SUBROUTINE VGTDT ( * * inputs * : OBSID, INTBL, DIM, * * output * : DET, HV, DISCR, BASE, COEFF, TEMP0, : NROWS, STATUS) * * Module Number: * * Module Name: * * Keyphrase: * ---------- * Read the dead time calibration table * * Description: * ------------ * * FORTRAN Name: VGTDT.FOR * * Keywords of Accessed Files and Tables: * -------------------------------------- * Name I/O Description / Comments * * column names of the input table: * * 'DET_NUM' I detector ID * 'VOLTAGE' I high voltage setting * 'THRESH' I discriminator threshold setting * 'BASE_VALUE' I dead time base value * 'A1' I temperature dependency coefficiency of * the deadtime * 'BASE_TEMP' I base temperature * * Subroutines Called: * ------------------- * CDBS: * VCDTIN * SDAS: * UTRGTR, UTRGTD, UTRGTT, UTRGTI, UTTCLO, UMSPUT * OTHERS: * None * * History: * -------- * Version Date Author Description * 1 08-01-88 J.-C. Hsu Design and coding * 2 08-11-89 J.-C. Hsu temperature dependent dead time * 3 11-15-89 J.-C. Hsu pass OBSID *------------------------------------------------------------------------------- * *== input: * --observation ID CHARACTER*(*) OBSID, * --input table name : INTBL * --maximum number of rows allowed for * --the input table INTEGER DIM * *== output: * --detector ID INTEGER DET(1), * --number of rows in the calibration table : NROWS, * --error status : STATUS * --high voltage setting REAL HV(1), * --discriminator threshold setting : DISCR(1), * --dead time base value : BASE(1), * --temperature dependent coefficients : COEFF(1), * --base temperature : TEMP0(1) * *== local: * CHARACTER*5 CHAR5 * --column names of input table CHARACTER*16 COLNAM(30) * --error message context CHARACTER*130 CONTXT, MESS * --number of columns INTEGER NCOLS, * --table pointer : TP, * --table column ID : COLIDN(30), * --error status : STAT(30), STATOK, * --loop indices : I, J LOGICAL NULMSK(30) *=========================begin hsp.inc========================================= * --status return code INTEGER OK, ERRNUM(20) 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/ * --message destination and priority DATA DEST, PRIO /1, 0/ *=========================end hsp.inc=========================================== *------------------------------------------------------------------------------- * * column names of the input table * COLNAM(1) = 'DET_NUM' COLNAM(2) = 'VOLTAGE' COLNAM(3) = 'THRESH' COLNAM(4) = 'BASE_VALUE' COLNAM(5) = 'A1' COLNAM(6) = 'BASE_TEMP' NCOLS = 6 * * set up input table * CALL VCDTIN (INTBL, COLNAM, NCOLS, TP, COLIDN, NROWS, STATUS) IF (STATUS .NE. OK) THEN CONTXT = 'cannot set up table ' // INTBL GO TO 999 END IF * * warning if there is no data or if the number of rows is over the maximum * limit * IF (NROWS .LT. 1 .OR. NROWS .GT. DIM) THEN WRITE (CHAR5, '(I5)') DIM CONTXT = '# of rows is 0 or > ' // CHAR5 // ' in table ' // : INTBL STATUS = ERRNUM(1) GO TO 999 END IF * * read the input table row by row * DO 30 I = 1, NROWS CALL UTRGTI (TP, COLIDN(1), 1, I, : DET(I), NULMSK(1), STAT(1)) CALL UTRGTR (TP, COLIDN(2), 1, I, : HV(I), NULMSK(2), STAT(2)) CALL UTRGTR (TP, COLIDN(3), 1, I, : DISCR(I), NULMSK(3), STAT(3)) CALL UTRGTR (TP, COLIDN(4), 1, I, : BASE(I), NULMSK(4), STAT(4)) CALL UTRGTR (TP, COLIDN(5), 1, I, : COEFF(I), NULMSK(5), STAT(5)) CALL UTRGTR (TP, COLIDN(6), 1, I, : TEMP0(I), NULMSK(6), STAT(6)) * * check status * DO 30 J = 1, NCOLS IF (STAT(J) .NE. OK) THEN WRITE (CHAR5, '(I5)') I STATUS = ERRNUM(1) CONTXT = 'cannot read row ' // CHAR5 // ' of table ' : // INTBL GO TO 999 END IF 30 CONTINUE * * check null mask, if there is a null value, set deadtime of that * row to zero and continue * DO 40 J = 1, NCOLS IF (NULMSK(J)) THEN BASE(I) = 0. COEFF(I) = 0. TEMP0(I) = 0. GO TO 50 END IF 40 CONTINUE 50 CONTINUE * * close table * CALL UTTCLO (TP, STATUS) IF (STATUS .NE. OK) THEN CONTXT = 'cannot close table ' // INTBL GO TO 999 END IF * STATUS = OK GO TO 1000 * * write error message * 999 MESS = OBSID // ' VGTDT: ' // CONTXT CALL UMSPUT (MESS, DEST, PRIO, STATOK) * 1000 RETURN END