SUBROUTINE ZVIGC * * Module number: * * Module name: ZVIGC * * Keyphrase: * ---------- * Compute HRS vignetting * * Description: * ------------ * * This routine computes the unsmoothed HRS vignetting by dividing * an HRS flux vector (processed through all pipeline reduction * steps except for the vignetting correction) by the observed * objects true flux (interpolated to the same wavelength scale * using linear interpolation) * * FORTRAN name: zvigc.for * * Keywords of accessed files and tables: * -------------------------------------- * Name I/O Description / Comments * * input I input flux vector * wave I input wavelength vector * table I input standard star flux table * with columns WAVELENGTH and * FLUX. * output I raw vignetting flux vector. It * will have the same length as input. * * Subroutines Called: * ------------------- * CDBS: * zlintp * SDAS: * uclgs* , umsput * uttopn, utpgti, utcfnd, utrgt*, utcgt*, uthgt*, uttclo * uimotp, uimxtp, uimctp, uimopn, uimgid, uimclo, uhdgs* uimclo * * History: * -------- * Version Date Author Description * 1 Oct 88 D. Lindler Designed and coded *------------------------------------------------------------------------------- C C FILE I/O ACCESS MODES C INTEGER RDONLY PARAMETER (RDONLY = 1) C C CODES FOR DATA TYPES C INTEGER TYREAL PARAMETER (TYREAL = 6) C C UMSPUT DESTINATIONS -- CB, DAO, 4-SEP-87 C INTEGER STDOUT PARAMETER (STDOUT = 1) INTEGER STDERR PARAMETER (STDERR = 2) 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) 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 END IRAF77.INC C C C INPUT FILE I/O C CHARACTER*64 NAME,WNAME,ONAME C --->FILE NAMES INTEGER IDIN,IDIN2,IDOUT C --->FILE IDS INTEGER NAXIS,DTYPE,DIMEN(8),NS C --->DATA DESCRIPTIONS DOUBLE PRECISION DATA(2000),WAVE(2000) C --->DATA BUFFERS C C INPUT TABLE PARAMETERS C CHARACTER*64 TABLE INTEGER IDTAB,NROWS,COLIDS(2) CHARACTER*10 COLNAM(2) DOUBLE PRECISION WSTAR(5000),FSTAR(5000) LOGICAL NULLS(5000) C C OTHER LOCAL VARIABLES C DOUBLE PRECISION FINT(2000) INTEGER I,ISTATS(20),ISTAT CHARACTER*130 CONTXT C C INPUT TABLE DATA C DATA COLNAM/'WAVELENGTH','FLUX'/ C C-------------------------------------------------------------------INPUT CL C C GET CL PARAMETERS C CALL UCLGST('input',NAME,ISTATS(1)) CALL UCLGST('wave',WNAME,ISTATS(2)) CALL UCLGST('table',TABLE,ISTATS(3)) CALL UCLGST('output',ONAME,ISTATS(4)) DO 10 I=1,4 IF(ISTATS(I).NE.0)THEN CONTXT='ERROR obtaining CL parameter value' GO TO 999 ENDIF 10 CONTINUE C C---------------------------------------------------------------INPUT FLUX C C READ INPUT FLUX VECTOR C C C OPEN INPUT FILE C CALL UIMOPN(NAME,RDONLY,IDIN,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error opening input flux file '//NAME GO TO 999 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.2000))THEN CONTXT='Input must be a vector with max. of 2000 points' GO TO 999 ENDIF NS=DIMEN(1) C C READ DATA C CALL UIGL1D(IDIN,DATA,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading input file '//NAME GO TO 999 ENDIF C C CLOSE INPUT IMAGE C CALL UIMCLO(IDIN,ISTAT) C C--------------------------------------------------------------INPUT WAVELENGTHS C READ INPUT WAVELENGTH VECTOR C C OPEN INPUT FILE C CALL UIMOPN(WNAME,RDONLY,IDIN2,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error opening input wave file '//WNAME GO TO 999 ENDIF C C READ IMAGE INFO C CALL UIMGID(IDIN2,DTYPE,NAXIS,DIMEN,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading input file '//WNAME GO TO 999 ENDIF C C CHECK FOR VALID DATA C IF((NAXIS.NE.1).OR.(DIMEN(1).NE.NS))THEN CONTXT='ERROR- wavelength vector not same length as'// * 'input flux vector' GO TO 999 ENDIF C C READ DATA C CALL UIGL1D(IDIN2,WAVE,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading input file '//NAME GO TO 999 ENDIF C C CLOSE IMAGE C CALL UIMCLO(IDIN2,ISTAT) C C------------------------------------------------------------INPUT TABLE C C READ INPUT TABLE OF STANDARD STAR FLUX C CALL UTTOPN(TABLE,RDONLY,IDTAB,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='ERROR opening input table' GO TO 999 ENDIF C C GET NUMBER OF ROWS C CALL UTPGTI(IDTAB,TBNROW,NROWS,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='ERROR getting number of rows in the table' GO TO 999 ENDIF C C GET COLUMN ID'S C CALL UTCFND(IDTAB,COLNAM,2,COLIDS,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='ERROR locating columns in input table' GO TO 999 ENDIF C C READ DATA C CALL UTCGTD(IDTAB,COLIDS(1),1,NROWS,WSTAR,NULLS,ISTATS(1)) CALL UTCGTD(IDTAB,COLIDS(2),1,NROWS,FSTAR,NULLS,ISTATS(2)) IF((ISTATS(1).NE.0).OR.(ISTATS(2).NE.0))THEN CONTXT='ERROR reading data from input table' GO TO 999 ENDIF C C CLOSE TABLE C CALL UTTCLO(IDTAB,ISTAT) C C-----------------------------------------------------------DO USEFUL STUFF C C INTERPOLATE STANDARD STAR FLUX TO SAME WAVELENGTHS SCALE AS INPUT C HRS OBSERVATION C IF((WSTAR(1).GT.WAVE(1)).OR.(WSTAR(NROWS).LT.WAVE(NS)))THEN CONTXT='ERROR- Insufficient wavelength coverage in'// * 'input table' GO TO 999 ENDIF CALL ZLINTP(WSTAR,FSTAR,NROWS,WAVE,FINT,NS,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='ERROR interpolating table flux to input'// * 'observation wavelength scale' GO TO 999 ENDIF C C NORMALIZE INPUT FLUX VECTOR C DO 100 I=1,NS IF(FINT(I).EQ.0.0)THEN DATA(I)=1.0 ELSE DATA(I)=DATA(I)/FINT(I) ENDIF 100 CONTINUE C C--------------------------------------------------------------WRITE OUTPUT C C CREATE OUTPUT FILE USING INPUT FILE AS A TEMPLATE C CALL ZTPLAT(NAME,ONAME,DATA,NS,IDOUT,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='ERROR writing output vignetting vector' GO TO 999 ENDIF CALL UIMCLO(IDOUT,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='ERROR closing output file' GO TO 999 ENDIF C C DONE C GO TO 1000 999 CALL UMSPUT(CONTXT,STDOUT+STDERR,0,ISTAT) 1000 RETURN END