SUBROUTINE VAP3LG ( * * outputs * : V2, V3, COUNT, DCOUNT, EPOCH, NPTS, LEVEL, : OFILE, STATUS) * * Module number: 15.11.2.3.2.1 * * Module name: lgaperloc * * Keyphrase: * ---------- * Input parameters and data needed for Phase III, large aperture location * calibration * * Description: * ------------ * * FORTRAN name: VAP3LG.FOR * * Keywords of accessed files and tables: * -------------------------------------- * Name I/O Description / Comments * 'intable' I input table name * 'outtable' I output table name * 'edge_level' I ratio between count levels of the edge * and the maximum * 'v2_key' I column name of the input V2 coordinate * 'v3_key' I column name of the input V3 coordinate * 'count_key' I column name of input count rate * 'counterr_key' I column name of count rate's stand dev * * input table column names: * * (v2_key) I V2 coordiante as passed from V2_KEY * (v3_key) I V3 coordiante as passed from V3_KEY * (count_key) I count rate as passed from COUNT_KEY * (counterr_key) I standard deviation count rate as * passed from COUNTSD_KEY * 'EPOCH' I epoch of observation * * Subroutines Called: * ------------------- * CDBS: * CDTIN * SDAS: * UCLGSR, UCLGST, UTRGTR, UTRGTD, UTTCLO, UMSPUT * Others: * None * * History: * -------- * Version Date Author Description * 1 01-20-87 J.-C. HSU design and coding * 2 11-10-87 J.-C. HSU F77 SDAS * *------------------------------------------------------------------------------- * *== output: * --V2 and V3 arrays REAL V2(1), V3(1), * --count rate and its standard deviation : COUNT(1), DCOUNT(1), * --ration between count levels of the * --edge and the maximum : LEVEL * --epoch of observation DOUBLE PRECISION EPOCH(1) * --total number of valid input data points INTEGER NPTS * --output file name CHARACTER*(*) OFILE * --error status INTEGER STATUS * *== local: * --number of points from the input table INTEGER NROWS, * --pointer of table descripter and column * --identifier : TP, COLIDN(20), * --loop indices, number of input columns : I, J, NCOLS, * --error status : STAT(20), STATOK * --null flag LOGICAL NULMSK(30) * --data buffer REAL COLBUF(20) * --column names CHARACTER*16 COLNAM(20) * --input file name CHARACTER*128 IFILE * --error message context CHARACTER*130 CONTXT CHARACTER*5 CHAR5 * *=========================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 parameters: * CALL UCLGST ('intable', IFILE, STAT(1)) CALL UCLGST ('outtable', OFILE, STAT(2)) CALL UCLGSR ('edge_level', LEVEL, STAT(3)) CALL UCLGST ('v2_key', COLNAM(1), STAT(4)) CALL UCLGST ('v3_key', COLNAM(2), STAT(5)) CALL UCLGST ('count_key', COLNAM(3), STAT(6)) CALL UCLGST ('counterr_key', COLNAM(4), STAT(7)) * DO 10 I = 1, 7 IF (STAT(I) .NE. OK) THEN STATUS = ERRNUM(1) CONTXT = 'cannot get input parameter(s)' GO TO 999 END IF 10 CONTINUE * * define the rest of column names * COLNAM(5) = 'EPOCH' NCOLS = 5 * * 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: V2, V3, count rate, its standard deviation and epoch, * from input table * NPTS = 0 DO 40 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)) * STATOK = ABS(STAT(1) - OK) + ABS(STAT(2) - OK) + OK DO 20 J = 1, NCOLS IF (NULMSK(J)) THEN STATOK = ERRNUM(2) GO TO 30 END IF 20 CONTINUE * * if error in UTRGTR or count rate is non-positive, put an error message and * do NOT increment the data array index * 30 CONTINUE IF (STATOK .NE. OK .OR. COLBUF(3) .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 V2(NPTS) = COLBUF(1) V3(NPTS) = COLBUF(2) COUNT(NPTS) = COLBUF(3) DCOUNT(NPTS) = COLBUF(4) EPOCH(NPTS) = EPOCH(I) END IF 40 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 CALL UMSPUT ('VAP3LG: ' // CONTXT, DEST, PRIO, STATOK) * 1000 RETURN END