SUBROUTINE VSYNPH ( * * inputs: * : OBSID, INMID, OUTMID, APERT, DET, * * outputs * : STATUS) * * Module Number: * * Module Name: CALHSP * * Keyphrase: * ---------- * perform synthetic photometry calculations for HSP calibration * * Description: * ------------ * * FORTRAN Name: vsynph.for * * Keywords of Accessed Files and Tables: * -------------------------------------- * Name I/O Description / Comments * * keywords updated in the file header * * 'PHOTMODE' I Photometric mode * 'PHOTFLAM' I Inverse sensitivity * 'PHOTZPT' I Zero point * 'PHOTPLAM' I Pivot Wavelength * 'PHOTBW' I RMS bandwidth of the filter * * Subroutines Called: * ------------------- * SDAS: * GTPHOT, UHDPSR, UHDPST, UMSPUT * OTHERS: * None * * History: * -------- * Version Date Author Description * 1 06-20-91 J.-C. Hsu Design and coding * 1.3.0 08-22-93 J.-C. Hsu add synphot path to header *------------------------------------------------------------------------------- * *== input: * --input file pointer INTEGER INMID, * --pointer of output file : OUTMID, * --detector ID of input data : DET * --observation ID CHARACTER*(*) OBSID, * --aperture ID of input data : APERT * *== output: * --error status INTEGER STATUS * *== local: * --return status INTEGER STAT(30), STATOK, : NFILT, LEN, APLEN, * --loop indices : I * --synthetic photometric quantities REAL PHOT(4) CHARACTER*1 APNAME CHARACTER*6 FNAME(30) * --header keywords CHARACTER*8 KEYWD(10) * --graph table, components table names, * --photometric mode CHARACTER*18 GRAPH, COMP, PHMODE * --error message context CHARACTER*130 CONTXT, MESS CHARACTER*400 PATH PARAMETER (NFILT = 27) *=========================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=========================================== DATA FNAME /'f122m', 'f135w', 'f145m', 'f152m', 'f179m', : 'f184w', 'f216m', 'f218m', 'f220w', 'f237m', : 'f240w', 'f248m', 'f262m', 'f277m', 'f278n', : 'f284m', 'f327m', 'f355m', 'f419n', 'f450w', : 'f551w', 'f620w', 'f140lp', 'f160lp', 'f400lp', : 'f320n', 'f750w', ' ', ' ', ' '/ *------------------------------------------------------------------------------- CONTXT = ' ' PHMODE = ' ' * * header keywords * KEYWD(1) = 'PHOTMODE' KEYWD(2) = 'PHOTFLAM' KEYWD(3) = 'PHOTZPT' KEYWD(4) = 'PHOTPLAM' KEYWD(5) = 'PHOTBW' * * beam splitters * IF (APERT(1:9) .EQ. 'VF135U1_A') THEN PHMODE = 'hsp uv1 prism blue' ELSE IF (APERT(1:9) .EQ. 'VF248U1_A') THEN PHMODE = 'hsp uv1 prism red' ELSE IF (APERT(1:9) .EQ. 'VF145U2_A') THEN PHMODE = 'hsp uv2 prism blue' ELSE IF (APERT(1:9) .EQ. 'VF262U2_A') THEN PHMODE = 'hsp uv2 prism red' ELSE IF (APERT(1:8) .EQ. 'VF240V_A') THEN PHMODE = 'hsp vis prism blue' ELSE IF (APERT(1:8) .EQ. 'VF551V_A') THEN PHMODE = 'hsp vis prism red' * * PMT * ELSE IF (APERT(1:10) .EQ. 'VF750_F320') THEN IF (DET .EQ. 3) THEN PHMODE = 'hsp pmt blue' ELSE IF (DET .EQ. 5) THEN PHMODE = 'hsp pmt red' ELSE GO TO 999 END IF * * clear apertures * ELSE IF (APERT(1:4) .EQ. 'VCLR') THEN IF (APERT(5:5) .EQ. 'P') THEN CALL UULOWC (APERT(7:7), APNAME) PHMODE = 'hsp pol f160lp ' // APNAME ELSE IF (APERT(5:5) .EQ. 'V') THEN CALL UULOWC (APERT(7:7), APNAME) PHMODE = 'hsp vis f160lp ' // APNAME ELSE IF (APERT(5:6) .EQ. 'U1') THEN CALL UULOWC (APERT(8:8), APNAME) PHMODE = 'hsp uv1 f140lp ' // APNAME ELSE IF (APERT(5:6) .EQ. 'U2') THEN CALL UULOWC (APERT(8:8), APNAME) PHMODE = 'hsp uv2 f140lp ' // APNAME ELSE GO TO 999 END IF * * regular cases * ELSE IF (APERT(2:2) .EQ. 'F') THEN DO 10 I = 1, NFILT IF (FNAME(I)(2:4) .EQ. APERT(3:5)) GO TO 20 10 CONTINUE GO TO 999 20 CALL UUSLEN (FNAME(I), LEN) IF (APERT(6:6) .NE. 'P') THEN IF (APERT(6:6) .EQ. 'V') THEN CALL UULOWC (APERT(8:8), APNAME) PHMODE = 'hsp vis ' // FNAME(I)(1:LEN) // : ' ' // APNAME ELSE IF (APERT(6:7) .EQ. 'U1') THEN CALL UULOWC (APERT(9:9), APNAME) PHMODE = 'hsp uv1 ' // FNAME(I)(1:LEN) // : ' ' // APNAME ELSE IF (APERT(6:7) .EQ. 'U2') THEN CALL UULOWC (APERT(9:9), APNAME) PHMODE = 'hsp uv2 ' // FNAME(I)(1:LEN) // : ' ' // APNAME ELSE GO TO 999 END IF ELSE CALL UUSLEN (APERT, APLEN) PHMODE = 'hsp pol ' // FNAME(I)(1:LEN) // ' ' // : APERT(7:APLEN) END IF END IF * CALL UHDPST (OUTMID, KEYWD(1), PHMODE, STAT(1)) * * get the HST graph table name and components table name * GRAPH = ' ' COMP = ' ' CALL UHDGST (INMID, 'GRAPHTAB', GRAPH, STATOK) CALL UHDGST (INMID, 'COMPTAB', COMP, STATOK) * IF (GRAPH .EQ. ' ' .OR. COMP .EQ. ' ') GO TO 999 * CALL GTPHOT (PHMODE, GRAPH, COMP, PATH, PHOT) * * update photometry header keywords * DO 30 I = 1, 4 CALL UHDPSR (OUTMID, KEYWD(I+1), PHOT(I), STAT(I+1)) 30 CONTINUE * * added 8/22/93 by JCH * CALL UHDAHS (OUTMID, 'HISTORY', PATH, STATOK) * STATUS = OK GO TO 1000 * * write error message * 999 MESS = OBSID // ' VSYNPH: ' // CONTXT CONTINUE * CALL UMSPUT (MESS, DEST, PRIO, STATOK) * 1000 RETURN END