        SUBROUTINE VPPCOR (
*
*  inputs:
*
     :                  OBSID, INMID, OFILE, MSKID, IP, MP, NPTS, CHUNK,
     :                  PTFLAG, DEADSW, CNTSW, PHCSW, TYPE,
     :                  DET, APERT, GAIN, HV, DISCR,
     :                  DETTMP, DEATMP, EPOCH, SMPTM,
     :                  NDK, NPA, NHV, NSN, NGN, NCV, NDT, NDKAP, NAREA,
     :                  PADET, HVDET, GNDET, CVDET, DTDET,
     :                  DKAPER, SNAPER, DKAP, DKDET, DKNAME, AREAAP,
     :                  DKHV, HVHV, DTHV, GNGAIN, CVGAIN,
     :                  DKTYPE, PATYPE, HVTYPE, DTDISC,
     :                  DKBASE, PABASE, HVBASE, SNBSPT, SNBSEX, GNBASE,
     :                  CVBASE, DTBASE, AREA,
     :                  DKCOFF, PACOFF, HVCOFF, SNCOFF, GNCOFF, CVCOFF,
     :                  DTCOFF,
     :                  DKTMP0, PATMP0, HVTMP0, SNTMP0, GNTMP0, CVTMP0,
     :                  DTTMP0,
     :                  DKEP0, PAEP0, HVEP0, SNEP0, GNEP0, CVEP0,
*
*  outputs
*
     :                  STATUS)
*
*  Module Number:
*
*  Module Name: CALHSP
*
*  Keyphrase:
*  ----------
*  perform RSDP (pipeline) calibration corrections
*
*  Description:
*  ------------
*  calculate true count rates from raw counts by applying :
*  (1) dark signal, (2) pre-amplifier noise, (3) high voltage factor,
*  (4) relative sensitivity, (5) gain factor, (6) CVC offset, and
*  (7) deadtime corrections
*  process data in sections if number of data is over 100,000.
*
*  FORTRAN Name: vppcor.for
*
*  Keywords of Accessed Files and Tables:
*  --------------------------------------
*  Name                         I/O     Description / Comments
*
*       keywords updated in the file header
*
*  'DEADTIME'                    I      deadtime correction switch
*  'TRUE_CNT'                    I      true count rate computation switch
*  'TRUE_PHC'                    I      true photocurrect computation switch
*  'DARKRATE'                    I      scaled cathod dark rate
*  'PRE_AMP'                     I      scaled tube pre-amp contribution
*  'HIGHVOLT'                    I      scaled high volatge factor
*  'TUBEGAIN'                    I      scaled tube gain factor
*  'CVCOFSET'                    I      scaled CVC offset
*  'DEADTM'                      I      deadtime
*  'PT_EFFIC'                    I      scaled point source cathod efficiency
*  'EX_EFFIC'                    I      scaled extended source cathod efficiency
*  'APERAREA'                    I      aperture size
*  'BUNIT'                       I      unit of the calibrated count rate
*
*  Subroutines Called:
*  -------------------
*  CDBS:
*       VDKEVL, VPAEVL, VHVEVL, VSNEVL, VGNEVL, VCVEVL, VDTEVL, VASIZE, VSYNPH
*  SDAS:
*       UIGS1R, UIPS1R, UHDPSR, UHDPST, UIMOPC, UIMDEL, UMSPUT, UUSMMX
*  OTHERS:
*       None
*
*  History:
*  --------
*  Version      Date        Author          Description
*     1       08-01-88     J.-C. Hsu        Design and coding
*     2       07-21-89     J.-C. Hsu        process data in sections
*     3       08-11-89     J.-C. Hsu        new temperature dependent dead time
*     4       07-10-90     J.-C. Hsu        calculate output min and max
*   1.2.2     06-12-92     J.-C. Hsu        change minmax calculation to avoid
*					    "out of memory" for big files
*-------------------------------------------------------------------------------
*
*== input:
*                                       --file ID
        INTEGER                 INMID, MSKID,
*                                       --memory pointers
     :                          IP, MP,
*                                       --number of input points
     :                          NPTS,
*                                       --size of section to be processed
     :                          CHUNK,
*                                       --detector ID of input data
     :                          DET,
*                                       --detector ID in each calibration table
*                                       --(PA = pre-amp, HV = high voltage
*                                       --factor, CV = CVC offset, DT = dead
*                                       --time, DM = dummy, DK = dark signal,
*                                       --GN = gain factor, SN = relative
*                                       --sensitivity)
     :                          PADET(1), HVDET(1), GNDET(1),
     :                          CVDET(1), DTDET(1), DKDET(1),
*                                       --number of rows in dark aperture
*                                       --translation table
     :                          NDKAP,
*                                       --number of rows in aperture area table
     :                          NAREA,
*                                       --number of data entries in each
*                                       --calibration table
     :                          NDK, NHV, NPA, NSN, NGN, NCV, NDT
*                                       --observation ID
        CHARACTER*(*)           OBSID,
*                                       --output file name
     :                          OFILE,
*                                       --aperture ID of input data
     :                          APERT,
*                                       --aperture names and dark aperture names
*                                       --in the dark aperture translation table
     :                          DKAP(1), DKNAME(1),
*                                       --aperture names in the aperture area
*                                       --table
     :                          AREAAP(1),
*                                       --aperture names in each calibration table
     :                          DKAPER(1), SNAPER(1),
*                                       --point source flag
     :                          PTFLAG,
*                                       --calibration switches
     :                          DEADSW, CNTSW, PHCSW,
*                                       --data type
     :                          TYPE,
*                                       --data types of each calibration table
     :                          DKTYPE(1), PATYPE(1), HVTYPE(1)
*                                       --DEA and detector temperatures
        REAL                    DEATMP, DETTMP,
*                                       --high voltage setting of input data
     :                          HV,
*                                       --high voltage settings in each
*                                       --calibration table
     :                          DKHV(1), HVHV(1), DTHV(1),
*                                       --gain setting of input data
     :                          GAIN,
*                                       --gain settings in each calibration table
     :                          GNGAIN(1), CVGAIN(1),
*                                       --discriminator threshold setting of
*                                       --input data
     :                          DISCR,
*                                       --discriminator threshold settings in
*                                       --the dead time calibration table
     :                          DTDISC(1),
*                                       --aperture area in the aperture area table
     :                          AREA(1),
*                                       --sample time
     :                          SMPTM
*                                       --base values of each calibration table
        REAL                    DKBASE(1), PABASE(1), HVBASE(1),
*                                       --relative sensitivity has two base
*                                       --values for each set of coefficients
     :                          SNBSPT(1), SNBSEX(1),
     :                          GNBASE(1), CVBASE(1),
     :                          DTBASE(1),
*                                       --polynominal coefficients of calibration
     :                          DKCOFF(16,1), PACOFF(16,1),
     :                          HVCOFF(16,1), SNCOFF(16,1),
     :                          GNCOFF(16,1), CVCOFF(16,1),
*                                       --deadtime temperature dependent coeff
     :                          DTCOFF(1),
*                                       --zero points of temperature in each
*                                       --calibration table
     :                          DKTMP0(1), PATMP0(1), HVTMP0(1),
     :                          SNTMP0(1), GNTMP0(1), CVTMP0(1),
     :                          DTTMP0(1)
*                                       --mean epoch
        DOUBLE PRECISION        EPOCH,
*                                       --zero points of epoch in each
*                                       --calibration table
     :                          DKEP0(1), PAEP0(1), HVEP0(1),
     :                          SNEP0(1), GNEP0(1), CVEP0(1)
*
*== output:
*                                       --error status
        INTEGER                 STATUS
*
*== local:
*                                       --return status
        INTEGER                 STAT(30), STATOK,
*                                       --pointer of output file
     :                          OUTMID,
*                                       --number of sections and number of
*                                       --points in last section
     :                          NSECT, REMAIN,
*                                       --loop indices
     :                          I, J, K, NP, XMIN, XMAX
*                                       --calibration corrections
        REAL                    DARK, PREAMP, HVFACT, RELSEN, GNFACT,
     :                          CVC, DEADTM, APSIZE
        REAL                    YMIN, YMAX
*                                       --correction dummies
        DOUBLE PRECISION        CORR1, CORR2, CORR3, CORR4, X
*                                       --header keywords
        CHARACTER*8             KEYWD(10)
*                                       --count rate unit
        CHARACTER*16            BUNIT
*                                       --error message context
        CHARACTER*130           CONTXT, MESS
*==========================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)
*
*     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===========================================
*-------------------------------------------------------------------------------
*
*  initialize output keyword values
*
        APSIZE = 0.
        DEADTM = 0.
        DARK = 0.
        PREAMP = 0.
        HVFACT = 0.
        RELSEN = 0.
        GNFACT = 0.
        CVC = 0.
*
*  divide up data into large sections (chunks)
*
        NSECT = NPTS / CHUNK + 1
        REMAIN = MOD (NPTS, CHUNK)
*
*  header keywords
*
        KEYWD(1) = 'APERAREA'
        KEYWD(2) = 'BUNIT'
        KEYWD(3) = 'DARKRATE'
        KEYWD(4) = 'PRE_AMP'
        KEYWD(5) = 'HIGHVOLT'
        KEYWD(6) = 'PT_EFFIC'
        BUNIT = 'CT/S'
        IF (PTFLAG(1:1) .EQ. 'E') THEN
            KEYWD(6) = 'EX_EFFIC'
            BUNIT = 'CT/S/ARCSEC**2'
        END IF
*
*  check the sample time to be non-zero
*
        IF (TYPE(1:7) .EQ. 'DIGITAL' .AND. SMPTM .LE. 0.) THEN
            STATUS = ERRNUM(1)
            CONTXT = 'zero or negative sample time'
            GO TO 999
        END IF
*
*  create the output file by using the input file as a template
*
        CALL UIMOPC (OFILE, INMID,   OUTMID, STATUS)
        IF (STATUS .NE. OK) THEN
            CONTXT = 'cannot create the output file ' // OFILE
            GO TO 999
        END IF
*  calculate the synthetic photometry quantities
*
	CALL VSYNPH (OBSID, INMID, OUTMID, APERT, DET,    STATOK)
*
*  read aperture size
*
        IF (PTFLAG(1:1) .EQ. 'E') THEN
            CALL VASIZE (OBSID, APERT, AREAAP, AREA, NAREA,   APSIZE,
     :                  STATUS)
            IF (STATUS .NE. OK) THEN
                CONTXT = 'cannot get aperture area'
                GO TO 997
            END IF
*
            IF (APSIZE .LE. 0.) THEN
                STATUS = ERRNUM(1)
                CONTXT = 'aperture area is non-positive'
                GO TO 997
            END IF
*
*  fill in aperture size keyword value
*
            CALL UHDPSR (OUTMID, 'APERAREA', APSIZE,      STATUS)
            IF (STATUS .NE. OK) THEN
                CONTXT = 'cannot update keyword APERAREA'
                GO TO 997
            END IF
        END IF
*
*  get deadtime
*
        IF (TYPE(1:7) .EQ. 'DIGITAL' .AND.
     :              DEADSW(1:7) .EQ. 'PERFORM') THEN
*
            CALL VDTEVL (OBSID, DET, HV, DISCR, DETTMP,
     :                   DTDET, DTHV, DTDISC, DTBASE, DTCOFF, DTTMP0,
     :                   NDT,     DEADTM, STATUS)
*
            IF (STATUS .NE. OK) THEN
                CONTXT = 'error getting deadtime'
                GO TO 997
            END IF
*
*  fill in deadtime keyword value
*
            CALL UHDPSR (OUTMID, 'DEADTM', DEADTM,      STATUS)
            IF (STATUS .NE. OK) THEN
                CONTXT = 'cannot update keyword DEADTM'
                GO TO 997
            END IF
        END IF
*
*  get calibration correction factors for digital data type
*
        IF (TYPE(1:7) .EQ. 'DIGITAL' .AND.
     :              CNTSW(1:7) .EQ. 'PERFORM') THEN
            CALL VDKEVL (OBSID, DET, APERT, HV, TYPE, DETTMP, EPOCH,
     :                   DKAPER, DKHV, DKTYPE, DKBASE, DKCOFF, DKTMP0,
     :                   DKEP0, NDK,
     :                   DKAP, DKDET, DKNAME, NDKAP,      DARK, STAT(3))
            CALL VPAEVL (OBSID, DET, TYPE, DEATMP, EPOCH,
     :                   PADET, PATYPE, PABASE, PACOFF, PATMP0,
     :                   PAEP0, NPA,      PREAMP, STAT(4))
            CALL VHVEVL (OBSID, DET, HV, TYPE, DETTMP, EPOCH,
     :                   HVDET, HVHV, HVTYPE, HVBASE, HVCOFF, HVTMP0,
     :                   HVEP0, NHV,      HVFACT, STAT(5))
            CALL VSNEVL (OBSID, APERT, PTFLAG, DETTMP, EPOCH,
     :                   SNAPER, SNBSPT, SNBSEX, SNCOFF, SNTMP0,
     :                   SNEP0, NSN,     RELSEN, STAT(6))
*
            DO 10 I = 3, 6
                IF (STAT(I) .NE. OK) THEN
                    STATUS = ERRNUM(2)
                    CONTXT = 'cannot get digital calibration factor(s) '
     :                          // KEYWD(I)
                    GO TO 997
                END IF
   10       CONTINUE
*
            CORR1 = DBLE (DARK + PREAMP)
            CORR2 = DBLE (HVFACT * RELSEN)
*
*  check non-zero denominator
*
            IF (CORR2 .EQ. 0.D0) THEN
                STATUS = ERRNUM(3)
                CONTXT = 'relative sensitivity or high volatge factor '
     :                          // 'is 0'
                GO TO 997
            END IF
*
*  fill in calibration values used
*
            CALL UHDPST (OUTMID, KEYWD(2), BUNIT,   STAT(2))
            CALL UHDPSR (OUTMID, KEYWD(3), DARK,    STAT(3))
            CALL UHDPSR (OUTMID, KEYWD(4), PREAMP,  STAT(4))
            CALL UHDPSR (OUTMID, KEYWD(5), HVFACT,  STAT(5))
            CALL UHDPSR (OUTMID, KEYWD(6), RELSEN,  STAT(6))
*
            DO 20 I = 2, 6
                IF (STAT(I) .NE. OK) THEN
                    CONTXT = 'cannot update header keyword ' // KEYWD(I)
                    STATUS = ERRNUM(4)
                    GO TO 997
                END IF
   20       CONTINUE
        END IF
*
*  get calibration correction factors for analog data type
*
        IF (TYPE(1:6) .EQ. 'ANALOG' .AND.
     :              PHCSW(1:7) .EQ. 'PERFORM') THEN
*
            CALL VDKEVL (OBSID, DET, APERT, HV, TYPE, DETTMP, EPOCH,
     :                   DKAPER, DKHV, DKTYPE, DKBASE, DKCOFF, DKTMP0,
     :                   DKEP0, NDK,
     :                   DKAP, DKDET, DKNAME, NDKAP,      DARK, STAT(3))
            CALL VPAEVL (OBSID, DET, TYPE, DEATMP, EPOCH,
     :                   PADET, PATYPE, PABASE, PACOFF, PATMP0,
     :                   PAEP0, NPA,      PREAMP, STAT(4))
            CALL VHVEVL (OBSID, DET, HV, TYPE, DETTMP, EPOCH,
     :                   HVDET, HVHV, HVTYPE, HVBASE, HVCOFF, HVTMP0,
     :                   HVEP0, NHV,      HVFACT, STAT(5))
            CALL VSNEVL (OBSID, APERT, PTFLAG, DETTMP, EPOCH,
     :                   SNAPER, SNBSPT, SNBSEX, SNCOFF, SNTMP0,
     :                   SNEP0, NSN,     RELSEN, STAT(6))
            CALL VGNEVL (OBSID, DET, GAIN, DEATMP, EPOCH,
     :                   GNDET, GNGAIN, GNBASE, GNCOFF, GNTMP0,
     :                   GNEP0, NGN,      GNFACT, STAT(7))
            CALL VCVEVL (OBSID, DET, GAIN, DEATMP, EPOCH,
     :                   CVDET, CVGAIN, CVBASE, CVCOFF, CVTMP0,
     :                   CVEP0, NCV,      CVC, STAT(8))
*
            KEYWD(7) = 'TUBEGAIN'
            KEYWD(8) = 'CVCOFSET'
*
            DO 30 I = 3, 8
                IF (STAT(I) .NE. OK) THEN
                    STATUS = ERRNUM(2)
                    CONTXT = 'cannot get analog calibration factor(s) '
     :                          // KEYWD(I)
                    GO TO 997
                END IF
   30       CONTINUE
*
            CORR1 = DBLE (CVC)
            CORR2 = DBLE (GNFACT)
            CORR3 = DBLE (DARK + PREAMP)
            CORR4 = DBLE (HVFACT * RELSEN)
*
*  check non-zero denominator
*
            IF (CORR2 .EQ. 0.D0 .OR. CORR4 .EQ. 0.D0) THEN
                STATUS = ERRNUM(3)
                CONTXT = 'relative sensitivity or high volatge factor '
     :                          // ' or gain factor is 0'
                GO TO 997
            END IF
*
*  fill in calibration values used
*
            CALL UHDPST (OUTMID, KEYWD(2), BUNIT,   STAT(2))
            CALL UHDPSR (OUTMID, KEYWD(3), DARK,    STAT(3))
            CALL UHDPSR (OUTMID, KEYWD(4), PREAMP,  STAT(4))
            CALL UHDPSR (OUTMID, KEYWD(5), HVFACT,  STAT(5))
            CALL UHDPSR (OUTMID, KEYWD(6), RELSEN,  STAT(6))
            CALL UHDPSR (OUTMID, KEYWD(7), GNFACT,  STAT(7))
            CALL UHDPSR (OUTMID, KEYWD(8), CVC,     STAT(8))
*
            DO 40 I = 2, 8
                IF (STAT(I) .NE. OK) THEN
                    CONTXT = 'cannot update header keyword ' // KEYWD(I)
                    STATUS = ERRNUM(4)
                    GO TO 997
                END IF
   40       CONTINUE
        END IF
*
*  read input data and mask to the dynamic memory
*
        DO 60 J = 1, NSECT
            XMIN = (J-1) * CHUNK + 1
            XMAX = J * CHUNK
            IF (J .EQ. NSECT) XMAX = NPTS
*
            CALL UIGS1R (INMID, XMIN, XMAX,    MEMR(IP), STAT(1))
            CALL UIGS1R (MSKID, XMIN, XMAX,    MEMR(MP), STAT(2))
*
            IF (STAT(1) .NE. OK .OR. STAT(2) .NE. OK) THEN
                STATUS = ERRNUM(1)
                CONTXT = 'cannot read data from input file or mask'
                GO TO 997
            END IF
*
*  perform the correction point by point
*
            NP = CHUNK
            IF (J .EQ. NSECT) NP = REMAIN
*
            DO 50 I = 1, NP
		K = IP + I - 1
*
*  do nothing if mask is not zero
*
                IF (MEMR(MP+I-1) .NE. 0.) GO TO 50
*
*  deadtime correction
*  only for digital data with DEADTIME switch set to 'PERFORM'
*
                IF (TYPE(1:7) .EQ. 'DIGITAL' .AND.
     :              DEADSW(1:7) .EQ. 'PERFORM') THEN
*
*  convert to double precision first
*
                    X = DBLE(MEMR(K))
*
*  convert from counts to count rates
*
                    X = X / DBLE(SMPTM)
*
                    MEMR(K) = REAL(X / (1.D0 - X * DBLE(DEADTM)))
                END IF
*
*  true digital count rate correction
*
*  only for digital data with TRUE_CNT switch set to 'PERFORM'
*
                IF (TYPE(1:7) .EQ. 'DIGITAL' .AND.
     :              CNTSW(1:7) .EQ. 'PERFORM') THEN
*
*  convert to double precision first
*
                    X = DBLE(MEMR(K))
*
*  convert from counts to count rates, if not done yet
*
                    IF (DEADSW(1:7) .NE. 'PERFORM')  X = X / DBLE(SMPTM)
*
                    MEMR(K) = REAL ((X - CORR1) / CORR2)
                END IF
*
*  true analog photocurrent calculations
*
*  only for analog data with TRUE_PHC switch set to 'PERFORM'
*
                IF (TYPE(1:6) .EQ. 'ANALOG' .AND.
     :              PHCSW(1:7) .EQ. 'PERFORM') THEN
*
*  convert to double precision first
*
                    X = DBLE(MEMR(K))
*
                    MEMR(K) = REAL (((X - CORR1) / CORR2 - CORR3) /
     :                          CORR4)
                END IF
*
*  divide the count rate by the aperture area in extended target case
*
                IF (PTFLAG(1:1) .EQ. 'E') THEN
                    MEMR(K) = MEMR(K) / APSIZE
                END IF
*
*  determine min and max 
*
            	IF (J .EQ. 1 .AND. I .EQ. 1) THEN
		    YMIN = MEMR(IP)
		    YMAX = MEMR(IP)
	        END IF
		IF (MEMR(K) .GT. YMAX) YMAX = MEMR(K)
		IF (MEMR(K) .LT. YMIN) YMIN = MEMR(K)
   50       CONTINUE
*
*  put corrected data back to the file
*
            CALL UIPS1R (OUTMID, XMIN, XMAX, MEMR(IP),   STATUS)
            IF (STATUS .NE. OK) THEN
                CONTXT = 'error putting data back to the file'
                GO TO 997
            END IF
   60   CONTINUE
*
*  update calibration switch(es) in the header
*
        IF (TYPE(1:7) .EQ. 'DIGITAL' .AND. DEADSW(1:7) .EQ. 'PERFORM')
     :      CALL UHDPST (OUTMID, 'DEADTIME', 'COMPLETE',    STATUS)
        IF (STATUS .NE. OK) THEN
            CONTXT = 'cannot update header keyword DEADTIME'
            GO TO 997
        END IF
*
        IF (TYPE(1:7) .EQ. 'DIGITAL' .AND. CNTSW(1:7) .EQ. 'PERFORM')
     :      CALL UHDPST (OUTMID, 'TRUE_CNT', 'COMPLETE',    STATUS)
        IF (STATUS .NE. OK) THEN
            CONTXT = 'cannot update keyword TRUE_CNT'
            GO TO 997
        END IF
*
        IF (TYPE(1:6) .EQ. 'ANALOG' .AND. PHCSW(1:7) .EQ. 'PERFORM')
     :      CALL UHDPST (OUTMID, 'TRUE_PHC', 'COMPLETE',    STATUS)
        IF (STATUS .NE. OK) THEN
            CONTXT = 'cannot update keyword TRUE_PHC'
            GO TO 997
        END IF
*
*  update the min and max of output file
*
        CALL UUSMMX (OUTMID, YMIN, YMAX)
*
*  close the output file
*
        CALL UIMCLO (OUTMID,        STATUS)
        IF (STATUS .NE. OK) THEN
            CONTXT = 'cannot close output file'
            GO TO 999
        END IF
*
        CONTXT = OBSID // '  generated calibrated file ' // OFILE
        CALL UMSPUT (CONTXT, DEST, PRIO,      STATOK)
*
        STATUS = OK
        GO TO 1000
*
*  write (dummy) pixels to output file ,close, and delete output file
*
  997   DO 998 J = 1, NSECT
            XMIN = (J-1) * CHUNK + 1
            XMAX = J * CHUNK
            IF (J .EQ. NSECT) XMAX = REMAIN
            CALL UIPS1R (OUTMID, XMIN, XMAX, MEMR(IP),   STATOK)
  998   CONTINUE
*
        CALL UIMCLO (OUTMID,     STATOK)
        CALL UIMDEL (OFILE,      STATOK)
*
*  write error message
*
  999   MESS = OBSID // '  VPPCOR: ' // CONTXT
        CALL UMSPUT (MESS, DEST, PRIO,      STATOK)
*
 1000   RETURN
        END
