C @(#)gcurve.for	17.1.1.1 (ES0-DMD) 01/25/02 17:54:07
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
      PROGRAM GCURVE
C
C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C.COPYRIGHT      (c) 1988 European Southern Observatory
C.IDENT          GCURVE
C.LANGUAGE       ESO-FOR
C.AUTHOR         Preben Grosbol (ESO-IPG)
C.KEYWORDS       Growth curve, photometry, galaxies
C.ENVIRONMENT    MIDAS
C.COMMENT        MIDAS command similar to the IHAP GCURVE command
C.PURPOSE        The command computes a growth curve for an object.
C.VERSION        1.0    1988-Sep-30 : Creation,      PJG
C---------------------------------------------------------------------
C
      IMPLICIT NONE
C
      CHARACTER*40  INAME,TNAME
      INTEGER       IAV,IERR,NX,NY,NA,N,I,ILAB
      INTEGER       NPIX(2),IDT,IDF,KUNIT(4),INULL
      INTEGER       IXF,IXL,IYF,IYL,I,I1,I2,NX,NY
      INTEGER       IDF,IDT,IMEM,IDX,IOFF
      REAL          CI,CP,SP,X,Y,XS,YS,DX,DY,XC,YC,XT,YT
      REAL          RL,R,SC,AMP,EL,ELIM,RQCNST
      REAL          POSI(2),PROJ(2),STEP(2),START(2),PARM(10)
      REAL          VMADD(1)
C
      COMMON /VMR/VMADD
C
      EQUIVALENCE (NX,NPIX(1)),(NY,NPIX(2))
      EQUIVALENCE (XS,START(1)),(YS,START(2))
      EQUIVALENCE (DX,STEP(1)),(DY,STEP(2))
      EQUIVALENCE (XC,POSI(1)),(YC,POSI(2))
C
      INCLUDE  'MID_REL_INCL:MIDAS_DEF.INC'
C
C     INITIATE MIDAS
C
      CALL STSPRO('GCURVE ',IERR)
C
C     READ FRAME NAME AND OPEN IT
C
      CALL STKRDC('IN_A ',1,1,40,IAV,INAME,KUNIT,INULL,IERR)
      CALL STFOPN(INAME,D_R4_FORMAT,0,1,IDF,IERR)
C
C     READ FRAME DESCRIPTORS
C
      CALL STDRDI(IDF,'NAXIS ',1,1,IVA,NA,KUNIT,INULL,IERR)
      IF (NA.NE.2 .OR. IERR.NE.0) THEN
         CALL STTPUT('WRONG IMAGE DIMENSION, MUST BE 2 ',IERR)
         GOTO 90000
      ENDIF
      CALL STDRDI(IDF,'NPIX ',1,2,IVA,NPIX,KUNIT,INULL,IERR)
      CALL STDRDR(IDF,'START ',1,2,IVA,START,KUNIT,INULL,IERR)
      CALL STDRDR(IDF,'STEP ',1,2,IVA,STEP,KUNIT,INULL,IERR)
C
C     READ PARAMETERS 
C
      CALL STKRDR('POSITION ',1,2,IAV,POSI,KUNIT,INULL,IERR)
      CALL STKRDR('PARM ',1,10,IAV,PARM,KUNIT,INULL,IERR)
      CALL STKRDR('ITERATION ',1,2,IAV,RITER,KUNIT,INULL,IERR)
C
C     INITIATE VARIABLES
C
      IYF = 1
      IYL = NY
      IXF = 1
      IXL = NX
C
C     READ AND INITIATE PROJECTION 
C
      CALL STKRDR('PROJECT ',1,2,IAV,PROJ,KUNIT,INULL,IERR)
      DTR = ATAN(1.0D0)/45.0D0
      CI = COS(DTR*PROJ(1))
      CP = COS(DTR*PROJ(2))
      SP = SIN(DTR*PROJ(2))
C
C     GET MEMORY AND INITIATE VARIABLES
C
      CALL STFCRE('DUMMY ',D_R4_FORMAT,F_X_MODE,1,NX,IMEM,IERR)
      CALL STFMAP(IMEM,F_X_MODE,1,NX,IVA,IDX,IERR)
      IOFF = NX*(IYF-1) + 1
C
C     GO THROUGH FRAME LINE BY LINE
C
      Y = YS - YC + (IYF-1)*DY
      I1 = IDX + IXF - 1
      I2 = IDX + IXL - 1
      DO 100, IY = IYF,IYL
         CALL STFGET(IDF,IOFF,NX,IVA,IDX,IERR)
         X = XS - XC + (IXF-1)*DX
         DO 300, I = I1,I2
            XT = SP*X - CP*Y
            YT = CI * (CP*X + SP*Y)
            R = SQRT(XT*XT + YT*YT)
            VMADD(I) = VMADD(I) + AMP*EXP(R*SC)
            X = X + DX
  300    CONTINUE
         Y = Y + DY
         CALL STFPUT(IDF,IOFF,NX,IVA,IDX,IERR)
         IOFF = IOFF + NX
  100 CONTINUE
C
C     FINISHED - EXIT
C
90000 CALL STFCLO(IDF,IERR)
      CALL STFCLO(IMEM,IERR)
      CALL STSEPI(IERR)
      END