SUBROUTINE ZYFIT C C Module Number: 13.3.3.2 C C Module Name: ZYFIT C C Keyphrase: C ---------- C Compute HRS y-deflection calibration C C Description: C ------------ C Using a table of y-deflection versus carrousel position and spectral C order, the coefficients giving y-deflection by the followin function C are determined using a least squares fit. C C ydef = a + b*w + c*w*w + d*m*w C C where: C w is the wavelength computed using the carrousel calibration stored C cctabin C m is the spectral order C a,b,c and d are fitted coefficients. d is not used for first order C gratings (i.e. set to 0.0) and c is not used for echelle C modes. C C C FORTRAN Name: zyfit.for C C C Keywords of Accessed Files : C -------------------------- C YPOSTAB input y-deflection table C CCTABIN input carrousel calibration table C CCTABOUT output updated carrousel calibration table C C Modules Called: C --------------- C CDBS: C zycoef C SDAS: C uclgs* , umsput C uttinn, utppti, utcdef, utrpt*, utcpt*, uthad*, uttclo, utccre C uttopn, utpgti, utcfnd, utrgt*, utcgt*, uthgt*, uttclo 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 ERROR PROCESSING PARAMETERS C INTEGER STATUS,ISTAT,ISTATS(10) C --->ERROR STATUS CHARACTER*130 CONTXT C --->ERROR MESSAGE C C INPUT CCTABIN TABLE PARAMETERS C CHARACTER*64 CCTABI CHARACTER*8 COLNAM(8) INTEGER COLIDS(8),IDIN CHARACTER*5 GRAT INTEGER NROWS C --->NUMBER OF ROWS INTEGER IROW C --->ROW COUNTER DOUBLE PRECISION COEF(7) C C INPUT YPOSTAB PARAMETERS C CHARACTER*64 DYTAB CHARACTER*8 COL1(3) CHARACTER*5 GRAT1 LOGICAL NULLS(500) C C OUTPUT CCTAB TABLE C CHARACTER*64 CCTABO INTEGER IDOUT CHARACTER*8 CFORM(8),CUNITS(8) INTEGER CTYPE(8) C C OTHER LOCAL VARIABLES C DOUBLE PRECISION CARPOS(500) C --->TABLE OF CAR. POS DOUBLE PRECISION ORDER(500) C --->TABLE OF ORDER NUM. DOUBLE PRECISION YDEF(500) C --->TABLE OF Y-DEFLECTIONS INTEGER N C --->NUMBER OF POSITIONS INTEGER I C C DATA DECLARATIONS C DATA COLNAM/'GRATING','CAP_A','LIT_A','CAP_B', * 'LIT_B','CAP_C','LIT_C','LIT_D'/ DATA COL1/'CARPOS','ORDER','YDEF'/ DATA CFORM/8*' '/ DATA CUNITS/8*' '/ DATA CTYPE/-3,7*TYDOUB/ C --->INDEX C C-------------------------------------------------------------------------- C C READ INPUT TABLE NAMES C CALL UCLGST('cctabin',CCTABI,ISTATS(1)) CALL UCLGST('ypostab',DYTAB,ISTATS(2)) CALL UCLGST('cctabout',CCTABO,ISTATS(3)) DO 5 I=1,3 IF(ISTATS(I).NE.0)THEN CONTXT='Error getting CL parameter' GO TO 999 ENDIF 5 CONTINUE C C READ INPUT DYTAB C CALL UTTOPN(DYTAB,RDONLY,IDIN,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error opening y-postion table: '//DYTAB GO TO 999 ENDIF CALL UTPGTI(IDIN,TBNROW,NROWS,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading input table '//DYTAB GO TO 999 ENDIF CALL UTCFND(IDIN,COL1,3,COLIDS,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error locating correct columns in '//DYTAB GO TO 999 ENDIF C C GET GRATING MODE C CALL UTHGTT(IDIN,'GRATING',GRAT1,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error getting grating mode from '//DYTAB GO TO 999 ENDIF C C READ ROWS C IF(NROWS.GT.500)THEN CALL UMSPUT('Only 500 rows allowed in y-position table', * STDOUT,0,ISTAT) CALL UMSPUT('First 500 rows used',STDOUT,0,ISTAT) NROWS=500 ENDIF CALL UTCGTD(IDIN,COLIDS(1),1,NROWS,CARPOS,NULLS,ISTATS(1)) CALL UTCGTD(IDIN,COLIDS(2),1,NROWS,ORDER,NULLS,ISTATS(2)) CALL UTCGTD(IDIN,COLIDS(3),1,NROWS,YDEF,NULLS,ISTATS(3)) DO 70 I=1,3 IF(ISTATS(I).NE.0)THEN CONTXT='Error reading input table '//DYTAB GO TO 999 ENDIF 70 CONTINUE CALL UTTCLO(IDIN,ISTAT) N=NROWS C C READ INPUT CCTAB (FIND ROW WITH CORRECT GRATING MODE --------------------- C CALL UTTOPN(CCTABI,RDONLY,IDIN,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error opening cctabin 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,COLNAM,8,COLIDS,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error locating correct columns in '//CCTABI GO TO 999 ENDIF C C LOOP ON ROWS UNTIL CORRECT GRATING FOUND C DO 500 IROW=1,NROWS CALL UTRGTT(IDIN,COLIDS,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 550 C --->FOUND? 500 CONTINUE C C IF WE MADE IT HERE, WE DID NOT FIND GRATING MATCH C CONTXT='Grating '//GRAT1//' not found in '//CCTABI GO TO 999 C C READ COEFFICIENTS C 550 CALL UTRGTD(IDIN,COLIDS(2),7,IROW,COEF,NULLS,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading from input table '//CCTABI GO TO 999 ENDIF CALL UTTCLO(IDIN,ISTAT) C C COMPUTE NEW Y-DEFLECTION CALIBRATION COEFFICIENTS ------------------ C CALL ZYCOEF(N,CARPOS,ORDER,YDEF,GRAT,COEF,STATUS) IF(STATUS.NE.0)THEN CONTXT='ERROR COMPUTING NEW Y-DEFLECTION CALIB. COEF.' GO TO 999 ENDIF C C OPEN OUTPUT TABLE CCTABOUT AND WRITE NEW COEF. TO IT ---------------- C CALL UTTINN(CCTABO,IDOUT,ISTATS(1)) CALL UTPPTI(IDOUT,TBRLEN,16,ISTATS(2)) CALL UTPPTI(IDOUT,TBMXCL,8,ISTATS(3)) CALL UTCDEF(IDOUT,COLNAM,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,GRAT,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 ' GO TO 999 ENDIF C C DONE C GO TO 1000 999 CALL UMSPUT(CONTXT,STDOUT+STDERR,0,ISTAT) 1000 RETURN END