SUBROUTINE VREFAP ( * * outputs * : FILTER, APERT, NPTS, STATUS) * * Module Number: 15.8.3 * * Module Name: relsen * * Keyphrase: * ---------- * input reference aperture names for each filter of HSP * * Description: * ------------ * Read reference aperture names for all filters from a table. These * are reference apertures for the relative sensitivity calibration. * * FORTRAN Name: VREFAP.FOR * * Keywords of Accessed Files and Tables: * -------------------------------------- * Name I/O Description / Comments * * CL parameter * * 'ref_aper' I reference aperture table name * * column names in the reference aperture table * * 'FILTER_NAME' I filter name * 'REF_APER' I reference aperture name * * Subroutines Called: * ------------------- * CDBS: * CDTIN * SDAS: * UCLGST, UTRGTR, UTRGTI, UTTCLO, UMSPUT * OTHERS: * None * * History: * -------- * Version Date Author Description * 1 05-30-86 J.-C. Hsu Design and coding * 2 10-05-87 J.-C. Hsu F77 standard *------------------------------------------------------------------------------- * *== output: * --filter name and reference aperture CHARACTER*(*) FILTER(1), APERT(1) * --number of entries in the table INTEGER NPTS, * --error status : STATUS * *== local: * --loop index INTEGER I, * --number of rows and columns : NROWS, NCOLS, * --error status : STAT(10), STATOK, * --table pointer and column ID : TP, COLIDN(10) LOGICAL NULMSK(10) CHARACTER*5 CHAR5 * --column names CHARACTER*16 COLNAM(10) * --table name CHARACTER*128 TBNAME * --error message context CHARACTER*130 CONTXT, MESS *=========================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=========================================== *------------------------------------------------------------------------------- * * initialization * NPTS = 0 * * read reference aperture table name from the CL parameter * CALL UCLGST ('ref_aper', TBNAME, STATUS) IF (STATUS .NE. OK) THEN CONTXT = 'cannot get reference aperture table keyword ' : // 'name' GO TO 999 END IF * * define reference aperture table column names * COLNAM(1) = 'FILTER_NAME' COLNAM(2) = 'REF_APER' NCOLS = 2 * * set up the reference aperture table * CALL CDTIN (TBNAME, COLNAM, NCOLS, TP, COLIDN, NROWS, STATUS) IF (STATUS .NE. OK) THEN CONTXT = 'cannot set up reference aperture table' GO TO 999 END IF * * read the reference aperture table row by row * DO 10 I = 1, NROWS CALL UTRGTT (TP, COLIDN(1), 1, I, : FILTER(I), NULMSK(1), STAT(1)) CALL UTRGTT (TP, COLIDN(2), 1, I, : APERT(I), NULMSK(2), STAT(2)) IF (STAT(1) .EQ. OK .AND. STAT(2) .EQ. OK .AND. : (.NOT. NULMSK(1)) .AND. (.NOT. NULMSK(2))) THEN NPTS = NPTS + 1 FILTER(NPTS) = FILTER(I) APERT(NPTS) = APERT(I) ELSE WRITE (CHAR5, '(I5)') I CONTXT = 'error reading reference aperture table at ' : // 'row #' // CHAR5 CALL UMSPUT (CONTXT, DEST, PRIO, STATOK) END IF 10 CONTINUE * * close the reference aperture table * CALL UTTCLO (TP, STATUS) IF (STATUS .NE. OK) THEN CONTXT = 'cannot close reference aperture table' GO TO 999 END IF * * check if there is any reference aperture data * IF (NPTS .EQ. 0.) THEN STATUS = ERRNUM(1) CONTXT = 'no data in reference aperture table' GO TO 999 END IF * STATUS = OK GO TO 1000 * * write error message * 999 MESS = 'VREFAP: ' // CONTXT CALL UMSPUT (MESS, DEST, PRIO, STATOK) * 1000 RETURN END