SUBROUTINE ZOFIT * * Module number: 13.9.3 * * Module name: ZOFIT * * Keyphrase: * ---------- * Fit wavelength offsets * * Description: * ------------ * Using and input table of wavelength offsets versus spectral * order, sample, and carrousel position, a least squares fit * to the equation: * m*deltaw = c0 + c1*carpos + c2*m + c3*sample * is performed where: * m - is the spectral order * deltaw - wavelength offset * carpos - is the carrousel postion * sample - is the photocathode sample position * c0,c1,c2,c3 - are the fitted coefficients. * * These coefficients are then used to compute a table of * coefficients for a and b as a tabular function of * carrousel position and spectral order. where: * * m*deltaw = a + b*sample * * FORTRAN name: zwoff.for * * Keywords of accessed files and tables: * -------------------------------------- * Name I/O Description / Comments * intable I input table with columns * carpos - carrousel position * sample - sample position * order - spectral order * deltaw - wavelength offset * and header parameter grating. * outtable O output table with columns * grating - grating mode * carpos - carrousel position * sporder - spectral order * a - constant coef. * b - linear coef. * * Input CL parameters: * tabstat - input table status (read/append). If append * then deltaw_fit and residual columns will be added * * m1,m2 - range of orders the calibration is valid for * carpos1,carpos2 - range of carrousel positions calibration is * valid for. * * Subroutines Called: * ------------------- * CDBS: * zofit1, zofit2, minmax * SDAS: * uclgs*, uttopn, utpgti, utcfnd, utcgt*, uttclo, utppti, * uttcre, utcdef, utrpt*, uttclo, umsput * Others: * * * History: * -------- * Version Date Author Description * 1 Oct 87 D. Lindler Designed and Coded * 1.1 Jan 92 S. Hulbert New grating values *------------------------------------------------------------------------------- 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 CL PARAMETERS C INTEGER M1,M2,CPOS(2) CHARACTER*64 INPUT,OUTPT CHARACTER*6 TBSTAT C C INPUT TABLE PARAMETERS C CHARACTER*19 COLNAM(4) INTEGER NROWS,CARPOS(2000),ORDER(2000),IDIN,COLID1,COLID2 DOUBLE PRECISION SAMPLE(2000),DELTAW(2000) LOGICAL NULLS(2000) CHARACTER*5 GRAT C C OUTPUT TABLE PARAMETERS C CHARACTER*19 CNAMES(5),CUNITS(5),CFORMS(5) INTEGER COLIDS(5),CTYPES(5),IDOUT C C OTHER LOCAL PARAMETERS C INTEGER NCPOS,NORDER,M,I,ISTAT,ISTATS(20),J INTEGER CMIN,CMAX,MINPOS,MAXPOS,OMIN,OMAX CHARACTER*130 CONTXT DOUBLE PRECISION A,B,COEF(4),FIT(2000),RESI(2000) C C DATA DECLARATIONS C DATA COLNAM/'CARPOS','ORDER','SAMPLE','DELTAW'/ DATA CNAMES/'GRATING','CARPOS','SPORDER','A','B'/ DATA CUNITS/5*' '/ DATA CFORMS/'A6','I8','I7',' ',' '/ DATA CTYPES/-3,TYINT,TYINT,TYDOUB,TYDOUB/ C C------------------------------------------------------------------------ C C READ INPUT CL PARAMETERS C CALL UCLGST('intable',INPUT,ISTATS(1)) CALL UCLGST('outtable',OUTPT,ISTATS(2)) CALL UCLGST('tabstat',TBSTAT,ISTATS(3)) CALL UCLGSI('m1',M1,ISTATS(4)) CALL UCLGSI('m2',M2,ISTATS(5)) CALL UCLGSI('carpos1',CPOS(1),ISTATS(6)) CALL UCLGSI('carpos2',CPOS(2),ISTATS(7)) CONTXT='Error reading input CL parameter' DO 10 I=1,6 IF(ISTATS(I).NE.0) GO TO 999 10 CONTINUE C----------------------------------------------------------------------- C C READ INPUT TABLE C CONTXT='Error reading input table'//INPUT CALL UTTOPN(INPUT,RDONLY,IDIN,ISTAT) IF(ISTAT.NE.0) GO TO 999 CALL UTPGTI(IDIN,TBNROW,NROWS,ISTAT) IF(ISTAT.NE.0) GO TO 999 IF(NROWS.GT.2000)THEN CONTXT='Maximum of 2000 input table rows allowed' GO TO 999 ENDIF CALL UTCFND(IDIN,COLNAM,4,COLIDS,ISTATS(1)) CALL UTHGTT(IDIN,'grating',GRAT,ISTATS(2)) CALL UTCGTI(IDIN,COLIDS(1),1,NROWS,CARPOS,NULLS,ISTATS(3)) CALL UTCGTI(IDIN,COLIDS(2),1,NROWS,ORDER,NULLS,ISTATS(4)) CALL UTCGTD(IDIN,COLIDS(3),1,NROWS,SAMPLE,NULLS,ISTATS(5)) CALL UTCGTD(IDIN,COLIDS(4),1,NROWS,DELTAW,NULLS,ISTATS(6)) CALL UTTCLO(IDIN,ISTATS(7)) DO 20 I=1,7 IF(ISTATS(I).NE.0) GO TO 999 20 CONTINUE C ------------------------------------------------------------------------ C PERFORM FIT C CALL ZOFIT1(NROWS,CARPOS,ORDER,SAMPLE,DELTAW,COEF,FIT,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Unable to fit wavelength offsets' GO TO 999 ENDIF C C COMPUTE RESIDUALS OF FIT C DO 150 I=1,NROWS 150 RESI(I)=DELTAW(I)-FIT(I) C C PRINT RESULTS OF THE FIT C CALL ZOFIT2(NROWS,CARPOS,ORDER,SAMPLE,DELTAW,FIT,RESI,COEF) C C IF TABSTAT=APPEND THEN ADD RESULTS TO INPUT TABLE C IF(TBSTAT.EQ.'append')THEN CONTXT='Error appending results to input table'//INPUT CALL UTTOPN(INPUT,RDWRIT,IDIN,ISTATS(1)) CALL UTCFND(IDIN,'DELTAW_FIT',1,COLID1,ISTAT) IF(ISTAT.NE.0)CALL UTCDEF(IDIN,'DELTAW_FIT',' ','F12.4', * TYDOUB,1,COLID1,ISTATS(2)) CALL UTCFND(IDIN,'RESIDUALS',1,COLID2,ISTAT) IF(ISTAT.NE.0)CALL UTCDEF(IDIN,'RESIDUALS',' ','F12.4', * TYDOUB,1,COLID2,ISTATS(3)) CALL UTCPTD(IDIN,COLID1,1,NROWS,FIT,ISTATS(4)) CALL UTCPTD(IDIN,COLID2,1,NROWS,RESI,ISTATS(5)) CALL UTTCLO(IDIN,ISTATS(6)) DO 200 I=1,6 IF(ISTATS(I).NE.0) GO TO 999 200 CONTINUE ENDIF C C COMPUTE LIMITS OF TABULAR FUNCTION C CALL MINMAX(CARPOS,NROWS,CMIN,MINPOS,CMAX,MAXPOS) CALL MINMAX(ORDER,NROWS,OMIN,MINPOS,OMAX,MAXPOS) IF(M1.EQ.0)M1=OMIN IF(M2.EQ.0)M2=OMAX IF(M2.LT.M1)M2=M1 IF(CPOS(1).EQ.0)CPOS(1)=CMIN IF(CPOS(2).EQ.0)CPOS(2)=CMAX C C COMPUTE NUMBER OF OUTPUT TABLE ROWS C NORDER=M2-M1+1 NCPOS=2 IF(CPOS(2).EQ.CPOS(1))NCPOS=1 NROWS=NORDER*NCPOS C------------------------------------------------------------------------- C C OPEN OUTPUT TABLE AND SET UP COLUMNS C CALL UTTINN(OUTPT,IDOUT,ISTATS(1)) CALL UTPPTI(IDOUT,TBALLR,NROWS,ISTATS(2)) CALL UTPPTI(IDOUT,TBMXCL,6,ISTATS(3)) CALL UTPPTI(IDOUT,TBRLEN,8,ISTATS(4)) CALL UTTCRE(IDOUT,ISTATS(5)) CALL UTCDEF(IDOUT,CNAMES,CUNITS,CFORMS,CTYPES,5,COLIDS, * ISTATS(6)) CONTXT='Error creating output table '//OUTPT DO 300 I=1,6 IF(ISTATS(I).NE.0)GO TO 999 300 CONTINUE C C WRITE OUTPUT TABLE BY LOOPING ON CARROUSEL POSITIONS AND ORDERS C NROWS=1 DO 500 I=1,NCPOS DO 500 M=M1,M2 A=COEF(1)+COEF(2)*CPOS(I)+COEF(3)*M B=COEF(4) CALL UTRPTT(IDOUT,COLIDS(1),1,NROWS,GRAT,ISTATS(1)) CALL UTRPTI(IDOUT,COLIDS(2),1,NROWS,CPOS(I),ISTATS(2)) CALL UTRPTI(IDOUT,COLIDS(3),1,NROWS,M,ISTATS(3)) CALL UTRPTD(IDOUT,COLIDS(4),1,NROWS,A,ISTATS(4)) CALL UTRPTD(IDOUT,COLIDS(5),1,NROWS,B,ISTATS(5)) DO 400 J=1,5 IF(ISTATS(I).NE.0)THEN CONTXT='Error writing to output table' GO TO 999 ENDIF 400 CONTINUE NROWS=NROWS+1 500 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