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
Source Code · Search Form · STSDAS
Maintained by the Science Software Group at STScI
This file last updated on 24 Feb 2011