SUBROUTINE VGTCTB ( * * inputs * : ROOT, FLEN, * * outputs * : OBSID, AARTBL, HVTBL, GNTBL, PATBL, : SNTBL, DKTBL, CVTBL, DTTBL, DKATBL, : SOURCE, STATUS) * * Module Number: * * Module Name: calhsp * * Keyphrase: * ---------- * get the calibration table names for HSP pipeline processing * * Description: * ------------ * * FORTRAN Name: VGTCTB.FOR * * Keywords of Accessed Files and Tables: * -------------------------------------- * Name I/O Description / Comments * * keywords from input science file header * * 'DATA_SRC' I data source * 'CCP0' I aperture area table name * 'CCP1' I high voltage factor calibartion table name * 'CCP2' I analog gain factor calibartion table name * 'CCP3' I pre-amplifier noise calibration table name * 'CCP4' I relative sensitivity calibartion table name * 'CCP5' I dark signal calibartion table name * 'CCP7' I CVC offset calibartion table name * 'CCP8' I digital linearity (deadtime) calibartion table name * 'CCP9' I translation table from regular aperture * name to "dark" aperture name * * Subroutines Called: * ------------------- * CDBS: * None * SDAS: * UHDGST, UIMOPN, UIMCLO, UMSPUT, UUFACC * OTHERS: * None * * History: * -------- * Version Date Author Description * 1 08-11-89 J.-C. Hsu Design and coding * 2 11-17-89 J.-C. Hsu read OBSID in this routine *------------------------------------------------------------------------------- * *== input: * --root name of the input file CHARACTER*(*) ROOT * --string length of the root name INTEGER FLEN * *== output: * --observation ID CHARACTER*(*) OBSID, * --file name of the dark signal table : DKTBL, * --file name of the pre-amp noise table : PATBL, * --file name of the high voltage factor table : HVTBL, * --file name of the relative sensitivity * --table : SNTBL, * --file name of the gain factor table : GNTBL, * --file name of the CVC offset table : CVTBL, * --file name of the deadtime table : DTTBL, * --file name of the dark aperture translation * --table : DKATBL, * --file name of the aperture size table : AARTBL, * --data source : SOURCE * *== local: * --file pointer INTEGER INMID, * --return status : STATUS, * --return status : STAT(30), STATOK, * --loop indices : I CHARACTER*1 CHAR1 CHARACTER*4 KEYWD(20) * --input file name CHARACTER*128 INFILE * --error message context CHARACTER*130 CONTXT, MESS LOGICAL EXIST *==========================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=========================================== *------------------------------------------------------------------------------- * OBSID = ' ' * * find the first existing file and get the calibration table names from its * header keywords * DO 10 I = 0, 3 WRITE (CHAR1, '(I1)') I * * assume input file extensions are .d0h through .d3h * INFILE = ROOT(1:FLEN) // '.d' // CHAR1 // 'h' CALL UUFACC (INFILE, EXIST, STATOK) IF (EXIST) GO TO 20 10 CONTINUE * * if no input file, exit and issue error message * STATUS = ERRNUM(1) CONTXT = 'no existing science file with the root name ' // : ROOT(1:FLEN) GO TO 999 * 20 CALL UIMOPN (INFILE, RDONLY, INMID, STATUS) IF (STATUS .NE. OK) THEN CONTXT = 'cannot open file ' // INFILE GO TO 999 END IF * * read observation id * CALL UHDGST (INMID, 'ROOTNAME', OBSID, STATUS) IF (STATUS .NE. OK) THEN CONTXT = 'cannot read header keyword "ROOTNAME" from ' : // INFILE GO TO 999 END IF * * issue begin process message * CONTXT = OBSID // ' BEGIN HSP pipeline processing, opened ' // : INFILE CALL UMSPUT (CONTXT, DEST, PRIO, STATOK) * * read data source, if it is area scan, skip reading other keywords * CALL UHDGST (INMID, 'DATA_SRC', SOURCE, STATUS) IF (STATUS .NE. OK) THEN CONTXT = 'cannot read header keyword "DATA_SRC" from ' : // INFILE GO TO 999 END IF CALL UUUPPC (SOURCE, SOURCE) IF (SOURCE(1:4) .EQ. 'AREA') GO TO 40 * KEYWD(1) = 'CCP0' KEYWD(2) = 'CCP1' KEYWD(3) = 'CCP2' KEYWD(4) = 'CCP3' KEYWD(5) = 'CCP4' KEYWD(6) = 'CCP5' KEYWD(7) = 'CCP7' KEYWD(8) = 'CCP8' KEYWD(9) = 'CCP9' * CALL UHDGST (INMID, KEYWD(1), AARTBL, STAT(1)) CALL UHDGST (INMID, KEYWD(2), HVTBL, STAT(2)) CALL UHDGST (INMID, KEYWD(3), GNTBL, STAT(3)) CALL UHDGST (INMID, KEYWD(4), PATBL, STAT(4)) CALL UHDGST (INMID, KEYWD(5), SNTBL, STAT(5)) CALL UHDGST (INMID, KEYWD(6), DKTBL, STAT(6)) CALL UHDGST (INMID, KEYWD(7), CVTBL, STAT(7)) CALL UHDGST (INMID, KEYWD(8), DTTBL, STAT(8)) CALL UHDGST (INMID, KEYWD(9), DKATBL, STAT(9)) * DO 30 I = 1, 9 IF (STAT(I) .NE. OK) THEN STATUS = ERRNUM(1) CONTXT = 'cannot read calibration file name header ' : // 'keyword ' // KEYWD(I) GO TO 999 END IF 30 CONTINUE * * close file * 40 CALL UIMCLO (INMID, STATUS) IF (STATUS .NE. OK) THEN CONTXT = 'cannot close file ' // INFILE GO TO 999 END IF * STATUS = OK GO TO 1000 * * write error message * 999 MESS = OBSID // ' VGTCTB: ' // CONTXT CALL UMSPUT (MESS, DEST, PRIO, STATOK) * 1000 RETURN END