SUBROUTINE ZTACC * * Module number: 13.13.1.1 * * Module name: ZTACC * * Keyphrase: * ---------- * HRS target acquisition carrousel calibration * * Description: * ------------ * This routine computes the location (diodes) for a target * acquisition image. The locations is found both by location * of the left and right eddges, and the centroid. The * results are tabulated for use by a the fitting routine * ztafit. * * FORTRAN name: ztacc * * Keywords of accessed files and tables: * -------------------------------------- * Name I/O Description / Comments * Input I Input observation of * in a target acquisiton mode * table O Output table file for aperture * Locations. * Columns include * carpos - carrousel position * x_center - center of aperture * x_centroid - centroid of aperture * width - FWHM * peak - peak counts * * CL parameters * tabstat I output table status (write/append) * d1 I First diode in rage to use * d2 I Last diode * aper I aperture (char*3) * * Subroutines Called: * ------------------- * CDBS: * minmax, dmnmax, taedge * SDAS: * uclgs*, uimopn, uhdgst, uhdgsi, uigl1d, uimgid, uimclo, * uttopn, utpgti, uthgtt, uttinn, utppti, uttcre, uthadt, * uttrpt*, uttclo * 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 INPUT CL PARAMETERS C CHARACTER*64 INPUT,TABLE INTEGER D1,D2 CHARACTER*6 TBSTAT CHARACTER*3 APER C C INPUT FILE PARAMETERS C INTEGER IDIN,NAXIS,DTYPE,DIMEN(10),NS DOUBLE PRECISION COUNTS(2000) CHARACTER*5 GRAT C C OUTPUT TABLE VARIABLES C CHARACTER*19 CNAMES(5),CFORMS(5),CUNITS(5) INTEGER COLIDS(5),CTYPES(5) INTEGER NROWS,IDOUT CHARACTER*3 APER2 CHARACTER*5 GRAT2 C C OTHER LOCAL VARIABLES C INTEGER ISTATS(10),ISTAT,I,CARPOS,XSTEPS,I1,I2,MINPOS,MAXPOS DOUBLE PRECISION EDGES(2),CENTER,CTROID,PEAK,CMIN,FWHM CHARACTER*130 CONTXT,MESS C C DATA DECLARATIONS C DATA CNAMES/'CARPOS','X_CENTER','X_CENTROID','FWHM','PEAK'/ DATA CFORMS/'I8','F10.3','F10.2','F8.3',' '/ DATA CUNITS/' ','diodes','diodes','diodes',' '/ DATA CTYPES/TYINT,TYREAL,TYREAL,TYREAL,TYREAL/ C C------------------------------------------------------------------------ C C READ INPUT CL PARAMETERS C CALL UCLGST('input',INPUT,ISTATS(1)) CALL UCLGST('table',TABLE,ISTATS(2)) CALL UCLGST('tabstat',TBSTAT,ISTATS(3)) CALL UCLGST('aperture',APER,ISTATS(4)) CALL UCLGSI('d1',D1,ISTATS(5)) CALL UCLGSI('d2',D2,ISTATS(6)) CONTXT='Error reading CL parameter' DO 10 I=1,6 IF(ISTATS(I).NE.0)GO TO 999 10 CONTINUE IF(D1.NE.0)THEN IF(D2.LE.D1)THEN CONTXT='d2 must be greater than d1' GO TO 999 ENDIF ENDIF C C-------------------------------------------------------------------------- C C READ INPUT OBSERVATION C CALL UIMOPN(INPUT,RDONLY,IDIN,ISTAT) CONTXT='Error reading input file '//INPUT IF(ISTAT.NE.0) GO TO 999 CALL UIMGID(IDIN,DTYPE,NAXIS,DIMEN,ISTAT) IF(ISTAT.NE.0) GO TO 999 NS=DIMEN(1) IF(NAXIS.NE.1)THEN CONTXT='Input observation must be 1-Dimensional' GO TO 999 ENDIF IF((NS.NE.2000).AND.(NS.NE.500).AND.(NS.NE.1000))THEN CONTXT='Input must have 500, 1000, or 2000 points' GO TO 999 ENDIF CALL UIGL1D(IDIN,COUNTS,ISTAT) IF(ISTAT.NE.0) GO TO 999 C C GET HEADER INFO C CALL UHDGST(IDIN,'grating',GRAT,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='grating keyword missing from input header' GO TO 999 ENDIF CALL UHDGSI(IDIN,'carpos',CARPOS,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='carrousel position, CARPOS, missing from input' GO TO 999 ENDIF CALL UIMCLO(IDIN,ISTAT) C C----------------------------------------------------------------------- C C CONVERT D1 AND D2 TO DATA POINT NUMBERS C XSTEPS=NS/500 IF(D1.EQ.0)THEN C C D1 NOT SUPPLIED, SET RANGE TO 20 DIOES AROUND PEAK C CALL DMNMAX(COUNTS,NS,CMIN,MINPOS,PEAK,MAXPOS) I1=MAXPOS-10*XSTEPS I2=MAXPOS+10*XSTEPS ELSE I1=(D1-1)*XSTEPS+1 I2=(D2-1)*XSTEPS+1 ENDIF IF(I1.LT.1)I1=1 IF(I2.GT.NS)I2=NS C C COMPUTE EDGE LOCATIONS, CENTER, AND CENTROID C CALL TAEDGE(COUNTS,I1,I2,EDGES,CENTER,CTROID,ISTAT) IF( (ISTAT.NE.0).OR.(EDGES(1).EQ.0.0).OR.(EDGES(2).EQ.0.0).OR. * (CTROID.EQ.0.0).OR.(CENTER.EQ.0.0))THEN CONTXT='Error locating target acquisition image' GO TO 999 ENDIF C C COMPUTE PEAK COUNTS IN REGION C CALL DMNMAX(COUNTS(I1),I2-I1+1,CMIN,MINPOS,PEAK,MAXPOS) C C CONVERT LOCATIONS TO DIODE UNITS C EDGES(1)=(EDGES(1)-1)/XSTEPS+1 EDGES(2)=(EDGES(2)-1)/XSTEPS+1 CENTER=(CENTER-1)/XSTEPS+1 CTROID=(CTROID-1)/XSTEPS+1 FWHM=EDGES(2)-EDGES(1) C C PRINT RESULTS C WRITE(MESS,91)EDGES 91 FORMAT(' Edge Locations (diodes):',2F10.2) CALL UMSPUT(MESS,STDOUT,0,ISTAT) WRITE(MESS,92)CENTER,CTROID 92 FORMAT(' Center and Centroid (diodes):',2F10.2) CALL UMSPUT(MESS,STDOUT,0,ISTAT) WRITE(MESS,93)FWHM 93 FORMAT(' Full Width/Half max (diodes):',F10.2) CALL UMSPUT(MESS,STDOUT,0,ISTAT) C C ---------------------------------------------------------------------- C C OPEN OUTPUT TABLE C IF(TBSTAT.EQ.'append')THEN CONTXT='Error opening output table for append' CALL UTTOPN(TABLE,RDWRIT,IDOUT,ISTATS(1)) CALL UTPGTI(IDOUT,TBNROW,NROWS,ISTATS(2)) IF((ISTATS(1).NE.0).OR.(ISTATS(2).NE.0)) GO TO 999 CALL UTCFND(IDOUT,CNAMES,5,COLIDS,ISTATS) CONTXT='Error locating columns in existing table' IF(ISTAT.NE.0)GO TO 999 C C VERIFY CONSISTENCY OF GRATING MODE/APERTURE C CALL UTHGTT(IDOUT,'aperture',APER2,ISTAT) CONTXT='Error getting aperture name from '//TABLE IF(ISTAT.NE.0) GO TO 999 CALL UTHGTT(IDOUT,'grating',GRAT2,ISTAT) CONTXT='Error getting grating name from '//TABLE IF(ISTAT.NE.0) GO TO 999 CONTXT='Grating/aperture inconsistent with output table' IF((APER2.NE.APER).OR.(GRAT2.NE.GRAT))GO TO 999 ELSE C C OPEN NEW TABLE FILE C NROWS=0 CONTXT='Error creating output table '//TABLE CALL UTTINN(TABLE,IDOUT,ISTATS(1)) CALL UTPPTI(IDOUT,TBMXCL,6,ISTATS(2)) CALL UTPPTI(IDOUT,TBRLEN,8,ISTATS(3)) CALL UTTCRE(IDOUT,ISTATS(4)) CALL UTCDEF(IDOUT,CNAMES,CUNITS,CFORMS,CTYPES,5, * COLIDS,ISTATS(5)) CALL UTHADT(IDOUT,'grating',GRAT,ISTATS(6)) CALL UTHADT(IDOUT,'aperture',APER,ISTATS(7)) DO 100 I=1,7 IF(ISTATS(I).NE.0)GO TO 999 100 CONTINUE ENDIF C C --------------------------------------------------------------------- C C WRITE NEW TABLES COLUMNS C CONTXT='Error writing results to output table '//TABLE NROWS=NROWS+1 CALL UTRPTI(IDOUT,COLIDS(1),1,NROWS,CARPOS,ISTATS(1)) CALL UTRPTD(IDOUT,COLIDS(2),1,NROWS,CENTER,ISTATS(2)) CALL UTRPTD(IDOUT,COLIDS(3),1,NROWS,CTROID,ISTATS(3)) CALL UTRPTD(IDOUT,COLIDS(4),1,NROWS,FWHM,ISTATS(4)) CALL UTRPTD(IDOUT,COLIDS(5),1,NROWS,PEAK,ISTATS(5)) CALL UTTCLO(IDOUT,ISTATS(6)) DO 200 I=1,6 IF(ISTATS(I).NE.0) GO TO 999 200 CONTINUE C C DONE C GO TO 1000 999 CALL UMSPUT(CONTXT,STDOUT+STDERR,0,ISTAT) 1000 RETURN END