SUBROUTINE VGTDKA ( * * inputs * : OBSID, INTBL, DIM, * * output * : APERT, DET, DKAPER, NROWS, STATUS) * * Module Number: * * Module Name: * * Keyphrase: * ---------- * Read the dark aperture translation table * * Description: * ------------ * * FORTRAN Name: VGTDKA.FOR * * Keywords of Accessed Files and Tables: * -------------------------------------- * Name I/O Description / Comments * * column names of the input table: * * 'APER_NAME' I "regular" aperture name * 'DET_NUM' I detector ID * 'DARK_APER' I "dark" aperture name * * Subroutines Called: * ------------------- * CDBS: * VCDTIN * SDAS: * UTRGTT, UTTCLO, UMSPUT * OTHERS: * None * * History: * -------- * Version Date Author Description * 1 08-01-88 J.-C. Hsu Design and coding * 2 07-20-89 J.-C. Hsu Add detector ID as a column * 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: * --aperture names CHARACTER*(*) APERT(1), * --dark aperture names : DKAPER(1) * --number of rows in the calibration table INTEGER NROWS, * --detector ID : DET(1), * --error status : STATUS * *== 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) = 'APER_NAME' COLNAM(2) = 'DET_NUM' COLNAM(3) = 'DARK_APER' NCOLS = 3 * * 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 UTRGTT (TP, COLIDN(1), 1, I, : APERT(I), NULMSK(1), STAT(1)) CALL UTRGTI (TP, COLIDN(2), 1, I, : DET(I), NULMSK(2), STAT(2)) CALL UTRGTT (TP, COLIDN(3), 1, I, : DKAPER(I), NULMSK(3), STAT(3)) * * check status and null mask * DO 30 J = 1, 3 IF (STAT(J) .NE. OK .OR. NULMSK(J)) THEN WRITE (CHAR5, '(I5)') I STATUS = ERRNUM(1) CONTXT = 'cannot read row ' // CHAR5 // ' of table ' : // INTBL GO TO 999 END IF 30 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 // ' VGTDKA: ' // CONTXT CALL UMSPUT (MESS, DEST, PRIO, STATOK) * 1000 RETURN END