SUBROUTINE VGNGT ( * * outputs * : GAIN, CNTA, DCNTA, CNTD, DCNTD, TEMP, EPOCH, : APER, GNFAC, DGNFAC, TARGET, HV, DETID, : NPTS, OFILE, LEVEL, TNAME, STATUS) * * Module number: 15.9.2.2.1 * * Module name: gainfac * * Keyphrase: * ---------- * Input parameters and data needed for gain factor calibration * * Description: * ------------ * * FORTRAN name: VGNGT.FOR * * Keywords of accessed files and tables: * -------------------------------------- * Name I/O Description / Comments * * CL parameters: * * 'intable' I input table name * 'outtable' I output table name * 'setting' I gain setting level (hi or lo) * 'temp_key' I keyword name of the temperature * * input table column names: * * 'AOBJ_C' I analog measurement * 'AOBJ_ERR_C' I analog measurement's mean error * (temp_key) I temperature, specified in 'temp_key' * 'VGAIND' I gain setting * 'VOLTAGE' I high voltage setting * 'DETECTOB' I object detector ID * 'EPOCH' I epoch * 'APERTOBJ' I aperture used for the object * 'TRGTNAME' I target name * * the following is only for high gain settings: * * 'DOBJ_C' I digital count rate * 'DOBJ_ERR_C' I digital count rate's mean error * * the following is only for low gain settings: * * 'GAINFACT' I gain factor * * Subroutines Called: * ------------------- * CDBS: * CDTIN, VGNCR * SDAS: * UULOWC, UCLGST, UTRGTR, UTRGTD, UTRGTI, UTRGTT, UTTCLO, UMSPUT * Others: * None * * History: * -------- * Version Date Author Description * 1 12-20-85 J.-C. HSU design and coding * 2 09-15-87 J.-C. HSU F77 standard * 3 09-12-89 J.-C. HSU error propagation *------------------------------------------------------------------------------- * *== output: * --digital count rate and its standard * --deviation REAL CNTD(1), DCNTD(1), * --analog measurement and its standard * --deviation : CNTA(1), DCNTA(1), * --temperature : TEMP(1), * --gain setting : GAIN(1), * --gain factor and its error : GNFAC(1), DGNFAC(1), * --high voltage setting : HV(1) * --epoch DOUBLE PRECISION EPOCH(1) * --output file name CHARACTER*(*) OFILE, * --target name : TARGET(1), * --aperture name : APER(1), * --gain setting level keyword : LEVEL, * --temperature name : TNAME * --total number of valid input data points INTEGER NPTS, * --detector ID : DETID(1), * --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(20) 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) * --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=========================================== *------------------------------------------------------------------------------ * * input CL parameters: * CALL UCLGST ('intable', IFILE, STAT(1)) CALL UCLGST ('outtable', OFILE, STAT(2)) CALL UCLGST ('setting', LEVEL, STAT(3)) CALL UCLGST ('temp_key', TNAME, STAT(4)) * DO 10 I = 1, 4 IF (STAT(I) .NE. OK) THEN STATUS = ERRNUM(2) CONTXT = 'cannot get CL parameter(s)' GO TO 999 END IF 10 CONTINUE * * define input table column names * COLNAM(1) = 'AOBJ_C' COLNAM(2) = 'AOBJ_ERR_C' COLNAM(3) = 'VGAIND' COLNAM(4) = TNAME COLNAM(5) = 'EPOCH' COLNAM(6) = 'VOLTAGE' COLNAM(7) = 'DETECTOB' COLNAM(8) = 'APERTOBJ' COLNAM(9) = 'TRGTNAME' * * high gian setting only * CALL UULOWC (LEVEL, LEVEL) IF (LEVEL(1:1) .EQ. 'h') THEN COLNAM(10) = 'DOBJ_C' COLNAM(11) = 'DOBJ_ERR_C' NCOLS = 11 * * low gain setting only * ELSE IF (LEVEL(1:1) .EQ. 'l') THEN COLNAM(10) = 'GAINFACT' COLNAM(11) = 'GAINFACT_ERR' NCOLS = 11 ELSE STATUS = ERRNUM(1) CONTXT = 'illegal gain setting level keyword' GO TO 999 END IF * * calculate corrected count rates * CALL VGNCR (IFILE, LEVEL, STATUS) IF (STATUS .NE. OK) THEN CONTXT = 'cannot calculate corrected count rates' GO TO 999 END IF * * 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 * * read data from input table * NPTS = 0 DO 50 I = 1, NROWS CALL UTRGTR (TP, COLIDN(1), 4, I, COLBUF(1), NULMSK(1), : STAT(1)) CALL UTRGTD (TP, COLIDN(5), 1, I, EPOCH(I), NULMSK(5), : STAT(2)) CALL UTRGTR (TP, COLIDN(6), 1, I, HV(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, APER(I), NULMSK(8), : STAT(5)) CALL UTRGTT (TP, COLIDN(9), 1, I, TARGET(I), NULMSK(9), : STAT(6)) * IF (LEVEL(1:1) .EQ. 'h') THEN CALL UTRGTR (TP, COLIDN(10), 2, I, COLBUF(5), : NULMSK(10), STAT(7)) STAT(8) = OK ELSE CALL UTRGTR (TP, COLIDN(10), 1, I, GNFAC(I), : NULMSK(10), STAT(7)) CALL UTRGTR (TP, COLIDN(11), 1, I, DGNFAC(I), : NULMSK(11), STAT(8)) END IF * STATOK = OK DO 20 J = 1, 8 IF (STAT(J) .NE. OK) THEN STATOK = ERRNUM(3) GO TO 40 END IF 20 CONTINUE * DO 30 J = 1, NCOLS IF (NULMSK(J)) THEN STATOK = ERRNUM(4) GO TO 40 END IF 30 CONTINUE * * if error in UTRGTR or count rate is non-positive, put an error message and * exit * 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 STATUS = ERRNUM(5) GO TO 999 ELSE NPTS = NPTS + 1 CNTA(NPTS) = COLBUF(1) DCNTA(NPTS) = COLBUF(2) GAIN(NPTS) = COLBUF(3) TEMP(NPTS) = COLBUF(4) EPOCH(NPTS) = EPOCH(I) DETID(NPTS) = DETID(I) HV(NPTS) = HV(I) APER(NPTS) = APER(I) TARGET(NPTS) = TARGET(I) * IF (LEVEL(1:1) .EQ. 'h') THEN CNTD(NPTS) = COLBUF(5) DCNTD(NPTS) = COLBUF(6) ELSE GNFAC(NPTS) = GNFAC(I) DGNFAC(NPTS) = DGNFAC(I) END IF 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(5) CONTXT = 'no valid input data' GO TO 999 END IF * STATUS = OK GO TO 1000 * * write error message * 999 MESS = 'VGNGT: ' // CONTXT CALL UMSPUT (MESS, DEST, PRIO, STATOK) * 1000 RETURN END