SUBROUTINE YSENSE * * Module Number: 14.9.1 * * Module Name: YSENSE * * Keyphrase: * ---------- * Compute Fos senseitivity * * Description: * ------------ * The unsmoothed FOS sensitivity curve is computed by taking * the ratio of the oberserved flux and the known catalogued flux * for a standard star. To match wavelength scales in obersvation * and the catalogued flux, one of five options are available. * 0) interpolation in observation * 1) interpolation in the standard star flux * 2) integration of observation * 3) integration of standard star * 4) integration of both to equally spaced wavelength bins * * Fortran Name: zsense.for * * Keywords of accessed files and tables: * -------------------------------------- * WAVE input file containing wavelengths of the input * data (ascending order) * INPUT input Observed count rate for the input data * MASK input Mask for observation * STARTAB input Standard star table with columns of * wavelength and flux * TABLE output Output sensitivity table wavelength/value * IMODE input interpolation/integration mode * DELW input wavelength bin size if both observed and * reference fluxes are to be binned * * Subroutines Called: * ------------------- * CDBS: * yratio * SDAS: * uclgs* , umsput * uttinn, utppti, utcdef, utrpt*, utcpt*, uthad*, uttclo, utccre * uttopn, utpgti, utcfnd, utrgt*, utcgt*, uthgt*, uttclo * uimotp, uimxtp, uimctp, uimopn, uimgid, uimclo, uhdgs* uimclo * * History: * -------- * version date Author Description * 1 3/8/87 D. Lindler Designed and coded * *------------------------------------------------------------------------- C INCLUDE FILE FOR THE IRAF77 FORTRAN INTERFACE TO THE IRAF VOS C C C FILE I/O ACCESS MODES C INTEGER RDONLY PARAMETER (RDONLY = 1) INTEGER RDWRIT PARAMETER (RDWRIT = 2) INTEGER WRONLY PARAMETER (WRONLY = 3) INTEGER APPEND PARAMETER (APPEND = 4) C C CODES FOR DATA TYPES C INTEGER TYBOOL PARAMETER (TYBOOL = 1) INTEGER TYCHAR PARAMETER (TYCHAR = 2) INTEGER TYINT PARAMETER (TYINT = 4) INTEGER TYREAL PARAMETER (TYREAL = 6) INTEGER TYDOUB PARAMETER (TYDOUB = 7) C C UMSPUT DESTINATIONS -- CB, DAO, 4-SEP-87 C INTEGER STDOUT PARAMETER (STDOUT = 1) INTEGER STDERR PARAMETER (STDERR = 2) INTEGER USRLOG PARAMETER (USRLOG = 4) C C UHDAS HEADER PARM TYPES -- CB, DAO, 5-SEP-87 C INTEGER GENHDR PARAMETER (GENHDR = 0) INTEGER IMSPEC PARAMETER (IMSPEC = 1) C C THIS SECTION IS FOR PARAMETERS RELEVANT TO TABLE I/O. C C THESE MAY BE SET BY UTPPTI AND/OR READ BY UTPGTI: C C LENGTH OF ROW (UNIT = SIZE OF REAL) INTEGER TBRLEN PARAMETER (TBRLEN = 1) C INCREASE ROW LENGTH INTEGER TBIRLN PARAMETER (TBIRLN = 2) C NUMBER OF ROWS TO ALLOCATE INTEGER TBALLR PARAMETER (TBALLR = 3) C INCREASE ALLOC NUM OF ROWS INTEGER TBIALR PARAMETER (TBIALR = 4) C WHICH TYPE OF TABLE? (ROW OR COLUMN) INTEGER TBWTYP PARAMETER (TBWTYP = 5) C MAXIMUM NUMBER OF USER PARAMETERS INTEGER TBMXPR PARAMETER (TBMXPR = 6) C MAXIMUM NUMBER OF COLUMNS INTEGER TBMXCL PARAMETER (TBMXCL = 7) C TYPE = ROW-ORDERED TABLE INTEGER TBTYPR PARAMETER (TBTYPR = 11) C TYPE = COLUMN-ORDERED TABLE INTEGER TBTYPC PARAMETER (TBTYPC = 12) C C THESE MAY BE READ BY UTPGTI BUT MAY NOT BE SET: C C NUMBER OF ROWS WRITTEN TO INTEGER TBNROW PARAMETER (TBNROW = 21) C C END IRAF77.INC C C ERROR PROCESSING PARAMETERS C INTEGER STATUS,ISTAT,ISTATS(10) CHARACTER*130 CONTXT C C INPUT KEYWORD PARAMETERS C INTEGER MODE DOUBLE PRECISION DELW C C INPUT FILE I/O C CHARACTER*130 NAME,WNAME,MNAME INTEGER IDIN,IDIN2,IDIN3,NAXIS,DTYPE,DIMEN(8),NS DOUBLE PRECISION WOBS(2500),FOBS(2500),MASK(2500) C C DEFAULT MASK IF NONE SUPPLIED C C C STANDARD STAR TABLE PARAMETERS C CHARACTER*64 STARTB INTEGER COLIDS(2) CHARACTER*16 COLNAM(2) LOGICAL NULLS(5000) DOUBLE PRECISION WSTAR(5000),FSTAR(5000) INTEGER NSTAR C C OUTPUT RESULTS TABLE C CHARACTER*64 TABLE INTEGER IDOUT,CTYPE(2) CHARACTER*12 CNAMES(2),CFORM(2),CUNITS(2) DOUBLE PRECISION WAVE(5000),SENS(5000) INTEGER N,I C C OBSERVING MODE PARAMETERS C CHARACTER*5 DET CHARACTER*3 APER,GRAT CHARACTER*6 APERPS CHARACTER*1 POLAR INTEGER PASSDR,XSTEPS C C DATA DECLARATIONS C DATA MASK/2500*1.0/ DATA COLNAM/'WAVELENGTH','FLUX'/ DATA CNAMES/'WAVELENGTH','VALUE'/ DATA CFORM/' ',' '/ DATA CUNITS/' ',' '/ DATA CTYPE/TYREAL,TYREAL/ C----------------------------------------------------------------------------- C C READ CL PARAMETERS C CALL UCLGST('input',NAME,ISTATS(1)) CALL UCLGST('wave',WNAME,ISTATS(2)) CALL UCLGST('mask',MNAME,ISTATS(3)) CALL UCLGST('startab',STARTB,ISTATS(4)) CALL UCLGST('table',TABLE,ISTATS(5)) CALL UCLGSI('imode',MODE,ISTATS(6)) CALL UCLGSD('delw',DELW,ISTATS(7)) DO 10 I=1,7 IF(ISTATS(I).NE.0)THEN CONTXT='Error getting CL parameter' GO TO 999 ENDIF 10 CONTINUE C C READ INPUT OBSERVATIONS (WOBS,FOBS,MASK)--------------------------------- C C C OPEN INPUT FILES C CALL UIMOPN(NAME,RDONLY,IDIN,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error opening input file '//NAME GO TO 999 ENDIF CALL UIMOPN(WNAME,RDONLY,IDIN2,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error opening wavelength file '//WNAME GO TO 999 ENDIF IF(MNAME.NE.' ')THEN CALL UIMOPN(MNAME,RDONLY,IDIN3,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error opening mask file '//MNAME GO TO 999 ENDIF ENDIF C C READ IMAGE INFO C CALL UIMGID(IDIN,DTYPE,NAXIS,DIMEN,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading input file '//NAME GO TO 999 ENDIF C C CHECK FOR VALID DATA C IF((NAXIS.NE.1).OR.(DIMEN(1).GT.2500))THEN CONTXT='Input data must vector with max of 2500 points' GO TO 999 ENDIF NS=DIMEN(1) C C GET OBSERVING MODE INFORMATION C CALL YGMODE(IDIN,DET,GRAT,APER,APERPS,POLAR,PASSDR,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error in file '//NAME GO TO 999 ENDIF CALL UHDGSI(IDIN,'NXSTEPS',XSTEPS,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='NXSTEPS keyword missing from '//NAME GO TO 999 ENDIF C C READ WAVELEGNTH FILE INFO C CALL UIMGID(IDIN2,DTYPE,NAXIS,DIMEN,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading wavelength file '//WNAME GO TO 999 ENDIF C C CHECK FOR VALID DATA C IF((NAXIS.NE.1).OR.(DIMEN(1).NE.NS))THEN CONTXT='Wavelength vector '// * ' must match input file-'//NAME GO TO 999 ENDIF C C READ MASK FILE INFO C IF(MNAME.NE.' ')THEN CALL UIMGID(IDIN3,DTYPE,NAXIS,DIMEN,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading mask file '//MNAME GO TO 999 ENDIF C C CHECK FOR VALID DATA C IF((NAXIS.NE.1).OR.(DIMEN(1).NE.NS))THEN CONTXT='Mask vector '// * ' must match input file- '//NAME GO TO 999 ENDIF ENDIF C C READ DATA C CALL UIGL1D(IDIN,FOBS,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading input file '//NAME GO TO 999 ENDIF CALL UIGL1D(IDIN2,WOBS,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading input file '//WNAME GO TO 999 ENDIF IF(MNAME.NE.' ')THEN CALL UIGL1D(IDIN3,MASK,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading input file '//MNAME GO TO 999 ENDIF ENDIF C C CLOSE IMAGES C CALL UIMCLO(IDIN,ISTAT) CALL UIMCLO(IDIN2,ISTAT) IF(MNAME.NE.' ')CALL UIMCLO(IDIN3,ISTAT) C C DONE READING INPUT DATA ------------------------------------------------ C C C READ INPUT STAR TABLE C CALL UTTOPN(STARTB,RDONLY,IDIN,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error opening input star table '//STARTB GO TO 999 ENDIF CALL UTPGTI(IDIN,TBNROW,NSTAR,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error getting number of rows from '//STARTB GO TO 999 ENDIF CALL UTCFND(IDIN,COLNAM,2,COLIDS,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error locating correct columns in '//STARTB GO TO 999 ENDIF CALL UTCGTD(IDIN,COLIDS(1),1,NSTAR,WSTAR,NULLS,ISTATS(1)) CALL UTCGTD(IDIN,COLIDS(2),1,NSTAR,FSTAR,NULLS,ISTATS(2)) IF((ISTATS(1).NE.0).OR.(ISTATS(2).NE.0))THEN CONTXT='Error reading input star table '//STARTB GO TO 999 ENDIF CALL UTTCLO(IDIN,ISTAT) C C NOW COMPUTE THE SENSITIVITY ------------------------------------------- C CALL YRATIO(WOBS,FOBS,MASK,NS, * WSTAR,FSTAR,NSTAR,XSTEPS,MODE,DELW,WAVE,SENS,N,STATUS) IF(STATUS.NE.0)THEN CONTXT='No output sensitivity table written' GO TO 999 ENDIF C C WRITE OUTPUT SENSITIVITY TABLE --------------------------------------------- C C C OPEN OUTPUT TABLE C CALL UTTINN(TABLE,IDOUT,ISTATS(1)) CALL UTPPTI(IDOUT,TBWTYP,TBTYPC,ISTATS(2)) CALL UTPPTI(IDOUT,TBALLR,N,ISTATS(3)) CALL UTPPTI(IDOUT,TBMXPR,10,ISTATS(4)) CALL UTCDEF(IDOUT,CNAMES,CUNITS,CFORM,CTYPE,2,COLIDS,ISTATS(5)) CALL UTTCRE(IDOUT,ISTATS(6)) DO 200 I=1,5 IF(ISTATS(I).NE.0)THEN CONTXT='Error creating output table '//TABLE GO TO 999 ENDIF 200 CONTINUE C C COPY RESULTS TO TABLE C CALL UTCPTD(IDOUT,COLIDS(1),1,N,WAVE,ISTATS(1)) CALL UTCPTD(IDOUT,COLIDS(2),1,N,SENS,ISTATS(2)) DO 210 I=1,2 IF(ISTATS(I).NE.0)THEN CONTXT='Error writing to output table' GO TO 999 ENDIF 210 CONTINUE C C WRITE OBSERVING MODE TO OUTPUT TABLE HEADER C CALL UTHADT(IDOUT,'DETECTOR',DET,ISTATS(1)) CALL UTHADT(IDOUT,'FGWA_ID',GRAT,ISTATS(2)) CALL UTHADT(IDOUT,'APER_ID',APER,ISTATS(3)) CALL UTHADT(IDOUT,'APER_POS',APERPS,ISTATS(4)) CALL UTHADT(IDOUT,'POLAR_ID',POLAR,ISTATS(5)) CALL UTHADI(IDOUT,'PASS_DIR',PASSDR,ISTATS(6)) DO 220 I=1,6 IF(ISTATS(I).NE.0)THEN CONTXT='Error writing header parameter to '//TABLE GO TO 999 ENDIF 220 CONTINUE CALL UTTCLO(IDOUT,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error closing output table '//TABLE GO TO 999 ENDIF C C DONE C GO TO 1000 999 CALL UMSPUT(CONTXT,STDOUT+STDERR,0,ISTAT) 1000 RETURN END