C @(#)irsflat.for	17.1.1.1 (ES0-DMD) 01/25/02 17:53:06
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.COPYRIGHT   (C) 1992 European Southern Observatory
C.IDENT       .for
C.AUTHOR      E. Oliva,  Firenze-Arcetri
C.KEYWORDS    Spectroscopy, IRSPEC
C
C.PURPOSE     Execute command  ...
C
C.ALGORITHM
C
C
C.INPUT/OUTPUT
C
C
C.VERSION     1.0    Creation     02.09.1992   E. Oliva
C
C-------------------------------------------------------
C
      PROGRAM IRFLAT
      IMPLICIT REAL(A-H,O-Z)
      IMPLICIT INTEGER(I-N)

      CHARACTER*64 CUNIT
      CHARACTER*72 IDENT
      INTEGER*8 INPNTR,OUPNTR
      INTEGER NPIX(2),MMPIX(2)
      REAL CUTS(2)
      DOUBLE PRECISION START(2),STEP(2)
      COMMON /VMR/ MADRID(1)

      INCLUDE 'MID_INCLUDE:ST_DEF.INC'
      INCLUDE 'MID_INCLUDE:ST_DAT.INC'

      DATA MAXDIM/2/

      IRET=1
      CALL STSPRO('IRFLAT')
C
C GET INPUT FRAME AND MAP IT
C CHECK ALSO WHETHER IT IS A 2D FRAME.....
C
      CALL STIGET('middummb',D_R4_FORMAT,F_I_MODE,F_IMA_TYPE,MAXDIM,
     ,            NAXIS,NPIX,START,STEP,
     ,            IDENT,CUNIT,INPNTR,NIN,ISTAT)
      IF(NAXIS.NE.2) 
     +     CALL STETER(1,'Input frame must be 2-D')
C
C GET OUTPUT FRAME AND MAP IT
C
      CALL STIPUT('middummc',D_R4_FORMAT,F_O_MODE,F_IMA_TYPE,
     ,            NAXIS,NPIX,START,STEP,
     ,            IDENT,CUNIT,OUPNTR,NOU,ISTAT)
C
C GET key TO DEFINE threshold value
C
      CALL STKRDR('thres',1,1,IRET,THRES,KUNIT,KNUL,ISTAT)
C
C GET key TO DEFINE the value to which vignetted pixels must be
C forced.
C
      CALL STKRDR('vignet',1,1,IRET,VIGNET,KUNIT,KNUL,ISTAT)
C
C CALL ROUTINE WHICH which divides by a constant and modifies vignetted
C rows
C
      CALL NORMAL(MADRID(INPNTR),MADRID(OUPNTR),
     ,                NPIX(1),NPIX(2),THRES,VIGNET)
C
C Define and write cuts of output file
C
      CALL MNMX(MADRID(OUPNTR),NPIX,CUTS,MMPIX)
      CALL STDWRR(NOU,'LHCUTS',CUTS,3,2,KUNIT,ISTAT)
C
C RELEASE FILES, UPDATE KEYWORDS AND EXIT
C
      CALL STSEPI
      END
C
C
C
      SUBROUTINE NORMAL(A,B,NX,NY,THRES,VIGNET)
C
C divides the input frame by the average
C value of the central 10 rows (=AVER_CENT)
C In the computation of AVER_CENT the first and last 2 pixels
C of each row are not considered to avoid edge effects.
C
C All rows with average signal<THRES*AVER_CENT
C are not considered and the output is forced=VIGNET
C
      IMPLICIT REAL(A-H,O-Z)
      IMPLICIT INTEGER(I-N)


      DIMENSION A(NX,NY),B(NX,NY)
C
C Define average value of central 10 rows
C
      NYC=NY/2
      NCENT=0
      AVER_CENT=0.
      DO IX=3,NX-3
        DO IY=NYC-2,NYC+2
          AVER_CENT=AVER_CENT+A(IX,IY)
          NCENT=NCENT+1
        ENDDO
      ENDDO
      AVER_CENT=AVER_CENT/NCENT

      DO IY=1,NY
        AVEY=0.0
        NAVE=0
        DO IX=1,NX
          IF(IX.GT.2 .AND. IX.LT.(NX-2)) THEN
            AVEY=AVEY+A(IX,IY)
            NAVE=NAVE+1
          ENDIF
          B(IX,IY)=A(IX,IY)/AVER_CENT
        ENDDO
        AVEY=AVEY/NAVE
        IF(AVEY.LT.(THRES*AVER_CENT)) THEN
          DO IX=1,NX
            B(IX,IY)=VIGNET
          ENDDO
        ENDIF
      ENDDO
C
      RETURN
      END