        SUBROUTINE VPPACR (
*
*  inputs
*
     :                  TABLE, TYPE,
*
*  outputs
*
     :                  STATUS)
*
*  Module number: polpav
*
*  Module name:
*
*  Keyphrase:
*  ----------
*  calculate corrected count rates for polarization position angle offset
*  calibration
*
*  Description:
*  ------------
*
*  FORTRAN name: VPPACR.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
*  'SENSITIV'                    I      relative sensitivity
*  'SENSITIV_ERR'                I      relative sensitivity'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 mean error
*  'DOBJ_C'                      I      corrected digital count rate
*  'DOBJ_ERR_C'                  I      corrected digital count rate's mean error
*
*  Subroutines Called:
*  -------------------
*  CDBS:
*       CDTIN
*  SDAS:
*       UULOWC, UTRGTR, UTRPTR, UTTCLO, UMSPUT
*  Others:
*       None
*
*  History:
*  --------
*  Version      Date        Author          Description
*     1       01-05-90     J.-C. HSU        replace tcalc
*-------------------------------------------------------------------------------
*
*== input:
*                                       --input (=output) table name
        CHARACTER*(*)           TABLE,
*                                       --dat type
     :                          TYPE
*                                       --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, SN, SNERR,
     :                          A, B, C, D, E, F,
     :                          DASQ, DBSQ, DCSQ, DDSQ, DESQ, DFSQ
*                                       --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
*
*  analog data type only
*
        IF (TYPE(1:1) .EQ. 'A') THEN
            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'
            COLNAM(13) = 'SENSITIV'
            COLNAM(14) = 'SENSITIV_ERR'
            NCOLS = 14
*
*  digital data only
*
        ELSE IF (TYPE(1:1) .EQ. 'D') THEN
            COLNAM(1) = 'DOBJ'
            COLNAM(2) = 'DOBJ_ERR'
            COLNAM(3) = 'DARK_D'
            COLNAM(4) = 'DARK_D_ERR'
            COLNAM(5) = 'PREAMP_D'
            COLNAM(6) = 'PREAMP_D_ERR'
            COLNAM(7) = 'HVFACT_D'
            COLNAM(8) = 'HVFACT_D_ERR'
            COLNAM(9) = 'DEADTIME'
            COLNAM(10) = 'DEADTIME_ERR'
            COLNAM(11) = 'SENSITIV'
            COLNAM(12) = 'SENSITIV_ERR'
            NCOLS = 12
        END IF
*
*  define output columns
*
        IF (TYPE(1:1) .EQ. 'A') THEN
            COLNAM(NCOLS+1) = 'AOBJ_C'
            COLNAM(NCOLS+2) = 'AOBJ_ERR_C'
            OCOLS = NCOLS + 2
        ELSE IF (TYPE(1:1) .EQ. 'D') THEN
            COLNAM(NCOLS+1) = 'DOBJ_C'
            COLNAM(NCOLS+2) = 'DOBJ_ERR_C'
            OCOLS = NCOLS + 2
        END IF
*
*  define column unit and display format
*
        DO 10 I = 1, OCOLS
            DTYPE(I) = TYREAL
            UNIT(I) = ' '
            COLFMT(I) = ' '
   10   CONTINUE
*
*  set up the 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
*
                IF (TYPE(1:1) .EQ. 'A') 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)
                    SN = COLBUF(13)
                    SNERR = COLBUF(14)
*
*  calculate corrected analog count rate
*
                    IF (GN .LE. 0.) THEN
                        STATUS = ERRNUM(1)
                        CONTXT = 'gain factor <=0'
                        GO TO 999
                    END IF
*
                    IF (HVA .LE. 0.   .OR.   SN .LE. 0.) THEN
                        STATUS = ERRNUM(1)
                        CONTXT = 'analog high voltage factor or '
     :                          // 'relative sensitivity <=0'
                        GO TO 999
                    END IF
*
                    A = CTA - CVC
                    B = A / GN
                    C = B - PAA - DKA
                    D = C / HVA
                    E = D / SN
                    DASQ = CTAERR**2 + CVCERR**2
                    DBSQ = DASQ / GN**2 + (B*GNERR/GN)**2
                    DCSQ = DBSQ + PAAERR**2 + DKAERR**2
                    DDSQ = DCSQ / HVA**2 + (D*HVAERR/HVA)**2
                    DESQ = DDSQ / SN**2 + (E*SNERR/SN)**2
*
*  write the result to the input table
*
                    CALL UTRPTR (TP, COLIDN(NCOLS+1), 1, I,
     :                           REAL(E),   STAT(1))
                    CALL UTRPTR (TP, COLIDN(NCOLS+2), 1, I,
     :                           REAL(SQRT(DESQ)), STAT(2))
*
                ELSE IF (TYPE(1:1) .EQ. 'D') THEN
                    CTD = COLBUF(1)
                    CTDERR = COLBUF(2)
                    DKD = COLBUF(3)
                    DKDERR = COLBUF(4)
                    PAD = COLBUF(5)
                    PADERR = COLBUF(6)
                    HVD = COLBUF(7)
                    HVDERR = COLBUF(8)
                    DT = COLBUF(9)
                    DTERR = COLBUF(10)
                    SN = COLBUF(11)
                    SNERR = COLBUF(12)
*
*  calculate corrected digitl count rate
*
                    A = CTD * DT
                    B = 1.D0 - A
                    IF (HVD .LE. 0.   .OR.   SN .LE. 0.) THEN
                        STATUS = ERRNUM(1)
                        CONTXT = 'digital high voltage factor or '
     :                          // 'relative sensitivity <=0'
                        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
                    F = E / SN
                    DCSQ = (CTDERR**2 + C**4 * DTERR**2) / B**4
                    DDSQ = DCSQ + DKDERR**2 + PADERR**2
                    DESQ = DDSQ / HVD**2 + (E*HVDERR/HVD)**2
                    DFSQ = DESQ / SN**2 + (F*SNERR/SN)**2
*
*  write the result to the input table
*
                    CALL UTRPTR (TP, COLIDN(NCOLS+1), 1, I,
     :                            REAL(F),  STAT(1))
                    CALL UTRPTR (TP, COLIDN(NCOLS+2), 1, I,
     :                            REAL(SQRT(DFSQ)), STAT(2))
*
                END IF
*
                DO 40 J = 1, 2
                    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 the 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 = 'VPPACR: ' // CONTXT
        CALL UMSPUT (MESS, DEST, PRIO,   STATOK)
*
 1000   RETURN
        END
