SUBROUTINE VFLUX ( * * outputs * : TARGET, FILTER, DETID, FLUX, NPTS, : STATUS) * * Module Number: 15.9.1.2 * * Module Name: abssenv * * Keyphrase: * ---------- * Read the table containing flux densities of standard targets. * * Description: * ------------ * Get flux densities (integrated over the designated filter bandpass) of * standard targets. Each standard target can have up to 5 different names. * Maximum number of entries in the reference flux table is 5000. * * FORTRAN Name: VFLUX.FOR * * Keywords of Accessed Files and Tables: * -------------------------------------- * Name I/O Description / Comments * * keyword input from PAR file: * * 'ref_flux' I table name containing reference flux * * Column names in REF_FLUX: * * 'OBJ_NAME_1', 'OBJ_NAME_2',..., 'OBJ_NAME_5' * I name(s) of the standard target(s) * 'FILTER_NAME' I filter name * 'DET_NUM' I detector ID * 'FLUX' I flux of the target (in erg/sec/sq cm) * * Subroutines Called: * ------------------- * CDBS: * CDTIN * SDAS: * UCLGST, UTRGTR, UTRGTI, UTTCLO, UMSPUT * OTHERS: * None * * History: * -------- * Version Date Author Description * 1 08-30-86 J.-C. Hsu Design and coding * 2 10-05-87 J.-C. Hsu F77 standard * *------------------------------------------------------------------------------- * *== output: * --object names of targets CHARACTER*(*) TARGET(5, 5000), : FILTER(1) * --flux density of standard target REAL FLUX(1) * --detector ID INTEGER DETID(1), * --number of entries of input table : NPTS, * --error status : STATUS * *== local: * --loop index INTEGER I, J, * --number of rows and columns and names : NROWS, NCOLS, NNAMES, * --error status : STAT(10), STATOK, * --table pointer and column ID : TP, COLIDN(10) LOGICAL NULMSK(10) CHARACTER*1 CHAR1 CHARACTER*5 CHAR5 * --column names CHARACTER*16 COLNAM(10) * --target names CHARACTER*20 TRGT(5) * --table name CHARACTER*128 TBNAME * --error message context CHARACTER*130 CONTXT *=========================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=========================================== *------------------------------------------------------------------------------- * * initialization * NPTS = 0 NNAMES = 5 * * set up reference flux table * NCOLS = 8 COLNAM(1) = 'FILTER_NAME' COLNAM(2) = 'DET_NUM' COLNAM(3) = 'FLUX' * DO 10 I = 1, NNAMES WRITE (CHAR1, '(I1)') I COLNAM(3+I) = 'OBJ_NAME_' // CHAR1 10 CONTINUE * * set up standard target flux table * CALL UCLGST ('ref_flux', TBNAME, STATUS) IF (STATUS .NE. OK) THEN CONTXT = 'cannot get flux density table ' : // 'keyword name' GO TO 999 END IF * CALL CDTIN (TBNAME, COLNAM, NCOLS, : TP, COLIDN, NROWS, STATUS) IF (STATUS .NE. OK) THEN CONTXT = 'cannot set up flux density table' GO TO 999 END IF * * read flux density table * DO 50 I = 1, NROWS CALL UTRGTT (TP, COLIDN(1), 1, I, : FILTER(I), NULMSK(1), STAT(1)) CALL UTRGTI (TP, COLIDN(2), 1, I, : DETID(I), NULMSK(2), STAT(2)) CALL UTRGTR (TP, COLIDN(3), 1, I, : FLUX(I), NULMSK(3), STAT(3)) CALL UTRGTT (TP, COLIDN(4), 5, I, : TRGT, NULMSK(4), STAT(4)) * STATOK = ABS(STAT(1) - OK) + ABS(STAT(2) - OK) + : ABS(STAT(3) - OK) + ABS(STAT(4) - OK) + OK * * a target should have at least one name * DO 20 J = 1, NCOLS-4 IF (NULMSK(J)) THEN STATOK = ERRNUM(1) GO TO 30 END IF 20 CONTINUE * 30 IF (STATOK .NE. OK) THEN WRITE (CHAR5, '(I5)') I CONTXT = 'cannot read data entry #' // CHAR5 CALL UMSPUT (CONTXT, DEST, PRIO, STATOK) ELSE NPTS = NPTS + 1 FILTER(NPTS) = FILTER(I) DETID(NPTS) = DETID(I) FLUX(NPTS) = FLUX(I) DO 40 J = 1, NNAMES TARGET(J, NPTS) = TRGT(J) 40 CONTINUE END IF 50 CONTINUE * * check if there is any data or too many data causing memory buffer overflow * IF (NPTS .LE. 0 .OR. NPTS .GT. 5000) THEN STATUS = ERRNUM(3) CONTXT = 'no valid data or more than 5000 entries in the ' : // 'flux density table' GO TO 999 END IF * * close table * CALL UTTCLO (TP, STATUS) IF (STATUS .NE. OK) THEN CONTXT = 'cannot close flux density table' GO TO 999 END IF * STATUS = OK GO TO 1000 * * write error message * 999 CALL UMSPUT ('VFLUX: ' // CONTXT, DEST, PRIO, STATOK) * 1000 RETURN END