SUBROUTINE ZCCFIT(NPOS,DCIN,GRAT,COEF,STATUS) C C Module Number: 13.3.2.1 C C Module Name: zccfit C C Keyphrase: C ---------- C Update HRS carrousel calibration C C C Description: C ------------ C The Coefficient C in the HRS carrousel calibration giving C the carrousel position as a function of spectral order and C grating mode is updated using the wavelengths from dispersion C coefficients at known carrousel positions. C C C FORTRAN Name: zccfit.for C C C Keywords of Accessed Files : C -------------------------- C none C C Modules Called: C --------------- C CDBS: C zwcomp 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 NPOS C --->NUMBER OF POSITIONS OBSERVED DOUBLE PRECISION DCIN(8,NPOS) C --->INPUT DISP. COEF. C DCIN(1,I)= CPOS C DCIN(2,I)= A0 C ... C DCIN(8,I)= A6 CHARACTER*5 GRAT C --->GRATING MODE C C OUTPUT PARAMETERS C DOUBLE PRECISION COEF(7) C --->OUTPUT TABLE BUFFER C COEF(1)=CAP_A C COEF(2)=LIT_A C COEF(3)=CAP_B C COEF(4)=LIT_B C COEF(5)=CAP_C C COEF(6)=LIT_C C COEF(7)=LIT_D INTEGER STATUS C C LOCAL VARIABLES C DOUBLE PRECISION WOLD(100) C --->CENTRAL WAVELENGTHS USING OLD CALIB DOUBLE PRECISION WNEW(100) C --->CENTRAL WAVELENGTHS FROM DISP.COEF. DOUBLE PRECISION R(100) C --->CAR. POSITIONS COMPUTED USING OLD CALIB DOUBLE PRECISION TOT,AVE C --->TOTAL AND AVERAGE CARROUSEL OFFSET DOUBLE PRECISION M C --->SPECTRAL ORDER DOUBLE PRECISION A,B,C C --->CARROUSEL COEFFICIENTS CHARACTER*130 CONTXT,MESS C --->TEXT MESSS DOUBLE PRECISION ARG C --->ARGUMENT FOR ARCSIN INTEGER ISTAT INTEGER I C --->INDEX DOUBLE PRECISION DIFF1,DIFF2 C --->WAVELENGTH DIFFERENCES DOUBLE PRECISION NEWW C --->WAVELENGTH USING NEW CALIB C------------------------------------------------------------------ C C DETERMINE SPECTRAL ORDER (USE 1 FOR GRATINGS 1 TO 5) AND CENTRAL C ORDER FOR ECHELLE MODES C M=1.0 IF(GRAT.EQ.'ECH-A'.OR.GRAT.EQ.'E-A')M=42.0 IF(GRAT.EQ.'ECH-B'.OR.GRAT.EQ.'E-B')M=25.0 C C GET PREVIOUS CALIBRATION VALUES C A=COEF(1) B=COEF(3) C=COEF(5) TOT=0.0 C --->INITIALIZE TOTAL ERROR C C LOOP ON ALL SUPPLIED CARROUSEL POSITIONS C DO 100 I=1,NPOS C C COMPUTE CENTRAL WAVELENGTH USING PREVIOUS CAR. CALIB. C WOLD(I)=A/M*SIN((C-DCIN(1,I))/B) C C COMPUTE WAVELENGTH USING DISPERSION COEF., USE OLD WAVELENGTHS AS C INITIAL GUESS. WAVELENGTH IS FOR PHOTOCATHODE SAMPLE=280 C WHICH IS THE CENTER OF THE PHOTOCATHODE C WNEW(I)=WOLD(I) CALL ZWCOMP(280.0,DCIN(2,I),M,WNEW(I),STATUS) IF(STATUS.NE.0)THEN CONTXT='ERROR COMPUTING CENTRAL WAVELENGTH' GO TO 999 ENDIF C C COMPUTE ERROR IN CARROUSEL POSITION IF OLD CAR. CALIBRATION IS USED C ARG=M*WNEW(I)/A IF((ARG.GT.1.0) .OR. (ARG.LT.-1.0))THEN CONTXT='ERROR IN CAR. POS. COMPUTATION' STATUS=1 GO TO 999 ENDIF R(I)=C-B*ASIN(ARG) TOT=TOT+R(I)-DCIN(1,I) C --->ADD ERRORS 100 CONTINUE C C COMPUTE AVERAGE ERROR AND UPDATE C COEF. C AVE=TOT/NPOS COEF(5)=C-AVE C C PRINT RESULTS C WRITE(MESS,99)GRAT C --->HEADER 99 FORMAT('Carrousel Calibration for grating ',A5) CALL UMSPUT(MESS,STDOUT,0,ISTAT) WRITE(MESS,199) 199 FORMAT(' WAVELENGTH WOLD DIFF WNEW DIFF') CALL UMSPUT(MESS,STDOUT,0,ISTAT) DO 200 I=1,NPOS DIFF1=WNEW(I)-WOLD(I) C C COMPUTE WAVELEGTH USING NEW CALIBRATION C NEWW=A/M*SIN((COEF(5)-DCIN(1,I))/B) DIFF2=WNEW(I)-NEWW WRITE(MESS,299)WNEW(I),WOLD(I),DIFF1,NEWW,DIFF2 299 FORMAT(F10.3,F10.3,F10.3,F12.3,F10.3) CALL UMSPUT(MESS,STDOUT,0,ISTAT) 200 CONTINUE STATUS=0 GO TO 1000 999 CALL UMSPUT(CONTXT,STDOUT+STDERR,0,ISTAT) 1000 RETURN END