SUBROUTINE YOFIT * * Module Number: 14.8.4 * * Module Name: YOFIT * * Keyphrase: * ---------- * Fit FOS wavelength offsets * * Description: * ------------ * Dispersion coefficients are computed for a FOS * spectra using a set of reference dispersion coef. * and a table of wavelength and diode offsets from * the reference spectra. The offset table is generated * by routine yoff * * Fortran Name: yofit.for * * Keywords of accessed files and tables: * -------------------------------------- * DCIN input disp.coef. table for reference spectrum * OFFTAB input input offset table generated by YOFF * ORDER input parameter giving the order of the polynomial * to fit offsets. For prism this parameter * is ignored. Only a constant diode offset is * computed. * MINCOUNT input input parameter giving the minimum total counts * in the bin used to compute the offset. * DCOUT output output disp. coef. table * * Subroutines Called: * ------------------- * CDBS: * ydcoff * SDAS: * uclgs* , umsput * uttinn, utppti, utcdef, utrpt*, utcpt*, uthad*, uttclo, utccre * uttopn, utpgti, utcfnd, utrgt*, utcgt*, uthgt*, uttclo * * History: * -------- * version date Author Description * 1 4/20/87 D. Lindler Designed and coded * 2 jan 88 D. Lindler New sdas i/o and standards *------------------------------------------------------------------------- C C ERROR PROCESSING PARAMETERS C 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 INTEGER STATUS,ISTAT,ISTATS(10) CHARACTER*130 CONTXT C C DISPERSION COEF. TABLE PARAMETERS C C C INPUT/OUTPUT DC TABLE PARAMETERS C CHARACTER*64 DCIN,DCOUT INTEGER IDIN,IDOUT,COLIDS(12),NROWS CHARACTER*15 COLNAM(12) CHARACTER*8 CUNITS(12),CFORM(12) INTEGER CTYPE(12) DOUBLE PRECISION COEF(6),COEFO(6) C C OBSERVING MODES C C - MODE FOR OFFSETS C R - MODE FOR REFERENCE SPECTRA THAT THE OFFSETS C ARE RELATIVE TO C 1 - MODE FOR INPUT DISPERSION COEF. C CHARACTER*5 DET,DET1 CHARACTER*3 GRAT,GRAT1,APER,APER1,APERR CHARACTER*6 APERP,APERP1,APERPR CHARACTER*1 POLAR,POLAR1,POLARR INTEGER PASSD,PASSD1,PASSDR C C OFFSET TABLE PARAMETERS C CHARACTER*64 OFFTAB CHARACTER*16 COLIN(5) INTEGER NOFF,NVALID DOUBLE PRECISION WAVE(200),DIODE(200),DELTAW(200), * DELTAD(200),COUNTS(200) LOGICAL NULLS(200) C C KEYWORD VALUES C DOUBLE PRECISION MINC INTEGER ORDER C C OTHERS C INTEGER I,J C C DATA DECLARATIONS C DATA COLNAM/'DETECTOR','APER_ID','APER_POS','FGWA_ID', * 'POLAR_ID','PASS_DIR','COEFF_0','COEFF_1', * 'COEFF_2','COEFF_3','COEFF_4', * 'XZERO'/ DATA CUNITS/12*' '/ DATA CFORM/12*' '/ DATA CTYPE/-5,-3,-6,-3,-1,TYINT,6*TYDOUB/ DATA COLIN/'WAVELENGTH','DIODE','DELTAW','DELTAD','COUNTS'/ C C---------------------------------------------------------------------- C C READ INPUT CL PARAMETERS C CALL UCLGST('offtab',OFFTAB,ISTATS(1)) CALL UCLGST('dcin',DCIN,ISTATS(2)) CALL UCLGST('dcout',DCOUT,ISTATS(3)) CALL UCLGSI('order',ORDER,ISTATS(4)) CALL UCLGSD('mincount',MINC,ISTATS(5)) DO 10 I=1,5 IF(ISTATS(I).NE.0)THEN CONTXT='Error reading CL parameter' GO TO 999 ENDIF 10 CONTINUE C C READ INPUT OFFSET TABLE ---------------------------------------------- C CALL UTTOPN(OFFTAB,RDONLY,IDIN,ISTAT) C --->OPEN TABLE IF(ISTAT.NE.0)THEN CONTXT='Error opening offset table '//OFFTAB GO TO 999 ENDIF CALL UTPGTI(IDIN,TBNROW,NOFF,ISTAT) C --->GET NUMBER OF ROWS IF(ISTAT.NE.0)THEN CONTXT='Error getting number of rows in offtab '//OFFTAB GO TO 999 ENDIF CALL UTCFND(IDIN,COLIN,5,COLIDS,ISTAT) C --->FIND COLUMNS IF(ISTAT.NE.0)THEN CONTXT='Error locating correct columns in offtab '// * OFFTAB GO TO 999 ENDIF C C READ COLUMNS C CALL UTCGTD(IDIN,COLIDS(1),1,NOFF,WAVE,NULLS,ISTATS(1)) CALL UTCGTD(IDIN,COLIDS(2),1,NOFF,DIODE,NULLS,ISTATS(2)) CALL UTCGTD(IDIN,COLIDS(3),1,NOFF,DELTAW,NULLS,ISTATS(3)) CALL UTCGTD(IDIN,COLIDS(4),1,NOFF,DELTAD,NULLS,ISTATS(4)) CALL UTCGTD(IDIN,COLIDS(5),1,NOFF,COUNTS,NULLS,ISTATS(5)) DO 20 I=1,5 IF(ISTATS(I).NE.0)THEN CONTXT='Error reading offset table '//OFFTAB GO TO 999 ENDIF 20 CONTINUE C C READ PARAMETERS DESCRIBING OBSERVING MODE AND REFERENCE SPECTRUM C OBSERVING MODE C CALL UTHGTT(IDIN,'DETECTOR',DET,ISTATS(1)) CALL UTHGTT(IDIN,'FGWA_ID',GRAT,ISTATS(2)) CALL UTHGTT(IDIN,'APER_ID',APER,ISTATS(3)) CALL UTHGTT(IDIN,'APER_POS',APERP,ISTATS(4)) CALL UTHGTT(IDIN,'POLAR_ID',POLAR,ISTATS(5)) CALL UTHGTI(IDIN,'PASS_DIR',PASSD,ISTATS(6)) CALL UTHGTT(IDIN,'APER_REF',APERR,ISTATS(7)) CALL UTHGTT(IDIN,'APOS_REF',APERPR,ISTATS(8)) CALL UTHGTT(IDIN,'POLR_REF',POLARR,ISTATS(9)) CALL UTHGTI(IDIN,'PASS_REF',PASSDR,ISTATS(10)) DO 40 I=1,10 IF(ISTATS(I).NE.0)THEN CONTXT='Error reading observing mode parameters from '// * OFFTAB GO TO 999 ENDIF 40 CONTINUE CALL UTTCLO(IDIN,ISTAT) C C READ INPUT DISPERSION COEFFICIENT TABLE. FIND ROW WITH C CORRECT OBSERVING MODE C CALL UTTOPN(DCIN,RDONLY,IDIN,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='ERROR opening input disp.coef. table '//DCIN GO TO 999 ENDIF CALL UTPGTI(IDIN,TBNROW,NROWS,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error getting number of rows from '//DCIN GO TO 999 ENDIF CALL UTCFND(IDIN,COLNAM,12,COLIDS,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='ERROR locating columns in input dctab '//DCIN GO TO 999 ENDIF C C LOOP ON ROWS UNTIL CORRECT GRATING/DETECTOR FOUND C DO 50 I=1,NROWS CALL UTRGTT(IDIN,COLIDS(1),1,I,DET1,NULLS,ISTATS(1)) CALL UTRGTT(IDIN,COLIDS(2),1,I,APER1,NULLS,ISTATS(2)) CALL UTRGTT(IDIN,COLIDS(3),1,I,APERP1,NULLS,ISTATS(3)) CALL UTRGTT(IDIN,COLIDS(4),1,I,GRAT1,NULLS,ISTATS(4)) CALL UTRGTT(IDIN,COLIDS(5),1,I,POLAR1,NULLS,ISTATS(5)) CALL UTRGTI(IDIN,COLIDS(6),1,I,PASSD1,NULLS,ISTATS(6)) DO 45 J=1,6 IF(ISTATS(J).NE.0)THEN CONTXT='Error reading input disp. table '//DCIN GO TO 999 ENDIF 45 CONTINUE C C DOES IT MATCH THE REFERENCE SPETRUM OBSERVING MODE C IF((GRAT1.EQ.GRAT).AND. * (DET1.EQ.DET).AND. * (APER1.EQ.APERR).AND. * (APERP1.EQ.APERPR).AND. * (POLAR1.EQ.POLARR).AND. * (PASSD1.EQ.PASSDR))GO TO 60 50 CONTINUE C C IF WE MADE IT HERE, WE DID NOT FIND A ROW FOR GIVEN DETECTOR/GRATING C CONTXT='No disp. coef. for offset reference spectrum in ' * //DCIN GO TO 999 C C READ COEFFICIENTS C 60 CALL UTRGTD(IDIN,COLIDS(7),6,I,COEF,NULLS,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='ERROR reading input disp. table '//DCIN GO TO 999 ENDIF C C DELETE POINTS WITH COUNTS LESS THAN MINC AND PERFORM FIT ------------------ NVALID=0 DO 70 I=1,NOFF IF(COUNTS(I).GE.MINC)THEN NVALID=NVALID+1 WAVE(NVALID)=WAVE(I) DELTAW(NVALID)=DELTAW(I) DIODE(NVALID)=DIODE(I) DELTAD(NVALID)=DELTAD(I) COUNTS(NVALID)=COUNTS(I) ENDIF 70 CONTINUE C IF(NVALID.LT.1)THEN CONTXT='Error: All offsets have total counts < mincount' GO TO 999 ENDIF C C CORRECT DISPERSION COEF. C CALL YDCOFF(GRAT,WAVE,DELTAW,DIODE,DELTAD,NVALID,ORDER,COEF, * COEFO,STATUS) IF(STATUS.NE.0)THEN CONTXT='No output disp. coef. table written' GO TO 999 ENDIF C C WRITE OUTPUT DISPERSION COEF. TABLE C C C WRITE OUTPUT TABLE ----------------------------------------------------- C C C OPEN OUTPUT TABLE C CALL UTTINN(DCOUT,IDOUT,ISTATS(1)) CALL UTPPTI(IDOUT,TBRLEN,30,ISTATS(2)) CALL UTPPTI(IDOUT,TBMXCL,12,ISTATS(3)) CALL UTCDEF(IDOUT,COLNAM,CUNITS,CFORM,CTYPE,12,COLIDS,ISTATS(4)) CALL UTTCRE(IDOUT,ISTATS(5)) DO 200 I=1,5 IF(ISTATS(I).NE.0)THEN CONTXT='Error creating output table '//DCOUT GO TO 999 ENDIF 200 CONTINUE C C COPY RESULTS TO TABLE C CALL UTRPTT(IDOUT,COLIDS(1),1,1,DET,ISTATS(1)) CALL UTRPTT(IDOUT,COLIDS(2),1,1,APER,ISTATS(2)) CALL UTRPTT(IDOUT,COLIDS(3),1,1,APERP,ISTATS(3)) CALL UTRPTT(IDOUT,COLIDS(4),1,1,GRAT,ISTATS(4)) CALL UTRPTT(IDOUT,COLIDS(5),1,1,POLAR,ISTATS(5)) CALL UTRPTI(IDOUT,COLIDS(6),1,1,PASSDR,ISTATS(6)) CALL UTRPTD(IDOUT,COLIDS(7),6,1,COEFO,ISTATS(7)) DO 210 I=1,7 IF(ISTATS(I).NE.0)THEN CONTXT='Error writing to output table' GO TO 999 ENDIF 210 CONTINUE CALL UTTCLO(IDOUT,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error closing output table '//DCOUT GO TO 999 ENDIF C C DONE C GO TO 1000 999 CALL UMSPUT(CONTXT,STDOUT+STDERR,0,ISTAT) 1000 RETURN END