SUBROUTINE YDCFIT(WAVE,SAMP,WEIGHT,N,GRAT,ORDER,NSIG,NTRY,NITER, * COEF,NFIT,RMSFIT,STATUS) * * Module number: 14.8.2.1 * * Module name: YDCFIT * * Keyphrase: * ---------- * Fit FOS dispersion coefficients * Description: * ------------ * This routine does a least squares fit to the dispersion * coefficients relating wavelength as a function of sample * position. For the gratings the relation is a polynomial * with the specified order. For the prism a non-linear least * squares fit is perrformed using the Numerical Recipe routine * MRQMIN. * * The fit is performed up to NTRY times. After each try lines * with a residual of NSIG times the rms residual of all lines * are deleted from the analysis. * * FORTRAN name: zdcfit.for * * Keywords of accessed files and tables: * -------------------------------------- * none * Subroutines Called: * ------------------- * CDBS: * yevald, ydcprt, mrqmin, polyft * SDAS: * umsput * * History: * -------- * Version Date Author Description * 1 Jan 88 D. Lindler Designed and coded * 2 AUG 88 D. Lindler Added fit weights *------------------------------------------------------------------------------- C C INPUT PARAMETERS C C WAVE - VECTOR OF WAVLENGTHS (REAL*8) C SAMP - VECTOR OF SAMPLE POSITIONS (REAL*8) C WEIGHT - WEIGHTS (REAL*8) C N - NUMBER OF WAVELENGTHS (INTEGER) C GRAT - GRATING MODE (CHAR*3) C ORDER - ORDER OF POLYNOMIAL (INTEGER) C NSIG - REJECTION LIMIT (REAL*8) C NTRY - NUMBER OF TRIES FOR FIT (INTEGER) C NITER - NUMBER OF ITERATIONS FOR NON-LINEAR LEAST SQUARES C PRISM FIT. C COEF - INPUT STARTING GUESS FOR PRISM FIT. C C OUTPUT PARAMETERS C C WAVE,SAMP - UPDATED VECTORS WITH BAD LINES REMOVED C NFIT - NUMBER OF GOOD LINES (OUTPUT SIZE OF WAVE AND SAMP) C RMSFIT - RMS ERROR OF FIT (REAL*8) C STATUS - ERROR STATUS (INTEGER) C 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 DOUBLE PRECISION WAVE(1),SAMP(1),NSIG,COEF(1),RMSFIT,WEIGHT(1) INTEGER N,ORDER,NTRY,NITER,NFIT,STATUS CHARACTER*3 GRAT C C LOCAL VARIABLES C INTEGER I,ITRY,NGOOD,ISTAT,XSTAT DOUBLE PRECISION DIFF(200) CHARACTER*130 CONTXT C C NON-LINEAR LEAST SQUARE FIT PARAMETERS C C --->FUNCTION FOR MRQMIN DOUBLE PRECISION ALPHA(6,6),ALAMDA,COVAR(6,6),CHISQ,YFIT(200) INTEGER LISTA(6) DOUBLE PRECISION SIGMAS(200) C C DATA DECLARATIONS C EXTERNAL YFUNCP DATA LISTA/1,2,3,4,5,6/ DATA SIGMAS/200*1.0/ C-------------------------------------------------------------------------- C C LOOP UP TO NTRIES C NFIT=N DO 500 ITRY=1,NTRY C C DELETE BAD LINES C NGOOD=0 DO 5 I=1,NFIT IF((SAMP(I).GT.0.0).AND.(WEIGHT(I).GT.0.0))THEN NGOOD=NGOOD+1 SAMP(NGOOD)=SAMP(I) WAVE(NGOOD)=WAVE(I) WEIGHT(NGOOD)=WEIGHT(I) SIGMAS(NGOOD)=SQRT(1/WEIGHT(NGOOD)) ENDIF 5 CONTINUE NFIT=NGOOD C C PERFORM FIT C IF(GRAT.EQ.'PRI')THEN C C -------------------------- PRISM MODE ------------------------------------ IF(NFIT.LT.7)THEN CONTXT='Too few lines to fit' GO TO 999 ENDIF C C INITIALIZE LEAST SQUARES ROUTINE C CONTXT='Error fitting coefficients for PRISM mode' ALAMDA=-1.0 CALL MRQMIN(SAMP,WAVE,SIGMAS,NFIT,COEF,6,LISTA,6,COVAR, * ALPHA,6,CHISQ,YFUNCP,ALAMDA,ISTAT) IF(ISTAT.NE.0) GO TO 999 C C ITERATE NITER TIMES C DO 20 I=1,NITER CALL MRQMIN(SAMP,WAVE,SIGMAS,NFIT,COEF,6,LISTA,6, * COVAR,ALPHA,6,CHISQ,YFUNCP,ALAMDA,ISTAT) IF(ISTAT.NE.0) GO TO 999 20 CONTINUE C C CLEAN UP C ALAMDA=0.0 CALL MRQMIN(SAMP,WAVE,SIGMAS,NFIT,COEF,6,LISTA,6,COVAR, * ALPHA,6,CHISQ,YFUNCP,ALAMDA,ISTAT) IF(ISTAT.NE.0) GO TO 999 C C COMPUTE FITTED VALUES C DO 30 I=1,N CALL YDCF(SAMP(I),GRAT,COEF,YFIT(I)) 30 CONTINUE C C -------------------------- GRATING MODE ------------------------------------- C ELSE IF(NFIT.LE.(ORDER+1))THEN CONTXT='Too Few lines to perform fit' GO TO 999 ENDIF CALL POLYFT(SAMP,WAVE,SIGMAS,NFIT,ORDER,COEF,YFIT,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error computing disp. coef. for grating' GO TO 999 ENDIF ENDIF C C ---------------------------EVALUTATE RESULTS-------------------------------- C CALL YEVALD(WAVE,NFIT,SAMP,YFIT,NSIG,GRAT,COEF,RMSFIT,DIFF, * XSTAT) CALL YDCPRT(NFIT,SAMP,WAVE,YFIT,RMSFIT,DIFF,ORDER,COEF) IF(XSTAT.EQ.0)GO TO 600 C --->NO BAD LINES? 500 CONTINUE C C IF WE MADE IT HERE WE DID NTRY FITS AND STILL FOUND BAD LINES C CALL UMSPUT('Warning: ntry fits performed with additional '// * 'bad lines found',STDOUT,0,ISTAT) C C DONE C 600 STATUS=0 GO TO 1000 999 CALL UMSPUT(CONTXT,STDOUT,0,ISTAT) STATUS=1 1000 RETURN END