SUBROUTINE YDFIT * * Module Number: 14.8.2 * * Module Name: YDFIT * * Keyphrase: * ---------- * Fit FOS dispersion coef. * * Description: * ------------ * This routine uses the wavelengths and line positions found * by YCOR to compute a least squares fit of wavelength as a function * of line position. For all gratings a polynomial is used. for * the prism the function: * * wave = a(1) + a(2)/xx + a(3)/xx**2 + a(4)/xx**3 + a(5)/xx**4 * * is used where: xx is the sample position-xzero * * Fortran Name: ydfit * * Keywords of accessed files and tables: * -------------------------------------- * table input found sample location table (output of ycor) * dcin input previous disperion coef. needed only for prsim * dcout output output dispersion table * * Subroutines Called: * ------------------- * CDBS: * ydcfit * 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/1/87 D. Lindler Designed and coded * 2 Jan 88 D. Lindler New sdas i/o and standards * 3 Aug 88 D. Lindler Added fit weights. *------------------------------------------------------------------------- C C ERROR PROCESSING PARAMTERS 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 INPUT TABLE PARAMETERS C CHARACTER*64 TABLE INTEGER IDIN CHARACTER*10 COLIN(5) DOUBLE PRECISION WAVE(200),SAMP(200),SAPPX(200),PEAK(200), * WEIGHT(200) INTEGER NWAVE LOGICAL NULLS(200) DOUBLE PRECISION COEF(6) C C INPUT/OUTPUT DC TABLE PARAMETERS C CHARACTER*64 DCIN,DCOUT INTEGER IDOUT,COLIDS(15),NROWS CHARACTER*12 COLNAM(15) CHARACTER*8 CUNITS(15),CFORM(15) INTEGER CTYPE(15) CHARACTER*5 DET,DET1 CHARACTER*3 GRAT,GRAT1,APER CHARACTER*6 APERPS CHARACTER*1 POLAR INTEGER PASSDR C C KEYWORD PARAMETERS C DOUBLE PRECISION MAXDEV,MININT,NSIG INTEGER NTRY,NITER,ORDER C C OTHER LOCAL VARIABLES C INTEGER I,NFIT DOUBLE PRECISION RMSFIT C C DATA DECLARATIONS C DATA COLIN/'WAVELENGTH','SAPPROX','SFOUND','PEAK_COUNT', * 'WEIGHT'/ DATA COLNAM/'DETECTOR','APER_ID','APER_POS','FGWA_ID', * 'POLAR_ID','PASS_DIR','COEFF_0','COEFF_1', * 'COEFF_2','COEFF_3','COEFF_4', * 'XZERO','NLINES','NGOOD','RMSFIT'/ DATA CUNITS/14*' ','DIODES'/ DATA CFORM/15*' '/ DATA CTYPE/-5,-3,-6,-3,-1,TYINT,6*TYDOUB,2*TYINT,TYDOUB/ C C ---------------------------------------------------------------- C C READ INPUT CL PARAMETERS C CALL UCLGST('table',TABLE,ISTATS(1)) CALL UCLGST('dcin',DCIN,ISTATS(2)) CALL UCLGST('dcout',DCOUT,ISTATS(3)) CALL UCLGSD('maxdev',MAXDEV,ISTATS(4)) CALL UCLGSD('minint',MININT,ISTATS(5)) CALL UCLGSI('order',ORDER,ISTATS(6)) CALL UCLGSD('nsig',NSIG,ISTATS(7)) CALL UCLGSI('ntry',NTRY,ISTATS(8)) CALL UCLGSI('niter',NITER,ISTATS(9)) DO 5 I=1,9 IF(ISTATS(I).NE.0)THEN CONTXT='Error reading CL parameter' GO TO 999 ENDIF 5 CONTINUE C C READ INPUT TABLE --------------------------------------------------------- C CALL UTTOPN(TABLE,RDONLY,IDIN,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error opening input table '//TABLE GO TO 999 ENDIF CALL UTPGTI(IDIN,TBNROW,NWAVE,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading number of rows in '//TABLE GO TO 999 ENDIF CALL UTCFND(IDIN,COLIN,5,COLIDS,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error locating correct column(s) in '//TABLE GO TO 999 ENDIF IF(NWAVE.GT.200)THEN CONTXT='Maximum of 200 rows in input table allowed' GO TO 999 ENDIF CALL UTHGTT(IDIN,'DETECTOR',DET,ISTATS(1)) CALL UTHGTT(IDIN,'APER_ID',APER,ISTATS(2)) CALL UTHGTT(IDIN,'APER_POS',APERPS,ISTATS(3)) CALL UTHGTT(IDIN,'FGWA_ID',GRAT,ISTATS(4)) CALL UTHGTT(IDIN,'POLAR_ID',POLAR,ISTATS(5)) CALL UTHGTI(IDIN,'PASS_DIR',PASSDR,ISTATS(6)) DO 30 I=1,6 IF(ISTATS(I).NE.0)THEN CONTXT='Detector, grating, aperture, polarizer '// * 'information incomplete in input table' GO TO 999 ENDIF 30 CONTINUE CALL UTCGTD(IDIN,COLIDS(1),1,NWAVE,WAVE,NULLS,ISTATS(1)) CALL UTCGTD(IDIN,COLIDS(2),1,NWAVE,SAPPX,NULLS,ISTATS(2)) CALL UTCGTD(IDIN,COLIDS(3),1,NWAVE,SAMP,NULLS,ISTATS(3)) CALL UTCGTD(IDIN,COLIDS(4),1,NWAVE,PEAK,NULLS,ISTATS(4)) CALL UTCGTD(IDIN,COLIDS(5),1,NWAVE,WEIGHT,NULLS,ISTATS(5)) DO 40 I=1,5 IF(ISTATS(I).NE.0)THEN CONTXT='ERROR reading input table '//TABLE GO TO 999 ENDIF 40 CONTINUE CALL UTTCLO(IDIN,ISTAT) C C IF PRISM THEN READ PREVIOUS DISP COEF. --------------------------------- C IF(GRAT.EQ.'PRI')THEN 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(4),1,I,GRAT1,NULLS,ISTATS(2)) IF((ISTATS(1).NE.0).OR.(ISTATS(2).NE.0))THEN CONTXT='Error reading input disp. table '//DCIN GO TO 999 ENDIF IF((GRAT1.EQ.GRAT).AND.(DET1.EQ.DET))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. in input table for '//DET//' PRISM' 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 ELSE C C GRATING MODE ---- INITIALIZE COEF. TO ZERO C DO 90 I=1,6 COEF(I)=0.0 90 CONTINUE ENDIF C C DELETE BAD LINES BY SETTING SFOUND TO ZERO ------------------------------- C DO 110 I=1,NWAVE IF((DABS(SAMP(I)-SAPPX(I)).GT.MAXDEV).OR. * (PEAK(I).LT.MININT))SAMP(I)=0.0 110 CONTINUE C C PERFORM FIT -------------------------------------------------------------- C CALL YDCFIT(WAVE,SAMP,WEIGHT,NWAVE,GRAT,ORDER,NSIG,NTRY,NITER, * COEF,NFIT,RMSFIT,STATUS) IF(STATUS.NE.0)THEN CONTXT='No output dc table written' GO TO 999 ENDIF 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,15,ISTATS(3)) CALL UTCDEF(IDOUT,COLNAM,CUNITS,CFORM,CTYPE,15,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,APERPS,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,COEF,ISTATS(7)) CALL UTRPTI(IDOUT,COLIDS(13),1,1,NWAVE,ISTATS(8)) CALL UTRPTI(IDOUT,COLIDS(14),1,1,NFIT,ISTATS(9)) CALL UTRPTD(IDOUT,COLIDS(15),1,1,RMSFIT,ISTATS(10)) DO 210 I=1,10 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