SUBROUTINE VDARK * * Module number: * * Module name: darkv * * Keyphrase: * ---------- * read dark counts from the input table and append to the output table, also * add a new column of data type to the output table * * Description: * ------------ * Maximum number of rows in the input table is 2000. * * FORTRAN name: VDARK.FOR * * Keywords of accessed files and tables: * -------------------------------------- * Name I/O Description / Comments * parameters * * 'intable' I input table name * 'outtable' I output table name * 'temp_key' I column name of temperature in input table * 'type' I data type * * column names in the input table * * 'APERTOBJ' I aperture name * 'VOLTAGE' I high voltage setting * (temp_key) I temperature * 'EPOCH' I epoch of observation * * column names in the output table * * 'APER_NAME' O aperture name * 'VOLTAGE' O high voltage setting * 'DARK' O dark count rate * 'DARK_ERR' O standard deviation of dark count rate * (temp_key) O temperature * 'EPOCH' O epoch of observation * 'TYPE' O data type * * Subroutines Called: * ------------------- * CDBS: * CDTIN, CDTOUT, VDKCR * SDAS: * UCLGST, UTRGTT, UTRGTR, UTRGTD, UTRPTT, UTRPTR, UTRPTD, UUUPPC, UTTCLO, * UMSPUT * Others: * none * * History: * -------- * Version Date Author Description * 1 11-30-87 J.-C. Hsu design and coding * 2 11-01-88 J.-C. Hsu modify to be able to append to output table * 3 10-16-89 J.-C. Hsu Error propagation * 4 08-22-90 J.-C. Hsu change column names ...SD to ..._ERR *------------------------------------------------------------------------------- * *== local: * --maximum column number and row numbers INTEGER COLMAX, ROWMAX PARAMETER (COLMAX = 20) PARAMETER (ROWMAX = 2000) * --column data type INTEGER DTYPE(COLMAX), * --pointer to table descripter : TP, * --column identifiers : COLIDN(COLMAX), * --number of rows in input table : NROWS, * --number of columns : NCOLS, * --number of data points : NPTS, * --error status : STATUS, STATOK, STAT(20), * --loop index : I, J, NPUT * --high voltage settings REAL HV(ROWMAX), * --temperature : TEMP(ROWMAX), * --count rates and their errors : CNT(ROWMAX), DCNT(ROWMAX), * --column buffer : COLBUF(COLMAX) * --epoch DOUBLE PRECISION EPOCH(ROWMAX), TIME CHARACTER*5 CHAR5 * --data type CHARACTER*7 TYPE CHARACTER*8 COLFMT(COLMAX) * --aperture names CHARACTER*10 APER(ROWMAX), APERT * --column name(s), unit(s), their * --format(s) CHARACTER*16 COLNAM(COLMAX), UNIT(COLMAX), * --temperature name : TNAME * --input and output table names CHARACTER*128 INTBL, OUTTBL * --error message CHARACTER*130 CONTXT, MESS LOGICAL NULMSK(COLMAX) *==========================begin iraf77.inc (without INTEGER*2)================= * Include file for the iraf77 FORTRAN interface to the IRAF VOS * Get IRAF common into main program * LOGICAL MEMB(1) INTEGER MEMI(1) INTEGER MEML(1) REAL MEMR(1) DOUBLE PRECISION MEMD(1) COMPLEX MEMX(1) EQUIVALENCE (MEMB, MEMI, MEML, MEMR, MEMD, MEMX) COMMON /MEM/ MEMD * * File I/O access modes * INTEGER RDONLY PARAMETER (RDONLY = 1) INTEGER RDWRIT PARAMETER (RDWRIT = 2) INTEGER WRONLY PARAMETER (WRONLY = 3) INTEGER APPEND PARAMETER (APPEND = 4) INTEGER NEWFIL PARAMETER (NEWFIL = 5) INTEGER TMPFIL PARAMETER (TMPFIL = 6) INTEGER NEWCPY PARAMETER (NEWCPY = 7) INTEGER NEWIMG PARAMETER (NEWIMG = 5) * * codes for data types * INTEGER TYBOOL PARAMETER (TYBOOL = 1) INTEGER TYCHAR PARAMETER (TYCHAR = 2) INTEGER TYSHOR PARAMETER (TYSHOR = 3) INTEGER TYINT PARAMETER (TYINT = 4) INTEGER TYLONG PARAMETER (TYLONG = 5) INTEGER TYREAL PARAMETER (TYREAL = 6) INTEGER TYDOUB PARAMETER (TYDOUB = 7) INTEGER TYCPLX PARAMETER (TYCPLX = 8) INTEGER TYUSHT PARAMETER (TYUSHT = 11) INTEGER TYUBYT PARAMETER (TYUBYT = 12) * * TYTEXT is a special code for the iraf77 interface; it is not in the VOS * INTEGER TYTEXT PARAMETER (TYTEXT = 13) *========================end iraf77.inc========================================= *=========================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=========================================== *------------------------------------------------------------------------------ * * read input parameters * CALL UCLGST ('intable', INTBL, STAT(1)) CALL UCLGST ('outtable', OUTTBL, STAT(2)) CALL UCLGST ('temp_key', TNAME, STAT(3)) CALL UCLGST ('type', TYPE, STAT(4)) * DO 10 I = 1, 4 IF (STAT(I) .NE. OK) THEN STATUS = ERRNUM(1) CONTXT = 'can not get parameter(s)' GO TO 999 END IF 10 CONTINUE * * define input table column names * COLNAM(1) = 'APERTOBJ' COLNAM(2) = 'VOLTAGE' COLNAM(3) = TNAME COLNAM(4) = 'EPOCH' * * analog data only * CALL UUUPPC (TYPE, TYPE) IF (TYPE(1:1) .EQ. 'A') THEN COLNAM(5) = 'AOBJ_C' COLNAM(6) = 'AOBJ_ERR_C' NCOLS = 6 ELSE IF (TYPE(1:1) .EQ. 'D') THEN COLNAM(5) = 'DOBJ_C' COLNAM(6) = 'DOBJ_ERR_C' NCOLS = 6 ELSE STATUS = ERRNUM(1) CONTXT = 'illegal data type keyword ' // TYPE GO TO 999 END IF * * calculate corrected count rates * CALL VDKCR (INTBL, TYPE, STATUS) IF (STATUS .NE. OK) THEN CONTXT = 'cannot calculate corrected count rates' GO TO 999 END IF * * set up input table * CALL CDTIN (INTBL, 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 UTRGTT (TP, COLIDN(1), 1, I, APERT, NULMSK(1), : STAT(1)) CALL UTRGTR (TP, COLIDN(2), 2, I, COLBUF, NULMSK(2), : STAT(2)) CALL UTRGTD (TP, COLIDN(4), 1, I, TIME, NULMSK(4), : STAT(3)) CALL UTRGTR (TP, COLIDN(5), 2, I, COLBUF(3), NULMSK(5), : STAT(4)) * STATOK = OK DO 20 J = 1, 4 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 put an error message and do NOT increment the data array * index * 40 CONTINUE IF (STATOK .NE. OK) THEN WRITE(CHAR5, '(I5)') I CONTXT = 'VDARK: can not read input data at row #' : // CHAR5 CALL UMSPUT (CONTXT, DEST, PRIO, STATOK) ELSE NPTS = NPTS + 1 HV(NPTS) = COLBUF(1) TEMP(NPTS) = COLBUF(2) CNT(NPTS) = COLBUF(3) DCNT(NPTS) = COLBUF(4) EPOCH(NPTS) = TIME APER(NPTS) = APERT 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 or more than maximum * IF (NPTS .LE. 0 .OR. NPTS .GT. ROWMAX) THEN STATUS = ERRNUM(5) WRITE (CHAR5, '(I5)') ROWMAX CONTXT = 'number of input data is 0 or more than ' // CHAR5 GO TO 999 END IF * * define output table columns, undefined columns have the same names as in * the input table * NCOLS = 7 * COLNAM(1) = 'APER_NAME' COLNAM(2) = 'VOLTAGE' COLNAM(3) = 'DARK' COLNAM(4) = 'DARK_ERR' COLNAM(5) = TNAME COLNAM(6) = 'EPOCH' COLNAM(7) = 'TYPE' DTYPE(1) = -10 DO 60 J = 2, 5 DTYPE(J) = TYREAL 60 CONTINUE DTYPE(6) = TYDOUB DTYPE(7) = -7 * DO 70 J = 1, 7 UNIT(J) = ' ' COLFMT(J) = ' ' 70 CONTINUE * * set up output table * CALL CDTOUT (OUTTBL, COLNAM, UNIT, COLFMT, DTYPE, NCOLS, TP, : COLIDN, NROWS, STATUS) IF (STATUS .NE. OK) THEN CONTXT = 'error setting up output table' GO TO 999 END IF * * put each observation to output table * DO 90 I = 1, NPTS * * specify buffer contents * COLBUF(1) = HV(I) COLBUF(2) = CNT(I) COLBUF(3) = DCNT(I) COLBUF(4) = TEMP(I) * * write results to the output table * CALL UTRPTT (TP, COLIDN(1), 1, NROWS+I, APER(I), STAT(1)) CALL UTRPTR (TP, COLIDN(2), 4, NROWS+I, COLBUF, STAT(2)) CALL UTRPTD (TP, COLIDN(6), 1, NROWS+I, EPOCH(I), STAT(3)) CALL UTRPTT (TP, COLIDN(7), 1, NROWS+I, TYPE, STAT(4)) NPUT = 4 * DO 80 J = 1, NPUT IF (STAT(J) .NE. OK) THEN STATUS = ERRNUM(1) CONTXT = 'cannot write a row to output table' GO TO 999 END IF 80 CONTINUE 90 CONTINUE * CALL UTTCLO (TP, STATUS) IF (STATUS .NE. OK) THEN CONTXT = 'cannot close output table' GO TO 999 END IF * STATUS = OK GO TO 1000 * * write error message * 999 MESS = 'VDARK: ' // CONTXT CALL UMSPUT (MESS, DEST, PRIO, STATOK) * 1000 RETURN END