SUBROUTINE ZTAMOD * * Module number: 13.13.2.1 * * Module name: ZTAMOD * * Keyphrase: * ---------- * HRS aperture location and sizes * Description: * ------------ * This routine computes the aperture locations and sizes * in an HRS field map and or the spectral cal. lamp positions * from computed by the on-board target acquisition software. * * FORTRAN name: ztamod.for * * Keywords of accessed files and tables: * -------------------------------------- * Name I/O Description / Comments * input I HRS field map file * output O output table of edge locations * and sizes. Columns in the table * are: * aperture - aperture name * left_edge * right_edge * upper_edge * lower_edge * x_center * y_center * x_centroid * y_centroid * x_crosscor * y_crosscor * area * flux * time * CL parameters * ------------- * aperture aperture name SC1, SC2, SSA, or LSA * map boolean variable specifying map processing * defcal boolean variable specifying use of def. calibration * tabstat output table status (write or append) * twidthx cross correlation template width in in sample units * for the x-directions * twidthy cross correlation template width for the y-direction * * Subroutines Called: * ------------------- * CDBS: * tainfo * SDAS: * uclgs*, uimopn, uhdgst, uhdgsd, uigl2d, uimgid, uttinn, * utppti, utcdef, uttcre, uthgtt, utrpt*, uthadt, uttclo, * umsput * Others: * * * History: * -------- * Version Date Author Description * 1 Sept 87 D. Lindler Designed and coded * 1.1 Dec 91 S. Hulbert Get keyword values from udl not d0h * 1.2 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 LOCAL VARIABLES C C HEADER KEYWORD VALUES C DOUBLE PRECISION XMAPC,YMAPC,DELX,DELY,XSC1,YSC1,XSC2,YSC2 CHARACTER*5 GMODE,GRAT CHARACTER*24 TIME C C FILE I/O PARAMETERS C INTEGER IDIN,IDOUT,NAXIS,DIMEN(7),DTYPE,NROWS INTEGER IDUDL DOUBLE PRECISION IMAGE(512) C C OUTPUT TABLE PARAMETERS C CHARACTER*19 COLNAM(14),CUNITS(14) CHARACTER*5 CFORM(14) INTEGER CTYPE(14),COLIDS(14) C C CL PARAMETERS C INTEGER TWIDX,TWIDY LOGICAL MAP,DEFCAL CHARACTER*3 APER CHARACTER*64 INPUT,OUTPUT CHARACTER*6 TBSTAT C C INPUT AREA TO PROCESS C INTEGER AREA(4) C C COMPUTED RESULTS C DOUBLE PRECISION EDGES(4),ECENT(2),CTROID(2),CCENT(2),FLUX C C OTHERS C INTEGER ISTATS(25),ISTAT,HWIDX,HWIDY,I CHARACTER*130 CONTXT DOUBLE PRECISION X0,Y0,A CHARACTER*64 ROOT,UDLNAM C C DATA DECLARATIONS C DATA COLNAM/'APERTURE','LEFT_EDGE','RIGHT_EDGE','UPPER_EDGE', * 'LOWER_EDGE','X_CENTER','Y_CENTER','X_CENTROID', * 'Y_CENTROID','X_CROSSCOR','Y_CROSSCOR','AREA', * 'FLUX','TIME'/ DATA CUNITS/' ',11*'deflection units',' ',' '/ DATA CFORM/'A4',10*'F12.6',' ',' ',' '/ DATA CTYPE/-3,12*TYREAL,-24/ DATA AREA/4*1/ C C--------------------------------------------------------------------- C C GET INPUT CL PARAMETERS C CALL UCLGST('input',INPUT,ISTATS(2)) CALL UCLGST('aperture',APER,ISTATS(4)) CALL UCLGST('table',OUTPUT,ISTATS(3)) CALL UCLGST('tabstat',TBSTAT,ISTATS(5)) CALL UCLGSB('map',MAP,ISTATS(6)) CALL UCLGSB('defcal',DEFCAL,ISTATS(7)) CALL UCLGSI('twidthx',TWIDX,ISTATS(8)) CALL UCLGSI('twidthy',TWIDY,ISTATS(9)) DO 10 I=2,9 IF(ISTATS(I).NE.0) THEN CONTXT='Error getting CL parameter' GO TO 999 ENDIF 10 CONTINUE C C -------------------------------------------------- C GET JUNK FROM INPUT IMAGE C CALL UIMOPN(INPUT,RDONLY,IDIN,ISTAT) IF(ISTAT.NE.0) THEN WRITE(CONTXT,600)INPUT GO TO 999 ENDIF 600 FORMAT('Error opening ',A64) C C open udl C CALL GTROOT(INPUT,ROOT,ISTAT) CALL ZFNAME(ROOT,'ulh',1,0,UDLNAM) CALL UIMOPN(UDLNAM,RDONLY,IDUDL,ISTAT) IF(ISTAT.NE.0) THEN WRITE(CONTXT,600)UDLNAM GO TO 999 ENDIF C C GET GRATING MODE C CALL UHDGST(IDIN,'grating',GRAT,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error getting grating mode from input file' GO TO 999 ENDIF C C READ MAP IF REQUIRED C TIME=' ' IF(MAP)THEN CALL UIMGID(IDIN,DTYPE,NAXIS,DIMEN,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading input' GO TO 999 ENDIF IF(NAXIS.NE.2)THEN CONTXT='Field map does not have dimension=2' GO TO 999 ENDIF IF((DIMEN(1)*DIMEN(2)).GT.512)THEN CONTXT='Max. of 512 pixels allowed in field map' GO TO 999 ENDIF AREA(2)=DIMEN(1) AREA(4)=DIMEN(2) DO 25 I=1,DIMEN(2) CALL UIGL2D(IDIN,I,IMAGE((I-1)*DIMEN(1)+1), * ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading input file' GO TO 999 ENDIF 25 CONTINUE CALL UHDGST(IDIN,'PKTTIME',TIME,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error getting PKTTIME from input file' GO TO 999 ENDIF ENDIF C C--------------------------------------------------------------------------- C READ INFO ON DEFLECTION CALIBRATION (currently from udl) C C CALL UHDGSD(IDIN,'zfcdefx1',XSC1,ISTATS(1)) C CALL UHDGSD(IDIN,'zfcdefy1',YSC1,ISTATS(2)) C CALL UHDGSD(IDIN,'zfcdefx2',XSC2,ISTATS(3)) C CALL UHDGSD(IDIN,'zfcdefy2',YSC2,ISTATS(4)) CALL UHDGSD(IDUDL,'zsrchlce',DELX,ISTATS(5)) CALL UHDGSD(IDUDL,'zsrchlcf',DELY,ISTATS(6)) CALL UHDGSD(IDUDL,'zfxmapc',XMAPC,ISTATS(7)) CALL UHDGSD(IDUDL,'zfymapc',YMAPC,ISTATS(8)) DO 30 I=5,8 IF(ISTATS(I).NE.0)THEN CONTXT='Error reading keyword value from UDL' GO TO 999 ENDIF 30 CONTINUE CALL UIMCLO(IDIN,ISTAT) C C -------------------------------------------------------------------- C READY TO DO USEFUL THINGS C C PROCESS MAP IF SPECIFIED C IF(MAP) THEN IF((TWIDX.GE.(DIMEN(1)-1)).OR. * (TWIDY.GE.(DIMEN(2)-1)))THEN CONTXT='twidx or twidy too big for image size' GO TO 999 ENDIF CALL TAINFO(IMAGE,DIMEN(1),DIMEN(2),TWIDX,TWIDY,AREA, * EDGES,CTROID,ECENT,CCENT,FLUX,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error processing field map' GO TO 999 ENDIF C C DETERMINE POSITION OF LINE=0 AND SAMPLE=0 C HWIDX = DIMEN(1)/2+1 HWIDY = DIMEN(2)/2+1 X0 = XMAPC - HWIDX*DELX Y0 = YMAPC - HWIDY*DELY ENDIF C C----------------------------------------------------------------------- C READY TO WRITE OUTPUT TABLE C C CREATE TABLE IF TBSTAT NE 'APPEND' C IF(TBSTAT.NE.'append')THEN C CALL UTTINN(OUTPUT,IDOUT,ISTATS(1)) CALL UTPPTI(IDOUT,TBALLR,4,ISTATS(2)) CALL UTPPTI(IDOUT,TBMXCL,15,ISTATS(3)) CALL UTCDEF(IDOUT,COLNAM,CUNITS,CFORM,CTYPE,14,COLIDS, * ISTATS(4)) CALL UTTCRE(IDOUT,ISTATS(5)) CONTXT='Error creating output table' DO 200 I=1,5 IF(ISTATS(I).NE.0) GO TO 999 200 CONTINUE NROWS=0 ELSE C C OPEN EXISTING TABLE C CALL UTTOPN(OUTPUT,RDWRIT,IDOUT,ISTATS(1)) CALL UTCFND(IDOUT,COLNAM,14,COLIDS,ISTATS(2)) CALL UTPGTI(IDOUT,TBNROW,NROWS,ISTATS(3)) CONTXT='Error opening output table for appending' DO 300 I=1,3 IF(ISTATS(I).NE.0) GO TO 999 300 CONTINUE C C CHECK GRATING MODE CONSISTENCY C CALL UTHGTT(IDOUT,'grating',GMODE,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading grating mode from table' GO TO 999 ENDIF IF(GMODE.NE.GRAT)THEN CONTXT='Grating mode in map and table do not match' GO TO 999 ENDIF ENDIF C C WRITE INFO TO THE OUTPUT TABLES C IF(MAP)THEN DO 400 I=1,25 400 ISTATS(I)=0 NROWS=NROWS+1 CALL UTRPTT(IDOUT,COLIDS(1),1,NROWS,APER,ISTATS(1)) IF(EDGES(1).NE.0.0) CALL UTRPTD(IDOUT,COLIDS(2),1,NROWS, * EDGES(1)*DELX+X0,ISTATS(2)) IF(EDGES(2).NE.0.0) CALL UTRPTD(IDOUT,COLIDS(3),1,NROWS, * EDGES(2)*DELX+X0,ISTATS(3)) IF(EDGES(3).NE.0.0) CALL UTRPTD(IDOUT,COLIDS(4),1,NROWS, * EDGES(3)*DELY+Y0,ISTATS(4)) IF(EDGES(4).NE.0.0) CALL UTRPTD(IDOUT,COLIDS(5),1,NROWS, * EDGES(4)*DELY+Y0,ISTATS(5)) IF(ECENT(1).NE.0.0) CALL UTRPTD(IDOUT,COLIDS(6),1,NROWS, * ECENT(1)*DELX+X0,ISTATS(6)) IF(ECENT(2).NE.0.0) CALL UTRPTD(IDOUT,COLIDS(7),1,NROWS, * ECENT(2)*DELY+Y0,ISTATS(7)) IF(CTROID(1).NE.0.0) CALL UTRPTD(IDOUT,COLIDS(8),1,NROWS * ,CTROID(1)*DELX+X0,ISTATS(8)) IF(CTROID(2).NE.0.0) CALL UTRPTD(IDOUT,COLIDS(9),1,NROWS * ,CTROID(2)*DELY+Y0,ISTATS(9)) IF(CCENT(1).NE.0.0) CALL UTRPTD(IDOUT,COLIDS(10),1,NROWS * ,CCENT(1)*DELX+X0,ISTATS(10)) IF(CCENT(2).NE.0.0) CALL UTRPTD(IDOUT,COLIDS(11),1,NROWS * ,CCENT(2)*DELY+Y0,ISTATS(11)) IF((EDGES(1).NE.0.0) .AND. (EDGES(2).NE.0.0) .AND. * (EDGES(3).NE.0.0) .AND. (EDGES(4).NE.0.0))THEN A=(EDGES(2)-EDGES(1))*(EDGES(4)-EDGES(3)) A=A*DELX*DELY CALL UTRPTD(IDOUT,COLIDS(12),1,NROWS,A, * ISTATS(12)) ENDIF CALL UTRPTD(IDOUT,COLIDS(13),1,NROWS,FLUX,ISTATS(13)) CALL UTRPTT(IDOUT,COLIDS(14),1,NROWS,TIME,ISTATS(22)) ENDIF C C IF DEF. CAL. ALSO WRITE SC1 AND SC2 COLUMNS C IF(DEFCAL)THEN NROWS=NROWS+1 CALL UTRPTT(IDOUT,COLIDS(1),1,NROWS,'sc1',ISTATS(14)) CALL UTRPTT(IDOUT,COLIDS(1),1,NROWS+1,'sc2',ISTATS(15)) CALL UTRPTD(IDOUT,COLIDS(6),1,NROWS,XSC1,ISTATS(16)) CALL UTRPTD(IDOUT,COLIDS(6),1,NROWS+1,XSC2,ISTATS(17)) CALL UTRPTD(IDOUT,COLIDS(7),1,NROWS,YSC1,ISTATS(18)) CALL UTRPTD(IDOUT,COLIDS(7),1,NROWS+1,YSC2,ISTATS(19)) CALL UTRPTT(IDOUT,COLIDS(14),1,NROWS,TIME,ISTATS(23)) CALL UTRPTT(IDOUT,COLIDS(14),1,NROWS+1,TIME,ISTATS(24)) ENDIF CALL UTHADT(IDOUT,'grating',GRAT,ISTATS(20)) CALL UTTCLO(IDOUT,ISTATS(21)) DO 500 I=1,24 IF(ISTATS(I).NE.0)THEN CONTXT='Error writing to output table' GO TO 999 ENDIF 500 CONTINUE C C DONE C GO TO 1000 999 CALL UMSPUT(CONTXT,STDOUT+STDERR,0,ISTAT) 1000 RETURN END