SUBROUTINE VASEN * * Module Number: 15.9.1 * * Module Name: abssenv * * Keyphrase: * ---------- * Calculate digital absolute sensitivity * * Description: * ------------ * This task calculates digital absolute efficiency for any number (up to * 2000) of targets with known flux densities. The absolute efficiency of each * target is calculated by dividing its observed count rate (corrected for dark * signal, high voltage factor, pre-amp noise, and relative sensitivity) * by the target's flux density (integrated over the specified filter's * bandpass, and weighted by the filter's transmission curve). This routine * also checks the instrument mode of each observation. If it has a * simultaneous sky measurement, the sky (which is also corrected for dark etc.) * is subtracted from the target measurement, otherwise the observed count rate * of the target is not changed. * * FORTRAN Name: VASEN.FOR * * Keywords of Accessed Files : * -------------------------- * Name I/O Description / Comments * * Modules Called: * --------------- * CDBS: * VASNGT, VASNPT, VFLUX * SDAS: * UMSPUT * OTHERS: * none * * History: * -------- * Version Date Author Description * 1 08-30-86 J.-C. Hsu Design and coding * 2 10-05-87 J.-C. Hsu F77 standard *------------------------------------------------------------------------------- * *== local: * --count rate and its standard deviation REAL COUNT(2000), DCOUNT(2000), * --sky count rate : SKY(2000), * --absolute sensitivity : ASEN(2000), * --reference flux : REFLUX(5000), * --flux : FLUX(2000), * --temperature : TEMP(2000) * --epoch of the observation DOUBLE PRECISION EPOCH(2000) * --number of input data points INTEGER NPTS, * --input array index : INDEX(2000), * --number of output points : NROWS, * --number of entries in the flux table : NFLUX, * --input detector ID : DETID(2000), * --detector ID in reference flux table : REFDET(5000), * --error status : STATUS, STATOK, * --loop index : I, J, K * --instrument mode CHARACTER*3 MODE(2000) * --reference filter name CHARACTER*4 REFFLT(5000), * --filter name of this data set : FILTER CHARACTER*5 CHAR5 * --aperture names of input data CHARACTER*10 APERT(2000) * --column name of the temperature CHARACTER*16 TNAME * --input target names CHARACTER*20 TARGET(2000), * --target names in reference flux table : REFOBJ(5, 5000) * --output table name CHARACTER*128 OFILE * --error message context CHARACTER*130 CONTXT, MESS *=========================begin hsp.inc========================================= * --status return code INTEGER OK, ERRNUM(20) 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/ * --message destination and priority DATA DEST, PRIO /1, 0/ *=========================end hsp.inc=========================================== *------------------------------------------------------------------------------- * * input parameters from parameter file and data from input table * CALL VASNGT (COUNT, DCOUNT, SKY, TEMP, EPOCH, APERT, DETID, : TARGET, MODE, INDEX, NPTS, OFILE, TNAME, STATUS) IF (STATUS .NE. OK .OR. NPTS .GT. 2000) THEN CONTXT = 'cannot get input parameters/data or more than ' : // '2000 input points' GO TO 999 END IF * * read standard stars' flux density table * CALL VFLUX ( : REFOBJ, REFFLT, REFDET, REFLUX, NFLUX, STATUS) IF (STATUS .NE. OK) THEN CONTXT = 'error getting flux densities' GO TO 999 END IF * * process each input point * NROWS = 0 DO 100 I = 1, NPTS * WRITE (CHAR5, '(I5)') INDEX(I) * * identify filter name from aperture name * DO 10 J = 1, 10 IF (APERT(I)(J:J) .EQ. 'F') GO TO 20 10 CONTINUE * CONTXT = 'illegal aperture name ' // APERT(I) // ' at row ' : // CHAR5 CALL UMSPUT (CONTXT, DEST, PRIO, STATOK) GO TO 100 * 20 FILTER = APERT(I)(J:J+3) * * obtain reference flux density by matching filter, detector ID, and * target name with those in the flux table * DO 40 J = 1, NFLUX IF (FILTER .EQ. REFFLT(J) .AND. : DETID(I) .EQ. REFDET(J)) THEN DO 30 K = 1, 5 IF (TARGET(I) .EQ. REFOBJ(K, J)) THEN FLUX(I) = REFLUX(J) GO TO 50 END IF 30 CONTINUE END IF 40 CONTINUE * * if there is no matching standard stardata, skip and write warning message * CONTXT = 'no reference flux density for ' // TARGET(I) // : ' at filter ' // FILTER // ' at row ' // CHAR5 CALL UMSPUT (CONTXT, DEST, PRIO, STATOK) GO TO 100 * * check if there is sky measurement * 50 IF (MODE(I)(1:3) .EQ. 'SSP') COUNT(I) = COUNT(I) - SKY(I) * * calculate absolute sensitivity * NROWS = NROWS + 1 ASEN(NROWS) = COUNT(I) / FLUX(I) * COUNT(NROWS) = COUNT(I) DCOUNT(NROWS) = DCOUNT(I) FLUX(NROWS) = FLUX(I) TARGET(NROWS) = TARGET(I) APERT(NROWS) = APERT(I) TEMP(NROWS) = TEMP(I) EPOCH(NROWS) = EPOCH(I) 100 CONTINUE * * write result to output table * CALL VASNPT (OFILE, TARGET, APERT, COUNT, DCOUNT, FLUX, ASEN, : TEMP, EPOCH, NROWS, TNAME, STATUS) IF (STATUS .NE. OK) THEN GO TO 999 END IF * STATUS = OK GO TO 1000 * * write error message * 999 MESS = 'VASEN: ' // CONTXT CALL UMSPUT (MESS, DEST, PRIO, STATOK) * 1000 RETURN END