        SUBROUTINE VFLAT
*
*  Module number: 15.6
*
*  Module name: taflat
*
*  Keyphrase:
*  ----------
*  Calculate an average flat field of HSP's target acquisization aperture
*
*  Description:
*  ------------
*  Maximum number of input data points for each file is 1000.
*  Only process one-group files.
*
*  FORTRAN name: VFLAT.FOR
*
*  Keywords of accessed files and tables:
*  --------------------------------------
*  Name                         I/O     Description / Comments
*
*       input parameters
*
*  'infiles'                     I      input file template
*  'inmasks'                     I      input mask template
*  'nfiles'                      I      number of input files
*  'intable'                     I      input table name
*  'outfile '                    I      output file containing result
*  'outmask'                     I      output file mask
*  'okval'                       I      good pixel mask value
*  'hitval'                      I      bad pixel mask value
*  'count_key'                   I      column name of the count rate
*  'inttm_key'                   I      column name of the integration time
*  'temp_key'                    I      column name of the temperature
*  'apert_key'                   I      column name of the aperture name
*  'type'                        I      data type
*
*       input table column names:
*
*  (count_key)                   I      count rate as passed from COUNT_KEY
*  (inttm_key)                   I      the integration time as passed from INTTM_KEY
*  (temp_key)                    I      the temperature as passed from TEMP_KEY
*  (apert_key)                   I      the aperture ID as passed from APERT_KEY
*  'EPOCH'                       I      observation epoch
*
*  Subroutines Called:
*  -------------------
*  CDBS:
*       CDTIN
*  SDAS:
*       UCLGSI, UCLGSR, UCLGST, UIMOPN, UIMGID, UIMCLO, UTRGTR, UIMCRE,
*       UIGL1R, UIGL2R, UIPL1R, UIPL2R, UTTCLO, UMSPUT, UHDASR, UHDASD
*  Others:
*       None
*
*  History:
*  --------
*  Version      Date        Author          Description
*     1       06-22-87     J.-C. HSU        design and coding
*     2       11-20-87     J.-C. HSU        F77 SDAS
*-------------------------------------------------------------------------------
*
*== local:
*                                       --temperature
        REAL                    TEMP(100),
*                                       --temperature mean and range
     :                          TAVE, TMIN, TMAX,
*                                       --data and mask buffer
     :                          FBUFF(1000), MBUFF(1000),
*                                       --total weights of data
     :                          WEIGHT(1000),
*                                       --output data and mask buffer
     :                          OUT(1000), OUTM(1000),
*                                       --mask values
     :                          OKVAL, HITVAL,
*                                       --average count rate, and integration time
     :                          AVECT, INTTM,
*                                       --data buffer
     :                          COLBUF(10)
*                                       --epoch, it's mean and range
        DOUBLE PRECISION        EPOCH(100), EPAVE, EPMIN, EPMAX
*                                       --total number of valid input data points
        INTEGER                 NPTS,
*                                       --error status
     :                          STATUS,
*                                       --image/mask descriptor
     :                          IMGDSC, MSKDSC,
*                                       --number of dimensions
     :                          NAXIS, NAX,
*                                       --array sizes
     :                          DIMEN(7), DIM(7),
*                                       --number of input files
     :                          NFL, NFILES, NROWS,
*                                       --input and output file/mask ID
     :                          INFID, INMID, OUTFID, OUTMID,
*                                       --data type
     :                          DTYPE, TYPE,
*                                       --pointer of table descripter and column
*                                       --identifier
     :                          TP, COLIDN(10),
*                                       --loop indices, number of input columns
     :                          I, J, K, NCOLS,
*                                       --status
     :                          STAT(20), STATOK
*                                       --null flag in UTRGTR
        LOGICAL                 NULMSK(30)
        CHARACTER*5             CHAR5
*                                       --aperture name, and data type
        CHARACTER*10            APER, APERT, DAT
*                                       --column names
        CHARACTER*16            COLNAM(10)
*                                       --input file, mask, table, output file,
*                                       --mask names
        CHARACTER*128           IFILE, ITABLE, IMASK,
     :                          OFILE, OMASK, INFILE, INMASK
*                                       --error message context
        CHARACTER*130           CONTXT
*==========================begin iraf77.inc (without INTEGER*2)=================
*     Include file for the iraf77 FORTRAN interface to the IRAF VOS
*     Get IRAF common into main program
*
      LOGICAL MEMB(1)
      INTEGER MEMI(1)
      INTEGER MEML(1)
      REAL MEMR(1)
      DOUBLE PRECISION MEMD(1)
      COMPLEX MEMX(1)
      EQUIVALENCE (MEMB, MEMI, MEML, MEMR, MEMD, MEMX)
      COMMON /MEM/ MEMD
*
*     File I/O access modes
*
      INTEGER   RDONLY
      PARAMETER (RDONLY = 1)
      INTEGER   RDWRIT
      PARAMETER (RDWRIT = 2)
      INTEGER   WRONLY
      PARAMETER (WRONLY = 3)
      INTEGER   APPEND
      PARAMETER (APPEND = 4)
      INTEGER   NEWFIL
      PARAMETER (NEWFIL = 5)
      INTEGER   TMPFIL
      PARAMETER (TMPFIL = 6)
      INTEGER   NEWCPY
      PARAMETER (NEWCPY = 7)
      INTEGER   NEWIMG
      PARAMETER (NEWIMG = 5)
      INTEGER   EOF
      PARAMETER (EOF = -2)
*
*     codes for data types
*
      INTEGER   TYBOOL
      PARAMETER (TYBOOL = 1)
      INTEGER   TYCHAR
      PARAMETER (TYCHAR = 2)
      INTEGER   TYSHOR
      PARAMETER (TYSHOR = 3)
      INTEGER   TYINT
      PARAMETER (TYINT = 4)
      INTEGER   TYLONG
      PARAMETER (TYLONG = 5)
      INTEGER   TYREAL
      PARAMETER (TYREAL = 6)
      INTEGER   TYDOUB
      PARAMETER (TYDOUB = 7)
      INTEGER   TYCPLX
      PARAMETER (TYCPLX = 8)
      INTEGER   TYUSHT
      PARAMETER (TYUSHT = 11)
      INTEGER   TYUBYT
      PARAMETER (TYUBYT = 12)
*
*     TYTEXT is a special code for the iraf77 interface; it is not in the VOS
*
      INTEGER TYTEXT
      PARAMETER (TYTEXT = 13)
*========================end iraf77.inc=========================================
*=========================begin hsp.inc=========================================
*                                       --status return code
        INTEGER         OK, ERRNUM(20)
*                                       --message destination and priority
        INTEGER         DEST, PRIO
        DATA OK /0/
        DATA ERRNUM /701, 702, 703, 704, 705, 706, 707, 708, 709, 710,
     :               711, 712, 713, 714, 715, 716, 717, 718, 719, 720/
        DATA DEST, PRIO /1, 0/
*=========================end hsp.inc===========================================
*------------------------------------------------------------------------------
*
*  get parameters from PAR file: number of input files, input table name,
*  output file name, output mask name, column names of (1) average count rate,
*  (2) integration time, (3) temperature, (4) aperture name; mask values
*  of good and bad pixels, and data type
*
        CALL UCLGST ('infiles',         INFILE, STAT(1))
        CALL UCLGST ('inmasks',         INMASK, STAT(2))
        CALL UCLGSI ('nfiles',          NFILES, STAT(3))
        CALL UCLGST ('intable',         ITABLE, STAT(4))
        CALL UCLGST ('outfile',         OFILE, STAT(5))
        CALL UCLGST ('outmask',         OMASK, STAT(6))
        CALL UCLGST ('count_key',       COLNAM(1), STAT(7))
        CALL UCLGST ('inttm_key',       COLNAM(2), STAT(8))
        CALL UCLGST ('temp_key',        COLNAM(3), STAT(9))
        CALL UCLGST ('apert_key',       COLNAM(5), STAT(10))
        CALL UCLGST ('type',            DAT, STAT(11))
        CALL UCLGSR ('okval',           OKVAL, STAT(12))
        CALL UCLGSR ('hitval',          HITVAL, STAT(13))
*
        DO 10 I = 1, 13
            IF (STAT(I) .NE. OK) THEN
                STATUS = ERRNUM(1)
                CONTXT = 'can not get input parameter(s)'
                GO TO 999
            END IF
   10   CONTINUE
*
*  set up input table
*
        NCOLS = 5
        COLNAM(4) = 'EPOCH'
*
        CALL CDTIN (ITABLE, COLNAM, NCOLS,
     :                  TP, COLIDN, NROWS, STATUS)
        IF (STATUS .NE. OK) THEN
            CONTXT = 'error setting up input table'
            GO TO 999
        END IF
*
*  reset output buffer
*
        DO 20 I = 1, 1000
            OUT(I) = 0.
            OUTM(I) = OKVAL
            WEIGHT(I) = 0.
   20   CONTINUE
*
*  initialize template processing
*
        CALL UIMOTP (INFILE,    IMGDSC, STAT(1))
        CALL UIMOTP (INMASK,    MSKDSC, STAT(2))
        IF (STAT(1) .NE. OK .OR. STAT(2) .NE. OK) THEN
            STATUS = ERRNUM(3)
            CONTXT = 'cannot initialize template processing'
            GO TO 999
        END IF
*
*  process each input file
*
        NFL = 0
        NPTS = 1
        DO 100 I = 1, NFILES
*
*  expand image name template
*
            CALL UIMXTP (IMGDSC,        IFILE, STAT(1))
            CALL UIMXTP (MSKDSC,        IMASK, STAT(2))
*
*  check on end of file
*
            IF (STAT(1) .EQ. EOF .OR. STAT(2) .EQ. EOF) GO TO 200
*
            IF (STAT(1) .NE. OK .OR. STAT(2) .NE. OK) THEN
                STATUS = ERRNUM(1)
                CONTXT = 'cannot expand file name template'
                GO TO 999
            END IF
*
*  read average count rate, integration time, temperature, epoch, and aperture
*  name from input table
*
            CALL UTRGTR (TP, COLIDN, 3, I,
     :                   COLBUF, NULMSK, STAT(1))
            CALL UTRGTD (TP, COLIDN(4), 1, I,
     :                   EPOCH(NFL+1), NULMSK(4), STAT(2))
            CALL UTRGTT (TP, COLIDN(5), 1, I,
     :                   APERT, NULMSK(5), STAT(3))
*
            STATOK = ABS(STAT(1) - OK) + ABS(STAT(2) - OK) +
     :                  ABS(STAT(3) - OK) + OK
            DO 30 J = 1, NCOLS
                IF (NULMSK(J)) THEN
                    STATOK = ERRNUM(2)
                    GO TO 40
                END IF
   30       CONTINUE
*
*  if error in UTRGTR, put an error message and skip the current file
*
   40       CONTINUE
            IF (STATOK .NE. OK) THEN
                WRITE(CHAR5, '(I5)') I
                CONTXT = 'VFLAT: can not read input table row #' //
     :                          CHAR5
                CALL UMSPUT (CONTXT, DEST, PRIO,        STATOK)
                GO TO 100
            END IF
*
            AVECT = COLBUF(1)
            INTTM = COLBUF(2)
            TEMP(NFL+1) = COLBUF(3)
*
*  open input file
*
            CALL UIMOPN (IFILE, RDONLY,         INFID, STAT(1))
            CALL UIMGID (INFID,         DTYPE, NAXIS, DIMEN, STAT(2))
            IF (STAT(1) .NE. OK .OR. STAT(2) .NE. OK) THEN
                CONTXT = 'VFLAT: cannot open input file or get image '
     :                          // 'description'
                CALL UMSPUT (CONTXT, DEST, PRIO,        STATOK)
                GO TO 100
            END IF
*
*  use the first file as a reference
*
            IF (NFL .EQ. 0) THEN
                NAX = NAXIS
                TYPE = DTYPE
                APER = APERT
                DO 50 J = 1, NAX
                    DIM(J) = DIMEN(J)
                    NPTS = DIM(J) * NPTS
   50           CONTINUE
            END IF
*
*  check image description against the reference (first) file
*
            IF (DTYPE .NE. TYPE .OR. NAXIS .NE. NAX .OR.
     :          APERT .NE. APER .OR. DIMEN(1) .NE. DIM(1) ) THEN
                CONTXT = 'VFLAT: input file has '
     :                  // 'incompatible data type or dimension or size'
     :                  // ' or aperture'
                CALL UMSPUT (CONTXT, DEST, PRIO,        STATOK)
                GO TO 100
            END IF
*
*  open input mask
*
            CALL UIMOPN (IMASK, RDONLY,        INMID, STAT(1))
            CALL UIMGID (INMID,         DTYPE, NAXIS, DIMEN, STAT(2))
            IF (STAT(1) .NE. OK .OR. STAT(2) .NE. OK) THEN
                CONTXT = 'VFLAT: cannot open input mask or get image '
     :                          // 'description'
                CALL UMSPUT (CONTXT, DEST, PRIO,        STATOK)
                GO TO 100
            END IF
*
            IF (DTYPE .NE. TYPE .OR. NAXIS .NE. NAX .OR.
     :          DIMEN(1) .NE. DIM(1) ) THEN
                CONTXT = 'VFLAT: input mask has '
     :                  // 'incompatible data type or dimension or size'
                CALL UMSPUT (CONTXT, DEST, PRIO,        STATOK)
                GO TO 100
            END IF
*
*  read data from input file and its mask (line by line if 2-D)
*
            IF (NAX .EQ. 1) THEN
                CALL UIGL1R (INFID,     FBUFF, STAT(1))
                CALL UIGL1R (INMID,     MBUFF, STAT(2))
                IF (STAT(1) .NE. OK .OR. STAT(2) .NE. OK) THEN
                    GO TO 70
                END IF
            ELSE
                DO 60 K = 1, DIM(2)
                    J = DIM(1) * (K-1) + 1
                    CALL UIGL2R (INFID, K,      FBUFF(J), STAT(1))
                    CALL UIGL2R (INMID, K,      MBUFF(J), STAT(2))
                    IF (STAT(1) .NE. OK .OR. STAT(2) .NE. OK) THEN
                        GO TO 70
                    END IF
   60           CONTINUE
            END IF
            GO TO 80
   70       CONTXT = 'error reading data from input file '
            CALL UMSPUT (CONTXT, DEST, PRIO,    STATOK)
            GO TO 100
   80       CONTINUE
*
*  co-add count rate (normalized by the average count rate of each file)
*  to the output array
*
            DO 90 K = 1, NPTS
                IF (MBUFF(K) .EQ. OKVAL) THEN
                    FBUFF(K) = FBUFF(K) / AVECT
*
*  if data type is digital, divide by integration time
*
                    IF (DAT .EQ. 'digital') THEN
                        FBUFF(K) = FBUFF(K) / INTTM
                    END IF
                    OUT(K) = OUT(K) + FBUFF(K)
*
*  equally weighted
*
                    WEIGHT(K) = WEIGHT(K) + 1.
                END IF
   90       CONTINUE
*
*  increment the number of valid files
*
            NFL = NFL + 1
*
*  close input file/mask
*
            CALL UIMCLO (INFID,         STAT(1))
            CALL UIMCLO (INMID,         STAT(2))
            IF (STAT(1) .NE. OK .OR. STAT(2) .NE. OK) THEN
                CONTXT = 'cannot close input file '
                CALL UMSPUT (CONTXT, DEST, PRIO,        STATOK)
            END IF
  100   CONTINUE
*
*  close image list
*
  200   CALL UIMCTP (IMGDSC,         STATOK)
        CALL UIMCTP (MSKDSC,         STATOK)
*
*  close input table
*
        CALL UTTCLO (TP,        STATUS)
        IF (STATUS .NE. OK) THEN
            CONTXT = 'cannot close input table'
            GO TO 999
        END IF
*
        IF (NFL .LE. 0) THEN
            STATUS = ERRNUM(2)
            CONTXT = 'no input data been successfully read'
            GO TO 999
        END IF
*
*  divide results by weight
*
        DO 110 I = 1, NPTS
            IF (WEIGHT(I) .GT. 0.) THEN
                OUT(I) = OUT(I) / WEIGHT(I)
            ELSE
                OUTM(I) = HITVAL
            END IF
  110   CONTINUE
*
*  find the range and mean of temperature and epoch
*
        TAVE = 0.
        TMIN = TEMP(1)
        TMAX = TEMP(1)
        EPAVE = 0.D0
        EPMIN = EPOCH(1)
        EPMAX = EPOCH(1)
*
        DO 120 I = 1, NFL
            TAVE = TAVE + TEMP(I)
            EPAVE = EPAVE + EPOCH(I)
*
            IF (TEMP(I) .GT. TMAX) THEN
                TMAX = TEMP(I)
            ELSE IF (TEMP(I) .LT. TMIN) THEN
                TMIN = TEMP(I)
            END IF
*
            IF (EPOCH(I) .GT. EPMAX) THEN
                EPMAX = EPOCH(I)
            ELSE IF (EPOCH(I) .LT. EPMIN) THEN
                EPMIN = EPOCH(I)
            END IF
  120   CONTINUE
        TAVE = TAVE / REAL(NFL)
        EPAVE = EPAVE / DBLE(NFL)
*
*  open output file/mask
*
        CALL UIMCRE (OFILE, TYPE, NAX, DIM,     OUTFID, STAT(1))
        CALL UIMCRE (OMASK, TYPE, NAX, DIM,     OUTMID, STAT(2))
        IF (STAT(1) .NE. OK .OR. STAT(2) .NE. OK) THEN
            STATUS = ERRNUM(3)
            CONTXT = 'cannot open output file/mask'
            CALL UMSPUT (CONTXT, DEST, PRIO,    STATOK)
            GO TO 999
        END IF
*
*  write the result to output file/mask
*
        IF (NAX .EQ. 1) THEN
            CALL UIPL1R (OUTFID, OUT,           STAT(1))
            CALL UIPL1R (OUTMID, OUTM,          STAT(2))
            IF (STAT(1) .NE. OK .OR. STAT(2) .NE. OK) THEN
                GO TO 150
            END IF
        ELSE
            DO 130 K = 1, DIM(2)
                J = DIM(1) * (K-1) + 1
                CALL UIPL2R (OUTFID, K, OUT(J),         STAT(1))
                CALL UIPL2R (OUTMID, K, OUTM(J),        STAT(2))
                IF (STAT(1) .NE. OK .OR. STAT(2) .NE. OK) THEN
                    GO TO 150
                END IF
  130       CONTINUE
        END IF
*
*  write parameters to output file header  (global)
*
        CALL UHDASR (OUTFID, 'TEMPAVE', TAVE, ' ', 0,           STAT(1))
        CALL UHDASR (OUTFID, 'TEMPMAX', TMAX, ' ', 0,           STAT(2))
        CALL UHDASR (OUTFID, 'TEMPMIN', TMIN, ' ', 0,           STAT(3))
        CALL UHDASD (OUTFID, 'EPOCHAVE', EPAVE, ' ', 0,         STAT(4))
        CALL UHDASD (OUTFID, 'EPOCHMAX', EPMAX, ' ', 0,         STAT(5))
        CALL UHDASD (OUTFID, 'EPOCHMIN', EPMIN, ' ', 0,         STAT(6))
*
        DO 140 I = 1,6
            IF (STAT(I) .NE. OK) THEN
                GO TO 150
            END IF
  140   CONTINUE
        GO TO 160
*
  150   STATUS = ERRNUM(4)
        CONTXT = 'cannot write parameter(s) to output file header'
        GO TO 999
  160   CONTINUE
*
*  close output file/mask
*
        CALL UIMCLO (OUTFID,    STAT(1))
        CALL UIMCLO (OUTMID,    STAT(2))
        IF (STAT(1) .NE. OK .OR. STAT(2) .NE. OK) THEN
            STATUS = ERRNUM(5)
            CONTXT = 'cannot close output file(s)'
            GO TO 999
        END IF
*
        STATUS = OK
        GO TO 1000
*
*  write error message
*
  999   CALL UMSPUT ('VFLAT: ' // CONTXT, DEST, PRIO,        STATOK)
*
 1000   RETURN
        END
