SUBROUTINE VASNGT ( * * outputs * : COUNT, DCOUNT, SKY, TEMP, EPOCH, APERT, DETID, : TARGET, MODE, INDEX, NPTS, OFILE, TNAME, STATUS) * * Module number: 15.9.1.1 * * Module name: abssenv * * Keyphrase: * ---------- * Input parameters and data needed for VASEN * * Description: * ------------ * * FORTRAN name: VASNGT.FOR * * Keywords of accessed files and tables: * -------------------------------------- * Name I/O Description / Comments * * CL parameters: * * 'intable' I input table name * 'outtable' I output table name * 'temp_key' I keyword name of the temperature * 'count_key' I keyword name of digital count rate * 'counterr_key' I keyword name of digital count rate's standard * deviation * 'sky_key' I keyword name of sky's digital count rate * * input table column names: * * (count_key) I count rate, specified in 'count_key' * (counterr_key) I count rate's standard deviation, * specified in 'counterr_key' * (sky_key) I sky's count rate * (temp_key) I temperature, specified in 'temp_key' * 'APERTOBJ' I aperture name * 'DETECTOB' I detector ID * 'TRGTNAME' I target name * 'MODE' I mode * 'EPOCH' I epoch * * Subroutines Called: * ------------------- * CDBS: * CDTIN * SDAS: * UCLGSR, UCLGST, UTRGTR, UTRGTD, UTRGTT, 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: * --count rate and its standard deviation REAL COUNT(1), DCOUNT(1), * --sky's count rate : SKY(1), * --temperature : TEMP(1) * --epoch DOUBLE PRECISION EPOCH(1) * --aperture name CHARACTER*(*) APERT(1), * --target name : TARGET(1), * --mode : MODE(1), * --output file name : OFILE, * --temperature name : TNAME * --detector ID INTEGER DETID(1), * --array index : INDEX(1), * --total number of valid input data points : NPTS, * --error status : STATUS * *== local: * --number of input data points INTEGER NROWS, * --pointer of table descripter and column * --identifier : TP, COLIDN(20), * --loop indices, number of input columns : I, J, NCOLS, * --status : STAT(20), STATOK * --data buffer REAL COLBUF(20) * --column names CHARACTER*16 COLNAM(20) * --null flag in UTRGTR LOGICAL NULMSK(30) CHARACTER*5 CHAR5 * --input file name CHARACTER*128 IFILE * --error message context CHARACTER*130 CONTXT, MESS *=========================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=========================================== *------------------------------------------------------------------------------ * * input parameters: * input and output table names, data type, column names of: * (1) count rate, (2) standard deviation of count arte, (3) temperature, * (4) sky's count rate * CALL UCLGST ('intable', IFILE, STAT(1)) CALL UCLGST ('outtable', OFILE, STAT(2)) CALL UCLGST ('count_key', COLNAM(1), STAT(3)) CALL UCLGST ('counterr_key', COLNAM(2), STAT(4)) CALL UCLGST ('sky_key', COLNAM(3), STAT(5)) CALL UCLGST ('temp_key', TNAME, STAT(6)) * DO 10 I = 1, 6 IF (STAT(I) .NE. OK) THEN STATUS = ERRNUM(1) CONTXT = 'can not get CL parameter(s)' GO TO 999 END IF 10 CONTINUE * * define the rest of column names * COLNAM(4) = TNAME COLNAM(5) = 'EPOCH' COLNAM(6) = 'APERTOBJ' COLNAM(7) = 'DETECTOB' COLNAM(8) = 'TRGTNAME' COLNAM(9) = 'MODE' NCOLS = 9 * * set up input table * CALL CDTIN (IFILE, COLNAM, NCOLS, : TP, COLIDN, NROWS, STATUS) IF (STATUS .NE. OK) THEN CONTXT = 'error setting up input table' GO TO 999 END IF * * input the following: count rate and its standard deviation, temperature, * aperture name, and epoch, from input table * NPTS = 0 DO 50 I = 1, NROWS CALL UTRGTR (TP, COLIDN, 4, I, : COLBUF, NULMSK, STAT(1)) CALL UTRGTD (TP, COLIDN(5), 1, I, : EPOCH(I), NULMSK(5), STAT(2)) CALL UTRGTT (TP, COLIDN(6), 1, I, : APERT(I), NULMSK(6), STAT(3)) CALL UTRGTI (TP, COLIDN(7), 1, I, : DETID(I), NULMSK(7), STAT(4)) CALL UTRGTT (TP, COLIDN(8), 1, I, : TARGET(I), NULMSK(8), STAT(5)) CALL UTRGTT (TP, COLIDN(9), 1, I, : MODE(I), NULMSK(9), STAT(6)) * STATOK = OK DO 20 J = 1, 6 STATOK = ABS(STAT(I) - OK) + STATOK 20 CONTINUE * DO 30 J = 1, NCOLS IF (NULMSK(J)) THEN STATOK = ERRNUM(2) GO TO 40 END IF 30 CONTINUE * * if error in UTRGTR or count rate is non-positive, put an error message and * do NOT increment the data array index * 40 CONTINUE IF (STATOK .NE. OK .OR. COLBUF(1) .LE. 0.) THEN WRITE(CHAR5, '(I5)') I CONTXT = 'can not read input data or non-positive ' : // 'data at row #' // CHAR5 CALL UMSPUT (CONTXT, DEST, PRIO, STATOK) ELSE NPTS = NPTS + 1 COUNT(NPTS) = COLBUF(1) DCOUNT(NPTS) = COLBUF(2) SKY(NPTS) = COLBUF(3) TEMP(NPTS) = COLBUF(4) EPOCH(NPTS) = EPOCH(I) APERT(NPTS) = APERT(I) DETID(NPTS) = DETID(I) TARGET(NPTS) = TARGET(I) MODE(NPTS) = MODE(I) INDEX(NPTS) = I END IF 50 CONTINUE * * close input table * CALL UTTCLO (TP, STATUS) IF (STATUS .NE. OK) THEN CONTXT = 'cannot close input table' GO TO 999 END IF * * check if there is any valid data point * IF (NPTS .LE. 0) THEN STATUS = ERRNUM(3) CONTXT = 'no valid input data' GO TO 999 END IF * STATUS = OK GO TO 1000 * * write error message * 999 MESS = 'VASNGT: ' // CONTXT CALL UMSPUT (MESS, DEST, PRIO, STATOK) * 1000 RETURN END