SUBROUTINE ZMPSCL C C Module Number: 13.8.1 C C Module Name: ZMPSC C C Keyphrase: C ---------- C Compute HRS photocathode sample mapping coefficients C C Description: C ------------ C Using observations of the left and right photocathode mask edge with C the flat field lamp on, a least squares fit is performed to compute C the coefficients of the following equation giving sample position as C a function of x-deflection and diode number. C C S = s0 + b*(dx) + e*X C where dx is the x-deflection minus 2048 and X is the diode number C s0, b, e are the fitted coefficients C C C FORTRAN Name: zmpsc.for C C C Keywords of Accessed Files : C -------------------------- C input input Observations of left and right edges C table output Coefficients fo fit C C Modules Called: C --------------- C CDBS: C zefit, ZPEDGE C SDAS: C uclgst, uimopn, uttinn, utppti, utcdef, uttcre, utrpt*, C uttclo, uimotp, uimxtp, uimg1d, uhdgs* C OTHERS: C C History: C -------- C Version Date Author Description C 1 3-10-86 D. Lindler Design and coded C 2 15-Dec-87 D. Lindler New sdas i/o and 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 STATUS C ---> STATUS INDICATOR CHARACTER*130 CONTXT C ---> STATUS MESSAGE INTEGER ISTAT,ISTATS(10) C C OUTPUT TABLE VARIABLES C CHARACTER*64 TABLE INTEGER IDOUT CHARACTER*8 COLNAM(10),CUNITS(10),CFORM(10) INTEGER CTYPE(10) DOUBLE PRECISION VALUES(9) C ---> R*8 ROW VALUES INTEGER COLIDS(10) INTEGER NTAB C ---> NUMBER OF ROWS IN TABLE C INTEGER I DOUBLE PRECISION EDGEPS(2) C ---> RIGHT EDGE LOC. BOTH DETECTORS DOUBLE PRECISION XTAB(500), C ---> TABLE OF FOUND EDGE LOCATIONS * DXTAB(500), C ---> TABLE OF X-DEFLECTIONS * SPOS(500), C ---> TABLE OF EDGE SAMPLE POSITIONS * XDEF, C ---> X-DEF FOR 7 SUBSTEP BINS * YDEF, C ---> Y-DEF FOR 7 SUBSTEP BINS * XPOS, C ---> FOUND EDGE LOCATION * YDEF1 C ---> FIRST Y-DEF OF FIRST FILE CHARACTER*5 EDGE C ---> EDGE 'RIGHT' OR 'LEFT' LOGICAL FIRST INTEGER DET,DET1 C ---> DETECTOR NUMBERS C C INPUT FILE I/O C CHARACTER*130 INPUT,NAME INTEGER IDTEMP,IDIN,NAXIS,DTYPE,DIMEN(8) DOUBLE PRECISION DATA(512) C C DATA DECLARATIONS C DATA COLNAM/'DETECTOR','YDEF','S0','ERROR_S0','B','ERROR_B', & 'C','ERROR_C','E','ERROR_E'/ DATA CUNITS/10*' '/ DATA CFORM/10*' '/ DATA CTYPE/2*TYINT,8*TYDOUB/ DATA EDGEPS/562.0,558.0/ C C--------------------------------------------------------------------- C C GET CL PARAMETERS C CALL UCLGST('input',INPUT,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error getting input filename template' GO TO 999 ENDIF CALL UCLGST('table',TABLE,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error getting output table name' GO TO 999 ENDIF C C OPEN TEMPALTE C FIRST=.TRUE. 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).AND.(FIRST))THEN CONTXT='No data found in input template '// * INPUT GO TO 999 ENDIF 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 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 IMAGE PARAMETERS C CALL UHDGSI(IDIN,'DETECTOR',DET,ISTAT) IF(ISTAT.NE.0) THEN CONTXT='Error getting DETECTOR value from input file' GO TO 999 ENDIF CALL UHDGSD(IDIN,'YDEF',YDEF,ISTAT) IF(ISTAT.NE.0) THEN CONTXT='Error getting YDEF value from input file' GO TO 999 ENDIF CALL UHDGSD(IDIN,'XDEF',XDEF,ISTAT) IF(ISTAT.NE.0) THEN CONTXT='Error getting XDEF value from input file' GO TO 999 ENDIF C C CHECK FOR CONSISTENT Y-DEFLECTIONS AND DETECTOR C IF(FIRST)THEN YDEF1=YDEF DET1=DET NTAB=0 ENDIF IF((YDEF.NE.YDEF1).OR.(DET.NE.DET1))THEN CONTXT='ALL DATA NOT AT SAME Y-DEFLECTION AND 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 CLOSE IMAGE C CALL UIMCLO(IDIN,ISTAT) C C FIND EDGE LOCATION C CALL ZPEDGE(DATA,XDEF,FIRST,XPOS,EDGE,STATUS) C C ADD TO TABLE IF FOUND C IF(STATUS.EQ.0) THEN NTAB=NTAB+1 DXTAB(NTAB)=XDEF XTAB(NTAB)=XPOS SPOS(NTAB)=0.0 IF(EDGE.EQ.'RIGHT')SPOS(NTAB)=EDGEPS(DET) ENDIF C C GO GET NEXT IMAGE C FIRST=.FALSE. GO TO 20 100 CONTINUE C C DONE READING INPUT DATA ------------------------------------------------ C C C COMPUTE COEFFICIENTS C CALL ZEFIT(DET,YDEF1,NTAB,XTAB,DXTAB,SPOS,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,20,ISTATS(2)) CALL UTPPTI(IDOUT,TBMXCL,11,ISTATS(3)) CALL UTCDEF(IDOUT,COLNAM,CUNITS,CFORM,CTYPE,10,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 COPY RESULTS TO TABLE C CALL UTRPTI(IDOUT,COLIDS(1),1,1,DET,ISTATS(1)) CALL UTRPTD(IDOUT,COLIDS(2),1,1,YDEF,ISTATS(2)) CALL UTRPTD(IDOUT,COLIDS(3),8,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) CALL UIMCTP(IDTEMP,ISTAT) 1000 RETURN END