SUBROUTINE ZFOCS C C Module Number: 13.3.1 C C Module Name: ZFOCS C C Keyphrase: C ---------- C Compute HRS focus parameter C C Description: C ------------ C Using observations of either the left or right photocathode C edge all taken at the same y-deflection the focus parameter is C computed by: C C 1) The data is merged into a single substepped vector C 2) The x-position of the 10% and 90% level of the edge is determined C 3) The focus parameter (in deflections steps) is computed as the C difference of the 10 and 90 percent level positions C C FORTRAN Name: zfocs.for C C C Keywords of Accessed Files : C -------------------------- C input input list of input observations C table output output focus table C newtable input input table flag (yes=new, no=append) C C Modules Called: C --------------- C CDBS: C zdfoc, zfmerge C SDAS: C uclgs* , umsput C uttinn, utppti, utcdef, utrpt*, utcpt*, uthad*, uttclo, utccre C uttopn, utpgti, utcfnd, utrgt*, utcgt*, uthgt*, uttclo C uimotp, uimxtp, uimctp, uimopn, uimgid, uimclo, uhdgs* uimclo C History: C -------- C Version Date Author Description C 1 Oct 86 D. Lindler Design and coded C 2 Dec 87 D. Lindler New SDAS I/O and standards C 3 Feb 97 M. De La Pena Removed search for TWEAK keyword C------------------------------------------------------------------------ C Data Declaration 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 ---> STATUS INDICATOR CHARACTER*130 CONTXT C ---> STATUS MESSAGE C ---> ERROR NUMBER C C INPUT FILE I/O C CHARACTER*130 INPUT,NAME INTEGER IDTEMP,IDIN,NAXIS,DTYPE,DIMEN(8) DOUBLE PRECISION DATA(512) C C TABLE PARAMETERS C LOGICAL NEWTAB CHARACTER*64 TABLE CHARACTER*8 COLNAM(6),CFORM(6),CUNITS(6) INTEGER COLIDS(6),CTYPE(6) INTEGER NROWS,IDOUT INTEGER DET,DET1 C --->DETECTOR NUMBERS DOUBLE PRECISION YDEF,YDEF1 C --->YDEFLECTIONS DOUBLE PRECISION FOCUS,HV,TWEAK CHARACTER*5 EDGE C C OTHER VARIABLES C DOUBLE PRECISION BDATA(5100), C ---> VECTOR OF MERGED DATA & XDEF C ---> X-DEFLECTION INTEGER I C --->INDEX INTEGER NADDS(5100) C ---> # OF ADDS TO EACH POINT IN DATA CHARACTER*8 HVKEY(2) C --->HIGH VOLTAGE KEYWORDS LOGICAL FIRST CHARACTER*8 HEADER(3) C C DATA DECLARATIONS C DATA COLNAM/'DETECTOR','EDGE','HV','TWEAK','YDEF','FOCUS'/ DATA CFORM/6*' '/ DATA CUNITS/6*' '/ DATA CTYPE/TYINT,-5,4*TYREAL/ DATA HVKEY/'ZPCV1','ZPCV2'/ DATA HEADER/'DETECTOR','YDEF','XDEF'/ C C KEYWORD TWEAK IS NOT PRESENT AND NO LONGER LOOKED FOR IN THE INPUT HEADER C DATA TWEAK / 0.0D0 / C C------------------------------------------------------------------------- C C INITIALIZE MERGED DATA VECTOR C DO 1 I=1,5100 BDATA(I)=0.0 NADDS(I)=0 1 CONTINUE FIRST=.TRUE. C C GET CL PARAMETERS C CALL UCLGST('input',INPUT,ISTATS(1)) CALL UCLGST('table',TABLE,ISTATS(2)) CALL UCLGSB('newtable',NEWTAB,ISTATS(3)) DO 10 I=1,3 IF(ISTATS(I).NE.0)THEN CONTXT='Error gettting CL parameter' GO TO 999 ENDIF 10 CONTINUE C C OPEN TEMPALTE C CALL UIMOTP(INPUT,IDTEMP,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error opening input filename template '//INPUT GO TO 999 ENDIF C C GET NEXT FILE NAME C 20 CALL UIMXTP(IDTEMP,NAME,ISTAT) IF(ISTAT.LT.0)GO TO 100 IF(ISTAT.NE.0)THEN CONTXT='Error getting filename from template '//INPUT GO TO 999 ENDIF C C OPEN INPUT FILE C CALL UIMOPN(NAME,RDONLY,IDIN,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error opening file '//NAME GO TO 999 ENDIF C C READ IMAGE INFO C CALL UIMGID(IDIN,DTYPE,NAXIS,DIMEN,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading input file '//NAME GO TO 999 ENDIF C C CHECK FOR VALID DATA C IF((NAXIS.NE.1).OR.(DIMEN(1).NE.500))THEN CONTXT='Input data must be 500 point vectors' GO TO 999 ENDIF C C GET HEADER PARAMETERS C CALL UHDGSI(IDIN,'DETECTOR',DET,ISTATS(1)) CALL UHDGSD(IDIN,'YDEF',YDEF,ISTATS(2)) CALL UHDGSD(IDIN,'XDEF',XDEF,ISTATS(3)) DO 35 I=1,3 IF(ISTATS(I).NE.0)THEN CONTXT='Error getting header parameter '//HEADER(I) GO TO 999 ENDIF 35 CONTINUE IF((DET.NE.1).AND.(DET.NE.2))THEN CONTXT='Invalid detector number in '//NAME GO TO 999 ENDIF C C CHECK CONSISTENCY OF DATA C IF(FIRST)THEN YDEF1=YDEF DET1=DET ENDIF IF((YDEF1.NE.YDEF).OR.(DET1.NE.DET))THEN CONTXT='All data not for the same y-deflection and detector' GO TO 999 ENDIF C C GET HV FOR THE PROPER DETECTOR C CALL UHDGSD(IDIN,HVKEY(DET),HV,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error getting pc high voltage from header' GO TO 999 ENDIF C C DETERMINE WHICH EDGE IS BEING PROCESSED C IF(FIRST)THEN EDGE='LEFT' IF(XDEF.GT.2048)EDGE='RIGHT' ENDIF C C READ DATA C CALL UIGL1D(IDIN,DATA,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading input file '//NAME GO TO 999 ENDIF C C CLOSE IMAGE C CALL UIMCLO(IDIN,ISTAT) C C PLACED DATA INTO MERGED DATA ARRAY C CALL ZFMERG(DATA,XDEF,BDATA,NADDS) C C GO GET NEXT IMAGE C FIRST=.FALSE. GO TO 20 100 CONTINUE C C DONE READING INPUT DATA ------------------------------------------------ C C C DETERMINE FOCUS C CALL ZDFOC(BDATA,NADDS,EDGE,FOCUS,STATUS) IF(STATUS.NE.0)THEN CONTXT='ERROR COMPUTING FOCUS' GO TO 999 ENDIF C C CREATE OUTPUT OR APPEND TO EXISTING TABLE C IF(NEWTAB)THEN C C CREATE NEW TABLE C CALL UTTINN(TABLE,IDOUT,ISTATS(1)) CALL UTPPTI(IDOUT,TBRLEN,6,ISTATS(2)) CALL UTPPTI(IDOUT,TBMXCL,7,ISTATS(3)) CALL UTCDEF(IDOUT,COLNAM,CUNITS,CFORM,CTYPE,6, * COLIDS,ISTATS(4)) CALL UTTCRE(IDOUT,ISTATS(5)) DO 200 I=1,5 IF(ISTATS(I).NE.0)THEN CONTXT='Error creating output table '//TABLE GO TO 999 ENDIF 200 CONTINUE NROWS=1 ELSE CALL UTTOPN(TABLE,RDWRIT,IDOUT,ISTATS(1)) CALL UTPGTI(IDOUT,TBNROW,NROWS,ISTATS(2)) CALL UTCFND(IDOUT,COLNAM,6,COLIDS,ISTATS(3)) DO 300 I=1,3 IF(ISTATS(I).NE.0)THEN CONTXT='Error reading table '//NAME GO TO 999 ENDIF 300 CONTINUE NROWS=NROWS+1 ENDIF C C COPY RESULTS TO TABLE C CALL UTRPTI(IDOUT,COLIDS(1),1,NROWS,DET,ISTATS(1)) CALL UTRPTT(IDOUT,COLIDS(2),1,NROWS,EDGE,ISTATS(2)) CALL UTRPTD(IDOUT,COLIDS(3),1,NROWS,HV,ISTATS(3)) CALL UTRPTD(IDOUT,COLIDS(4),1,NROWS,TWEAK,ISTATS(4)) CALL UTRPTD(IDOUT,COLIDS(5),1,NROWS,YDEF,ISTATS(5)) CALL UTRPTD(IDOUT,COLIDS(6),1,NROWS,FOCUS,ISTATS(6)) DO 210 I=1,6 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 '//TABLE GO TO 999 ENDIF C C DONE C GO TO 1000 999 CALL UMSPUT(CONTXT,STDOUT+STDERR,0,ISTAT) 1000 CALL UIMCTP(IDTEMP,ISTAT) END