SUBROUTINE ZYCOEF(N,CARPOS,ORDER,YDEF,GRAT,TABLE,STATUS) C C Module Number: 13.3.3.2.1 C C Module Name: zycoef C C Keyphrase: C ---------- C compute y-deflection calibration coefficients C C C Description: C ------------ C the coefficients a,b,c and d are computed in the equation: C ydef = a + b*w +c*w*w + d*m*w C using a least squares fit. C w is the wavelength computed using carrousel calibration C coeffients A,B, and C stored in the input table C w = A/m * sin((C-carpos)/B) C m is the spectral order C carpos is the carrousel position C C C FORTRAN Name: zycoef.for C C C Keywords of Accessed Files : C -------------------------- C NONE C C Modules Called: C --------------- C SDAS: C UMSPUT C C History: C -------- C Version Date Author Description C 1 Oct 86 D. Lindler Designed and coded C 2 Dec 87 D. Lindler New sdas i/o and standards C 2.1 Jan 92 S. Hulbert New grating values 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) 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 PARAMETERS C INTEGER N C --->NUMBER OF VALUES IN CARPOS,ORDER,YDEF DOUBLE PRECISION CARPOS(N) C --->CARROUSEL POSITIONS DOUBLE PRECISION ORDER(N) C --->SPECTRAL ORDER NUMBERS DOUBLE PRECISION YDEF(N) C --->Y-DEFLECTIONS CHARACTER*5 GRAT C --->GRATING MODE C C INPUT/OUTPUT PARAMETERS C DOUBLE PRECISION TABLE(7) C --->ROW OF CARROUSEL CALIB. TABLE C (1) - A C (2) - a C (3) - B C (4) - b C (5) - C C (6) - c C (7) - d C C OUTPUT PARAMETER C INTEGER STATUS C --->ERROR STATUS C C LOCAL VARIABLES C DOUBLE PRECISION WAVE(500) C --->WAVELENGTHS DOUBLE PRECISION MW(500) C --->WAVELENGTH TIMES ORDER NUMBER DOUBLE PRECISION COEF(4) C --->COEFF. OF FIT DOUBLE PRECISION CHISQ,COVAR(4,4) DOUBLE PRECISION YFIT(500) C --->FITTED VALUES OF Y DOUBLE PRECISION SIG(500) C --->SIGMAS OF Y-DEFS DOUBLE PRECISION DIFF C --->OBSERVED MINUS FIT DOUBLE PRECISION SUM C --->SUMSQ OF DIFFs INTEGER MM C --->INTEGER VALUE OF ORDER NUMBER DOUBLE PRECISION RMS C --->ROOT MEAN SQUARE OF DIFFs LOGICAL ECHELL C --->ECHELLE FLAG FOR E-A AND E-B INTEGER I C --->INDICES CHARACTER*130 MESS C --->FUNCTION TO FIT INTEGER LISTA(4) C --->LIST OF TERMS TO FIT INTEGER ISTAT C C DATA DECLARATIONS C EXTERNAL ZYDFUN DATA SIG/500*1.0/ C------------------------------------------------------------------------- C C DETERMINE IF ECHELLE MODE C IF((GRAT.EQ.'E-A'.OR.GRAT.EQ.'ECH-A').OR. $ (GRAT.EQ.'E-B'.OR.GRAT.EQ.'ECH-B'))THEN ECHELL=.TRUE. ELSE ECHELL=.FALSE. ENDIF C C COMPUTE WAVELENGTHS FOR EACH POINT C DO 10 I=1,N WAVE(I)=TABLE(1)/ORDER(I)*DSIN((TABLE(5)-CARPOS(I))/TABLE(3)) MW(I)=WAVE(I)*ORDER(I) 10 CONTINUE C C SELECT TERM TO FIT C IF (ECHELL) THEN LISTA(1)=1 LISTA(2)=2 LISTA(3)=4 COEF(3)=0.0 ELSE LISTA(1)=1 LISTA(2)=2 LISTA(3)=3 COEF(4)=0.0 ENDIF C C PREFORM FIT C CALL LFIT2(WAVE,MW,YDEF,SIG,N,COEF,4,LISTA,3,COVAR,4,CHISQ, * ZYDFUN,STATUS) IF(STATUS.NE.0)GO TO 1000 C C COMPUTE FITTED VALUES C DO 50 I=1,N YFIT(I)=COEF(1) + WAVE(I)*COEF(2) + * COEF(3)*WAVE(I)*WAVE(I) + MW(I)*COEF(4) 50 CONTINUE C C PRINT HEADING FOR PRINTED TABLE OF RESULTS C WRITE(MESS,99)GRAT 99 FORMAT(' YDEFLECTION CALIBRATION FOR GRATING ',A5) CALL UMSPUT(MESS,STDOUT,0,ISTAT) WRITE(MESS,199) 199 FORMAT(' CAR. POS. ORDER WAVELENGTH Y-DEF Y-FIT DIFF.') CALL UMSPUT(MESS,STDOUT,0,ISTAT) C C PRINT RESULTS OF THE FIT AND COMPUTE RMS ERROR OF RESIDUALS C SUM=0.0 DO 20 I=1,N DIFF=YDEF(I)-YFIT(I) SUM=SUM+DIFF*DIFF C C PRINT TABLE C MM=ORDER(I) WRITE(MESS,299)CARPOS(I),MM,WAVE(I),YDEF(I),YFIT(I),DIFF 299 FORMAT(F9.0,I7,F13.2,3F8.1) CALL UMSPUT(MESS,STDOUT,0,ISTAT) 20 CONTINUE C C COMPUTE RMS ERROR C RMS=SQRT(SUM/N) WRITE(MESS,399)RMS 399 FORMAT('RMS OF RESIDUALS=',F5.1) CALL UMSPUT(MESS,STDOUT,0,ISTAT) C C PLACE COEFFICIENTS INTO OUTPUT TABLE C TABLE(2)=COEF(1) TABLE(4)=COEF(2) TABLE(6)=COEF(3) TABLE(7)=COEF(4) C C PRINT COEFFICIENTS C WRITE(MESS,499)TABLE(2),TABLE(4),TABLE(6),TABLE(7) 499 FORMAT(' COEF. OF FIT ',F10.1,F10.3,E12.4,E12.4) CALL UMSPUT(MESS,STDOUT,0,ISTAT) STATUS=0 C C DONE C 1000 RETURN END