SUBROUTINE ZTACF * * Module number: 13.13.1.2 * * Module name: ZTACF * * Keyphrase: * ---------- * HRS TA carrousel calibration * Description: * ------------ * This routines takes a table of image positions (diode) versus * carrousel position, and computes the least sqaures coefficients * for: * diode = c0 + c1*carpos + c2*carpos**2 + c3*carpos**3 * * FORTRAN name: ztacf * * Keywords of accessed files and tables: * -------------------------------------- * Name I/O Description / Comments * intable I Table of diode position versus * carrousel position. It must * have columns: * carpos - carrousel position * x-center - diode position * and header parameters: * aperture, grating * outtable O Output coef. table with columns * grating * aperture * coef_0,coef_1,coef_2,coef_3 * rms_of_fit * order I cl parameter (order of polynomial) * Subroutines Called: * ------------------- * CDBS: * polyft, ztacf1 * SDAS: * uclgs*, uttopn, utpgti, uthgtt, utcfnd, utcgtd, uttclo, * uttinn, utppti, uttcre, utrpt*, 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 OUTPUT TABLE PARAMETERS C CHARACTER*64 OUTTAB INTEGER IDOUT,COLIDS(7),CTYPES(7) CHARACTER*19 CNAMES(7),CUNITS(7),CFORMS(7) DOUBLE PRECISION COEF(4),RMS C C INPUT TABLE PARAMETERS C CHARACTER*64 INTAB INTEGER COLID1,COLID2,NROWS,IDIN LOGICAL NULLS(500) DOUBLE PRECISION CARPOS(500),DIODE(500) CHARACTER*5 GRAT CHARACTER*3 APER C C OTHER LOCAL VARIABLES C INTEGER ISTAT,ISTATS(10),I,ORDER DOUBLE PRECISION FIT(500) DOUBLE PRECISION SIG(500) CHARACTER*132 CONTXT C C DATA DECLARATIONS C DATA CNAMES/'GRATING','APERTURE','COEF_0','COEF_1','COEF_2', * 'COEF_3','RMS_OF_FIT'/ DATA CUNITS/6*' ','diodes'/ DATA CTYPES/-3,-3,4*TYDOUB,TYREAL/ DATA CFORMS/6*' ','F10.3'/ DATA SIG/500*1.0/ C C---------------------------------------------------------------------- C C READ INPUT CL PARAMETERS C CALL UCLGST('intable',INTAB,ISTATS(1)) CALL UCLGST('outtable',OUTTAB,ISTATS(2)) CALL UCLGSI('order',ORDER,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 C READ INPUT TABLE C CONTXT='Error reading input table '//INTAB CALL UTTOPN(INTAB,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.500)THEN CONTXT='Maximum of 500 input table rows allowed' GO TO 999 ENDIF CALL UTHGTT(IDIN,'grating',GRAT,ISTATS(1)) CALL UTHGTT(IDIN,'aperture',APER,ISTATS(2)) IF((ISTATS(1).NE.0).OR.(ISTATS(2).NE.0))THEN CONTXT='grating or aperture keyword missing from input' GO TO 999 ENDIF CALL UTCFND(IDIN,'CARPOS',1,COLID1,ISTATS(1)) CALL UTCFND(IDIN,'X_CENTER',1,COLID2,ISTATS(2)) CALL UTCGTD(IDIN,COLID1,1,NROWS,CARPOS,NULLS,ISTATS(3)) CALL UTCGTD(IDIN,COLID2,1,NROWS,DIODE,NULLS,ISTATS(4)) CALL UTTCLO(IDIN,ISTATS(5)) DO 30 I=1,5 IF(ISTATS(I).NE.0)GO TO 999 30 CONTINUE C C---------------------------------------------------------------------- C C CHECK FOR VALID NUMBER OF ROWS FOR FIT C IF(NROWS.LE.ORDER)THEN CONTXT='Too Few points to perform fit' GO TO 999 ENDIF C C PERFORM FIT C DO 50 I=1,4 COEF(I)=0.0 50 CONTINUE CALL POLYFT(CARPOS,DIODE,SIG,NROWS,ORDER,COEF,FIT,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error fitting diode versus carrousel position' GO TO 999 ENDIF C C PRINT RESULTS OF FIT C CALL ZTACF1(CARPOS,DIODE,FIT,NROWS,COEF,ORDER,RMS) C C--------------------------------------------------------------------- C C WRITE RESULTS TO OUTPUT TABLE C CALL UTTINN(OUTTAB,IDOUT,ISTATS(1)) CALL UTPPTI(IDOUT,TBMXCL,8,ISTATS(2)) CALL UTPPTI(IDOUT,TBRLEN,14,ISTATS(3)) CALL UTTCRE(IDOUT,ISTATS(4)) CONTXT='Error opening output table '//OUTTAB DO 300 I=1,4 IF(ISTATS(I).NE.0)GO TO 999 300 CONTINUE CONTXT='Error writing to output table '//OUTTAB CALL UTCDEF(IDOUT,CNAMES,CUNITS,CFORMS,CTYPES,7,COLIDS,ISTAT) IF(ISTAT.NE.0)GO TO 999 CALL UTRPTT(IDOUT,COLIDS(1),1,1,GRAT,ISTATS(1)) CALL UTRPTT(IDOUT,COLIDS(2),1,1,APER,ISTATS(2)) CALL UTRPTD(IDOUT,COLIDS(3),4,1,COEF,ISTATS(3)) CALL UTRPTD(IDOUT,COLIDS(7),1,1,RMS,ISTATS(4)) CALL UTTCLO(IDOUT,ISTATS(5)) DO 400 I=1,5 IF(ISTATS(I).NE.0) GO TO 999 400 CONTINUE C C DONE C GO TO 1000 999 CALL UMSPUT(CONTXT,STDOUT+STDERR,0,ISTAT) 1000 RETURN END