SUBROUTINE ZMPLCL C C Module Number: 13.8.2 C C Module Name: ZMPLCL C C Keyphrase: C ---------- C Compute HRS photocathode line mapping coefficients C C Description: C ------------ C Using observations of the upper and lower photocathode mask edge with C the flat field lamp on, the y-deflections needed to center the edges on C the main diode array are determined. C C The coefficients in the following equation are computed, assuming the C line position of the upper edge is 0 and the lower edge is 430. C C L = L0 + A * (ydef-2048) C C where: C L is the line position for y-deflection ydef C L0 and A are the mapping coefficients C C C FORTRAN Name: zmplcl.for C C C Keywords of Accessed Files : C -------------------------- C input input Observations of upper and lower edges C table output Line mapping function Coefficients C C Modules Called: C --------------- C CDBS: C zledge, zgetdef, zpiksr2, zlcoef C SDAS: C uclgs* , umsput C uttinn, utppti, utcdef, utrpt*, utcpt*, uthad*, uttclo, utccre C uimotp, uimxtp, uimctp, uimopn, uimgid, uimclo, uhdgs* uimclo C C History: C -------- C Version Date Author Description C 1 3-10-86 D. Lindler Design and coded C 2 dec 87 D. Lindler New SDAS IO/standards 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 ISTAT,STATUS,ISTATS(10) C ---> STATUS INDICATORS CHARACTER*130 CONTXT C ---> STATUS MESSAGE C C INPUT FILE I/O C CHARACTER*130 INPUT,NAME INTEGER IDTEMP,IDIN,NAXIS,DTYPE,DIMEN(8) DOUBLE PRECISION DATA(512) C C LOCAL VARIABLES C CHARACTER*64 TABLE INTEGER IDOUT CHARACTER*8 COLNAM(6),CUNITS(6),CFORM(6) INTEGER COLIDS(6),CTYPE(6) DOUBLE PRECISION VALUES(4) C C CL PARAMETERS C INTEGER DFIRST,DLAST C --->FIRST AND LAST DIODE C C OTHERS C INTEGER NUP,NLOW, C ---> # OF YDEF OBSERVED FOR EDGES * DET,DET1 C ---> HRS DETECTOR NUMBER DOUBLE PRECISION * YDEF, C ---> Y-DEFLECTIONS * YDEFUP(2000),YDEFLW(2000), C ---> TABLES OF DEFLEC. FOR EDGES * TOTUP(2000),TOTLOW(2000), C ---> TABLES OF COUNTS * TOT C ---> TOTAL OF CENTER DIODES LOGICAL FIRST INTEGER I C C DATA DECLARATIONS C DATA COLNAM/'DETECTOR','YDEF','L0','ERROR_L0','A','ERROR_A'/ DATA CUNITS/6*' '/ DATA CFORM/6*' '/ DATA CTYPE/2*TYINT,4*TYDOUB/ C------------------------------------------------------------------------------ C C GET CL PARAMETERS C CALL UCLGST('input',INPUT,ISTATS(1)) CALL UCLGST('table',TABLE,ISTATS(2)) CALL UCLGSI('dfirst',DFIRST,ISTATS(3)) CALL UCLGSI('dlast',DLAST,ISTATS(4)) DO 1 I=1,4 IF(ISTATS(I).NE.0)THEN CONTXT='Error getting CL parameters' GO TO 999 ENDIF 1 CONTINUE IF(DLAST.LT.DFIRST)THEN CONTXT='dlast must be greater than or equal to dfirst' GO TO 999 ENDIF C C INITILIZATION C FIRST=.TRUE. NUP=0 C ---> INITIALIZE NUMBER OF EDGES FOUND NLOW=0 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 KEYWORD PARAMETERS C CALL UHDGSI(IDIN,'DETECTOR',DET,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error getting detector keyword from '//NAME GO TO 999 ENDIF CALL UHDGSD(IDIN,'YDEF',YDEF,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error getting YDEF form '//NAME GO TO 999 ENDIF IF(FIRST)DET1=DET IF(DET1.NE.DET)THEN CONTXT='All input observations must be same DETECTOR' GO TO 999 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 COMPUTE TOTAL COUNTS FOR DIODES DFIRST,DLAST ON THE MAIN DIODE ARRAY C TOT=0 DO 50 I=DFIRST,DLAST TOT=TOT+DATA(I) 50 CONTINUE C C ADD TO PROPER TABLE C IF(YDEF.LT.2048) THEN NUP=NUP+1 C ---> UPPER EDGE YDEFUP(NUP)=YDEF TOTUP(NUP)=TOT ELSE NLOW=NLOW+1 C ---> LOWER EDGE YDEFLW(NLOW)=YDEF TOTLOW(NLOW)=TOT ENDIF C C CLOSE IMAGE C CALL UIMCLO(IDIN,ISTAT) C C GO GET NEXT IMAGE C GO TO 20 100 CONTINUE C C DONE READING INPUT DATA ------------------------------------------------ C C C COMPUTE COEFFICIENTS C CALL ZLCOEF(DET,NUP,YDEFUP,TOTUP,NLOW,YDEFLW,TOTLOW, * VALUES,STATUS) IF(STATUS.NE.0) THEN CONTXT='Unable to generate reference relation' GO TO 999 ENDIF C C OPEN OUTPUT TABLE C CALL UTTINN(TABLE,IDOUT,ISTATS(1)) CALL UTPPTI(IDOUT,TBRLEN,10,ISTATS(2)) CALL UTPPTI(IDOUT,TBMXCL,6,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 C C ADD DFIRST AND DLAST TO HEADER C CALL UTHADI(IDOUT,'DFIRST',DFIRST,ISTATS(1)) CALL UTHADI(IDOUT,'DLAST',DLAST,ISTATS(2)) IF((ISTATS(1).NE.0).OR.(ISTATS(2).NE.0))THEN CONTXT='Error parameters dfirst,dlast to output table' GO TO 999 ENDIF C C COPY RESULTS TO TABLE C CALL UTRPTI(IDOUT,COLIDS(1),1,1,DET,ISTATS(1)) CALL UTRPTI(IDOUT,COLIDS(2),1,1,2048,ISTATS(2)) CALL UTRPTD(IDOUT,COLIDS(3),4,1,VALUES,ISTATS(3)) DO 210 I=1,3 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