SUBROUTINE YRATIO(WO,FO,MASK,NOBS,WSTAR,FSTAR,NSTAR,XSTEPS, * MODE,DELW,WAVE,SENS,N,STATUS) * * Module Number: 14.9.1.1 * * Module Name: YRATIO * * Keyphrase: * ---------- * Compute FOS sensivity * * Description: * ------------ * The FOS sensivity is computed as the ratio of the observed counts * and the actual flux in the observed star. Linear interpolation * or trapezoidal integration is used to match wavelength scales. * The method is determined by the input MODE * MODE = 0 interpolate in observed counts * 1 interpolate in star's flux * 2 integrate in observed counts * 3 integrate in star's flux * 4 integrate in both in bins of DELW * * Fortran Name: yratio.for * * Keywords of accessed files and tables: * -------------------------------------- * none * * Subroutines Called: * ------------------- * CDBS: * zinteg, zlintp * SDAS: * umsput * * History: * -------- * version date Author Description * 1 3/10/87 D. Lindler Designed and coded * 2 Jan 88 D. Lindler New sdas i/o and standards *------------------------------------------------------------------------- * * Input parameters * * WO - wavelength vector for observation (real*8) * FO - observed flux or count rate for star (real*8) * MASK - data quality mask for observation (real*8) * NOBS - number of points in WOBS, FOBS, and MASK (integer) * WSTAR - wavelength vector stellar reference flux (real*8) * FSTAR - flux of reference star (real*8) * NSTAR - number of points in WSTAR and FSTAR * XSTEPS - xsteps of observation (1, 2 or 4) integer * MODE - interpolation /integration mode (integer) * DELW - wavelength bin size for mode 4 * * Output parameters * * WAVE - wavelength vector for sensitivity (real*8) * SENS - sensititivy vector (real*8) * N - number of points in WAVE and SENS (integer) * STATUS - error status (character*8) * 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 DOUBLE PRECISION WO(*),FO(*),MASK(*),WSTAR(*),FSTAR(*), * DELW,WAVE(*),SENS(*) INTEGER NOBS,NSTAR,XSTEPS,MODE,N INTEGER STATUS C C LOCAL VARIABLES C DOUBLE PRECISION WOBS(2500),FOBS(2500) DOUBLE PRECISION WMIN,WMAX,FLUXS(5000),FLUXO(5000) DOUBLE PRECISION RLOW(5000),RHIGH(5000),WLO(5000),WHI(5000) DOUBLE PRECISION X(2500),XHI(2500),XLO(2500) INTEGER NGOOD C INTEGER I CHARACTER*130 CONTXT C---------------------------------------------------------------------------- C C DELETE MASKED POINTS IN OBSERVED SPECTRUM C NGOOD=0 DO 10 I=1,NOBS IF(MASK(I).EQ.1.0)THEN NGOOD=NGOOD+1 WOBS(NGOOD)=WO(I) FOBS(NGOOD)=FO(I) ENDIF 10 CONTINUE C NOBS=NGOOD IF(NOBS.LT.1)THEN CONTXT='ALL POINTS MASKED AS BAD IN INPUT SPECTRA' GO TO 999 ENDIF C C DETERMINE OVERLAP IN WAVELENGTH RANGES C WMIN=WOBS(1) IF(WSTAR(1).GT.WMIN) WMIN=WSTAR(1) WMAX=WOBS(NOBS) IF(WSTAR(NSTAR).LT.WMAX) WMAX=WSTAR(NSTAR) IF(WMAX.LT.WMIN)THEN CONTXT='NO OVERLAP IN OBSERVED AND REFERENCE WAVELENGTHS' GO TO 999 ENDIF C C MODE 0 INTERPOLATE IN OBSERVED COUNT RATE TO MATCH WAVELENGTH SCALE ------ C OF REFERENCE STAR C IF(MODE.EQ.0)THEN CALL ZLINTP(WOBS,FOBS,NOBS,WSTAR,FLUXO,NSTAR,STATUS) N=NSTAR DO 5 I=1,N FLUXS(I)=FSTAR(I) WAVE(I)=WSTAR(I) 5 CONTINUE ENDIF C C MODE 1 INTERPOLATE REFERENCE SPECTRA TO MATCH OBSERVED ----------------- C IF(MODE.EQ.1)THEN CALL ZLINTP(WSTAR,FSTAR,NSTAR,WOBS,FLUXS,NOBS,STATUS) N=NOBS DO 12 I=1,N WAVE(I)=WOBS(I) FLUXO(I)=FOBS(I) 12 CONTINUE ENDIF C C MODE 2 INTEGRATE OBSERVED COUNTS TO MATCH REFERENCE STAR ---------------- C IF(MODE.EQ.2)THEN C C COMPUTE WAVELENGTH RANGES C DO 15 I=2,NSTAR WLO(I)=(WSTAR(I-1)+WSTAR(I))/2.0 15 CONTINUE WLO(1)=WSTAR(1)-(WSTAR(2)-WSTAR(1))/2.0 DO 20 I=1,NSTAR-1 WHI(I)=(WSTAR(I)+WSTAR(I+1))/2.0 20 CONTINUE WHI(NSTAR)=WSTAR(NSTAR)+ * (WSTAR(NSTAR)-WSTAR(NSTAR-1))/2.0 C C INTEGRATE OBSERVATION FROM WLO TO WHI C CALL ZINTEG(WOBS,FOBS,NOBS,WLO,WHI,NSTAR, * RLOW,RHIGH,FLUXO) C C NORMALIZE BY WAVELENGTH INTERVAL C DO 30 I=1,NSTAR FLUXO(I)=FLUXO(I)/(WHI(I)-WLO(I)) 30 CONTINUE C C KEEP STANDARD STAR AS IS C N=NSTAR DO 35 I=1,N WAVE(I)=WSTAR(I) FLUXS(I)=FSTAR(I) 35 CONTINUE ENDIF C C MODE 3 INTEGRATE STANDARD STAR TO MATCH OBSERVATION --------------------- C IF(MODE.EQ.3)THEN C C COMPUTE WAVELENGTH INTERVALS C DO 50 I=1,NOBS XLO(I)=I-XSTEPS/2.0 X(I)=I XHI(I)=I+XSTEPS/2.0 50 CONTINUE CALL ZLINTP(X,WOBS,NOBS,XLO,WLO,NOBS,STATUS) CALL ZLINTP(X,WOBS,NOBS,XHI,WHI,NOBS,STATUS) C C INTEGRATE BETWEEN WLO AND WHI C CALL ZINTEG(WSTAR,FSTAR,NSTAR,WLO,WHI,NOBS, * RLOW,RHIGH,FLUXS) DO 60 I=1,NOBS FLUXS(I)=FLUXS(I)/(WHI(I)-WLO(I)) 60 CONTINUE C C LEAVE OBSERVATION AS IS C N=NOBS DO 65 I=1,N WAVE(I)=WOBS(I) FLUXO(I)=FOBS(I) 65 CONTINUE ENDIF C C MODE 4 ITNEGRATE BOTH INTO EQUALLY SPACED WAVELEGNTH BINS C IF(MODE.EQ.4) THEN N=(WMAX-WMIN)/DELW IF(N.GT.5000)THEN CONTXT='WAVELENGTH INTERVAL TOO SMALL (DELW)' GO TO 999 ENDIF C C COMPUTE OUTPUT WAVELENGTHS AND INTEGRATION LIMITS C DO 80 I=1,N WLO(I)=WMIN+(I-1)*DELW WHI(I)=WLO(I)+DELW WAVE(I)=WLO(I)+DELW/2.0 80 CONTINUE C C INTEGRATE IN BOTH SPECTRA C CALL ZINTEG(WOBS,FOBS,NOBS,WLO,WHI,N,RLOW,RHIGH,FLUXO) CALL ZINTEG(WSTAR,FSTAR,NSTAR,WLO,WHI,N, * RLOW,RHIGH,FLUXS) ENDIF C C COMPUTE RATIO (SENSITIVITY) DELETE POINTS WHERE STAR FLUX=0.0 C NGOOD=0 DO 100 I=1,N IF((WAVE(I).GE.WMIN).AND.(WAVE(I).LE.WMAX).AND. * (FLUXS(I).GT.0.0))THEN NGOOD=NGOOD+1 SENS(NGOOD)=FLUXO(I)/FLUXS(I) WAVE(NGOOD)=WAVE(I) ENDIF 100 CONTINUE N=NGOOD IF(N.LT.1)THEN CONTXT='NO NON-ZERO FLUX VALUES IN REGION OF '// * 'WAVELENGTH OVERLAP' GO TO 999 ENDIF C STATUS=0 GO TO 1000 999 CALL UMSPUT(CONTXT,STDOUT+STDERR,0,STATUS) STATUS=1 1000 RETURN END