SUBROUTINE VSCTGT ( * * outputs * : REFID, OBSID, RA, DEC, COUNT, DCOUNT, TEMP, : EPOCH, APER, TARGET, NPTS, OFILE, STATUS) * * Module number: 15.14.1 * * Module name: scatterv * * Keyphrase: * ---------- * Input parameters and data needed for VSCATT * * Description: * ------------ * * FORTRAN name: VSCTGT.FOR * * Keywords of accessed files and tables: * -------------------------------------- * Name I/O Description / Comments * 'intable' I input table name * 'outtable' I output table name * 'ref_obs_id' I reference observation ID * 'obsid_key' I column name of the observation ID * 'count_key' I column name of the count rate * 'counterr_key' I column name of count rate's standard dev * 'ra_key' I column name of the right ascension * 'dec_key' I column name of the declination * 'temp_key' I column name of temperature * * input table column names: * * (obsid_key) I count rate * (count_key) I count rate * (counterr_key) I count rate's standard deviation * (ra_key) I right ascension * (dec_key) I declination * (temp_key) I the temperature * 'EPOCH' I observation epoch * 'TRGTNAME' I target name * 'APERTOBJ' I aperture name * * Subroutines Called: * ------------------- * CDBS: * CDTIN * SDAS: * UCLGSR, UCLGST, UTRGTR, UTRGTD, UTRGTT, UTTCLO, UMSPUT * Others: * None * * History: * -------- * Version Date Author Description * 1 06-22-87 J.-C. HSU design and coding * 2 11-20-87 J.-C. HSU F77 SDAS *------------------------------------------------------------------------------- * *== output: * --count rate and its standard deviation REAL COUNT(1), DCOUNT(1), * --temperature : TEMP(1) * --right ascension, declination, and epoch DOUBLE PRECISION RA(1), DEC(1), EPOCH(1) * --target name, and aperture name CHARACTER*(*) TARGET(1), APER(1), * --reference obs ID, and obs ID's : REFID, OBSID(1) * --total number of valid input data points INTEGER NPTS * --output file name CHARACTER*(*) OFILE * --error status INTEGER STATUS * *== local: * --number of rows in input table INTEGER NROWS, * --pointer of table descripter and column * --identifier : TP, COLIDN(10), * --loop indices, number of input columns : I, J, NCOLS, * --status : STAT(20), STATOK * --data buffer REAL COLBUF(10) DOUBLE PRECISION BUFFD(10) * --column names CHARACTER*16 COLNAM(10) * --null flag in UTRGTR LOGICAL NULMSK(30) * --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 input- and output- file names, reference obs ID, and column names of * observation ID, count rate, its standard deviation, right ascension, * declination, and temperature * CALL UCLGST ('intable', IFILE, STAT(1)) CALL UCLGST ('outtable', OFILE, STAT(2)) CALL UCLGST ('ref_obs_id', REFID, STAT(3)) CALL UCLGST ('obsid_key', COLNAM(1), STAT(4)) CALL UCLGST ('count_key', COLNAM(2), STAT(5)) CALL UCLGST ('counterr_key', COLNAM(3), STAT(6)) CALL UCLGST ('temp_key', COLNAM(4), STAT(7)) CALL UCLGST ('ra_key', COLNAM(5), STAT(8)) CALL UCLGST ('dec_key', COLNAM(6), STAT(9)) * DO 10 I = 1, 9 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 * NCOLS = 9 COLNAM(7) = 'EPOCH' COLNAM(8) = 'TRGTNAME' COLNAM(9) = 'APERTOBJ' * * 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: observation ID, count rate and its standard deviation, * right ascension, declination, temperature, epoch, target name, and aperture * name from input table * NPTS = 0 DO 40 I = 1, NROWS CALL UTRGTT (TP, COLIDN(1), 1, I, : OBSID(I), NULMSK(1), STAT(1)) CALL UTRGTR (TP, COLIDN(2), 3, I, : COLBUF, NULMSK(2), STAT(2)) CALL UTRGTD (TP, COLIDN(5), 3, I, : BUFFD, NULMSK(5), STAT(3)) CALL UTRGTT (TP, COLIDN(8), 1, I, : TARGET(I), NULMSK(8), STAT(4)) CALL UTRGTT (TP, COLIDN(9), 1, I, : APER(I), NULMSK(9), STAT(5)) * STATOK = ABS(STAT(1) - OK) + ABS(STAT(2) - OK) + : ABS(STAT(3) - OK) + ABS(STAT(4) - OK) + : ABS(STAT(5) - 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 table row #' // CHAR5 CALL UMSPUT (CONTXT, DEST, PRIO, STATOK) ELSE NPTS = NPTS + 1 OBSID(NPTS) = OBSID(I) COUNT(NPTS) = COLBUF(1) DCOUNT(NPTS) = COLBUF(2) TEMP(NPTS) = COLBUF(3) RA(NPTS) = BUFFD(1) DEC(NPTS) = BUFFD(2) EPOCH(NPTS) = BUFFD(3) TARGET(NPTS) = TARGET(I) APER(NPTS) = APER(I) END IF 40 CONTINUE * * close the input table * CALL UTTCLO (TP, STATUS) IF (STATUS .NE. OK) THEN CONTXT = 'cannot close input table' GO TO 999 END IF * IF (NPTS .LE. 0) THEN STATUS = ERRNUM(3) CONTXT = 'no input data been successfully read' GO TO 999 END IF * STATUS = OK GO TO 1000 * * write error message * 999 CALL UMSPUT ('VSCTGT: ' // CONTXT, DEST, PRIO, STATOK) * 1000 RETURN END