        SUBROUTINE VGNCR (
*
*  inputs
*
     :                  TABLE, LEVEL,
*
*  outputs
*
     :                  STATUS)
*
*  Module number: 15.9.2.2.1
*
*  Module name: gainfac
*
*  Keyphrase:
*  ----------
*  calculate corrected count rates for gain factor calculation
*
*  Description:
*  ------------
*
*  FORTRAN name: VGNCR.FOR
*
*  Keywords of accessed files and tables:
*  --------------------------------------
*  Name                         I/O     Description / Comments
*
*       input table column names:
*
*  'AOBJ'                        I      analog measurement
*  'AOBJ_ERR'                    I      analog measurement's mean error
*  'DARK_A'                      I      analog dark count
*  'DARK_A_ERR'                  I      analog dark count's error
*  'PREAMP_A'                    I      analog pre-amp
*  'PREAMP_A_ERR'                I      analog pre-amp's error
*  'CVCOFFST'                    I      CVC offset
*  'CVCOFFST_ERR'                I      CVC offset's error
*  'GAINFACT'                    I      gain factor
*  'GAINFACT_ERR'                I      gain factor's error
*  'HVFACT_A'                    I      analog high voltage factor
*  'HVFACT_A_ERR'                I      analog high voltage factor's error
*
*  'DOBJ'                        I      digital count rate
*  'DOBJ_ERR'                    I      digital count rate's mean error
*  'DARK_D'                      I      digital dark count
*  'DARK_D_ERR'                  I      digital dark count's error
*  'PREAMP_D'                    I      digital pre-amp
*  'PREAMP_D_ERR'                I      digital pre-amp's error
*  'HVFACT_D'                    I      digital high voltage factor
*  'HVFACT_D_ERR'                I      digital high voltage factor's error
*  'DEADTIME'                    I      dead time
*  'DEADTIME_ERR'                I      dead time's error
*
*       output table column names:
*
*  'AOBJ_C'                      I      corrected analog count rate
*  'AOBJ_ERR_C'                    I      corrected analog count rate's error
*  'DOBJ_C'                      I      corrected digital count rate
*  'DOBJ_ERR_C'                    I      corrected digital count rate's error
*
*  Subroutines Called:
*  -------------------
*  CDBS:
*       CDTIN
*  SDAS:
*       UULOWC, UTRGTR, UTRPTR, UTTCLO, UMSPUT
*  Others:
*       None
*
*  History:
*  --------
*  Version      Date        Author          Description
*     1       09-12-89     J.-C. HSU        replace tcalc
*-------------------------------------------------------------------------------
*
*== input:
*                                       --input (=output) table name
        CHARACTER*(*)           TABLE,
*                                       --gain setting level keyword
     :                          LEVEL
*                                       --error status
        INTEGER                 STATUS
*
*== local:
*                                       --number of input data points
        INTEGER                 NROWS,
*                                       --pointer of table descripter and column
*                                       --identifier
     :                          TP, COLIDN(40),
*                                       --data type
     :                          DTYPE(40),
*                                       --loop indices, number of input columns
     :                          I, J, NCOLS, OCOLS,
*                                       --status
     :                          STAT(20), STATOK
*                                       --data buffer
        REAL                    COLBUF(40)
*                                       --dummies
        DOUBLE PRECISION        CTD, CTDERR, CTA, CTAERR, DKD, DKDERR,
     :                          DKA, DKAERR, PAD, PADERR, PAA, PAAERR,
     :                          HVD, HVDERR, HVA, HVAERR, CVC, CVCERR,
     :                          GN, GNERR, DT, DTERR,
     :                          A, B, C, D, E,
     :                          DASQ, DBSQ, DCSQ, DDSQ, DESQ
*                                       --column format
        CHARACTER*8             COLFMT(40)
*                                       --column names
        CHARACTER*16            COLNAM(40),
*                                       --column units
     :                          UNIT(40)
*                                       --error message context
        CHARACTER*130           CONTXT, MESS
*                                       --null flag in UTRGTR
        LOGICAL                 NULMSK(40)
*==========================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===========================================
*------------------------------------------------------------------------------
*
*  define input (=output) table column names
*
        COLNAM(1) = 'AOBJ'
        COLNAM(2) = 'AOBJ_ERR'
        COLNAM(3) = 'DARK_A'
        COLNAM(4) = 'DARK_A_ERR'
        COLNAM(5) = 'PREAMP_A'
        COLNAM(6) = 'PREAMP_A_ERR'
        COLNAM(7) = 'CVCOFFST'
        COLNAM(8) = 'CVCOFFST_ERR'
        COLNAM(9) = 'GAINFACT'
        COLNAM(10) = 'GAINFACT_ERR'
        COLNAM(11) = 'HVFACT_A'
        COLNAM(12) = 'HVFACT_A_ERR'
        NCOLS = 12
*
*  high gain setting only
*
        IF (LEVEL(1:1) .EQ. 'h') THEN
            COLNAM(13) = 'DOBJ'
            COLNAM(14) = 'DOBJ_ERR'
            COLNAM(15) = 'DARK_D'
            COLNAM(16) = 'DARK_D_ERR'
            COLNAM(17) = 'PREAMP_D'
            COLNAM(18) = 'PREAMP_D_ERR'
            COLNAM(19) = 'HVFACT_D'
            COLNAM(20) = 'HVFACT_D_ERR'
            COLNAM(21) = 'DEADTIME'
            COLNAM(22) = 'DEADTIME_ERR'
            NCOLS = 22
        END IF
*
*  output columns
*
        COLNAM(NCOLS+1) = 'AOBJ_C'
        COLNAM(NCOLS+2) = 'AOBJ_ERR_C'
        OCOLS = NCOLS + 2
        IF (LEVEL(1:1) .EQ. 'h') THEN
            COLNAM(NCOLS+3) = 'DOBJ_C'
            COLNAM(NCOLS+4) = 'DOBJ_ERR_C'
            OCOLS = NCOLS + 4
        END IF
*
*  column unit and format
*
        DO 10 I = 1, OCOLS
            DTYPE(I) = TYREAL
            UNIT(I) = ' '
            COLFMT(I) = ' '
   10   CONTINUE
*
*  set up input table
*
        CALL CDTOUT (TABLE, COLNAM, UNIT, COLFMT, DTYPE, OCOLS,    TP,
     :                  COLIDN, NROWS, STATUS)
        IF (STATUS .NE. OK) THEN
            CONTXT = 'error setting up input table'
            GO TO 999
        END IF
*
*  process row by row
*
        DO 50 I = 1, NROWS
            STATOK = OK
            CALL UTRGTR (TP, COLIDN, NCOLS, I,      COLBUF, NULMSK,
     :                   STATOK)
*
*  if error in UTRGTR or read null values, skip this row
*
            IF (STATOK .NE. OK) GO TO 30
*
            DO 20 J = 1, NCOLS
                IF (NULMSK(J)) THEN
                    STATOK = ERRNUM(4)
                    GO TO 30
                END IF
   20       CONTINUE
*
   30       CONTINUE
*
*  convert all quantities to double precision before arithmetic calculations
*
            IF (STATOK .EQ. OK)  THEN
                CTA = COLBUF(1)
                CTAERR = COLBUF(2)
                DKA = COLBUF(3)
                DKAERR = COLBUF(4)
                PAA = COLBUF(5)
                PAAERR = COLBUF(6)
                CVC = COLBUF(7)
                CVCERR = COLBUF(8)
                GN = COLBUF(9)
                GNERR = COLBUF(10)
                HVA = COLBUF(11)
                HVAERR = COLBUF(12)
*
*  calculate corrected analog count rate
*
                IF (HVA .LE. 0.) THEN
                    STATUS = ERRNUM(1)
                    CONTXT = 'analog high voltage factor is '
     :                          // 'non-positive'
                    GO TO 999
                END IF
*
                A = PAA + DKA
                B = GN * A
                C = CTA - CVC - B
                D = C / HVA
                DASQ = PAAERR**2 + DKA**2
                DBSQ = A**2 * GNERR**2 + GN**2 * DASQ
                DCSQ = CTAERR**2 + CVCERR**2 + DBSQ
                DDSQ = DCSQ / HVA**2 + (D*HVAERR/HVA)**2
*
*  write to input table
*
                CALL UTRPTR (TP, COLIDN(NCOLS+1), 1, I,
     :                        REAL(D),   STAT(1))
                CALL UTRPTR (TP, COLIDN(NCOLS+2), 1, I,
     :                        REAL(SQRT(DDSQ)), STAT(2))
                STAT(3) = OK
                STAT(4) = OK
*
                IF (LEVEL(1:1) .EQ. 'h') THEN
                    CTD = COLBUF(13)
                    CTDERR = COLBUF(14)
                    DKD = COLBUF(15)
                    DKDERR = COLBUF(16)
                    PAD = COLBUF(17)
                    PADERR = COLBUF(18)
                    HVD = COLBUF(19)
                    HVDERR = COLBUF(20)
                    DT = COLBUF(21)
                    DTERR = COLBUF(22)
*
*  calculate corrected digitl count rate
*
                    A = CTD * DT
                    B = 1.D0 - A
*
                    IF (HVD .LE. 0.) THEN
                        STATUS = ERRNUM(1)
                        CONTXT = 'digital high voltage factor is '
     :                           // 'non-positive'
                        GO TO 999
                    END IF
*
                    IF (B .LE. 0.) THEN
                        STATUS = ERRNUM(1)
                        CONTXT = 'dead time correction is '
     :                           // 'larger than one'
                        GO TO 999
                    END IF
*
                    C = CTD / B
                    D = C - DKD - PAD
                    E = D / HVD
                    DCSQ = (CTDERR**2 + C**4 * DTERR**2) / B**4
                    DDSQ = DCSQ + DKDERR**2 + PADERR**2
                    DESQ = DDSQ / HVD**2 + (E*HVDERR/HVD)**2
*
*  write to input table
*
                    CALL UTRPTR (TP, COLIDN(NCOLS+3), 1, I,
     :                            REAL(E),  STAT(3))
                    CALL UTRPTR (TP, COLIDN(NCOLS+4), 1, I,
     :                            REAL(SQRT(DESQ)), STAT(4))
*
                END IF
*
                DO 40 J = 1, 4
                    IF (STAT(J) .NE. OK) THEN
                        STATUS = ERRNUM(1)
                        CONTXT = 'cannot write to table ' // TABLE
                        GO TO 999
                    END IF
   40           CONTINUE
            END IF
   50   CONTINUE
*
*  close input table
*
        CALL UTTCLO (TP,    STATUS)
        IF (STATUS .NE. OK) THEN
            CONTXT = 'cannot close input table'
            GO TO 999
        END IF
*
        STATUS = OK
        GO TO 1000
*
*  write error message
*
  999   MESS = 'VGNCR: ' // CONTXT
        CALL UMSPUT (MESS, DEST, PRIO,   STATOK)
*
 1000   RETURN
        END
