C @(#)averow.for	17.1.1.1 (ESO-IPG) 01/25/02 17:54:47
      PROGRAM AVEROW
C --------------------------------------------------------------------
C
C.COPYRIGHT: Copyright (c) 1987 European Southern Observatory,
C                                         all rights reserved
C
C.VERSION: 1.0  ESO-FORTRAN Conversion, AA  13:37 - 5 JAN 1988
C
C.LANGUAGE: F77+ESOext
C
C.AUTHOR: J.D.Ponz
C         900202   KB  take care of options in lower case
C
C.MODIF : M.Peron cosmectic changes
C.MODIF : 910417 replace numbers by symbolic constants in ST calls !!
C.MODIF : 940518 O. Stahl
C.MODIF : replace STIGET with STFGET to speed up operation for large frames
C.IDENTIFICATION
C
C AVEROW.FOR
C
C.KEYWORDS
C
C  average
C
C.PURPOSE
C
C  produce a 1d image from a 2d by averaging over rows or columns
C
C  COMMAND
C  AVERAGE/ROW    OUTPUT = INPUT START,END
C  AVERAGE/COLUMN OUTPUT = INPUT START,END
C
C.ALGORITHM
C
C  add rows/columns
C
C.INPUT/OUTPUT
C
C KEYWORDS P1 - P3
C
C ------------------------------------------------------------------
C
      IMPLICIT NONE
C
      INTEGER MADRID(1)
      INTEGER NDIM,KUN,KNUL,DUN,DNUL
      INTEGER I,I1,I2,II,II1,II2,K,IFIRST,IAV
      INTEGER NAXISA,NAXISB,NN,IMNOA,IMNOB,INUM
      INTEGER NPIXA(3),NPIXB(3),STATUS
      INTEGER*8 PNTRB,IPNTR
C
      REAL ACTVAL,LHCUTS(4),RN
C
      DOUBLE PRECISION STEPA(3),STEPB(3),STP,STR
      DOUBLE PRECISION STARTA(3),STARTB(3)
C
      CHARACTER*80    FRAMEA, FRAMEB
      CHARACTER*72    CUNITA,RANGE
      CHARACTER*72    IDENT
      CHARACTER       IOP*1,COMLIN*14,AUX*72
C
      INCLUDE 'MID_INCLUDE:ST_DEF.INC'
C
      COMMON  /VMR/ MADRID
C
      INCLUDE 'MID_INCLUDE:ST_DAT.INC'
C
      DATA   NDIM    /2/
      DATA   IDENT   /' '/,   CUNITA  /' '/
C
C  initialize system
C
      CALL STSPRO('AVEROW')
C
C  read params
C
      CALL STKRDC('P1',1,1,80,ACTVAL,FRAMEB,KUN,KNUL,STATUS)
      CALL STKRDC('P3',1,1,80,ACTVAL,FRAMEA,KUN,KNUL,STATUS)
      CALL STKRDC('P4',1,1,72,ACTVAL,RANGE,KUN,KNUL,STATUS)
      CALL STKRDC('P5',1,1,1,ACTVAL,IOP,KUN,KNUL,STATUS)
      CALL STKRDC('MID$CMND',1,1,14,ACTVAL,COMLIN,KUN,KNUL,STATUS)
C
C  open input frame and read descriptors
C
      CALL STFOPN(FRAMEA,D_R4_FORMAT,0,F_IMA_TYPE,IMNOA,STATUS)
      CALL STDRDI(IMNOA,'NAXIS',1,1,IAV,NAXISA,DUN,DNUL,STATUS)
      CALL STDRDI(IMNOA,'NPIX',1,2,IAV,NPIXA,DUN,DNUL,STATUS)
      CALL STDRDD(IMNOA,'START',1,2,IAV,STARTA,DUN,DNUL,STATUS)
      CALL STDRDD(IMNOA,'STEP',1,2,IAV,STEPA,DUN,DNUL,STATUS)
      CALL STDRDC(IMNOA,'IDENT',1,1,72,IAV,IDENT,DUN,DNUL,STATUS)
      CALL STDRDC(IMNOA,'CUNIT',1,1,72,IAV,CUNITA,DUN,DNUL,STATUS)
C
C  map output frame
C
      NAXISB = 1
      NPIXB(2) = 1
      STARTB(2) = 1.D0
      STEPB(2) = 0.D0
      IF (COMLIN(11:11).EQ.'R') THEN
         NPIXB(1) = NPIXA(1)
         STARTB(1) = STARTA(1)
         STEPB(1) = STEPA(1)
         NN = NPIXA(2)
         STR = STARTA(2)
         STP = STEPA(2)
      ELSE
         NPIXB(1) = NPIXA(2)
         STARTB(1) = STARTA(2)
         STEPB(1)= STEPA(2)
         NN = NPIXA(1)
         STR = STARTA(1)
         STP = STEPA(1)
      ENDIF
C
C  get range of pixels I1,I2
C
      II = INDEX(RANGE,'[')
      IF (II.EQ.1) THEN
         AUX = RANGE(2:)
         II = INDEX(AUX,']') - 1
         RANGE= AUX(1:II)
      ENDIF
      II2 = INDEX(RANGE,' ')
      II1 = INDEX(RANGE,',')
      CALL GETSNG(RANGE(1:II1-1),NN,STR,STP,I1)
      CALL GETSNG(RANGE(II1+1:II2-1),NN,STR,STP,I2)
      IF ((I1.LT.0).OR.(I2.LT.0).OR.(I1.GT.I2)) 
     +   CALL STETER(22,'Invalid range')
C
C  do it
C
      CALL STIPUT(FRAMEB,D_R4_FORMAT,F_O_MODE,F_IMA_TYPE,NAXISB,
     +            NPIXB,STARTB,STEPB,IDENT,CUNITA,PNTRB,IMNOB,STATUS)

      IF (COMLIN(11:11).EQ.'R') THEN

      CALL STFXMP(NPIXB,D_R4_FORMAT,IPNTR,STATUS)
      DO 30 I = I1,I2
         IFIRST = (I-1)*NPIXA(1)+1
C
C read row after row and sum up
C
         CALL STFGET(IMNOA,IFIRST,NPIXB,IAV,MADRID(IPNTR),STATUS)
         CALL AVER1(MADRID(PNTRB),MADRID(IPNTR),NPIXB)
 30   CONTINUE
C     
      ELSE
C     
         INUM = I2-I1+1
         CALL STFXMP(INUM,D_R4_FORMAT,IPNTR,STATUS)
         DO I = 1, NPIXA(2)
            IFIRST = (I-1)*NPIXA(1)+I1
            K = I
C
C read the columns which are to be  summed up
C
            CALL STFGET(IMNOA,IFIRST,INUM,IAV,MADRID(IPNTR),STATUS)
            CALL AVER2(MADRID(PNTRB),MADRID(IPNTR),
     +           K,INUM,NPIXA(1),NPIXA(2))
         ENDDO
      ENDIF
C
C find minmax and optionally average
C
      RN = I2-I1+1
      CALL MINMAX(MADRID(PNTRB),NPIXB(1),LHCUTS(3),LHCUTS(4),IOP,RN)
      CALL STDWRR(IMNOB,'LHCUTS',LHCUTS,1,4,KUN,STATUS)
C     
C  free data
C
      CALL STSEPI
      STOP
      END
C
      SUBROUTINE AVER1(Y,Y1,NPIX1)
C
C SUM OVER ROWS
C
      IMPLICIT NONE
      INTEGER  NPIX1,J
      REAL     Y(NPIX1), Y1(NPIX1)
C
      DO 20 J = 1,NPIX1
         Y(J)   = Y(J) + Y1(J)
 20   CONTINUE
C
      RETURN
      END

      SUBROUTINE AVER2(Y,Y1,ICOL,INUM,NPIX1,NPIX2)
C
C SUM OVER COLUMNS
C
      IMPLICIT NONE
      INTEGER  ICOL,J,INUM,NPIX1,NPIX2
      REAL     Y(NPIX1), Y1(NPIX2)
C
      Y(ICOL) = 0.0
      DO J = 1,INUM
         Y(ICOL) = Y(ICOL)+Y1(J)
      ENDDO
C     
      RETURN
      END
      
      SUBROUTINE MINMAX(Y,NPIX,YMIN,YMAX,IOP,RN)
C
C FIND MIN AND MAX OF SUM OR AVERAGE
C
      IMPLICIT NONE
      INTEGER  I,NPIX
      REAL     Y(NPIX),YMIN,YMAX,RN
      CHARACTER*1 IOP

      IF (IOP.NE.'S'.AND.IOP.NE.'s') THEN
         DO I = 1,NPIX
            Y(I) = Y(I)/RN
         ENDDO
      ENDIF
      YMIN = 1.0E30
      YMAX = -1.0E30
      DO I =  1, NPIX
         YMIN = MIN(YMIN,Y(I))
         YMAX = MAX(YMAX,Y(I))
      ENDDO
      RETURN 
      END