SUBROUTINE ZWOFF * * Module number: 13.9.2 * * Module name: ZWOFF * * Keyphrase: * ---------- * HRS aperture wavelength offsets * * Description: * ------------ * This routine computes the wavelength offsets for different * HRS entrance apertures using cross-correlation between * spectra taken in two differenct apertures. The spectra * are divided into a specified number of boxes, and results * computed for each box(region) of the spectra. * The results are tabulated as a function of carrousel * position, spectral order, wavelength, and photocathode * sample position. * * FORTRAN name: zwoff * * Keywords of accessed files and tables: * -------------------------------------- * Name I/O Description / Comments * * input1 I Reference spectra * wave I wavelength vector for input1 * input2 I Spectra from different aperture * table O Output offset table with columns * carpos - carrousel position * wavelength - wavelength * order - spectral order * sample - photocathode sample pos. * deltaw - wavelength offset * deltas - sample offset * total1 - total flux in box for input1 * total2 - total flux in box for input2 * CL parameters: * tabstat I Output table status (write or append) * nbox I Number of boxes to divied spectra into * maxdist I Maximum distance to search for * correlation offset (data point units) * aperture1 I aperture ID for first spectrum. * aperture2 I aperture ID for second specturm. * fwidth1 I mean filter width for first spectrum. * fwidth2 I mean filter width for second spectrum * * Subroutines Called: * ------------------- * CDBS: * zsprd, crossc, ccprt * SDAS: * uclgs*, uimopn, uimgid, uhdgs*, uigl1d, uimclo, uitinn, * utppti, uttcre, utcdef, uttopn, utpgti, utcfnd, uthgt*, * utcpt*, uthadt, uttclo, umsput * Others: * * * History: * -------- * Version Date Author Description * 1 Oct. 1987 D. Lindler Designed and Coded * 1.1 Jan 92 S. Hulbert New grating values *------------------------------------------------------------------------------- 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) 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 INPUT FILE VARIABLES C INTEGER IDIN,S1(2000),S2(2000),WAVE(2000) INTEGER NS1,NS2,NAXIS,DIMEN(7),DTYPE,XSTEPS C C INPUT CL PARAMETERS C INTEGER NBOX,FWID1,FWID2,MAXD CHARACTER*64 INPUT1,INPUT2,WNAME,TABLE CHARACTER*3 APER1,APER2 CHARACTER*6 TBSTAT C C INPUT HEADER PARAMETERS C INTEGER BINID1,BINID2,CPOS1,CPOS2,ORDER CHARACTER*5 GRAT1,GRAT2 CHARACTER*3 AP1,AP2 C C OUTPUT TABLE VARIABLES C INTEGER IDOUT,NROWS,ROW1,IROW,ROW2 CHARACTER*19 CNAMES(8) INTEGER COLIDS(8),CTYPES(8) CHARACTER*5 CUNITS(8),CFORMS(8) C C RESULTS OF CROSS CORRELATION C DOUBLE PRECISION DELTAS(100),DELTAW(100),SCENT(100),WCENT(100), * TOTAL1(100),TOTAL2(100) INTEGER NGOOD C C OTHER LOCAL VARIABLES C INTEGER ISTATS(20),ISTAT,I CHARACTER*130 CONTXT C C DATA DECLARATIONS C DATA CNAMES/'CARPOS','ORDER','SAMPLE','WAVELENGTH', * 'DELTAS','DELTAW','TOTAL1','TOTAL2'/ DATA CTYPES/TYINT,TYINT,TYREAL,TYDOUB,TYREAL,TYDOUB,TYREAL, * TYREAL/ DATA CFORMS/'I8','I5','F9.2','F11.4','F9.3','F10.4',' ',' '/ DATA CUNITS/8*' '/ C C-------------------------------------------------------------------------- C C GET INPUT CL PARAMETERS C CALL UCLGST('input1',INPUT1,ISTATS(1)) CALL UCLGST('wave',WNAME,ISTATS(2)) CALL UCLGST('input2',INPUT2,ISTATS(3)) CALL UCLGST('table',TABLE,ISTATS(4)) CALL UCLGST('tabstat',TBSTAT,ISTATS(5)) CALL UCLGSI('nbox',NBOX,ISTATS(6)) CALL UCLGSI('maxdist',MAXD,ISTATS(7)) CALL UCLGSI('fwidth1',FWID1,ISTATS(8)) CALL UCLGSI('fwidth2',FWID2,ISTATS(9)) CALL UCLGST('aperture1',APER1,ISTATS(10)) CALL UCLGST('aperture2',APER2,ISTATS(11)) CONTXT='Error reading input CL parameter' DO 10 I=1,11 IF(ISTATS(I).NE.0) GO TO 999 10 CONTINUE C C READ INPUT SPECTRUM 1 C CALL ZSPRD(INPUT1,FWID1,NS1,S1,GRAT1,CPOS1,BINID1,ISTAT) CONTXT='Error reading input1 '//INPUT1 IF(ISTAT.NE.0) GO TO 999 IF(APER1.EQ.' ')THEN APER1='???' IF(BINID1.EQ.1)APER1='SSA' IF(BINID1.EQ.2)APER1='LSA' ENDIF C C READ WAVELENGTHS FOR INPUT1 C CALL UIMOPN(WNAME,RDONLY,IDIN,ISTAT) CONTXT='Error Reading wavelength file '//WNAME IF(ISTAT.NE.0) GO TO 999 CALL UIMGID(IDIN,DTYPE,NAXIS,DIMEN,ISTAT) IF(ISTAT.NE.0) GO TO 999 IF(NAXIS.NE.1)THEN CONTXT='Input wavelenght file must be 1-dimensional' GO TO 999 ENDIF IF(DIMEN(1).NE.NS1) THEN CONTXT='Wavelength file must be same length as spectrum' GO TO 999 ENDIF CALL UIGL1D(IDIN,WAVE,ISTAT) IF(ISTAT.NE.0) GO TO 999 C C GET SPECTRAL ORDER C CALL UHDGSI(IDIN,'sporder',ORDER,ISTAT) CONTXT='Error reading spectral order' IF(ISTAT.NE.0)GO TO 999 CALL UIMCLO(IDIN,ISTAT) C C READ SECOND INPUT SPECTRUM C CALL ZSPRD(INPUT2,FWID2,NS2,S2,GRAT2,CPOS2,BINID2,ISTAT) CONTXT='Error reading input2' IF(ISTAT.NE.0) GO TO 999 IF(NS2.NE.NS1)THEN CONTXT='Input spectra must be same length' GO TO 999 ENDIF IF(CPOS2.NE.CPOS1)THEN CONTXT='Input spectra not at same carrousel position' GO TO 999 ENDIF IF(APER2.EQ.' ')THEN APER2='???' IF(BINID2.EQ.1)APER2='SSA' IF(BINID2.EQ.2)APER2='LSA' ENDIF C C COMPUTE OFFSETS C CALL CROSSC(WAVE,S1,S2,NS1,NBOX,MAXD,WCENT,SCENT,DELTAW, * DELTAS,TOTAL1,TOTAL2,NGOOD) IF(NGOOD.LT.1)THEN CONTXT='No correlation maximum found for any box' GO TO 999 ENDIF C C CONVERT INDICES TO SAMPLE UNITS C XSTEPS=NS1/500 DO 90 I=1,NGOOD SCENT(I)=SCENT(I)/XSTEPS+30 DELTAS(I)=DELTAS(I)/XSTEPS 90 CONTINUE C C PRINT RESULTS C CALL CCPRT(WCENT,SCENT,DELTAW,DELTAS,TOTAL1,TOTAL2,NGOOD,ISTAT) C C OPEN OUTPUT TABLE C IF(TBSTAT.EQ.'write')THEN C C CREATE NEW TABLE C CONTXT='Error creating output table '//TABLE CALL UTTINN(TABLE,IDOUT,ISTATS(1)) CALL UTPPTI(IDOUT,TBMXCL,10,ISTATS(2)) CALL UTPPTI(IDOUT,TBRLEN,12,ISTATS(3)) CALL UTTCRE(IDOUT,ISTATS(4)) CALL UTCDEF(IDOUT,CNAMES,CUNITS,CFORMS,CTYPES,8,COLIDS, * ISTATS(5)) DO 30 I=1,5 IF(ISTATS(I).NE.0) GO TO 999 30 CONTINUE NROWS=0 ELSE C C OPEN EXISTING TABLE FOR APPEND C CONTXT='Error opening/reading existing table'//TABLE CALL UTTOPN(TABLE,RDWRIT,IDOUT,ISTATS(1)) CALL UTPGTI(IDOUT,TBNROW,NROWS,ISTATS(2)) CALL UTCFND(IDOUT,CNAMES,8,COLIDS,ISTATS(3)) DO 40 I=1,3 IF(ISTATS(I).NE.0) GO TO 999 40 CONTINUE C C CHECK FOR GRATING MODE AND APERTURE CONSISTENCY CONSISTENCY C CALL UTHGTT(IDOUT,'grating',GRAT2,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Grating parameter missing from '//TABLE GO TO 999 ENDIF CALL UTHGTT(IDOUT,'aper1',AP1,ISTATS(1)) CALL UTHGTT(IDOUT,'aper2',AP2,ISTATS(2)) IF((ISTATS(1).NE.0).OR.(ISTATS(2).NE.0))THEN CONTXT='Aperture info missing from '//TABLE GO TO 999 ENDIF IF((GRAT2.NE.GRAT1).OR.(AP2.NE.APER2).OR.(AP1.NE.APER1)) * THEN CONTXT='Inconsistent aperture/grating mode'// * 'in input and existing table' GO TO 999 ENDIF ENDIF C C WRITE NEW INFORMATION TO TABLE C ROW1=NROWS+1 ROW2=NROWS+NGOOD CONTXT='Error writing to output table '//TABLE DO 100 IROW=ROW1,ROW2 CALL UTRPTI(IDOUT,COLIDS(1),1,IROW,CPOS1,ISTATS(1)) CALL UTRPTI(IDOUT,COLIDS(2),1,IROW,ORDER,ISTATS(2)) IF((ISTATS(1).NE.0).OR.(ISTATS(2).NE.0)) GO TO 999 100 CONTINUE CALL UTCPTD(IDOUT,COLIDS(3),ROW1,ROW2,SCENT,ISTATS(1)) CALL UTCPTD(IDOUT,COLIDS(4),ROW1,ROW2,WCENT,ISTATS(2)) CALL UTCPTD(IDOUT,COLIDS(5),ROW1,ROW2,DELTAS,ISTATS(3)) CALL UTCPTD(IDOUT,COLIDS(6),ROW1,ROW2,DELTAW,ISTATS(4)) CALL UTCPTD(IDOUT,COLIDS(7),ROW1,ROW2,TOTAL1,ISTATS(5)) CALL UTCPTD(IDOUT,COLIDS(8),ROW1,ROW2,TOTAL2,ISTATS(6)) C CALL UTHADT(IDOUT,'grating',GRAT1,ISTATS(7)) CALL UTHADT(IDOUT,'aper1',APER1,ISTATS(8)) CALL UTHADT(IDOUT,'aper2',APER2,ISTATS(9)) CALL UTTCLO(IDOUT,ISTATS(10)) C DO 110 I=1,10 IF(ISTATS(I).NE.0)GO TO 999 110 CONTINUE C C DONE C GO TO 1000 999 CALL UMSPUT(CONTXT,STDOUT+STDERR,0,ISTAT) 1000 RETURN END