C @(#)sgpfc.for 17.1.1.1 (ES0-DMD) 01/25/02 17:19:22 C=========================================================================== C Copyright (C) 1995 European Southern Observatory (ESO) C C This program is free software; you can redistribute it and/or C modify it under the terms of the GNU General Public License as C published by the Free Software Foundation; either version 2 of C the License, or (at your option) any later version. C C This program is distributed in the hope that it will be useful, C but WITHOUT ANY WARRANTY; without even the implied warranty of C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the C GNU General Public License for more details. C C You should have received a copy of the GNU General Public C License along with this program; if not, write to the Free C Software Foundation, Inc., 675 Massachusetss Ave, Cambridge, C MA 02139, USA. C C Corresponding concerning ESO-MIDAS should be addressed as follows: C Internet e-mail: midas@eso.org C Postal address: European Southern Observatory C Data Management Division C Karl-Schwarzschild-Strasse 2 C D 85748 Garching bei Muenchen C GERMANY C=========================================================================== C C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C C.IDENTIFICATION: C PROGRAM SGPFC VERSION 1.0 SEP 8, 1988 C P.GROSBOL ESO - GARCHING C C.PURPOSE: C PROGRAM TO EXTRACT AZIMUTHAL PROFILES FROM A GALAXY WITH GIVEN C PA AND AI. THE PROFILES ARE FOURIER TRANSFORMED AND THE C COEFFICIENTS ARE STORED IN A TABLE FILE. C THE NO. OF COEFFICIENTS IS DEFINED BY THE PARAMETER 'MFC=7' C I.E. INCLUDING THE 6TH HARMONIC C C.INPUT/OUTPUT: C THE PROGRAM RUNS UNDER MIDAS AND USES THE FOLLOWING KEYWORDS: C IN_A : NAME OF IMAGE FILE (I) C INPUTR(1-7) : REAL INPUT PARAMETERS DEFINING GALAXY POSITION (I) C 1:X CENTER POSITION, 2:Y CENTER POSITION, C 3:POSITON ANGLE (DEG), 4:INCLINATION ANGLE (DEG) C 5:INNER RADIUS, 6:OUTER RADIUS, 7:RADIAL STEP C OUT_A : OUTPUT TABLE NAME (I) C C.VERSION: C 910307 RHW Included in ESO-MIDAS C C--------------------------------------------------------------------- PROGRAM SGPFC C IMPLICIT NONE INTEGER MFC INTEGER NCOL INTEGER MCOL PARAMETER (MFC=7) PARAMETER (NCOL=2*MFC+3) PARAMETER (MCOL=NCOL+5) C REAL AMP(MFC),PHA(MFC),PH(MFC),ROW(NCOL), 2 RANGE(3),POSI(4) REAL PI, PI2, PA REAL RI, RO REAL R, RP REAL AI, AN REAL DIF REAL DR, DTR REAL XC, YC DOUBLE PRECISION STEP(3),START(3) INTEGER MADRID(1) INTEGER NPIX(3),PNTR INTEGER IC(NCOL),KUNIT(4) INTEGER IMNO, INULL, ITNO INTEGER I, IERR, IAV, IDF INTEGER MC INTEGER IX INTEGER N, NA, NR, NC LOGICAL LFPHA C CHARACTER*16 LAB CHARACTER*60 INAME,TNAME,TNN CHARACTER*64 UNIT CHARACTER*72 IDEN CHARACTER*80 MSG C INCLUDE 'MID_INCLUDE:ST_DEF.INC' COMMON /VMR/MADRID INCLUDE 'MID_INCLUDE:ST_DAT.INC' C C INITIATE MIDAS C CALL STSPRO('SGPFC') C C READ PARAMETERS C CALL STKRDC('IN_A',1,1,60,IAV,INAME,KUNIT,INULL,IERR) CALL STKRDR('INPUTR',1,4,IAV,POSI,KUNIT,INULL,IERR) CALL STKRDR('INPUTR',5,3,IAV,RANGE,KUNIT,INULL,IERR) CALL STKRDC('OUT_A',1,1,60,IAV,TNAME,KUNIT,INULL,IERR) C C OPEN IMAGE FRAME C CALL STIGET(INAME,D_R4_FORMAT,F_I_MODE,1,3,NA,NPIX, , START,STEP,IDEN,UNIT,PNTR,IMNO,IERR) IF (NA.NE.2 .OR. IERR.NE.0 .OR. . ABS(STEP(1)/STEP(2)-1.0).GT.1E-5) THEN CALL STTPUT('*** FATAL: WRONG IMAGE FORMAT',IERR) CALL STSEPI ENDIF C C CHECK PARAMETERS AND CONVERT TO PIXEL VALUES C LFPHA = .TRUE. PI = 4.0 * ATAN(1.0) PI2 = 2.0 * PI DTR = PI / 180.0 RI = MAX( 0.0 , ABS(RANGE(1)) ) RO = MAX( RI , ABS(RANGE(2)) ) DR = ABS( RANGE(3) ) XC = (POSI(1)-START(1))/STEP(1) + 1.0 YC = (POSI(2)-START(2))/STEP(2) + 1.0 PA = DTR * POSI(3) AI = DTR * MAX( 0.0 , MIN( 90.0 , POSI(4) ) ) NR = INT( (RO-RI)/DR + 1.0 ) C C CREATE TABLE C I = INDEX(TNAME,' ') - 1 TNN = TNAME(1:I)//'.TBL' CALL TBTINI(TNAME,0,1,MCOL,NR,ITNO,IERR) CALL STDWRC(ITNO,'IDENT',1,IDEN,1,72,KUNIT,IERR) CALL STDWRR(ITNO,'POSI',POSI,1,4,KUNIT,IERR) CALL TBCINI(ITNO,D_R4_FORMAT,1,'F6.1',UNIT(17:32), , 'R',IC(1),IERR) CALL TBCINI(ITNO,D_R4_FORMAT,1,'F6.3','LR','LR',IC(2),IERR) CALL TBCINI(ITNO,D_R4_FORMAT,1,'I4','POINTS', , 'NOP',IC(3),IERR) CALL TBCINI(ITNO,D_R4_FORMAT,1,'F7.1',UNIT(1:16), , 'AMP',IC(4),IERR) CALL TBCINI(ITNO,D_R4_FORMAT,1,'F6.3',UNIT(17:32), , 'NOISE',IC(5),IERR) NC = 6 DO 100, I = 1,MFC-1 WRITE(LAB,650) I 650 FORMAT('AMP',I1) CALL TBCINI(ITNO,D_R4_FORMAT,1,'F6.3',' ',LAB,IC(NC),IERR) NC = NC + 1 WRITE(LAB,655) I 655 FORMAT('PHA',I1) CALL TBCINI(ITNO,D_R4_FORMAT,1,'F7.1','DEGREES', , LAB,IC(NC),IERR) NC = NC + 1 100 CONTINUE C C GET FOURIER COEFFICIENTS FROM EACH RADIUS C R = RI DO 200, I = 1,NR RP = R / STEP(1) CALL APFFTC(MADRID(PNTR),NPIX(1),NPIX(2),XC,YC,RP,PA,AI, , MFC,MC,AMP,PHA,AN) IF (MC.GE.MFC) THEN IF (LFPHA) THEN LFPHA = .FALSE. PH(1) = 0.0 DO 250, IX = 2, MFC DIF = PI2 / FLOAT(IX-1) IDF = INT((PHA(IX)-PH(IX-1))/DIF+100.5) - 100 PH(IX) = PHA(IX) - FLOAT(IDF)*DIF 250 CONTINUE ENDIF CALL PHAMOD(PHA,PH,MFC) ROW(1) = R ROW(2) = LOG(R) ROW(3) = 2 * MC ROW(4) = AMP(1) ROW(5) = AN / AMP(1) NC = 6 DO 300, N = 2,MFC ROW(NC) = AMP(N) / AMP(1) NC = NC + 1 ROW(NC) = PHA(N) / DTR NC = NC + 1 300 CONTINUE CALL TBRWRR(ITNO,I,NCOL,IC,ROW,IERR) ENDIF R = R + DR 200 CONTINUE WRITE(MSG,620) IDEN,RI,DR,NR 620 FORMAT(' IDEN,RI,DR,NR :',A18,3X,2F10.1,I8) CALL STTPUT(MSG,IERR) C C FINISHED - EXIT C CALL TBSINI(ITNO,IERR) CALL TBTCLO(ITNO,IERR) CALL STSEPI END