C @(#)sgpfc.for	19.1 (ESO-DMD) 02/25/03 13:31:24
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 Massachusetts Ave, Cambridge, 
C MA 02139, USA.
C
C Correspondence 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 021031	last modif
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
C 
      DOUBLE PRECISION STEP(3),START(3)
      INTEGER  MADRID(1)
      INTEGER  NPIX(3)
      INTEGER  IC(NCOL),KUNIT(4)
      INTEGER  IMNO, INULL, ITNO
      INTEGER  I, IERR, IAV, IDF
      INTEGER  MC
      INTEGER  IX
      INTEGER  N, NA, NR, NC
      INTEGER*8 PNTR
C 
      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
