SUBROUTINE ZCCALX C C Module Number: 13.3.2 C C Module Name: ZCCALX C C Keyphrase: C ---------- C HRS carrousel calibration C C Description: C ------------ C Using tables of dispersion coefficients (all for the same C grating mode. The carrousel calibration coefficient, C, is C computed for the equation: C C carpos = C - B*arcsin(m*wave/A) C where: C carpos - is the carrousel position C m - is the spectral order (1 for first order gratings) C wave - is the wavelength at the center of the photocathode, C (i.e. sample position 280) C B = 10430.378 (carrousel steps per radian) C A is a constant for each grating C C is a coeficient updated by the routine C C The input dispersion coefficients are used to compute the C central wavelength at sample position 280.0 at each carrousel C position observed. Using the previous car6rousel calibration C coefficients in CCTABIN an effective carrousel position is computed C using each wavelength computed from the dispersion coefficients. C The average of the difference from the computed and actual C carrousels is used as an offset to the input value of the C coefficient C. C C C FORTRAN Name: ZCCALX.FOR C C C Keywords of Accessed Files : C -------------------------- C cctabin input carrousel calibration to update (Optional) C dctab input Dispersion coef. table C cctabout output updated carrousel calibration table C C Modules Called: C --------------- C CDBS: C zccfit, zwcomp C SDAS: * uclgs* , umsput * uttinn, utppti, utcdef, utrpt*, utcpt*, uthad*, uttclo, utccre * uttopn, utpgti, utcfnd, utrgt*, utcgt*, uthgt*, uttclo * uimotp, uimxtp, uimctp, uimopn, uimgid, uimclo, uhdgs* uimclo 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 * 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 ERROR PROCESSING PARAMETERS C INTEGER STATUS,ISTAT,ISTATS(10) CHARACTER*130 CONTXT C --->WHAT HAPPENED C C INPUT DC TABLE INFO C CHARACTER*130 NAME INTEGER IDIN CHARACTER*8 COLNAM(9) INTEGER NROWS,COLIDS(9) LOGICAL NULLS(9) C C INPUT/OUTPUT CAR. CALIBRATIN TABLE C CHARACTER*64 CCTABI,CCTABO INTEGER IDOUT CHARACTER*8 COL1(8),CFORM(8),CUNITS(8) INTEGER CTYPE(8) DOUBLE PRECISION COEF(7) C C LOCAL VARIABLES C INTEGER IROW C --->ROW COUNTER LOGICAL FIRST C ---> FIRST SET OF DC'S INTEGER I C --->INDEX INTEGER NPOS C --->NUMBER OF CAR. POSITIONS CHARACTER*5 GRAT1,GRAT C --->GRATING MODE DOUBLE PRECISION DC(8,100) C C DATA DECLARATIONS C DATA COLNAM/'GRATING','CARPOS','A0','A1','A2','A3', * 'A4','A5','A6'/ DATA COL1/'GRATING','CAP_A','LIT_A','CAP_B','LIT_B','CAP_C', * 'LIT_C','LIT_D'/ DATA CFORM/8*' '/ DATA CUNITS/8*' '/ DATA CTYPE/-3,7*TYDOUB/ C --->DISPERSION COEFFICIENTS C C -------------------------------------------------------------------- C C GET CL PARAMETERS C CALL UCLGST('dctab',NAME,ISTATS(1)) CALL UCLGST('cctabin',CCTABI,ISTATS(2)) CALL UCLGST('cctabout',CCTABO,ISTATS(3)) DO 10 I=1,3 IF(ISTATS(I).NE.0)THEN CONTXT='Error reading input cl parameter' GO TO 999 ENDIF 10 CONTINUE C C READ INPUT DCTAB TABLE ------------------------------------------------ C NPOS=0 C --->NUMBER OF SETS OF DISP. CONSTANTS READ FIRST=.TRUE. C --->FIRST SET? C C OPEN TABLE FILE C CALL UTTOPN(NAME,RDONLY,IDIN,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error opening input dctab '//NAME GO TO 999 ENDIF CALL UTPGTI(IDIN,TBNROW,NROWS,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading input dctab '//NAME GO TO 999 ENDIF IF(NROWS.EQ.0)THEN CONTXT='Input dctab has no rows' GO TO 999 ENDIF CALL UTCFND(IDIN,COLNAM,9,COLIDS,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error locating correct columns in dctab '//NAME GO TO 999 ENDIF C C LOOP ON ROWS OF THE TABLE C DO 50 IROW=1,NROWS NPOS=NPOS+1 IF(NPOS.GT.100)THEN CONTXT='Error: max. of 100 carrousel '// * 'allowed' GO TO 999 ENDIF CALL UTRGTT(IDIN,COLIDS(1),1,IROW,GRAT,NULLS,ISTATS(1)) CALL UTRGTD(IDIN,COLIDS(2),8,IROW,DC(1,NPOS),NULLS, * ISTATS(2)) DO 30 I=1,2 IF(ISTATS(I).NE.0)THEN CONTXT='Error reading input dctab '//NAME GO TO 999 ENDIF 30 CONTINUE C C CHECK CONSISTENCY C IF(FIRST)THEN GRAT1=GRAT FIRST=.FALSE. ELSE IF(GRAT.NE.GRAT1)THEN CONTXT='All dctabs must be same grating' GO TO 999 ENDIF ENDIF 50 CONTINUE CALL UTTCLO(IDIN,ISTAT) C C DONE READING INPUT DCTABS ------------------------------------------------ C C C READ PREVIOUS CARROUSEL CALIBRATION TABLE C CALL UTTOPN(CCTABI,RDONLY,IDIN,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error opening input table '//CCTABI GO TO 999 ENDIF CALL UTPGTI(IDIN,TBNROW,NROWS,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading input table '//CCTABI GO TO 999 ENDIF CALL UTCFND(IDIN,COL1,8,COLIDS,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error locating correct columns in '// * CCTABI GO TO 999 ENDIF C C LOOP ON ROWS TO FIND CORRECT GRATING MODE C DO 80 IROW=1,NROWS CALL UTRGTT(IDIN,COLIDS(1),1,IROW,GRAT,NULLS,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading input table '//CCTABI GO TO 999 ENDIF IF(GRAT.EQ.GRAT1)GO TO 90 80 CONTINUE C C IF WE MADE IT HERE THEN WE DID NOT FIND CORRECT GRATING MODE C CONTXT='Grating mode was not found in input cctab '// * CCTABI GO TO 999 C C READ COEFFICIENTS C 90 CALL UTRGTD(IDIN,COLIDS(2),7,IROW,COEF,NULLS,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading input table '//CCTABI GO TO 999 ENDIF CALL UTTCLO(IDIN,ISTAT) C C COMPUTE NEW COEFFICIENTS FOR OUTPUT TABLE --------------------------- C CALL ZCCFIT(NPOS,DC,GRAT1,COEF,STATUS) IF(STATUS.NE.0)THEN CONTXT='ERROR COMPUTING NEW COEFFICIENTS' GO TO 999 ENDIF C C WRITE OUTPUT TABLE ---------------------------------------------------- C C C OPEN OUTPUT TABLE C CALL UTTINN(CCTABO,IDOUT,ISTATS(1)) CALL UTPPTI(IDOUT,TBRLEN,15,ISTATS(2)) CALL UTPPTI(IDOUT,TBMXCL,8,ISTATS(3)) CALL UTCDEF(IDOUT,COL1,CUNITS,CFORM,CTYPE,8,COLIDS,ISTATS(4)) CALL UTTCRE(IDOUT,ISTATS(5)) DO 200 I=1,5 IF(ISTATS(I).NE.0)THEN CONTXT='Error creating output table '//CCTABO GO TO 999 ENDIF 200 CONTINUE C C COPY RESULTS TO TABLE C CALL UTRPTT(IDOUT,COLIDS(1),1,1,GRAT1,ISTATS(1)) CALL UTRPTD(IDOUT,COLIDS(2),7,1,COEF,ISTATS(2)) DO 210 I=1,2 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 '//CCTABO GO TO 999 ENDIF C C DONE C GO TO 1000 999 CALL UMSPUT(CONTXT,STDOUT+STDERR,0,ISTAT) 1000 RETURN END