SUBROUTINE VAP3SG ( * * outputs * : V2, V3, COUNT, DCOUNT, EPOCH, NPTS, LEVEL, : BORDER, SCHEME, FRAC, ITER, TOLERN, : XNAME, YNAME, DXNAME, DYNAME, : CFILE, OFILE, STATUS) * * Module number: 15.11.2.3.1.1 * * Module name: smaperloc * * Keyphrase: * ---------- * Input parameters and data needed for Phase III, large aperture location * calibration * * Description: * ------------ * * FORTRAN name: VAP3SG.FOR * * Keywords of accessed files and tables: * -------------------------------------- * Name I/O Description / Comments * 'intable' I input table name * 'outtable' I output table name * 'contourkeep' I flag of keeping contour coordinates * 'contourtable' I contour 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 * 'v2weight' I weighting scheme of V2 axis * 'v3weight' I weighting scheme of V3 axis * 'itermax' I maximum number of iterations * 'tolern' I tolerance of sigma-squared difference * during least square iterations * 'frac' I specified fraction applied to the * coefficients modification * 'v2name' I column name of the V2 coordinate in * contour table * 'v3name' I column name of the V3 coordinate in * contour table" * 'dv2name' I column name of V2 coordinate's error * in contour table" * 'dv3name' I column name of V3 coordinate's error * in contour table" * * 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 COUNTERR_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), * --weighting schemes : SCHEME(*), * --specified fraction applied to the * --coefficient modification : FRAC, * --tolerance of sigma-squared difference : TOLERN, * --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, * --maximum number of iterations of least * --square fitting : ITER * --flag of saving circle contour in a table LOGICAL BORDER * --contour coordinate table and output * --table names CHARACTER*(*) CFILE, OFILE, * --contour table column names : XNAME, YNAME, DXNAME, DYNAME * --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 UCLGSB ('contourkeep', BORDER, STAT(3)) CALL UCLGST ('contourtable', CFILE, STAT(4)) CALL UCLGSR ('edge_level', LEVEL, STAT(5)) CALL UCLGST ('v2_key', COLNAM(1), STAT(6)) CALL UCLGST ('v3_key', COLNAM(2), STAT(7)) CALL UCLGST ('count_key', COLNAM(3), STAT(8)) CALL UCLGST ('counterr_key', COLNAM(4), STAT(9)) CALL UCLGSI ('itermax', ITER, STAT(10)) CALL UCLGSR ('tolern', TOLERN, STAT(11)) CALL UCLGSR ('frac', FRAC, STAT(12)) CALL UCLGSR ('v2weight', SCHEME(1), STAT(13)) CALL UCLGSR ('v3weight', SCHEME(2), STAT(14)) CALL UCLGST ('v2name', XNAME, STAT(15)) CALL UCLGST ('v3name', YNAME, STAT(16)) CALL UCLGST ('dv2name', DXNAME, STAT(17)) CALL UCLGST ('dv3name', DYNAME, STAT(18)) * DO 10 I = 1, 18 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 put an error message and do NOT increment the data array * index * 30 CONTINUE IF (STATOK .NE. OK) THEN WRITE(CHAR5, '(I5)') I CONTXT = 'can not read input 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 ('VAP3SG: ' // CONTXT, DEST, PRIO, STATOK) * 1000 RETURN END