C   20/03/97 703202248  MEMBER NAME  JEOSUM4  (PATRECSR)    SHELTRAN
 00000    C   03/09/79 706261839  MEMBER NAME  INPATC   (S)           SHELTRAN
 00001   2      SUBROUTINE INPATC
 00002   3      IMPLICIT INTEGER*2 (H)
 00003    C
 00004    C-----------------------------------------------------------------------
 00005    C        INITIALIZE CONSTANTS USED BY PATTERN RECOGNITION PROGRAMS
 00006    C        ADDED CALL TO ADPATR     26/06/87     E ELSEN
 00007    C-----------------------------------------------------------------------
 00008    C
          C----------------------------------------------------------------------
          C             MACRO CDATA .... BOS COMMON.
          C
          C             THIS MACRO ONLY DEFINES THE IDATA/HDATA/ADATA NAMES.
          C             THE ACTUAL SIZE OF /BCS/ IS FIXED ON MACRO CBCSMX
          C             OR BY OTHER MEANS. A DEFAULT SIZE OF 40000 IS GIVEN HERE.
          C
          C----------------------------------------------------------------------
          C
         4      COMMON /BCS/ IDATA(40000)
         5      DIMENSION HDATA(80000),ADATA(40000),IPNT(50)
         6      EQUIVALENCE (HDATA(1),IDATA(1),ADATA(1)),(IPNT(1),IDATA(55))
         7      EQUIVALENCE (NWORD,IPNT(50))
          C
          C------------------------ END OF MACRO CDATA --------------------------
          C----------------------------------------------------------------------
          C           MACRO CDSMAX .... PATTERN RECOGNITION CONSTANTS.
          C----------------------------------------------------------------------
         8      COMMON/CDSMAX/DSMAX(16,3,2),DIRWR1(24,2),DIRWR3(48,2)
               *             ,DHALF(16,3,2),DTWICE(16,3,2),HMCH(16,3,2)
               *             ,IBCK(9),DBCK(30),TRMATS(96,2),TRMATC(96,2)
          C------------------------ END OF MACRO CDSMAX -------------------------
 00100    C-----------------------------------------------------------------------
 00200    C                            MACRO CJDRCH .... JET CHAMBER CONSTANTS.
 00300    C-----------------------------------------------------------------------
 00310    C
 00400   9      COMMON / CJDRCH / RDEC(4),PSIIN(3),RINCR(3),FIRSTW(3),FSENSW(3),
 00500         +                  RDEPTH,SWDEPL,YSUSPN,TIMDEL(2,3),ZMAX,ZOFFS,
 00510         +                  ZRESOL,ZNORM,ZAL,ZSCAL,DRIDEV,DRICOS,DRISIN,
 00600         +                  PEDES,TZERO(3),DRIROT(96,2),SINDRI(96,2),
 00701         +                  COSDRI(96,2),DRIVEL(96,2),T0FIX(3),
 00800         +                  ABERR(8), DUMJDC(20)
 00900    C
 01100    C      BLOCK DATA SET TO MC VALUES, KALIBR WILL SET REAL DATA VALUES
 01210    C--->  A CHANGE OF THIS COMMON MUST BE DONE SIMULTANEOUSLY WITH  <----
 01220    C--->  A CHANGE OF THE BLOCK DATA                                <----
 01230    C
 01300    C--------------------------- END OF MACRO CJDRCH -----------------------
 01400    C
 00012    C
 00013    C   CHANGED TO CHECK RUN NUMBER AND TO RETURN IF NO NEW RUN NUMBER
 00014    C
 00015  10      DATA HHHRUN /-1/
 00016    C
 00017  11      IPHE = IDATA(IBLN('HEAD'))
 00018  12      HHRUN = HDATA(2*IPHE+10)
 00019  13      IF(HHRUN.EQ.HHHRUN) RETURN
 00020  15      HHHRUN = HHRUN
 00021    C
 00022    C                                           CHANGED 26/06/87
 00023  16      NRUN = HHRUN
 00024  17      CALL ADPATR( NRUN )
 00025    C
 00026    C---------------------------
 00027    C     ANGLES OF CELL BOUNDS
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  2
0CARD TARGET
  NO  STM.NO
 
 00028    C---------------------------
 00029  18      DFI0 = 3.1415927 / 12.
 00030  19      DFI1 = 3.1415927 / 24.
 00031  20      DFI3 = 3.1415927 / 48.
 00032    C-------------------------------------------
 00033    C    WIRE PLANE DIRECTIONS FOR RINGS 1 AND 2
 00034    C-------------------------------------------
 00035  21      FI = DFI1
 00036  22      FOR I=1,6
 00037  23         DX = COS(FI)
 00038  24         DY = SIN(FI)
 00039  25         DIRWR1(I   ,1) = DX
 00040  26         DIRWR1(I   ,2) = DY
 00041  27         DIRWR1(I+ 6,1) =-DY
 00042  28         DIRWR1(I+ 6,2) = DX
 00043  29         DIRWR1(I+12,1) =-DX
 00044  30         DIRWR1(I+12,2) =-DY
 00045  31         DIRWR1(I+18,1) = DY
 00046  32         DIRWR1(I+18,2) =-DX
 00047  33         FI = FI + DFI0
 00048  34      CFOR
 00049    C------------------------------------
 00050    C    WIRE PLANE DIRECTIONS FOR RING 3
 00051    C------------------------------------
 00052  36      FI = DFI3
 00053  37      FOR I=1,12
 00054  38         DX = COS(FI)
 00055  39         DY = SIN(FI)
 00056  40         DIRWR3(I   ,1) = DX
 00057  41         DIRWR3(I   ,2) = DY
 00058  42         DIRWR3(I+12,1) =-DY
 00059  43         DIRWR3(I+12,2) = DX
 00060  44         DIRWR3(I+24,1) =-DX
 00061  45         DIRWR3(I+24,2) =-DY
 00062  46         DIRWR3(I+36,1) = DY
 00063  47         DIRWR3(I+36,2) =-DX
 00064  48         FI = FI + DFI1
 00065  49      CFOR
 00066    C---------------------------------
 00067    C    DRIFT SPACE DIRECTIONS
 00068    C---------------------------------
 00069  51      FOR I=1,96
 00070    C     GET WIRE PLANE DIRECTION
 00071  52         K = I
 00072  53         IF(K.GT.24) K=K-24
 00073  55         IF I.LE.48
 00074  56         THEN
 00075  59            DX=DIRWR1(K,1)
 00076  60            DY=DIRWR1(K,2)
 00077  61         ELSE
 00078  63            DX=DIRWR3(K-24,1)
 00079  64            DY=DIRWR3(K-24,2)
 00080  65         CIF
 00081    C     FORM DRIFT DIRECTION TRANSFORMATION MATRIX
 00082    C       TRMATS(CELL,L/R)
 00083  66         TRMATS(I,1) = -( DY * COSDRI(I,1) + DX * SINDRI(I,1) )
 00084  67         TRMATS(I,2) = -( DY * COSDRI(I,2) + DX * SINDRI(I,2) )
 00085  68         TRMATC(I,1) =  ( DX * COSDRI(I,1) - DY * SINDRI(I,1) )
 00086  69         TRMATC(I,2) =  ( DX * COSDRI(I,2) - DY * SINDRI(I,2) )
 00087  70      CFOR
 00088    C-------------------------------
 00089    C     INITIALIZE MAX. DRIFTSPACE
 00090    C-------------------------------
 00091  72      FACTL1 = SIN(DFI1) / COS(DFI1+DRIDEV)
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  3
0CARD TARGET
  NO  STM.NO
 
 00092  73      FACTR1 = SIN(DFI1) / COS(DFI1-DRIDEV)
 00093  74      FACTL3 = SIN(DFI3) / COS(DFI3+DRIDEV)
 00094  75      FACTR3 = SIN(DFI3) / COS(DFI3-DRIDEV)
 00095  76      R1 = FSENSW(1)
 00096  77      R2 = FSENSW(2)
 00097  78      R3 = FSENSW(3)
 00098  79      FOR ILAY=1,16
 00099    C       DSMAX(LAYER,RING,L/R)
 00100  80         DSMAX(ILAY,1,1) = R1 * FACTL1
 00101  81         DSMAX(ILAY,2,1) = R2 * FACTL1
 00102  82         DSMAX(ILAY,3,1) = R3 * FACTL3
 00103  83         DSMAX(ILAY,1,2) = R1 * FACTR1
 00104  84         DSMAX(ILAY,2,2) = R2 * FACTR1
 00105  85         DSMAX(ILAY,3,2) = R3 * FACTR3
 00106  86         R1 = R1 + RINCR(1)
 00107  87         R2 = R2 + RINCR(2)
 00108  88         R3 = R3 + RINCR(3)
 00109  89      CFOR
 00110  91      CALL INBACK
 00111  92      RETURN
 00112  93      END
0END OF SEGMENT
0  OPTIONS IN EFFECT - LINECOUNT=64,LINEWIDTH=131,  SOURCE,  FORTRAN  NUMBERING
0   0 ERRORS           0 WARNINGS          92 TARGET STATEMENTS
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  1
0CARD TARGET
  NO  STM.NO
 
 00113    C
 00114    C    ***************************************
 00115    C
 00116   2      SUBROUTINE INBACK
 00117   3      IMPLICIT INTEGER*2 (H)
 00118    C--------------------------------------------
 00119    C      INITIALIZATION OF CONSTANTS FOR BACKTR
 00120    C--------------------------------------------
          C----------------------------------------------------------------------
          C           MACRO CDSMAX .... PATTERN RECOGNITION CONSTANTS.
          C----------------------------------------------------------------------
         4      COMMON/CDSMAX/DSMAX(16,3,2),DIRWR1(24,2),DIRWR3(48,2)
               *             ,DHALF(16,3,2),DTWICE(16,3,2),HMCH(16,3,2)
               *             ,IBCK(9),DBCK(30),TRMATS(96,2),TRMATC(96,2)
          C------------------------ END OF MACRO CDSMAX -------------------------
 00100    C-----------------------------------------------------------------------
 00200    C                            MACRO CJDRCH .... JET CHAMBER CONSTANTS.
 00300    C-----------------------------------------------------------------------
 00310    C
 00400   5      COMMON / CJDRCH / RDEC(4),PSIIN(3),RINCR(3),FIRSTW(3),FSENSW(3),
 00500         +                  RDEPTH,SWDEPL,YSUSPN,TIMDEL(2,3),ZMAX,ZOFFS,
 00510         +                  ZRESOL,ZNORM,ZAL,ZSCAL,DRIDEV,DRICOS,DRISIN,
 00600         +                  PEDES,TZERO(3),DRIROT(96,2),SINDRI(96,2),
 00701         +                  COSDRI(96,2),DRIVEL(96,2),T0FIX(3),
 00800         +                  ABERR(8), DUMJDC(20)
 00900    C
 01100    C      BLOCK DATA SET TO MC VALUES, KALIBR WILL SET REAL DATA VALUES
 01210    C--->  A CHANGE OF THIS COMMON MUST BE DONE SIMULTANEOUSLY WITH  <----
 01220    C--->  A CHANGE OF THE BLOCK DATA                                <----
 01230    C
 01300    C--------------------------- END OF MACRO CJDRCH -----------------------
 01400    C
 00123    C
 00124   6      DIMENSION LFTCL(3),LSTCL(3),NCELL(3),TANDEL(3)
 00125   7      EQUIVALENCE (IBCK(1),LSTCL(1)),(IBCK(4),LFTCL(1))
 00126   8      EQUIVALENCE (IBCK(7),NCELL(1)),(DBCK(1),TANDEL(1))
 00127
 00128   9      DIMENSION GB(3)
 00129  10      DATA GB/376.,586.,797./
 00130    C
 00131  11      NCELL(1)=24
 00132  12      NCELL(2)=24
 00133  13      NCELL(3)=48
 00134  14      LSTCL(1)=24
 00135  15      LSTCL(2)=48
 00136  16      LSTCL(3)=96
 00137  17      LFTCL(1)=1
 00138  18      LFTCL(2)=25
 00139  19      LFTCL(3)=49
 00140  20      DEL=3.141593/48.
 00141  21      DBCK(4)=COS(DEL-DRIDEV)
 00142  22      DBCK(5)=COS(DEL+DRIDEV)
 00143  23      DBCK(6)=TAN(DEL)
 00144  24      DBCK(7)=TAN(DEL+3.141593/24.)
 00145  25      DBCK(8)=SIN(DEL)
 00146  26      DBCK(9)=-DBCK(8)
 00147  27      DEL=DEL+3.141593/24.
 00148  28      DBCK(10)=COS(DEL-DRIDEV)
 00149  29      DBCK(11)=COS(DEL+DRIDEV)
 00150  30      DBCK(12)=SIN(DEL)
 00151  31      DBCK(13)=-DBCK(12)
 00152  32      DEL=6.283185/24.
 00153  33      DBCK(14)=COS(DEL-DRIDEV)
 00154  34      DBCK(15)=COS(DEL+DRIDEV)
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  2
0CARD TARGET
  NO  STM.NO
 
 00155  35      DBCK(16)=SIN(DEL)
 00156  36      DBCK(17)=-DBCK(16)
 00157  37      DEL=DEL+3.141593/48.
 00158  38      DBCK(18)=COS(DEL-DRIDEV)
 00159  39      DBCK(19)=COS(DEL+DRIDEV)
 00160  40      DBCK(20)=SIN(DEL)
 00161  41      DBCK(21)=-DBCK(20)
 00162  42      DBCK(22)=TAN(3.141593/12.+3.141593/48.)
 00164  43      FOR KRING=1,3                                                      INITIALIZE DHALF AND HMCH ARRAYS
 00165  44         DEL=3.141593/NCELL(KRING)
 00166  45         TANDEL(KRING)=TAN(DEL*2.)
 00167  46         FOR IW=1,16
 00168  47            DSMX=DSMAX(IW,KRING,1)
 00169  48            IF(KRING.EQ.3) DSMSP=DSMAX(IW,2,1)
 00170  50            ALSIN=-DRISIN
 00171  51            AL=-DRIDEV
 00172  52            PERFORM INIT
 00173  55            HMCH(IW,KRING,1)=IK
 00174  56            DHALF(IW,KRING,1)=DT
 00175  57            DTWICE(IW,KRING,1)=DTW
 00176  58            DSMX=DSMAX(IW,KRING,2)
 00177  59            IF(KRING.EQ.3) DSMSP=DSMAX(IW,2,2)
 00178  61            ALSIN=DRISIN
 00179  62            AL=DRIDEV
 00180  63            PERFORM INIT
 00181  66            HMCH(IW,KRING,2)=IK
 00182  67            DHALF(IW,KRING,2)=DT
 00183  68            DTWICE(IW,KRING,2)=DTW
 00184  69         CFOR
 00185  71      CFOR
 00186  73      RETURN
 00187    C
 00188    C *********************
 00189    C
 00190  74      PROC INIT
 00191    C
 00192    C     THIS PROC CALCULATES QUANTITIES FOR HMCH AND DHALF ARRAYS
 00193    C     DHALF ARRAY CONTAINS 'HALF' THE MAX DRIFT DISTANCE FOR EACH WIRE
 00194    C     AND IS USED IN MATCHING TRACKS FROM RING 3 TO RING 2.
 00195    C     HMCH ARRAY CONTAINS THE WIRE NO. WHICH WILL FIRE IN THE
 00196    C     NEIGHBOURING CELL IF THE TRACK GOES THROUGH THE CELL
 00197    C     SIDEWALL.
 00198    C     THE CONVENTION IS THAT 1 IS LEFT AND 2 IS RIGHT.
 00199    C
 00200  75         W=FSENSW(KRING)+FLOAT(IW-1)*RINCR(KRING)
 00201  76         X=SQRT(W**2+DSMX**2-2.*W*DSMX*ALSIN)
 00202  77         DTW=1.-TAN(DEL)*TAN(DEL-AL)
 00203  78         DTW=2.*DSMX/DTW
 00204  79         IF KRING.EQ.2
 00205  80         THEN
 00206  83            DTW=1.-TAN(DEL*.5)*TAN(DEL-AL)
 00207  84            DTW=DSMX*(1.+TAN(DEL*.5)/TAN(DEL))/DTW
 00208  85         CIF
 00209  86         IF KRING.EQ.3
 00210  87         THEN
 00211  90            DTW=1.-TAN(DEL*1.5)*TAN(DEL-AL)
 00212  91            DTW=DSMSP*(1.+TAN(DEL*1.5)/TAN(DEL))/DTW
 00213  92         CIF
 00214  93         DT=TAN(DEL*0.5)*TAN(DEL*0.5-AL)
 00216  94         DT=DSMX*0.5*(1.-DT)                                             DT IS DHALF
 00218  95         IF X.LT.GB(KRING)                                               NOW CALCULATE MCH ARRAY
 00219  96         THEN
 00220  99            IK=-5
 00221 100            E=X*COS(AL+DEL)/DRICOS
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  3
0CARD TARGET
  NO  STM.NO
 
 00222 101            E=E-FSENSW(KRING)
 00223 102            IF(E.GE.-5.) IK=(E+5.)/RINCR(KRING)
 00224 104            IF(IK.GT.15) IK=20
 00225 106         ELSE
 00226 108            IK=20
 00227 109         CIF
 00228 110      CPROC
 00229 112      END
0END OF SEGMENT
0  OPTIONS IN EFFECT - LINECOUNT=64,LINEWIDTH=131,  SOURCE,  FORTRAN  NUMBERING
0   0 ERRORS           0 WARNINGS         111 TARGET STATEMENTS
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  1
0CARD TARGET
  NO  STM.NO
 
0END OF PROGRAM
0  OPTIONS IN EFFECT - LINECOUNT=64,LINEWIDTH=131,  SOURCE,  FORTRAN  NUMBERING
0   0 ERRORS           0 WARNINGS         203 TARGET STATEMENTS
 00000    C   06/02/81 308301443  MEMBER NAME  KNTREL   (PATRECSR)    SHELTRAN
 00100   2      SUBROUTINE KNTREL(HEARR,NUMTRK)
 00200    C
 00300    C     CALLS FITTING ROUTINES AND PATROL AND FILLS PATR AND JHTL BANKS
 00400    C     RESULTS OF XYFIT AND PATROL ARE USED TO CORRECT BACKTRACE ARRAYS
 00500    C
 00600    C     IMCERT=1  MEANS BACKTR ARRAYS ARE NOT CORRECTED BY THE RESULTS
 00700    C               OF XYFIT AND PATROL
 00800    C
 00900    C     IMCERT=0   MEANS 'FULL' EDITING WITH TRACK ELS ALSO
 01000    C                BEING DELETED
 01100   3      IMPLICIT INTEGER*2 (H)
 01200   4      COMMON/CHEADR/HEAD(17),HRUN,HEV
 01300   5      COMMON/CADMIN/IEVTP,NREC,NRWRIT,NRERR
 01400   6      COMMON/CBKPAT/HTRK(100)
          C----------------------------------------------------------------------
          C             MACRO CDATA .... BOS COMMON.
          C
          C             THIS MACRO ONLY DEFINES THE IDATA/HDATA/ADATA NAMES.
          C             THE ACTUAL SIZE OF /BCS/ IS FIXED ON MACRO CBCSMX
          C             OR BY OTHER MEANS. A DEFAULT SIZE OF 40000 IS GIVEN HERE.
          C
          C----------------------------------------------------------------------
          C
         7      COMMON /BCS/ IDATA(40000)
         8      DIMENSION HDATA(80000),ADATA(40000),IPNT(50)
         9      EQUIVALENCE (HDATA(1),IDATA(1),ADATA(1)),(IPNT(1),IDATA(55))
        10      EQUIVALENCE (NWORD,IPNT(50))
          C
          C------------------------ END OF MACRO CDATA --------------------------
          C----------------------------------------------------------------------
          C           MACRO CCYCP .... JET CHAMBER HIT POINTERS (PATREC)
          C----------------------------------------------------------------------
        11      INTEGER*4 HPTSEC
        12      COMMON/CCYCP/HPTSEC(98)
 00016    C     HPTSEC(I) = CDATA POINTER TO 1ST I*2 WORD FOR 1ST HIT OF CELL I
          C------------------------ END OF MACRO CCYCP --------------------------
          C----------------------------------------------
          C  MACRO CWORKPR .... PATTERN RECOGNITION CWORK
          C----------------------------------------------
        13      COMMON /CWORK/ HPLAST,HPFREE,HPWRK(30),ADWRK(600),
               ,               HPRO,HNTR,HNTCEL(98),IPCL(200),NRHT(200),
               ,               NWR1(200),DS1(200),SL1(200),
               ,               NWR2(200),DS2(200),SL2(200),
               ,               LBL(200),NTREL(200),ICRO(200),
               ,               NTR,HNREL(100),HISTR(9,100),HRES(168),
               ,               NTRLM,RLMTR(3,5),
               ,               WRK(7000)
        14      DIMENSION TRKAR(200,11),ITRKAR(200,11),
               ,                         LMRTR(3,5)
        15      EQUIVALENCE (IPCL(1),TRKAR(1,1),ITRKAR(1,1))
        16      EQUIVALENCE (LMRTR(1,1),RLMTR(1,1))
        17      DIMENSION IWRK(7000),HWRK(14000),IDWRK(600),HDWRK(1200)
        18      EQUIVALENCE (IWRK(1),WRK(1),HWRK(1))
        19      EQUIVALENCE (IDWRK(1),ADWRK(1),HDWRK(1))
          C---------- END OF MACRO CWORKPR --------------
 00100    C-------------------------------------------------------
 00200    C  MACRO CWORKEQ .... PATTERN RECOGNITION CWORK POINTERS
 00300    C-------------------------------------------------------
 00400  20      EQUIVALENCE
 00410    C                POINTERS FOR FXYZ HIT ARRAY .. PRIMARY L/R SOLUTION
 00500         #          (HPHT0,HPWRK( 1)),(HPHT9,HPWRK( 2)),(HLDHT,HPWRK( 3))
 00510    C                POINTERS FOR CWORK SINGLE TRACK PATR BANK
 00600         #         ,(HPTR0,HPWRK( 4)),(HPTR9,HPWRK( 5)),(HLDTR,HPWRK( 6))
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  2
0CARD TARGET
  NO  STM.NO
 
 00610    C                POINTERS FOR TRACK ELEMENT HIT LABEL ARRAY
 00700         #         ,(HPHL0,HPWRK( 7)),(HPHL9,HPWRK( 8)),(HLDHL,HPWRK( 9))
 00710    C                POINTERS FOR FXYZ HIT ARRAY .. OPPOSITE L/R SOLUTION
 00800         #         ,(HPHT0A,HPWRK(10)),(HPHT9A,HPWRK(11)),(HLDHTA,HPWRK(12))
 00810    C               POINTER LIMIT ON FXYZ HIT ARRAY
 00900         #         ,(HPHTLM,HPWRK(13))
 00910    C               POINTERS FOR
 01000         #         ,(HPTE0,HPWRK(14)),(HPTE9,HPWRK(15)),(HLDTE,HPWRK(16))
 01100    C-------------- END OF MACRO CWORKEQ ------------------
 01900  21      EQUIVALENCE (ICELL ,IDWRK(1)),(NHIT  ,IDWRK(2))
 02000  22      DIMENSION HEARR(1)
          C----------------------------------------------
          C  MACRO CPATLM .... PATTERN RECOGNITION LIMITS
          C----------------------------------------------
        23      COMMON /CPATLM/ PATRLM(5),FLINLM(10),TRELLM(20),ZFITLM(10),BKK(20)
               *               ,XYF(20),IGFP(20),XBKK(40),IADMIN(5),YBKK(20)
        24      INTEGER IXYF(20),LMPATR(5),LMFLIN(10)
        25      INTEGER LMTREL(20),LMZFIT(10),IBKK(20)
        26      DIMENSION GFP(20),IXBKK(40),IYBKK(20)
        27      EQUIVALENCE (PATRLM(1),LMPATR(1)),(IXBKK(1),XBKK(1)),(IYBKK(1),
               *YBKK(1))   ,(FLINLM(1),LMFLIN(1)),(TRELLM(1),LMTREL(1))
               *           ,(ZFITLM(1),LMZFIT(1)),(BKK(1),IBKK(1))
               *           ,(XYF(1),IXYF(1)),(GFP(1),IGFP(1)),(IADMIN(1),IMCERT)
               *           ,(IYBKK(20),IPPASS),(IADMIN(2),IPFAST)
          C----------- END OF MACRO CPATLM --------------
 02200  28      EQUIVALENCE (IXBKK(40),IXITER),(IXBKK(39),MAXITR),(JJPR,IXBKK(38))
 02300  29      EQUIVALENCE (IXBKK(37),MINHIT),(IXBKK(36),ICUT)
 02400    C
 02500  30      INTEGER DATE(5), IDAY /0/
 02600    C
 02700  31      DIMENSION NCNT1(127),NCNT2(127),IXREF0(127)
 02800  32      DIMENSION JCLLA(20),NCLLA(20)
 02900    C
 03000    C2001 FORMAT(1H0,2I3,I8,2(I4,3F6.1,3F6.3),
 03100    C    ,     /,14X,I3,4E13.5,F6.2,I3,4E13.5,
 03200    C    ,     /,14X,I3,2F8.3,F6.1,I3,10X,6I3,8I6,2X,Z4)
 03300    C2002 FORMAT(1H0,40I3,/,1X,40I3,/,1X,40I3,/,1X,7I3)
 03400    C2003 FORMAT(1H0,A4,3I6,2(/,1X,24I4),/,1X,50I2,
 03500    C    ,       90(/,1X,2I6,I3,2F10.3,I3,2F10.3,1X,Z4,2I3))
 03600    C2004 FORMAT(1H0,'BACKTR:',5X,20I6)
 03700    C2005 FORMAT(1H ,12X,20I6)
 03800    C2008 FORMAT(' JHTL-BANK:',2I6,/,(12X,20(2X,Z4)))
 03900    C
 04000    C
 04100    C
 04200    C        MINHIT IS THE MINIMUM NO OF UNUSED HITS
 04300    C        LEFT ON A TRACKEL FOR IT TO BE BROUGHT
 04400    C        BACK AT THE END AS AS A SEPARATE TRACK
 04500    C
 04600    C     ICUT IS THE MAX NO OF HITS LEFT UNCORRELATED
 04700    C     BY PATROL BEFORE THE TRACKEL IS ASSIGNED TO THE TRACK
 04800    C
 04900  33      DATA MSKTR1/Z7F/
 05000  34      DATA MSKDSP/Z2000/
 05100  35      DATA MAXTRK/100/
 05200  36      DATA MKBDHT /Z600/
 05300    C
 05400  37 458  FORMAT(' ',20(X,Z4))
 05500  38 675  FORMAT('  ***** HIT LABEL MAY BE ZEROED **********')
 05600  39 754            FORMAT('  HPFREE , HPLAST ',2I10)
 05700  40 97           FORMAT(1X,30('+'),' KNTREL ERROR',I2,4I7)
 05800  41 674  FORMAT('  **** NOT ENOUGH SPACE IN CWORK TO MOVE HIT LABEL *******
 05900         $ , HPFREE, HPLAST , NO OF WORDS ',3I7)
 06000    C
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  3
0CARD TARGET
  NO  STM.NO
 
 06200  42      IF IDAY.EQ.0                                                       INITIALISE DATE + POINTER
 06300  43      THEN
 06400  46         CALL DAY2(DATE)
 06500  47         IDAY = DATE(1)*1000 + DATE(2)
 06600  48         IQJHTL = IBLN('JHTL')
 06700  49         IQPATR = IBLN('PATR')
 06800  50      CIF
 06900    C
 07000    C     CALL PRPATR
 07200  51      IPJHTL = IDATA(IQJHTL)                                             POINTER TO 'JHTL'-BANK
 07400  52      NHITT = (HPTSEC(97) - HPTSEC(1)) / 4                               NUMBER OF HITS
 07600  53      IPPATR = IDATA(IQPATR)                                             POINTER TO 'PATR'-BANK
 07800  54      NTR0  = IDATA(IPPATR+2)                                            CURRENT NUMBER OF TRACKS
 07900  55      ITRBK = NTR0
 08100  56      LTRBK = IDATA(IPPATR+3)                                            LENGTH OF TRACK BANK
 08300  57      IPTRBK = IPPATR + IDATA(IPPATR+1) + ITRBK*LTRBK                    POINTER TO NEXT TRACK BANK - 1
 08500  58      HPFRE0 = HPFREE                                                    MEMORIZE 1. FREE LOC. IN CWORK
 08600    C
 08800  59      CALL SETSL(IXREF0(1),0,508,0)                                      ZERO XREF: TRACK#(PATR) - TRACK#(BACKTR)
 08900    C
 09000  60      IF NTR.GT.0 .AND. NUMTRK.GT.0
 09100  61      THEN
 09200    C
 09400    C       I9 = HNTR                                                        PRINTOUT
 09500    C       PRINT 2003, HPRO,HNTR,NTR,NUMTRK,
 09600    C    ,              HNTCEL, ((TRKAR(I1,I2),I2=1,11),I1=1,I9)
 09700    C
 09800    C       I0 = HPHL0
 09900    C       I9 = HPHL9
 10000    C       PRINT 2008, I0,I9,(HWRK(I1),I1=I0,I9)
 10100    C
 10200    C         PRINT 2004,NTR, (HNREL(I1),I1=1,NTR)
 10300    C         FOR ITR=1,NTR
 10400    C           NELM = HNREL(ITR)
 10500    C           PRINT 2005, (HISTR(I1,ITR),I1=1,NELM)
 10600    C         CFOR
 10700    C
 10900  64         LBEVTR = 0                                                      LOOP OVER ALL TRACKS AND FIT
 11000  65         IEDTK  = 0
 11100  66         ITR    = 0
 11200  67         MAXTR0 = MIN0(MAXTRK,NUMTRK)
 11300  68         WHILE IEDTK.LT.MAXTR0
 11500  70            IEDTK=IEDTK+1                                                COUNTER FOR HEARR
 11600    C
 11800  74            ITR=HEARR(IEDTK)                                             EXTRACT TRACK NO
 11900    C
 12100  75            IF(ITRBK.GT.MAXTRK .OR. ITR.GT.MAXTRK) XWHILE                TRACK ARRAY SATURATED ?
 12200    C
 12300  77            IF HNREL(ITR).GT.0
 12400  78            THEN
 12500  81               HPFREE = HPFRE0
 12600  82               CALL FXYZ(ITR)
 12700  83               NHIT = (HPHT9-HPHT0+1) / HLDHT
 12900  84               IF NHIT.GT.3                                              MORE THAN THREE HITS
 13000  85               THEN
 13200  88                  HPTR0 = HPFREE                                         POINTER TO RESULTS OF TRACK FITS
 13300  89                  HPTR9 = HPTR0 + 49
 13400  90                  HLDTR = 50
 13500  91                  HPFREE= HPTR9 + 1
 13600  92                  IF HPFREE.LE.HPLAST
 13700  93                  THEN
 13800  96                     IWRK(HPTR0+47)=0
 13900  97                     CALL XYFIT
 14000  98                     IF WRK(HPTR0+22).LT.GFP(2)
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  4
0CARD TARGET
  NO  STM.NO
 
 14100  99                     THEN
 14200    C
 14400 102                        RMIN = 150.                                      SET RADIUS LIMITS FOR PATROL
 14500 103                        RMAX = 850.
 14600 104                        IF NTRLM.GT.0
 14700 105                        THEN
 14800 108                           FOR I=1,NTRLM
 14900 109                              IF LMRTR(1,I).EQ.ITR
 15000 110                              THEN
 15100 113                                 RMIN = RLMTR(2,I)
 15200 114                                 RMAX = RLMTR(3,I)
 15300 115                                 XFOR
 15400 116                              CIF
 15500 117                           CFOR
 15600 119                        CIF
 15700 120                        CALL PATROL(RMIN,RMAX)
 15800 121                     CIF
 15900    C
 16000 122                     RMSFIT = WRK(HPTR0+22)
 16100 123                     IF RMSFIT.GE.1000. .OR.
 16200         ?                  IWRK(HPTR0+23).LT.5 .AND. IMCERT.EQ.0
 16300 124                     THEN
 16400 127                        HNREL(ITR) = 0
 16500 128                     ELSE
 16600 130                        NHGDZ = 0
 16700 131                        IDHTLB=IPJHTL*2-HPHL0+3
 16800 132                        FOR IIP=HPHT0,HPHT9,HLDHT
 16900 133                           IPHTLB=IWRK(IIP+2)
 17000 134                           IPHTL=HDATA(IPHTLB+IDHTLB)
 17100 135                           IF(LAND(IPHTL,MKBDHT).EQ.0.AND.IPHTL.NE.0) IWRK(IIP+7)=8
 17200 137                           IF(IWRK(IIP+7).LT.8) NHGDZ = NHGDZ + 1
 17300 139                        CFOR
 17400    C
 17600 141                        IF NHGDZ.LT.3                                    CHECK IF <3 GOOD Z-HITS
 17700 142                        THEN
 17800 145                           HNREL(ITR) = 0
 17900 146                        ELSE
 18100 148                           CALL ZRFIT                                    >2 GOOD Z-HITS
 18200    C
 18400 149                           CRV  = ABS(WRK(HPTR0+24))                     DELETE BACKGROUND TRACK
 18500 150                           ZINT = ABS(WRK(HPTR0+30))
 18600 151                           IF IYBKK(14).NE.0 .AND. CRV.GT.YBKK(12) .AND.
 18700         ?                        ZINT.GT.YBKK(15)
 18800 152                           THEN
 18900 155                              KP=HPTR0
 19000 156                              CSTH=WRK(KP+4)*WRK(KP+7)+WRK(KP+5)*WRK(KP+8)
 19100
 19200 157                              CSTH=CSTH/SQRT((WRK(KP+4)**2+WRK(KP+5)**2)*
 19300         *                        (WRK(KP+7)**2+WRK(KP+8)**2))
 19400 158                              IF(CSTH.LT.YBKK(13)) HNREL(ITR) = 0
 19500 160                           CIF
 19600    C
 19700 161                           IF HNREL(ITR).GT.0
 19800 162                           THEN
 19900    C
 20100 165                              ITRBK = ITRBK + 1                          INCREASE TRACK BANK # + ANALYSE TRACK
 20200 166                              IXREF0(ITRBK) = ITR
 20300 167                              PERFORM TRKBNK
 20400    C
 20600 170                              IF NHTREG.LT.5                             DELETE TRACK IF <5 HITS REGISTERED
 20700 171                              THEN
 20800 174                                 ITRBK  = ITRBK  - 1
 20900 175                                 IPTRBK = IPTRBK - LTRBK
 21000 176                              CIF
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  5
0CARD TARGET
  NO  STM.NO
 
 21100 177                           CIF
 21200    C
 21300 178                        CIF
 21400 179                     CIF
 21500 180                  ELSE
 21600    C               KERROR 2 .. NOT ENOUGH SPACE IN CWORK
 21700 182                     KERROR = 2
 21800 183                     PRINT97,KERROR,NREC,HRUN,HEV,ITR
 21900 184                     PRINT 754,HPFREE,HPLAST
 22000 185                     XWHILE
 22100 186                  CIF
 22200 187               ELSE
 22300    C             KERROR 1 .. NOT ENOUGH HITS ON TRACK
 22400 189                  KERROR = 1
 22500 190                  PRINT97,KERROR,NREC,HRUN,HEV,ITR
 22600 191                  HNREL(ITR)=0
 22700 192               CIF
 22800 193            CIF
 22900 194         CWHILE
 23000    C
 23100 196         HPFREE=HPFRE0
 23200 197      CIF
 23300    C
 23500 198      NDIFF = IPTRBK - IPPATR - IDATA(IPPATR)                            READJUST RECORD LENGTH + # OF TRACKS
 23600 199      CALL BCHM(IPPATR,NDIFF,IRET)
 23700 200      IDATA(IPPATR+2) = ITRBK
 23800    C
 24000 201      IF IMCERT.EQ.0 .AND. ITRBK.GT.0                                    ELIMINATE BAD + COVERED TRACKS IF IMCERT = 0
 24100 202      THEN
 24200    C
 24400    C       I0 = IPJHTL*2 + 1                                                COUNT CORRELATED + UNCORRELATED HITS
 24500    C       I9 = (IDATA(IPJHTL)+IPJHTL)*2
 24600    C       PRINT 2008, I0,I9,(HDATA(I1),I1=I0,I9)
 24700 205         PERFORM CNTHIT
 24800    C       PRINT 2008, I0,I9,(HDATA(I1),I1=I0,I9)
 24900    C
 25000 208         IDATA(IPPATR+4)=LBEVTR
 25100 209         IDATA(IPPATR+ 6) = NHITUC
 25200 210      CIF
 25300    C
 25500 211      ITR = 0                                                            ELIMINATE TRACKS WITH 0 TRELS
 25600 212      WHILE ITR.LT.NTR
 25700 214         ITR = ITR + 1
 25800 218         NELM = HNREL(ITR)
 25900 219         IF NELM.LE.0
 26000 220         THEN
 26100 223            NBYTE = (NTR-ITR)*2
 26200 224            NTR = NTR - 1
 26300 225            IF NBYTE.GT.0
 26400 226            THEN
 26500 229               CALL MVCL(HNREL(ITR),0,HNREL(ITR+1),0,NBYTE)
 26600 230               NBYTE = NBYTE * 9
 26700 231               CALL MVCL(HISTR(1,ITR),0,HISTR(1,ITR+1),0,NBYTE)
 26800 232            CIF
 26900 233            ITR = ITR - 1
 27000 234         CIF
 27100 235      CWHILE
 27200    C
 27300    C
 27400 237      RETURN
 27500    C
 27600    C
 27700                                                                             ***************************
 27800                                                                             *      T R K B N K        *
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  6
0CARD TARGET
  NO  STM.NO
 
 28000    C                                                                        ***************************
 28200 238      PROC TRKBNK                                                        SET TRACK BANK IN /CDATA/
 28300    C
 28400 239         JP     = HPTR0
 28500 240         LBTRCK = 0
 28600    C
 28700 241         IR1=0
 28800 242         IR2=0
 28900 243         IR3=0
 29000 244         NTRKEL=HNREL(ITR)
 29100 245         FOR ITN=1,NTRKEL
 29200 246            ITH=HISTR(ITN,ITR)
 29300 247            ITH=IABS(ITH)
 29400 248            IF(LAND(LBL(ITH),MSKDSP).NE.0)LBTRCK=LOR(LBTRCK,2048)
 29500 250            ITH=IPCL(ITH)
 29600 251            IF ITH.LE.24
 29700 252            THEN
 29800 255               IR1=1
 29900 256            ELSE
 30000 258               IF ITH.GT.48
 30100 259               THEN
 30200 262                  IR3=1
 30300 263               ELSE
 30400 265                  IR2=1
 30500 266               CIF
 30600 267            CIF
 30700 268         CFOR
 30800 270         IF(IR1.EQ.0)LBTRCK=LOR(LBTRCK,512)
 30900 272         IF(IR1.NE.0.AND.IR3.NE.0.AND.IR2.EQ.0) LBTRCK=LOR(LBTRCK,1024)
 31000 274         IF(CRV.GT..002) LBTRCK=LOR(LBTRCK,64)
 31100    C
 31200    C     I0 = JP
 31300    C     I9 = JP+47
 31400    C     PRINT 2001,(WRK(I1),I1=I0,I9)
 31500 276         TGTH       = WRK(JP+29)
 31600 277         Z0         = WRK(JP+30)
 31700 278         CSTH       = 1. / SQRT(TGTH**2+1.)
 31800 279         SNTH       = CSTH * TGTH
 31900 280         WRK(JP+ 6) = WRK(JP+ 6)*TGTH + Z0
 32000 281         WRK(JP+13) = WRK(JP+13)*TGTH + Z0
 32100 282         WRK(JP+ 7) = WRK(JP+ 7) * CSTH
 32200 283         WRK(JP+ 8) = WRK(JP+ 8) * CSTH
 32300 284         WRK(JP+ 9) = SNTH
 32400 285         WRK(JP+14) = WRK(JP+14) * CSTH
 32500 286         WRK(JP+15) = WRK(JP+15) * CSTH
 32600 287         WRK(JP+16) = SNTH
 32700 288         LBEVTR=LOR(LBEVTR,LBTRCK)
 32800    C     PRINT 2001,(WRK(I1),I1=I0,I9)
 32900    C
 33100 289         HTRK(ITR)=ITRBK                                                 INCREASE TRACK BANK COUNTER
 33200 290         IP0 = IPTRBK + 1
 33300 291         IP9 = IPTRBK + LTRBK
 33400 292         FOR IP = IP0,IP9
 33500 293            IDATA(IP) = 0
 33600 294         CFOR
 33700 296         IDATA(IPTRBK+ 1) = ITRBK
 33800 297         IDATA(IPTRBK+ 2) = IPFAST+1
 33900 298         IDATA(IPTRBK+ 3) = IDAY
 34000    C
 34200 299         IP1 = HPTR0+3                                                   RESULTS FROM X-Y-FIT + ZRFIT
 34300 300         IP9 = IP1+29
 34400 301         JP  = IPTRBK + 3
 34500 302         FOR IP=IP1,IP9
 34600 303            JP = JP + 1
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  7
0CARD TARGET
  NO  STM.NO
 
 34700 304            IDATA(JP) = IWRK(IP)
 34800 305         CFOR
 34900 307         IDATA(IPTRBK+47)=IWRK(HPTR0+46)
 35000 308         IDATA(IPTRBK+48)=LBTRCK
 35100    C
 35300 309         NPCLL  = 0                                                      POINTER TO FIRST CELL -1
 35500 310         ICELL0 = -1                                                     INITIALIZE CELL #
 35700 311         NHTREG = 0                                                      COUNTER OF REGISTERED HITS
 35800    C
 35900                                                                             SET HIT LABELS
 36100 312         IDHTLB = IPJHTL*2-HPHL0+3                                       LOOP OVER ALL HITS
 36200 313         IP     = HPHT0
 36300 314         REPEAT
 36500 315            IF IWRK(IP+10).GE.0 .AND. IWRK(IP+10).LE.2                   SELECT ONLY ACCEPTED HITS
 36600 316            THEN
 36800 319               LBBDHT = IWRK(IP+10)                                      UPPER BITS
 36900 320               LBBDHT=LAND(LBBDHT,3)
 37000 321               LBBDHT = SHFTL(LBBDHT,9)
 37200 322               IPHTLB = IWRK(IP+ 2)                                      POINTER TO HIT LABEL IN CWORK
 37400 323               LBHIT0 = HWRK(IPHTLB)                                     ORIGINAL HIT LABEL
 37500 324               LBHIT1 = HWRK(IPHTLB+1)
 37700 325               ITREL = IABS(IWRK(IP+ 8))                                 TKEL NO
 37900 326               JTREL = NTREL(ITREL)*2                                    TKEL NO WITHIN RING
 38000                                                                             TRACK NO
 38200 327               LBHIT = ITRBK*2                                           SET TRACK #
 38400 328               IF(IWRK(IP+8).GT.0) LBHIT = LOR(LBHIT,256)                SET L/R BIT
 38600 330               IPHTL1 = IPHTLB + IDHTLB                                  FETCH HIT LABEL OF TRACK
 38700 331               IPHTL2 = IPHTLB + IDHTLB +1
 38900 332               LBHIT1 = HDATA(IPHTL1)                                    HIT LABEL IN CDATA
 39000 333               LBHIT2 = HDATA(IPHTL1+1)
 39100 334               RES=WRK(IP+13)
 39200 335               RES=ABS(RES)/.2
 39300 336               IRES=IFIX(RES)
 39400 337               IF(IRES.GT.31) IRES=31
 39500 339               IRES=SHFTL(IRES,11)
 39600 340               LBHIT=LBHIT+IRES
 39800 341               LBREG = 0                                                 LABEL FOR REGISTERED HIT
 39900    C
 40000 342               IF LAND(MSKTR1,SHFTR(LBHIT1,1)).NE.ITRBK
 40100         ý            .OR.LAND(LBHIT1,MKBDHT).NE.0
 40200 343               THEN
 40300 346                  IF LAND(LBHIT1,MKBDHT).NE.0
 40400 347                  THEN
 40600 350                     IF LBBDHT.EQ.0                                      PRIOR HIT IS BAD(XYFIT)
 40700 351                     THEN
 40900 354                        LBREG = 1                                        THIS HIT IS GOOD
 41000 355                        LBHIT1 = LBHIT
 41200 356                        IF(IWRK(IP+7).EQ.0) LBHIT1 = LOR(LBHIT1,1)       SET BIT FOR GOOD  Z-COORDINATE
 41300 358                     ELSE
 41500 360                        ITLND=LAND(LBHIT1,MKBDHT)                        NEW HIT IS ALSO BAD
 41600 361                        IF LBBDHT.LT.ITLND
 41700 362                        THEN
 41800 365                           LBHIT1 = LOR(LBHIT,LBBDHT)
 41900 366                           LBREG = 1
 42100 367                           IF(IWRK(IP+7).EQ.0) LBHIT1 = LOR(LBHIT1,1)    SET BIT FOR GOOD  Z-COORDINATE
 42200 369                        CIF
 42300 370                     CIF
 42400 371                  ELSE
 42600 373                     IF LBHIT1.EQ.0                                      NO BAD PRIOR HIT
 42800 374                     THEN                                                FIRST TRACK FOR THIS HIT NOW
 42900 377                        LBHIT1 = LOR(LBHIT,LBBDHT)
 43000 378                        LBREG = 1
 43200 379                        IF(IWRK(IP+7).EQ.0) LBHIT1 = LOR(LBHIT1,1)       SET BIT FOR GOOD  Z-COORDINATE
 43400 381                     ELSE                                                SECOND TRACK FOR THIS HIT NOW
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  8
0CARD TARGET
  NO  STM.NO
 
 43500 383                        IF LBBDHT.EQ.0 .AND. LBHIT2.EQ.0
 43600 384                        THEN
 43700 387                           LBHIT2 = LOR(LBHIT,LBBDHT)
 43800 388                           LBREG = 1
 44000 389                           IF(IWRK(IP+7).EQ.0) LBHIT2 = LOR(LBHIT2,1)    SET BIT FOR GOOD  Z-COORDINATE
 44100 391                        CIF
 44200 392                     CIF
 44300 393                  CIF
 44400 394                  HDATA(IPHTL1) = LBHIT1
 44500 395                  HDATA(IPHTL2) = LBHIT2
 44700 396                  NHTREG = NHTREG + 1                                    COUNT REGISTERED HIT
 44900 397                  ICELL = IWRK(IP+9)                                     CHECK IF NEW CELL
 45000 398                  IF LBREG.NE.0
 45100 399                  THEN
 45200 402                     IF ICELL.EQ.ICELL0
 45300 403                     THEN
 45400 406                        NCLLA(JPCLL) = NCLLA(JPCLL) + 1
 45500 407                     ELSE
 45600 409                        ICELL0 = ICELL
 45700 410                        JPCLL = 0
 45800 411                        IF NPCLL.GT.1
 45900 412                        THEN
 46000 415                           FOR I1=1,NPCLL
 46100 416                              IF(ICELL.EQ.JCLLA(I1)) JPCLL = I1
 46200 418                           CFOR
 46300 420                        CIF
 46400 421                        IF JPCLL.EQ.0
 46500 422                        THEN
 46600 425                           NPCLL        = NPCLL + 1
 46700 426                           JPCLL        = NPCLL
 46800 427                           JCLLA(JPCLL) = ICELL
 46900 428                           NCLLA(JPCLL) = 1
 47000 429                        ELSE
 47100 431                           NCLLA(JPCLL) = NCLLA(JPCLL) + 1
 47200 432                        CIF
 47300 433                     CIF
 47400 434                  CIF
 47500 435               CIF
 47600 436            CIF
 47700 437            IP = IP + HLDHT
 47800 438         UNTIL IP.GT.HPHT9
 47900    C
 48100 439         WHILE NPCLL.GT.6                                                REDUCE # OF CELLS TO 6
 48200 444            NHTMIN = 99999
 48300 448            FOR I1=1,NPCLL
 48400 449               IF NCLLA(I1).LT.NHTMIN
 48500 450               THEN
 48600 453                  NHTMIN = NCLLA(I1)
 48700 454                  JPCLL = I1
 48800 455               CIF
 48900 456            CFOR
 49000 458            JCLLA(JPCLL) = JCLLA(NPCLL)
 49100 459            NCLLA(JPCLL) = NCLLA(NPCLL)
 49200 460            NPCLL = NPCLL - 1
 49300 461         CWHILE
 49400    C
 49600 463         IPCLL  = IPTRBK + 33                                            STORE CELLS IN TRACK BANK
 49700 464         FOR I1 = 1,NPCLL
 49800 465            IPCLL  = IPCLL + 1
 49900 466            IDATA(IPCLL) = JCLLA(I1)
 50000 467         CFOR
 50100    C
 50300 469         IPTRBK = IPTRBK + LTRBK                                         INCREASE POINTER TO TRACK BANK
 50400    C
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  9
0CARD TARGET
  NO  STM.NO
 
 50500 470      CPROC
 50600    C
 50700    C
 50800                                                                             ***************************
 50900                                                                             *      C N T H I T        *
 51100    C                                                                        ***************************
 51300 472      PROC CNTHIT                                                        COUNT CORRELATED + UNCORRELATED HITS
 51400    C
 51500    C
 51700 473         NTR1  = ITRBK                                                   NO CHECK IF NO TRACKS
 51800 474         LPATR = IDATA(IPPATR)
 51900    C
 52000 475         IPHL0 = IPJHTL*2 + 3
 52100 476         ILDHL = IDATA(IPJHTL)*2 - 2
 52200 477         IPHL9 = ILDHL + IPHL0 - 1
 52300    C
 52500 478         CALL SETSL(NCNT1(1),0,1016,0)                                   COUNT HITS OF TRACK
 52600 479         NHITUC = 0
 52700 480         FOR I=IPHL0,IPHL9,2
 52800 481            IZW1  = HDATA(I  )
 52900 482            ITRK1 = LAND(SHFTR(IZW1,1),127)
 53000 483            IF ITRK1.GT.0
 53100 484            THEN
 53200 487               IZW2  = HDATA(I+1)
 53300 488               ITRK2 = LAND(SHFTR(IZW2,1),127)
 53400 489               IF ITRK2.LE.0
 53500 490               THEN
 53600 493                  NCNT1(ITRK1) = NCNT1(ITRK1) + 1
 53700 494               ELSE
 53800 496                  NCNT2(ITRK1) = NCNT2(ITRK1) + 1
 53900 497                  NCNT2(ITRK2) = NCNT2(ITRK2) + 1
 54000 498               CIF
 54100 499            ELSE
 54200 501               NHITUC = NHITUC + 1
 54300 502            CIF
 54400 503         CFOR
 54500    C
 54700    C     PRINT 2002, NCNT1,NCNT2,IXREF0                                     ELIMINATE COVERED OR TOO SHORT TRACKS
 54800    C     CALL PRPATR
 54900 505         MTR = 0
 55000 506         LTRBK = IDATA(IPPATR+3)
 55100 507         IPTR0 = IPPATR + IDATA(IPPATR+1)
 55200 508         IPTR9 = (NTR1-1)*LTRBK + IPTR0
 55300 509         FOR ITR=1,NTR1
 55400 510            IF NCNT1(ITR).GE.5 .AND. NCNT1(ITR)+NCNT2(ITR).LT.LMPATR(1)
 55500 511            THEN
 55700 514               IPTR1 = 0                                                 CHECK IF TRACKS LEAVES IN Z DIRECT.
 55800 515               JTR = MTR + 1
 55900 516               FOR IP=IPTR0,IPTR9,LTRBK
 56000 517                  IF IDATA(IP+1).EQ.JTR
 56100 518                  THEN
 56200 521                     IPTR1 = IP
 56300 522                     XFOR
 56400 523                  CIF
 56500 524               CFOR
 56600 526               IF(IPTR1.NE.0 .AND.ABS(ADATA(IPTR1+14)).LT.1000.)NCNT1(ITR)=1
 56700 528            CIF
 56800 529            IF NCNT1(ITR).LT.5
 56900 530            THEN
 57000 533               PERFORM ELIMTR
 57100 536               NCNT1(ITR) =-NCNT1(ITR)
 57200 537               JTR = IXREF0(ITR)
 57300 538               HNREL(JTR) = 0
 57400    C     PRINT 2002, NCNT1,NCNT2
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE 10
0CARD TARGET
  NO  STM.NO
 
 57500 539            ELSE
 57700 541               MTR = MTR + 1                                             COUNT REMAINING TRACKS
 57800 542            CIF
 57900 543         CFOR
 58000    C
 58100    C
 58200 545         IDATA(IPPATR+2) = MTR
 58300    C     PRINT 2002, NCNT1,NCNT2,MTR
 58400    C
 58600 546         LENG  = IDATA(IPPATR+2)*IDATA(IPPATR+3) + IDATA(IPPATR+1)       READJUST RECORD LENGTH + # OF TRACKS
 58700 547         NDIFF = LENG - IDATA(IPPATR)
 58800 548         IF(NDIFF.NE.0) CALL BCHM(IPPATR,NDIFF,IRET)
 58900    C
 59000 550      CPROC
 59100    C
 59200    C
 59300                                                                             ***************************
 59400                                                                             *      E L I M T R        *
 59600    C                                                                        ***************************
 59800 552      PROC ELIMTR                                                        ELIMINATE TRACK ITR
 59900    C
 60100 553         JTR = MTR + 1                                                   LOOP OVER HIT LABEL ARRAY
 60200 554         ITRDIF = ITR - JTR
 60300 555         FOR I=IPHL0,IPHL9,2
 60400 556            IZW1  = HDATA(I  )
 60500 557            ITRK1 = LAND(SHFTR(IZW1,1),127)
 60600 558            IZW2  = HDATA(I+1)
 60700 559            ITRK2 = LAND(SHFTR(IZW2,1),127)
 60800 560            IF ITRK2.EQ.JTR
 60900 561            THEN
 61000 564               HDATA(I+1) = 0
 61100 565               ITRK2 = 0
 61200 566               IND1  = ITRK1 + ITRDIF
 61300 567               NCNT1(IND1) = NCNT1(IND1) + 1
 61400 568               NCNT2(IND1) = NCNT2(IND1) - 1
 61500    C     DATA NPREL /0/
 61600    C     NPREL = NPREL + 1
 61700 569            CIF
 61800 570            IF ITRK1.EQ.JTR
 61900 571            THEN
 62000 574               HDATA(I ) = HDATA(I+1)
 62100 575               HDATA(I+1) = 0
 62200 576               ITRK1 = ITRK2
 62300 577               ITRK2 = 0
 62400 578               IF ITRK1.GT.0
 62500 579               THEN
 62600 582                  IND1  = ITRK1 + ITRDIF
 62700 583                  NCNT1(IND1) = NCNT1(IND1) + 1
 62800 584                  NCNT2(IND1) = NCNT2(IND1) - 1
 62900 585               CIF
 63000 586            CIF
 63100    C         DECREASE TRACK # FOR HIGHER TRACK #'S
 63200 587            IF(ITRK1.GT.JTR) HDATA(I  ) = HDATA(I  )-2
 63300 589            IF(ITRK2.GT.JTR) HDATA(I+1) = HDATA(I+1)-2
 63400 591         CFOR
 63500    C     PRINT 2002, NCNT1,NCNT2
 63600    C
 63800 593         FOR IP=IPTR0,IPTR9,LTRBK                                        ELIMINATE TRACK IN PATR-BANK
 63900 594            IF IDATA(IP+1).EQ.JTR
 64000 595            THEN
 64100 598               IPTR1 = IP
 64200 599               XFOR
 64300 600            CIF
 64400 601         CFOR
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE 11
0CARD TARGET
  NO  STM.NO
 
 64500    C
 64600 603         IF IPTR1.GT.0
 64700 604         THEN
 64800 607            IPTR2 = IPTR1 + LTRBK
 64900 608            NBYTE = (IPTR9 -IPTR2 + LTRBK) * 4
 65000 609            IPTR9 = IPTR9 - LTRBK
 65100 610            IF NBYTE.GT.0
 65200 611            THEN
 65300 614               CALL MVCL(IDATA(IPTR1+1),0,IDATA(IPTR2+1),0,NBYTE)
 65400 615               FOR IP=IPTR1,IPTR9,LTRBK
 65500 616                  IDATA(IP+1) = IDATA(IP+1) - 1
 65600 617               CFOR
 65700 619            CIF
 65800 620         CIF
 65900    C
 66000 621      CPROC
 66100    C
 66200 623      END
0END OF SEGMENT
0  OPTIONS IN EFFECT - LINECOUNT=64,LINEWIDTH=131,  SOURCE,  FORTRAN  NUMBERING
0   0 ERRORS           0 WARNINGS         622 TARGET STATEMENTS
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  1
0CARD TARGET
  NO  STM.NO
 
0END OF PROGRAM
0  OPTIONS IN EFFECT - LINECOUNT=64,LINEWIDTH=131,  SOURCE,  FORTRAN  NUMBERING
0   0 ERRORS           0 WARNINGS         622 TARGET STATEMENTS
 00000    C   16/01/80 102191159  MEMBER NAME  KOMPAT   (PATRECSR)    SHELTRAN
 00001   2      SUBROUTINE KOMPAT
 00002    C
 00003   3      IMPLICIT INTEGER*2 (H)
 00004    C
 00005    C
 00006    C     KOMPAT COMPARES TWO PATR BANKS
 00007    C
 00008    C     MONTE CARLO TRACKS ARE MATCHED ONE BY ONE TO
 00009    C     TRACKS IN THE MOST RECENT PATR BANK
 00010    C
 00011    C     EACH MONTE CARLO TRACK IS EXTRAPOLATED TO THE POINT OF
 00012    C     CLOSEST APPROACH TO THE 'REAL' TRACKS. AT THIS POINT
 00013    C     X,Y COORDINATES , DIRECTION COSINES (IN THE X,Y PLANE),
 00014    C     RAD OF CURVATURE , AND NUMBER OF HITS  ARE COMPARED.
 00015    C
 00016    C     THE NUMBER OF UNMATCHED MC TRACKS IS STORED IN IMCNMX
 00017    C      AND THE NUMBER OF UNMATCHED 'REAL' TRACKS IN IRLNMX.
 00018    C
 00019    C
 00020    C
 00021   4      COMMON /CWORK/ HMC(100),HRL(100)
          C----------------------------------------------------------------------
          C             MACRO CDATA .... BOS COMMON.
          C
          C             THIS MACRO ONLY DEFINES THE IDATA/HDATA/ADATA NAMES.
          C             THE ACTUAL SIZE OF /BCS/ IS FIXED ON MACRO CBCSMX
          C             OR BY OTHER MEANS. A DEFAULT SIZE OF 40000 IS GIVEN HERE.
          C
          C----------------------------------------------------------------------
          C
         5      COMMON /BCS/ IDATA(40000)
         6      DIMENSION HDATA(80000),ADATA(40000),IPNT(50)
         7      EQUIVALENCE (HDATA(1),IDATA(1),ADATA(1)),(IPNT(1),IDATA(55))
         8      EQUIVALENCE (NWORD,IPNT(50))
          C
          C------------------------ END OF MACRO CDATA --------------------------
 00023   9      COMMON /COMPAT/ RADLI1,RADLI2,NHTLI1,DHTLI2,DXLIM1,DYLIM1,
 00024         & DXLIM2,DYLIM2,DIRXL1,DIRYL1,DIRXL2,DIRYL2,IPRINT,CRVLOW,
 00025         & IMCNMX,IRLNMX
 00026  10      CALL SETSL(HMC(1),0,400,0)
 00027  11      IREAL=IBLN('PATR')
 00028  12      IREAL=IDATA(IREAL)
 00029  13      IF(IREAL.LE.0) WRITE(6,468)
 00030  15 468  FORMAT('  **** NO PATR BANK FROM PATTERN RECOGNITION')
 00031  16      IF(IREAL.LE.0) RETURN
 00032  18      CALL CLOC(IMC,'PATR',12)
 00033  19      IF(IMC.LE.0) WRITE(6,469)
 00034  21 469  FORMAT('  **** NO MONTE CARLO PATR BANK ')
 00035  22      IF(IMC.LE.0) RETURN
 00036  24      NUMMC=IDATA(IMC+2)
 00037  25      NUMRL=IDATA(IREAL+2)
 00038  26      LNGRL=IDATA(IREAL+3)
 00039  27      IPTRL=IDATA(IREAL+1)+IREAL+1
 00040  28      LNGMC=IDATA(IMC+3)
 00041  29      IPTMC=IDATA(IMC+1)+IMC+1
 00043  30      FOR JMC=1,NUMMC                                                    LOOP OVER MC TRACKS
 00044  31         IF HMC(JMC).GE.0
 00045  32         THEN
 00046  35            IF(IPRINT.GT.1) WRITE(6,382) JMC
 00047  37  382   FORMAT('0 MC TRACK NO',I5)
 00048  38            RAD=1./ADATA(IPTMC+18)
 00050  39            RMC=ADATA(IPTMC+19)+ABS(RAD)                                 RMC IS DISTANCE TO CENTER OF CURV
 00051  40            NHITMC=IDATA(IPTMC+23)
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  2
0CARD TARGET
  NO  STM.NO
 
 00052  41            CRVMC=ADATA(IPTMC+26)
 00053  42            THETA=ADATA(IPTMC+20)
 00054  43            XMCB=ADATA(IPTMC+4)
 00055  44            YMCB=ADATA(IPTMC+5)
 00056  45            ZMCP1=ADATA(IPTMC+29)
 00057  46            ZMCP2=ADATA(IPTMC+30)
 00059  47            XRMC=RMC*COS(THETA)                                          X,Y COORDINATES OF CENTER OF CURV
 00060  48            YRMC=RMC*SIN(THETA)
 00061  49            IF(IPRINT.GT.2) WRITE(6,298) RAD,RMC,XRMC,YRMC
 00062  51298   FORMAT('  RAD,RMC,XRMC,YRMC',4F10.3)
 00063  52            IPTRL=IDATA(IREAL+1)+IREAL+1
 00064  53            CHIOLD=9999.
 00066  54            FOR IRL=1,NUMRL                                              LOOP OVER PATREC TRACKS
 00067  55               IF HRL(IRL).GE.0
 00068  56               THEN
 00069  59                  IF(IPRINT.GT.2) WRITE(6,383) IRL
 00070  61 383   FORMAT('0 RL TRACK NO',I5)
 00071  62                  XRLB=ADATA(IPTRL+4)
 00072  63                  YRLB=ADATA(IPTRL+5)
 00073  64                  ZRLB=ADATA(IPTRL+6)
 00074  65                  NHITRL=IDATA(IPTRL+23)
 00075  66                  NHTDIF=IABS(NHITRL-NHITMC)
 00076  67                  NLIM1=NHTLI1
 00077  68                  NLIM2=IFIX(DHTLI2*NHITMC)
 00079  69                  IF ABS(CRVMC).GT..0015.AND.NHITMC.GT.30                REQUIREMENT ON MATCHING NUMBER OF HITS WILL
 00081  70                  THEN                                                   BE RELEASED FOR A LONG LOW MOM MC TRACK
 00082  73                     IF(IPRINT.GT.2)  WRITE(6,303) IRL
 00083  75303   FORMAT('   HIT RESTRICTION RELEASED,TRACK ',I10)
 00084  76                     NHTDIF=0
 00085  77                  CIF
 00087  78                  IF NHTDIF.LT.NLIM1.OR.NHTDIF.LT.NLIM2                  HIT DIFFERENCE SMALL ENOUGH ?
 00088  79                  THEN
 00090  82                     XD=XRLB-XRMC                                        VECTOR FROM CENTER OF CURV TO BEGINING OF REAL TRA
 00091  83                     YD=YRLB-YRMC
 00092  84                     DI=SQRT(YD**2+XD**2)
 00094  85                     XEXP=XRMC+XD*ABS(RAD)/DI                            XEXP,YEXP ARE COORDINATES OF THE POINT ON THE
 00096  86                     YEXP=YRMC+YD*ABS(RAD)/DI                            EXTRAPOLATED MC TRACK CLOSEST TO THE BEGINNING OF
 00098  87                     REXP=SQRT(XEXP**2+YEXP**2)                          REAL TRACK
 00099  88                     ZEXP=ZMCP1+REXP*ZMCP2
 00100  89                     IF(IPRINT.GT.2) WRITE(6,195) XEXP,YEXP,ZEXP,XRLB,YRLB,ZRLB
 00101  91 195  FORMAT(' XEXP,YEXP,ZEXP',6F10.3)
 00102  92                     DIFX=ABS(XEXP-XRLB)
 00103  93                     DIFY=ABS(YEXP-YRLB)
 00105  94                     ANEXP=XMCB*XEXP+YMCB*YEXP                           ANEXP IS UNORMALIZED ANGLE THROUGH WHICH EXTRAPOLA
 00107  95                     IF ANEXP.LT.0.                                      IS MADE
 00108  96                     THEN
 00109  99                        DIFX=999.
 00110 100                        DIFY=999.
 00111 101                        IF(IPRINT.GT.2) WRITE(6,775) IRL
 00112 103  775 FORMAT('  EXTRAPOLATION TOO FAR , TRACK ',I5)
 00113 104                     CIF
 00115 105                     DXLIM=DXLIM1+ADATA(IPTMC+18)*1000.*DXLIM2           LIMITS FOR MATCHING START POINT OF TRACKS
 00116 106                     DYLIM=DYLIM1+ADATA(IPTMC+18)*1000.*DYLIM2
 00117 107                     IF DIFX.LT.DXLIM.AND.DIFY.LT.DYLIM
 00118 108                     THEN
 00119 111                        IF(IPRNT.GT.1) WRITE(6,196) DIFX,DIFY,DXLIM,DYLIM
 00120 113 196  FORMAT('  DIFX,DIFY,DXLIM,DYLIM',4F10.5)
 00121 114                        IF(IPRNT.GT.1) WRITE(6,212) IRL
 00122 116 212  FORMAT('   SUCCESSFUL MATCH FOUND TO STARTING POIINT FOR TRACK',I5
 00123         &                  )
 00125 117                        XD=XD/DI                                         NORMALIZE THE VECTOR
 00126 118                        YD=YD/DI
 00128 119                        DXNEW=YD                                         DIR COSINES AT EXTRAPOLATED PT OF MC TRACK
 00130 120                        DYNEW=-XD                                        ARE PERP TO (XD,YD) VECTOR
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  3
0CARD TARGET
  NO  STM.NO
 
 00132 121                        CS=DXNEW*XEXP+DYNEW*YEXP                         MAKE SURE THEY ALWAYS POINT TO ORIGIN
 00133 122                        IF CS.LT.0.
 00134 123                        THEN
 00135 126                           IF(IPRINT.GT.2) WRITE(6,386)
 00136 128 386  FORMAT('  DIRECTION COSINES REVERSED')
 00137 129                           DXNEW=-DXNEW
 00138 130                           DYNEW=-DYNEW
 00139 131                        CIF
 00141 132                        DXRL=ADATA(IPTRL+7)                              DIR COSINES
 00142 133                        DYRL=ADATA(IPTRL+8)
 00143 134                        DXY=SQRT(DXRL**2+DYRL**2)
 00145 135                        DXRL=DXRL/DXY                                    NORMALIZE TO X,Y PLANE
 00146 136                        DYRL=DYRL/DXY
 00147 137                        IF(IPRINT.GT.2) WRITE(6,295) DXNEW,DYNEW,DXRL,DYRL
 00148 139 295  FORMAT(' DXNEW,DYNEW,DXRL,DYRL',4F10.7)
 00149 140                        DIFDX=ABS(DXNEW-DXRL)
 00150 141                        DIFDY=ABS(DYNEW-DYRL)
 00152 142                        DIRXL=DIRXL1+DIRXL2*1000.*ADATA(IPTMC+18)        LIMITS FOR DIR COSINES
 00153 143                        DIRYL=DIRYL1+DIRYL2*1000.*ADATA(IPTMC+18)
 00154 144                        IF DIFDX.LT.DIRXL.AND.DIFDY.LT.DIRYL
 00155 145                        THEN
 00156 148                           IF(IPRINT.GT.1) WRITE(6,838) DIFDX,DIFDY,DIRXL,DIRYL
 00157 150 838  FORMAT(' SUCCESSFUL MATCH TO DIRECTION COSINES,DIFX,Y',4F10.7)
 00158 151                           CRVRL=ADATA(IPTRL+26)
 00159 152                           RADRL=1./ADATA(IPTRL+26)
 00160 153                           CRVMC=ADATA(IPTMC+26)
 00161 154                           RADMC=1./ADATA(IPTMC+26)
 00162    C     DIFCRV=ABS(CRVRL-CRVMC)
 00163 155                           DIFRAD=ABS(RADRL-RADMC)
 00165 156                           IF(CRVRL*CRVMC.LT.0.) DIFCRV=9999.            ARE CHARGES SAME ?
 00167 158                           DRADL=RADLI1+RADLI2*ABS(RADMC)                LIMITS ON RADIUS
 00168 159                           IF DIFRAD.LT.DRADL
 00169 160                           THEN
 00170 163                              IF(IPRINT.GT.1) WRITE(6,393) DIFRAD,DRADL
 00171 165 393  FORMAT('  SUCCESSFUL RAD MATCH ,DIFRAD ,LIMIT ',2F10.2)
 00172 166                              CHI=DIFDX/DIRXL+DIFDY/DIRYL+DIFX/DXLIM+DIFY/DYLIM+DIFRAD/DRADL
 00173         ý                        + FLOAT(NHTDIF/(NHTLI1+NHTLI2)/2)
 00174 167                              IF(IPRINT.GT.1.AND.CHIOLD.NE.9999.) WRITE(6,777) CHI,CHIOLD
 00175 169 777  FORMAT('  TWO MATCHES FOUND NEW,OLD',2F10.5)
 00176 170                              IF CHI.LT.CHIOLD.AND.CHI.LT.4.
 00177 171                              THEN
 00178 174                                 CHIOLD=CHI
 00179 175                                 HMC(JMC)=IRL
 00180 176                                 IF(IPRINT.GT.1) WRITE(6,934) CHI
 00181 178 934  FORMAT('  ********** MATCH FOUND,CHI=',F10.5)
 00182 179                              CIF
 00183 180                           CIF
 00184 181                        CIF
 00185 182                     CIF
 00186 183                  CIF
 00187 184               CIF
 00188 185               IPTRL=IPTRL+LNGRL
 00189 186            CFOR
 00190 188            ITR=HMC(JMC)
 00191 189            HRL(ITR)=-JMC
 00192 190         CIF
 00193 191         IPTMC=IPTMC+LNGMC
 00194 192      CFOR
 00195 194      IPTMC=IDATA(IMC+1)+IMC+1
 00196 195      IMCNMX=0
 00197 196      FOR IMC=1,NUMMC
 00198 197         IF(HMC(IMC).GT.0.AND.IPRINT.GT.0) WRITE(6,192) IMC,HMC(IMC)
 00199 199 192  FORMAT('  MC TRACK ',I5,'   MATCHED WITH TRACK',I5)
 00200 200         IF HMC(IMC).EQ.0
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  4
0CARD TARGET
  NO  STM.NO
 
 00201 201         THEN
 00202 204            CRVMC=ADATA(IPTMC+26)
 00203 205            IF ABS(CRVMC).GT.CRVLOW
 00204 206            THEN
 00205 209               IF(IPRINT.GT.0) WRITE(6,104) IMC
 00206 211 104  FORMAT('  MC TRACK',I5,'   MOMENTUM TOO LOW')
 00207 212               HMC(IMC)=999
 00208 213            ELSE
 00209 215               ITYP=IDATA(IPTMC+3)
 00210 216               IF ITYP.EQ.3
 00211 217               THEN
 00212 220                  IF(IPRNT.GT.0) WRITE(6,735) IMC
 00213 222 735  FORMAT(' KINK DAUGHTER NOT FOUND, MC TRACK',I5)
 00214 223                  HMC(IMC)=999
 00215 224               ELSE
 00216 226                  IF IMC.LT.NUMMC
 00217 227                  THEN
 00218 230                     ITYPNX=IDATA(IPTMC+LNGMC+3)
 00219 231                     IF ITYPNX.EQ.3.AND.HMC(IMC+1).GT.0
 00220 232                     THEN
 00221 235                        HMC(IMC)=999
 00222 236                        IF(IPRNT.GT.0) WRITE(6,727) IMC
 00223 238 727  FORMAT(' KINK PARENT NOT FOUND BUT DAUGHTER HAS BEEN,MC TRACK',I5)
 00224 239                     CIF
 00225 240                  CIF
 00226 241               CIF
 00227 242            CIF
 00228 243            IF(HMC(IMC).EQ.0.AND.IPRINT.GT.0) WRITE(6,736) IMC
 00229 245 736  FORMAT(' MC TRACK',I5,'  NOT MATCHED')
 00230 246            IF(HMC(IMC).EQ.0) IMCNMX=IMCNMX+1
 00231 248         CIF
 00232 249         IPTMC=IPTMC+LNGMC
 00233 250      CFOR
 00234 252      IPTRL=IDATA(IREAL+1)+IREAL+1
 00235 253      IRLNMX=0
 00236 254      FOR IRL=1,NUMRL
 00237 255         CRVRL=ADATA(IPTRL+26)
 00238 256         IF ABS(CRVRL).GT.CRVLOW
 00239 257         THEN
 00240 260            IF(IPRINT.GT.0) WRITE(6,695) IRL
 00241 262 695  FORMAT('  REAL TRACK',I5,'   MOMENTUM TOO LOW')
 00242 263            HRL(IRL)=999
 00243 264         CIF
 00244 265         IF(HRL(IRL).EQ.0.AND.IPRINT.GT.0) WRITE(6,385) IRL
 00245 267 385  FORMAT('  REAL TRACK',I5,'   NOT MATCHED')
 00246 268         IF(HRL(IRL).EQ.0) IRLNMX=IRLNMX+1
 00247 270         IPTRL=IPTRL+LNGRL
 00248 271      CFOR
 00249 273      IF(IPRINT.GT.0) WRITE(6,738) IMCNMX
 00250 275 738  FORMAT('0 ',I5,'     MONTE CARLO TRACKS NOT MATCHED')
 00251 276      IF(IPRINT.GT.0) WRITE(6,730) IRLNMX
 00252 278 730  FORMAT('  ',I5,'     PATTERN RECOGNIZED TRACKS NOT MATCHED')
 00253 279      RETURN
 00254 280      END
0END OF SEGMENT
0  OPTIONS IN EFFECT - LINECOUNT=64,LINEWIDTH=131,  SOURCE,  FORTRAN  NUMBERING
0   0 ERRORS           0 WARNINGS         279 TARGET STATEMENTS
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  1
0CARD TARGET
  NO  STM.NO
 
 00255   2      BLOCK DATA
 00256    C
 00257    C
 00258    C-------------------------------------------------------------------
 00259    C
 00260    C       DESCRIPTION OF LIMITS IN COMMON COMPAT
 00261    C
 00262    C
 00263    C
 00264    C
 00265    C       THE LIMIT ON THE MATCHING OF THE RAD OF CURVS
 00266    C       IS :  RADLI1 + RADLI2 * (RAD OF CRV OF MC TRACK)
 00267    C
 00268    C        THE LIMIT ON MATCHING NO OF HITS IS:
 00269    C        NHTLI1 + DHTLI2 * (NO. OF HITS ON MC TRACK)
 00270    C
 00271    C        THE LIMITS ON THE X,Y START POSITION OF REAL TRACK
 00272    C        AND EXTRAPOLATED POINT ON MC TRACK ARE:
 00273    C        DXLIM1 + 1000. * DXLIM2 *( CRV OF MC TRACK)
 00274    C
 00275    C        THE LIMITS ON DIR COSINE MATCHING ARE:
 00276    C        DIRXL1 + 1000. * DIRXL2 *( CRV OF MC TRACK)
 00277    C
 00278    C        ANY TRACKS WITH CRV HIGHER THAN CRVLOW ARE NOT
 00279    C        COUNTED AS BEING MISMATCHED
 00280    C        IPRINT = 0,1,2  GIVES PROGRESSIVELY MORE PRINT
 00281    C
 00282    C----------------------------------------------------------------
 00283    C
 00284   3      IMPLICIT INTEGER*2 (H)
 00285    C
 00286   4      COMMON /COMPAT/ RADLI1,RADLI2,NHTLI1,DHTLI2,DXLIM1,DYLIM1,
 00287         & DXLIM2,DYLIM2,DIRXL1,DIRYL1,DIRXL2,DIRYL2,IPRINT,CRVLOW,
 00288         & IMCNMX,IRLNMX
 00289   5      DATA CRVLOW/.0015/,IPRINT/1/
 00290   6      DATA RADLI1,RADLI2/400.,.15/
 00291   7      DATA NHTLI1,DHTLI2/10,.5/
 00292   8      DATA DXLIM1,DYLIM1/3.0,3.0/
 00293   9      DATA DXLIM2,DYLIM2/3.5,3.5/
 00294  10      DATA DIRXL1,DIRYL1/.04,.04/
 00295  11      DATA DIRXL2,DIRYL2/.05,.05/
 00296  12      END
 ..WARNING..                STOP OR RETURN ARE MISSING
0END OF SEGMENT
0  OPTIONS IN EFFECT - LINECOUNT=64,LINEWIDTH=131,  SOURCE,  FORTRAN  NUMBERING
0   0 ERRORS           1 WARNINGS          11 TARGET STATEMENTS
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  1
0CARD TARGET
  NO  STM.NO
 
0END OF PROGRAM
0  OPTIONS IN EFFECT - LINECOUNT=64,LINEWIDTH=131,  SOURCE,  FORTRAN  NUMBERING
0   0 ERRORS           1 WARNINGS         290 TARGET STATEMENTS
 00000    C   25/07/80 102191159  MEMBER NAME  LBHTRO   (PATRECSR)    SHELTRAN
 00001   2      SUBROUTINE LBHTRO(ITRK,PAR1,PAR2,PAR3,INDPAR)
 00002    C
 00003    C        LABEL GOOD HITS OF TRACK TROUGH ORIGIN
 00004    C                   HISTOGRAM METHOD USING INTERACTION POINT
 00005    C                   OR        DIRECTION AT CONVERSION IN PIPE OR TANK
 00006    C
 00007   3      IMPLICIT INTEGER*2 (H)
 00008    C
          C----------------------------------------------
          C  MACRO CWORKPR .... PATTERN RECOGNITION CWORK
          C----------------------------------------------
         4      COMMON /CWORK/ HPLAST,HPFREE,HPWRK(30),ADWRK(600),
               ,               HPRO,HNTR,HNTCEL(98),IPCL(200),NRHT(200),
               ,               NWR1(200),DS1(200),SL1(200),
               ,               NWR2(200),DS2(200),SL2(200),
               ,               LBL(200),NTREL(200),ICRO(200),
               ,               NTR,HNREL(100),HISTR(9,100),HRES(168),
               ,               NTRLM,RLMTR(3,5),
               ,               WRK(7000)
         5      DIMENSION TRKAR(200,11),ITRKAR(200,11),
               ,                         LMRTR(3,5)
         6      EQUIVALENCE (IPCL(1),TRKAR(1,1),ITRKAR(1,1))
         7      EQUIVALENCE (LMRTR(1,1),RLMTR(1,1))
         8      DIMENSION IWRK(7000),HWRK(14000),IDWRK(600),HDWRK(1200)
         9      EQUIVALENCE (IWRK(1),WRK(1),HWRK(1))
        10      EQUIVALENCE (IDWRK(1),ADWRK(1),HDWRK(1))
          C---------- END OF MACRO CWORKPR --------------
 00100    C-------------------------------------------------------
 00200    C  MACRO CWORKEQ .... PATTERN RECOGNITION CWORK POINTERS
 00300    C-------------------------------------------------------
 00400  11      EQUIVALENCE
 00410    C                POINTERS FOR FXYZ HIT ARRAY .. PRIMARY L/R SOLUTION
 00500         #          (HPHT0,HPWRK( 1)),(HPHT9,HPWRK( 2)),(HLDHT,HPWRK( 3))
 00510    C                POINTERS FOR CWORK SINGLE TRACK PATR BANK
 00600         #         ,(HPTR0,HPWRK( 4)),(HPTR9,HPWRK( 5)),(HLDTR,HPWRK( 6))
 00610    C                POINTERS FOR TRACK ELEMENT HIT LABEL ARRAY
 00700         #         ,(HPHL0,HPWRK( 7)),(HPHL9,HPWRK( 8)),(HLDHL,HPWRK( 9))
 00710    C                POINTERS FOR FXYZ HIT ARRAY .. OPPOSITE L/R SOLUTION
 00800         #         ,(HPHT0A,HPWRK(10)),(HPHT9A,HPWRK(11)),(HLDHTA,HPWRK(12))
 00810    C               POINTER LIMIT ON FXYZ HIT ARRAY
 00900         #         ,(HPHTLM,HPWRK(13))
 00910    C               POINTERS FOR
 01000         #         ,(HPTE0,HPWRK(14)),(HPTE9,HPWRK(15)),(HLDTE,HPWRK(16))
 01100    C-------------- END OF MACRO CWORKEQ ------------------
 00011    C
 00012  12      EQUIVALENCE
 00013         ,          (HPCO0 ,HPWRK(17)),(HPCO9 ,HPWRK(18)),(HLDCO ,HPWRK(19))
 00014         ,         ,(ICELL ,IDWRK( 1)),(MHIT  ,IDWRK( 2)),(IRING ,IDWRK( 3))
 00015         ,         ,(IERRCD,IDWRK( 4)),(NTRKEL,IDWRK( 5))
 00016    C
          C----------------------------------------------
          C  MACRO CPATLM .... PATTERN RECOGNITION LIMITS
          C----------------------------------------------
        13      COMMON /CPATLM/ PATRLM(5),FLINLM(10),TRELLM(20),ZFITLM(10),BKK(20)
               *               ,XYF(20),IGFP(20),XBKK(40),IADMIN(5),YBKK(20)
        14      INTEGER IXYF(20),LMPATR(5),LMFLIN(10)
        15      INTEGER LMTREL(20),LMZFIT(10),IBKK(20)
        16      DIMENSION GFP(20),IXBKK(40),IYBKK(20)
        17      EQUIVALENCE (PATRLM(1),LMPATR(1)),(IXBKK(1),XBKK(1)),(IYBKK(1),
               *YBKK(1))   ,(FLINLM(1),LMFLIN(1)),(TRELLM(1),LMTREL(1))
               *           ,(ZFITLM(1),LMZFIT(1)),(BKK(1),IBKK(1))
               *           ,(XYF(1),IXYF(1)),(GFP(1),IGFP(1)),(IADMIN(1),IMCERT)
               *           ,(IYBKK(20),IPPASS),(IADMIN(2),IPFAST)
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  2
0CARD TARGET
  NO  STM.NO
 
          C----------- END OF MACRO CPATLM --------------
 00018    C
 00100    C-----------------------------------------------------------------------
 00200    C                            MACRO CJDRCH .... JET CHAMBER CONSTANTS.
 00300    C-----------------------------------------------------------------------
 00310    C
 00400  18      COMMON / CJDRCH / RDEC(4),PSIIN(3),RINCR(3),FIRSTW(3),FSENSW(3),
 00500         +                  RDEPTH,SWDEPL,YSUSPN,TIMDEL(2,3),ZMAX,ZOFFS,
 00510         +                  ZRESOL,ZNORM,ZAL,ZSCAL,DRIDEV,DRICOS,DRISIN,
 00600         +                  PEDES,TZERO(3),DRIROT(96,2),SINDRI(96,2),
 00701         +                  COSDRI(96,2),DRIVEL(96,2),T0FIX(3),
 00800         +                  ABERR(8), DUMJDC(20)
 00900    C
 01100    C      BLOCK DATA SET TO MC VALUES, KALIBR WILL SET REAL DATA VALUES
 01210    C--->  A CHANGE OF THIS COMMON MUST BE DONE SIMULTANEOUSLY WITH  <----
 01220    C--->  A CHANGE OF THE BLOCK DATA                                <----
 01230    C
 01300    C--------------------------- END OF MACRO CJDRCH -----------------------
 01400    C
          C----------------------------------------------------------------------
          C           MACRO CDSMAX .... PATTERN RECOGNITION CONSTANTS.
          C----------------------------------------------------------------------
        19      COMMON/CDSMAX/DSMAX(16,3,2),DIRWR1(24,2),DIRWR3(48,2)
               *             ,DHALF(16,3,2),DTWICE(16,3,2),HMCH(16,3,2)
               *             ,IBCK(9),DBCK(30),TRMATS(96,2),TRMATC(96,2)
          C------------------------ END OF MACRO CDSMAX -------------------------
 00021    C
 00022  20      DIMENSION HST( 80)
 00023    C
 00025  21      DATA XCV /152.7/                                                   AVERAGE RADIUS FOR PAIR CONVERSION IN BEAM PIPE OR
 00026    C
 00027    C2101 FORMAT('0HISTOGRAM:',20I2,2X,20I2,/,(11X,20I2,2X,20I2))
 00028    C2102 FORMAT(' PEAK =',10I6,6F10.5)
 00029    C2103 FORMAT(' SAMPL.:',3F6.1,3F10.5,I5,  5X,F10.1,2F10.5,I5)
 00030    C
 00031    C
 00033  22      CALL SETS(HST(1),0,160,0)                                          ZERO HISTOGRAM
 00034  23      DCRV =  .000010
 00035  24      CRV1 = -DCRV*20.
 00036  25      X0   = FSENSW(IRING) + RINCR(IRING)*7.5
 00037  26      Y0   = (PAR1*X0 + PAR2)*X0 + PAR3
 00038  27      S0   = PAR1*X0*2. + PAR2
 00039  28      CRV0 = (S0*X0 - Y0) / X0**2
 00040  29      CRV0 = CRV0 + CRV1
 00041  30      CVP0 = (S0*X0 - Y0) / (X0**2 - XCV**2)
 00042  31      CVP0 = CVP0 + CRV1
 00043  32      ZW1  = X0
 00044  33      ZW2  = Y0 / X0
 00045  34      ZW3  = XCV**2
 00046    C
 00048  35      FOR IP = HPCO0,HPCO9,HLDCO                                         LOOP OVER ALL HITS
 00049  36         X   = WRK(IP+3)
 00050  37         Y   = WRK(IP+4)
 00051  38         IF ABS(X-X0) .GT. 25.
 00052  39         THEN
 00053  42            CV1 = ZW2*X - Y
 00054  43            CV2 = (ZW1-X)*X
 00055  44            CRV = CV1 / CV2
 00056  45            IBN = (CRV-CRV0) / DCRV + 1
 00057  46            IF(IBN.GT.0 .AND. IBN.LE.40) HST(IBN   ) = HST(IBN   ) + 1
 00058  48            CVP = CV1 / ((X/ZW1-1.)*ZW3 + CV2)
 00059  49            IBM = (CVP-CVP0) / DCRV + 1
 00060  50            IF(IBM.GT.0 .AND. IBM.LE.40) HST(IBM+40) = HST(IBM+40) + 1
 00061    C     PRINT 2103, X,Y,ZW1,ZW2,CRV0,CRV,IBN,ZW3,CVP0,CVP,IBM
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  3
0CARD TARGET
  NO  STM.NO
 
 00062  52         CIF
 00063  53      CFOR
 00064    C
 00065    C     PRINT 2101, HST
 00066    C
 00068    C                                                                        FIND PEAK IN HISTOGRAMS
 00069    C
 00071  55      MHST = 0                                                           HISTOGRAM (TRACKS THROUGH ORIGIN)
 00072  56      IMAX = 0
 00073  57      FOR I=19,22
 00074  58         NHST = HST(I-1) + HST(I  ) + HST(I+1)
 00075  59         IF NHST.GE.MHST
 00076  60         THEN
 00077  63            MHST = NHST
 00078  64            IMAX = I
 00079  65         CIF
 00080  66      CFOR
 00081    C
 00083  68      MHSTP = 0                                                          HISTOGRAM (TRACKS FROM PAIR CONV.IN PIPE OR TANK)
 00084  69      IMAXP = 0
 00085  70      FOR I=59,62
 00086  71         NHST = HST(I-1) + HST(I  ) + HST(I+1)
 00087  72         IF NHST.GE.MHSTP
 00088  73         THEN
 00089  76            MHSTP = NHST
 00090  77            IMAXP = I
 00091  78         CIF
 00092  79      CFOR
 00093    C     PRINT 2102, IMAX,MHST,IMAXP,MHSTP
 00094    C
 00096  81      IF MHSTP.LT.IRING*8 .OR. MHSTP-5.LT.MHST                           SELECT HISTOGRAM
 00097  82      THEN
 00099  85         INDPAR = 0                                                      TRACK THROUGH ORIGIN
 00100  86      ELSE
 00102  88         INDPAR = 1                                                      TRACK FROM PAIR CONVERSION
 00103  89         MHST = MHSTP
 00104  90         IMAX = IMAXP - 40
 00105  91         CALL MVC(HST(1),0,HST(2),0,80)
 00106  92         CRV0 = CVP0
 00107  93         PAR1 = CVP0 - CRV1
 00108  94         PAR3 = PAR1 * ZW3
 00109  95      CIF
 00110    C
 00112  96      NH0 = HST(IMAX-2)                                                  EVALUATE PEAK
 00113  97      NH1 = HST(IMAX-1)
 00114  98      NH2 = HST(IMAX  )
 00115  99      NH3 = HST(IMAX+1)
 00116 100      NH4 = HST(IMAX+2)
 00117    C
 00119 101      IF IMAX.EQ.19 .AND.                                                CORRECT FOR DOUBLE PEAK
 00120         ?   NH0.GT.0 .AND. NH0.GT.NH1 .AND. NH4.NE.0
 00121 102      THEN
 00122 105         IMAX = IMAX + 1
 00123 106      CIF
 00124 107      IF IMAX.EQ.22 .AND.
 00125         ?   NH4.GT.0 .AND. NH4.GT.NH3 .AND. NH0.NE.0
 00126 108      THEN
 00127 111         IMAX = IMAX - 1
 00128 112      CIF
 00129 113      IM1 = IMAX - 1
 00130 114      IM3 = IMAX + 1
 00131 115      IF(NH1.LE.2 .AND. NH3-NH1.GT.2) IM1 = IM1 + 1
 00132 117      IF(NH3.LE.2 .AND. NH1-NH3.GT.2) IM3 = IM3 - 1
 00133 119      NHST  = NH1 + NH2 + NH3
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  4
0CARD TARGET
  NO  STM.NO
 
 00134 120      NHTTR = 0
 00135 121      IF NHST.GE.3
 00136 122      THEN
 00137    C     PRINT 2102,IMAX,MHST,LBLR,NH1,NH2,NH3,IM1,IM3,MHSTL,MHSTR,ZW1,ZW2
 00138    C
 00140 125         IHIT = 0                                                        FETCH HITS OF PEAK IN HISTOGRAM
 00141 126         IPHT = HPHT0
 00142 127         FOR IP = HPCO0,HPCO9,HLDCO
 00143 128            X   = WRK(IP+3)
 00144 129            Y   = WRK(IP+4)
 00145 130            IF ABS(X-X0) .GT. 25.
 00146 131            THEN
 00147 134               CV1 = ZW2*X - Y
 00148 135               CV2 = (ZW1-X)*X
 00149 136               IF INDPAR.EQ.0
 00150 137               THEN
 00151 140                  CRV = CV1 / CV2
 00152 141               ELSE
 00153 143                  CRV = CV1 / ((X/ZW1-1.)*ZW3 + CV2)
 00154 144               CIF
 00155 145               IBN = (CRV-CRV0) / DCRV + 1
 00156    C     PRINT 2103, X,Y,ZW1,ZW2,CRV0,CRV,IBN
 00157 146               IF IBN.GE.IM1 .AND. IBN.LE.IM3
 00158 147               THEN
 00160 150                  IF IWRK(IP+ 9).EQ.ICELL                                CHECK IF HIT OF TREL
 00161 151                  THEN
 00162 154                     LBGOOD = 4
 00163 155                     PERFORM CKORHT
 00164 158                  ELSE
 00165 160                     LBGOOD = 0
 00166 161                  CIF
 00167 162               ELSE
 00168 164                  LBGOOD = 8
 00170 165                  PERFORM CKORHT                                         CHECK IF NO ORIGINAL HIT OF TRACK
 00171 168               CIF
 00172 169            ELSE
 00173 171               LBGOOD = 1
 00175 172               PERFORM CKORHT                                            CHECK IF NO ORIGINAL HIT OF TRACK
 00176 175            CIF
 00177 176            IWRK(IP+7) = LBGOOD
 00178 177            IF(LBGOOD.EQ.0) IHIT = IHIT + 1
 00179 179         CFOR
 00180 181         NHTTR = IHIT
 00181 182      CIF
 00182    C
 00183 183      RETURN
 00184    C
 00185    C
 00186                                                                             *************************
 00187                                                                             *      C K O R H T      *
 00189    C                                                                        *************************
 00190    C
 00192 184      PROC CKORHT                                                        CHECK IF NO ORIGINAL HIT OF TREL
 00193    C
 00195 185         IF ITRK.GT.0                                                    CHECK IF ANY TREL
 00196 186         THEN
 00197    C
 00198 189            JCELL = IWRK(IP+ 9)
 00200 190            IF JCELL.EQ.ICELL                                            CHECK IF SAME CELL
 00201 191            THEN
 00202 194               IPBACK = IWRK(IP+ 1)
 00203 195               WHILE IPHT.LT.HPHT9
 00204 197                  IF IWRK(IPHT+1).EQ.IPBACK
 00205 201                  THEN
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  5
0CARD TARGET
  NO  STM.NO
 
 00206 204                     IF(IWRK(IPHT+9).EQ.ITRK .OR. IWRK(IPHT+10).EQ.ITRK)
 00207         ?               LBGOOD = 0
 00208 206                     XWHILE
 00209 207                  CIF
 00210 208                  IF(IWRK(IPHT+1).GT.IPBACK) XWHILE
 00211 210                  IPHT = IPHT + HLDHT
 00212 211               CWHILE
 00213 213            CIF
 00214 214         CIF
 00215 215      CPROC
 00216    C
 00217 217      END
0END OF SEGMENT
0  OPTIONS IN EFFECT - LINECOUNT=64,LINEWIDTH=131,  SOURCE,  FORTRAN  NUMBERING
0   0 ERRORS           0 WARNINGS         216 TARGET STATEMENTS
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  1
0CARD TARGET
  NO  STM.NO
 
0END OF PROGRAM
0  OPTIONS IN EFFECT - LINECOUNT=64,LINEWIDTH=131,  SOURCE,  FORTRAN  NUMBERING
0   0 ERRORS           0 WARNINGS         216 TARGET STATEMENTS
 00000    C   13/01/82 703202243  MEMBER NAME  PATRCO   (PATRECSR)    SHELTRAN
 00100    C   09/07/80 201111008  MEMBER NAME  ORPATRCO (JADESR)      SHELTRAN
 00200   2      SUBROUTINE PATRCO(IND)
 00300    C
 00400    C     MAIN SUBROUTINE FOR PATREC IN JET CHAMBERS
 00500    C     SELECTING ONLY TRACKS FROM ORIGIN (P>200MEV)
 00600    C     PETER STEFFEN  9/07/80
 00700    C
 00800   3      IMPLICIT INTEGER*2 (H)
 00900    C
          C-------------------------------
          C  MACRO CHEADR .... HEADER BANK
          C-------------------------------
         4      COMMON /CHEADR/ IHEADR(54)
         5      INTEGER*2 HHEADR(108)
         6      EQUIVALENCE (IHEADR(1),HHEADR(1))
          C --
          C --  HHEADR(17) = EXPERIMENT NUMBER
          C --  HHEADR(18) = RUN NUMBER
          C --  HHEADR(19) = EVENT NUMBER
          C --  HHEADR(38) = MAGNETIC FIELD (GAUSS)
          C --
          C--------- END OF MACRO CHEADR ------------
          C----------------------------------------------------------------------
          C             MACRO CDATA .... BOS COMMON.
          C
          C             THIS MACRO ONLY DEFINES THE IDATA/HDATA/ADATA NAMES.
          C             THE ACTUAL SIZE OF /BCS/ IS FIXED ON MACRO CBCSMX
          C             OR BY OTHER MEANS. A DEFAULT SIZE OF 40000 IS GIVEN HERE.
          C
          C----------------------------------------------------------------------
          C
         7      COMMON /BCS/ IDATA(40000)
         8      DIMENSION HDATA(80000),ADATA(40000),IPNT(50)
         9      EQUIVALENCE (HDATA(1),IDATA(1),ADATA(1)),(IPNT(1),IDATA(55))
        10      EQUIVALENCE (NWORD,IPNT(50))
          C
          C------------------------ END OF MACRO CDATA --------------------------
          C----------------------------------------------------------------------
          C           MACRO CCYCP .... JET CHAMBER HIT POINTERS (PATREC)
          C----------------------------------------------------------------------
        11      INTEGER*4 HPTSEC
        12      COMMON/CCYCP/HPTSEC(98)
 00016    C     HPTSEC(I) = CDATA POINTER TO 1ST I*2 WORD FOR 1ST HIT OF CELL I
          C------------------------ END OF MACRO CCYCP --------------------------
 01300    C
 00100    C-----------------------------------------------------------------------
 00200    C                            MACRO CJDRCH .... JET CHAMBER CONSTANTS.
 00300    C-----------------------------------------------------------------------
 00310    C
 00400  13      COMMON / CJDRCH / RDEC(4),PSIIN(3),RINCR(3),FIRSTW(3),FSENSW(3),
 00500         +                  RDEPTH,SWDEPL,YSUSPN,TIMDEL(2,3),ZMAX,ZOFFS,
 00510         +                  ZRESOL,ZNORM,ZAL,ZSCAL,DRIDEV,DRICOS,DRISIN,
 00600         +                  PEDES,TZERO(3),DRIROT(96,2),SINDRI(96,2),
 00701         +                  COSDRI(96,2),DRIVEL(96,2),T0FIX(3),
 00800         +                  ABERR(8), DUMJDC(20)
 00900    C
 01100    C      BLOCK DATA SET TO MC VALUES, KALIBR WILL SET REAL DATA VALUES
 01210    C--->  A CHANGE OF THIS COMMON MUST BE DONE SIMULTANEOUSLY WITH  <----
 01220    C--->  A CHANGE OF THE BLOCK DATA                                <----
 01230    C
 01300    C--------------------------- END OF MACRO CJDRCH -----------------------
 01400    C
          C----------------------------------------------------------------------
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  2
0CARD TARGET
  NO  STM.NO
 
          C           MACRO CDSMAX .... PATTERN RECOGNITION CONSTANTS.
          C----------------------------------------------------------------------
        14      COMMON/CDSMAX/DSMAX(16,3,2),DIRWR1(24,2),DIRWR3(48,2)
               *             ,DHALF(16,3,2),DTWICE(16,3,2),HMCH(16,3,2)
               *             ,IBCK(9),DBCK(30),TRMATS(96,2),TRMATC(96,2)
          C------------------------ END OF MACRO CDSMAX -------------------------
          C----------------------------------------------
          C  MACRO CPATLM .... PATTERN RECOGNITION LIMITS
          C----------------------------------------------
        15      COMMON /CPATLM/ PATRLM(5),FLINLM(10),TRELLM(20),ZFITLM(10),BKK(20)
               *               ,XYF(20),IGFP(20),XBKK(40),IADMIN(5),YBKK(20)
        16      INTEGER IXYF(20),LMPATR(5),LMFLIN(10)
        17      INTEGER LMTREL(20),LMZFIT(10),IBKK(20)
        18      DIMENSION GFP(20),IXBKK(40),IYBKK(20)
        19      EQUIVALENCE (PATRLM(1),LMPATR(1)),(IXBKK(1),XBKK(1)),(IYBKK(1),
               *YBKK(1))   ,(FLINLM(1),LMFLIN(1)),(TRELLM(1),LMTREL(1))
               *           ,(ZFITLM(1),LMZFIT(1)),(BKK(1),IBKK(1))
               *           ,(XYF(1),IXYF(1)),(GFP(1),IGFP(1)),(IADMIN(1),IMCERT)
               *           ,(IYBKK(20),IPPASS),(IADMIN(2),IPFAST)
          C----------- END OF MACRO CPATLM --------------
 01700    C
          C----------------------------------------------
          C  MACRO CWORKPR .... PATTERN RECOGNITION CWORK
          C----------------------------------------------
        20      COMMON /CWORK/ HPLAST,HPFREE,HPWRK(30),ADWRK(600),
               ,               HPRO,HNTR,HNTCEL(98),IPCL(200),NRHT(200),
               ,               NWR1(200),DS1(200),SL1(200),
               ,               NWR2(200),DS2(200),SL2(200),
               ,               LBL(200),NTREL(200),ICRO(200),
               ,               NTR,HNREL(100),HISTR(9,100),HRES(168),
               ,               NTRLM,RLMTR(3,5),
               ,               WRK(7000)
        21      DIMENSION TRKAR(200,11),ITRKAR(200,11),
               ,                         LMRTR(3,5)
        22      EQUIVALENCE (IPCL(1),TRKAR(1,1),ITRKAR(1,1))
        23      EQUIVALENCE (LMRTR(1,1),RLMTR(1,1))
        24      DIMENSION IWRK(7000),HWRK(14000),IDWRK(600),HDWRK(1200)
        25      EQUIVALENCE (IWRK(1),WRK(1),HWRK(1))
        26      EQUIVALENCE (IDWRK(1),ADWRK(1),HDWRK(1))
          C---------- END OF MACRO CWORKPR --------------
 00100    C-------------------------------------------------------
 00200    C  MACRO CWORKEQ .... PATTERN RECOGNITION CWORK POINTERS
 00300    C-------------------------------------------------------
 00400  27      EQUIVALENCE
 00410    C                POINTERS FOR FXYZ HIT ARRAY .. PRIMARY L/R SOLUTION
 00500         #          (HPHT0,HPWRK( 1)),(HPHT9,HPWRK( 2)),(HLDHT,HPWRK( 3))
 00510    C                POINTERS FOR CWORK SINGLE TRACK PATR BANK
 00600         #         ,(HPTR0,HPWRK( 4)),(HPTR9,HPWRK( 5)),(HLDTR,HPWRK( 6))
 00610    C                POINTERS FOR TRACK ELEMENT HIT LABEL ARRAY
 00700         #         ,(HPHL0,HPWRK( 7)),(HPHL9,HPWRK( 8)),(HLDHL,HPWRK( 9))
 00710    C                POINTERS FOR FXYZ HIT ARRAY .. OPPOSITE L/R SOLUTION
 00800         #         ,(HPHT0A,HPWRK(10)),(HPHT9A,HPWRK(11)),(HLDHTA,HPWRK(12))
 00810    C               POINTER LIMIT ON FXYZ HIT ARRAY
 00900         #         ,(HPHTLM,HPWRK(13))
 00910    C               POINTERS FOR
 01000         #         ,(HPTE0,HPWRK(14)),(HPTE9,HPWRK(15)),(HLDTE,HPWRK(16))
 01100    C-------------- END OF MACRO CWORKEQ ------------------
 02000    C
 02100  28      EQUIVALENCE
 02200         ,           (ICELL ,IDWRK(1)),(NHIT  ,IDWRK(2)),(IRING ,IDWRK(3))
 02300         ,         , (IERRCD,IDWRK(4)),(NTRKEL,IDWRK(5))
 02400         ,         , (ITR   ,IDWRK(7)),(ITRNG ,IDWRK(8))
 02500    C
 02600    C
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  3
0CARD TARGET
  NO  STM.NO
 
 02700  29      COMMON /CLBPGM/ LBPGM(30)
 02800  30      INTEGER MSKHIT(16) /1,2,4,8,16,32,64,128,Z100,Z200,Z400,Z800,
 02900         ,                    Z1000,Z2000,Z4000,Z8000/
 03000    C
 03100  31      DATA HPS /2HPS/
 03200  32      DATA PATR /'PATR'/, LHEAD,LTRBK /8,48/
 03300  33      DATA JHTL /'JHTL'/
 03400    C
 03500  34 2991 FORMAT('0/BCS/ TOO SHORT FOR TRACK BANK; EVENT:',3I6,
 03600         ,       ', IRET=',I2,',NTR,LENGTH=',I3,1X,I4)
 03700  35 2992 FORMAT('0/CWORK/ TOO SHORT FOR PATREC; EVENT:',3I6)
 03800  36 2993 FORMAT('0/BCS/ TOO SHORT FOR PATREC; EVENT:',3I6,' ,IERR=',I2)
 03900  37 2994 FORMAT('0WRONG POINTER IN JETC-BANK; EVENT:',3I6,' ,POINTER:',
 04000         ,        /,(1X,24I5))
 04100    C
 04300  38      IF IND.EQ.2                                                        CHECK INDEX
 04400  39      THEN
 04500  42         CALL PATREC(0)
 04600  43         RETURN
 04700  44      CIF
 04800    C
 04900    C
 05100  45      DATA LBINIT /0/                                                    INITIALIZE POINTERS
 05200  46      IF LBINIT .EQ. 0
 05300  47      THEN
 05400  50         LBINIT = 0
 05500  51         IQPATR = IBLN('PATR')
 05600  52         IQJHTL = IBLN('JHTL')
 05700  53         IQJETC = IBLN('JETC')
 05800    C       CONST. FOR VAR. OF DRIFT VEL.
 05900  54         DSD0   =-.63
 06000  55         DSD1   = 1.8
 06100  56         DSD2   = 4.0
 06200  57         DRV0   = 0.8
 06300  58         DRV1   = (DSD2 - (DSD1-DSD0)*DRV0) / (DSD2-DSD1)
 06400  59      CIF
 06500    C
 06700  60      NTR = 0                                                            INITIALIZE # OF TRACKS
 06800    C
 07000  61      IPJETC = IDATA(IQJETC)                                             SET UP PATR-ARRAY IF NO HITS
 07100  62      IF IPJETC.LE.0
 07200  63      THEN
 07300  66         IPPATR = IDATA(IQPATR)
 07400  67         IF IPPATR.LE.0
 07500  68         THEN
 07600  71            NBNK = 10
 07700  72            IZW = LHEAD
 07800  73            CALL CCRE(IPPATR,PATR,NBNK,IZW,IERR)
 08000  74            IF(IERR.NE.0) RETURN                                         CHECK IF IERR = 0
 08100  76            CALL BSAW(1,PATR)
 08300  77            IDATA(IPPATR+1) = LHEAD                                      PRESET # OF TRACKS + LENGTH OF TRACK-VECTOR
 08400  78            IDATA(IPPATR+3) = LTRBK
 08500  79         CIF
 08600  80         RETURN
 08700  81      CIF
 08800    C
 09000  82      NHITJC = HDATA(IPJETC*2+99) / 4                                    # OF HITS IN JETC
 09100    C
 09300  83      PERFORM INAROU                                                     INITIALIZE ARRAYS IN OUTPUT AREA
 09400    C
 09600  86      HPFREE = 1                                                         POINTER TO 1. FREE LOC. IN /CWORK/
 09700  87      HPLAST = LMPATR(5)
 09800    C
 09900  88      PERFORM PRCYCP
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  4
0CARD TARGET
  NO  STM.NO
 
 10100  91      IF IERRFL.NE.0                                                     CHECK IF POINTERS OK
 10200  92      THEN
 10300  95         I1 = IPJCA2 + 1
 10400  96         I9 = I1 + 97
 10500  97         WRITE(6,2994) HHEADR(17),HHEADR(18),HHEADR(19),
 10600         ,   (HDATA(I),I=I1,I9)
 10700  98         CALL BDLS(PATR,NBNK)
 10800  99         CALL BDLS(JHTL,NBNK)
 10900 100         RETURN
 11000 101      CIF
 11100    C
 11300 102      IF (HPFREE+NHITJC+96*12+10*17 - 1).LT.LMPATR(5)                    CHECK IF ENOUGH SPACE IN /CWORK/
 11400 103      THEN
 11600 106         PERFORM ZRHTLB                                                  ZERO HIT LABEL ARRAY OF TRACK ELEMENTS
 11700 109      ELSE
 11800 111         WRITE(6,2992) HHEADR(17),HHEADR(18),HHEADR(19)
 11900 112         CALL BDLS(PATR,NBNK)
 12000 113         CALL BDLS(JHTL,NBNK)
 12100 114         RETURN
 12200 115      CIF
 12400 116      HPFRE0 = HPFREE                                                    MEMORIZE 1. FREE LOCATION IN CWORK
 12500    C
 12700 117      HPRO = HPS                                                         INITIALISE TRKEL ARRAY FOR TRACING
 12800 118      ITR = 1
 12900 119      IRINGO = 0
 13000    C
 13200 120      JCELL=97                                                           LOOP OVER ALL CELLS
 13300 121      REPEAT
 13400 122         JCELL = JCELL - 1
 13600 123         MHIT = (HPTSEC(JCELL+1)-HPTSEC(JCELL)) / 4                      NUMBER OF HITS IN CELL
 13800 124         IF MHIT.GE.5                                                    CHECK IF AT LEAST NHMIN HITS IN CELL
 13900 125         THEN
 14100 128            IRING = 3                                                    SET RING + CELL NUMBER
 14200 129            IF(JCELL.LE.48) IRING = 2
 14300 131            IF(JCELL.LE.24) IRING = 1
 14400 133            ICELL = JCELL
 14500    C
 14700 134            IERRCD = 0                                                   INITIALIZE ERR.CODE
 14800    C
 15000 135            HPFREE = HPFRE0                                              SEARCH FOR TRACK ELEMENTS
 15100 136            PERFORM SRTREL
 15200    C
 15300 139         CIF
 15400 140      UNTIL JCELL.EQ.25
 15500 141      HPFREE = HPFRE0
 15600    C
 15800 145      LENG  = IDATA(IPPATR+2)*IDATA(IPPATR+3) + IDATA(IPPATR+1)          READJUST RECORD LENGTH + # OF TRACKS
 15900 146      NDIFF = LENG - IDATA(IPPATR)
 16000 147      CALL BCHM(IPPATR,NDIFF,IRET)
 16100    C
 16200                                                                             CHECK IF REMAINING TRACKS WANTED
 16400 148      IF(IND.NE.0) CALL PATREC(1)                                        CALL PATREC(1) TO OBTAIN REMAINING TRACKS
 16500    C
 16700    C     CALL TRHTCK(IDATA(IQPATR),IDATA(IQJHTL))                           ELIMINATE COVERED TRACKS (ALREADY CALLED IN PATREC
 16800    C
 16900 150      RETURN
 17000    C
 17100                                                                             ***************************
 17200                                                                             *      S R T R E L        *
 17400    C                                                                        ***************************
 17600 151      PROC SRTREL                                                        SEARCH FOR TREL IN CELL + CALL TRACING
 17700    C
 17800                                                                             PREPAR HIT ARRAY OF CELL FOR PATREC
 18000 152         DSBIN1 = TIMDEL(1,IRING)                                        SET DRIFT SPACE BIN
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  5
0CARD TARGET
  NO  STM.NO
 
 18100 153         DSBIN2 = TIMDEL(2,IRING)
 18300 154         IP0 = HPTSEC(ICELL)                                             START POINTER OF CELL
 18500 155         IP9 = HPTSEC(ICELL+1) - 1                                       END POINTER OF CELL
 18700 156         IPHL = (HPTSEC(ICELL)-HPTSEC(1))/4 + IDATA(IQJHTL) + 1          START POINTER TO HIT LABEL ARRAY -1
 18900 157         HPHT0 = HPFREE                                                  POINTER OF NEW HIT ARRAY
 19000 158         HLDHT = 12
 19100 159         IPHT  = HPHT0
 19300 160         LBHITW = 0                                                      COUNTER FOR NUMBER OF HITS IN HIT ARRAY
 19400 161         NWRD2 = NWORD*2
 19500    C
 19700 162         ILAY0 = -10                                                     LOOP OVER ALL HITS OF CELL
 19800 163         MLAY  = 0
 19900 164         JHIT  = 0
 20000 165         FOR IP=IP0,IP9,4
 20100 166            IPHL = IPHL + 1
 20200 167            IF IDATA(IPHL).EQ.0
 20300 168            THEN
 20400 171               IF HDATA(IP+1).GT.0 .AND. HDATA(IP+2).GT.0
 20500 172               THEN
 20600 175                  IWIR = HDATA(IP)
 20700 176                  IWIR = SHFTR(IWIR,3)
 20900 177                  ILAYR = LAND(IWIR,15)                                  LAYER NUMBER WITHIN RING 3
 21000 178                  LBHITW = LOR(LBHITW,MSKHIT(ILAYR+1))
 21200 179                  IF(ILAYR.GE.8) DSBIN1 = DSBIN2                         CHANGE DRIFT SPACE BIN FOR 8 HIGHER LAYERS
 21400 181                  DS =(HDATA(IP+3)) * DSBIN1                             DRIFT SPACE
 21500 182                  DS = DS
 21600 183                  IF DS.LT.4.0
 21700 184                  THEN
 21800 187                     IF DS.GT.DSD1
 21900 188                     THEN
 22000 191                        DS = (DSD1-DSD0)*DRV0 + (DS-DSD1)*DRV1
 22100 192                     ELSE
 22200 194                        DS = (DS-DSD0)*DRV0
 22300 195                     CIF
 22400 196                     IF(DS.LT.0.1) DS = 0.1
 22500 198                  CIF
 22700 199                  WRK(IPHT+ 2)  = DS                                     SET ARRAY
 22800 200                  IWRK(IPHT  ) = ILAYR
 23000 201                  IWRK(IPHT+ 1) = IP                                     BACK POINTER
 23100 202                  IWRK(IPHT+ 3) = 0
 23200 203                  IWRK(IPHT+ 4) = 0
 23300 204                  IWRK(IPHT+ 5) = 0
 23400 205                  IWRK(IPHT+ 6) = 0
 23500 206                  IWRK(IPHT+ 7) = 0
 23600 207                  IWRK(IPHT+ 8) = 0
 23700 208                  IWRK(IPHT+ 9) = 0
 23800 209                  IWRK(IPHT+10) = 0
 23900 210                  IWRK(IPHT+11) = 0
 24100 211                  IPHT = IPHT + HLDHT                                    INCREASE POINTERS
 24300 212                  JHIT = JHIT + 1                                        INCREASE HIT COUNTER
 24400 213                  IF(ILAYR.NE.ILAY0) MLAY = MLAY + 1
 24500 215                  ILAY0 = ILAYR
 24600 216               CIF
 24700 217            CIF
 24800 218         CFOR
 24900    C
 25100 220         NHIT = JHIT                                                     NUMBER OF HITS
 25300 221         HPHT9 = IPHT - 1                                                SET START + END POINTER IN ARRAY
 25400 222         HPFREE= IPHT
 25500 223         IF MLAY.GE.5
 25600 224         THEN
 25700    C
 25900 227            LBHT = LBHITW                                                CHECK IF AT LEAST 3 ADJACENT HITS
 26000 228            LBAD = 0
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  6
0CARD TARGET
  NO  STM.NO
 
 26100 229            FOR I=1,14
 26200 230               IF LAND(LBHT,7).EQ.7
 26300 231               THEN
 26400 234                  LBAD = 1
 26500 235                  XFOR
 26600 236               CIF
 26700 237               LBHT = SHFTR(LBHT,1)
 26800 238            CFOR
 26900 240            IF LBAD.NE.0
 27000 241            THEN
 27100    C
 27200                                                                             FIND TRACKELEMENT FROM ORIGIN IN CELL
 27400 244               NTRKEL = 0                                                AND CALL TRACE
 27500 245               CALL FTRELO
 27600 246            CIF
 27700 247         CIF
 27800    C
 28000 248         HPFREE = HPFRE0                                                 FREE AREA IN CWORK
 28100 249      CPROC
 28200    C
 28300                                                                             ***************************
 28400                                                                             *      I N A R O U        *
 28600    C                                                                        ***************************
 28800 251      PROC INAROU                                                        INITIALIZE ARRAYS IN OUTPUT AREA
 28900    C
 29100 252         IPJHTL = IDATA(IQJHTL)                                          POINTER TO 'JHTL' + 'PATR'
 29200 253         IPPATR = IDATA(IQPATR)
 29400 254         NBKPAT = 10                                                     GET BANK #
 29500 255         IF(IPPATR.GT.0) NBKPAT = IDATA(IPPATR-2) - 1
 29600 257         NBKHTL = 10
 29700 258         IF(IPJHTL.GT.0) NBKHTL = IDATA(IPJHTL-2) - 1
 29800 260         NBNK = MIN0(10,NBKPAT,NBKHTL)
 29900    C
 30000 261         IZW = NHITJC + 1
 30100 262         CALL CCRE(IPJHTL,JHTL,NBNK,IZW,IERR)
 30200 263         LBRHTL = 0
 30300 264         IF(IERR.NE.0) LBRHTL = 1
 30400    C
 30600 266         IZW = LTRBK*30 + LHEAD                                          INITIALIZE BOS BANK OF 30 TRACKS
 30700 267         CALL CCRE(IPPATR,PATR,NBNK,IZW,IERR)
 30900 268         IF IERR.NE.0 .OR. LBRHTL.NE.0                                   CHECK IF IERR = 0
 31000 269         THEN
 31200 272            WRITE(6,2993) HHEADR(17),HHEADR(18),HHEADR(19),IERR          NOT ENOUGH SPACE FOR 'PATR' BANK
 31300 273            CALL BDLS(PATR,NBNK)
 31400 274            CALL BDLS(JHTL,NBNK)
 31500 275            RETURN
 31600 276         CIF
 31700 277         CALL BSAW(1,PATR)
 31800 278         CALL BSAW(1,JHTL)
 32000 279         IDATA(IPPATR+1) = LHEAD                                         PRESET # OF TRACKS + LENGTH OF TRACK-VECTOR
 32100 280         IDATA(IPPATR+2) = 0
 32200 281         IDATA(IPPATR+3) = LTRBK
 32300 282         IDATA(IPPATR+4) = IDATA(IPJHTL-2)
 32400 283         IDATA(IPPATR+5) = NHITJC
 32500 284         IDATA(IPPATR+6) = NHITJC
 32600 285         IDATA(IPPATR+7) = NHITJC
 32700 286         IDATA(IPPATR+8) = 0
 32800    C
 32900 287      CPROC
 33000    C
 33100                                                                             ***************************
 33200                                                                             *      P R C Y C P        *
 33400    C                                                                        ***************************
 33600 289      PROC PRCYCP                                                        PREPARE CYCLIC POINTER ARRAY
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  7
0CARD TARGET
  NO  STM.NO
 
 33700    C
 33900 290         IPJCA2 = IPJETC*2 + 2                                           ADDRESS OF POINTERS TO CELLS (-1)
 34100 291         IP0 = IPJCA2 + 98                                               COPY CELL POINTERS + CALC. LENGTH
 34200 292         IERRFL = 0
 34300 293         IPCLL = IPJCA2
 34400 294         FOR ICLL=1,96
 34500 295            IPCLL = IPCLL + 1
 34600 296            HPTSEC(ICLL) = HDATA(IPCLL) + IP0
 34700 297            IF(HDATA(IPCLL+1).LT.HDATA(IPCLL)) IERRFL = 1
 34800 299         CFOR
 34900 301         HPTSEC(97) = HDATA(IPCLL+1) + IP0
 35000 302         HPTSEC(98) = 0
 35100    C
 35200 303      CPROC
 35300    C
 35400                                                                             ***************************
 35500                                                                             *      Z R H T L B        *
 35700    C                                                                        ***************************
 35900 305      PROC ZRHTLB                                                        ZERO HIT LABEL ARRAY OF TRACK ELEMENTS
 36000    C
 36100 306         HPHL0 = HPFREE*2 - 1
 36200 307         HLDHL = NHITJC*2
 36300 308         HPHL9 = HPHL0 + HLDHL - 1
 36400 309         NBYTHT = HLDHL*2
 36500 310         ZERO = 0
 36600 311         CALL SETSL(HWRK(HPHL0),0,NBYTHT,ZERO)
 36800 312         HPFREE = HPFREE + NHITJC                                        SET POINTER TO 1. FREE LOCATION IN /CWORK/
 36900    C
 37000 313      CPROC
 37100    C
 37200 315      END
0END OF SEGMENT
0  OPTIONS IN EFFECT - LINECOUNT=64,LINEWIDTH=131,  SOURCE,  FORTRAN  NUMBERING
0   0 ERRORS           0 WARNINGS         314 TARGET STATEMENTS
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  1
0CARD TARGET
  NO  STM.NO
 
0END OF PROGRAM
0  OPTIONS IN EFFECT - LINECOUNT=64,LINEWIDTH=131,  SOURCE,  FORTRAN  NUMBERING
0   0 ERRORS           0 WARNINGS         314 TARGET STATEMENTS
 00000    C   16/12/82 411291851  MEMBER NAME  PATRC1   (PATRECSR)    SHELTRAN
 00100   2      SUBROUTINE PATRC1(IDRENT)
 00200    C
 00300    C     MAIN SUBROUTINE FOR PATREC IN JET CHAMBERS
 00400    C     PETER STEFFEN  6/ 4/79
 00500    C
 00600   3      IMPLICIT INTEGER*2 (H)
 00700   4      LOGICAL TBIT
 00800    C
          C-------------------------------
          C  MACRO CHEADR .... HEADER BANK
          C-------------------------------
         5      COMMON /CHEADR/ IHEADR(54)
         6      INTEGER*2 HHEADR(108)
         7      EQUIVALENCE (IHEADR(1),HHEADR(1))
          C --
          C --  HHEADR(17) = EXPERIMENT NUMBER
          C --  HHEADR(18) = RUN NUMBER
          C --  HHEADR(19) = EVENT NUMBER
          C --  HHEADR(38) = MAGNETIC FIELD (GAUSS)
          C --
          C--------- END OF MACRO CHEADR ------------
          C----------------------------------------------------------------------
          C             MACRO CDATA .... BOS COMMON.
          C
          C             THIS MACRO ONLY DEFINES THE IDATA/HDATA/ADATA NAMES.
          C             THE ACTUAL SIZE OF /BCS/ IS FIXED ON MACRO CBCSMX
          C             OR BY OTHER MEANS. A DEFAULT SIZE OF 40000 IS GIVEN HERE.
          C
          C----------------------------------------------------------------------
          C
         8      COMMON /BCS/ IDATA(40000)
         9      DIMENSION HDATA(80000),ADATA(40000),IPNT(50)
        10      EQUIVALENCE (HDATA(1),IDATA(1),ADATA(1)),(IPNT(1),IDATA(55))
        11      EQUIVALENCE (NWORD,IPNT(50))
          C
          C------------------------ END OF MACRO CDATA --------------------------
          C----------------------------------------------------------------------
          C           MACRO CCYCP .... JET CHAMBER HIT POINTERS (PATREC)
          C----------------------------------------------------------------------
        12      INTEGER*4 HPTSEC
        13      COMMON/CCYCP/HPTSEC(98)
 00016    C     HPTSEC(I) = CDATA POINTER TO 1ST I*2 WORD FOR 1ST HIT OF CELL I
          C------------------------ END OF MACRO CCYCP --------------------------
 01200    C
          C----------------------------------------------
          C  MACRO CWORKPR .... PATTERN RECOGNITION CWORK
          C----------------------------------------------
        14      COMMON /CWORK/ HPLAST,HPFREE,HPWRK(30),ADWRK(600),
               ,               HPRO,HNTR,HNTCEL(98),IPCL(200),NRHT(200),
               ,               NWR1(200),DS1(200),SL1(200),
               ,               NWR2(200),DS2(200),SL2(200),
               ,               LBL(200),NTREL(200),ICRO(200),
               ,               NTR,HNREL(100),HISTR(9,100),HRES(168),
               ,               NTRLM,RLMTR(3,5),
               ,               WRK(7000)
        15      DIMENSION TRKAR(200,11),ITRKAR(200,11),
               ,                         LMRTR(3,5)
        16      EQUIVALENCE (IPCL(1),TRKAR(1,1),ITRKAR(1,1))
        17      EQUIVALENCE (LMRTR(1,1),RLMTR(1,1))
        18      DIMENSION IWRK(7000),HWRK(14000),IDWRK(600),HDWRK(1200)
        19      EQUIVALENCE (IWRK(1),WRK(1),HWRK(1))
        20      EQUIVALENCE (IDWRK(1),ADWRK(1),HDWRK(1))
          C---------- END OF MACRO CWORKPR --------------
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  2
0CARD TARGET
  NO  STM.NO
 
 00100    C-------------------------------------------------------
 00200    C  MACRO CWORKEQ .... PATTERN RECOGNITION CWORK POINTERS
 00300    C-------------------------------------------------------
 00400  21      EQUIVALENCE
 00410    C                POINTERS FOR FXYZ HIT ARRAY .. PRIMARY L/R SOLUTION
 00500         #          (HPHT0,HPWRK( 1)),(HPHT9,HPWRK( 2)),(HLDHT,HPWRK( 3))
 00510    C                POINTERS FOR CWORK SINGLE TRACK PATR BANK
 00600         #         ,(HPTR0,HPWRK( 4)),(HPTR9,HPWRK( 5)),(HLDTR,HPWRK( 6))
 00610    C                POINTERS FOR TRACK ELEMENT HIT LABEL ARRAY
 00700         #         ,(HPHL0,HPWRK( 7)),(HPHL9,HPWRK( 8)),(HLDHL,HPWRK( 9))
 00710    C                POINTERS FOR FXYZ HIT ARRAY .. OPPOSITE L/R SOLUTION
 00800         #         ,(HPHT0A,HPWRK(10)),(HPHT9A,HPWRK(11)),(HLDHTA,HPWRK(12))
 00810    C               POINTER LIMIT ON FXYZ HIT ARRAY
 00900         #         ,(HPHTLM,HPWRK(13))
 00910    C               POINTERS FOR
 01000         #         ,(HPTE0,HPWRK(14)),(HPTE9,HPWRK(15)),(HLDTE,HPWRK(16))
 01100    C-------------- END OF MACRO CWORKEQ ------------------
 01500    C
 01600  22      EQUIVALENCE
 01700         ,           (ICELL ,IDWRK(1)),(NHIT  ,IDWRK(2)),(IRING ,IDWRK(3))
 01800         ,         , (IERRCD,IDWRK(4)),(NTRKEL,IDWRK(5))
 01900         ,         , (ITR   ,IDWRK(7)),(ITRNG ,IDWRK(8))
 02000    C
          C----------------------------------------------
          C  MACRO CPATLM .... PATTERN RECOGNITION LIMITS
          C----------------------------------------------
        23      COMMON /CPATLM/ PATRLM(5),FLINLM(10),TRELLM(20),ZFITLM(10),BKK(20)
               *               ,XYF(20),IGFP(20),XBKK(40),IADMIN(5),YBKK(20)
        24      INTEGER IXYF(20),LMPATR(5),LMFLIN(10)
        25      INTEGER LMTREL(20),LMZFIT(10),IBKK(20)
        26      DIMENSION GFP(20),IXBKK(40),IYBKK(20)
        27      EQUIVALENCE (PATRLM(1),LMPATR(1)),(IXBKK(1),XBKK(1)),(IYBKK(1),
               *YBKK(1))   ,(FLINLM(1),LMFLIN(1)),(TRELLM(1),LMTREL(1))
               *           ,(ZFITLM(1),LMZFIT(1)),(BKK(1),IBKK(1))
               *           ,(XYF(1),IXYF(1)),(GFP(1),IGFP(1)),(IADMIN(1),IMCERT)
               *           ,(IYBKK(20),IPPASS),(IADMIN(2),IPFAST)
          C----------- END OF MACRO CPATLM --------------
 02200    C
 02300  28      COMMON /CLBPGM/ LBPGM(30)
 02400  29      DIMENSION HEARR(30)
 02500    C
 02600  30      DATA HPS /2HPS/
 02700  31      DATA PATR /'PATR'/, LHEAD,LTRBK /8,48/
 02800  32      DATA JHTL /'JHTL'/
 02900  33      DATA JETC /'JETC'/
 03000    C
 03100    C2003 FORMAT(1H0,A4,I6,2(/,1X,24I4),/,1X,50I2,
 03200    C    ,       90(/,1X,2I6,I3,2F10.3,I3,2F10.3,1X,Z4,2I3))
 03300    C2004 FORMAT(1H0,'BACKTR:',5X,20I6)
 03400    C2005 FORMAT(1H ,12X,20I6)
 03500    C2008 FORMAT(' HIT LABEL OF TRELS:',2I6,/,(12X,20(2X,Z4)))
 03600  34 2009 FORMAT('0CHANGE OF POINTERS:',10I8)
 03700  35 2991 FORMAT('0/BCS/ TOO SHORT FOR TRACK BANK; EVENT:',3I6,
 03800         ,       ', IRET=',I2,',NTR,LENGTH=',I3,1X,I4)
 03900  36 2992 FORMAT('0/CWORK/ TOO SHORT FOR PATREC; EVENT:',3I6)
 04000  37 2993 FORMAT('0/BCS/ TOO SHORT FOR PATREC; EVENT:',3I6,' ,IERR=',I2)
 04100  38 2994 FORMAT('0WRONG POINTER IN JETC-BANK; EVENT:',3I6,' ,POINTER:',
 04200         ,        (/,1X,24I5))
 04210    C    ,        /,(1X,24I5))
 04300    C
 04500  39      NTR = 0                                                            INITIALIZE # OF TRACKS
 04600    C
 04800  40      IPJETC = IDATA(IBLN(JETC))                                         SET UP PATR-ARRAY IF NO HITS
 04900  41      IF IPJETC.LE.0
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  3
0CARD TARGET
  NO  STM.NO
 
 05000  42      THEN
 05100  45         IPPATR = IDATA(IBLN(PATR))
 05200  46         IF IPPATR.LE.0
 05300  47         THEN
 05400  50            NBNK = 10
 05500  51            IZW = LHEAD
 05600  52            CALL CCRE(IPPATR,PATR,NBNK,IZW,IERR)
 05800  53            IF(IERR.NE.0) RETURN                                         CHECK IF IERR = 0
 05900  55            CALL BSAW(1,PATR)
 06100  56            IDATA(IPPATR+1) = LHEAD                                      PRESET # OF TRACKS + LENGTH OF TRACK-VECTOR
 06200  57            IDATA(IPPATR+3) = LTRBK
 06300  58         CIF
 06400  59         RETURN
 06500  60      CIF
 06600    C
 06800  61      NHITJC = HDATA(IPJETC*2+99) / 4                                    # OF HITS IN JETC
 06900    C
 07100  62      PERFORM INAROU                                                     INITIALIZE ARRAYS IN OUTPUT AREA
 07200    C
 07400  65      HPFREE = 1                                                         POINTER TO 1. FREE LOC. IN /CWORK/
 07500  66      HPLAST = LMPATR(5)
 07600    C
 07800  67      PERFORM PRCYCP                                                     PREPARE CYCLIC POINTER ARRAY
 08000  70      IF IERRFL.NE.0                                                     CHECK IF POINTERS OK
 08100  71      THEN
 08200  74         I1 = IPJCA2 + 1
 08300  75         I9 = I1 + 97
 08400  76         WRITE(6,2994) HHEADR(17),HHEADR(18),HHEADR(19),
 08500         ,   (HDATA(I),I=I1,I9)
 08600  77         CALL BDLS(PATR,NBNK)
 08700  78         CALL BDLS(JHTL,NBNK)
 08800  79         RETURN
 08900  80      CIF
 09000    C
 09200  81      IF (HPFREE+NHITJC+96*12+10*17 - 1).LT.LMPATR(5)                    CHECK IF ENOUGH SPACE IN /CWORK/
 09300  82      THEN
 09500  85         PERFORM ZRHTLB                                                  ZERO HIT LABEL ARRAY OF TRACK ELEMENTS
 09600  88      ELSE
 09700  90         WRITE(6,2992) HHEADR(17),HHEADR(18),HHEADR(19)
 09800  91         CALL BDLS(PATR,NBNK)
 09900  92         CALL BDLS(JHTL,NBNK)
 10000  93         RETURN
 10100  94      CIF
 10300  95      HPFRE0 = HPFREE                                                    MEMORIZE 1. FREE LOCATION IN CWORK
 10400    C
 10600  96      HPRO = HPS                                                         INITIALISE TRKEL ARRAY FOR TRACING
 10700  97      ITR = 1
 10800  98      IRINGO = 0
 10900    C
 11100  99      JCELL=0                                                            LOOP OVER ALL CELLS
 11200 100      REPEAT
 11300 101         JCELL = JCELL + 1
 11500 102         HNTCEL(JCELL) = ITR                                             ZERO TRACK COUNTER FOR CELL
 11700 103         MHIT = (HPTSEC(JCELL+1)-HPTSEC(JCELL)) / 4                      NUMBER OF HITS IN CELL
 11900 104         IF MHIT.GE.5                                                    CHECK IF AT LEAST NHMIN HITS IN CELL
 12000 105         THEN
 12200 108            IRING = 3                                                    SET RING + CELL NUMBER
 12300 109            IF(JCELL.LE.48) IRING = 2
 12400 111            IF(JCELL.LE.24) IRING = 1
 12600 113            IF IRING.NE.IRINGO                                           RESTART TRACK COUNTING WITH NEW RING
 12700 114            THEN
 12800 117               IRINGO = IRING
 12900 118               ITRNG = 1
 13000 119            CIF
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  4
0CARD TARGET
  NO  STM.NO
 
 13100 120            ICELL = JCELL
 13200    C
 13400 121            IERRCD = 0                                                   INITIALIZE ERR.CODE
 13500    C
 13700 122            HPFREE = HPFRE0                                              SEARCH FOR TRACK ELEMENTS
 13800 123            CALL SRTREL
 13900    C
 14000 124         CIF
 14100 125      UNTIL JCELL.EQ.96
 14200 126      HNTCEL(97) = ITR
 14300 130      HNTR = ITR - 1
 14400    C
 14600    C       I9 = ITR - 1                                                     PRINTOUT
 14700    C       PRINT 2003, HPRO,HNTR,HNTCEL,((TRKAR(I1,I2),I2=1,11),I1=1,I9)
 14800    C       I0 = HPHL0
 14900    C       I9 = HPHL9
 15000    C       PRINT 2008, I0,I9,(HWRK(I1),I1=I0,I9)
 15100    C
 15300 131      HPFREE = HPFRE0                                                    CONNECT TRELS
 15500    C                                                                        INITIALISE DATE
 15700 132      NTR = 0                                                            BACKTRACING IF TRELS
 15800 133      IF(HNTR.GT.0) CALL BACKTR(0,0)
 15900    C         PRINT 2004,NTR, (HNREL(I1),I1=1,NTR)
 16000    C         FOR ITR=1,NTR
 16100    C           NELM = HNREL(ITR)
 16200    C           PRINT 2005, (HISTR(I1,ITR),I1=1,NELM)
 16300    C         CFOR
 16400    C
 16600 135      IF NTR.GT.0                                                        CHECK IF ANY TRACKS
 16700 136      THEN
 16800    C
 17000 139         LENGTR =(NTR+10)*LTRBK                                          SPACE IN BCS FOR UP TO 10 ADDITIONAL TRACKS
 17100 140         CALL BCHM(IPPATR,LENGTR,IRET)
 17300 141         IF IRET.NE.0                                                    CHECK IF ENOUGH SPACE AVAILABLE
 17400 142         THEN
 17500 145            WRITE(6,2991) HHEADR(17),HHEADR(18),HHEADR(19),
 17600         ,      IRET,NTR,LENGTR
 17700 146            NTR = 0
 17800 147            CALL BDLS(PATR,NBNK)
 17900 148            CALL BDLS(JHTL,NBNK)
 18000 149            RETURN
 18100 150         CIF
 18300 151         IPJETC = IDATA(IBLN(JETC))                                      CHECK IF POINTERS HAVE CHANGED
 18400 152         IP0 = IPJETC*2 + 101
 18500 153         IF IP0.NE.HPTSEC(1)
 18600 154         THEN
 18700 157            PRINT 2009, IPJETC,IP0,HPTSEC(1)
 18800 158            PERFORM PRCYCP
 18900 161         CIF
 19000 162      CIF
 19100    C
 19200 163      RETURN
 19300    C
 19400                                                                             ***************************
 19500                                                                             *      I N A R O U        *
 19700    C                                                                        ***************************
 19900 164      PROC INAROU                                                        INITIALIZE ARRAYS IN OUTPUT AREA
 20000    C
 20200 165         IPJHTL = IDATA(IBLN(JHTL))                                      POINTER TO 'JHTL' + 'PATR'
 20300 166         IPPATR = IDATA(IBLN(PATR))
 20500 167         NBKPAT = 10                                                     GET BANK #
 20600 168         IF(IPPATR.GT.0) NBKPAT = IDATA(IPPATR-2) - 1
 20700 170         NBKHTL = 10
 20800 171         IF(IPJHTL.GT.0) NBKHTL = IDATA(IPJHTL-2) - 1
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  5
0CARD TARGET
  NO  STM.NO
 
 20900 173         NBNK = MIN0(10,NBKPAT,NBKHTL)
 21100 174         IF IPJHTL.EQ.0 .OR. IDRENT.EQ.0                                 CHECK IF HIT LABEL EXISTING
 21200 175         THEN
 21300 178            IZW = NHITJC + 1
 21400 179            CALL CCRE(IPJHTL,JHTL,NBNK,IZW,IERR)
 21500 180            LBRHTL = 0
 21600 181            IF(IERR.NE.0) LBRHTL = 1
 21700 183         CIF
 21800    C
 22000 184         IF IPPATR.EQ.0 .OR. IDRENT.EQ.0                                 INITIALIZE BOS BANK OF TRACKS
 22100 185         THEN
 22200 188            IZW = LHEAD
 22300 189            CALL CCRE(IPPATR,PATR,NBNK,IZW,IERR)
 22500 190            IF IERR.NE.0 .OR. LBRHTL.NE.0                                CHECK IF IERR = 0
 22600 191            THEN
 22800 194               WRITE(6,2993) HHEADR(17),HHEADR(18),HHEADR(19),IERR       NOT ENOUGH SPACE FOR 'PATR' BANK
 22900 195               CALL BDLS(PATR,NBNK)
 23000 196               CALL BDLS(JHTL,NBNK)
 23100 197               RETURN
 23200 198            CIF
 23300 199            CALL BSAW(1,PATR)
 23400 200            CALL BSAW(1,JHTL)
 23600 201            IDATA(IPPATR+1) = LHEAD                                      PRESET # OF TRACKS + LENGTH OF TRACK-VECTOR
 23700 202            IDATA(IPPATR+2) = 0
 23800 203            IDATA(IPPATR+3) = LTRBK
 23900 204            IDATA(IPPATR+4) = IDATA(IPJHTL-2)
 24000 205            IDATA(IPPATR+5) = NHITJC
 24100 206            IDATA(IPPATR+6) = NHITJC
 24200 207            IDATA(IPPATR+7) = NHITJC
 24300 208            IDATA(IPPATR+8) = 0
 24500 209         ELSE                                                            HIT LABEL BANK EXISTS + SHALL BE EXTENDED
 24700 211            CALL CMVE(IPPATR,IERR)                                       MOVE TRACK BANK TO END
 24800 212         CIF
 24900    C
 25000 213      CPROC
 25100    C
 25200                                                                             ***************************
 25300                                                                             *      P R C Y C P        *
 25500    C                                                                        ***************************
 25700 215      PROC PRCYCP                                                        PREPARE CYCLIC POINTER ARRAY
 25800    C
 26000 216         IPJCA2 = IPJETC*2 + 2                                           ADDRESS OF POINTERS TO CELLS (-1)
 26200 217         IP0 = IPJCA2 + 98                                               COPY CELL POINTERS + CALC. LENGTH
 26300 218         IERRFL = 0
 26400 219         IPCLL = IPJCA2
 26500 220         FOR ICLL=1,96
 26600 221            IPCLL = IPCLL + 1
 26700 222            HPTSEC(ICLL) = HDATA(IPCLL) + IP0
 26800 223            IF(HDATA(IPCLL+1).LT.HDATA(IPCLL)) IERRFL = 1
 26900 225         CFOR
 27000 227         HPTSEC(97) = HDATA(IPCLL+1) + IP0
 27100 228         HPTSEC(98) = 0
 27200    C
 27300 229      CPROC
 27400    C
 27500                                                                             ***************************
 27600                                                                             *      Z R H T L B        *
 27800    C                                                                        ***************************
 28000 231      PROC ZRHTLB                                                        ZERO HIT LABEL ARRAY OF TRACK ELEMENTS
 28100    C
 28200 232         HPHL0 = HPFREE*2 - 1
 28300 233         HLDHL = NHITJC*2
 28400 234         HPHL9 = HPHL0 + HLDHL - 1
 28500 235         NBYTHT = HLDHL*2
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  6
0CARD TARGET
  NO  STM.NO
 
 28600 236         ZERO = 0
 28700 237         CALL SETSL(HWRK(HPHL0),0,NBYTHT,ZERO)
 28900 238         HPFREE = HPFREE + NHITJC                                        SET POINTER TO 1. FREE LOCATION IN /CWORK/
 29000    C
 29100 239      CPROC
 29200    C
 29300 241      END
0END OF SEGMENT
0  OPTIONS IN EFFECT - LINECOUNT=64,LINEWIDTH=131,  SOURCE,  FORTRAN  NUMBERING
0   0 ERRORS           0 WARNINGS         240 TARGET STATEMENTS
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  1
0CARD TARGET
  NO  STM.NO
 
0END OF PROGRAM
0  OPTIONS IN EFFECT - LINECOUNT=64,LINEWIDTH=131,  SOURCE,  FORTRAN  NUMBERING
0   0 ERRORS           0 WARNINGS         240 TARGET STATEMENTS
 00000    C   08/12/80 102191200  MEMBER NAME  PATREC   (PATRECSR)    SHELTRAN
 00001   2      SUBROUTINE PATREC(IDRENT)
 00002    C
 00003    C     MAIN SUBROUTINE FOR PATREC IN JET CHAMBERS
 00004    C     PETER STEFFEN  6/ 4/79
 00005    C
 00006   3      IMPLICIT INTEGER*2 (H)
 00007   4      LOGICAL TBIT
          C----------------------------------------------
          C  MACRO CWORKPR .... PATTERN RECOGNITION CWORK
          C----------------------------------------------
         5      COMMON /CWORK/ HPLAST,HPFREE,HPWRK(30),ADWRK(600),
               ,               HPRO,HNTR,HNTCEL(98),IPCL(200),NRHT(200),
               ,               NWR1(200),DS1(200),SL1(200),
               ,               NWR2(200),DS2(200),SL2(200),
               ,               LBL(200),NTREL(200),ICRO(200),
               ,               NTR,HNREL(100),HISTR(9,100),HRES(168),
               ,               NTRLM,RLMTR(3,5),
               ,               WRK(7000)
         6      DIMENSION TRKAR(200,11),ITRKAR(200,11),
               ,                         LMRTR(3,5)
         7      EQUIVALENCE (IPCL(1),TRKAR(1,1),ITRKAR(1,1))
         8      EQUIVALENCE (LMRTR(1,1),RLMTR(1,1))
         9      DIMENSION IWRK(7000),HWRK(14000),IDWRK(600),HDWRK(1200)
        10      EQUIVALENCE (IWRK(1),WRK(1),HWRK(1))
        11      EQUIVALENCE (IDWRK(1),ADWRK(1),HDWRK(1))
          C---------- END OF MACRO CWORKPR --------------
 00100    C-------------------------------------------------------
 00200    C  MACRO CWORKEQ .... PATTERN RECOGNITION CWORK POINTERS
 00300    C-------------------------------------------------------
 00400  12      EQUIVALENCE
 00410    C                POINTERS FOR FXYZ HIT ARRAY .. PRIMARY L/R SOLUTION
 00500         #          (HPHT0,HPWRK( 1)),(HPHT9,HPWRK( 2)),(HLDHT,HPWRK( 3))
 00510    C                POINTERS FOR CWORK SINGLE TRACK PATR BANK
 00600         #         ,(HPTR0,HPWRK( 4)),(HPTR9,HPWRK( 5)),(HLDTR,HPWRK( 6))
 00610    C                POINTERS FOR TRACK ELEMENT HIT LABEL ARRAY
 00700         #         ,(HPHL0,HPWRK( 7)),(HPHL9,HPWRK( 8)),(HLDHL,HPWRK( 9))
 00710    C                POINTERS FOR FXYZ HIT ARRAY .. OPPOSITE L/R SOLUTION
 00800         #         ,(HPHT0A,HPWRK(10)),(HPHT9A,HPWRK(11)),(HLDHTA,HPWRK(12))
 00810    C               POINTER LIMIT ON FXYZ HIT ARRAY
 00900         #         ,(HPHTLM,HPWRK(13))
 00910    C               POINTERS FOR
 01000         #         ,(HPTE0,HPWRK(14)),(HPTE9,HPWRK(15)),(HLDTE,HPWRK(16))
 01100    C-------------- END OF MACRO CWORKEQ ------------------
          C----------------------------------------------------------------------
          C             MACRO CDATA .... BOS COMMON.
          C
          C             THIS MACRO ONLY DEFINES THE IDATA/HDATA/ADATA NAMES.
          C             THE ACTUAL SIZE OF /BCS/ IS FIXED ON MACRO CBCSMX
          C             OR BY OTHER MEANS. A DEFAULT SIZE OF 40000 IS GIVEN HERE.
          C
          C----------------------------------------------------------------------
          C
        13      COMMON /BCS/ IDATA(40000)
        14      DIMENSION HDATA(80000),ADATA(40000),IPNT(50)
        15      EQUIVALENCE (HDATA(1),IDATA(1),ADATA(1)),(IPNT(1),IDATA(55))
        16      EQUIVALENCE (NWORD,IPNT(50))
          C
          C------------------------ END OF MACRO CDATA --------------------------
 00011  17      COMMON /CHEADR/ IHEADR(54)
 00012  18      DIMENSION HEARR(200)
 00013    C
 00015  19      DATA LBINIT /0/                                                    INITIALIZE POINTERS
 00016  20      IF LBINIT .EQ. 0
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  2
0CARD TARGET
  NO  STM.NO
 
 00017  21      THEN
 00018  24         LBINIT = 0
 00019  25         IQPATR = IBLN('PATR')
 00020  26         IQJHTL = IBLN('JHTL')
 00021  27         IQJETC = IBLN('JETC')
 00022  28         IQHEAD = IBLN('HEAD')
 00023  29      CIF
 00024    C
 00025  30      IPHEAD=IDATA(IQHEAD)
 00026  31      IF(IPHEAD.GE.1) CALL MVCL(IHEADR(1),0,IDATA(IPHEAD-3),0,216)
 00027    C
 00029  33      CALL PATRC1(IDRENT)                                                PATREC UPT TO BACKTR
 00030    C
 00032  34      IF NTR.GT.0                                                        CONTINUE WITH ANALYSIS
 00033  35      THEN
 00034  38         FOR IMO=1,NTR
 00035  39            HEARR(IMO)=IMO
 00036  40         CFOR
 00037  42         ITRK=NTR
 00039  43         NTRLM = 0                                                       NO LIMITS IN RADIUS FOR PATROL
 00041  44         CALL KNTREL(HEARR,ITRK)                                         FIT TRACKS, FILL 'PATR', ADMINISTRATION
 00042    C
 00043  45      CIF
 00044    C
 00045  46      RETURN
 00046    C
 00047  47      END
0END OF SEGMENT
0  OPTIONS IN EFFECT - LINECOUNT=64,LINEWIDTH=131,  SOURCE,  FORTRAN  NUMBERING
0   0 ERRORS           0 WARNINGS          46 TARGET STATEMENTS
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  1
0CARD TARGET
  NO  STM.NO
 
0END OF PROGRAM
0  OPTIONS IN EFFECT - LINECOUNT=64,LINEWIDTH=131,  SOURCE,  FORTRAN  NUMBERING
0   0 ERRORS           0 WARNINGS          46 TARGET STATEMENTS
 00000    C   13/01/82            MEMBER NAME  PRHTAR   (PATRECSR)    SHELTRAN
 00100    C   24/03/80 201111011  MEMBER NAME  ORPRHTAR (JADESR)      SHELTRAN
 00200    C   10/09/79 C9091001   MEMBER NAME  PRHTAR9  (JADESR)      SHELTRAN
 00300    C   13/03/79 C9062901   MEMBER NAME  ORPRHTAR (JADESR)      SHELTRAN
 00400    C   13/03/79            MEMBER NAME  PRHTARP8 (JADESR)      SHELTRAN
 00500   2      SUBROUTINE PRHTAR
 00600    C
 00700    C     GENERATE ARRAY OF HITS FROM ONE CELL: P.STEFFEN(78/11/15)
 00800    C
 00900   3      IMPLICIT INTEGER*2 (H)
 01000    C
          C----------------------------------------------------------------------
          C             MACRO CDATA .... BOS COMMON.
          C
          C             THIS MACRO ONLY DEFINES THE IDATA/HDATA/ADATA NAMES.
          C             THE ACTUAL SIZE OF /BCS/ IS FIXED ON MACRO CBCSMX
          C             OR BY OTHER MEANS. A DEFAULT SIZE OF 40000 IS GIVEN HERE.
          C
          C----------------------------------------------------------------------
          C
         4      COMMON /BCS/ IDATA(40000)
         5      DIMENSION HDATA(80000),ADATA(40000),IPNT(50)
         6      EQUIVALENCE (HDATA(1),IDATA(1),ADATA(1)),(IPNT(1),IDATA(55))
         7      EQUIVALENCE (NWORD,IPNT(50))
          C
          C------------------------ END OF MACRO CDATA --------------------------
          C----------------------------------------------------------------------
          C           MACRO CCYCP .... JET CHAMBER HIT POINTERS (PATREC)
          C----------------------------------------------------------------------
         8      INTEGER*4 HPTSEC
         9      COMMON/CCYCP/HPTSEC(98)
 00016    C     HPTSEC(I) = CDATA POINTER TO 1ST I*2 WORD FOR 1ST HIT OF CELL I
          C------------------------ END OF MACRO CCYCP --------------------------
 01300    C
          C----------------------------------------------
          C  MACRO CWORKPR .... PATTERN RECOGNITION CWORK
          C----------------------------------------------
        10      COMMON /CWORK/ HPLAST,HPFREE,HPWRK(30),ADWRK(600),
               ,               HPRO,HNTR,HNTCEL(98),IPCL(200),NRHT(200),
               ,               NWR1(200),DS1(200),SL1(200),
               ,               NWR2(200),DS2(200),SL2(200),
               ,               LBL(200),NTREL(200),ICRO(200),
               ,               NTR,HNREL(100),HISTR(9,100),HRES(168),
               ,               NTRLM,RLMTR(3,5),
               ,               WRK(7000)
        11      DIMENSION TRKAR(200,11),ITRKAR(200,11),
               ,                         LMRTR(3,5)
        12      EQUIVALENCE (IPCL(1),TRKAR(1,1),ITRKAR(1,1))
        13      EQUIVALENCE (LMRTR(1,1),RLMTR(1,1))
        14      DIMENSION IWRK(7000),HWRK(14000),IDWRK(600),HDWRK(1200)
        15      EQUIVALENCE (IWRK(1),WRK(1),HWRK(1))
        16      EQUIVALENCE (IDWRK(1),ADWRK(1),HDWRK(1))
          C---------- END OF MACRO CWORKPR --------------
 00100    C-------------------------------------------------------
 00200    C  MACRO CWORKEQ .... PATTERN RECOGNITION CWORK POINTERS
 00300    C-------------------------------------------------------
 00400  17      EQUIVALENCE
 00410    C                POINTERS FOR FXYZ HIT ARRAY .. PRIMARY L/R SOLUTION
 00500         #          (HPHT0,HPWRK( 1)),(HPHT9,HPWRK( 2)),(HLDHT,HPWRK( 3))
 00510    C                POINTERS FOR CWORK SINGLE TRACK PATR BANK
 00600         #         ,(HPTR0,HPWRK( 4)),(HPTR9,HPWRK( 5)),(HLDTR,HPWRK( 6))
 00610    C                POINTERS FOR TRACK ELEMENT HIT LABEL ARRAY
 00700         #         ,(HPHL0,HPWRK( 7)),(HPHL9,HPWRK( 8)),(HLDHL,HPWRK( 9))
 00710    C                POINTERS FOR FXYZ HIT ARRAY .. OPPOSITE L/R SOLUTION
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  2
0CARD TARGET
  NO  STM.NO
 
 00800         #         ,(HPHT0A,HPWRK(10)),(HPHT9A,HPWRK(11)),(HLDHTA,HPWRK(12))
 00810    C               POINTER LIMIT ON FXYZ HIT ARRAY
 00900         #         ,(HPHTLM,HPWRK(13))
 00910    C               POINTERS FOR
 01000         #         ,(HPTE0,HPWRK(14)),(HPTE9,HPWRK(15)),(HLDTE,HPWRK(16))
 01100    C-------------- END OF MACRO CWORKEQ ------------------
 01600    C
 01700  18      EQUIVALENCE
 01800         ,            (ICELL,IDWRK(1)),(NHIT,IDWRK(2)),(IRING,IDWRK(3))
 01900    C
 00100    C-----------------------------------------------------------------------
 00200    C                            MACRO CJDRCH .... JET CHAMBER CONSTANTS.
 00300    C-----------------------------------------------------------------------
 00310    C
 00400  19      COMMON / CJDRCH / RDEC(4),PSIIN(3),RINCR(3),FIRSTW(3),FSENSW(3),
 00500         +                  RDEPTH,SWDEPL,YSUSPN,TIMDEL(2,3),ZMAX,ZOFFS,
 00510         +                  ZRESOL,ZNORM,ZAL,ZSCAL,DRIDEV,DRICOS,DRISIN,
 00600         +                  PEDES,TZERO(3),DRIROT(96,2),SINDRI(96,2),
 00701         +                  COSDRI(96,2),DRIVEL(96,2),T0FIX(3),
 00800         +                  ABERR(8), DUMJDC(20)
 00900    C
 01100    C      BLOCK DATA SET TO MC VALUES, KALIBR WILL SET REAL DATA VALUES
 01210    C--->  A CHANGE OF THIS COMMON MUST BE DONE SIMULTANEOUSLY WITH  <----
 01220    C--->  A CHANGE OF THE BLOCK DATA                                <----
 01230    C
 01300    C--------------------------- END OF MACRO CJDRCH -----------------------
 01400    C
 02100    C
 02300  20      DATA LBINIT /0/                                                    INITIALIZE POINTERS
 02400  21      IF LBINIT .EQ. 0
 02500  22      THEN
 02600  25         LBINIT = 0
 02700  26         IQJHTL = IBLN('JHTL')
 02800    C       CONST. FOR VAR. OF DRIFT VEL.
 02900  27         DSD0   =-.63
 03000  28         DSD1   = 1.8
 03100  29         DSD2   = 4.0
 03200  30         DRV0   = 0.8
 03300  31         DRV1   = (DSD2 - (DSD1-DSD0)*DRV0) / (DSD2-DSD1)
 03400  32      CIF
 03500    C
 03700  33      DSBIN1 = TIMDEL(1,IRING)                                           SET DRIFT SPACE BIN
 03800  34      DSBIN2 = TIMDEL(2,IRING)
 04000  35      IP0 = HPTSEC(ICELL)                                                START POINTER OF CELL
 04200  36      IP9 = HPTSEC(ICELL+1) - 1                                          END POINTER OF CELL
 04400  37      IPHL = (HPTSEC(ICELL)-HPTSEC(1))/4 + IDATA(IQJHTL) + 1             START POINTER TO HIT LABEL ARRAY -1
 04600  38      HPHT0 = HPFREE                                                     POINTER OF NEW HIT ARRAY
 04700  39      HLDHT = 12
 04800  40      IPHT  = HPHT0
 05000  41      JHIT = 0                                                           COUNTER FOR NUMBER OF HITS IN HIT ARRAY
 05100  42      NWRD2 = NWORD*2
 05300  43      FOR IP=IP0,IP9,4                                                   LOOP OVER ALL HITS OF CELL
 05400  44         IPHL = IPHL + 1
 05500  45         IF IDATA(IPHL).EQ.0
 05600  46         THEN
 05700  49            IF HDATA(IP+1).GT.0 .AND. HDATA(IP+2).GT.0
 05800  50            THEN
 05900  53               IWIR = HDATA(IP)
 06000  54               IWIR = SHFTR(IWIR,3)
 06200  55               ILAYR = LAND(IWIR,15)                                     LAYER NUMBER WITHIN RING 3
 06400  56               IF(ILAYR.GE.8) DSBIN1 = DSBIN2                            CHANGE DRIFT SPACE BIN FOR 8 HIGHER LAYERS
 06600  58               DS =(HDATA(IP+3)) * DSBIN1                                DRIFT SPACE
 06700  59               IF DS.LT.4.0
 06800  60               THEN
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  3
0CARD TARGET
  NO  STM.NO
 
 06900  63                  IF DS.GT.DSD1
 07000  64                  THEN
 07100  67                     DS = (DSD1-DSD0)*DRV0 + (DS-DSD1)*DRV1
 07200  68                  ELSE
 07300  70                     DS = (DS-DSD0)*DRV0
 07400  71                  CIF
 07500  72                  IF(DS.LT.0.1) DS = 0.1
 07600  74               CIF
 07800  75               WRK(IPHT+2)  = AMAX1(DS,0.)                               SET ARRAY
 07900  76               IWRK(IPHT  ) = ILAYR
 08100  77               IWRK(IPHT+1) = IP                                         BACK POINTER
 08200  78               IWRK(IPHT+4) = 0
 08300  79               IWRK(IPHT+5) = 0
 08400  80               IWRK(IPHT+6) = 0
 08500  81               IWRK(IPHT+7) = 0
 08700  82               IPHT = IPHT + HLDHT                                       INCREASE POINTERS
 08900  83               JHIT = JHIT + 1                                           INCREASE HIT COUNTER
 09000  84            CIF
 09100  85         CIF
 09200  86      CFOR
 09300    C
 09500  88      NHIT = JHIT                                                        NUMBER OF HITS
 09700  89      HPHT9 = IPHT - 1                                                   SET START + END POINTER IN ARRAY
 09800  90      HPFREE= IPHT
 09900    C
 10000  91      RETURN
 10100  92      END
0END OF SEGMENT
0  OPTIONS IN EFFECT - LINECOUNT=64,LINEWIDTH=131,  SOURCE,  FORTRAN  NUMBERING
0   0 ERRORS           0 WARNINGS          91 TARGET STATEMENTS
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  1
0CARD TARGET
  NO  STM.NO
 
0END OF PROGRAM
0  OPTIONS IN EFFECT - LINECOUNT=64,LINEWIDTH=131,  SOURCE,  FORTRAN  NUMBERING
0   0 ERRORS           0 WARNINGS          91 TARGET STATEMENTS
 00000    C   18/01/80 102270037  MEMBER NAME  PRXYTR   (PATRECSR)    SHELTRAN
 00001   2      SUBROUTINE PRXYTR
 00002    C
 00003   3      IMPLICIT INTEGER*2 (H)
 00004   4      LOGICAL TBIT
 00005    C
 00006    C     SUBROUTINE TO CALCULATE COORDINATES (X,Y) OF ALL TRKEL'S
 00007    C     AUTHOR: P. STEFFEN(78/11/21)
 00008    C
 00009    C     RESULTS ARE PLACED IN COMMON/CWORK/ VIZ.
 00010    C     IHIT = TOTAL NUMBER OF HITS ON TRACK
 00011    C     FIRST HIT STARTS IN LOCATION WRK(HPTE0) WHERE IPTR0 IS DEFINED
 00012    C     BY THE CALLING ROUTINE.
 00013    C
 00014    C     FOR EACH TRKEL THESE WORDS CONTAIN THE FOLLOWING INFORMATION
 00015    C
 00016    C     IWRK(IPTR   )  = CELL #
 00017    C     IWRK(IPTR+ 1)  = TRKEL #
 00018    C     IWRK(IPTR+ 2)  = # OF HITS OF TRKEL
 00019    C     WRK (IPTR+ 3)  = X COORD. AT START (L)
 00020    C     WRK (IPTR+ 4)  = Y COORD. AT START (L)
 00021    C     WRK (IPTR+ 5)  = X-DIR. AT START   (L)
 00022    C     WRK (IPTR+ 6)  = Y-DIR. AT START   (L)
 00023    C     WRK (IPTR+ 7)  = X COORD. AT START (R)
 00024    C     WRK (IPTR+ 8)  = Y COORD. AT START (R)
 00025    C     WRK (IPTR+ 9)  = X-DIR. AT START   (R)
 00026    C     WRK (IPTR+10)  = Y-DIR. AT START   (R)
 00027    C     WRK (IPTR+11)  = X COORD. AT END   (L)
 00028    C     WRK (IPTR+12)  = Y COORD. AT END   (L)
 00029    C     WRK (IPTR+13)  = X-DIR. AT END     (L)
 00030    C     WRK (IPTR+14)  = Y-DIR. AT END     (L)
 00031    C     WRK (IPTR+15)  = X COORD. AT END   (R)
 00032    C     WRK (IPTR+16)  = Y COORD. AT END   (R)
 00033    C     WRK (IPTR+17)  = X-DIR. AT END     (R)
 00034    C     WRK (IPTR+18)  = Y-DIR. AT END     (R)
 00035    C     WRK (IPTR+19)  = LABEL
 00036    C     WRK (IPTR+20)  = # OF DOWN-CONNECT.
 00037    C     WRK (IPTR+21)  = # OF UP-CONNECT.
 00038    C     WRK (IPTR+22)  = POINTER TO DOWN-CONNECT.
 00039    C     WRK (IPTR+23)  = ...
 00040    C     WRK (IPTR+24)  = ...
 00041    C     WRK (IPTR+25)  = ...
 00042    C     WRK (IPTR+26)  = POINTER TO UP-CONNECT.
 00043    C     WRK (IPTR+27)  = ...
 00044    C     WRK (IPTR+28)  = ...
 00045    C     WRK (IPTR+29)  = ...
 00046    C
 00047    C-----------------------------------------------------------------------
 00048    C
 00100    C-----------------------------------------------------------------------
 00200    C                            MACRO CJDRCH .... JET CHAMBER CONSTANTS.
 00300    C-----------------------------------------------------------------------
 00310    C
 00400   5      COMMON / CJDRCH / RDEC(4),PSIIN(3),RINCR(3),FIRSTW(3),FSENSW(3),
 00500         +                  RDEPTH,SWDEPL,YSUSPN,TIMDEL(2,3),ZMAX,ZOFFS,
 00510         +                  ZRESOL,ZNORM,ZAL,ZSCAL,DRIDEV,DRICOS,DRISIN,
 00600         +                  PEDES,TZERO(3),DRIROT(96,2),SINDRI(96,2),
 00701         +                  COSDRI(96,2),DRIVEL(96,2),T0FIX(3),
 00800         +                  ABERR(8), DUMJDC(20)
 00900    C
 01100    C      BLOCK DATA SET TO MC VALUES, KALIBR WILL SET REAL DATA VALUES
 01210    C--->  A CHANGE OF THIS COMMON MUST BE DONE SIMULTANEOUSLY WITH  <----
 01220    C--->  A CHANGE OF THE BLOCK DATA                                <----
 01230    C
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  2
0CARD TARGET
  NO  STM.NO
 
 01300    C--------------------------- END OF MACRO CJDRCH -----------------------
 01400    C
 00050    C
          C----------------------------------------------
          C  MACRO CWORKPR .... PATTERN RECOGNITION CWORK
          C----------------------------------------------
         6      COMMON /CWORK/ HPLAST,HPFREE,HPWRK(30),ADWRK(600),
               ,               HPRO,HNTR,HNTCEL(98),IPCL(200),NRHT(200),
               ,               NWR1(200),DS1(200),SL1(200),
               ,               NWR2(200),DS2(200),SL2(200),
               ,               LBL(200),NTREL(200),ICRO(200),
               ,               NTR,HNREL(100),HISTR(9,100),HRES(168),
               ,               NTRLM,RLMTR(3,5),
               ,               WRK(7000)
         7      DIMENSION TRKAR(200,11),ITRKAR(200,11),
               ,                         LMRTR(3,5)
         8      EQUIVALENCE (IPCL(1),TRKAR(1,1),ITRKAR(1,1))
         9      EQUIVALENCE (LMRTR(1,1),RLMTR(1,1))
        10      DIMENSION IWRK(7000),HWRK(14000),IDWRK(600),HDWRK(1200)
        11      EQUIVALENCE (IWRK(1),WRK(1),HWRK(1))
        12      EQUIVALENCE (IDWRK(1),ADWRK(1),HDWRK(1))
          C---------- END OF MACRO CWORKPR --------------
 00100    C-------------------------------------------------------
 00200    C  MACRO CWORKEQ .... PATTERN RECOGNITION CWORK POINTERS
 00300    C-------------------------------------------------------
 00400  13      EQUIVALENCE
 00410    C                POINTERS FOR FXYZ HIT ARRAY .. PRIMARY L/R SOLUTION
 00500         #          (HPHT0,HPWRK( 1)),(HPHT9,HPWRK( 2)),(HLDHT,HPWRK( 3))
 00510    C                POINTERS FOR CWORK SINGLE TRACK PATR BANK
 00600         #         ,(HPTR0,HPWRK( 4)),(HPTR9,HPWRK( 5)),(HLDTR,HPWRK( 6))
 00610    C                POINTERS FOR TRACK ELEMENT HIT LABEL ARRAY
 00700         #         ,(HPHL0,HPWRK( 7)),(HPHL9,HPWRK( 8)),(HLDHL,HPWRK( 9))
 00710    C                POINTERS FOR FXYZ HIT ARRAY .. OPPOSITE L/R SOLUTION
 00800         #         ,(HPHT0A,HPWRK(10)),(HPHT9A,HPWRK(11)),(HLDHTA,HPWRK(12))
 00810    C               POINTER LIMIT ON FXYZ HIT ARRAY
 00900         #         ,(HPHTLM,HPWRK(13))
 00910    C               POINTERS FOR
 01000         #         ,(HPTE0,HPWRK(14)),(HPTE9,HPWRK(15)),(HLDTE,HPWRK(16))
 01100    C-------------- END OF MACRO CWORKEQ ------------------
 00053    C
          C----------------------------------------------------------------------
          C           MACRO CDSMAX .... PATTERN RECOGNITION CONSTANTS.
          C----------------------------------------------------------------------
        14      COMMON/CDSMAX/DSMAX(16,3,2),DIRWR1(24,2),DIRWR3(48,2)
               *             ,DHALF(16,3,2),DTWICE(16,3,2),HMCH(16,3,2)
               *             ,IBCK(9),DBCK(30),TRMATS(96,2),TRMATC(96,2)
          C------------------------ END OF MACRO CDSMAX -------------------------
 00055    C
 00056    C
 00058  15      IPTR  = HPFREE                                                     POINTER TO TREL + LENGTH OF VECTOR
 00059  16      HPTE0 = HPFREE
 00060    C     HLDTE = 38
 00062  17      NBYTE = HLDTE*HNTR*4                                               INITIALIZE ARRAY TO ZERO
 00063  18      CALL SETSL(IWRK(IPTR),0,NBYTE,0)
 00064    C     PRINT 2902, TRMATS,TRMATL
 00065    C2902 FORMAT(' LORANG:',24F5.2)
 00066    C
 00068  19      FOR ITREL=1,HNTR                                                   LOOP OVER ALL TREL'S
 00070  20         JCELL = ITRKAR(ITREL,1)                                         CELL #
 00071  21         IWRK(IPTR   ) = JCELL
 00072  22         IWRK(IPTR+ 1) = ITREL
 00073  23         IWRK(IPTR+ 2) = ITRKAR(ITREL, 2)
 00074  24         IWRK(IPTR+19) = ITRKAR(ITREL, 9)
 00075    C
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  3
0CARD TARGET
  NO  STM.NO
 
 00077    C                                                                        DIRECTIONS OF WIRE PLANE + DRIFT SPACE
 00078  25         IF JCELL.LE.24
 00080  26         THEN                                                            RING 1
 00081  29            JRING = 1
 00082  30            DXWR=DIRWR1(JCELL  ,1)
 00083  31            DYWR=DIRWR1(JCELL  ,2)
 00084  32            TRLOXL=TRMATS(JCELL  ,1)
 00085  33            TRLOYL=TRMATC(JCELL  ,1)
 00086  34            TRLOXR=TRMATS(JCELL  ,2)
 00087  35            TRLOYR=TRMATC(JCELL  ,2)
 00088  36         ELSE
 00089  38            IF JCELL.LE.48
 00091  39            THEN                                                         RING2
 00092  42               JRING = 2
 00093  43               DXWR=DIRWR1(JCELL-24,1)
 00094  44               DYWR=DIRWR1(JCELL-24,2)
 00095  45               TRLOXL=TRMATS(JCELL  ,1)
 00096  46               TRLOYL=TRMATC(JCELL  ,1)
 00097  47               TRLOXR=TRMATS(JCELL  ,2)
 00098  48               TRLOYR=TRMATC(JCELL  ,2)
 00100  49            ELSE                                                         RING3
 00101  51               JRING = 3
 00102  52               DXWR=DIRWR3(JCELL-48,1)
 00103  53               DYWR=DIRWR3(JCELL-48,2)
 00104  54               TRLOXL=TRMATS(JCELL  ,1)
 00105  55               TRLOYL=TRMATC(JCELL  ,1)
 00106  56               TRLOXR=TRMATS(JCELL  ,2)
 00107  57               TRLOYR=TRMATC(JCELL  ,2)
 00108  58            CIF
 00109  59         CIF
 00110    C
 00112  60         R0 = FSENSW(JRING)                                              LOAD RADIUS AND WIRE SPACING
 00113  61         DR0= RINCR (JRING)
 00115  62         DRC = DR0*.5                                                    RADIUS AROUND WIRE FOR CORR. OF DRIFTSPACE
 00116    C
 00118    C                                                                        START OF TREL
 00120  63         ILAYR = ITRKAR(ITREL,3)                                         LAYER #
 00122  64         DRSP1 = TRKAR(ITREL,4)                                          DRIFT SPACE
 00123  65         DRSP2 = DRSP1 + TRKAR(ITREL,5)
 00125  66         IF DRSP1.LT.DRC .AND. ABS(DRSP2-DRSP1).GE.DRC                   CHECK IF SLOPE > 1. CLOSE TO ZERO
 00126  67         THEN
 00128  70            DWIR = ITRKAR(ITREL,6)-ILAYR                                 MOVE 1. POINT 1 LAYER UP
 00129  71            CRV  = 0.
 00130  72            IF(DWIR.GT.0.) CRV = (TRKAR(ITREL,8)-TRKAR(ITREL,5))/DWIR
 00131  74            SLOPE = CRV*.5 + DRSP2-DRSP1
 00132  75            DRSP1 = DRSP1 + SLOPE
 00133  76            DRSP2 = CRV*.5 + SLOPE + DRSP1
 00134  77            ILAYR = ILAYR + 1
 00135  78         CIF
 00136    C
 00138  79         R1 = R0 + DR0*ILAYR                                             POSITION OF SENSE WIRE
 00139  80         R2 = R1 + DR0
 00140  81         X1 = R1*DXWR
 00141  82         X2 = R2*DXWR
 00142  83         Y1 = R1*DYWR
 00143  84         Y2 = R2*DYWR
 00144    C
 00146    C                                                                        COORDINATES
 00148  85         IF DRSP1.LT.DRC                                                 CHECK IF HIT CLOSE TO WIRE
 00149  86         THEN
 00150  89            SNFI = (DRSP2 - DRSP1) / DR0
 00151  90            CSFI = SQRT(1.-SNFI**2)
 00152  91            DRSPC = DRSP1/CSFI
 00153  92            XL  = X1 + DYWR*DRSPC
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  4
0CARD TARGET
  NO  STM.NO
 
 00154  93            YL  = Y1 - DXWR*DRSPC
 00155  94            DXL =-DXWR*CSFI - DYWR*SNFI
 00156  95            DYL = DXWR*SNFI - DYWR*CSFI
 00157  96            XR  = X1 - DYWR*DRSPC
 00158  97            YR  = Y1 + DXWR*DRSPC
 00159  98            DXR =-DXWR*CSFI + DYWR*SNFI
 00160  99            DYR =-DXWR*SNFI - DYWR*CSFI
 00161 100         ELSE
 00162 102            YL  = Y1 - TRLOYL*DRSP1
 00163 103            DYL = Y2 - TRLOYL*DRSP2 - YL
 00164 104            XL  = X1 - TRLOXL*DRSP1
 00165 105            DXL = X2 - TRLOXL*DRSP2 - XL
 00166 106            DISTL = SQRT(DXL**2+DYL**2)
 00167 107            DXL =-DXL / DISTL
 00168 108            DYL =-DYL / DISTL
 00170 109            COSGL = -DXL*TRLOYL + DYL*TRLOXL                             ANGULAR CORRECTION
 00171 110            DDRSP = (1./COSGL - 1.) * DRC
 00172    C     PRINT 2901, ITREL,IPTR,XL,YL,DXL,DYL,COSGL,DDRSP,TRLOXL,TRLOYL
 00173    C2901 FORMAT(' PRXYTR:',I3,I6,2F8.2,6F8.3)
 00174 111            XL =-DDRSP*TRLOXL + XL
 00175 112            YL =-DDRSP*TRLOYL + YL
 00176    C
 00177 113            YR  = Y1 + TRLOYR*DRSP1
 00178 114            DYR = Y2 + TRLOYR*DRSP2 - YR
 00179 115            XR  = X1 + TRLOXR*DRSP1
 00180 116            DXR = X2 + TRLOXR*DRSP2 - XR
 00181 117            DISTR = SQRT(DXR**2+DYR**2)
 00182 118            DXR =-DXR / DISTR
 00183 119            DYR =-DYR / DISTR
 00185 120            COSGR = -DXR*TRLOYR + DYR*TRLOXR                             ANGULAR CORRECTION
 00186 121            DDRSP = (1./COSGR - 1.) * DRC
 00187    C     PRINT 2901, ITREL,IPTR,XR,YR,DXR,DYR,COSGR,DDRSP,TRLOXR,TRLOYR
 00188 122            XR = DDRSP*TRLOXR + XR
 00189 123            YR = DDRSP*TRLOYR + YR
 00190 124         CIF
 00191    C
 00192 125         WRK(IPTR+ 3) = XL
 00193 126         WRK(IPTR+ 4) = YL
 00194 127         WRK(IPTR+ 5) = DXL
 00195 128         WRK(IPTR+ 6) = DYL
 00196 129         WRK(IPTR+ 7) = XR
 00197 130         WRK(IPTR+ 8) = YR
 00198 131         WRK(IPTR+ 9) = DXR
 00199 132         WRK(IPTR+10) = DYR
 00200    C
 00202    C                                                                        END OF TREL
 00204 133         ILAYR = ITRKAR(ITREL,6)                                         LAYER #
 00206 134         DRSP1 = TRKAR(ITREL,7)                                          DRIFT SPACE
 00207 135         DRSP2 = DRSP1 - TRKAR(ITREL,8)
 00209 136         IF DRSP1.LT.DRC .AND. ABS(DRSP2-DRSP1).GE.DRC                   CHECK IF SLOPE > 1. CLOSE TO ZERO
 00210 137         THEN
 00212 140            DWIR = ILAYR - ITRKAR(ITREL,3)                               MOVE LAST POINT 1 LAYER DOWN
 00213 141            CRV  = 0.
 00214 142            IF(DWIR.GT.0.) CRV = (TRKAR(ITREL,8)-TRKAR(ITREL,5))/DWIR
 00215 144            SLOPE =-CRV*.5 + DRSP1-DRSP2
 00216 145            DRSP1 = DRSP1 - SLOPE
 00217 146            DRSP2 = CRV*.5 - SLOPE + DRSP1
 00218 147            ILAYR = ILAYR - 1
 00219 148         CIF
 00220    C
 00222 149         R1 = R0 + DR0*ILAYR                                             POSITION OF SENSE WIRE
 00223 150         R2 = R1 - DR0
 00224 151         X1 = R1*DXWR
 00225 152         X2 = R2*DXWR
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  5
0CARD TARGET
  NO  STM.NO
 
 00226 153         Y1 = R1*DYWR
 00227 154         Y2 = R2*DYWR
 00228    C
 00230    C                                                                        COORDINATES
 00232 155         IF DRSP1.LT.DRC                                                 CHECK IF HIT CLOSE TO WIRE
 00233 156         THEN
 00234 159            SNFI = (DRSP2 - DRSP1) / DR0
 00235 160            CSFI = SQRT(1.-SNFI**2)
 00236 161            DRSPC = DRSP1/CSFI
 00237 162            XL  = X1 + DYWR*DRSPC
 00238 163            YL  = Y1 - DXWR*DRSPC
 00239 164            DXL =-DXWR*CSFI + DYWR*SNFI
 00240 165            DYL =-DXWR*SNFI - DYWR*CSFI
 00241 166            XR  = X1 - DYWR*DRSPC
 00242 167            YR  = Y1 + DXWR*DRSPC
 00243 168            DXR =-DXWR*CSFI - DYWR*SNFI
 00244 169            DYR = DXWR*SNFI - DYWR*CSFI
 00245 170         ELSE
 00246 172            YL  = Y1 - TRLOYL*DRSP1
 00247 173            DYL = Y2 - TRLOYL*DRSP2 - YL
 00248 174            XL  = X1 - TRLOXL*DRSP1
 00249 175            DXL = X2 - TRLOXL*DRSP2 - XL
 00250 176            DISTL = SQRT(DXL**2+DYL**2)
 00251 177            DXL = DXL / DISTL
 00252 178            DYL = DYL / DISTL
 00254 179            COSGL = -DXL*TRLOYL + DYL*TRLOXL                             ANGULAR CORRECTION
 00255 180            DDRSP = (1./COSGL - 1.) * DRC
 00256    C     PRINT 2901, ITREL,IPTR,XL,YL,DXL,DYL,COSGL,DDRSP,TRLOXL,TRLOYL
 00257 181            XL =-DDRSP*TRLOXL + XL
 00258 182            YL =-DDRSP*TRLOYL + YL
 00259    C
 00260 183            YR  = Y1 + TRLOYR*DRSP1
 00261 184            DYR = Y2 + TRLOYR*DRSP2 - YR
 00262 185            XR  = X1 + TRLOXR*DRSP1
 00263 186            DXR = X2 + TRLOXR*DRSP2 - XR
 00264 187            DISTR = SQRT(DXR**2+DYR**2)
 00265 188            DXR = DXR / DISTR
 00266 189            DYR = DYR / DISTR
 00268 190            COSGR = -DXR*TRLOYR + DYR*TRLOXR                             ANGULAR CORRECTION
 00269 191            DDRSP = (1./COSGR - 1.) * DRC
 00270    C     PRINT 2901, ITREL,IPTR,XR,YR,DXR,DYR,COSGR,DDRSP,TRLOXR,TRLOYR
 00271 192            XR = DDRSP*TRLOXR + XR
 00272 193            YR = DDRSP*TRLOYR + YR
 00273 194         CIF
 00274    C
 00275 195         IF TBIT(ITRKAR(ITREL,9),23)
 00277 196         THEN                                                            ZERO CROSSING
 00278 199            WRK(IPTR+15) = XL
 00279 200            WRK(IPTR+16) = YL
 00280 201            WRK(IPTR+17) = DXL
 00281 202            WRK(IPTR+18) = DYL
 00282 203            WRK(IPTR+11) = XR
 00283 204            WRK(IPTR+12) = YR
 00284 205            WRK(IPTR+13) = DXR
 00285 206            WRK(IPTR+14) = DYR
 00287 207         ELSE                                                            NOT ZERO CROSSING
 00288 209            WRK(IPTR+11) = XL
 00289 210            WRK(IPTR+12) = YL
 00290 211            WRK(IPTR+13) = DXL
 00291 212            WRK(IPTR+14) = DYL
 00292 213            WRK(IPTR+15) = XR
 00293 214            WRK(IPTR+16) = YR
 00294 215            WRK(IPTR+17) = DXR
 00295 216            WRK(IPTR+18) = DYR
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  6
0CARD TARGET
  NO  STM.NO
 
 00296 217         CIF
 00297    C
 00299 218         IPTR = IPTR + HLDTE                                             INCREASE POINTER
 00300 219      CFOR
 00301    C
 00303 221      HPFREE = IPTR                                                      SET POINTER TO LAST LOCATION
 00304 222      HPTE9  = IPTR - 1
 00305 223      RETURN
 00306 224      END
0END OF SEGMENT
0  OPTIONS IN EFFECT - LINECOUNT=64,LINEWIDTH=131,  SOURCE,  FORTRAN  NUMBERING
0   0 ERRORS           0 WARNINGS         223 TARGET STATEMENTS
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  1
0CARD TARGET
  NO  STM.NO
 
0END OF PROGRAM
0  OPTIONS IN EFFECT - LINECOUNT=64,LINEWIDTH=131,  SOURCE,  FORTRAN  NUMBERING
0   0 ERRORS           0 WARNINGS         223 TARGET STATEMENTS
 00000    C   22/01/81 102191204  MEMBER NAME  REFITO   (PATRECSR)    SHELTRAN
 00001   2      SUBROUTINE REFITO(IPTR,IPJHTL,XO,YO,WGHTO)
 00002    C
 00003    C        REFIT TRACK ITRK IN 'PATR'-BANK USING ORIGIN
 00004    C        P. STEFFEN                    22/08/80
 00005    C
 00006   3      IMPLICIT INTEGER*2 (H)
 00007    C
          C-------------------------------
          C  MACRO CHEADR .... HEADER BANK
          C-------------------------------
         4      COMMON /CHEADR/ IHEADR(54)
         5      INTEGER*2 HHEADR(108)
         6      EQUIVALENCE (IHEADR(1),HHEADR(1))
          C --
          C --  HHEADR(17) = EXPERIMENT NUMBER
          C --  HHEADR(18) = RUN NUMBER
          C --  HHEADR(19) = EVENT NUMBER
          C --  HHEADR(38) = MAGNETIC FIELD (GAUSS)
          C --
          C--------- END OF MACRO CHEADR ------------
 00009   7      EQUIVALENCE (HHEADR(18),HRUN)
 00010    C
          C----------------------------------------------------------------------
          C             MACRO CDATA .... BOS COMMON.
          C
          C             THIS MACRO ONLY DEFINES THE IDATA/HDATA/ADATA NAMES.
          C             THE ACTUAL SIZE OF /BCS/ IS FIXED ON MACRO CBCSMX
          C             OR BY OTHER MEANS. A DEFAULT SIZE OF 40000 IS GIVEN HERE.
          C
          C----------------------------------------------------------------------
          C
         8      COMMON /BCS/ IDATA(40000)
         9      DIMENSION HDATA(80000),ADATA(40000),IPNT(50)
        10      EQUIVALENCE (HDATA(1),IDATA(1),ADATA(1)),(IPNT(1),IDATA(55))
        11      EQUIVALENCE (NWORD,IPNT(50))
          C
          C------------------------ END OF MACRO CDATA --------------------------
          C----------------------------------------------------------------------
          C           MACRO CCYCP .... JET CHAMBER HIT POINTERS (PATREC)
          C----------------------------------------------------------------------
        12      INTEGER*4 HPTSEC
        13      COMMON/CCYCP/HPTSEC(98)
 00016    C     HPTSEC(I) = CDATA POINTER TO 1ST I*2 WORD FOR 1ST HIT OF CELL I
          C------------------------ END OF MACRO CCYCP --------------------------
 00013    C
          C----------------------------------------------
          C  MACRO CWORKPR .... PATTERN RECOGNITION CWORK
          C----------------------------------------------
        14      COMMON /CWORK/ HPLAST,HPFREE,HPWRK(30),ADWRK(600),
               ,               HPRO,HNTR,HNTCEL(98),IPCL(200),NRHT(200),
               ,               NWR1(200),DS1(200),SL1(200),
               ,               NWR2(200),DS2(200),SL2(200),
               ,               LBL(200),NTREL(200),ICRO(200),
               ,               NTR,HNREL(100),HISTR(9,100),HRES(168),
               ,               NTRLM,RLMTR(3,5),
               ,               WRK(7000)
        15      DIMENSION TRKAR(200,11),ITRKAR(200,11),
               ,                         LMRTR(3,5)
        16      EQUIVALENCE (IPCL(1),TRKAR(1,1),ITRKAR(1,1))
        17      EQUIVALENCE (LMRTR(1,1),RLMTR(1,1))
        18      DIMENSION IWRK(7000),HWRK(14000),IDWRK(600),HDWRK(1200)
        19      EQUIVALENCE (IWRK(1),WRK(1),HWRK(1))
        20      EQUIVALENCE (IDWRK(1),ADWRK(1),HDWRK(1))
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  2
0CARD TARGET
  NO  STM.NO
 
          C---------- END OF MACRO CWORKPR --------------
 00100    C-------------------------------------------------------
 00200    C  MACRO CWORKEQ .... PATTERN RECOGNITION CWORK POINTERS
 00300    C-------------------------------------------------------
 00400  21      EQUIVALENCE
 00410    C                POINTERS FOR FXYZ HIT ARRAY .. PRIMARY L/R SOLUTION
 00500         #          (HPHT0,HPWRK( 1)),(HPHT9,HPWRK( 2)),(HLDHT,HPWRK( 3))
 00510    C                POINTERS FOR CWORK SINGLE TRACK PATR BANK
 00600         #         ,(HPTR0,HPWRK( 4)),(HPTR9,HPWRK( 5)),(HLDTR,HPWRK( 6))
 00610    C                POINTERS FOR TRACK ELEMENT HIT LABEL ARRAY
 00700         #         ,(HPHL0,HPWRK( 7)),(HPHL9,HPWRK( 8)),(HLDHL,HPWRK( 9))
 00710    C                POINTERS FOR FXYZ HIT ARRAY .. OPPOSITE L/R SOLUTION
 00800         #         ,(HPHT0A,HPWRK(10)),(HPHT9A,HPWRK(11)),(HLDHTA,HPWRK(12))
 00810    C               POINTER LIMIT ON FXYZ HIT ARRAY
 00900         #         ,(HPHTLM,HPWRK(13))
 00910    C               POINTERS FOR
 01000         #         ,(HPTE0,HPWRK(14)),(HPTE9,HPWRK(15)),(HLDTE,HPWRK(16))
 01100    C-------------- END OF MACRO CWORKEQ ------------------
 00016    C
 00017  22      EQUIVALENCE
 00018         ,          (HPCO0 ,HPWRK(17)),(HPCO9 ,HPWRK(18)),(HLDCO ,HPWRK(19))
 00019         ,         ,(ICELL ,IDWRK( 1)),(MHIT  ,IDWRK( 2)),(IRING ,IDWRK( 3))
 00020         ,         ,(IERRCD,IDWRK( 4)),(NTRKEL,IDWRK( 5))
 00021    C
          C----------------------------------------------
          C  MACRO CPATLM .... PATTERN RECOGNITION LIMITS
          C----------------------------------------------
        23      COMMON /CPATLM/ PATRLM(5),FLINLM(10),TRELLM(20),ZFITLM(10),BKK(20)
               *               ,XYF(20),IGFP(20),XBKK(40),IADMIN(5),YBKK(20)
        24      INTEGER IXYF(20),LMPATR(5),LMFLIN(10)
        25      INTEGER LMTREL(20),LMZFIT(10),IBKK(20)
        26      DIMENSION GFP(20),IXBKK(40),IYBKK(20)
        27      EQUIVALENCE (PATRLM(1),LMPATR(1)),(IXBKK(1),XBKK(1)),(IYBKK(1),
               *YBKK(1))   ,(FLINLM(1),LMFLIN(1)),(TRELLM(1),LMTREL(1))
               *           ,(ZFITLM(1),LMZFIT(1)),(BKK(1),IBKK(1))
               *           ,(XYF(1),IXYF(1)),(GFP(1),IGFP(1)),(IADMIN(1),IMCERT)
               *           ,(IYBKK(20),IPPASS),(IADMIN(2),IPFAST)
          C----------- END OF MACRO CPATLM --------------
 00023    C
 00100    C-----------------------------------------------------------------------
 00200    C                            MACRO CJDRCH .... JET CHAMBER CONSTANTS.
 00300    C-----------------------------------------------------------------------
 00310    C
 00400  28      COMMON / CJDRCH / RDEC(4),PSIIN(3),RINCR(3),FIRSTW(3),FSENSW(3),
 00500         +                  RDEPTH,SWDEPL,YSUSPN,TIMDEL(2,3),ZMAX,ZOFFS,
 00510         +                  ZRESOL,ZNORM,ZAL,ZSCAL,DRIDEV,DRICOS,DRISIN,
 00600         +                  PEDES,TZERO(3),DRIROT(96,2),SINDRI(96,2),
 00701         +                  COSDRI(96,2),DRIVEL(96,2),T0FIX(3),
 00800         +                  ABERR(8), DUMJDC(20)
 00900    C
 01100    C      BLOCK DATA SET TO MC VALUES, KALIBR WILL SET REAL DATA VALUES
 01210    C--->  A CHANGE OF THIS COMMON MUST BE DONE SIMULTANEOUSLY WITH  <----
 01220    C--->  A CHANGE OF THE BLOCK DATA                                <----
 01230    C
 01300    C--------------------------- END OF MACRO CJDRCH -----------------------
 01400    C
          C----------------------------------------------------------------------
          C           MACRO CDSMAX .... PATTERN RECOGNITION CONSTANTS.
          C----------------------------------------------------------------------
        29      COMMON/CDSMAX/DSMAX(16,3,2),DIRWR1(24,2),DIRWR3(48,2)
               *             ,DHALF(16,3,2),DTWICE(16,3,2),HMCH(16,3,2)
               *             ,IBCK(9),DBCK(30),TRMATS(96,2),TRMATC(96,2)
          C------------------------ END OF MACRO CDSMAX -------------------------
 00026    C
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  3
0CARD TARGET
  NO  STM.NO
 
 00027  30      COMMON/CALIBR/JPOINT(100),
 00028         1HMUCAL(8370),HLGMAI(5760),HTAGSY(384),HJPULS(9216),
 00029         1DELTA0(96,2),DELTA1(96,2),DELTA2(96,2),DELTA5(96,2),DELTA6(96,2)
 00030    C
 00031  31      INTEGER DATE(5), IDAY /0/
 00032  32      DIMENSION ITRCLL(6), NCNCK(24)
 00033    C
 00035  33      INTEGER MKLRT1 /Z1000000/, MKLRT2 /Z100/                           MASK FOR L/R BIT IN HIT LABEL
 00036    C
 00038  34      INTEGER MKBDCL(3) /Z10,Z20,Z40/                                    MASK FOR TRACKS AT CELL WALL
 00039    C
 00040    C     I0 = IPTR + 1
 00041    C     I9 = IPTR + 48
 00042    C     PRINT 2001, (IDATA(I1),I1=I0,I9)
 00043    C     I0 = IPJHTL*2 + 1
 00044    C     I9 = I0 + IDATA(IPJHTL)*2 - 1
 00045    C     PRINT 2000, IPJHTL,I0,I9,(HDATA(I1),I1=I0,I9)
 00046    C     IPJETC = IDATA(IBLN('JETC'))
 00047    C     I0 = IPJETC*2 + 1
 00048    C     I9 = I0 + 109
 00049    C     PRINT 2000, IPJETC,I0,I9,(HDATA(I1),I1=I0,I9)
 00050    C2000 FORMAT('0REFIT:',3I8,/,(20(1X,Z4)))
 00051    C2001 FORMAT(1H0,2I3,I8,2(I4,3F6.1,3F6.3),
 00052    C    ,     /,14X,I3,4E13.5,F6.2,I3,4E13.5,
 00053    C    ,     /,14X,I3,2F8.3,F6.1,I3,10X,6I3,8I6,2X,Z4)
 00054    C2002 FORMAT('0FETCH:',2I3,2I5,12F9.5)
 00055    C2003 FORMAT('0ROTATION:',10F10.5)
 00056    C2004 FORMAT('0CIRC.CENTRE:',2I3, F10.5,2F10.0,F8.1,2F8.1)
 00057    C2005 FORMAT('0TRACK:',I6,/,(1X,3I6,4F8.1,I4,F6.2,2I4,F8.3,I6,F8.1))
 00058    C2006 FORMAT(1X,I6,5F8.2,F12.1,5F8.2)
 00059    C2007 FORMAT(' FETCH:',I3,9F8.4,F10.5,F6.0)
 00060    C2008 FORMAT(' FIT:',2I3,F8.2,F5.0,F10.6,F7.3,F5.1,F6.3,F5.1)
 00061    C2009 FORMAT(' JHTL:',I8,1X,Z8,3I5)
 00062    C2011 FORMAT('0ABERR:',10F10.6)
 00063    C2010 FORMAT(' HIT:',I6,12F8.2)
 00064    C2014 FORMAT('0FIT-BANK:',5F8.3,5X,5F8.3,5X,F8.5,2F8.1)
 00065    C2016 FORMAT('0ITRCLL =',6I8,/,(9X,6F8.3))
 00066    C2107 FORMAT(' SIGLM:',10F8.3)
 00067    C
 00069  35      DATA LBINIT /0/                                                    INITIALIZATION
 00070  36      IF LBINIT .EQ. 0
 00071  37      THEN
 00072  40         LBINIT = 1
 00073  41         PERFORM INIT
 00074  44      CIF
 00075    C
 00077  45      HPFREE = 1                                                         RESERVE SPACE IN CWORK
 00078  46      HPFRE1 = HPFREE
 00079  47      HPCO0  = HPFREE
 00080  48      HLDCO  = 14
 00081  49      HPFREE = HLDCO*100 + HPCO0
 00082  50      HPCO9 = HPFREE - 1
 00083    C
 00085  51      IPHEAD = IDATA(IQHEAD)*2                                           GET RUN #
 00086  52      NRUN = HDATA(IPHEAD+10)
 00087    C
 00089  53      HPTR0 = HPFREE                                                     COPY TRACK BANK
 00090  54      CALL MVC(IWRK(HPTR0),0,IDATA(IPTR+1),0,192)
 00091    C
 00093  55      ITRK = IDATA(IPTR+1)                                               TRACK #
 00094    C
 00096  56      IF IDATA(IPTR+18).EQ.1                                             CENTRE OF CIRCLE (USED FOR ANGULAR CORRECTION)
 00097  57      THEN
 00099  60         ALFA  = ADATA(IPTR+21)                                          CIRCLE PARAMETERS
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  4
0CARD TARGET
  NO  STM.NO
 
 00100  61         CRV   = ADATA(IPTR+19)
 00101  62         IF(ABS(CRV).LT.1.E-8) CRV = SIGN(1.E-8,CRV)
 00102  64         RAD   =  1./CRV + ADATA(IPTR+20)
 00103  65         XCIRC = COS(ALFA) * RAD
 00104  66         YCIRC = SIN(ALFA) * RAD
 00105  67         CHARGE = SIGN(1.,ADATA(IPTR+25))
 00106  68      ELSE
 00108  70         CRV   = ADATA(IPTR+22)*2.                                       PARABOLA PARAMETERS
 00109  71         IF(ABS(CRV).LT.1.E-8) CRV = SIGN(1.E-8,CRV)
 00110  73         ALFA  = ADATA(IPTR+19)
 00111  74         XCIRC =-SIN(ALFA)/CRV + ADATA(IPTR+20)
 00112  75         YCIRC = COS(ALFA)/CRV + ADATA(IPTR+21)
 00113  76         CHARGE =-SIGN(1.,ADATA(IPTR+22))
 00114  77      CIF
 00115  78      ZVERT = ADATA(IPTR+31)
 00116  79      ZSLOP = ADATA(IPTR+30)
 00117  80      COSTHI = SQRT(ZSLOP**2 + 1.)
 00118    C     PRINT 2004,ITRK,IDATA(IPTR+18),ALFA,XCIRC,YCIRC,ZVERT,ZSLOP,COSTHI
 00119    C     PRINT 2011,ABERR
 00120    C
 00122  81      XX    = ADATA(IPTR+12)                                             ROTATION ANGLE (USING LAST POINT OF TRACK)
 00123  82      YY    = ADATA(IPTR+13)
 00124  83      RR    = SQRT(XX**2+YY**2)
 00125  84      CSROT = XX / RR
 00126  85      SNROT = YY / RR
 00127  86      X0   = XO*CSROT + YO*SNROT
 00128  87      Y0   =-XO*SNROT + YO*CSROT
 00129  88      WGHT0 = AMIN1(WGHTO,1.0)
 00130  89      WGHT0 = AMAX1(WGHTO,0.0)
 00131    C     PRINT 2003, CSROT,SNROT,XX,YY,X0,Y0,WGHT0
 00132    C
 00134  90      PERFORM SELCLL                                                     FILL CELL ARRAY
 00135    C
 00137  93      KCLL = 0                                                           LOOP OVER ALL CELLS + FETCH HITS
 00138  94      NHIT = 0
 00139  95      IPCO = HPCO0
 00140    C
 00142  96      JRING = 0                                                          LOOP OVER RINGS
 00143                                                                             INITIALIZE LABEL FOR DEAD CELLS +
 00145  97      LBCELL = 0                                                         TRACKS AT CELL WALLS
 00146  98      REPEAT
 00147  99         JRING = JRING + 1
 00148 100         NHRNG = 0
 00149 101         NCLL = 0
 00150 102         REPEAT
 00151 103            NCLL = NCLL + 1
 00152 104            KCLL = KCLL + 1
 00153 105            JCELL = ITRCLL(KCLL)
 00154 106            IF JCELL.NE.0
 00155 107            THEN
 00156 110               PERFORM FETCH
 00157 113               NHRNG = NHRNG + JHIT
 00158 114            CIF
 00159 115         UNTIL NCLL.EQ.2
 00161 116         IF(JCELL.NE.0) LBCELL = LOR(MKBDCL(JRING),LBCELL)               SET LABEL FOR TRACK AT CELL BOUND.
 00162 121      UNTIL KCLL.EQ.6
 00163 122      HPCO9 = IPCO - 1
 00164    C     PRINT 2005, LBCELL,(WRK(I),I=HPCO0,HPCO9)
 00165    C
 00166                                                                             1. PARABOLA FIT
 00168 126      JRINGL = 3                                                         LAST RING INCLUDED IN FIT
 00169 127      PERFORM FPARA0
 00170    C
 00172 130      ALBLM1 = 0.6                                                       RELABEL HITS
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  5
0CARD TARGET
  NO  STM.NO
 
 00173 131      ALBLM2 = 3.0
 00174 132      PERFORM LABEL
 00175    C     PRINT 2005, LBCELL,(WRK(I),I=HPCO0,HPCO9)
 00176    C
 00178 135      PERFORM FPARA0                                                     REFIT PARABOLA
 00179    C
 00181 138      PERFORM LABEL                                                      RELABEL HITS
 00182    C     PRINT 2005, LBCELL,(WRK(I),I=HPCO0,HPCO9)
 00183    C
 00185 141      PERFORM FITBNK                                                     SET UP FIT-BANK
 00186    C
 00188 144      IF ABS(PAR1).GT..00030 .AND. SIG.GT..06                            CHECK IF BAD FIT AND LOW MOMENTUM
 00189 145      THEN
 00190 148         IF SIG.GT..10 .OR. IDATA(IPTR+24)-INT(S0).GT.8
 00191 149         THEN
 00192 152            ALBLM1 = 1.5
 00193 153            ALBLM2 = 3.0
 00194 154            PERFORM LABEL
 00195 157            JRINGL = 2
 00196 158            PERFORM FPARA0
 00197 161            ALBLM1 = 0.6
 00198 162            PERFORM LABEL
 00199 165            PERFORM FPARA0
 00200 168            PERFORM LABEL
 00201 171            IF SIG.LT..10
 00202 172            THEN
 00203 175               PERFORM FITBK1
 00204 178            CIF
 00205 179         CIF
 00206 180      CIF
 00207    C
 00208 181      HPFREE = HPFRE1
 00209 182      RETURN
 00210    C
 00211                                                                             *************************
 00212                                                                             *      F P A R A 0      *
 00214    C                                                                        *************************
 00215    C
 00217 183      PROC FPARA0                                                        PARABOLA FIT THROUG ORIGIN
 00218    C
 00219                                                                             GET EQUATIONS
 00221 184         S0 = WGHT0                                                      WEIGHT ORIGIN AS POINT OF PARABOLA
 00222 185         S1 = 0.
 00223 186         S2 = 0.
 00224 187         S3 = 0.
 00225 188         S4 = 0.
 00226 189         S5 = 0.
 00227 190         S6 = 0.
 00228 191         S7 = Y0 * WGHT0
 00229 192         IPCO = HPCO0
 00230 193         REPEAT
 00231 194            IF IWRK(IPCO+ 7).EQ.0 .AND. IWRK(IPCO+12).LE.JRINGL
 00232 195            THEN
 00233 198               X = WRK(IPCO+3)
 00234 199               Y = WRK(IPCO+4)
 00235 200               X2 = X**2
 00236 201               S1 = S1 + X
 00237 202               S2 = S2 + X2
 00238 203               S3 = S3 + X*X2
 00239 204               S4 = S4 + X2**2
 00240 205               S5 = S5 + Y*X2
 00241 206               S6 = S6 + Y*X
 00242 207               S7 = S7 + Y
 00243 208               S0 = S0 + 1.
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  6
0CARD TARGET
  NO  STM.NO
 
 00244 209            CIF
 00245 210            IPCO = IPCO + HLDCO
 00246 211         UNTIL IPCO.GT.HPCO9
 00247 212         IF S0.LT.2.5
 00248 216         THEN
 00249 219            SIG = 1000.
 00250 220         ELSE
 00251    C
 00253 222            F1 = 1. / S4                                                 SOLVE EQUATIONS FOR PARABOLA FIT
 00254 223            XX12 = S3*F1
 00255 224            XX13 = S2*F1
 00256 225            YY1  = S5*F1
 00257 226            XX22 = S2 - S3*XX12
 00258 227            XX23 = S1 - S3*XX13
 00259 228            YY2  = S6 - S3*YY1
 00260 229            XX32 = S1 - S2*XX12
 00261 230            XX33 = S0 - S2*XX13
 00262 231            YY3  = S7 - S2*YY1
 00263 232            IF XX22.GT.XX32
 00264 233            THEN
 00265 236               XX23 = XX23 / XX22
 00266 237               YY2  = YY2  / XX22
 00267 238               PAR3 = (YY3 - XX32*YY2) / (XX33 - XX32*XX23)
 00268 239               PAR2 = YY2 - XX23*PAR3
 00269 240            ELSE
 00270 242               XX33 = XX33 / XX32
 00271 243               YY3  = YY3  / XX32
 00272 244               PAR3 = (YY2 - XX22*YY3) / (XX23 - XX22*XX33)
 00273 245               PAR2 = YY3 - XX33*PAR3
 00274 246            CIF
 00275 247            PAR1 = YY1 - XX12*PAR2 - XX13*PAR3
 00276 248            DEG = S0 - WGHT0 - 2.
 00277    C
 00278    C
 00280 249            CHISQ = 0.                                                   CALC. CHISQ + SOLVE L/R AMBIGUITY
 00281 250            DCHIM1 = 0.
 00282 251            IHITM1 = 0
 00283 252            IHSTRT = 0
 00284 253            IPCO = HPCO0
 00285 254            REPEAT
 00286 255               IF IWRK(IPCO+ 7).EQ.0 .AND. IWRK(IPCO+12).LE.JRINGL
 00287 256               THEN
 00288 259                  IF(IHSTRT.EQ.0) IHSTRT = IPCO
 00289 261                  IHEND = IPCO
 00290 262                  X = WRK(IPCO+3)
 00291 263                  Y = WRK(IPCO+4)
 00292 264                  F = (PAR1 *X + PAR2 )*X + PAR3
 00293 265                  DCHI = Y - F
 00294 266                  WRK(IPCO+13) = DCHI
 00296 267                  CHISQ = CHISQ + DCHI**2                                SUM FOR RMS
 00298    C           IF ABS(DCHI).GE.DCHIM1                                       KEEP BIGGEST RMS
 00299    C           THEN
 00300    C             DCHIM1 = ABS(DCHI)
 00301    C             IHITM1 = IPCO
 00302    C           CIF
 00303    C     PRINT 2006, IPCO,X,Y,F,DCHI,CHISQ
 00304 268               CIF
 00305 269               IPCO = IPCO + HLDCO
 00306 270            UNTIL IPCO.GT.HPCO9
 00307 271            SIG    =      CHISQ  / DEG
 00308    C     PRINT 2008, JRINGL,IWRK(IHEND),SIG,DEG,PAR1,PAR2,PAR3,
 00309    C    ,            WGHT0,Y0
 00310    C
 00312 275            SIGLM = TRELLM(16)**2                                        SET LIMIT FOR SIGMA
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  7
0CARD TARGET
  NO  STM.NO
 
 00313 276         CIF
 00314    C
 00315 277      CPROC
 00316    C
 00317                                                                             *************************
 00318                                                                             *      S E L C L L      *
 00320    C                                                                        *************************
 00321    C
 00323 279      PROC SELCLL                                                        SELECT CELLS CONTAINING TRACK
 00324    C
 00325 280         FOR I=1,6
 00326 281            ITRCLL(I) = 0
 00327 282         CFOR
 00328 284         IPC0 = IPTR + 34
 00329 285         IPC9 = IPC0 +  5
 00330 286         ICELL = 0
 00331 287         FOR IPC = IPC0,IPC9
 00332 288            JCELL = IDATA(IPC)
 00333 289            IF JCELL.GT. 0 .AND. JCELL.LE.96
 00334 290            THEN
 00335 293               JRING = 1
 00336 294               IF(JCELL.GT.24) JRING = 2
 00337 296               IF(JCELL.GT.48) JRING = 3
 00338 298               JPC = JRING*2 - 1
 00339 299               IF ITRCLL(JPC).EQ.0
 00340 300               THEN
 00341 303                  ITRCLL(JPC) = JCELL
 00342 304               ELSE
 00343 306                  IF(ITRCLL(JPC).NE.JCELL) ITRCLL(JPC+1) = JCELL
 00344 308               CIF
 00345 309               ICELL = JCELL
 00346 310               IRING = JRING
 00347 311            CIF
 00348 312         CFOR
 00349    C
 00350    C     PRINT 2016, ITRCLL
 00351 314      CPROC
 00352    C
 00353                                                                             *************************
 00354                                                                             *      F E T C H        *
 00356    C                                                                        *************************
 00357    C
 00359 316      PROC FETCH                                                         FETCH HITS IN CELL
 00360    C
 00362 317         IF JRING.NE.3                                                   DIR. OF SENSEW. + DRIFTSP.
 00363 318         THEN
 00364 321            IC1 = JCELL
 00365 322            IF(IC1.GT.24) IC1 = IC1 - 24
 00366 324            CSROT0 = DIRWR1(IC1,1)
 00367 325            SNROT0 = DIRWR1(IC1,2)
 00368 326         ELSE
 00369 328            IC1 = JCELL - 48
 00370 329            CSROT0 = DIRWR3(IC1,1)
 00371 330            SNROT0 = DIRWR3(IC1,2)
 00372 331         CIF
 00373 332         DRICS  = TRMATC(JCELL,2)
 00374 333         DRISN  = TRMATS(JCELL,2)
 00375 334         DRITG  = DRISN/DRICS
 00376 335         DRISNF = DRISN * .05
 00377    C
 00379 336         R0 = FSENSW(JRING)                                              LOAD RADIUS AND WIRE SPACING
 00380 337         DR = RINCR (JRING)
 00381    C
 00383 338         R1   = DR*7.5 + R0                                              ANGLE OF TRACK IN RING
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  8
0CARD TARGET
  NO  STM.NO
 
 00384 339         DX   = R1 * CSROT0 - XCIRC
 00385 340         DY   = R1 * SNROT0 - YCIRC
 00386 341         RR   = SQRT(DX**2 + DY**2) * CHARGE
 00387 342         CSB  = DX / RR
 00388 343         SNB  = DY / RR
 00389 344         TGB  = CSB/SNB
 00390    C
 00392 345         DSBIN1 = DRIVEL(JCELL,1)                                        SET DRIFT SPACE BIN
 00393 346         IF(NRUN.GT.100) DS0 = T0FIX(JRING)*DSBIN1*64.
 00394 348         IF(NRUN.LE.100) DS0 = DSBIN1*.5
 00396 350         TANBET = ABS((TGB-DRITG)/(TGB*DRITG+1.))                        ANGLE(TRACK,DRIFT DIRECT.)
 00397    C     PRINT 2007, JCELL,CSROT0,SNROT0,DRICS,DRISN,CSB,SNB,CHARGE,TANBET,
 00398    C    ,            DSBIN1,DS0
 00400 351         CCST01 = DELTA0(JCELL,1)*TANBET                                 CORRECTION CONSTANTS FOR JCELL
 00401 352         CCST02 = DELTA0(JCELL,2)*TANBET
 00402 353         CCST11 = DELTA1(JCELL,1)
 00403 354         CCST12 = DELTA1(JCELL,2)
 00404 355         CCST21 = DELTA2(JCELL,1)
 00405 356         CCST22 = DELTA2(JCELL,2)
 00406 357         CCST51 = DELTA5(JCELL,1) * 10.
 00407 358         CCST52 = DELTA5(JCELL,2) / 121.15
 00408 359         CCST61 = DELTA6(JCELL,1) * 10.
 00409 360         CCST62 = DELTA6(JCELL,2) / 121.15
 00410    C     PRINT 2002, JRING,JCELL,IP,IP9,CCST01,CCST02,CCST11,CCST12,
 00411    C    ,            CCST21,CCST22,CCST51,CCST52,CCST61,CCST62
 00413 361         JHIT = 0                                                        COUNTER FOR NUMBER OF HITS FOUND
 00414 362         NHIT   = 0
 00415 363         NHGOOD = 0
 00417 364         ILAYL =-99                                                      PRESET LAST LAYER
 00419 365         IPCO = IPCO - HLDCO                                             LOOP OVER ALL HITS OF CELL
 00420 366         IPJETC = IDATA(IQJETC)*2
 00421 367         IP0    = IPJETC + 100
 00422 368         IPCLL  = IPJETC + 2 + JCELL
 00423 369         IP     = HDATA(IPCLL  ) + IP0
 00424 370         IP9    = HDATA(IPCLL+1) + IP0
 00425 371         IPHL   = IPJHTL + 2 + HDATA(IPCLL)/4
 00426    C     PRINT 2002, JRING,JCELL,IP,IP9,TGB,SNB,CSB,DRISN,DRICS
 00427 372         WHILE IP.LT.IP9
 00428    C
 00430 374            LB   = IDATA(IPHL)                                           CHECK TRACK # OF HIT LABEL
 00431 378            ITR1 = LAND(SHFTR(LB,17),127)
 00432 379            ITR2 = LAND(SHFTR(LB, 1),127)
 00433    C     PRINT 2009, IPHL,LB,ITR1,ITR2,ITRK
 00434 380            IF ITR1.EQ.ITRK .OR. ITR2.EQ.ITRK
 00435 381            THEN
 00436    C
 00438 384               LBLR = 0                                                  L/R FROM HIT LABEL
 00439 385               IF(ITR1.EQ.ITRK) LBLR = LAND(LB,MKLRT1)
 00440 387               IF(ITR2.EQ.ITRK) LBLR = LAND(LB,MKLRT2)
 00441 389               LBSIDE =-1
 00442 390               IF(LBLR.NE.0) LBSIDE = 1
 00443 392               LBLR = LBSIDE
 00444    C
 00445 393               IWIR = HDATA(IP)
 00446 394               IWIR = SHFTR(IWIR,3)
 00448 395               ILAY = LAND(IWIR,15)                                      LAYER NUMBER WITHIN RING 3
 00450 396               DS =(HDATA(IP+3)) * DSBIN1                                DRIFT SPACE
 00451 397               DATA NPRHT /0/
 00452 398               NPRHT = NPRHT + 1
 00453    C     IF(NPRHT.LE.25) PRINT 2019, IWIR,ILAY,JCELL,HDATA(IP+3),DS,DSBIN1
 00454    C2019 FORMAT(' HIT ',4I6,F6.1)
 00455 399               X1   = ILAY * DR + R0
 00456 400               Z1   = X1*ZSLOP + ZVERT
 00458 401               DDS = (1222.9-ABS(Z1))*ABERR(1) + ABERR(6)*R1*COSTHI      CORRECTION FOR TOF + PROPAG. ALONG WIRE
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  9
0CARD TARGET
  NO  STM.NO
 
 00459 402               DSC = DS - DDS + DS0
 00460 403               Y1   = SWDEPL
 00461 404               IF(LAND(ILAY,1).NE.0) Y1 =-Y1
 00462 406               Y1   = (7-ILAY)*(CCST52*Z1+CCST51) - CCST62*Z1-CCST61 + Y1
 00463 407               X    = X1*CSROT0 - Y1*SNROT0
 00464 408               Y    = X1*SNROT0 + Y1*CSROT0
 00465 409               IF DS.LE.DRC
 00466 410               THEN
 00467 413                  IF DS.LT.4.0
 00468 414                  THEN
 00469 417                     IF DS.GT.DSD1
 00470 418                     THEN
 00471 421                        DSC = (DSD1-DSD0)*DRV0 + (DS-DSD1)*DRV1
 00472 422                     ELSE
 00473 424                        DSC = (DS-DSD0)*DRV0
 00474 425                     CIF
 00475 426                     IF(DSC.LT.0.1) DSC = 0.1
 00476 428                  CIF
 00477 429                  DXR  = DSC * CSB
 00478 430                  DYR  = DSC * SNB
 00479 431                  DXL =-DXR
 00480 432                  DYL =-DYR
 00481 433               ELSE
 00482    C
 00484 435                  IF ILAY.LT. 3                                          EDGE WIRE FIELD DISTORTION
 00485 436                  THEN
 00486 439                     DILAY =-(ILAY- 3)**2
 00487 440                     DSCL  = (DILAY*CCST11 + 1.) * DSC
 00488 441                     DSCR  = (DILAY*CCST12 + 1.) * DSC
 00489 442                  ELSE
 00490 444                     IF ILAY.GT.12
 00491 445                     THEN
 00492 448                        DILAY =-(ILAY-12)**2
 00493 449                        DSCL  = (DILAY*CCST21 + 1.) * DSC
 00494 450                        DSCR  = (DILAY*CCST22 + 1.) * DSC
 00495 451                     ELSE
 00496 453                        DSCL = DSC
 00497 454                        DSCR = DSC
 00498 455                     CIF
 00499 456                  CIF
 00500    C
 00502 457                  IF DSC.GT.ABERR(7)                                     FIELD DISTORTIONS AT LARGE DRIFT TIMES
 00503 458                  THEN
 00504 461                     DWIR  = ILAY - 7.5
 00505 462                     DWIRC = DSC*DRISNF
 00506 463                     DWIRL = DWIR + DWIRC
 00507 464                     DWIRR = DWIR - DWIRC
 00508 465                     DSCL  = (DSCL-ABERR(7))*DWIRL*CCST01 + DSCL
 00509 466                     DSCR  =-(DSCR-ABERR(7))*DWIRR*CCST02 + DSCR
 00510 467                  CIF
 00511 468                  DXR  = (DSCR-DRC)*DRISN + DRC*CSB
 00512 469                  DYR  = (DSCR-DRC)*DRICS + DRC*SNB
 00513 470                  DXL  =-(DSCL-DRC)*DRISN - DRC*CSB
 00514 471                  DYL  =-(DSCL-DRC)*DRICS - DRC*SNB
 00515 472               CIF
 00516    C     PRINT 2010, ILAY,DS,DSC,DSCL,DSCR,XL,XR,X,Y,DXL,DXR,DYL,DYR
 00517 473               XL   = DXL + X
 00518 474               YL   = DYL + Y
 00519 475               XXL  = XL*CSROT + YL*SNROT
 00520 476               YYL  =-XL*SNROT + YL*CSROT
 00521 477               XR   = DXR + X
 00522 478               YR   = DYR + Y
 00523 479               XXR  = XR*CSROT + YR*SNROT
 00524 480               YYR  =-XR*SNROT + YR*CSROT
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE 10
0CARD TARGET
  NO  STM.NO
 
 00526    C     PRINT 2010, ILAY,DS,XXL,YYL,X1,Z1,XXR,YYR,Y1                       SET ARRAY
 00527    C
 00529 481               NLRSOL = 1                                                CHECK IF LEFT + RIGHT SOLUTION POSSIBLE
 00530 482               IF(DS.LT.2.0) NLRSOL = 2
 00531    C
 00533 484               ILRSOL = 0                                                LOOP OVER LEFT +/OR RIGHT SOLUTION
 00534 485               REPEAT
 00535 486                  ILRSOL = ILRSOL + 1
 00536    C
 00538 487                  IF NLRSOL.EQ.1 .AND. LBSIDE.LT.0  .OR.                 SELECT SIDE
 00539         ?               NLRSOL.EQ.2 .AND. ILRSOL.EQ.1
 00540 488                  THEN
 00542 491                     LBSIDE =-1                                          LEFT SIDE
 00543 492                     XX  = XXL
 00544 493                     YY  = YYL
 00545 494                  ELSE
 00547 496                     LBSIDE = 1                                          RIGHT SIDE
 00548 497                     XX  = XXR
 00549 498                     YY  = YYR
 00550 499                  CIF
 00551    C
 00553 500                  LBGOOD = 0                                             HIT QUALITY:
 00554 501                  IF(LBSIDE.NE.LBLR) LBGOOD = 1
 00556 503                  IF ILAY.NE.ILAYL .OR. LBGDL.LE.1.AND.LBGOOD.LE.1       NEW LAYER?
 00557 504                  THEN
 00558 507                     LBREG = 1
 00560 508                     JHIT = JHIT + 1                                     INCREASE HIT COUNTER
 00561 509                     IPCO = IPCO + HLDCO
 00562 510                  ELSE
 00564 512                     LBREG = 0                                           2 HITS IN SAME LAYER, SELECT CLOSEST
 00565 513                     IF(LBGOOD.LT.IWRK(IPCO+7)) LBREG = 1
 00566 515                  CIF
 00568 516                  IF LBREG.NE.0                                          REGISTER NEW HIT?
 00569 517                  THEN
 00570 520                     NHIT   = NHIT   + 1
 00571 521                     IF(LBGOOD.LE.1) NHGOOD = NHGOOD + 1
 00572 523                     IWRK(IPCO   ) = ILAY
 00573 524                     IWRK(IPCO+ 1) = IP
 00574 525                     IWRK(IPCO+ 2) = LBSIDE
 00575 526                     WRK (IPCO+ 3) = XX
 00576 527                     WRK (IPCO+ 4) = YY
 00577 528                     WRK (IPCO+ 5) = 0.
 00578 529                     WRK (IPCO+ 6) = 0.
 00579 530                     IWRK(IPCO+ 7) = LBGOOD
 00580 531                     WRK (IPCO+ 8) = DS
 00581 532                     IWRK(IPCO+ 9) = JCELL
 00582 533                     IWRK(IPCO+10) = LBGOOD
 00583 534                     WRK (IPCO+11) = TGB
 00584 535                     IWRK(IPCO+12) = JRING
 00585 536                     WRK (IPCO+13) = 0.
 00586 537                     ILAYL = ILAY
 00587 538                     LBGDL = LBGOOD
 00588 539                  CIF
 00589    C
 00590 540               UNTIL ILRSOL.GE.NLRSOL
 00591    C
 00592 541            CIF
 00593    C
 00594 545            IPHL = IPHL + 1
 00595 546            IP   = IP   + 4
 00596 547         CWHILE
 00598 549         IPCO = IPCO + HLDCO                                             SET IPCO TO 1. FREE LOCATION
 00599    C
 00601 550         IF NHIT.LE.2                                                    SET LABEL FOR DEAD CELL
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE 11
0CARD TARGET
  NO  STM.NO
 
 00602 551         THEN
 00603 554            REPEAT
 00604 555               IF JCELL.EQ.17
 00605 556               THEN
 00606 559                  IF NRUN.GE.539
 00607 560                  THEN
 00608 563                     LBCELL = LOR(LBCELL,1)
 00609 564                     JHIT = 16
 00610 565                     NHIT = 16
 00611 566                  CIF
 00612 567                  XREPEAT
 00613 568               CIF
 00614 569               IF JCELL.EQ.37
 00615 570               THEN
 00616 573                  IF NRUN.GE.2303
 00617 574                  THEN
 00618 577                     LBCELL = LOR(LBCELL,2)
 00619 578                     JHIT = 16
 00620 579                     NHIT = 16
 00621 580                  CIF
 00622 581                  XREPEAT
 00623 582               CIF
 00624 583               IF JCELL.EQ.65 .OR. JCELL.EQ.66 .OR.
 00625         ?            JCELL.EQ.81 .OR. JCELL.EQ.82
 00626 584               THEN
 00627 587                  IF NRUN.GE.2783
 00628 588                  THEN
 00629 591                     LBCELL = LOR(LBCELL,4)
 00630 592                     JHIT = 16
 00631 593                     NHIT = 16
 00632 594                  CIF
 00633 595                  XREPEAT
 00634 596               CIF
 00635    C
 00636 597            UNTIL .TRUE.
 00637    C
 00638 598         CIF
 00639    C
 00640 602      CPROC
 00641    C
 00642                                                                             *************************
 00643                                                                             *      F I T B N K      *
 00645    C                                                                        *************************
 00646    C
 00648 604      PROC FITBNK                                                        SET UP FIT-BANK
 00649    C
 00651 605         XST  = WRK(IHSTRT+ 3)                                           START + END POINTS
 00652 606         YST  = WRK(IHSTRT+ 4)
 00653 607         XEN  = WRK(IHEND + 3)
 00654 608         YEN  = WRK(IHEND + 4)
 00656 609         TGST = PAR1*XST*2 + PAR2                                        DIRECTION AT START + END POINT
 00657 610         DXST = 1./SQRT(TGST**2+1.)
 00658 611         DYST = DXST * TGST
 00659 612         TGEN = PAR1*XEN*2 + PAR2
 00660 613         DXEN = 1./SQRT(TGEN**2+1.)
 00661 614         DYEN = DXEN * TGEN
 00663 615         XMIN = -PAR2*.5 / PAR1                                          MIN. OF PARABOLA
 00664 616         YMIN = (PAR1*XMIN + PAR2)*XMIN + PAR3
 00666 617         CURV =-PAR1 * 2.                                                CURVATURE
 00667    C
 00669 618         ZV0  = ADATA(IPTR+31)                                           USE ZFIT RESULTS FROM PATR-BANK
 00670 619         TGTH = ADATA(IPTR+30)
 00671 620         CSTH = 1./SQRT(TGTH**2+1.)
 00672 621         SNTH = CSTH * TGTH
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE 12
0CARD TARGET
  NO  STM.NO
 
 00673    C
 00674    C     PRINT 2014, XST,YST,DXST,DYST,TGST,XEN,YEN,DXEN,DYEN,TGEN,CURV,
 00675    C    ,            XMIN,YMIN
 00676    C
 00678 622         IP    = HPTR0 - 1                                               FILL FIT-BANK
 00679 623         IWRK(IP+ 1) = ITRK
 00680 624         IWRK(IP+ 2) = 32
 00681 625         IWRK(IP+ 3) = IDAY
 00682 626         IWRK(IP+ 4) = 8
 00683 627         WRK (IP+ 5) = XST *CSROT - YST *SNROT
 00684 628         WRK (IP+ 6) = XST *SNROT + YST *CSROT
 00685 629         WRK (IP+ 7) = SQRT(WRK(IP+ 5)**2 + WRK(IP+ 6)**2) * TGTH + ZV0
 00686 630         WRK (IP+ 8) = (DXST*CSROT - DYST*SNROT)*CSTH
 00687 631         WRK (IP+ 9) = (DXST*SNROT + DYST*CSROT)*CSTH
 00688 632         WRK (IP+10) = SNTH
 00689 633         IWRK(IP+11) = 0
 00690 634         WRK (IP+12) = XEN *CSROT - YEN *SNROT
 00691 635         WRK (IP+13) = XEN *SNROT + YEN *CSROT
 00692 636         WRK (IP+14) = SQRT(WRK(IP+12)**2 + WRK(IP+13)**2) * TGTH + ZV0
 00693 637         WRK (IP+15) = (DXEN*CSROT - DYEN*SNROT)*CSTH
 00694 638         WRK (IP+16) = (DXEN*SNROT + DYEN*CSROT)*CSTH
 00695 639         WRK (IP+17) = SNTH
 00696 640         IWRK(IP+18) = 2
 00697 641         WRK (IP+19) = ATAN2(SNROT,CSROT)
 00698 642         WRK (IP+20) = XMIN*CSROT - YMIN*SNROT
 00699 643         WRK (IP+21) = XMIN*SNROT + YMIN*CSROT
 00700 644         WRK (IP+22) = PAR1
 00701 645         WRK (IP+23) = SQRT(SIG)
 00702 646         IWRK(IP+24) = S0 + .001
 00703 647         WRK (IP+25) = CURV
 00704 648         WRK (IP+26) = 0.
 00705 649         WRK (IP+27) = CURV
 00706 650         WRK (IP+28) = CURV
 00707 651         I0 = IP+ 1
 00708 652         I9 = IP+28
 00709    C     PRINT 2001,(WRK(I1),I1=I0,I9)
 00710 653      CPROC
 00711    C
 00712                                                                             *************************
 00713                                                                             *      F I T B K 1      *
 00715    C                                                                        *************************
 00716    C
 00718 655      PROC FITBK1                                                        CHANGE FIT BANK (1.POINT)
 00719    C
 00721 656         XST  = WRK(IHSTRT+ 3)                                           START POINT
 00722 657         YST  = WRK(IHSTRT+ 4)
 00724 658         TGST = PAR1*XST*2 + PAR2                                        DIRECTION AT START POINT
 00725 659         DXST = 1./SQRT(TGST**2+1.)
 00726 660         DYST = DXST * TGST
 00728 661         XMIN = -PAR2*.5 / PAR1                                          MIN. OF PARABOLA
 00729 662         YMIN = (PAR1*XMIN + PAR2)*XMIN + PAR3
 00731 663         CURV =-PAR1 * 2.                                                CURVATURE
 00732    C
 00734 664         ZV0  = ADATA(IPTR+31)                                           USE ZFIT RESULTS FROM PATR-BANK
 00735 665         TGTH = ADATA(IPTR+30)
 00736 666         CSTH = 1./SQRT(TGTH**2+1.)
 00737 667         SNTH = CSTH * TGTH
 00738    C
 00739    C     PRINT 2014, XST,YST,DXST,DYST,TGST,XEN,YEN,DXEN,DYEN,TGEN,CURV,
 00740    C    ,            XMIN,YMIN
 00741    C
 00743 668         IP    = HPTR0 - 1                                               FILL FIT-BANK
 00744 669         IWRK(IP+ 4) = 16
 00745 670         WRK (IP+ 5) = XST *CSROT - YST *SNROT
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE 13
0CARD TARGET
  NO  STM.NO
 
 00746 671         WRK (IP+ 6) = XST *SNROT + YST *CSROT
 00747 672         WRK (IP+ 7) = SQRT(WRK(IP+ 5)**2 + WRK(IP+ 6)**2) * TGTH + ZV0
 00748 673         WRK (IP+ 8) = (DXST*CSROT - DYST*SNROT)*CSTH
 00749 674         WRK (IP+ 9) = (DXST*SNROT + DYST*CSROT)*CSTH
 00750 675         WRK (IP+10) = SNTH
 00751 676         IWRK(IP+18) = 2
 00752 677         WRK (IP+19) = ATAN2(SNROT,CSROT)
 00753 678         WRK (IP+20) = XMIN*CSROT - YMIN*SNROT
 00754 679         WRK (IP+21) = XMIN*SNROT + YMIN*CSROT
 00755 680         WRK (IP+22) = PAR1
 00756 681         WRK (IP+23) = SQRT(SIG)
 00757 682         IWRK(IP+24) = S0 + .001
 00758 683         WRK (IP+25) = CURV
 00759 684         WRK (IP+26) = 0.
 00760 685         WRK (IP+27) = CURV
 00761 686         WRK (IP+28) = CURV
 00762 687         I0 = IP+ 1
 00763 688         I9 = IP+28
 00764    C     PRINT 2001,(WRK(I1),I1=I0,I9)
 00765 689      CPROC
 00766    C
 00767    C
 00768                                                                             *************************
 00769                                                                             *      L A B E L        *
 00771    C                                                                        *************************
 00772    C
 00774 691      PROC LABEL                                                         LABEL USED HITS
 00775    C
 00777 692         IWL = -999                                                      PRESET LAST HIT POINTER
 00778 693         FOR IP = HPCO0,HPCO9,HLDCO
 00779 694            IW0 = IWRK(IP)
 00780 695            X   = WRK(IP+3)
 00781 696            Y   = WRK(IP+4)
 00782 697            F   = (PAR1*X + PAR2)*X + PAR3
 00783 698            DF  = F - Y
 00785 699            LBGOOD = 4                                                   SELECT CLOSEST HIT
 00786 700            IF(ABS(DF).LT.ALBLM2) LBGOOD = 1
 00787 702            IF(ABS(DF).LT.ALBLM1) LBGOOD = 0
 00788 704            IWRK(IP+ 7) = LBGOOD
 00789 705            WRK (IP+13) = DF
 00790    C
 00792 706            IF IWL.EQ.IW0                                                CHECK IF 2 HITS FROM SAME WIRE
 00793 707            THEN
 00795 710               IF ABS(DFL).LT.ABS(DF)                                    SELECT CLOSEST HIT
 00796 711               THEN
 00797 714                  IWRK(IP +7) = 16
 00798 715               ELSE
 00799 717                  IWRK(IPL+7) = 16
 00800 718               CIF
 00801 719            CIF
 00803 720            IWL = IW0                                                    STORE LAST POINTERS + DF
 00804 721            IPL = IP
 00805 722            DFL = DF
 00806 723         CFOR
 00807    C
 00808 725      CPROC
 00809    C
 00810    C
 00811                                                                             *************************
 00812                                                                             *      I N I T          *
 00814    C                                                                        *************************
 00815    C
 00817 727      PROC INIT                                                          INITIALIZE CONSTANTS
 00818    C
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE 14
0CARD TARGET
  NO  STM.NO
 
 00819 728         IQJETC = IBLN('JETC')
 00820 729         IQHEAD = IBLN('HEAD')
 00821    C
 00822 730         IWRK(IP+ 3) = IDAY
 00823 731         CALL DAY2(DATE)
 00824 732         IDAY = DATE(1)*1000 + DATE(2)
 00825    C
 00827 733         DRC = RINCR(1)*.5 * DRICOS                                      RADIUS AROUND WIRE FOR CORR. OF DRIFTSPACE
 00828    C       CONST. FOR VAR. OF DRIFT VEL.
 00829 734         IF NRUN.LE.100
 00830 735         THEN
 00831 738            DSD0   = .0
 00832 739            DSD1   = 5.0
 00833 740            DSD2   = 5.0
 00834 741            DRV0   = 1.0
 00835 742            DRV1   = 1.0
 00836 743         ELSE
 00837 745            DSD0   =-.63
 00838 746            DSD1   = 1.8
 00839 747            DSD2   = 4.0
 00840 748            DRV0   = 0.8
 00841 749            DRV1   = (DSD2 - (DSD1-DSD0)*DRV0) / (DSD2-DSD1)
 00842 750         CIF
 00843 751      CPROC
 00844    C
 00845 753      END
0END OF SEGMENT
0  OPTIONS IN EFFECT - LINECOUNT=64,LINEWIDTH=131,  SOURCE,  FORTRAN  NUMBERING
0   0 ERRORS           0 WARNINGS         752 TARGET STATEMENTS
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  1
0CARD TARGET
  NO  STM.NO
 
0END OF PROGRAM
0  OPTIONS IN EFFECT - LINECOUNT=64,LINEWIDTH=131,  SOURCE,  FORTRAN  NUMBERING
0   0 ERRORS           0 WARNINGS         752 TARGET STATEMENTS
 00000    C   20/02/81 107101015  MEMBER NAME  RINCON1  (PATRECSR)    SHELTRAN
 00001   2      SUBROUTINE RINCON
 00002    C
 00003    C     BACKTRACING VERSION 5 (MAR 2,79)
 00004    C     THIS SUBROUTINE IS CALLED BY BACKTR TO
 00005    C     JOIN TRACK ELEMENTS ACROSS RING BOUNDARIES
 00006    C
 00007   3      IMPLICIT INTEGER*2 (H)
 00008    C
 00010    C
 00100    C-----------------------------------------------------------------------
 00200    C                            MACRO CJDRCH .... JET CHAMBER CONSTANTS.
 00300    C-----------------------------------------------------------------------
 00310    C
 00400   4      COMMON / CJDRCH / RDEC(4),PSIIN(3),RINCR(3),FIRSTW(3),FSENSW(3),
 00500         +                  RDEPTH,SWDEPL,YSUSPN,TIMDEL(2,3),ZMAX,ZOFFS,
 00510         +                  ZRESOL,ZNORM,ZAL,ZSCAL,DRIDEV,DRICOS,DRISIN,
 00600         +                  PEDES,TZERO(3),DRIROT(96,2),SINDRI(96,2),
 00701         +                  COSDRI(96,2),DRIVEL(96,2),T0FIX(3),
 00800         +                  ABERR(8), DUMJDC(20)
 00900    C
 01100    C      BLOCK DATA SET TO MC VALUES, KALIBR WILL SET REAL DATA VALUES
 01210    C--->  A CHANGE OF THIS COMMON MUST BE DONE SIMULTANEOUSLY WITH  <----
 01220    C--->  A CHANGE OF THE BLOCK DATA                                <----
 01230    C
 01300    C--------------------------- END OF MACRO CJDRCH -----------------------
 01400    C
 00000    C   30/10/79 910301050  MEMBER NAME  CWORKMX  (PATRECSR)    FORTRAN
 00100    C   16/09/79 C9092001   MEMBER NAME  CWORKMX  (UKSOR)       FORTRAN
 00200    C ==========MACRO CWORKMG =============================
 00300   5      EQUIVALENCE (ADWRK(291),HUSE(1)),(ADWRK(391),K),
 00400         * (ADWRK(392),ICL),(ADWRK(393),LRING),(ADWRK(394),KRING),
 00500         * (ADWRK(395),LR),(ADWRK(396),IRIFLG),(ADWRK(397),IUDFLG),
 00600         * (ADWRK(398),ILIM),(ADWRK(399),LR1),(ADWRK(400),IRL),
 00700         * (ADWRK(401),ITK(1,1)),(ADWRK(441),DTEMP(1)),
 00800         * (ADWRK(451),IPST),(ADWRK(452),IJFLG),(ADWRK(453),ICX),
 00900         * (ADWRK(454),KT),(ADWRK(455),ISDL),(ADWRK(456),IBFIT),
 01000         * (ADWRK(457),ISP),(ADWRK(458),ISKP(1)),(ADWRK(468),HSP1(1)),
 01100         * (ADWRK(478),ITOL),(ADWRK(479),IW),(ADWRK(480),A),
 01200         * (ADWRK(481),DS),(ADWRK(482),IWT),(ADWRK(483),ICT),
 01300         * (ADWRK(484),IKX),(ADWRK(485),LRCORN)
 01400   6      DIMENSION HUSE(200),DTEMP(10),ITK(10,4),ISKP(10),HSP1(20)
 01500   7      EQUIVALENCE (ILOUT,IBKK(3)),(ILIN,IBKK(4)),
 01600         * (ILBOT,IBKK(8)),(DCELL,BKK(9))
 01700    C ==========ENDMACRO CWORKMG==========================
          C----------------------------------------------
          C  MACRO CWORKPR .... PATTERN RECOGNITION CWORK
          C----------------------------------------------
         8      COMMON /CWORK/ HPLAST,HPFREE,HPWRK(30),ADWRK(600),
               ,               HPRO,HNTR,HNTCEL(98),IPCL(200),NRHT(200),
               ,               NWR1(200),DS1(200),SL1(200),
               ,               NWR2(200),DS2(200),SL2(200),
               ,               LBL(200),NTREL(200),ICRO(200),
               ,               NTR,HNREL(100),HISTR(9,100),HRES(168),
               ,               NTRLM,RLMTR(3,5),
               ,               WRK(7000)
         9      DIMENSION TRKAR(200,11),ITRKAR(200,11),
               ,                         LMRTR(3,5)
        10      EQUIVALENCE (IPCL(1),TRKAR(1,1),ITRKAR(1,1))
        11      EQUIVALENCE (LMRTR(1,1),RLMTR(1,1))
        12      DIMENSION IWRK(7000),HWRK(14000),IDWRK(600),HDWRK(1200)
        13      EQUIVALENCE (IWRK(1),WRK(1),HWRK(1))
        14      EQUIVALENCE (IDWRK(1),ADWRK(1),HDWRK(1))
          C---------- END OF MACRO CWORKPR --------------
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  2
0CARD TARGET
  NO  STM.NO
 
          C----------------------------------------------------------------------
          C           MACRO CDSMAX .... PATTERN RECOGNITION CONSTANTS.
          C----------------------------------------------------------------------
        15      COMMON/CDSMAX/DSMAX(16,3,2),DIRWR1(24,2),DIRWR3(48,2)
               *             ,DHALF(16,3,2),DTWICE(16,3,2),HMCH(16,3,2)
               *             ,IBCK(9),DBCK(30),TRMATS(96,2),TRMATC(96,2)
          C------------------------ END OF MACRO CDSMAX -------------------------
          C----------------------------------------------
          C  MACRO CPATLM .... PATTERN RECOGNITION LIMITS
          C----------------------------------------------
        16      COMMON /CPATLM/ PATRLM(5),FLINLM(10),TRELLM(20),ZFITLM(10),BKK(20)
               *               ,XYF(20),IGFP(20),XBKK(40),IADMIN(5),YBKK(20)
        17      INTEGER IXYF(20),LMPATR(5),LMFLIN(10)
        18      INTEGER LMTREL(20),LMZFIT(10),IBKK(20)
        19      DIMENSION GFP(20),IXBKK(40),IYBKK(20)
        20      EQUIVALENCE (PATRLM(1),LMPATR(1)),(IXBKK(1),XBKK(1)),(IYBKK(1),
               *YBKK(1))   ,(FLINLM(1),LMFLIN(1)),(TRELLM(1),LMTREL(1))
               *           ,(ZFITLM(1),LMZFIT(1)),(BKK(1),IBKK(1))
               *           ,(XYF(1),IXYF(1)),(GFP(1),IGFP(1)),(IADMIN(1),IMCERT)
               *           ,(IYBKK(20),IPPASS),(IADMIN(2),IPFAST)
          C----------- END OF MACRO CPATLM --------------
 00016  21      DIMENSION LSTCL(3),LFTCL(3),NCELL(3),TANDEL(3)
 00017  22      EQUIVALENCE (IBCK(1),LSTCL(1)),(IBCK(4),LFTCL(1))
 00018  23      EQUIVALENCE (IBCK(7),NCELL(1)),(DBCK(1),TANDEL(1))
 00019  24      DIMENSION HTEMP(9)
 00020  25      DATA MSKCR1,MSKCR2,MSKERR,MSKLR0 /Z100,Z200,Z4000,Z1000/
 00021  26      DATA MSKFIT,MSKAIT /Z20000,ZFFFDFFFF/
 00022                                                                             PERFORM ONCE FOR LR AMBIGUITY AS GIVEN IN MIDOUT
 00024  27      FOR II=1,2                                                         IF THIS IS NOT SUCCESSFUL WE WILL TRY AGAIN WITH L
 00025  28         IRL=0
 00027  29         PERFORM FNDCEL                                                  PUT CELL NUMBER OF CANDIDATE TRACK IN ICX
 00029  32         IF HNTCEL(ICX+1) - HNTCEL(ICX).GT.0                             ELEMENTS IN THIS CELL ?
 00030  33         THEN
 00032  36            NTRLX1 = HNTCEL(ICX)                                         NUMBER OF ELEMENTS
 00033  37            NTRLX2 = HNTCEL(ICX+1)-1
 00034    C     PRINT 2222,ICX,NTRLX1,NTRLX2
 00035    C2222 FORMAT(' TRY RING CON    CELL=',I4,' TRACKS=',2I4)
 00037  38            KRING = LRING - 1                                            NEW RING NUMBER
 00038                                                                             INITIALIZE FOR USE IN CASE THERE IS MORE THAN ONE
 00040  39            LRCORN=0                                                     INITIALIZE CORNER FLAG
 00042  40            FOR KX = NTRLX1,NTRLX2                                       LOOP OVER ELEMENTS IN NEW CELL
 00044  41               IF HUSE(KX).EQ.0                                          HAS THIS TRACK BEEN USED YET?
 00045  42               THEN
 00047  45                  IF KRING.EQ.2                                          MATCHING FROM RING 3 AND FROM RING 2 MUST BE HANDL
 00048  46                  THEN
 00049  49                     PERFORM MATCH1
 00051  52                  ELSE                                                   FOR MATCHING BETWEEN RING 2 AND RING 1
 00052  54                     PERFORM MATCH2
 00053  57                  CIF
 00054  58               CIF
 00055  59            CFOR
 00057  61         CIF                                                             SEE IF WE'VE BEEN SUCCESSFUL
 00058                                                                             IF WE'VE FAILED THEN TRY A CORNER CONNECTION
 00059                                                                             TRY A CONNECTION ON RIGHT SIDE
 00061  62         PERFORM FNDCEL                                                  FIND CELL NUMBER OF CANDIDATE TRACK
 00062  65         KRING=LRING-1
 00063  66         ICX=ICX+1
 00064  67         IF(ICX.GT.LSTCL(KRING)) ICX=ICX-NCELL(KRING)
 00066  69         LRCORN=1                                                        TRY CORNER CONNECTION WITH FLAG SET FOR RIGHT
 00067  70         PERFORM CORNER
 00069  73         PERFORM FNDCEL                                                  TRY A LEFT CONNECTION
 00070  76         KRING=LRING-1
 00071  77         ICX=ICX-1
 00072  78         IF(ICX.LT.LFTCL(KRING)) ICX=ICX+NCELL(KRING)
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  3
0CARD TARGET
  NO  STM.NO
 
 00074  80         LRCORN=-1                                                       TRY A LEFT CORNER CONNECTION
 00075  81         PERFORM CORNER
 00076  84         IF IRIFLG.EQ.1
 00078  85         THEN                                                            IF SUCCESSFUL SEE IF THERE IS A
 00080  88            PERFORM LKAHED                                               BETTER MATCH TO THIS CANDIDATE
 00081  91         CIF
 00082  92         KMP1=HISTR(1,NTR)
 00083  93         KMP1=IABS(KMP1)
 00084  94         KMP1=IPCL(KMP1)
 00085  95         KMP2=HISTR(HNREL(NTR),NTR)
 00086  96         KMP2=IABS(KMP2)
 00087  97         KMP2=IPCL(KMP2)
 00089  98         PERFORM PRESTO                                                  HAVE WE BEEN SUCCESSFUL
 00091 101         IF IRIFLG.NE.0.OR.IPST.EQ.0.OR.LR.EQ.0.OR.IBKK(20).NE.0.AND.    IF WE'VE SUCCEEDED THEN END THE 'FOR' LOOP
 00092         $      IJFLG.EQ.0.AND.NRHT(K).GE.IBKK(19).OR.KMP1.NE.KMP2
 00093 102         THEN
 00094 105            XFOR
 00095 106         ELSE
 00097 107            LR=-LR                                                       OTHERWISE TRY THE OTHER AMBIGUITY
 00098    C     PRINT 389
 00099    C389  FORMAT(' *************** ERROR IN LR FLAG IN RINCON *******')
 00100 108         CIF
 00101 109      CFOR
 00102 111      RETURN
 00103    C
 00104    C     ******************************************************
 00105    C
 00106 112      PROC LKAHED
 00107    C
 00108    C     THIS PROC IS ENTERED AFTER ASUCCESSFUL RING
 00109    C     CONNECTION. IT CHECKS TO SEE IF THERE EXISTS
 00110    C     A BETTER MATCH TO THIS CANDIDATE TRACK
 00111    C     WITH ANOTHER PARENT
 00112    C
 00113 113         IBFIT=-4
 00114 114         IRT=IRL
 00115 115         ITMP=LR
 00117 116         ITMP1=K                                                         REMEMBER THESE FLAGS
 00118 117         ITMP2=ICL
 00120 118         FOR JK=1,IRT                                                    FOR EACH CANDIDATE
 00121 119            LRCORN=0
 00122 120            KX=ITK(JK,1)
 00123 121            ICX=IPCL(KX)
 00124 122            IC1=ICX+24
 00125 123            IC2=IC1
 00127 124            IF LRING.EQ.3                                                FOR RING 2 TO RING 1 CONNECTION)
 00128 125            THEN
 00129 128               IC1=2*ICX-1
 00130 129               IC2=IC1+1
 00131 130            CIF
 00132 131            ICZ=IC1
 00133 132            IF HNTCEL(IC2+1)-HNTCEL(IC1).GT.0
 00134 133            THEN
 00135 136               NTRLX3=HNTCEL(IC1)
 00136 137               NTRLX4=HNTCEL(IC2+1)-1
 00137    C     CALL CHKX(63,NTRLX3,NTRLX4,IC1)
 00139 138               FOR IB=NTRLX3,NTRLX4                                      TRY ALL THE PARENTS
 00140 139                  IBFIT=-4
 00141 140                  IF HUSE(IB).EQ.0.OR.LAND(LBL(IB),MSKERR).NE.0
 00142 141                  THEN
 00143 144                     K=IB
 00144 145                     ICL=IPCL(IB)
 00145    C     CALL CHKX(64,K,IB,ICL)
 00146 146                     IF KRING.EQ.2
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  4
0CARD TARGET
  NO  STM.NO
 
 00147 147                     THEN
 00148 150                        LR=0
 00149 151                        PERFORM LRPAR
 00151 154                        PERFORM MATCH1                                   RING 3 TO RING 2 CONNECTION
 00152 157                     ELSE
 00153 159                        LR=ITK(JK,3)
 00154 160                        PERFORM LRPAR
 00156 163                        PERFORM MATCH2                                   RING 2 TO RING 1 CONNECTION
 00157 166                     CIF
 00158 167                  CIF
 00159 168               CFOR
 00160 170            CIF
 00161 171            IC1=ICZ+1
 00162 172            IF(LRING.EQ.3) IC1=ICZ+2
 00163 174            IF(IC1.GT.LSTCL(LRING)) IC1=IC1-NCELL(LRING)
 00164 176            IC2=IC1
 00165 177            IF(LRING.EQ.3) IC2=IC1+1
 00166 179            IF HNTCEL(IC2+1)-HNTCEL(IC1).GT.0
 00167 180            THEN
 00168 183               NTRLX3=HNTCEL(IC1)
 00169 184               NTRLX4=HNTCEL(IC2+1)-1
 00170    C     CALL CHKX(73,NTRLX3,NTRLX4,IC1)
 00172 185               FOR IB=NTRLX3,NTRLX4                                      TRY ALL THE PARENTS
 00173 186                  IBFIT=-4
 00174 187                  IF HUSE(IB).EQ.0.OR.LAND(LBL(IB),MSKERR).NE.0
 00175 188                  THEN
 00176 191                     K=IB
 00177 192                     ICL=IPCL(IB)
 00178    C     CALL CHKX(74,K,IB,ICL)
 00179 193                     LRCORN=-1
 00180 194                     LR=0
 00181 195                     PERFORM LRPAR
 00182 198                     PERFORM MATCH3
 00183 201                  CIF
 00184 202               CFOR
 00185 204            CIF
 00186 205            IC1=ICZ-1
 00187 206            IF(LRING.EQ.3) IC1=ICZ-2
 00188 208            IF(IC1.LT.LFTCL(LRING)) IC1=IC1+NCELL(LRING)
 00189 210            IC2=IC1
 00190 211            IF(LRING.EQ.3) IC2=IC1+1
 00191 213            IF HNTCEL(IC2+1)-HNTCEL(IC1).GT.0
 00192 214            THEN
 00193 217               NTRLX3=HNTCEL(IC1)
 00194 218               NTRLX4=HNTCEL(IC2+1)-1
 00195    C     CALL CHKX(83,NTRLX3,NTRLX4,IC1)
 00197 219               FOR IB=NTRLX3,NTRLX4                                      TRY ALL THE PARENTS
 00198 220                  IBFIT=-4
 00199 221                  IF HUSE(IB).EQ.0.OR.LAND(LBL(IB),MSKERR).NE.0
 00200 222                  THEN
 00201 225                     K=IB
 00202 226                     ICL=IPCL(IB)
 00203    C     CALL CHKX(84,K,IB,ICL)
 00204 227                     LRCORN=1
 00205 228                     LR=0
 00206 229                     PERFORM LRPAR
 00207 232                     PERFORM MATCH3
 00208 235                  CIF
 00209 236               CFOR
 00210 238            CIF
 00211 239         CFOR
 00212 241         LR=ITMP
 00214 242         ICL=ITMP2                                                       RESET FLAGS
 00215 243         K=ITMP1
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  5
0CARD TARGET
  NO  STM.NO
 
 00216 244         IBFIT=0
 00217 245      CPROC
 00218    C
 00219    C   *************************************************************
 00220    C
 00221 247      PROC MATCH1
 00222    C
 00223    C     THIS PROC CALLED FOR MATCHING
 00224    C     FROM RING 3 TO RING 2
 00225    C
 00227 248         PERFORM DSRIN                                                   COMPUTE QUANTITIES USED IN MATCHING FROM RING 3 TO
 00229 251         IF LR.NE.0                                                      HERE WE KNOW THE L-R AMBIGUITY IN RING 3
 00230 252         THEN
 00231 255            LRT=LR
 00233 256            PERFORM JOIN                                                 TRY A CONNECTION
 00235 259         ELSE                                                            HERE WE DON'T KNOW THE L-R SOL'N IN RING 3
 00237 261            DSEX=DSEXR                                                   FIRST TRY RIGHT SOLN
 00238 262            LRT=1
 00239 263            SLEX=SLEXR
 00240 264            PERFORM JOIN
 00242 267            DSEX=DSEXL                                                   THEN TRY THE LEFT SOLN
 00243 268            LRT=-1
 00244 269            SLEX=SLEXL
 00245 270            PERFORM JOIN
 00246 273         CIF
 00247 274      CPROC
 00248    C
 00249    C     ***********************************************************
 00250    C
 00251 276      PROC MATCH2
 00252    C
 00253    C     THIS PROC CALLED FOR MATCHING
 00254    C     BETWEEN RING 2 TO RING 1
 00255    C
 00256 277         LR1=LR
 00258 278         IF(LR.EQ.0) LR1=1                                               SET LR FLAG ARBITRARILY 1 IF IT IS ZERO
 00259 280         IF(LR.EQ.0.AND.IBKK(20).NE.0.AND.NRHT(K).GE.IBKK(19)) IJFLG=1
 00260 282         LRT=LR1
 00261 283         LRS=LR1
 00262 284         PERFORM NOTH
 00263 287         PERFORM FCNT
 00264 290         SL=SL1K-FCONT*.5*(W3-W2)
 00266 291         DSEX=D-SL*(W3-W2)                                               COMPUTE EXPECTED DRIFT SPACE
 00268 292         PERFORM JOIN                                                    TRY A CONNECTION
 00269 295      CPROC
 00270    C
 00271    C   *************************************************************
 00272    C
 00273 297      PROC FNDCEL
 00274    C
 00275    C     IF A TRACK EXISTS IN CELL 'ICL',RING 'LRING'
 00276    C     THEN THIS PROC PLACES IN ICX THE CELL WHERE
 00277    C     A MATCHING TRACK ACROSS THE RING SHOULD BE FOUND
 00278    C
 00279 298         ICX=ICL
 00281 299         IF(LRING.EQ.3) ICX =(ICX+1)/2                                   EXPECTED CELLNUMBER IN NEXT RING
 00282 301         IF(LRING.EQ.2) ICX = ICX - 24
 00283 303      CPROC
 00284    C
 00285    C     **********************************************************
 00286    C
 00287 305      PROC PRESTO
 00288    C
 00289    C     THIS PROC CHOOSES BEST MATCH(WHEN MORE THAN ONE EXISTS)
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  6
0CARD TARGET
  NO  STM.NO
 
 00290    C     AND STORES IT AWAY
 00291    C
 00293 306         IF IRIFLG.EQ.1                                                  AT LEAST ONE MATCH
 00294 307         THEN
 00296 310            IF IRL.GT.1                                                  IS THERE ONLY ONE SOLN?
 00297 311            THEN
 00299 314               CALL CHOOSE                                               CHOOSE ONE
 00300 315            CIF
 00301 316            IF IRIFLG.EQ.1
 00302 317            THEN
 00303 320               K=ITK(1,1)
 00304 321               IKX=K
 00306 322               IF(LR.EQ.0.AND.ITK(1,2).EQ.-1) HISTR(1,NTR)=-HISTR(1,NTR) CHANGE THE AMBIGUITY OF THE PARENT
 00308 324               ICL=IPCL(IKX)                                             RESET POINTERS AND STORE IT AWAY
 00309 325               LRCORN=0
 00310 326               IPAR=ITK(1,4)
 00311 327               IPAR=IPCL(IPAR)+ICL
 00312 328               IF(LAND(IPAR,1).EQ.1) LRCORN=1
 00313 330               IF(LRCORN.EQ.1.OR.KRING.EQ.2) IJFLG=0
 00314    C     IF(LR.EQ.0.AND.KRING.EQ.1.AND.LRCORN.EQ.0) IJFLG=1
 00315 332               LR=ITK(1,3)
 00316 333               IF(II.EQ.2) CALL COREC
 00317 335               IF(KMP1.EQ.KMP2.AND.KRING.EQ.1.AND.II.EQ.2.AND.LRCORN.EQ.0)
 00318         *         IJFLG=1
 00319 337               LRING=KRING
 00320 338               CALL BSTORE
 00321 339               IPST=0
 00322 340            CIF
 00323 341         CIF
 00324 342      CPROC
 00325    C
 00326    C     *************************************************************
 00327    C
 00328 344      PROC CORNER
 00329    C
 00330    C     THIS PROC MATCHES TRACKS ACROSS RINGS
 00331    C     WHEN THEY HAVE CROSSED THE CORNER OF THE CELL WALLS
 00332    C
 00334 345         IF HNTCEL(ICX+1)-HNTCEL(ICX).GT.0                               ANY ELEMENTS IN THE EXPECTED CELL?
 00335 346         THEN
 00337 349            NTRLX1=HNTCEL(ICX)                                           EXPECTED NUMBER OF TRACKS
 00338 350            NTRLX2=HNTCEL(ICX+1)-1
 00339 351            FOR KX=NTRLX1,NTRLX2
 00341 352               IF HUSE(KX).EQ.0                                          HAS IT BEEN USED YET?
 00342 353               THEN
 00343 356                  PERFORM MATCH3
 00344 359               CIF
 00345 360            CFOR
 00346 362         CIF
 00347 363      CPROC
 00348    C
 00349    C     ***********************************************************
 00350    C
 00351 365      PROC MATCH3
 00352    C
 00353    C
 00355 366         PERFORM DSCORN                                                  INITIALIZE QUANTITIES FOR CORNER MATCHING
 00356    C     PRINT 6654,ICX,KX
 00357    C6654 FORMAT(' TRY CORNER CONNECTION,CELL=',I4,' TRACK=',I4)
 00359 369         LR1=-LRCORN                                                     TRY A CONNECTION
 00360 370         IF LR.NE.0
 00361 371         THEN
 00362 374            LRT=LR
 00363 375            PERFORM JOIN
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  7
0CARD TARGET
  NO  STM.NO
 
 00364 378         ELSE
 00365 380            LRT=1
 00366 381            DSEX=DSEXR
 00367 382            SLEX=SLEXR
 00368 383            PERFORM JOIN
 00369 386            LRT=-1
 00370 387            DSEX=DSEXL
 00371 388            SLEX=SLEXL
 00372 389            PERFORM JOIN
 00373 392         CIF
 00374 393      CPROC
 00375    C
 00376    C     **************************************************************
 00377    C
 00378 395      PROC JOIN
 00379    C
 00380    C     THIS PROC ATTEMPTS TO JOIN TRACKS ACROSS A RING BOUNDARY
 00381    C
 00382 396         IOFF=0
 00383 397         IF(NRHT(K).LE.6.OR.NRHT(KX).LE.6) IOFF=IOFF+1
 00384 399         IF(ITOL.NE.1) IOFF=IOFF+2
 00385 401         IF(LRCORN.NE.0) IOFF=IOFF+4
 00386 403         DSM=XBKK(IOFF+1)
 00387 404         SLCON=XBKK(IOFF+9)
 00388 405         SLX=XBKK(IOFF+17)
 00389 406         DX=XBKK(IOFF+25)
 00390    C     ISIS=(3+LR1)/2
 00391    C     DT=DSMAX(NWR2(KX)+1,KRING,ISIS)
 00392    C     IF(ABS(DSEX).GT.DT) DSEX=SIGN(DT,DSEX)
 00394 407         ICROSS=0                                                        CROSSING THE WIRE PLANEIN THE CELL WALL
 00395 408         MAMB=0
 00396 409         IF(NRHT(KX).GE.IBKK(19).AND.IBKK(20).NE.0) MAMB=1
 00397 411         IF MAMB.NE.0
 00398 412         THEN
 00399 415            JT=IKX
 00400 416            IKX=KX
 00401 417            CALL LFRT(LRC)
 00402 418            IF LRC.NE.0
 00403 419            THEN
 00404 422               IF(LAND(LBL(KX),MSKCR1).NE.0) LRC=-LRC
 00405 424               IF(LRC.NE.LR1) ICROSS=1
 00406    C     IF(LRC.NE.LR1) PRINT 632,KX
 00407    C632  FORMAT('  CROSSING FORCED FOR TRACK',I5)
 00408 426            CIF
 00409 427            IKX=JT
 00410 428         CIF
 00411 429         EPS=-.00001
 00412 430         IF MAMB.EQ.0.OR.MAMB.NE.0.AND.LRC.EQ.0
 00413 431         THEN
 00414 434            IF(DSEX.LT.0..AND.SL2(KX).LT.EPS.OR.DSEX.LT.DX.AND.
 00415         *      DS2(KX).LT.DX.AND.SL2(KX).LT.EPS) ICROSS=1
 00416 436         CIF
 00417 437         DTMP=DSEX-DS2(KX)
 00418 438         IF(ICROSS.EQ.1) DTMP=DSEX+DS2(KX)
 00419    C     CALL CHKX(-99,DSEX,DTMP,DSM)
 00421 440         IF ABS(DTMP).LT.DSM                                             IS THE EXPECTED DRIFT SPACE CLOSE ENOUGH?
 00422 441         THEN
 00423    C     PRINT 2223,DTMP,KX,LRT,LR1,KRING,K
 00424    C2223 FORMAT(' RING CONNECTION,EXPECTED-ACTUAL DRIFT TIME='
 00425    C    * ,F7.3,' TRACK=',I4,' LR(PARENT)=',I4,' LR(CANDIDATE)=',I4,
 00426    C    * ' RING=',I4,' PARENT TRACK',I4)
 00427 444            IF(ICROSS.EQ.1) LR1=-LR1
 00428    C     IF(ICROSS.EQ.1) PRINT 4428,K,KX,DSEX
 00429    C4428 FORMAT(' WIRE CROSSING AT CELL BOUNDARY FROM TRACK',I4,' TO TRACK,
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  8
0CARD TARGET
  NO  STM.NO
 
 00430    C    *',I4,' DSEX=',F7.3)
 00431 446            INTFLG=0
 00432 447            IKX=0
 00433 448            ICFIT=IBFIT
 00434 449            IBFIT=-1
 00436 450            IF HNTCEL(ICX+1)-HNTCEL(ICX) .GT. 1                          WE WILL NOW CHECK TO SEE IF
 00438 451            THEN                                                         THIS CANDIDATE JOINS INSIDE A CELL
 00440 454               NTRLX1=HNTCEL(ICX)                                        WITH A TRACK ELEMENT IN THE UPPER
 00442 455               NTRLX2=HNTCEL(ICX+1)-1                                    HALF OF THE CELL
 00444 456               FOR KK=NTRLX1,NTRLX2                                      LOOP OVER ALL TRACK ELS IN THIS CELL
 00446 457                  IF HUSE(KK).EQ.0                                       WITH LOWER TRACK EL FIXED AT KX
 00447 458                  THEN
 00448 461                     IW=NWR1(KK)
 00449 462                     IF IW.GE.ILBOT
 00450 463                     THEN
 00452 466                        CALL  INTJN1(KK,KX,INTFLG,DT)                    TRY CONNECTION WITHIN A CELL
 00454 467                        IF INTFLG.NE.0                                   SUCCESS SO REJECT THIS RING CONNECTION
 00455 468                        THEN
 00456    C     PRINT 675
 00457    C675  FORMAT(' REJECTED BECAUSE OF INTJN')
 00458 471                           XFOR
 00459 472                        CIF
 00460 473                     CIF
 00461 474                  CIF
 00462 475               CFOR
 00463 477            CIF
 00464 478            IF LRCORN.NE.0.AND.INTFLG.EQ.0
 00465 479            THEN
 00466 482               LRY=LR1
 00467 483               IF LRCORN.EQ.1
 00468 484               THEN
 00469 487                  LR1=1
 00470 488                  ICT=ICX-1
 00471 489                  IF(ICT.LT.LFTCL(KRING)) ICT=ICT+NCELL(KRING)
 00472 491               CIF
 00473 492               IF LRCORN.EQ.-1
 00474 493               THEN
 00475 496                  LR1=2
 00476 497                  ICT=ICX+1
 00477 498                  IF(ICT.GT.LSTCL(KRING)) ICT=ICT-NCELL(KRING)
 00478 500               CIF
 00479 501               IF HNTCEL(ICT+1)-HNTCEL(ICT).GT.0
 00480 502               THEN
 00481    C     PRINT 9654
 00482    C9654 FORMAT(' ======= ATTEMPT SIDOUT ==============')
 00483 505                  A=TRKAR(KX,8)
 00484 506                  DS=TRKAR(KX,7)
 00485 507                  IW=ITRKAR(KX,6)
 00486 508                  IUDFLG=3
 00487 509                  ILIM=ILOUT
 00488 510                  KT=KX
 00489 511                  CALL SIDE1
 00490    C     IF(IKX.NE.0) PRINT 2349
 00491    C2349 FORMAT('   REJECTED BECAUSE OF SIDOUT  ')
 00492 512               CIF
 00493 513               LR1=LRY
 00494 514            CIF
 00495 515            IBFIT=ICFIT
 00497 516            IF INTFLG.EQ.0.AND.IKX.EQ.0                                  THIS CANDIDATE DOES NOT INTJOIN
 00498 517            THEN
 00500    C     IF NRHT(K).GT.6.AND.NRHT(KX).GT.6                                  IF ENOUGH HITS COMPARE SLOPES
 00501    C     THEN
 00503 520               PERFORM SLRIN2                                            COMPARE SLOPES
 00504    C     ELSE
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  9
0CARD TARGET
  NO  STM.NO
 
 00505    C     PERFORM TK
 00506    C     DTEMP(IRL)=ABS(DTMP)
 00507    C     CIF
 00508 523            CIF
 00509 524         CIF
 00510 525      CPROC
 00511    C
 00512    C     ******************************************************
 00513    C
 00514 527      PROC DSCORN
 00515    C
 00516    C     THIS PROC INITIALIZES QUANTITIES USED IN COMPARING
 00517    C     DRIFT TIMES FOR CORNER MATCHING
 00518    C
 00519 528         PERFORM NOTH
 00520 531         IF KRING.EQ.2
 00521 532         THEN
 00522 535            IF LAND(ICL,1).EQ.1
 00523 536            THEN
 00524 539               KR=3
 00525 540               IN1=19
 00526 541               IN2=21
 00527 542               IN3=20
 00528 543               JR=KRING
 00529 544               IN4=10
 00530 545               IN5=12
 00531 546               IN6=13
 00532 547               PERFORM DSINIT
 00533 550            CIF
 00534 551            IF LAND(ICL,1).NE.1
 00535 552            THEN
 00536 555               KR=KRING
 00537 556               IN1=11
 00538 557               IN2=13
 00539 558               IN3=12
 00540 559               JR=3
 00541 560               IN4=18
 00542 561               IN5=20
 00543 562               IN6=21
 00544 563               PERFORM DSINIT
 00545 566            CIF
 00546 567         ELSE
 00547 569            KR=KRING
 00548 570            IN1=15
 00549 571            IN2=17
 00550 572            IN3=16
 00551 573            JR=KRING
 00552 574            IN4=14
 00553 575            IN5=16
 00554 576            IN6=17
 00555 577            PERFORM DSINIT
 00556 580         CIF
 00557 581      CPROC
 00558    C
 00559    C      *********************************************************
 00560    C
 00561    C
 00562 583      PROC DSINIT
 00563    C
 00564    C
 00565    C
 00566    C
 00567 584         IF LRCORN.EQ.1
 00568 585         THEN
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE 10
0CARD TARGET
  NO  STM.NO
 
 00569 588            DSMX=DTWICE(NWR2(KX)+1,KR,1)
 00570 589            X1=DBCK(IN1)
 00571 590            IF LR.EQ.0.OR.LR.EQ.1
 00572 591            THEN
 00573 594               X2=DBCK(IN2)
 00574 595               LRS=1
 00575 596               PERFORM FCNT
 00576 599               PERFORM XQQ
 00577 602               DSEX=DSMX-XQ
 00578 603            CIF
 00579 604            IF(LR.EQ.0) DSEXR=DSEX
 00580 606            IF(LR.EQ.0) SLEXR=SLEX
 00581 608            IF LR.EQ.0.OR.LR.EQ.-1
 00582 609            THEN
 00583 612               X2=DBCK(IN3)
 00584 613               LRS=-1
 00585 614               PERFORM FCNT
 00586 617               PERFORM XQQ
 00587 620               DSEX=DSMX+XQ
 00588 621            CIF
 00589 622            IF(LR.EQ.0) DSEXL=DSEX
 00590 624            IF(LR.EQ.0) SLEXL=SLEX
 00591 626         ELSE
 00592 628            DSMX=DTWICE(NWR2(KX)+1,JR,2)
 00593 629            X1=DBCK(IN4)
 00594 630            IF LR.EQ.0.OR.LR.EQ.1
 00595 631            THEN
 00596 634               X2=DBCK(IN5)
 00597 635               LRS=1
 00598 636               PERFORM FCNT
 00599 639               PERFORM XQQ
 00600 642               DSEX=DSMX+XQ
 00601 643            CIF
 00602 644            IF(LR.EQ.0) DSEXR=DSEX
 00603 646            IF(LR.EQ.0) SLEXR=SLEX
 00604 648            IF LR.EQ.0.OR.LR.EQ.-1
 00605 649            THEN
 00606 652               X2=DBCK(IN6)
 00607 653               LRS=-1
 00608 654               PERFORM FCNT
 00609 657               PERFORM XQQ
 00610 660               DSEX=DSMX-XQ
 00611 661            CIF
 00612 662            IF(LR.EQ.0) DSEXL=DSEX
 00613 664            IF(LR.EQ.0) SLEXL=SLEX
 00614 666         CIF
 00615 667      CPROC
 00616    C
 00617    C     ******************************************************
 00618    C
 00619 669      PROC SLRIN2
 00620    C
 00621    C     THIS PROC TRANSFORMS SLOPES THEN COMPARES THEM
 00622    C
 00623 670         IF KRING.EQ.2.OR.LRCORN.NE.0
 00625 671         THEN                                                            FOR RING 3 TO RING 2 OR CORNER CONNECTION
 00626 674            SL=SLEX
 00627 675            IF(LRT*LR1.EQ.1) SL=-SL
 00628 677            IF(ICROSS.EQ.1) SL=-SL
 00630 679            T=DBCK(6)                                                    T IS ANGLE BETWEEN WIRE PLANES FOR
 00632 680            IF(KRING.EQ.2.AND.LRCORN.NE.0) T=DBCK(7)                     PARENT AND CANDIDATE
 00633 682            IF(KRING.EQ.1.AND.LRCORN.NE.0) T=TANDEL(2)
 00634 684            IF(LAND(ICL,1).EQ.1.AND.LRCORN.EQ.1.OR.
 00635         *      LAND(ICL,1).NE.1.AND.LRCORN.EQ.-1) T=DBCK(22)
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE 11
0CARD TARGET
  NO  STM.NO
 
 00636                                                                             ROTATE TO NEW WIRE CO-ORDINATE SYSTEM
 00638 686            SLEX=(T-SL)/(1.+SL*T)                                        EXPECTED SLOPE
 00639 687         CIF
 00641 688         IF(ICROSS.EQ.1) SLEX=-SLEX                                      CORRECT EXPECTED SLOPE IF IT CROSSES WIRE PLANE
 00642                                                                             IN THE CELL WALL
 00644 690         SL=SL2(KX)/RINCR(KRING)                                         CANDIDATE SLOPE
 00646 691         SLC=SLCOR(SL,LR1)                                               TRANSFORM CANDIDATE SLOPE
 00647 692         SLTMP=SLC-SLEX
 00649 693         SLOLIM=(ABS(SLEX)+ABS(SLC))/2.*SLX+SLCON                        TOLERANCE ON SLOPE MATCHING
 00650    C      PRINT 2229,KX,SLTMP,SLOLIM,K
 00651    C2229 FORMAT(' COMPARE SLOPES, TRACK=',I4,' SL-SLEX ',F7.3,' SLOLIM'
 00652                                                                             ,F7.3,' PARENT TRACK',I4)
 00654 694         IF ABS(SLC-SLEX) .LT. SLOLIM                                    DO THE SLOPES AGREE
 00655 695         THEN
 00656 698            IXXB=0
 00657 699            IF IBKK(18).NE.0.AND.IBFIT.EQ.0
 00658 700            THEN
 00659 703               PERFORM FITRIN
 00660 706            CIF
 00661 707            IF IXXB.EQ.0
 00662 708            THEN
 00664 711               PERFORM TK                                                STORE AWAY TRACK
 00665 714               DTEMP(IRL)=ABS(DTMP*(SLC-SLEX))
 00666 715            CIF
 00667 716         CIF
 00668 717      CPROC
 00669    C
 00670    C    *********************************************************
 00671    C
 00672 719      PROC TK
 00673    C
 00674    C     THIS PROC FILLS ITK ARRAY
 00675    C
 00676 720         IRIFLG=1
 00677 721         IF IRL.LT.10
 00678 722         THEN
 00679 725            IRL=IRL+1
 00681 726            ITK(IRL,1)=KX                                                CANDIDATE TRACK EL
 00683 727            ITK(IRL,3)=LR1                                               CANDIDATE LR
 00685 728            ITK(IRL,2)=LRT                                               PARENT LR
 00687 729            ITK(IRL,4)=K                                                 PARENT TRACK EL
 00688 730         ELSE
 00689    C     PRINT 4953
 00690    C4953 FORMAT(' TOO MANY CHOICES   ýýýýýýýýýýýýýýýýýýýýýý')
 00691 732         CIF
 00692 733      CPROC
 00693    C
 00694    C    ************************************************************
 00695    C
 00696 735      PROC DSRIN
 00697    C
 00698    C     THIS PROC COMPUTES QUANTITIES USED IN MATCHING
 00699    C     DRIFT TIMES FOR TRACKS PASSING FROM RING 3 TO RING 2
 00700    C     THE EXPECTED DRIFT TIMES ARE PUT INTO DSEX,DSEXR,DSEXL
 00701    C
 00702 736         PERFORM NOTH
 00704 739         IF LAND(ICL,1).EQ.1                                             ODD CELL IN RING 3
 00705 740         THEN
 00706 743            LR1=-1
 00707 744            DSMX=DHALF(NWR2(KX)+1,KRING,1)
 00708 745            IF LR.EQ.-1.OR.LR.EQ.0
 00709 746            THEN
 00710 749               LRS=-1
 00711 750               PERFORM FCNT
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE 12
0CARD TARGET
  NO  STM.NO
 
 00712 753               X1=DBCK(5)
 00713 754               X2=DBCK(8)
 00714 755               PERFORM XQQ
 00715 758               DSEX=DSMX+XQ
 00716 759            CIF
 00717 760            IF(LR.EQ.0) DSEXL=DSEX
 00718 762            IF(LR.EQ.0) SLEXL=SLEX
 00719 764            IF LR.EQ.1.OR.LR.EQ.0
 00720 765            THEN
 00721 768               LRS=1
 00722 769               PERFORM FCNT
 00723 772               X1=DBCK(5)
 00724 773               X2=DBCK(9)
 00725 774               PERFORM XQQ
 00726 777               DSEX=DSMX-XQ
 00727 778            CIF
 00728 779            IF(LR.EQ.0) DSEXR=DSEX
 00729 781            IF(LR.EQ.0) SLEXR=SLEX
 00730 783         CIF
 00732 784         IF LAND(ICL,1).NE.1                                             EVEN CELL IN RING 3
 00733 785         THEN
 00734 788            LR1=1
 00735 789            DSMX=DHALF(NWR2(KX)+1,KRING,2)
 00736 790            IF LR.EQ.-1.OR.LR.EQ.0
 00737 791            THEN
 00738 794               LRS=-1
 00739 795               PERFORM FCNT
 00740 798               X1=DBCK(4)
 00741 799               X2=DBCK(9)
 00742 800               PERFORM XQQ
 00743 803               DSEX=DSMX-XQ
 00744 804            CIF
 00745 805            IF(LR.EQ.0) DSEXL=DSEX
 00746 807            IF(LR.EQ.0) SLEXL=SLEX
 00747 809            IF LR.EQ.1.OR.LR.EQ.0
 00748 810            THEN
 00749 813               LRS=1
 00750 814               PERFORM FCNT
 00751 817               X1=DBCK(4)
 00752 818               X2=DBCK(8)
 00753 819               PERFORM XQQ
 00754 822               DSEX=DSMX+XQ
 00755 823            CIF
 00756 824            IF(LR.EQ.0) DSEXR=DSEX
 00757 826            IF(LR.EQ.0) SLEXR=SLEX
 00758 828         CIF
 00759 829      CPROC
 00760    C
 00761    C    **********************************************************
 00762    C
 00763 831      PROC FCNT
 00764    C
 00765    C     THIS PROC COMPUTES SLOPE CONTINUATION FACTOR
 00766    C
 00768 832         SLC1=SLCOR(SL1K,LRS)                                            TRANSFORM SL1(K)
 00769                                                                             CHECK FOR CROSSING THE WIRE PLANE
 00770 833         IF(LAND(LBL(K),MSKCR1).NE.0.AND.LAND(LBL(K),MSKCR2).EQ.0)LRS=-LRS
 00772 835         SLC2=SLCOR(SL2K,LRS)                                            TRANSFORM SL2(K)
 00773                                                                             TO GET CORRECT CONTINUATION FACTOR IF TRACK CROSSE
 00775 836         IF LAND(LBL(K),MSKCR1).NE.0.AND.LAND(LBL(K),MSKCR2).EQ.0        THE WIRE PLANE
 00776 837         THEN
 00777 840            SLC2=ABS(SLC2)
 00778 841            IF(SLC1.LT.0.) SLC2=-SLC2
 00779 843         CIF
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE 13
0CARD TARGET
  NO  STM.NO
 
 00781 844         FCONT=(SLC2-SLC1)/(NWR2(K)-NWR1(K))/RINCR(KRING+1)              COMPUTE CONTIUATION FACTOR FOR PARENT TRACK
 00782 845         IF(ABS(FCONT).GT..001.AND.NRHT(K).LE.8) FCONT=FCONT/2.
 00784 847         SLEX=SLC1-FCONT*(W3-W2)                                         EXPECTED SLOPE USING CONT FACTOR
 00785    C     PRINT 612,FCONT,SLEX
 00786    C612  FORMAT(' SLOPE CONT FACTOR= ',F10.5,' EXPECTED SLOPE= ',F10.5)
 00787 848      CPROC
 00788    C     ************************************************************
 00789    C
 00790 850      PROC NOTH
 00791    C
 00792    C     THIS PROC COMPUTES WIRE DISTANCES ETC. FOR USE IN
 00793    C     MATCHING DRIFT TIMES BETWEEN RING 3 AND RING 2
 00794    C
 00795 851         SL1K=SL1(K)/RINCR(KRING+1)
 00796 852         SL2K=SL2(K)/RINCR(KRING+1)
 00797 853         D=DS1(K)
 00798 854         W3=FSENSW(KRING+1)+NWR1(K)*RINCR(KRING+1)
 00799 855         W2=FSENSW(KRING)+NWR2(KX)*RINCR(KRING)
 00800 856      CPROC
 00801    C
 00802    C     ***********************************************************
 00803    C
 00804 858      PROC XQQ
 00805    C
 00806    C     THIS PROC COMPUTES QUANTITIES USED IN MATCHING
 00807    C     DRIFT TIMES BETWEEN RING 3 AND RING 2
 00808    C
 00809 859         SL=SL1K-FCONT*.5*(W3-W2)
 00810 860         X=D*DRICOS/X1
 00811 861         XQ=W3-(W2*DRICOS+D*X2)/X1
 00812 862         XQ=X-SL*DRICOS*XQ/(X1-SL*X2)
 00813 863      CPROC
 00814    C
 00815    C     *************************************************************
 00816    C
 00817 865      PROC LRPAR
 00818    C
 00819    C     THIS PROC EXTRACTS LR AMBIGUITY FOR PREVIOUSLY
 00820    C     STORED TRACK ELEMENT
 00821    C
 00822 866         IF LAND(LBL(K),MSKERR).NE.0.AND.LAND(LBL(K),MSKLR0).EQ.0
 00823 867         THEN
 00824 870            FOR KTR=1,100
 00825 871               ITMM=HNREL(KTR)
 00826 872               IF ITMM.GT.0
 00827 873               THEN
 00828 876                  JA=HISTR(ITMM,KTR)
 00829 877                  IF IABS(JA).EQ.K
 00830 878                  THEN
 00831 881                     LR=ISIGN(1,JA)
 00832 882                     XFOR
 00833 883                  CIF
 00834 884               ELSE
 00835 886                  XFOR
 00836 887               CIF
 00837 888            CFOR
 00838    C     CALL CHKX(27,LR,K,NTR)
 00839 890         CIF
 00840 891      CPROC
 00841    C
 00842    C    ********************************************************
 00843    C
 00844 893      PROC FITRIN
 00845 894         IXXB=0
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE 14
0CARD TARGET
  NO  STM.NO
 
 00846 895         IF HNREL(NTR).LT.9
 00847 896         THEN
 00848 899            CALL MVC(HTEMP(1),0,HISTR(1,NTR),0,18)
 00849 900            IKFLG=IJFLG
 00850 901            IF(II.EQ.2) CALL COREC
 00851 903            IJFLG=IKFLG
 00852 904            HNREL(NTR)=HNREL(NTR)+1
 00853 905            LRC=LR1
 00854 906            IF(LAND(LBL(KX),MSKCR1).NE.0) LRC=-LRC
 00855 908            HISTR(HNREL(NTR),NTR)=KX*LRC
 00856 909            IF(LR.EQ.0.AND.LRT.EQ.-1) HISTR(1,NTR)=-HISTR(1,NTR)
 00857    C     LBL(KX)=LOR(LBL(KX),MSKFIT)
 00858 911            IAB=HNREL(NTR)
 00859 912            CALL BAKFIT(IXXB,2)
 00860    C     IF(IXXB.NE.0) PRINT 36
 00861    C36   FORMAT('   RING  FIT    ')
 00862    C     IF(IXXB.NE.0) PRINT 37,KX,NTR,(HISTR(IR,NTR),IR=1,IAB)
 00863    C     IF(IXXB.NE.0) PRINT 38,(HTEMP(IR),IR=1,9)
 00864    C37   FORMAT(' KX, NTR,HISTR :',11I5)
 00865    C38   FORMAT(' OLD HISTR :',9I5)
 00866    C     LBL(KX)=LAND(LBL(KX),MSKAIT)
 00867 913            HNREL(NTR)=HNREL(NTR)-1
 00868 914            CALL MVC(HISTR(1,NTR),0,HTEMP(1),0,18)
 00869 915         CIF
 00870 916      CPROC
 00871 918      END
0END OF SEGMENT
0  OPTIONS IN EFFECT - LINECOUNT=64,LINEWIDTH=131,  SOURCE,  FORTRAN  NUMBERING
0   0 ERRORS           0 WARNINGS         917 TARGET STATEMENTS
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  1
0CARD TARGET
  NO  STM.NO
 
0END OF PROGRAM
0  OPTIONS IN EFFECT - LINECOUNT=64,LINEWIDTH=131,  SOURCE,  FORTRAN  NUMBERING
0   0 ERRORS           0 WARNINGS         917 TARGET STATEMENTS
 00000    C   24/03/80 102191205  MEMBER NAME  RSTBTR   (PATRECSR)    SHELTRAN
 00001   2      SUBROUTINE RSTBTR(IPJHTL)
 00002    C
 00003    C     RESTORE BACKTRACE RESULTS FROM BANK 'JHTL'
 00004    C
 00005    C     AUTHOR: P. STEFFEN (79/09/10)
 00006    C
 00007   3      IMPLICIT INTEGER*2 (H)
 00008    C
          C----------------------------------------------------------------------
          C             MACRO CDATA .... BOS COMMON.
          C
          C             THIS MACRO ONLY DEFINES THE IDATA/HDATA/ADATA NAMES.
          C             THE ACTUAL SIZE OF /BCS/ IS FIXED ON MACRO CBCSMX
          C             OR BY OTHER MEANS. A DEFAULT SIZE OF 40000 IS GIVEN HERE.
          C
          C----------------------------------------------------------------------
          C
         4      COMMON /BCS/ IDATA(40000)
         5      DIMENSION HDATA(80000),ADATA(40000),IPNT(50)
         6      EQUIVALENCE (HDATA(1),IDATA(1),ADATA(1)),(IPNT(1),IDATA(55))
         7      EQUIVALENCE (NWORD,IPNT(50))
          C
          C------------------------ END OF MACRO CDATA --------------------------
          C----------------------------------------------------------------------
          C           MACRO CCYCP .... JET CHAMBER HIT POINTERS (PATREC)
          C----------------------------------------------------------------------
         8      INTEGER*4 HPTSEC
         9      COMMON/CCYCP/HPTSEC(98)
 00016    C     HPTSEC(I) = CDATA POINTER TO 1ST I*2 WORD FOR 1ST HIT OF CELL I
          C------------------------ END OF MACRO CCYCP --------------------------
 00011    C
 00100    C-----------------------------------------------------------------------
 00200    C                            MACRO CJDRCH .... JET CHAMBER CONSTANTS.
 00300    C-----------------------------------------------------------------------
 00310    C
 00400  10      COMMON / CJDRCH / RDEC(4),PSIIN(3),RINCR(3),FIRSTW(3),FSENSW(3),
 00500         +                  RDEPTH,SWDEPL,YSUSPN,TIMDEL(2,3),ZMAX,ZOFFS,
 00510         +                  ZRESOL,ZNORM,ZAL,ZSCAL,DRIDEV,DRICOS,DRISIN,
 00600         +                  PEDES,TZERO(3),DRIROT(96,2),SINDRI(96,2),
 00701         +                  COSDRI(96,2),DRIVEL(96,2),T0FIX(3),
 00800         +                  ABERR(8), DUMJDC(20)
 00900    C
 01100    C      BLOCK DATA SET TO MC VALUES, KALIBR WILL SET REAL DATA VALUES
 01210    C--->  A CHANGE OF THIS COMMON MUST BE DONE SIMULTANEOUSLY WITH  <----
 01220    C--->  A CHANGE OF THE BLOCK DATA                                <----
 01230    C
 01300    C--------------------------- END OF MACRO CJDRCH -----------------------
 01400    C
 00013    C
          C----------------------------------------------
          C  MACRO CWORKPR .... PATTERN RECOGNITION CWORK
          C----------------------------------------------
        11      COMMON /CWORK/ HPLAST,HPFREE,HPWRK(30),ADWRK(600),
               ,               HPRO,HNTR,HNTCEL(98),IPCL(200),NRHT(200),
               ,               NWR1(200),DS1(200),SL1(200),
               ,               NWR2(200),DS2(200),SL2(200),
               ,               LBL(200),NTREL(200),ICRO(200),
               ,               NTR,HNREL(100),HISTR(9,100),HRES(168),
               ,               NTRLM,RLMTR(3,5),
               ,               WRK(7000)
        12      DIMENSION TRKAR(200,11),ITRKAR(200,11),
               ,                         LMRTR(3,5)
        13      EQUIVALENCE (IPCL(1),TRKAR(1,1),ITRKAR(1,1))
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  2
0CARD TARGET
  NO  STM.NO
 
        14      EQUIVALENCE (LMRTR(1,1),RLMTR(1,1))
        15      DIMENSION IWRK(7000),HWRK(14000),IDWRK(600),HDWRK(1200)
        16      EQUIVALENCE (IWRK(1),WRK(1),HWRK(1))
        17      EQUIVALENCE (IDWRK(1),ADWRK(1),HDWRK(1))
          C---------- END OF MACRO CWORKPR --------------
 00100    C-------------------------------------------------------
 00200    C  MACRO CWORKEQ .... PATTERN RECOGNITION CWORK POINTERS
 00300    C-------------------------------------------------------
 00400  18      EQUIVALENCE
 00410    C                POINTERS FOR FXYZ HIT ARRAY .. PRIMARY L/R SOLUTION
 00500         #          (HPHT0,HPWRK( 1)),(HPHT9,HPWRK( 2)),(HLDHT,HPWRK( 3))
 00510    C                POINTERS FOR CWORK SINGLE TRACK PATR BANK
 00600         #         ,(HPTR0,HPWRK( 4)),(HPTR9,HPWRK( 5)),(HLDTR,HPWRK( 6))
 00610    C                POINTERS FOR TRACK ELEMENT HIT LABEL ARRAY
 00700         #         ,(HPHL0,HPWRK( 7)),(HPHL9,HPWRK( 8)),(HLDHL,HPWRK( 9))
 00710    C                POINTERS FOR FXYZ HIT ARRAY .. OPPOSITE L/R SOLUTION
 00800         #         ,(HPHT0A,HPWRK(10)),(HPHT9A,HPWRK(11)),(HLDHTA,HPWRK(12))
 00810    C               POINTER LIMIT ON FXYZ HIT ARRAY
 00900         #         ,(HPHTLM,HPWRK(13))
 00910    C               POINTERS FOR
 01000         #         ,(HPTE0,HPWRK(14)),(HPTE9,HPWRK(15)),(HLDTE,HPWRK(16))
 01100    C-------------- END OF MACRO CWORKEQ ------------------
 00016    C
 00018  19      DATA MKHTL1 /Z8400/, MKATR /Z100/, MKHTL2 /Z7FFF/                  LABEL FOR HITLABEL IN /CWORK/ + L/R
 00020  20      DATA  MKLRSV / Z800/                                               HIT LABEL FOR SOLVED L/R AMBIG.
 00022  21      DATA  MKBDHT / Z600/                                               LABEL FOR BAD HITS
 00023    C
 00025  22      DATA MKLFTR,MKRTTR / Z400, Z800/                                   LABEL FOR TREL (L/R)
 00027  23      DATA LBZRCR / Z100/                                                LABEL FOR ZERO CROSSING TRKEL
 00028    C
 00029    C2000 FORMAT(1X,20I6)
 00030    C2001 FORMAT(1H0,A4,I6,2(/,1X,24I4),/,1X,50I2,
 00031    C    ,       90(/,1X,2I6,I3,2F10.3,I3,2F10.3,1X,Z4,2I3))
 00032    C2002 FORMAT(' HIT LABEL OF TRELS:',2I6,/,(12X,20(2X,Z4)))
 00033    C2004 FORMAT(1H0,'BACKTR:',5X,20I6)
 00034    C2005 FORMAT(1H ,12X,20I6)
 00035    C2006 FORMAT(1H ,I2,3I6,6X,I4,F8.2)
 00036    C2007 FORMAT('0TREL:',3I4,8(I6,F6.1),/,18X,8(I6,F6.1))
 00037    C2008 FORMAT(1X,20(2X,Z4))
 00038    C2009 FORMAT(1H ,15F8.2)
 00039    C2010 FORMAT(1H0,2I6,I3,2F10.3,I3,2F10.3,1X,Z4,2I3)
 00040    C
 00041    C
 00043    C     I9 = HNTR                                                          PRINTOUT
 00044    C     PRINT 2001, HPRO,HNTR,HNTCEL,((TRKAR(I1,I2),I2=1,11),I1=1,I9)
 00045    C     I0 = HPHL0
 00046    C     I9 = HPHL9
 00047    C     PRINT 2002, I0,I9,(HWRK(I1),I1=I0,I9)
 00048    C     PRINT 2004,NTR, (HNREL(I1),I1=1,NTR)
 00049    C     FOR ITR=1,NTR
 00050    C       NELM = HNREL(ITR)
 00051    C       PRINT 2005, (HISTR(I1,ITR),I1=1,NELM)
 00052    C     CFOR
 00053    C
 00055  24      NBYTE = IDATA(IPJHTL)*4 - 4                                        COPY 'JHTL' TO /CWORK/
 00056  25      CALL MVCL(HWRK(HPHL0),0,IDATA(IPJHTL+2),0,NBYTE)
 00057  26      HLDHL = IDATA(IPJHTL)*2 - 2
 00058  27      HPHL9 = HLDHL + HPHL0 - 1
 00059  28      HPFREE = (HPHL9+1)/2 + 1
 00060  29      HPHT0  = HPFREE
 00061    C
 00062    C     PRINT 2002, I0,I9,(HWRK(I1),I1=I0,I9)
 00064  30      FOR I=HPHL0,HPHL9,2                                                DELETE ALL BAD HITS
 00065  31         IZW = HWRK(I  )
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  3
0CARD TARGET
  NO  STM.NO
 
 00066  32         IF LAND(IZW,MKBDHT).NE.0
 00067  33         THEN
 00068  36            HWRK(I) = HWRK(I+1)
 00069  37            IZW     = HWRK(I+1)
 00070  38            HWRK(I+1) = 0
 00071    C         PRINT 2008,MKBDHT,IZW,HWRK(I),HWRK(I+1)
 00072  39            IF(LAND(IZW,MKBDHT).NE.0) HWRK(I  ) = 0
 00073  41         ELSE
 00074  43            IZW = HWRK(I+1)
 00075  44            IF(LAND(IZW,MKBDHT).NE.0) HWRK(I+1) = 0
 00076  46         CIF
 00077  47      CFOR
 00078    C     PRINT 2002, I0,I9,(HWRK(I1),I1=I0,I9)
 00079    C
 00081  49      NBYTE = 200                                                        INITIALIZE MIDOUT
 00082  50      CALL SETSL(HNREL(1),0,NBYTE,0)
 00083  51      NTR   = 0
 00084  52      HNTR  = 0
 00085    C
 00087  53      ICELL = 1                                                          LOOP OVER ALL CELLS
 00088  54      ITREL = 0
 00089  55      ITRBK = 0
 00090  56      REPEAT
 00092  57         IPHIT0 = HPTSEC(ICELL  )                                        POINTER TO HITS OF SELECTED CELL
 00093  58         IPHIT9 = HPTSEC(ICELL+1) - 4
 00094    C
 00096  59         IF(ICELL.EQ.25) ITREL = 0                                       RESET TREL# FOR EACH RING
 00097  61         IF(ICELL.EQ.49) ITREL = 0
 00098    C
 00100  63         IRING = 1                                                       GET DRIFTTIME CONSTANTS
 00101  64         IF(ICELL.GE.25) IRING = 2
 00102  66         IF(ICELL.GE.49) IRING = 3
 00103  68         DSBIN1 = TIMDEL(1,IRING)
 00104  69         DSBIN2 = TIMDEL(2,IRING)
 00105    C
 00107  70         IF IPHIT9.GE.IPHIT0                                             CHECK IF HITS IN CELL
 00108  71         THEN
 00109    C
 00111  74            IPHTL0 = (IPHIT0-HPTSEC(1))/2 + HPHL0                        POINTER TO HIT LABEL
 00112    C
 00114  75            REPEAT                                                       LOOP OVER CELL HITS UNTIL NO MORE HIT FOUND
 00115  76               IPHIT = IPHIT0
 00116  77               IPHTL = IPHTL0
 00117  78               ITR   = 0
 00118  79               DSBIN = DSBIN1
 00119  80               NHT   = 0
 00120  81               IPHTW = HPHT0
 00122  82               ZCRLB1 = 0.                                               LABEL FOR DET. OF 1. + 2. ZERO-XING
 00123  83               ZCRLB2 = 0.
 00124  84               WHILE IPHIT.LE.IPHIT9
 00126  86                  LHTL1 = HWRK(IPHTL  )                                  HIT LABEL
 00127  90                  LHTL2 = HWRK(IPHTL+1)
 00129  91                  NTR1  = 0                                              TRACK #
 00130  92                  NTR2  = 0
 00131  93                  IF(LAND(LHTL1,MKHTL1).EQ.0) NTR1 = LAND(SHFTR(LHTL1,1),127)
 00132  95                  IF(LAND(LHTL2,MKHTL1).EQ.0) NTR2 = LAND(SHFTR(LHTL2,1),127)
 00133    C
 00135  97                  IF ITR.EQ.0                                            SET TRACK# + TREL#
 00136  98                  THEN
 00137 101                     IF NTR1.NE.0
 00138 102                     THEN
 00139 105                        ITR = NTR1
 00140 106                     ELSE
 00141 108                        IF(NTR2.NE.0) ITR = NTR2
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  4
0CARD TARGET
  NO  STM.NO
 
 00142 110                     CIF
 00143 111                     IF(ITR.NE.0) ITREL = ITREL + 1
 00144 113                  CIF
 00145    C
 00147 114                  IF ITR.NE.0 .AND. (NTR1.EQ.ITR .OR. NTR2.EQ.ITR)       CHECK IF HIT BELONGS TO TRACK
 00148 115                  THEN
 00149    C
 00151 118                     IF ITR.EQ.NTR1                                      SET TREL# AND MARK HIT LABEL
 00152 119                     THEN
 00153 122                        LBHIT = LAND(MKATR,LHTL1)
 00155 123                        SGNLR =-1.                                       SET SIGN FOR L/R
 00156 124                        IF(LBHIT.NE.0) SGNLR = 1.
 00157 126                        LBHIT = LOR (ITREL*2,LBHIT)
 00158 127                        LBHIT = LOR (MKHTL1 ,LBHIT)
 00159 128                        LBHIT = LOR (MKLRSV ,LBHIT)
 00160 129                        HWRK(IPHTL  ) = LBHIT
 00161 130                     CIF
 00162 131                     IF ITR.EQ.NTR2
 00163 132                     THEN
 00164 135                        LBHIT = LAND(MKATR,LHTL2)
 00166 136                        SGNLR =-1.                                       SET SIGN FOR L/R
 00167 137                        IF(LBHIT.NE.0) SGNLR = 1.
 00168 139                        LBHIT = LOR (ITREL*2,LBHIT)
 00169 140                        LBHIT = LOR (MKHTL1 ,LBHIT)
 00170 141                        LBHIT = LOR (MKLRSV ,LBHIT)
 00171 142                        HWRK(IPHTL+1) = LBHIT
 00172 143                     CIF
 00173    C
 00175 144                     IWIR = HDATA(IPHIT  )                               GET DATA OF HIT
 00176 145                     ILAY = LAND(SHFTR(IWIR,3),15)
 00177 146                     IF(ILAY.GE.8) DSBIN = DSBIN2
 00178 148                     ITAU = HDATA(IPHIT+3)
 00179 149                     DRSP          = ITAU*DSBIN*SGNLR
 00180    C
 00181                                                                             CHECK IF 2. ZERO-XING
 00182 150                     IF(ZCRLB1.EQ.0. .AND. DRSP.NE.0.) ZCRLB1 = SIGN(1.,DRSP)
 00183 152                     IF(ZCRLB1*DRSP.LT.0.) ZCRLB2 =-ZCRLB1
 00184 154                     IF ZCRLB2*DRSP.LT.0.
 00185 155                     THEN
 00187 158                        HWRK(IPHTL  ) = LHTL1                            2. ZERO-XING FOUND: CUT TREL
 00188 159                        HWRK(IPHTL+1) = LHTL2
 00189 160                        XWHILE
 00190 161                     CIF
 00191    C
 00193 162                     NHT = NHT + 1                                       STORE HIT
 00194 163                     IWRK(IPHTW  ) = ILAY
 00195 164                     WRK (IPHTW+1) = DRSP
 00196 165                     IPHTW = IPHTW + 2
 00197 166                  CIF
 00198 167                  IPHTL = IPHTL + 2
 00199 168                  IPHIT = IPHIT + 4
 00200 169               CWHILE
 00201    C
 00203 171               IF ITR.GT.0                                               CHECK IF NEW TREL
 00204 172               THEN
 00206 175                  PERFORM MIDOUT                                         SETUP MIDOUT
 00207 178               CIF
 00208 179            UNTIL ITR.EQ.0
 00209    C
 00210 180         CIF
 00211 184         ICELL = ICELL + 1
 00212 185      UNTIL ICELL.GT.96
 00213    C
 00215 186      HNTR = ITRBK                                                       SET # OF TRELS
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  5
0CARD TARGET
  NO  STM.NO
 
 00216    C
 00218 190      ICELL0 = 0                                                         DETERMINE CELL POINTERS
 00219 191      FOR ITRBK=1,HNTR
 00220 192         ICELL = IPCL(ITRBK)
 00221 193         IF ICELL.NE.ICELL0
 00222 194         THEN
 00223 197            ICELL0 = ICELL0 + 1
 00224 198            FOR IC=ICELL0,ICELL
 00225 199               HNTCEL(IC) = ITRBK
 00226 200            CFOR
 00227 202            ICELL0 = ICELL
 00228 203         CIF
 00229 204      CFOR
 00230 206      ICELL0 = ICELL0 + 1
 00231 207      ITRBK = HNTR + 1
 00232 208      FOR IC=ICELL0,97
 00233 209         HNTCEL(IC) = ITRBK
 00234 210      CFOR
 00235 212      HNTCEL(98) = 0
 00236    C
 00238 213      CALL TRLORD                                                        GET TRELS IN ORDER
 00239    C
 00241 214      FOR I=HPHL0,HPHL9                                                  BIT OFF IN HITLABEL FOR USED HITS
 00242 215         IZW = HWRK(I)
 00243 216         IZW = LAND(IZW,MKHTL2)
 00244 217         HWRK(I) = IZW
 00245 218      CFOR
 00246    C
 00248    C     I9 = HNTR                                                          PRINTOUT
 00249    C     PRINT 2001, HPRO,HNTR,HNTCEL,((TRKAR(I1,I2),I2=1,11),I1=1,I9)
 00250    C     I0 = HPHL0
 00251    C     I9 = HPHL9
 00252    C     PRINT 2002, I0,I9,(HWRK(I1),I1=I0,I9)
 00253    C     PRINT 2004,NTR, (HNREL(I1),I1=1,NTR)
 00254    C     FOR ITR=1,NTR
 00255    C       NELM = HNREL(ITR)
 00256    C        PRINT 2005, (HISTR(I1,ITR),I1=1,NELM)
 00257    C     CFOR
 00258    C     I0 = IPJHTL*2+3
 00259    C     I9 = I0 + IDATA(IPJHTL)*2 - 3
 00260    C     PRINT 2002, I0,I9,(HDATA(I1),I1=I0,I9)
 00261    C
 00262 220      RETURN
 00263    C
 00264                                                                             ***************************
 00265                                                                             *      M I D O U T        *
 00267    C                                                                        ***************************
 00269 221      PROC MIDOUT                                                        SETUP MIDOUT
 00270    C
 00272 222         HPHT9 = IPHTW - 1                                               CHECK IF HIT LABEL EXISTING
 00273    C     PRINT 2007, ICELL,ITREL,ITR,(WRK(I1),I1=HPHT0,HPHT9)
 00275 223         ITRBK = ITRBK + 1                                               INCREASE COUNTER OF TREL
 00276    C
 00278 224         DS10  =  WRK(HPHT0+1)                                           DETERMINE RESULTS OF TREL SEARCH
 00279 225         DS20  =  WRK(HPHT9  )
 00280 226         IF NHT.LT.4
 00281 227         THEN
 00282 230            IF NHT.EQ.1
 00283 231            THEN
 00284 234               SL10 = 0.
 00285 235               SL20 = 0.
 00286 236            ELSE
 00287 238               IDWIR =  IWRK(HPHT9-1)-IWRK(HPHT0)
 00288 239               SL10  =  0.
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  6
0CARD TARGET
  NO  STM.NO
 
 00289 240               IF(IDWIR.NE.0) SL10  =  (DS20-DS10)/IDWIR
 00290 242               SL20  =  SL10
 00291 243            CIF
 00292 244         ELSE
 00293 246            SL10  =  (WRK(HPHT0+7)-DS10)/(IWRK(HPHT0+6)-IWRK(HPHT0  ))
 00294 247            SL20  =  (WRK(HPHT9-6)-DS20)/(IWRK(HPHT9-7)-IWRK(HPHT9-1))
 00295 248            WR10  =  (IWRK(HPHT0+6)+IWRK(HPHT0  ))*.5
 00296 249            WR20  =  (IWRK(HPHT9-7)+IWRK(HPHT9-1))*.5
 00297 250            DSL   =  0.
 00298 251            DWR   =  WR20 - WR10
 00299 252            IF(DWR.GT.0) DSL   =  (SL20-SL10) / DWR
 00300    C     PRINT 2009, DS10,DS20,SL10,SL20,WR10,WR20,DWR,DSL
 00301 254            IF DSL.NE.0.
 00302 255            THEN
 00303 258               SL10 = SL10 + (IWRK(HPHT0  )-WR10)*DSL
 00304 259               SL20 = SL20 + (IWRK(HPHT9-1)-WR20)*DSL
 00305 260            CIF
 00306 261         CIF
 00307    C     PRINT 2009, DS10,DS20,SL10,SL20,WR10,WR20,DWR,DSL
 00308    C
 00310 262         LBTREL       = MKRTTR                                           LABEL OF TREL
 00311 263         IF(DS10.LT.0.) LBTREL = MKLFTR
 00312 265         IF(DS10.EQ.0 .AND. DS20.LT.0) LBTREL = MKLFTR
 00313 267         ITRBKS = ITRBK
 00314 268         ITRS   = ITR
 00315 269         IF LBTREL.EQ.MKLFTR
 00316 270         THEN
 00317 273            ITRBKS =-ITRBK
 00318 274            ITRS   =-ITR
 00319 275            DS10   =-DS10
 00320 276            SL10   =-SL10
 00321 277            DS20   =-DS20
 00322 278            SL20   =-SL20
 00323 279         CIF
 00324    C     PRINT 2009, DS10,DS20,SL10,SL20,WR10,WR20,DWR,DSL
 00325    C
 00327 280         IZRCR = 0                                                       ZERO CROSSING TREL
 00328 281         IF DS10*DS20 .LT.0.
 00329 282         THEN
 00330 285            DS20 =-DS20
 00331 286            SL20 =-SL20
 00332 287            LBTREL = LOR(LBTREL,LBZRCR)
 00333 288            DS0 = WRK(HPHT0+1)
 00334 289            FOR IP=HPHT0,HPHT9,2
 00335 290               IF DS0*WRK(IP+1).LT.0
 00336 291               THEN
 00337 294                  XFOR
 00338 295               CIF
 00339 296               IZRCR = IWRK(IP)
 00340 297            CFOR
 00341 299            IZRCR = IZRCR + 1
 00342 300         CIF
 00343    C     PRINT 2009, DS10,DS20,SL10,SL20,WR10,WR20,DWR,DSL
 00344    C
 00346 301         IPCL (ITRBK) =  ICELL                                           STORE RESULT OF TREL SEARCH
 00347 302         NRHT (ITRBK) =  NHT
 00348 303         NWR1 (ITRBK) =  IWRK(HPHT0  )
 00349 304         DS1  (ITRBK) =  DS10
 00350 305         SL1  (ITRBK) =  SL10
 00351 306         NWR2 (ITRBK) =  IWRK(HPHT9-1)
 00352 307         DS2  (ITRBK) =  DS20
 00353 308         SL2  (ITRBK) =  SL20
 00354 309         LBL  (ITRBK) =  LBTREL
 00355 310         NTREL(ITRBK) =  ITREL
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  7
0CARD TARGET
  NO  STM.NO
 
 00356 311         ICRO (ITRBK) =  IZRCR
 00357    C     PRINT 2010, (TRKAR(ITRBK,I1),I1=1,11)
 00358    C
 00360 312         MTREL = HNREL(ITR)                                              STORE RESULT OF BACKTRACE
 00361 313         IF(MTREL.LT.9) MTREL = MTREL + 1
 00362 315         HISTR(MTREL,ITR) = ITRBKS
 00363 316         HNREL(ITR) = MTREL
 00364 317         HRES(ITRBK) = ITRS
 00365 318         NTR = MAX0(NTR,ITR)
 00366    C
 00367 319      CPROC
 00368    C
 00369 321      END
0END OF SEGMENT
0  OPTIONS IN EFFECT - LINECOUNT=64,LINEWIDTH=131,  SOURCE,  FORTRAN  NUMBERING
0   0 ERRORS           0 WARNINGS         320 TARGET STATEMENTS
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  1
0CARD TARGET
  NO  STM.NO
 
0END OF PROGRAM
0  OPTIONS IN EFFECT - LINECOUNT=64,LINEWIDTH=131,  SOURCE,  FORTRAN  NUMBERING
0   0 ERRORS           0 WARNINGS         320 TARGET STATEMENTS
 00000    C   24/03/80 109291155  MEMBER NAME  SRTREL   (PATRECSR)    SHELTRAN
 00001   2      SUBROUTINE SRTREL
 00002    C
 00003    C     SUBROUTINE FOR SEARCH OF TRACK ELEMENTS WITHIN CELL
 00004    C     PETER STEFFEN:  6/ 4/79
 00005    C
 00006   3      IMPLICIT INTEGER*2 (H)
 00007   4      LOGICAL TBIT
 00008    C
          C----------------------------------------------------------------------
          C             MACRO CDATA .... BOS COMMON.
          C
          C             THIS MACRO ONLY DEFINES THE IDATA/HDATA/ADATA NAMES.
          C             THE ACTUAL SIZE OF /BCS/ IS FIXED ON MACRO CBCSMX
          C             OR BY OTHER MEANS. A DEFAULT SIZE OF 40000 IS GIVEN HERE.
          C
          C----------------------------------------------------------------------
          C
         5      COMMON /BCS/ IDATA(40000)
         6      DIMENSION HDATA(80000),ADATA(40000),IPNT(50)
         7      EQUIVALENCE (HDATA(1),IDATA(1),ADATA(1)),(IPNT(1),IDATA(55))
         8      EQUIVALENCE (NWORD,IPNT(50))
          C
          C------------------------ END OF MACRO CDATA --------------------------
          C----------------------------------------------------------------------
          C           MACRO CCYCP .... JET CHAMBER HIT POINTERS (PATREC)
          C----------------------------------------------------------------------
         9      INTEGER*4 HPTSEC
        10      COMMON/CCYCP/HPTSEC(98)
 00016    C     HPTSEC(I) = CDATA POINTER TO 1ST I*2 WORD FOR 1ST HIT OF CELL I
          C------------------------ END OF MACRO CCYCP --------------------------
 00011    C
          C----------------------------------------------
          C  MACRO CWORKPR .... PATTERN RECOGNITION CWORK
          C----------------------------------------------
        11      COMMON /CWORK/ HPLAST,HPFREE,HPWRK(30),ADWRK(600),
               ,               HPRO,HNTR,HNTCEL(98),IPCL(200),NRHT(200),
               ,               NWR1(200),DS1(200),SL1(200),
               ,               NWR2(200),DS2(200),SL2(200),
               ,               LBL(200),NTREL(200),ICRO(200),
               ,               NTR,HNREL(100),HISTR(9,100),HRES(168),
               ,               NTRLM,RLMTR(3,5),
               ,               WRK(7000)
        12      DIMENSION TRKAR(200,11),ITRKAR(200,11),
               ,                         LMRTR(3,5)
        13      EQUIVALENCE (IPCL(1),TRKAR(1,1),ITRKAR(1,1))
        14      EQUIVALENCE (LMRTR(1,1),RLMTR(1,1))
        15      DIMENSION IWRK(7000),HWRK(14000),IDWRK(600),HDWRK(1200)
        16      EQUIVALENCE (IWRK(1),WRK(1),HWRK(1))
        17      EQUIVALENCE (IDWRK(1),ADWRK(1),HDWRK(1))
          C---------- END OF MACRO CWORKPR --------------
 00100    C-------------------------------------------------------
 00200    C  MACRO CWORKEQ .... PATTERN RECOGNITION CWORK POINTERS
 00300    C-------------------------------------------------------
 00400  18      EQUIVALENCE
 00410    C                POINTERS FOR FXYZ HIT ARRAY .. PRIMARY L/R SOLUTION
 00500         #          (HPHT0,HPWRK( 1)),(HPHT9,HPWRK( 2)),(HLDHT,HPWRK( 3))
 00510    C                POINTERS FOR CWORK SINGLE TRACK PATR BANK
 00600         #         ,(HPTR0,HPWRK( 4)),(HPTR9,HPWRK( 5)),(HLDTR,HPWRK( 6))
 00610    C                POINTERS FOR TRACK ELEMENT HIT LABEL ARRAY
 00700         #         ,(HPHL0,HPWRK( 7)),(HPHL9,HPWRK( 8)),(HLDHL,HPWRK( 9))
 00710    C                POINTERS FOR FXYZ HIT ARRAY .. OPPOSITE L/R SOLUTION
 00800         #         ,(HPHT0A,HPWRK(10)),(HPHT9A,HPWRK(11)),(HLDHTA,HPWRK(12))
 00810    C               POINTER LIMIT ON FXYZ HIT ARRAY
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  2
0CARD TARGET
  NO  STM.NO
 
 00900         #         ,(HPHTLM,HPWRK(13))
 00910    C               POINTERS FOR
 01000         #         ,(HPTE0,HPWRK(14)),(HPTE9,HPWRK(15)),(HLDTE,HPWRK(16))
 01100    C-------------- END OF MACRO CWORKEQ ------------------
 00014    C
 00015  19      EQUIVALENCE
 00016         ,           (ICELL ,IDWRK(1)),(NHIT  ,IDWRK(2)),(IRING ,IDWRK(3))
 00017         ,         , (IERRCD,IDWRK(4)),(NTRKEL,IDWRK(5))
 00018         ,         , (ITR   ,IDWRK(7)),(ITRNG ,IDWRK(8))
 00019    C
          C----------------------------------------------
          C  MACRO CPATLM .... PATTERN RECOGNITION LIMITS
          C----------------------------------------------
        20      COMMON /CPATLM/ PATRLM(5),FLINLM(10),TRELLM(20),ZFITLM(10),BKK(20)
               *               ,XYF(20),IGFP(20),XBKK(40),IADMIN(5),YBKK(20)
        21      INTEGER IXYF(20),LMPATR(5),LMFLIN(10)
        22      INTEGER LMTREL(20),LMZFIT(10),IBKK(20)
        23      DIMENSION GFP(20),IXBKK(40),IYBKK(20)
        24      EQUIVALENCE (PATRLM(1),LMPATR(1)),(IXBKK(1),XBKK(1)),(IYBKK(1),
               *YBKK(1))   ,(FLINLM(1),LMFLIN(1)),(TRELLM(1),LMTREL(1))
               *           ,(ZFITLM(1),LMZFIT(1)),(BKK(1),IBKK(1))
               *           ,(XYF(1),IXYF(1)),(GFP(1),IGFP(1)),(IADMIN(1),IMCERT)
               *           ,(IYBKK(20),IPPASS),(IADMIN(2),IPFAST)
          C----------- END OF MACRO CPATLM --------------
 00021    C
 00023  25      DATA MKTREL / Z3000/                                               MASK FOR GOOD TRKELS
 00027  26      DATA MKLBTC / ZFFF/                                                MASKS FOR TRKEL LABEL FOR TRACING
 00029  27      DATA MKLFTR / Z 30000/, MKRGHT / Z20000/                           MASK FOR LEFT/RIGHT BITS
 00031  28      INTEGER  MKLRHT(3) / Z800, Z0, Z900/                               HIT LABEL FOR SOLVED L/R AMBIG.
 00033  29      DATA LBZRCR / Z100/                                                LABEL FOR ZERO CROSSING TRKEL
 00034    C
 00035    C2000 FORMAT(1H0,'ERROR CODE:',I4, ', ICELL:',I3,', TRACKS:',I9)
 00036    C2001 FORMAT(1X,/,(1X,2I6,2F6.2,2X,Z4,6I6,F6.2))
 00037    C2002 FORMAT(/,(1X,3I6,4F8.5,I3,2F6.2,I3,2F6.2,2X,Z4,2X,Z4,2X,Z5,F6.2))
 00038    C
 00040  30      DATA NANF /0/                                                      ADDRESS OF POINTER TO HIT LABEL
 00041  31      IF(NANF.EQ.0) IQPATR= IBLN('PATR')
 00042  33      NANF = 1
 00043    C
 00045  34      IPPATR = IDATA(IQPATR)                                             POINTER TO 'PATR'-BANK
 00046    C               PRINT 2000, IERRCD, ICELL, IPPATR
 00048  35      HPFRE0 = HPFREE                                                    MEMORIZE 1. FREE LOCATION
 00050  36      CALL PRHTAR                                                        PREPAR HIT ARRAY OF CELL FOR PATREC
 00051  37      IF NHIT.GE.5
 00052  38      THEN
 00053    C
 00055  41         CALL FLINEL                                                     FIND LINELS WITHIN CELL
 00056    C
 00058  42         CALL FTRKEL                                                     FIND TRKELS FROM LINELS
 00059    C
 00060  43         IF NTRKEL.GT.0
 00062  44         THEN                                                            ANALYSE TRKELS WITHIN CELL
 00063    C
 00064    COMMENT OUT CALL TO DUMMY ROUTINE ATRKEL ... GFP 1/4/81
 00065    C
 00067    CCCCCC        CALL ATRKEL
 00068    C             IF IERRCD.NE.-1
 00069    C             THEN
 00070    C               PRINT 2000, IERRCD, ICELL, NTRCNT
 00071    C               PRINT 2001, (WRK(I1),I1=HPHT0,HPHT9)
 00072    C               PRINT 2002, (WRK(I1),I1=HPTR0,HPTR9)
 00073    C             CIF
 00074    C
 00076  47            PERFORM PRBTAR                                               FILL TRKEL ARRAY FOR TRACING
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  3
0CARD TARGET
  NO  STM.NO
 
 00077  50         CIF
 00078    C
 00080  51         NLINUC = 0                                                      COUNT UNCORRELATED LINELS
 00081  52         FOR IP=HPHT0,HPHT9,HLDHT
 00082  53            IF(IWRK(IP+9).EQ.0 .AND. LAND(IWRK(IP+4),7).NE.0)
 00083         .      NLINUC = NLINUC + 1
 00084  55         CFOR
 00086  57         IDATA(IPPATR+7) = IDATA(IPPATR+7) + NLINUC                      INCREASE COUNTER OF UNCORRELATED LINELS
 00087  58      CIF
 00088    C
 00090  59      HPFREE = HPFRE0                                                    FREE AREA IN CWORK
 00091    C
 00092  60      RETURN
 00093    C
 00094                                                                             ***************************
 00095                                                                             *      P R B T A R        *
 00097    C                                                                        ***************************
 00099  61      PROC PRBTAR                                                        PREPARE ARRAY FOR BACKTRACING
 00100    C
 00102    C                                                                        SET TRACK ARRAY
 00103  62         ICLL16 = (ICELL-1) * 16
 00104  63         NTRCLL = 0
 00105  64         FOR IPTR = HPTR0,HPTR9,HLDTR
 00106  65            IF ITR.LE.200 .AND. ITRNG.LT.128
 00107  66            THEN
 00108  69               IF LAND(IWRK(IPTR+15),MKTREL).NE.0
 00109  70               THEN
 00110  73                  NTRCLL = NTRCLL + 1
 00111    C
 00113  74                  LB = LAND(IWRK(IPTR+15),MKLBTC)                        LABEL
 00115  75                  DRSP1 = WRK(IPTR+ 8)                                   DRIFT SPACE OF 1. + LAST POINT
 00116  76                  DRSP2 = WRK(IPTR+11)
 00117  77                  IF(DRSP1*DRSP2.LT.0) LB = LOR(LB,LBZRCR)
 00119  79                  LBLR = LAND(IWRK(IPTR+15),MKLFTR)                      LABEL FOR LEFT OR RIGHT SOLUTION
 00121  80                  IF(DRSP1.LT.0..AND.LBLR.NE.0.AND.LBLR.NE.MKLFTR)       FLIP L/R BITS IF 1. POINT -VE
 00122         .            LBLR = LXOR(LBLR,MKLFTR)
 00123  82                  LB = LOR(LB,SHFTR(LBLR,6))
 00124    C
 00125  83                  ITRKAR(ITR, 1) = ICELL
 00126  84                  ITRKAR(ITR, 2) = IWRK(IPTR+ 2)
 00127  85                  ITRKAR(ITR, 3) = IWRK(IPTR+ 7)
 00128  86                  TRKAR (ITR, 4) = ABS(DRSP1)
 00129  87                  DRSL1          = WRK(IPTR+ 9)
 00130  88                  IF(DRSP1.LT.0.)  DRSL1 =-DRSL1
 00131  90                  TRKAR (ITR, 5) = DRSL1
 00132  91                  ITRKAR(ITR, 6) = IWRK(IPTR+10)
 00133  92                  TRKAR (ITR, 7) = ABS(DRSP2)
 00134  93                  DRSL2          = WRK(IPTR+12)
 00135  94                  IF(DRSP2.LT.0.)  DRSL2 =-DRSL2
 00136  96                  TRKAR (ITR, 8) = DRSL2
 00137  97                  ITRKAR(ITR, 9) = LB
 00138  98                  ITRKAR(ITR,10) = ITRNG
 00139    C
 00141    C                                                                        LABEL INTERMEDIATE HIT ARRAY
 00143  99                  IDXLR =-1                                              L/R INDEX OF HITS
 00144 100                  IF(LBLR.EQ.MKRGHT) IDXLR = 1
 00145 102                  IF(DRSP1.LT.0.) IDXLR =-IDXLR
 00146 104                  IDXLR1 = IDXLR
 00148 105                  ILAYZ =-1                                              PRESET LAYER OF ZERO CROSSING
 00150 106                  FOR IP=HPHT0,HPHT9,HLDHT                               LOOP OVER ALL HITS
 00151 107                     IF IWRK(IP+9).EQ.IPTR .OR.IWRK(IP+10).EQ.IPTR
 00152 108                     THEN
 00153 111                        DRSP = WRK(IP+2)
 00154 112                        IF(IWRK(IP+10).EQ.IPTR .AND. TBIT(IWRK(IP+4),20)) DRSP=-DRSP
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  4
0CARD TARGET
  NO  STM.NO
 
 00155 114                        IF(DRSP.NE.0.) IDXLR1 = IDXLR
 00156 116                        IF DRSP*DRSP1.LT.0.
 00157 117                        THEN
 00158 120                           IDXLR1 =-IDXLR
 00159 121                           IF(ILAYZ.LT. 0) ILAYZ = IWRK(IP)
 00160 123                        CIF
 00161 124                        IPLBHT = (IWRK(IP+1) - HPTSEC(1))/2 + HPHL0
 00162 125                        LBHIT = ITRNG*2
 00163 126                        LBHIT = LOR(LBHIT,MKLRHT(IDXLR1+2))
 00164    C     PRINT 2003, IPLBHT,HPHL0,HPTSEC(1),LBHIT
 00165    C2003 FORMAT(1X,3I6,4X,Z4)
 00166 127                        IF HWRK(IPLBHT).EQ.0
 00167 128                        THEN
 00168 131                           HWRK(IPLBHT) = LBHIT
 00169 132                        ELSE
 00170 134                           IF(HWRK(IPLBHT+1).EQ.0) HWRK(IPLBHT+1) = LBHIT
 00171 136                        CIF
 00172 137                     CIF
 00173 138                  CFOR
 00174    C
 00176 140                  IF(LAND(LB,LBZRCR).NE.0 .AND. ILAYZ.LT.0)              SET LAYER # OF ZERO CROSSING
 00177         .            ILAYZ = IWRK(IPTR+10) + 1
 00178 142                  IF(ILAYZ.LT.0) ILAYZ = 0
 00179 144                  ITRKAR(ITR,11) = ILAYZ
 00180 145                  ITR   = ITR   + 1
 00181 146                  ITRNG = ITRNG + 1
 00182 147               CIF
 00183 148            CIF
 00184 149         CFOR
 00185    C
 00186 151      CPROC
 00187    C
 00188 153      END
0END OF SEGMENT
0  OPTIONS IN EFFECT - LINECOUNT=64,LINEWIDTH=131,  SOURCE,  FORTRAN  NUMBERING
0   0 ERRORS           0 WARNINGS         152 TARGET STATEMENTS
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  1
0CARD TARGET
  NO  STM.NO
 
0END OF PROGRAM
0  OPTIONS IN EFFECT - LINECOUNT=64,LINEWIDTH=131,  SOURCE,  FORTRAN  NUMBERING
0   0 ERRORS           0 WARNINGS         152 TARGET STATEMENTS
 00000    C   29/07/80 102191206  MEMBER NAME  STTRKO   (PATRECSR)    SHELTRAN
 00001   2      SUBROUTINE STTRKO(ILAYMX)
 00002    C
 00003    C     STORES TRACK IN 'PATR'-BANK
 00004    C     LABELS HITS  IN 'JHTL'-BANK
 00005    C     P. STEFFEN 8/07/80
 00006    C
 00007   3      IMPLICIT INTEGER*2 (H)
 00008   4      LOGICAL TBIT
 00009    C
 00010   5      COMMON/CHEADR/HEAD(17),HRUN,HEV
 00011   6      COMMON/CADMIN/IEVTP,NREC,NRWRIT,NRERR
 00012    C
          C----------------------------------------------------------------------
          C             MACRO CDATA .... BOS COMMON.
          C
          C             THIS MACRO ONLY DEFINES THE IDATA/HDATA/ADATA NAMES.
          C             THE ACTUAL SIZE OF /BCS/ IS FIXED ON MACRO CBCSMX
          C             OR BY OTHER MEANS. A DEFAULT SIZE OF 40000 IS GIVEN HERE.
          C
          C----------------------------------------------------------------------
          C
         7      COMMON /BCS/ IDATA(40000)
         8      DIMENSION HDATA(80000),ADATA(40000),IPNT(50)
         9      EQUIVALENCE (HDATA(1),IDATA(1),ADATA(1)),(IPNT(1),IDATA(55))
        10      EQUIVALENCE (NWORD,IPNT(50))
          C
          C------------------------ END OF MACRO CDATA --------------------------
          C----------------------------------------------------------------------
          C           MACRO CCYCP .... JET CHAMBER HIT POINTERS (PATREC)
          C----------------------------------------------------------------------
        11      INTEGER*4 HPTSEC
        12      COMMON/CCYCP/HPTSEC(98)
 00016    C     HPTSEC(I) = CDATA POINTER TO 1ST I*2 WORD FOR 1ST HIT OF CELL I
          C------------------------ END OF MACRO CCYCP --------------------------
 00015    C
 00100    C-----------------------------------------------------------------------
 00200    C                            MACRO CJDRCH .... JET CHAMBER CONSTANTS.
 00300    C-----------------------------------------------------------------------
 00310    C
 00400  13      COMMON / CJDRCH / RDEC(4),PSIIN(3),RINCR(3),FIRSTW(3),FSENSW(3),
 00500         +                  RDEPTH,SWDEPL,YSUSPN,TIMDEL(2,3),ZMAX,ZOFFS,
 00510         +                  ZRESOL,ZNORM,ZAL,ZSCAL,DRIDEV,DRICOS,DRISIN,
 00600         +                  PEDES,TZERO(3),DRIROT(96,2),SINDRI(96,2),
 00701         +                  COSDRI(96,2),DRIVEL(96,2),T0FIX(3),
 00800         +                  ABERR(8), DUMJDC(20)
 00900    C
 01100    C      BLOCK DATA SET TO MC VALUES, KALIBR WILL SET REAL DATA VALUES
 01210    C--->  A CHANGE OF THIS COMMON MUST BE DONE SIMULTANEOUSLY WITH  <----
 01220    C--->  A CHANGE OF THE BLOCK DATA                                <----
 01230    C
 01300    C--------------------------- END OF MACRO CJDRCH -----------------------
 01400    C
 00017    C
          C----------------------------------------------
          C  MACRO CWORKPR .... PATTERN RECOGNITION CWORK
          C----------------------------------------------
        14      COMMON /CWORK/ HPLAST,HPFREE,HPWRK(30),ADWRK(600),
               ,               HPRO,HNTR,HNTCEL(98),IPCL(200),NRHT(200),
               ,               NWR1(200),DS1(200),SL1(200),
               ,               NWR2(200),DS2(200),SL2(200),
               ,               LBL(200),NTREL(200),ICRO(200),
               ,               NTR,HNREL(100),HISTR(9,100),HRES(168),
               ,               NTRLM,RLMTR(3,5),
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  2
0CARD TARGET
  NO  STM.NO
 
               ,               WRK(7000)
        15      DIMENSION TRKAR(200,11),ITRKAR(200,11),
               ,                         LMRTR(3,5)
        16      EQUIVALENCE (IPCL(1),TRKAR(1,1),ITRKAR(1,1))
        17      EQUIVALENCE (LMRTR(1,1),RLMTR(1,1))
        18      DIMENSION IWRK(7000),HWRK(14000),IDWRK(600),HDWRK(1200)
        19      EQUIVALENCE (IWRK(1),WRK(1),HWRK(1))
        20      EQUIVALENCE (IDWRK(1),ADWRK(1),HDWRK(1))
          C---------- END OF MACRO CWORKPR --------------
 00100    C-------------------------------------------------------
 00200    C  MACRO CWORKEQ .... PATTERN RECOGNITION CWORK POINTERS
 00300    C-------------------------------------------------------
 00400  21      EQUIVALENCE
 00410    C                POINTERS FOR FXYZ HIT ARRAY .. PRIMARY L/R SOLUTION
 00500         #          (HPHT0,HPWRK( 1)),(HPHT9,HPWRK( 2)),(HLDHT,HPWRK( 3))
 00510    C                POINTERS FOR CWORK SINGLE TRACK PATR BANK
 00600         #         ,(HPTR0,HPWRK( 4)),(HPTR9,HPWRK( 5)),(HLDTR,HPWRK( 6))
 00610    C                POINTERS FOR TRACK ELEMENT HIT LABEL ARRAY
 00700         #         ,(HPHL0,HPWRK( 7)),(HPHL9,HPWRK( 8)),(HLDHL,HPWRK( 9))
 00710    C                POINTERS FOR FXYZ HIT ARRAY .. OPPOSITE L/R SOLUTION
 00800         #         ,(HPHT0A,HPWRK(10)),(HPHT9A,HPWRK(11)),(HLDHTA,HPWRK(12))
 00810    C               POINTER LIMIT ON FXYZ HIT ARRAY
 00900         #         ,(HPHTLM,HPWRK(13))
 00910    C               POINTERS FOR
 01000         #         ,(HPTE0,HPWRK(14)),(HPTE9,HPWRK(15)),(HLDTE,HPWRK(16))
 01100    C-------------- END OF MACRO CWORKEQ ------------------
 00020    C
 00021  22      EQUIVALENCE
 00022         ,          (HPCO0 ,HPWRK(17)),(HPCO9 ,HPWRK(18)),(HLDCO ,HPWRK(19))
 00023         ,         ,(ICELL ,IDWRK( 1)),(MHIT  ,IDWRK( 2)),(IRING ,IDWRK( 3))
 00024         ,         ,(IERRCD,IDWRK( 4)),(NTRKEL,IDWRK( 5))
 00025    C
 00026  23      INTEGER DATE(5), IDAY /0/
 00027    C
 00028    C
 00029    C
 00030  24      DATA MAXTRK/ 50/
 00031  25      DATA MKBDHT /Z600/
 00032    C
 00033    C
 00034  26      DATA LBINIT /0/
 00035  27      IF LBINIT.EQ.0
 00036  28      THEN
 00037  31         LBINIT=1
 00038  32         IQJHTL = IBLN('JHTL')
 00039  33         IQPATR = IBLN('PATR')
 00040  34      CIF
 00041    C
 00043  35      IF IDAY.EQ.0                                                       INITIALISE DATE
 00044  36      THEN
 00045  39         CALL DAY2(DATE)
 00046  40         IDAY = DATE(1)*1000 + DATE(2)
 00047  41      CIF
 00048    C
 00050  42      IPJHTL = IDATA(IQJHTL)*2 + 2                                       POINTER TO 'JHTL'-BANK
 00052  43      IPPATR = IDATA(IQPATR)                                             POINTER TO 'PATR'-BANK
 00054  44      ITRBK = IDATA(IPPATR+2)                                            CURRENT NUMBER OF TRACKS
 00056  45      LTRBK = IDATA(IPPATR+3)                                            LENGTH OF TRACK BANK
 00058  46      IPTRBK = IPPATR + IDATA(IPPATR+1) + ITRBK*LTRBK                    POINTER TO NEXT TRACK BANK - 1
 00059    C
 00061  47      IF(IPTRBK+LTRBK-IPPATR.GT.IDATA(IPPATR)) RETURN                    CHECK IF SPACE FOR NEW TRACK
 00062    C
 00063    C     PRINT 2005, (WRK(I),I=HPHT0,HPHT9)
 00064    C
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  3
0CARD TARGET
  NO  STM.NO
 
 00066  49      FOR IP=HPHT0,HPHT9,HLDHT                                           PREPARE GOODNESS LABELS FOR ZRFIT
 00068  50         IWRK(IP+10) = IWRK(IP+ 7)                                       SET ERROR LABEL FOR Z-R FIT
 00069  51         IWRK(IP+ 7) = 0
 00070  52         IF(IWRK(IP+10).GT.1) IWRK(IP+7) = 16
 00072  54         WRK (IP+ 6) = ((WRK(IP+4)/WRK(IP+3))**2 *.5 + 1.) * WRK(IP+3)   CALCULATE R
 00074  55         IP0 = IWRK(IP+1)                                                CALCULATE Z
 00075  56         IAMPL = HDATA(IP0+1)
 00076  57         IAMPR = HDATA(IP0+2)
 00077  58         IF IAMPR.LE.0.OR.IAMPL.LE.0
 00078  59         THEN
 00079  62            WRK (IP+5) = 0.
 00080  63            IWRK(IP+7) = 16
 00081  64         ELSE
 00082  66            Z1 = IAMPR + IAMPL
 00083  67            WRK(IP+5) = FLOAT(IAMPR-IAMPL) * ZAL*.5 / Z1
 00084  68         CIF
 00085  69      CFOR
 00086    C2005 FORMAT('0TRACK:',/,(1X,3I6,4F8.1,I4,F6.2,2I4,F8.3,I6,F8.1))
 00087    C     PRINT 2005, (WRK(I),I=HPHT0,HPHT9)
 00088    C
 00090  71      CALL ZRFIT                                                         Z-R FIT
 00091    C
 00093  72      ZLYMX = 1400.                                                      CHECK IF TRACK LEAVES AT MAX. LAYER
 00094  73      IF ILAYMX.LT.40
 00095  74      THEN
 00096  77         IZW = ILAYMX - 1 + 3
 00097  78         JRING = IZW / 16
 00098  79         ILAY  =-JRING*16 + IZW
 00099  80         RMAX  = ILAY*RINCR(JRING+1) + FSENSW(JRING+1)
 00100  81         ZLYMX = RMAX*WRK(HPTR0+29) + WRK(HPTR0+30)
 00101  82      CIF
 00102    C
 00103  83      IF ABS(ZLYMX)+ 50. .LT. ZMAX
 00104  84      THEN
 00105    C     PRINT 2004, ICELL,ILAYMX,RMAX,ZLYMX,ZMAX
 00106    C     PRINT 2005, (WRK(I),I=HPHT0,HPHT9)
 00107    C2004   FORMAT('0STTRKO-REJECT:',2I6,3F10.1)
 00108  87         RETURN
 00109  88      CIF
 00110    C
 00112  89      PERFORM TRKBNK                                                     REGISTER TRACK IN PATR BANK
 00113  92      IDATA(IPPATR+2) = ITRBK
 00114    C
 00115  93      RETURN
 00116    C
 00117                                                                             ***************************
 00118                                                                             *      T R K B N K        *
 00120    C                                                                        ***************************
 00122  94      PROC TRKBNK                                                        SET TRACK BANK IN /CDATA/
 00123    C
 00125  95         JP = HPTR0                                                      CALC. Z AND DIRECTIONS
 00126  96         IWRK(HPTR0+47)=LOR(IWRK(HPTR0+47),512)
 00127  97         WRK(JP+ 6) = WRK(JP+ 6)*WRK(JP+29) + WRK(JP+30)
 00128  98         WRK(JP+13) = WRK(JP+13)*WRK(JP+29) + WRK(JP+30)
 00129  99         WRK(JP+ 9)= WRK(JP+ 9)*WRK(JP+29)
 00130 100         WRK(JP+16)= WRK(JP+16)*WRK(JP+29)
 00131 101         ALGINV = 1./SQRT(WRK(JP+ 7)**2+WRK(JP+ 8)**2+WRK(JP+ 9)**2)
 00132 102         WRK(JP+ 7) = WRK(JP+ 7) * ALGINV
 00133 103         WRK(JP+ 8) = WRK(JP+ 8) * ALGINV
 00134 104         WRK(JP+ 9) = WRK(JP+ 9) * ALGINV
 00135 105         ALGINV = 1./SQRT(WRK(JP+14)**2+WRK(JP+15)**2+WRK(JP+16)**2)
 00136 106         WRK(JP+14) = WRK(JP+14) * ALGINV
 00137 107         WRK(JP+15) = WRK(JP+15) * ALGINV
 00138 108         WRK(JP+16) = WRK(JP+16) * ALGINV
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  4
0CARD TARGET
  NO  STM.NO
 
 00139    C
 00141 109         ITRBK = ITRBK + 1                                               INCREASE TRACK BANK COUNTER
 00142 110         IP0 = IPTRBK + 1
 00143 111         IP9 = IPTRBK + LTRBK
 00144 112         FOR IP = IP0,IP9
 00145 113            IDATA(IP) = 0
 00146 114         CFOR
 00147 116         IDATA(IPTRBK+ 1) = ITRBK
 00148 117         IDATA(IPTRBK+ 2) = 16
 00149 118         IDATA(IPTRBK+ 3) = IDAY
 00150    C
 00152 119         IP1 = HPTR0+3                                                   RESULTS FROM X-Y-FIT + ZRFIT
 00153 120         IP9 = IP1+29
 00154 121         JP  = IPTRBK + 3
 00155 122         FOR IP=IP1,IP9
 00156 123            JP = JP + 1
 00157 124            IDATA(JP) = IWRK(IP)
 00158 125         CFOR
 00159 127         IDATA(IPTRBK+47)=IWRK(HPTR0+46)
 00160 128         IDATA(IPTRBK+48)=IWRK(HPTR0+47)
 00161    C
 00163 129         IPCLL = IPTRBK + 33                                             POINTER TO FIRST CELL -1
 00164 130         IPCLLM = IPCLL + 6
 00166 131         JCELL0 = -1                                                     INITIALIZE CELL #
 00167    C
 00168 132         IF ITRBK.LE.MAXTRK
 00169 133         THEN
 00170                                                                             SET HIT LABELS
 00172 136            IPJET0 = HPTSEC(1)                                           LOOP OVER ALL HITS
 00173 137            FOR IP=HPHT0,HPHT9,HLDHT
 00175 138               LBBDHT = IWRK(IP+10)                                      LABEL FOR BAD HITS
 00177 139               IF LBBDHT.LE.1                                            SELECT ONLY ACCEPTED HITS
 00178 140               THEN
 00179 143                  LBBDHT = SHFTL(LBBDHT,9)
 00181 144                  IPHTLB = SHFTR((IWRK(IP+1)-IPJET0),1) + IPJHTL         POINTER TO HIT LABEL IN CWORK
 00182                                                                             TRACK NO
 00184 145                  LBHIT = ITRBK*2                                        SET TRACK #
 00186 146                  IF(IWRK(IP+2).GT.0) LBHIT = LOR(LBHIT,256)             SET L/R BIT
 00188 148                  LBHIT1 = HDATA(IPHTLB+1)                               FETCH HIT LABEL OF TRACK
 00189 149                  LBHIT2 = HDATA(IPHTLB+2)
 00190 150                  IRES = ABS(WRK(IP+13)) * 5.
 00191 151                  IF(IRES.GT.31) IRES=31
 00192 153                  IRES=SHFTL(IRES,11)
 00193 154                  LBHIT=LBHIT+IRES
 00194    C     PRINT 2002, LBHIT,LBHIT1,LBHIT2
 00195    C2002 FORMAT(' LABEL:',10(2X,Z4))
 00196    C
 00197 155                  IF LAND(LBHIT1,MKBDHT).NE.0
 00199 156                  THEN                                                   PRIOR HIT IS BAD(XYFIT)
 00200 159                     IF LBBDHT.EQ.0
 00202 160                     THEN                                                THIS HIT IS GOOD
 00203 163                        LBHIT1 = LBHIT
 00205 164                        LBHIT1 = LOR(LBHIT1,1)                           SET BIT FOR BAD Z-COORDINATE
 00206 165                        LBHIT2 = 0
 00208 166                     ELSE                                                NEW HIT IS ALSO BAD
 00210 168                        LBHIT1 = LOR(LBHIT1,1)                           SET BIT FOR BAD  Z-COORDINATE
 00211 169                        LBHIT  = LOR(LBHIT ,1)
 00212 170                        IF(LBHIT2.EQ.0) LBHIT2 = LOR(LBHIT,LBBDHT)
 00213 172                     CIF
 00215 173                  ELSE                                                   NO BAD PRIOR HIT
 00216 175                     IF LBHIT1.EQ.0
 00218 176                     THEN                                                FIRST TRACK FOR THIS HIT NOW
 00219 179                        LBHIT1 = LOR(LBHIT,LBBDHT)
 00221 180                        IF(IWRK(IP+7).EQ.0) LBHIT1 = LOR(LBHIT1,1)       SET BIT FOR GOOD  Z-COORDINATE
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  5
0CARD TARGET
  NO  STM.NO
 
 00223 182                     ELSE                                                SECOND TRACK FOR THIS HIT NOW
 00224 184                        IF LBBDHT.EQ.0
 00225 185                        THEN
 00226 188                           LBHIT2 = LOR(LBHIT,LBBDHT)
 00228 189                           LBHIT1 = LOR(LBHIT1,1)                        SET BIT FOR BAD Z-COORDINATE
 00229 190                           LBHIT2 = LOR(LBHIT2,1)
 00230 191                        CIF
 00231 192                     CIF
 00232 193                  CIF
 00233 194                  HDATA(IPHTLB+1) = LBHIT1
 00234 195                  HDATA(IPHTLB+2) = LBHIT2
 00235 196                  JCELL = IWRK(IP+9)
 00236 197                  IF JCELL.NE.JCELL0
 00237 198                  THEN
 00238 201                     JCELL0 = JCELL
 00239 202                     IPCLL  = IPCLL + 1
 00240 203                     IF(IPCLL.GT.IPCLLM) IPCLL = IPCLLM
 00241 205                     IDATA(IPCLL) = JCELL0
 00242 206                  CIF
 00243 207               CIF
 00244 208            CFOR
 00245    C
 00246 210            DATA NPR /0/
 00247 211            NPR = NPR + 1
 00248 212            I0 = IPTRBK + 1
 00249 213            I9 = IPTRBK + LTRBK
 00250    C     IF(NPR.LE.12) PRINT 2904,(IDATA(I1),I1=I0,I9)
 00251    C2904 FORMAT(1H0,2I3,I8,2(I4,3F6.1,3F6.3),
 00252    C    ,     /,14X,I3,4E13.5,F6.2,I3,4E13.5,
 00253    C    ,     /,14X,I3,2F8.3,F6.1,I3,10X,6I3,5I6,2F6.0,I6,2X,Z4)
 00254 214         CIF
 00255    C
 00257 215         IPTRBK = IPTRBK + LTRBK                                         INCREASE POINTER TO TRACK BANK
 00258    C
 00259 216      CPROC
 00260    C
 00261 218      END
0END OF SEGMENT
0  OPTIONS IN EFFECT - LINECOUNT=64,LINEWIDTH=131,  SOURCE,  FORTRAN  NUMBERING
0   0 ERRORS           0 WARNINGS         217 TARGET STATEMENTS
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  1
0CARD TARGET
  NO  STM.NO
 
0END OF PROGRAM
0  OPTIONS IN EFFECT - LINECOUNT=64,LINEWIDTH=131,  SOURCE,  FORTRAN  NUMBERING
0   0 ERRORS           0 WARNINGS         217 TARGET STATEMENTS
 00000    C   29/10/80 405092108  MEMBER NAME  TRACEO   (PATRECSR)    SHELTRAN
 00100   2      SUBROUTINE TRACEO(ITRK,PAR1,PAR2,PAR3)
 00200    C
 00300    C        FIND HITS OF TRACKS FROM ORIGIN
 00400    C        P. STEFFEN                     2/07/80
 00500    C
 00600   3      IMPLICIT INTEGER*2 (H)
 00700   4      LOGICAL DEADCL
 00800    C
          C-------------------------------
          C  MACRO CHEADR .... HEADER BANK
          C-------------------------------
         5      COMMON /CHEADR/ IHEADR(54)
         6      INTEGER*2 HHEADR(108)
         7      EQUIVALENCE (IHEADR(1),HHEADR(1))
          C --
          C --  HHEADR(17) = EXPERIMENT NUMBER
          C --  HHEADR(18) = RUN NUMBER
          C --  HHEADR(19) = EVENT NUMBER
          C --  HHEADR(38) = MAGNETIC FIELD (GAUSS)
          C --
          C--------- END OF MACRO CHEADR ------------
 01000   8      EQUIVALENCE (HHEADR(18),HRUN)
 01100    C
          C----------------------------------------------------------------------
          C             MACRO CDATA .... BOS COMMON.
          C
          C             THIS MACRO ONLY DEFINES THE IDATA/HDATA/ADATA NAMES.
          C             THE ACTUAL SIZE OF /BCS/ IS FIXED ON MACRO CBCSMX
          C             OR BY OTHER MEANS. A DEFAULT SIZE OF 40000 IS GIVEN HERE.
          C
          C----------------------------------------------------------------------
          C
         9      COMMON /BCS/ IDATA(40000)
        10      DIMENSION HDATA(80000),ADATA(40000),IPNT(50)
        11      EQUIVALENCE (HDATA(1),IDATA(1),ADATA(1)),(IPNT(1),IDATA(55))
        12      EQUIVALENCE (NWORD,IPNT(50))
          C
          C------------------------ END OF MACRO CDATA --------------------------
          C----------------------------------------------------------------------
          C           MACRO CCYCP .... JET CHAMBER HIT POINTERS (PATREC)
          C----------------------------------------------------------------------
        13      INTEGER*4 HPTSEC
        14      COMMON/CCYCP/HPTSEC(98)
 00016    C     HPTSEC(I) = CDATA POINTER TO 1ST I*2 WORD FOR 1ST HIT OF CELL I
          C------------------------ END OF MACRO CCYCP --------------------------
 01400    C
          C----------------------------------------------
          C  MACRO CWORKPR .... PATTERN RECOGNITION CWORK
          C----------------------------------------------
        15      COMMON /CWORK/ HPLAST,HPFREE,HPWRK(30),ADWRK(600),
               ,               HPRO,HNTR,HNTCEL(98),IPCL(200),NRHT(200),
               ,               NWR1(200),DS1(200),SL1(200),
               ,               NWR2(200),DS2(200),SL2(200),
               ,               LBL(200),NTREL(200),ICRO(200),
               ,               NTR,HNREL(100),HISTR(9,100),HRES(168),
               ,               NTRLM,RLMTR(3,5),
               ,               WRK(7000)
        16      DIMENSION TRKAR(200,11),ITRKAR(200,11),
               ,                         LMRTR(3,5)
        17      EQUIVALENCE (IPCL(1),TRKAR(1,1),ITRKAR(1,1))
        18      EQUIVALENCE (LMRTR(1,1),RLMTR(1,1))
        19      DIMENSION IWRK(7000),HWRK(14000),IDWRK(600),HDWRK(1200)
        20      EQUIVALENCE (IWRK(1),WRK(1),HWRK(1))
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  2
0CARD TARGET
  NO  STM.NO
 
        21      EQUIVALENCE (IDWRK(1),ADWRK(1),HDWRK(1))
          C---------- END OF MACRO CWORKPR --------------
 00100    C-------------------------------------------------------
 00200    C  MACRO CWORKEQ .... PATTERN RECOGNITION CWORK POINTERS
 00300    C-------------------------------------------------------
 00400  22      EQUIVALENCE
 00410    C                POINTERS FOR FXYZ HIT ARRAY .. PRIMARY L/R SOLUTION
 00500         #          (HPHT0,HPWRK( 1)),(HPHT9,HPWRK( 2)),(HLDHT,HPWRK( 3))
 00510    C                POINTERS FOR CWORK SINGLE TRACK PATR BANK
 00600         #         ,(HPTR0,HPWRK( 4)),(HPTR9,HPWRK( 5)),(HLDTR,HPWRK( 6))
 00610    C                POINTERS FOR TRACK ELEMENT HIT LABEL ARRAY
 00700         #         ,(HPHL0,HPWRK( 7)),(HPHL9,HPWRK( 8)),(HLDHL,HPWRK( 9))
 00710    C                POINTERS FOR FXYZ HIT ARRAY .. OPPOSITE L/R SOLUTION
 00800         #         ,(HPHT0A,HPWRK(10)),(HPHT9A,HPWRK(11)),(HLDHTA,HPWRK(12))
 00810    C               POINTER LIMIT ON FXYZ HIT ARRAY
 00900         #         ,(HPHTLM,HPWRK(13))
 00910    C               POINTERS FOR
 01000         #         ,(HPTE0,HPWRK(14)),(HPTE9,HPWRK(15)),(HLDTE,HPWRK(16))
 01100    C-------------- END OF MACRO CWORKEQ ------------------
 01700    C
 01800  23      EQUIVALENCE
 01900         ,          (HPCO0 ,HPWRK(17)),(HPCO9 ,HPWRK(18)),(HLDCO ,HPWRK(19))
 02000         ,         ,(ICELL ,IDWRK( 1)),(MHIT  ,IDWRK( 2)),(IRING ,IDWRK( 3))
 02100         ,         ,(IERRCD,IDWRK( 4)),(NTRKEL,IDWRK( 5))
 02200    C
          C----------------------------------------------
          C  MACRO CPATLM .... PATTERN RECOGNITION LIMITS
          C----------------------------------------------
        24      COMMON /CPATLM/ PATRLM(5),FLINLM(10),TRELLM(20),ZFITLM(10),BKK(20)
               *               ,XYF(20),IGFP(20),XBKK(40),IADMIN(5),YBKK(20)
        25      INTEGER IXYF(20),LMPATR(5),LMFLIN(10)
        26      INTEGER LMTREL(20),LMZFIT(10),IBKK(20)
        27      DIMENSION GFP(20),IXBKK(40),IYBKK(20)
        28      EQUIVALENCE (PATRLM(1),LMPATR(1)),(IXBKK(1),XBKK(1)),(IYBKK(1),
               *YBKK(1))   ,(FLINLM(1),LMFLIN(1)),(TRELLM(1),LMTREL(1))
               *           ,(ZFITLM(1),LMZFIT(1)),(BKK(1),IBKK(1))
               *           ,(XYF(1),IXYF(1)),(GFP(1),IGFP(1)),(IADMIN(1),IMCERT)
               *           ,(IYBKK(20),IPPASS),(IADMIN(2),IPFAST)
          C----------- END OF MACRO CPATLM --------------
 02400    C
 00100    C-----------------------------------------------------------------------
 00200    C                            MACRO CJDRCH .... JET CHAMBER CONSTANTS.
 00300    C-----------------------------------------------------------------------
 00310    C
 00400  29      COMMON / CJDRCH / RDEC(4),PSIIN(3),RINCR(3),FIRSTW(3),FSENSW(3),
 00500         +                  RDEPTH,SWDEPL,YSUSPN,TIMDEL(2,3),ZMAX,ZOFFS,
 00510         +                  ZRESOL,ZNORM,ZAL,ZSCAL,DRIDEV,DRICOS,DRISIN,
 00600         +                  PEDES,TZERO(3),DRIROT(96,2),SINDRI(96,2),
 00701         +                  COSDRI(96,2),DRIVEL(96,2),T0FIX(3),
 00800         +                  ABERR(8), DUMJDC(20)
 00900    C
 01100    C      BLOCK DATA SET TO MC VALUES, KALIBR WILL SET REAL DATA VALUES
 01210    C--->  A CHANGE OF THIS COMMON MUST BE DONE SIMULTANEOUSLY WITH  <----
 01220    C--->  A CHANGE OF THE BLOCK DATA                                <----
 01230    C
 01300    C--------------------------- END OF MACRO CJDRCH -----------------------
 01400    C
          C----------------------------------------------------------------------
          C           MACRO CDSMAX .... PATTERN RECOGNITION CONSTANTS.
          C----------------------------------------------------------------------
        30      COMMON/CDSMAX/DSMAX(16,3,2),DIRWR1(24,2),DIRWR3(48,2)
               *             ,DHALF(16,3,2),DTWICE(16,3,2),HMCH(16,3,2)
               *             ,IBCK(9),DBCK(30),TRMATS(96,2),TRMATC(96,2)
          C------------------------ END OF MACRO CDSMAX -------------------------
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  3
0CARD TARGET
  NO  STM.NO
 
 02700    C
          C----------------------------------------------------------------------
          C            MACRO CALIBR .... JADE CALIBRATION DATA COMMON
          C----------------------------------------------------------------------
        31      COMMON/CALIBR/ ACALIB(1000)
        32      DIMENSION HCALIB(100),ICALIB(100)
 02600  33      EQUIVALENCE(ACALIB(1),HCALIB(1),ICALIB(1))
          C------------------------ END OF MACRO CALIBR -------------------------
 02900    C
 03000  34      DIMENSION ITRCLL(6),CSRCLL(6),SNRCLL(6), NCNCK(24)
 03100  35      DIMENSION CSRNG1(3),SNRNG1(3),CSRNG3(4),SNRNG3(4)
 03200    C
 03400  36      DATA NCOAR / 15/, DTGB / .15/                                      CONSTANTS FOR ANGULAR CORRECTION
 03500  37      REAL TGCOAR(15) /-99.,-.45, 12*0., 99./
 03600  38      REAL T0COAR(60) / .000, .000, .000, .000, .000,
 03700         ,     .000, .000,-.020,-.060,-.130,-.030, .100, .200, .200, .200,
 03800         ,                  .000, .000, .010, .110, .100,
 03900         ,     .075, .050, .025, .005, .015, .065, .060, .060, .060, .060,
 04000         ,                  .190, .190, .180, .165, .140,
 04100         ,     .120, .100, .075, .050, .010,-.050,-.075,-.035, .000, .000,
 04200         ,                  .110, .110, .115, .140, .135,
 04300         ,     .085, .045, .030, .040, .050, .055, .055, .055, .055, .055/
 04400  39      REAL SLCOAR(60) / 60*0./
 04500    C
 04700  40      INTEGER MKBDCL(3) /Z10,Z20,Z40/                                    MASK FOR TRACKS AT CELL WALL + IN DEAD CELLS
 04800  41      INTEGER MKDDCL(3) /Z01,Z02,Z04/
 04900    C
 05000    C     IF(ICELL.GT.84) RETURN
 05100    C     PRINT 2900, IRING, ICELL, ITRK,PAR1,PAR2,PAR3
 05200    C     PRINT 2901, (WRK(I1),I1=HPHT0,HPHT9)
 05300    C2900 FORMAT(1H0,'RING:',I4, ', ICELL:',I3,', TRACK:',I4,3F10.5)
 05400    C2901 FORMAT(1X,/,(1X,2I6,2F6.2,2X,Z4,4F7.1,2I6,F6.2))
 05500    C2902 FORMAT(/,(1X,3I6,4F8.5,I3,2F6.2,I3,2F6.2,2X,Z4,2X,Z4,2X,Z5,F6.2))
 05600    C2904 FORMAT(1H0,2I3,I8,2(I4,3F6.1,3F6.3),
 05700    C    ,     /,14X,I3,4E13.5,F6.2,I3,4E13.5,
 05800    C    ,     /,14X,I3,2F8.3,F6.1,I3,10X,6I3,8I6,2X,Z4)
 05900    C2001 FORMAT('0TRACK0-INIT.:',3F10.5,F10.3,3F10.5,2F6.2)
 06000    C2002 FORMAT('0FETCH:',4I6,F10.1,6F9.5)
 06100    C2003 FORMAT('0ROTATION:',10F10.5)
 06200    C2004 FORMAT('0WALLS:',2I3,3F10.5)
 06300    C2005 FORMAT('0TRACK:',I6,/,(1X,3I6,4F9.5,I4,F9.5,2I4,F9.5,I6,F9.5))
 06400    C2006 FORMAT(1X,I6,5F8.2,F12.1,5F8.2)
 06500    C2007 FORMAT(' SIDE?',3I6,3F8.1)
 06600    C2008 FORMAT(' FIT:',2I3,F8.2,F5.0,F10.6,F7.3,F5.1,F6.3,F5.1)
 06700    C2009 FORMAT(' ROTATION:',2I6,10F10.5)
 06800    C2010 FORMAT(' HIT:',I6,12F8.2)
 06900    C2012 FORMAT('0FITBNK:',2I3,8F9.5)
 07000    C2014 FORMAT('0FIT-BANK:',5F8.3,5X,5F8.3,5X,F8.5,2F8.1)
 07100    C2015 FORMAT(' SELCLL:',2I4,8F8.3)
 07200    C2016 FORMAT('0ITRCLL =',6I8,/,(9X,6F8.3))
 07300    C2019 FORMAT(' TRACK IN DEAD CELL:',10I6)
 07400    C2107 FORMAT(' SIGLM:',10F8.3)
 07500    C
 07700  42      DATA LBINIT /0/                                                    INITIALIZATION
 07800  43      IF LBINIT .EQ. 0
 07900  44      THEN
 08000  47         LBINIT = 1
 08100  48         PERFORM INIT
 08200  51      CIF
 08300    C
 08500  52      HPCO0  = HPFREE                                                    RESERVE SPACE IN CWORK
 08600  53      HLDCO  = 14
 08700  54      HPFREE = HLDCO*100 + HPCO0
 08800  55      HPCO9 = HPFREE - 1
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  4
0CARD TARGET
  NO  STM.NO
 
 08900  56      IPCOMX= HPFREE - HLDCO
 09000    C
 09200  57      R0 = FSENSW(IRING)                                                 LOAD RADIUS AND WIRE SPACING
 09300  58      DR = RINCR (IRING)
 09400    C
 09600  59      X0    = DR*15. + R0                                                ROTAION ANGLE
 09700  60      Y0    = (PAR1*X0 + PAR2) * X0
 09800  61      TGROT = Y0 / X0
 09900  62      CSROT = 1. / SQRT(TGROT**2 + 1.)
 10000  63      SNROT = CSROT*TGROT
 10100  64      CSROT0= CSROT
 10200  65      SNROT0= SNROT
 10300    C     PRINT 2003, TGROT,CSROT,SNROT,X0,Y0,PAR1,PAR2,PAR3,WGHT0,Y0
 10400    C
 10600  66      PERFORM PRCOAR                                                     PREPARE COORDINATE ARRAY
 10700    C
 10900  69      WGHT0 = .01                                                        REFIT PARABOLA THROUGH ORIGIN
 11000  70      Y0    = 0.
 11100  71      PERFORM FPARA0
 11200  74      IF(S0.LT.3.5 .OR. SIG.GT.100.) RETURN
 11300    C
 11500  76      DORIG = PAR3                                                       CHECK IF DIST. TO ORIGIN ACCEPTABLE
 11600  77      IF(PAR1.LT.0) DORIG =-PAR3
 11700  79      IF DORIG.GT.11. .OR. DORIG.LT.-3.
 11800  80      THEN
 12000  83         WGHT0 = 1.0                                                     TOO BIG DIST., REPEAT FIT WITH RESTRICTION
 12100  84         Y0 = SIGN(10.,PAR1)
 12200  85         IF(DORIG.LT.0) Y0 =-SIGN(2.,PAR1)
 12300  87         PERFORM FPARA0
 12400  90      CIF
 12500    C
 12700  91      IF(SIG.GT.0.15) RETURN                                             CHECK IF GOOD FIT
 12800  93      IF(S0 .LT. 4.5) RETURN
 12900  95      IF(SIG.GT.0.06 .AND. S0 .LT. 6.5) RETURN
 13000    C
 13200  97      JCELL = ICELL                                                      START TRACING INWARDS
 13300  98      JRING = IRING
 13400    C
 13600  99      PERFORM SELCLL                                                     SELECT CELLS
 13700    C
 13900 102      KCLL = 0                                                           LOOP OVER ALL CELLS + FETCH HITS
 14000 103      NHIT = 0
 14100 104      IPCO = HPCO0
 14200    C
 14400 105      JRING = 0                                                          LOOP OVER RINGS
 14500                                                                             INITIALIZE LABEL FOR DEAD CELLS +
 14700 106      LBCELL = 0                                                         TRACKS AT CELL WALLS
 14900 107      LBHTMX = 0                                                         INITIALIZE LABEL FOR >100 HITS
 15000 108      REPEAT
 15100 109         JRING = JRING + 1
 15200 110         NHRNG = 0
 15300 111         NCLL = 0
 15400 112         REPEAT
 15500 113            NCLL = NCLL + 1
 15600 114            KCLL = KCLL + 1
 15700 115            JCELL = ITRCLL(KCLL)
 15800 116            IF JCELL.NE.0
 15900 117            THEN
 16000 120               CSROT = CSRCLL(KCLL)
 16100 121               SNROT = SNRCLL(KCLL)
 16200 122               PERFORM FETCH
 16300 125               NHRNG = NHRNG + JHIT
 16500 126               IF(LBHTMX.NE.0) RETURN                                    STOP IF > 100 HITS FOR THIS TRACK
 16600 128            CIF
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  5
0CARD TARGET
  NO  STM.NO
 
 16700 129         UNTIL NCLL.EQ.2
 16800 130         IF(NHRNG.LT.2 .AND. JRING.LT.IRING) RETURN
 17000 135         IF(JCELL.NE.0) LBCELL = LOR(MKBDCL(JRING),LBCELL)               SET LABEL FOR TRACK AT CELL BOUND.
 17100 137      UNTIL KCLL.EQ.6
 17200 138      HPCO9 = IPCO - 1
 17300    C
 17500 142      CALL LBHTRO(ITRK,PAR1,PAR2,PAR3,INDPAR)                            LABEL HITS BELONGING TO TRACK
 17600    C     PRINT 2005, INDPAR,(WRK(I),I=HPCO0,HPCO9)
 17700    C
 17900 143      IF INDPAR.EQ.0                                                     FIT PARABOLA
 18000 144      THEN
 18100 147         WGHT0 = 0.10
 18200 148         Y0 = 0.
 18300 149      ELSE
 18400 151         WGHT0 = 0.03
 18500 152         Y0 = PAR3
 18600 153      CIF
 18700 154      PERFORM FPARA0
 18800 157      IF(S0.LT.3.5 .OR. SIG.GT.100.) RETURN
 18900    C
 19100 159      ALBLM1 = 0.6                                                       RELABEL HITS
 19200 160      ALBLM2 = 3.0
 19300 161      PERFORM LABEL
 19400    C
 19600 164      WGHT0 = PATRLM(2)                                                  REFIT PARABOLA
 19700 165      SIG0  = SIG
 19800 166      PERFORM FPARA0
 19900    C
 20100 169      IF(S0.LT.7.5 .OR. SIG.GT.100.) RETURN                              STOP IF <8 GOOD HITS OR BAD FIT
 20200    C
 20400 171      ALBLM1 = 0.6                                                       RELABEL HITS
 20500 172      ALBLM2 = 3.0
 20600 173      PERFORM LABEL
 20700    C
 20900 176      WHILE  NHITLB-S0 .GT. 4.5 .OR. SIG0-SIG.GT..25                     REFIT IF MORE THAN 4 NEW HITS LABELED
 21000 178         SIG0  = SIG
 21100 182         PERFORM FPARA0
 21200 185         PERFORM LABEL
 21300 188      CWHILE
 21400    C     PRINT 2005, INDPAR,(WRK(I),I=HPCO0,HPCO9)
 21500    C
 21700 190      IF SIG.LE.0.1225                                                   CHECK IF ACCEPTABLE TRACK
 21800 191      THEN
 21900    C
 22100 194         CALL CKTRKO(LBCKTR,LBCELL)                                      CHECK IF GOOD TRACK
 22200 195         IF(LBCKTR.LE.16) RETURN
 22300    C
 22500 197         PERFORM FITBNK                                                  SET UP FIT-BANK
 22600                                                                             STORE TRACK IN 'PATR'-BANK
 22800 200         HPHT0S = HPHT0                                                  AND REGISTER HITS IN 'JHTL'-BANK
 22900 201         HPHT9S = HPHT9
 23000 202         HLDHTS = HLDHT
 23100 203         HPHT0  = HPCO0
 23200 204         HPHT9  = HPCO9
 23300 205         HLDHT  = HLDCO
 23400    C
 23500 206         CALL STTRKO(LBCKTR)
 23600    C
 23700 207         HPHT0  = HPHT0S
 23800 208         HPHT9  = HPHT9S
 23900 209         HLDHT  = HLDHTS
 24000 210      CIF
 24100 211      RETURN
 24200    C
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  6
0CARD TARGET
  NO  STM.NO
 
 24300    C
 24400                                                                             *************************
 24500                                                                             *      P R C O A R      *
 24700    C                                                                        *************************
 24800    C
 25000 212      PROC PRCOAR                                                        PREPARE COORDINATE ARRAY
 25100    C
 25300 213         XR1  = DR*7.5 + R0                                              ANGLE OF TRACK IN RING
 25400 214         TGB  = PAR1*XR1 * 2. + PAR2
 25500 215         CSB  = 1. / SQRT(TGB**2+1.)
 25600 216         SNB  = CSB * TGB
 25700    C
 25900 217         DRISN  = SINDRI(ICELL,1)                                        CALCULATE X,Y COORDINATES + FILL ARRAY
 26000 218         DRICS  = COSDRI(ICELL,1)
 26100 219         IHIT = 0
 26200 220         IPCO = HPCO0
 26300 221         IP = HPHT9 - HLDHT + 1
 26400    C     PRINT 2002, IRING,ICELL,IP,HPHT0,XR1,TGB,SNB,CSB,DRISN,DRICS
 26500 222         REPEAT
 26600 223            LBSIDE  = 0
 26700 224            LBGOOD = 0
 26800 225            IF IABS(IWRK(IP+ 9)).EQ.ITRK
 26900 226            THEN
 27000 229               LBSIDE = -1
 27100 230               IF(LAND(IWRK(IP+4),2).NE.0) LBSIDE = 1
 27200 232               IF(IWRK(IP+ 9).LT.0) LBGOOD = 1
 27300 234            ELSE
 27400 236               IF IABS(IWRK(IP+10)).EQ.ITRK
 27500 237               THEN
 27600 240                  LBSIDE = -1
 27700 241                  IF(LAND(IWRK(IP+4),8).NE.0) LBSIDE = 1
 27800 243                  IF(IWRK(IP+10).LT.0) LBGOOD = 1
 27900 245               CIF
 28000 246            CIF
 28100    C
 28300 247            IF LBSIDE.NE.0                                               CHECK IF SELECTED HIT
 28400 248            THEN
 28500 251               ILAY = IWRK(IP  )
 28600 252               Y    = SWDEPL
 28700 253               IF(LAND(ILAY,1).NE.0) Y =-Y
 28800 255               DS   =  WRK(IP+2)
 28900 256               X    = ILAY * DR + R0
 29000 257               IF DS.LE.DRC
 29100 258               THEN
 29200 261                  DX   =-DS * SNB
 29300 262                  DY   = DS * CSB
 29400 263               ELSE
 29500 265                  DX   =-(DS-DRC)*DRISN - DRC*SNB
 29600 266                  DY   = (DS-DRC)*DRICS + DRC*CSB
 29700 267               CIF
 29800 268               X    = DX*LBSIDE + X
 29900 269               Y    = DY*LBSIDE + Y
 30000 270               XX   = X*CSROT + Y*SNROT
 30100 271               YY   =-X*SNROT + Y*CSROT
 30200    C
 30300 272               IF(LBGOOD.LE.2) IHIT = IHIT + 1
 30400    C
 30600 274               IWRK(IPCO   ) = ILAY                                      FILL COORDINATE ARRAY
 30700 275               IWRK(IPCO+ 1) = IWRK(IP+1)
 30800 276               IWRK(IPCO+ 2) = LBSIDE
 30900 277               WRK (IPCO+ 3) = XX
 31000 278               WRK (IPCO+ 4) = YY
 31100 279               WRK (IPCO+ 5) = 0.
 31200 280               WRK (IPCO+ 6) = 0.
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  7
0CARD TARGET
  NO  STM.NO
 
 31300 281               IWRK(IPCO+ 7) = LBGOOD
 31400 282               WRK (IPCO+ 8) = DS
 31500 283               IWRK(IPCO+ 9) = ICELL
 31600 284               IWRK(IPCO+10) = LBGOOD
 31700 285               WRK (IPCO+11) = TGB
 31800 286               IWRK(IPCO+12) = IRING
 31900 287               WRK (IPCO+13) = 0.
 32000 288               IPCO = IPCO + HLDCO
 32100 289            CIF
 32200 290            IP = IP - HLDHT
 32300 291         UNTIL IP.LT.HPHT0
 32400 292         NHIT = IHIT
 32500 296         HPCO9 = IPCO - 1
 32600    C     PRINT 2005, NHIT,(WRK(I),I=HPCO0,HPCO9)
 32700    C
 32800 297      CPROC
 32900    C
 33000                                                                             *************************
 33100                                                                             *      F P A R A 0      *
 33300    C                                                                        *************************
 33400    C
 33600 299      PROC FPARA0                                                        PARABOLA FIT THROUG ORIGIN
 33700    C
 33800                                                                             GET EQUATIONS
 34000 300         S0 = WGHT0                                                      WEIGHT ORIGIN AS POINT OF PARABOLA
 34100 301         S1 = 0.
 34200 302         S2 = 0.
 34300 303         S3 = 0.
 34400 304         S4 = 0.
 34500 305         S5 = 0.
 34600 306         S6 = 0.
 34700 307         S7 = Y0 * WGHT0
 34800 308         IPCO = HPCO0
 34900 309         REPEAT
 35000 310            IF IWRK(IPCO+ 7).EQ.0
 35100 311            THEN
 35200 314               X = WRK(IPCO+3)
 35300 315               Y = WRK(IPCO+4)
 35400 316               X2 = X**2
 35500 317               S1 = S1 + X
 35600 318               S2 = S2 + X2
 35700 319               S3 = S3 + X*X2
 35800 320               S4 = S4 + X2**2
 35900 321               S5 = S5 + Y*X2
 36000 322               S6 = S6 + Y*X
 36100 323               S7 = S7 + Y
 36200 324               S0 = S0 + 1.
 36300 325            CIF
 36400 326            IPCO = IPCO + HLDCO
 36500 327         UNTIL IPCO.GT.HPCO9
 36600    C
 36800    C                                                                        CALCULATE PARAMETERS
 36900 328         IF S0.LT.3.5
 37000 332         THEN
 37100 335            SIG = 1000.
 37200 336         ELSE
 37300    C
 37500 338            F1 = 1. / S4                                                 SOLVE EQUATIONS FOR PARABOLA FIT
 37600 339            XX12 = S3*F1
 37700 340            XX13 = S2*F1
 37800 341            YY1  = S5*F1
 37900 342            XX22 = S2 - S3*XX12
 38000 343            XX23 = S1 - S3*XX13
 38100 344            YY2  = S6 - S3*YY1
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  8
0CARD TARGET
  NO  STM.NO
 
 38200 345            XX32 = S1 - S2*XX12
 38300 346            XX33 = S0 - S2*XX13
 38400 347            YY3  = S7 - S2*YY1
 38500 348            IF XX22.GT.XX32
 38600 349            THEN
 38700 352               XX23 = XX23 / XX22
 38800 353               YY2  = YY2  / XX22
 38900 354               DET  = XX33 - XX32*XX23
 39000 355               IF ABS(DET).GT.1.E-30
 39100 356               THEN
 39200 359                  PAR3 = (YY3 - XX32*YY2) / DET
 39300 360                  PAR2 = YY2 - XX23*PAR3
 39400 361               CIF
 39500 362            ELSE
 39600 364               XX33 = XX33 / XX32
 39700 365               YY3  = YY3  / XX32
 39800 366               DET  = XX23 - XX22*XX33
 39900 367               IF ABS(DET).GT.1.E-30
 40000 368               THEN
 40100 371                  PAR3 = (YY2 - XX22*YY3) / DET
 40200 372                  PAR2 = YY3 - XX33*PAR3
 40300 373               CIF
 40400 374            CIF
 40500 375            IF ABS(DET).LE.1.E-30
 40600 376            THEN
 40700 379               SIG = 1000.
 40800 380            ELSE
 40900 382               PAR1 = YY1 - XX12*PAR2 - XX13*PAR3
 41000 383               DEG = S0 - WGHT0 - 2.
 41100 384               IF(WGHT0.LT..001) DEG = DEG - 1.
 41200    C
 41300    C
 41500 386               CHISQ = 0.                                                CALC. CHISQ + SOLVE L/R AMBIGUITY
 41600 387               DCHIM1 = 0.
 41700 388               IHITM1 = 0
 41800 389               IPCO = HPCO0
 41900 390               REPEAT
 42000 391                  IF IWRK(IPCO+ 7).EQ.0
 42100 392                  THEN
 42200 395                     X = WRK(IPCO+3)
 42300 396                     Y = WRK(IPCO+4)
 42400 397                     F = (PAR1 *X + PAR2 )*X + PAR3
 42500 398                     DCHI = Y - F
 42600 399                     WRK(IPCO+13) = DCHI
 42800 400                     CHISQ = CHISQ + DCHI**2                             SUM FOR RMS
 43000    C           IF ABS(DCHI).GE.DCHIM1                                       KEEP BIGGEST RMS
 43100    C           THEN
 43200    C             DCHIM1 = ABS(DCHI)
 43300    C             IHITM1 = IPCO
 43400    C           CIF
 43500    C     PRINT 2006, IPCO,X,Y,F,DCHI,CHISQ
 43600 401                  CIF
 43700 402                  IPCO = IPCO + HLDCO
 43800 403               UNTIL IPCO.GT.HPCO9
 43900 404               SIG    =      CHISQ  / DEG
 44000    C     PRINT 2008, IWRK(IHSTRT),IWRK(IHEND),SIG,DEG,PAR1,PAR2,PAR3,
 44100    C    ,            WGHT0,Y0
 44200    C
 44400 408               SIGLM = TRELLM(16)**2                                     SET LIMIT FOR SIGMA
 44500    C
 44600 409            CIF
 44700 410         CIF
 44800    C
 44900 411      CPROC
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  9
0CARD TARGET
  NO  STM.NO
 
 45000    C
 45100                                                                             *************************
 45200                                                                             *      S E L C L L      *
 45400    C                                                                        *************************
 45500    C
 45700 413      PROC SELCLL                                                        SELECT CELLS CONTAINING TRACK
 45800    C
 46000 414         ICELL0 = ICELL - 1                                              BASIC CELL #
 46100 415         IF(ICELL.GT.24) ICELL0 = ICELL - 25
 46200 417         IF(ICELL.GT.48) ICELL0 = (ICELL-49)/2
 46300    C
 46500 419         IF IRING.NE.3                                                   ROTATION INTO BASIC CELL SYSTEM
 46600 420         THEN
 46700 423            TGR1 = TGROT
 46800 424            SNR1 = SNROT
 46900 425            CSR1 = CSROT
 47000 426         ELSE
 47100 428            IF LAND(ICELL,1).EQ.0
 47200 429            THEN
 47300 432               CSR1 = CSROT*CSFI3 - SNROT*SNFI3
 47400 433               SNR1 = CSROT*SNFI3 + SNROT*CSFI3
 47500 434            ELSE
 47600 436               CSR1 = CSROT*CSFI3 + SNROT*SNFI3
 47700 437               SNR1 =-CSROT*SNFI3 + SNROT*CSFI3
 47800 438            CIF
 47900 439            TGR1 = SNR1 / CSR1
 48000 440         CIF
 48100    C     PRINT 2015, ICELL,ICELL0,SNR1,CSR1,TGR1,SNROT,CSROT,SNFI3,CSFI3
 48200    C
 48400 441         JRING = 0                                                       LOOP OVER ALL RINGS
 48500 442         WHILE JRING.LT.3
 48600 444            JRING = JRING + 1
 48700    C
 48900 448            R0 = FSENSW(JRING)                                           1. + LAST POINT IN RING
 49000 449            DR = RINCR (JRING)
 49100 450            X1 = R0 - DR*2.
 49200 451            X2 = R0 + DR*17.
 49300 452            Y1 = (PAR1*X1 + PAR2)*X1 + PAR3
 49400 453            Y2 = (PAR1*X2 + PAR2)*X2 + PAR3
 49600 454            XX1 = X1*CSR1 - Y1*SNR1                                      ROTATE POINTS INTO CELL SYSTEM
 49700 455            YY1 = X1*SNR1 + Y1*CSR1
 49800 456            XX2 = X2*CSR1 - Y2*SNR1
 49900 457            YY2 = X2*SNR1 + Y2*CSR1
 50000    C     PRINT 2015, JRING,ICELL0,XX1,YY1,XX2,YY2,R0,DR
 50100    C
 50300 458            ICELL1 = 0                                                   FIND CELLS
 50400 459            LBINV  = 0
 50500 460            REPEAT
 50600 461               IF JRING.EQ.3
 50700 462               THEN
 50800                                                                             RING 3
 50900                                                                             CHECK IF TRACK PASSES CENTRAL WALL
 51000 465                  IF ABS(YY1).LT.3.0 .OR. ABS(YY2).LT.3.0 .OR. YY1*YY2.LE.0.
 51100 466                  THEN
 51200 469                     ICELL1 =  2
 51300 470                     LBINV = 1
 51400 471                     IF(YY1.GT.YY2) LBINV =-1
 51500 473                     XREPEAT
 51600 474                  CIF
 51800 475                  DY1 = ABS(YY1) - TGFI1*XX1                             CHECK IF TRACK PASSES SIDE WALL
 51900 476                  DY2 = ABS(YY2) - TGFI1*XX2
 52000 477                  IF ABS(DY1).LT.3.0 .OR. ABS(DY2).LT.3.0 .OR. DY1*DY2.LE.0.
 52100 478                  THEN
 52200 481                     ICELL1 =  1
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE 10
0CARD TARGET
  NO  STM.NO
 
 52300 482                     IF(YY1.GT.0) ICELL1 = 3
 52400 484                     LBINV  = 1
 52500 485                     IF((DY2-DY1)*YY1 .LT. 0.) LBINV =-1
 52600 487                     XREPEAT
 52700 488                  CIF
 52900 489                  ICELL1 =  2                                            TRACK STAYS IN ONE CELL
 53000 490                  IF(YY1.GT.0.) ICELL1 = 3
 53100 492                  IF DY1.GT.0
 53200 493                  THEN
 53300 496                     ICELL1 =  1
 53400 497                     IF(YY1.GT.0.) ICELL1 = 4
 53500 499                  CIF
 53600 500                  XREPEAT
 53700 501               CIF
 53800    C
 53900                                                                             RING 1, 2
 54100 502               DY1 = ABS(YY1) - TGFI1*XX1                                CHECK IF TRACK PASSES SIDE WALL
 54200 503               DY2 = ABS(YY2) - TGFI1*XX2
 54300 504               IF ABS(DY1).LT.3.0 .OR. ABS(DY2).LT.3.0 .OR. DY1*DY2.LE.0.
 54400 505               THEN
 54500 508                  ICELL1 =  1
 54600 509                  IF(YY1.GT.0) ICELL1 = 2
 54700 511                  LBINV  =  1
 54800 512                  IF((DY2-DY1)*YY1.LT.0.) LBINV =-1
 54900 514                  XREPEAT
 55000 515               CIF
 55200 516               ICELL1 =  2                                               TRACK STAYS IN ONE CELL
 55300 517               IF DY1.GT.0.
 55400 518               THEN
 55500 521                  ICELL1 =  1
 55600 522                  IF(YY1.GT.0.) ICELL1 = 3
 55700 524               CIF
 55800 525            UNTIL .TRUE.
 55900    C     PRINT 2015, ICELL1,LBINV ,DY1,DY2
 56000    C
 56200 526            IC2 = 0                                                      GET CELL # AND ROTATION MATRIX
 56300 530            CSROT2 = 0.
 56400 531            SNROT2 = 0.
 56500 532            IF JRING.NE.3
 56600 533            THEN
 56700 536               IC1 = ICELL1 + ICELL0 - 1
 56800 537               IF(IC1.LT. 1)  IC1 = IC1 + 24
 56900 539               IF(IC1.GT.24)  IC1 = IC1 - 24
 57000 541               IF(JRING.EQ.2) IC1 = IC1 + 24
 57200 543               CSROT1 = CSRNG1(ICELL1)                                   ROTATION MATRIX
 57300 544               SNROT1 = SNRNG1(ICELL1)
 57400    C
 57500 545               IF LBINV.NE.0
 57600 546               THEN
 57700 549                  IC2 = ICELL1 + ICELL0
 57800 550                  IF(IC2.LT. 1)  IC2 = IC2 + 24
 57900 552                  IF(IC2.GT.24)  IC2 = IC2 - 24
 58000 554                  IF(JRING.EQ.2) IC2 = IC2 + 24
 58200 556                  CSROT2 = CSRNG1(ICELL1+1)                              ROTATION MATRIX
 58300 557                  SNROT2 = SNRNG1(ICELL1+1)
 58400 558               CIF
 58500 559            ELSE
 58600 561               IC1 = ICELL1 + ICELL0*2 + 47
 58700 562               IF(IC1.LT.49)  IC1 = IC1 + 48
 58800 564               IF(IC1.GT.96)  IC1 = IC1 - 48
 59000 566               CSROT1 = CSRNG3(ICELL1)                                   ROTATION MATRIX
 59100 567               SNROT1 = SNRNG3(ICELL1)
 59200    C
 59300 568               IF LBINV.NE.0
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE 11
0CARD TARGET
  NO  STM.NO
 
 59400 569               THEN
 59500 572                  IC2 = ICELL1 + ICELL0*2 + 48
 59600 573                  IF(IC2.LT.49)  IC2 = IC2 + 48
 59700 575                  IF(IC2.GT.96)  IC2 = IC2 - 48
 59900 577                  CSROT2 = CSRNG3(ICELL1+1)                              ROTATION MATRIX
 60000 578                  SNROT2 = SNRNG3(ICELL1+1)
 60100 579               CIF
 60200 580            CIF
 60300    C
 60500 581            IF LBINV.LT.0                                                REVERSE ORDER OF CELLS IF NECESSAIRY
 60600 582            THEN
 60700 585               IZW    = IC2
 60800 586               IC2    = IC1
 60900 587               IC1    = IZW
 61000 588               ZWZ    = CSROT2
 61100 589               CSROT2 = CSROT1
 61200 590               CSROT1 = ZWZ
 61300 591               ZWZ    = SNROT2
 61400 592               SNROT2 = SNROT1
 61500 593               SNROT1 = ZWZ
 61600 594            CIF
 61700    C
 61800    C     PRINT 2015, IC1,IC2,CSROT1,SNROT1,CSROT2,SNROT2
 61900 595            ITRCLL(JRING*2-1) = IC1
 62000 596            ITRCLL(JRING*2  ) = IC2
 62100 597            CSRCLL(JRING*2-1) = CSROT1*CSR1 + SNROT1*SNR1
 62200 598            SNRCLL(JRING*2-1) =-SNROT1*CSR1 + CSROT1*SNR1
 62300 599            CSRCLL(JRING*2  ) = CSROT2*CSR1 + SNROT2*SNR1
 62400 600            SNRCLL(JRING*2  ) =-SNROT2*CSR1 + CSROT2*SNR1
 62500 601         CWHILE
 62600    C     PRINT 2016, ITRCLL,CSRCLL,SNRCLL
 62700 603      CPROC
 62800    C
 62900                                                                             *************************
 63000                                                                             *      F E T C H        *
 63200    C                                                                        *************************
 63300    C
 63500 605      PROC FETCH                                                         FETCH HITS IN CELL
 63600    C
 63800 606         R0 = FSENSW(JRING)                                              LOAD RADIUS AND WIRE SPACING
 63900 607         DR = RINCR (JRING)
 64000    C
 64200 608         XR1  = DR*7.5 + R0                                              ANGLE OF TRACK IN RING
 64300 609         TGB  = PAR1*XR1 * 2. + PAR2
 64400 610         XX   = 1. / SQRT(TGB**2+1.)
 64500 611         YY   = XX * TGB
 64700 612         CSB  = XX*CSROT - YY*SNROT                                      ROTATE
 64800 613         SNB  = XX*SNROT + YY*CSROT
 64900 614         TGB  = SNB/CSB
 65000    C
 65100    C
 65300 615         DSBIN1 = DRIVEL(JCELL,1)                                        SET DRIFT SPACE BIN
 65400 616         DS0 = 0.
 65500 617         IF(HRUN.LE.100) DS0 = DSBIN1*.5
 65600 619         DRISN  = SINDRI(JCELL,1)
 65700 620         DRICS  = COSDRI(JCELL,1)
 65800 621         DRISNF = DRISN * .05
 65900 622         DRITG  = DRISN/DRICS
 66100 623         TANBET = (DRITG - TGB) / (TGB*DRITG + 1.)                       ANGLE(TRACK,DRIFT DIRECT.)
 66200    C
 66400 624         FOR I1=1,NCOAR                                                  SET ANGULAR CORRECTION
 66500 625            IDX = I1
 66600 626            IF(TANBET.LT.TGCOAR(IDX)) XFOR
 66700 628         CFOR
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE 12
0CARD TARGET
  NO  STM.NO
 
 66800 630         KRNG = JRING
 66900 631         IF(KRNG.EQ.3 .AND. AND(JCELL,1).EQ.0) KRNG = 4
 67000 633         IBIN = (KRNG-1)*NCOAR  + IDX
 67100 634         T0CORR = (TANBET-TGCOAR(IDX)) * SLCOAR(IBIN) + T0COAR(IBIN)
 67200    C
 67400 635         IPJCOR = ICALIB(5) + JCELL                                      CORRECTION CONSTANTS FOR JCELL
 67500 636         CCST01 = ACALIB(IPJCOR     ) * ABS(TANBET)
 67600 637         CCST02 = ACALIB(IPJCOR+  96) * ABS(TANBET)
 67700 638         CCST11 = ACALIB(IPJCOR+ 192)
 67800 639         CCST12 = ACALIB(IPJCOR+ 288)
 67900 640         CCST21 = ACALIB(IPJCOR+ 384)
 68000 641         CCST22 = ACALIB(IPJCOR+ 480)
 68100 642         CCST51 = ACALIB(IPJCOR+ 576) * 10.
 68200 643         CCST61 = ACALIB(IPJCOR+ 768) * 10.
 68300 644         CCST81 = ACALIB(IPJCOR+1152)
 68500    C     PRINT 2002, IRING,ICELL,IP,HPHT0,XR1,CCST01,CCST02,CCST11,CCST12,  CORRECTION CONSTANTS FOR JCELL
 68600    C    ,            CCST21,CCST22
 68800 645         JHIT = 0                                                        COUNTER FOR NUMBER OF HITS FOUND
 68900 646         NHIT   = 0
 69000 647         NHGOOD = 0
 69200 648         ILAYL =-99                                                      PRESET LAST LAYER
 69400 649         IPCO = IPCO - HLDCO                                             LOOP OVER ALL HITS OF CELL
 69500 650         IP9 = HPTSEC(JCELL+1)
 69600 651         IP  = HPTSEC(JCELL  )
 69700    C     PRINT 2002, JRING,JCELL,IP,IP9,XR1,TGB,SNB,CSB,DRISN,DRICS,TANBET
 69800 652         WHILE IP.LT.IP9
 69900 654            IWIR = HDATA(IP)
 70000 658            IWIR = SHFTR(IWIR,3)
 70200 659            ILAY = LAND(IWIR,15)                                         LAYER NUMBER WITHIN RING 3
 70400 660            DS =(HDATA(IP+3)) * DSBIN1                                   DRIFT SPACE
 70500 661            DSC = DS + DS0
 70600 662            Y    = SWDEPL
 70700 663            IF(LAND(ILAY,1).NE.0) Y  =-Y
 70800 665            Y    = (7.5-ILAY)*CCST51 - CCST61 + Y
 70900 666            X    = ILAY * DR + R0
 71000 667            IF DSC.LE.DRC
 71100 668            THEN
 71200 671               IF DSC.LT.DSD2
 71300 672               THEN
 71400 675                  IF DSC.LT.DSD1
 71500 676                  THEN
 71600 679                     DSC = DSC + DDS1 + (DSC-DSD1)*DRV1
 71700 680                  ELSE
 71800 682                     DSC = DSC + DDS2 + (DSC-DSD2)*DRV2
 71900 683                  CIF
 72000 684                  IF(DSC.LT.0.1) DSC = 0.1
 72100 686               ELSE
 72300 688                  DSC = (DSC-DSD2)/(DRC-DSD2) * T0CORR + DSC             ANGULAR CORRECTION
 72400 689               CIF
 72500 690               DXR  =-DSC * SNB
 72600 691               DYR  = DSC * CSB
 72700 692               DXL  =-DXR
 72800 693               DYL  =-DYR
 72900 694            ELSE
 73000    C
 73200 696               DSC = DSC + T0CORR                                        ANGULAR CORRECTION
 73400 697               IF ILAY.LT. 3                                             EDGE WIRE FIELD DISTORTION
 73500 698               THEN
 73600 701                  DILAY =-(ILAY- 3)**2
 73700 702                  DSCL  = (DILAY*CCST11 + 1.) * DSC * (1. - CCST81)
 73800 703                  DSCR  = (DILAY*CCST12 + 1.) * DSC * (1. + CCST81)
 73900 704               ELSE
 74000 706                  IF ILAY.GT.12
 74100 707                  THEN
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE 13
0CARD TARGET
  NO  STM.NO
 
 74200 710                     DILAY =-(ILAY-12)**2
 74300 711                     DSCL  = (DILAY*CCST21 + 1.) * DSC * (1. - CCST81)
 74400 712                     DSCR  = (DILAY*CCST22 + 1.) * DSC * (1. + CCST81)
 74500 713                  ELSE
 74600 715                     DSCL = DSC * (1. - CCST81)
 74700 716                     DSCR = DSC * (1. + CCST81)
 74800 717                  CIF
 74900 718               CIF
 75000    C
 75200 719               IF DSC.GT.ABERR(7)                                        FIELD DISTORTIONS AT LARGE DRIFT TIMES
 75300 720               THEN
 75400 723                  DWIR  = ILAY - 7.5
 75500 724                  DWIRC = DSC*DRISNF
 75600 725                  DWIRL = DWIR + DWIRC
 75700 726                  DWIRR = DWIR - DWIRC
 75800 727                  DSCL  = (DSCL-ABERR(7))*DWIRL*CCST01 + DSCL
 75900 728                  DSCR  =-(DSCR-ABERR(7))*DWIRR*CCST02 + DSCR
 76000 729               CIF
 76100 730               DXR  =-(DSCR-DRC)*DRISN - DRC*SNB
 76200 731               DYR  = (DSCR-DRC)*DRICS + DRC*CSB
 76300 732               DXL  = (DSCL-DRC)*DRISN + DRC*SNB
 76400 733               DYL  =-(DSCL-DRC)*DRICS - DRC*CSB
 76500 734            CIF
 76600 735            XL   = DXL + X
 76700 736            YL   = DYL + Y
 76800 737            XXL  = XL*CSROT + YL*SNROT
 76900 738            YYL  =-XL*SNROT + YL*CSROT
 77000 739            FL   = (PAR1*XXL + PAR2)*XXL + PAR3
 77100 740            DFL  = FL - YYL
 77200 741            XR   = DXR + X
 77300 742            YR   = DYR + Y
 77400 743            XXR  = XR*CSROT + YR*SNROT
 77500 744            YYR  =-XR*SNROT + YR*CSROT
 77600 745            FR   = (PAR1*XXR + PAR2)*XXR + PAR3
 77700 746            DFR  = YYR - FR
 77900    C     PRINT 2010, ILAY,DS,DSC,DSCL,DSCR,XL,XR,X,Y,DXL,DXR,DYL,DYR        SET ARRAY
 78000    C
 78200 747            NLRSOL = 1                                                   CHECK IF LEFT + RIGHT SOLUTION POSSIBLE
 78300 748            IF(DSC.LT.2.0 .AND. DSC.NE.0 .AND. JCELL.NE.ICELL) NLRSOL = 2
 78400    C
 78600 750            ILRSOL = 0                                                   LOOP OVER LEFT +/OR RIGHT SOLUTION
 78700 751            REPEAT
 78800 752               ILRSOL = ILRSOL + 1
 78900    C
 79100 753               IF NLRSOL.EQ.1 .AND. ABS(DFL).LT.ABS(DFR) .OR.            SELECT SIDE
 79200         ?            NLRSOL.EQ.2 .AND. ILRSOL.EQ.1
 79300 754               THEN
 79500 757                  LBSIDE =-1                                             LEFT SIDE
 79600 758                  XX  = XXL
 79700 759                  YY  = YYL
 79800 760                  DF  = DFL
 79900 761               ELSE
 80100 763                  LBSIDE = 1                                             RIGHT SIDE
 80200 764                  XX  = XXR
 80300 765                  YY  = YYR
 80400 766                  DF  = DFR
 80500 767               CIF
 80600    C
 80800 768               LBGOOD = 0                                                HIT QUALITY:
 80900 769               IF(ABS(DF).GT.2.0) LBGOOD = 1
 81000 771               IF(ABS(DF).GT.5.0) LBGOOD = 8
 81100 773               IF(DF.LE.-10.0) LBGOOD = 4
 81200 775               IF(DF.GT.-10.0 .AND. DF.LT.-5.0) LBGOOD = 2
 81400 777               IF ILAY.NE.ILAYL .OR. LBGDL.LE.1.AND.LBGOOD.LE.1          NEW LAYER?
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE 14
0CARD TARGET
  NO  STM.NO
 
 81500 778               THEN
 81600 781                  LBREG = 1
 81800 782                  JHIT = JHIT + 1                                        INCREASE HIT COUNTER
 81900 783                  IPCO = IPCO + HLDCO
 82000 784               ELSE
 82200 786                  LBREG = 0                                              2 HITS IN SAME LAYER, SELECT CLOSEST
 82300 787                  IF(LBGOOD.LT.IWRK(IPCO+7)) LBREG = 1
 82400 789                  IF(LBGOOD.GE.4 .AND. ABS(DF).LT.ABS(WRK(IPCO+13))) LBREG = 1
 82500 791               CIF
 82700 792               IF LBREG.NE.0                                             REGISTER NEW HIT?
 82800 793               THEN
 83000 796                  IF IPCO.GT.IPCOMX                                      STOP IF > 100 HITS
 83100 797                  THEN
 83200 800                     LBHTMX = 1
 83300 801                     XWHILE
 83400 802                  CIF
 83500
 83600 803                  NHIT   = NHIT   + 1
 83700 804                  IF(LBGOOD.LE.1) NHGOOD = NHGOOD + 1
 83800 806                  IWRK(IPCO   ) = ILAY
 83900 807                  IWRK(IPCO+ 1) = IP
 84000 808                  IWRK(IPCO+ 2) = LBSIDE
 84100 809                  WRK (IPCO+ 3) = XX
 84200 810                  WRK (IPCO+ 4) = YY
 84300 811                  WRK (IPCO+ 5) = 0.
 84400 812                  WRK (IPCO+ 6) = 0.
 84500 813                  IWRK(IPCO+ 7) = LBGOOD
 84600 814                  WRK (IPCO+ 8) = DSC
 84700 815                  IWRK(IPCO+ 9) = JCELL
 84800 816                  IWRK(IPCO+10) = LBGOOD
 84900 817                  WRK (IPCO+11) = TANBET
 85000 818                  IWRK(IPCO+12) = JRING
 85100 819                  WRK (IPCO+13) = DF
 85200 820                  ILAYL = ILAY
 85300 821                  LBGDL = LBGOOD
 85400 822               CIF
 85500    C
 85600 823            UNTIL ILRSOL.GE.NLRSOL
 85700    C
 85800 824            IP = IP + 4
 85900 828         CWHILE
 86000    C
 86200 830         IF LBHTMX.EQ.0                                                  CHECK IF <100 HITS
 86300 831         THEN
 86500 834            IPCO = IPCO + HLDCO                                          SET IPCO TO 1. FREE LOCATION
 86600    C
 86800 835            IF NHIT.LE.2                                                 SET LABEL FOR DEAD CELL
 86900 836            THEN
 87000 839               NRUN = HRUN
 87100 840               IF DEADCL(JCELL,NRUN)
 87200 841               THEN
 87300 844                  LBCELL = LOR(LBCELL,MKDDCL(JRING))
 87400 845                  JHIT = 16
 87500 846                  NHIT = 16
 87600    C     PRINT 2019, JCELL,JRING,NRUN,LBCELL
 87700 847               CIF
 87800 848            CIF
 87900    C
 88000 849         CIF
 88100 850      CPROC
 88200    C
 88300                                                                             *************************
 88400                                                                             *      F I T B N K      *
 88600    C                                                                        *************************
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE 15
0CARD TARGET
  NO  STM.NO
 
 88700    C
 88900 852      PROC FITBNK                                                        SET UP FIT-BANK
 89000    C
 89200 853         XST = 10000.                                                    START + END POINTS
 89300 854         XEN =     0.
 89400 855         FOR IPCO = HPCO0,HPCO9,HLDCO
 89500 856            IF IWRK(IPCO+7).EQ.0
 89600 857            THEN
 89700 860               X = WRK(IPCO+3)
 89800 861               IF(X.GT.XEN) XEN = X
 89900 863               IF(X.LT.XST) XST = X
 90000 865            CIF
 90100 866         CFOR
 90200 868         YST = (PAR1*XST + PAR2)*XST + PAR3
 90300 869         YEN = (PAR1*XEN + PAR2)*XEN + PAR3
 90500 870         TGST = PAR1*XST*2 + PAR2                                        DIRECTION AT START + END POINT
 90600 871         DXST = 1./SQRT(TGST**2+1.)
 90700 872         DYST = DXST * TGST
 90800 873         TGEN = PAR1*XEN*2 + PAR2
 90900 874         DXEN = 1./SQRT(TGEN**2+1.)
 91000 875         DYEN = DXEN * TGEN
 91200 876         XMIN = -PAR2*.5 / PAR1                                          MIN. OF PARABOLA
 91300 877         YMIN = (PAR1*XMIN + PAR2)*XMIN + PAR3
 91500    C     CURV =-PAR1 * 2.                                                   CURVATURE
 91600 878         CVZW = TGST**2+1.
 91700 879         CVST =-PAR1 * 2 / (SQRT(CVZW)*CVZW)
 91800    C
 91900    C     PRINT 2014, XST,YST,DXST,DYST,TGST,XEN,YEN,DXEN,DYEN,TGEN,CURV,
 92000    C    ,            XMIN,YMIN
 92100    C
 92300 880         JCELLD = ICELL                                                  DIRECTION FOR ROTATION
 92400 881         IF(ICELL.GT.24) JCELLD = ICELL - 24
 92500 883         IF(ICELL.GT.48) JCELLD = ICELL - 48
 92600 885         IF IRING.NE.3
 92700 886         THEN
 92800 889            DXWR  = DIRWR1(JCELLD,1)
 92900 890            DYWR  = DIRWR1(JCELLD,2)
 93000 891         ELSE
 93100 893            DXWR  = DIRWR3(JCELLD,1)
 93200 894            DYWR  = DIRWR3(JCELLD,2)
 93300 895         CIF
 93400    C
 93600 896         XX = DXWR*CSROT0 - DYWR*SNROT0                                  ROTATION INTO CELL SYSTEM
 93700 897         YY = DXWR*SNROT0 + DYWR*CSROT0
 93800 898         UN = SQRT(XX**2 + YY**2)
 93900    C
 94000    C     PRINT 2012,ICELL,JCELLD,DXWR,DYWR,CSROT0,SNROT0,XX,YY,UN
 94100 899         CSROT = XX
 94200 900         SNROT = YY
 94300    C
 94500 901         HPTR0 = HPFREE                                                  FILL FIT-BANK
 94600 902         IP    = HPTR0 - 1
 94700 903         IWRK(IP+ 1) = 0
 94800 904         IWRK(IP+ 2) = 16
 94900 905         IWRK(IP+ 3) = 0
 95000 906         IWRK(IP+ 4) = INDPAR + 1
 95100 907         WRK (IP+ 5) = XST *CSROT - YST *SNROT
 95200 908         WRK (IP+ 6) = XST *SNROT + YST *CSROT
 95300 909         WRK (IP+ 7) = SQRT(WRK(IP+ 5)**2 + WRK(IP+ 6)**2)
 95400 910         WRK (IP+ 8) = DXST*CSROT - DYST*SNROT
 95500 911         WRK (IP+ 9) = DXST*SNROT + DYST*CSROT
 95600 912         WRK (IP+10) = 1.
 95700 913         IWRK(IP+11) = 0
 95800 914         WRK (IP+12) = XEN *CSROT - YEN *SNROT
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE 16
0CARD TARGET
  NO  STM.NO
 
 95900 915         WRK (IP+13) = XEN *SNROT + YEN *CSROT
 96000 916         WRK (IP+14) = SQRT(WRK(IP+12)**2 + WRK(IP+13)**2)
 96100 917         WRK (IP+15) = DXEN*CSROT - DYEN*SNROT
 96200 918         WRK (IP+16) = DXEN*SNROT + DYEN*CSROT
 96300 919         WRK (IP+17) = 1.
 96400 920         IWRK(IP+18) = 2
 96500 921         WRK (IP+19) = ATAN2(SNROT,CSROT)
 96600 922         WRK (IP+20) = XMIN*CSROT - YMIN*SNROT
 96700 923         WRK (IP+21) = XMIN*SNROT + YMIN*CSROT
 96800 924         WRK (IP+22) = PAR1
 96900 925         WRK (IP+23) = SQRT(SIG)
 97000 926         IWRK(IP+24) = S0 + .001
 97100 927         WRK (IP+25) = CVST
 97200 928         WRK (IP+26) = 0.
 97300 929         WRK (IP+27) = CVST
 97400 930         WRK (IP+28) = CVST
 97500 931         I0 = IP+ 1
 97600 932         I9 = IP+28
 97700    C     PRINT 2904,(WRK(I1),I1=I0,I9)
 97800 933      CPROC
 97900    C
 98000    C
 98100                                                                             *************************
 98200                                                                             *      L A B E L        *
 98400    C                                                                        *************************
 98500    C
 98700 935      PROC LABEL                                                         LABEL USED HITS
 98800    C
 99000 936         IWL = -999                                                      PRESET LAST HIT POINTER
 99100 937         NHITLB = 0
 99200 938         FOR IP = HPCO0,HPCO9,HLDCO
 99300 939            IW0 = IWRK(IP)
 99400 940            X   = WRK(IP+3)
 99500 941            Y   = WRK(IP+4)
 99600 942            F   = (PAR1*X + PAR2)*X + PAR3
 99700 943            DF  = F - Y
 99900 944            IF ABS(DF).LT.ALBLM1                                         SELECT CLOSEST HIT
 00000 945            THEN
 00100 948               LBGOOD = 0
 00200 949               NHITLB = NHITLB + 1
 00300 950            ELSE
 00400 952               LBGOOD = 4
 00500 953               IF(ABS(DF).LT.ALBLM2) LBGOOD = 1
 00600 955            CIF
 00700 956            IWRK(IP+ 7) = LBGOOD
 00800 957            WRK (IP+13) = DF
 00900    C
 01100 958            IF IWL.EQ.IW0                                                CHECK IF 2 HITS FROM SAME WIRE
 01200 959            THEN
 01400 962               IF ABS(DFL).LT.ABS(DF)                                    SELECT CLOSEST HIT
 01500 963               THEN
 01600 966                  IF(LBGOOD.EQ.0) NHITLB = NHITLB - 1
 01700 968                  IWRK(IP +7) = 16
 01800 969               ELSE
 01900 971                  IF(IWRK(IPL+7).EQ.0) NHITLB = NHITLB - 1
 02000 973                  IWRK(IPL+7) = 16
 02100 974               CIF
 02200 975            CIF
 02400 976            IWL = IW0                                                    STORE LAST POINTERS + DF
 02500 977            IPL = IP
 02600 978            DFL = DF
 02700 979         CFOR
 02800    C
 02900 981      CPROC
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE 17
0CARD TARGET
  NO  STM.NO
 
 03000    C
 03100    C
 03200                                                                             *************************
 03300                                                                             *      I N I T          *
 03500    C                                                                        *************************
 03600    C
 03800 983      PROC INIT                                                          INITIALIZE CONSTANTS
 03900    C
 04000 984         DFI0 = 3.1415927 / 12.
 04100 985         DFI1 = DFI0 * .5
 04200 986         DFI3 = DFI1 * .5
 04300 987         DFI4 = DFI3 + DFI1
 04400 988         SNFI0 = SIN(DFI0)
 04500 989         CSFI0 = COS(DFI0)
 04600 990         TGFI0 = SNFI0/CSFI0
 04700 991         SNFI1 = SIN(DFI1)
 04800 992         CSFI1 = COS(DFI1)
 04900 993         TGFI1 = SNFI1/CSFI1
 05000 994         SNFI3 = SIN(DFI3)
 05100 995         CSFI3 = COS(DFI3)
 05200 996         TGFI3 = SNFI3/CSFI3
 05300 997         SNFI4 = SIN(DFI4)
 05400 998         CSFI4 = COS(DFI4)
 05500    C
 05700 999         CSRNG1(1) = CSFI0                                               ROTATION MATRICES FOR CELLS
 058001000         CSRNG1(2) = 1.
 059001001         CSRNG1(3) = CSFI0
 060001002         SNRNG1(1) =-SNFI0
 061001003         SNRNG1(2) = 0.
 062001004         SNRNG1(3) = SNFI0
 063001005         CSRNG3(1) = CSFI4
 064001006         CSRNG3(2) = CSFI3
 065001007         CSRNG3(3) = CSFI3
 066001008         CSRNG3(4) = CSFI4
 067001009         SNRNG3(1) =-SNFI4
 068001010         SNRNG3(2) =-SNFI3
 069001011         SNRNG3(3) = SNFI3
 070001012         SNRNG3(4) = SNFI4
 07100    C
 073001013         DRC = RINCR(1)*.5 * DRICOS                                      RADIUS AROUND WIRE FOR CORR. OF DRIFTSPACE
 07400    C       CONST. FOR VAR. OF DRIFT VEL.
 075001014         IQHEAD = IBLN('HEAD')
 076001015         IPHEAD = IDATA(IQHEAD)*2
 077001016         NRUN = HDATA(IPHEAD+10)
 078001017         IF NRUN.LE.100
 079001018         THEN
 080001021            DSD0   = 0.0
 081001022            DSD1   = 0.0
 082001023            DSD2   = 0.0
 082101024            DDS0   = 0.0
 082201025            DDS1   = 0.0
 082301026            DDS2   = 0.0
 083001027            DRV1   = 0.0
 084001028            DRV2   = 0.0
 085001029         ELSE
 086001031            DSD0   =-0.400
 087001032            DSD1   = 0.300
 088001033            DSD2   = 2.500
 089001034            DDS0   = 0.720
 090001035            DDS1   = 0.330
 091001036            DDS2   = 0.0
 092001037            DRV1   = (DDS0-DDS1) / (DSD0-DSD1)
 093001038            DRV2   = (DDS1-DDS2) / (DSD1-DSD2)
 094001039         CIF
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE 18
0CARD TARGET
  NO  STM.NO
 
 09500    C     PRINT 2091, DSD0,DDS0,DSD1,DDS1,DSD2,DDS2,DRV1,DRV2,DRC
 09600    C2091 FORMAT(' DSD,DDS=',3(F9.3,F7.3),F11.5,F9.5,F9.3,F8.3)
 09700    C
 099001040         I9 = NCOAR - 1                                                  INITIALIZE ANGULAR CORRECTION CONSTANTS
 100001041         FOR I1=2,I9
 101001042            IF(I1.GT.2) TGCOAR(I1   ) = TGCOAR(I1- 1) + DTGB
 102001044            SLCOAR(I1   ) = (T0COAR(I1   )-T0COAR(I1- 1)) / DTGB
 103001045            SLCOAR(I1+15) = (T0COAR(I1+15)-T0COAR(I1+14)) / DTGB
 104001046            SLCOAR(I1+30) = (T0COAR(I1+30)-T0COAR(I1+29)) / DTGB
 105001047            SLCOAR(I1+45) = (T0COAR(I1+45)-T0COAR(I1+44)) / DTGB
 106001048         CFOR
 10700    C     PRINT 2092, TGCOAR,T0COAR,SLCOAR
 10800    C2092 FORMAT('0ANG.CORR.:',15F8.3,/,(11X,15F8.3))
 10900    C
 110001050      CPROC
 11100    C
 112001052      END
0END OF SEGMENT
0  OPTIONS IN EFFECT - LINECOUNT=64,LINEWIDTH=131,  SOURCE,  FORTRAN  NUMBERING
0   0 ERRORS           0 WARNINGS        1051 TARGET STATEMENTS
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  1
0CARD TARGET
  NO  STM.NO
 
0END OF PROGRAM
0  OPTIONS IN EFFECT - LINECOUNT=64,LINEWIDTH=131,  SOURCE,  FORTRAN  NUMBERING
0   0 ERRORS           0 WARNINGS        1051 TARGET STATEMENTS
 00000    C   31/01/80 102191206  MEMBER NAME  TRCDCK   (PATRECSR)    SHELTRAN
 00001   2      SUBROUTINE TRCDCK
 00002    C
 00003   3      IMPLICIT INTEGER*2 (H)
 00004   4      LOGICAL TBIT
 00005    C
 00006    C     SUBROUTINE TO CHECK TRACK CANDIDATES
 00007    C     AUTHOR: P. STEFFEN(78/11/21)
 00008    C
          C----------------------------------------------
          C  MACRO CPATLM .... PATTERN RECOGNITION LIMITS
          C----------------------------------------------
         5      COMMON /CPATLM/ PATRLM(5),FLINLM(10),TRELLM(20),ZFITLM(10),BKK(20)
               *               ,XYF(20),IGFP(20),XBKK(40),IADMIN(5),YBKK(20)
         6      INTEGER IXYF(20),LMPATR(5),LMFLIN(10)
         7      INTEGER LMTREL(20),LMZFIT(10),IBKK(20)
         8      DIMENSION GFP(20),IXBKK(40),IYBKK(20)
         9      EQUIVALENCE (PATRLM(1),LMPATR(1)),(IXBKK(1),XBKK(1)),(IYBKK(1),
               *YBKK(1))   ,(FLINLM(1),LMFLIN(1)),(TRELLM(1),LMTREL(1))
               *           ,(ZFITLM(1),LMZFIT(1)),(BKK(1),IBKK(1))
               *           ,(XYF(1),IXYF(1)),(GFP(1),IGFP(1)),(IADMIN(1),IMCERT)
               *           ,(IYBKK(20),IPPASS),(IADMIN(2),IPFAST)
          C----------- END OF MACRO CPATLM --------------
 00010    C
          C----------------------------------------------
          C  MACRO CWORKPR .... PATTERN RECOGNITION CWORK
          C----------------------------------------------
        10      COMMON /CWORK/ HPLAST,HPFREE,HPWRK(30),ADWRK(600),
               ,               HPRO,HNTR,HNTCEL(98),IPCL(200),NRHT(200),
               ,               NWR1(200),DS1(200),SL1(200),
               ,               NWR2(200),DS2(200),SL2(200),
               ,               LBL(200),NTREL(200),ICRO(200),
               ,               NTR,HNREL(100),HISTR(9,100),HRES(168),
               ,               NTRLM,RLMTR(3,5),
               ,               WRK(7000)
        11      DIMENSION TRKAR(200,11),ITRKAR(200,11),
               ,                         LMRTR(3,5)
        12      EQUIVALENCE (IPCL(1),TRKAR(1,1),ITRKAR(1,1))
        13      EQUIVALENCE (LMRTR(1,1),RLMTR(1,1))
        14      DIMENSION IWRK(7000),HWRK(14000),IDWRK(600),HDWRK(1200)
        15      EQUIVALENCE (IWRK(1),WRK(1),HWRK(1))
        16      EQUIVALENCE (IDWRK(1),ADWRK(1),HDWRK(1))
          C---------- END OF MACRO CWORKPR --------------
 00012  17      COMMON /CWORK/ DWORK(1000)
 00100    C-------------------------------------------------------
 00200    C  MACRO CWORKEQ .... PATTERN RECOGNITION CWORK POINTERS
 00300    C-------------------------------------------------------
 00400  18      EQUIVALENCE
 00410    C                POINTERS FOR FXYZ HIT ARRAY .. PRIMARY L/R SOLUTION
 00500         #          (HPHT0,HPWRK( 1)),(HPHT9,HPWRK( 2)),(HLDHT,HPWRK( 3))
 00510    C                POINTERS FOR CWORK SINGLE TRACK PATR BANK
 00600         #         ,(HPTR0,HPWRK( 4)),(HPTR9,HPWRK( 5)),(HLDTR,HPWRK( 6))
 00610    C                POINTERS FOR TRACK ELEMENT HIT LABEL ARRAY
 00700         #         ,(HPHL0,HPWRK( 7)),(HPHL9,HPWRK( 8)),(HLDHL,HPWRK( 9))
 00710    C                POINTERS FOR FXYZ HIT ARRAY .. OPPOSITE L/R SOLUTION
 00800         #         ,(HPHT0A,HPWRK(10)),(HPHT9A,HPWRK(11)),(HLDHTA,HPWRK(12))
 00810    C               POINTER LIMIT ON FXYZ HIT ARRAY
 00900         #         ,(HPHTLM,HPWRK(13))
 00910    C               POINTERS FOR
 01000         #         ,(HPTE0,HPWRK(14)),(HPTE9,HPWRK(15)),(HLDTE,HPWRK(16))
 01100    C-------------- END OF MACRO CWORKEQ ------------------
 00014  19      EQUIVALENCE
 00015         ,           (ICELL ,IDWRK(1)),(NHIT  ,IDWRK(2)),(IRING ,IDWRK(3))
 00016         ,         , (IERRCD,IDWRK(4)),(NTRKEL,IDWRK(5))
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  2
0CARD TARGET
  NO  STM.NO
 
 00017    C
 00018  20      DIMENSION NTRC( 3), LHIT(3),MHIT(3)
 00019    C
 00021  21      INTEGER*2 HZW(2)                                                   I2-I4 CONVERSION:
 00022  22      EQUIVALENCE (HZW(1),IZW)
 00023    C
 00025  23      COMMON /CPTSLM/ BKTRLM(20),HXREF(200,3)                            LIMITS
 00026  24      INTEGER LMBKTR(20)
 00027  25      EQUIVALENCE (BKTRLM(1),LMBKTR(1))
 00028    C
 00029  26 2003 FORMAT(1H0,A4,I6,2(/,1X,24I4),/,1X,50I2)
 00030  27 2004 FORMAT(1H0,'BACKTR:',5X,20I6)
 00031  28 2005 FORMAT(1H ,12X,20I6)
 00032  29 2006 FORMAT(1X,4I6,I3,2F10.3,I3,2F10.3,1X,Z5,2I3,2X,3I3)
 00033    C
 00034  30      IF(HNTR.LE.0) RETURN
 00035    C
 00037  32      PERFORM PRINT                                                      MIN. # OF UNIQUE HITS OF TRCAND
 00038  35      MINHIT = 1
 00039  36      PERFORM REDUCE
 00040  39      PERFORM PRINT
 00041  42      MINHIT = 5
 00042  43      PERFORM REDUCE
 00043  46      PERFORM PRINT
 00044    C
 00045  49      RETURN
 00046    C
 00047    C
 00048  50      PROC REDUCE
 00049    C
 00051  51         FOR ITRL=1,HNTR                                                 SEARCH FOR TRELS CORRELATED WITH >1 TRCD
 00052  52            IF HXREF(ITRL,2).NE.0
 00053  53            THEN
 00054  56               NTRC(1) = HXREF(ITRL,1)
 00055  57               NTRC(2) = HXREF(ITRL,2)
 00056  58               NTRC(3) = HXREF(ITRL,3)
 00057  59               LHIT(1) = 0
 00058  60               LHIT(2) = 0
 00059  61               LHIT(3) = 0
 00060  62               MHIT(1) = 0
 00061  63               MHIT(2) = 0
 00062  64               MHIT(3) = 0
 00063    C     PRINT 2010, ITRL,NTRC
 00064    C2010 FORMAT(' COVERED TREL:',10I6)
 00066  65               ITRC = 1                                                  CHECK IF TRCD HAVE UNIQUE TREL WITH >4 HITS
 00067  66               REPEAT
 00068  67                  JTRC = NTRC(ITRC)
 00069  68                  NTRL = HNREL(JTRC)
 00071  69                  LHIT0 = 0                                              LOOP OVER ALL TRELS OF 'JTRC'
 00072  70                  MHIT0 = 0
 00073  71                  FOR JTRL=1,NTRL
 00074  72                     KTRL = HISTR(JTRL,JTRC)
 00075  73                     KTRL = IABS(KTRL)
 00076  74                     IF HXREF(KTRL,2).EQ.0
 00077  75                     THEN
 00079  78                        MHIT0 = NRHT(KTRL) + MHIT0                       COUNT HITS OF UNIQUE TRELS
 00080  79                     ELSE
 00082  81                        LHIT0 = NRHT(KTRL) + LHIT0                       COUNT HITS OF COMMON TRELS
 00083  82                     CIF
 00084  83                  CFOR
 00086  85                  IF(MHIT0.LT.MINHIT) NTRC(ITRC) =-NTRC(ITRC)            MARK TRCD WITH <4 UNIQUE HITS
 00087  87                  MHIT(ITRC) = MHIT0
 00088  88                  LHIT(ITRC) = LHIT0
 00089    C     PRINT 2011, ITRC,JTRC,NTRL,MHIT0,LHIT0,NTRC(ITRC)
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  3
0CARD TARGET
  NO  STM.NO
 
 00090    C2011 FORMAT(' UNIQUE HITS:',10I6)
 00091  89                  ITRC = ITRC + 1
 00092  90               UNTIL ITRC.GT.3 .OR. NTRC(ITRC).EQ.0
 00093    C
 00095  91               IF NTRC(1).LE.0 .AND. NTRC(2).LE.0 .AND. NTRC(3).LE.0     CHECK IF NO GOOD TRCD
 00096  95               THEN
 00098  98                  LHIT(1) = MHIT(1) + LHIT(1)                            KEEP LONGEST TRCD
 00099  99                  LHIT(2) = MHIT(2) + LHIT(2)
 00100 100                  LHIT(3) = MHIT(3) + LHIT(3)
 00101 101                  IF(MAX0(LHIT(1),LHIT(2)).LT.LHIT(3)) NTRC(3) =-NTRC(3)
 00102 103                  IF(MAX0(LHIT(1),LHIT(3)).LT.LHIT(2)) NTRC(2) =-NTRC(2)
 00103 105                  IF(MAX0(LHIT(2),LHIT(3)).LT.LHIT(1)) NTRC(1) =-NTRC(1)
 00104 107                  IF NTRC(1).LE.0 .AND. NTRC(2).LE.0 .AND. NTRC(3).LE.0
 00105 108                  THEN
 00107 111                     IF LHIT(1).GE.LHIT(2)                               2 TRCD OF EQUAL LENGTH
 00108 112                     THEN
 00109 115                        NTRC(1) =-NTRC(1)
 00110 116                     ELSE
 00111 118                        NTRC(2) =-NTRC(2)
 00112 119                     CIF
 00113 120                  CIF
 00114 121               CIF
 00115    C     PRINT 2012, TRC,LHIT,MHIT
 00116    C2012 FORMAT(' CHECK:',10I6)
 00117    C
 00119 122               ITRC = 1                                                  DELETE BAD TRCD
 00120 123               REPEAT
 00121 124                  JTRC = NTRC(ITRC)
 00123 125                  IF JTRC.LT.0                                           CHECK IF BAD TRCD
 00124 126                  THEN
 00125 129                     JTRC = IABS(JTRC)
 00126 130                     NTRL = HNREL(JTRC)
 00128 131                     FOR JTRL=1,NTRL                                     LOOP OVER ALL TRELS OF 'JTRC'
 00129 132                        KTRL = HISTR(JTRL,JTRC)
 00130 133                        KTRL = IABS(KTRL)
 00132 134                        IF HXREF(KTRL,1).EQ.JTRC                         DELETE TRACK IN XREF
 00133 135                        THEN
 00134 138                           HXREF(KTRL,1) = HXREF(KTRL,2)
 00135 139                           HXREF(KTRL,2) = HXREF(KTRL,3)
 00136 140                           HXREF(KTRL,3) = 0
 00137 141                        ELSE
 00138 143                           IF HXREF(KTRL,2).EQ.JTRC
 00139 144                           THEN
 00140 147                              HXREF(KTRL,2) = HXREF(KTRL,3)
 00141 148                              HXREF(KTRL,3) = 0
 00142 149                           ELSE
 00143 151                              IF(HXREF(KTRL,3).EQ.JTRC) HXREF(KTRL,3)=0
 00144 153                           CIF
 00145 154                        CIF
 00146 155                     CFOR
 00147    C
 00149 157                     NBYTE = (NTR-JTRC)*2                                REMOVE DELETED TRACK
 00150 158                     IF(NBYTE.GT.0)
 00151         ?               CALL MVC(HNREL(JTRC),0,HNREL(JTRC+1),0,NBYTE)
 00152 160                     NBYTE = NBYTE*9
 00153 161                     IF(NBYTE.GT.0)
 00154         ?               CALL MVCL(HISTR(1,JTRC),0,HISTR(1,JTRC+1),0,NBYTE)
 00155 163                     HNREL(NTR) = 0
 00156 164                     CALL SETS(HISTR(1,NTR),0,18,0)
 00157 165                     NTR = NTR - 1
 00158 166                     FOR I=1,HNTR
 00159 167                        IF(HXREF(I,1).GT.JTRC) HXREF(I,1) = HXREF(I,1) - 1
 00160 169                        IF(HXREF(I,2).GT.JTRC) HXREF(I,2) = HXREF(I,2) - 1
 00161 171                        IF(HXREF(I,3).GT.JTRC) HXREF(I,3) = HXREF(I,3) - 1
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  4
0CARD TARGET
  NO  STM.NO
 
 00162 173                     CFOR
 00163    C
 00164 175                  CIF
 00165 176                  ITRC = ITRC + 1
 00166 177               UNTIL ITRC.GT.3 .OR. NTRC(ITRC).EQ.0
 00167 178            CIF
 00168 182         CFOR
 00169    C
 00170    C       PRINT 2003, HPRO,HNTR,HNTCEL
 00171    C       IP0 = HPTE0
 00172    C       FOR I1=1,HNTR
 00173    C       PRINT 2006, IP0,I1,(TRKAR(I1,I2),I2=1,11),
 00174    C    ,              HXREF(I1,1),HXREF(I1,2),HXREF(I1,3)
 00175    C          IP0 = IP0 + HLDTE
 00176    C       CFOR
 00177    C         PRINT 2004,NTR, (HNREL(I1),I1=1,NTR)
 00178    C         FOR ITR=1,NTR
 00179    C           NELM = HNREL(ITR)
 00180    C           PRINT 2005, (HISTR(I1,ITR),I1=1,NELM)
 00181    C         CFOR
 00182    C
 00183 184      CPROC
 00184    C
 00185 186      PROC PRINT
 00186 187         PRINT 2003, HPRO,HNTR,HNTCEL
 00187 188         IP0 = HPTE0
 00188 189         FOR I1=1,HNTR
 00189 190            PRINT 2006, IP0,I1,(TRKAR(I1,I2),I2=1,11),
 00190         ,      HXREF(I1,1),HXREF(I1,2),HXREF(I1,3)
 00191 191            IP0 = IP0 + HLDTE
 00192 192         CFOR
 00193 194         PRINT 2004,NTR, (HNREL(I1),I1=1,NTR)
 00194 195         FOR ITR=1,NTR
 00195 196            NELM = HNREL(ITR)
 00196 197            PRINT 2005, (HISTR(I1,ITR),I1=1,NELM)
 00197 198         CFOR
 00198 200      CPROC
 00199    C
 00200 202      END
0END OF SEGMENT
0  OPTIONS IN EFFECT - LINECOUNT=64,LINEWIDTH=131,  SOURCE,  FORTRAN  NUMBERING
0   0 ERRORS           0 WARNINGS         201 TARGET STATEMENTS
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  1
0CARD TARGET
  NO  STM.NO
 
0END OF PROGRAM
0  OPTIONS IN EFFECT - LINECOUNT=64,LINEWIDTH=131,  SOURCE,  FORTRAN  NUMBERING
0   0 ERRORS           0 WARNINGS         201 TARGET STATEMENTS
 00000    C   13/11/80 102191206  MEMBER NAME  TRHTCK   (PATRECSR)    SHELTRAN
 00001   2      SUBROUTINE TRHTCK(IPPATR,IPJHTL)
 00002    C
 00003    C     CHECK HITS OF TRACKS + REMOVE COVERED TRACKS
 00004    C
 00005    C     AUTHOR: P. STEFFEN (80/08/18)
 00006    C
 00007   3      IMPLICIT INTEGER*2 (H)
 00008    C
          C----------------------------------------------------------------------
          C             MACRO CDATA .... BOS COMMON.
          C
          C             THIS MACRO ONLY DEFINES THE IDATA/HDATA/ADATA NAMES.
          C             THE ACTUAL SIZE OF /BCS/ IS FIXED ON MACRO CBCSMX
          C             OR BY OTHER MEANS. A DEFAULT SIZE OF 40000 IS GIVEN HERE.
          C
          C----------------------------------------------------------------------
          C
         4      COMMON /BCS/ IDATA(40000)
         5      DIMENSION HDATA(80000),ADATA(40000),IPNT(50)
         6      EQUIVALENCE (HDATA(1),IDATA(1),ADATA(1)),(IPNT(1),IDATA(55))
         7      EQUIVALENCE (NWORD,IPNT(50))
          C
          C------------------------ END OF MACRO CDATA --------------------------
          C----------------------------------------------------------------------
          C           MACRO CCYCP .... JET CHAMBER HIT POINTERS (PATREC)
          C----------------------------------------------------------------------
         8      INTEGER*4 HPTSEC
         9      COMMON/CCYCP/HPTSEC(98)
 00016    C     HPTSEC(I) = CDATA POINTER TO 1ST I*2 WORD FOR 1ST HIT OF CELL I
          C------------------------ END OF MACRO CCYCP --------------------------
 00011    C
 00100    C-----------------------------------------------------------------------
 00200    C                            MACRO CJDRCH .... JET CHAMBER CONSTANTS.
 00300    C-----------------------------------------------------------------------
 00310    C
 00400  10      COMMON / CJDRCH / RDEC(4),PSIIN(3),RINCR(3),FIRSTW(3),FSENSW(3),
 00500         +                  RDEPTH,SWDEPL,YSUSPN,TIMDEL(2,3),ZMAX,ZOFFS,
 00510         +                  ZRESOL,ZNORM,ZAL,ZSCAL,DRIDEV,DRICOS,DRISIN,
 00600         +                  PEDES,TZERO(3),DRIROT(96,2),SINDRI(96,2),
 00701         +                  COSDRI(96,2),DRIVEL(96,2),T0FIX(3),
 00800         +                  ABERR(8), DUMJDC(20)
 00900    C
 01100    C      BLOCK DATA SET TO MC VALUES, KALIBR WILL SET REAL DATA VALUES
 01210    C--->  A CHANGE OF THIS COMMON MUST BE DONE SIMULTANEOUSLY WITH  <----
 01220    C--->  A CHANGE OF THE BLOCK DATA                                <----
 01230    C
 01300    C--------------------------- END OF MACRO CJDRCH -----------------------
 01400    C
 00013    C
          C----------------------------------------------
          C  MACRO CWORKPR .... PATTERN RECOGNITION CWORK
          C----------------------------------------------
        11      COMMON /CWORK/ HPLAST,HPFREE,HPWRK(30),ADWRK(600),
               ,               HPRO,HNTR,HNTCEL(98),IPCL(200),NRHT(200),
               ,               NWR1(200),DS1(200),SL1(200),
               ,               NWR2(200),DS2(200),SL2(200),
               ,               LBL(200),NTREL(200),ICRO(200),
               ,               NTR,HNREL(100),HISTR(9,100),HRES(168),
               ,               NTRLM,RLMTR(3,5),
               ,               WRK(7000)
        12      DIMENSION TRKAR(200,11),ITRKAR(200,11),
               ,                         LMRTR(3,5)
        13      EQUIVALENCE (IPCL(1),TRKAR(1,1),ITRKAR(1,1))
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  2
0CARD TARGET
  NO  STM.NO
 
        14      EQUIVALENCE (LMRTR(1,1),RLMTR(1,1))
        15      DIMENSION IWRK(7000),HWRK(14000),IDWRK(600),HDWRK(1200)
        16      EQUIVALENCE (IWRK(1),WRK(1),HWRK(1))
        17      EQUIVALENCE (IDWRK(1),ADWRK(1),HDWRK(1))
          C---------- END OF MACRO CWORKPR --------------
 00100    C-------------------------------------------------------
 00200    C  MACRO CWORKEQ .... PATTERN RECOGNITION CWORK POINTERS
 00300    C-------------------------------------------------------
 00400  18      EQUIVALENCE
 00410    C                POINTERS FOR FXYZ HIT ARRAY .. PRIMARY L/R SOLUTION
 00500         #          (HPHT0,HPWRK( 1)),(HPHT9,HPWRK( 2)),(HLDHT,HPWRK( 3))
 00510    C                POINTERS FOR CWORK SINGLE TRACK PATR BANK
 00600         #         ,(HPTR0,HPWRK( 4)),(HPTR9,HPWRK( 5)),(HLDTR,HPWRK( 6))
 00610    C                POINTERS FOR TRACK ELEMENT HIT LABEL ARRAY
 00700         #         ,(HPHL0,HPWRK( 7)),(HPHL9,HPWRK( 8)),(HLDHL,HPWRK( 9))
 00710    C                POINTERS FOR FXYZ HIT ARRAY .. OPPOSITE L/R SOLUTION
 00800         #         ,(HPHT0A,HPWRK(10)),(HPHT9A,HPWRK(11)),(HLDHTA,HPWRK(12))
 00810    C               POINTER LIMIT ON FXYZ HIT ARRAY
 00900         #         ,(HPHTLM,HPWRK(13))
 00910    C               POINTERS FOR
 01000         #         ,(HPTE0,HPWRK(14)),(HPTE9,HPWRK(15)),(HLDTE,HPWRK(16))
 01100    C-------------- END OF MACRO CWORKEQ ------------------
 00016    C
 00018  19      DIMENSION NCNT1(127),NCNT2(127)                                    COUNTER FOR HITS ON TRACK
 00019    C
 00020    C2001 FORMAT(1H0,40I3,/,1X,40I3,/,1X,40I3,/,1X,7I3)
 00021    C2002 FORMAT(' TRHTCK, "JHTL":',6I8,/,(12X,20(2X,Z4)))
 00022    C2004 FORMAT(' ELIMTR:',20I6)
 00023    C2005 FORMAT(' ELIMTR:',1X,20I6)
 00024    C
 00026  20      NTR1   = IDATA(IPPATR+ 2)                                          NO CHECK IF NO TRACKS
 00027  21      IF(NTR1.LE.0) RETURN
 00028  23      LPATR = IDATA(IPPATR)
 00029    C     CALL PRPATR
 00030    C
 00031  24      IPHL0 = IPJHTL*2 + 3
 00032  25      ILDHL = IDATA(IPJHTL)*2 - 2
 00033  26      IPHL9 = ILDHL + IPHL0 - 1
 00034  27      I0 = IPHL0
 00035  28      I9 = IPHL9
 00036  29      I1 = IDATA(IBLN('PATR'))
 00037  30      I2 = IDATA(IBLN('JHTL'))
 00038    C     PRINT 2002, I0,I9,IPPATR,IPJHTL,I1,I2,(HDATA(I1),I1=I0,I9)
 00039    C
 00041  31      CALL SETSL(NCNT1(1),0,1016,0)                                      COUNT HITS OF TRACK
 00042  32      FOR I=IPHL0,IPHL9,2
 00043  33         IZW1  = HDATA(I  )
 00044  34         ITRK1 = LAND(SHFTR(IZW1,1),127)
 00045  35         IF ITRK1.GT.0
 00046  36         THEN
 00047  39            IZW2  = HDATA(I+1)
 00048  40            ITRK2 = LAND(SHFTR(IZW2,1),127)
 00049  41            IF ITRK2.LE.0
 00050  42            THEN
 00051    C           PRINT 2008,MKBDHT,IZW,HDATA(I),HDATA(I+1)
 00052  45               NCNT1(ITRK1) = NCNT1(ITRK1) + 1
 00053  46            ELSE
 00054  48               NCNT2(ITRK1) = NCNT2(ITRK1) + 1
 00055  49               NCNT2(ITRK2) = NCNT2(ITRK2) + 1
 00056  50            CIF
 00057  51         CIF
 00058  52      CFOR
 00059    C
 00061    C     PRINT 2001, NCNT1,NCNT2                                            ELIMINATE COVERED OR TOO SHORT TRACKS
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  3
0CARD TARGET
  NO  STM.NO
 
 00062  54      MTR = 0
 00063  55      IPTR9 = IDATA(IPPATR) + IPPATR
 00064  56      FOR ITR=1,NTR1
 00065  57         IF NCNT1(ITR).LT.5 .OR. NCNT1(ITR)+NCNT2(ITR).LT.8
 00066  58         THEN
 00067  61            PERFORM ELIMTR
 00068  64            NCNT1(ITR) =-NCNT1(ITR)
 00069  65         ELSE
 00071  67            MTR = MTR + 1                                                COUNT REMAINING TRACKS
 00072  68         CIF
 00073  69      CFOR
 00074    C
 00075    C
 00076  71      IDATA(IPPATR+2) = MTR
 00077    C
 00079  72      LENG  = IDATA(IPPATR+2)*IDATA(IPPATR+3) + IDATA(IPPATR+1)          READJUST RECORD LENGTH + # OF TRACKS
 00080  73      NDIFF = LENG - IDATA(IPPATR)
 00081  74      IF(NDIFF.NE.0) CALL BCHM(IPPATR,NDIFF,IRET)
 00082    C
 00083  76      RETURN
 00084    C
 00085    C
 00086                                                                             ***************************
 00087                                                                             *      E L I M T R        *
 00089    C                                                                        ***************************
 00091  77      PROC ELIMTR                                                        ELIMINATE TRACK ITR
 00092    C
 00094  78         JTR = MTR + 1                                                   LOOP OVER HIT LABEL ARRAY
 00095  79         ITRDIF = ITR - JTR
 00096    C       PRINT 2004, ITR,MTR,JTR,ITRDIF
 00097  80         IF NCNT1(ITR).NE.0 .OR. NCNT2(ITR).NE.0
 00098  81         THEN
 00099  84            FOR I=IPHL0,IPHL9,2
 00100  85               IZW1  = HDATA(I  )
 00101  86               ITRK1 = LAND(SHFTR(IZW1,1),127)
 00102  87               IZW2  = HDATA(I+1)
 00103  88               ITRK2 = LAND(SHFTR(IZW2,1),127)
 00104  89               IF ITRK2.EQ.JTR
 00105  90               THEN
 00106  93                  HDATA(I+1) = 0
 00107  94                  ITRK2 = 0
 00108  95                  IND1  = ITRK1 + ITRDIF
 00109  96                  NCNT1(IND1) = NCNT1(IND1) + 1
 00110  97                  NCNT2(IND1) = NCNT2(IND1) - 1
 00111    C     DATA NPREL /0/
 00112    C     NPREL = NPREL + 1
 00113    C     IF(NPREL.LE.90) PRINT 2005, ITR,JTR,ITRK1,ITRK2,IND1
 00114  98               CIF
 00115  99               IF ITRK1.EQ.JTR
 00116 100               THEN
 00117 103                  HDATA(I ) = HDATA(I+1)
 00118 104                  HDATA(I+1) = 0
 00119 105                  ITRK1 = ITRK2
 00120 106                  ITRK2 = 0
 00121 107                  IF ITRK1.GT.0
 00122 108                  THEN
 00123 111                     IND1  = ITRK1 + ITRDIF
 00124 112                     NCNT1(IND1) = NCNT1(IND1) + 1
 00125 113                     NCNT2(IND1) = NCNT2(IND1) - 1
 00126    C     NPREL = NPREL + 1
 00127    C     IF(NPREL.LE.90) PRINT 2005, ITR,JTR,ITRK1,ITRK2,IND1
 00128 114                  CIF
 00129 115               CIF
 00130    C           DECREASE TRACK # FOR HIGHER TRACK #'S
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  4
0CARD TARGET
  NO  STM.NO
 
 00131 116               IF(ITRK1.GT.JTR) HDATA(I  ) = HDATA(I  )-2
 00132 118               IF(ITRK2.GT.JTR) HDATA(I+1) = HDATA(I+1)-2
 00133 120            CFOR
 00134    C     PRINT 2002, I0,I9,IPPATR,IPJHTL,I1,I2,(HDATA(I1),I1=I0,I9)
 00135 122         CIF
 00136    C     PRINT 2001, NCNT1,NCNT2
 00137    C
 00139 123         LTRBK = IDATA(IPPATR+3)                                         ELIMINATE TRACK IN PATR-BANK
 00140 124         IPTR1 = IPPATR + IDATA(IPPATR+1) + MTR*LTRBK
 00141 125         IPTR2 = IPTR1 + LTRBK
 00142 126         NBYTE = (IPTR9 -IPTR2 + 1) * 4
 00143 127         IF NBYTE.GT.0
 00144 128         THEN
 00145 131            CALL MVCL(IDATA(IPTR1+1),0,IDATA(IPTR2+1),0,NBYTE)
 00146    C     CALL PRPATR
 00147 132            FOR IP=IPTR1,IPTR9,LTRBK
 00148 133               IDATA(IP+1) = IDATA(IP+1) - 1
 00149 134            CFOR
 00150 136         CIF
 00151 137         IPTR9 = IPTR9 - LTRBK
 00152    C     CALL PRPATR
 00153    C
 00154 138      CPROC
 00155    C
 00156 140      END
0END OF SEGMENT
0  OPTIONS IN EFFECT - LINECOUNT=64,LINEWIDTH=131,  SOURCE,  FORTRAN  NUMBERING
0   0 ERRORS           0 WARNINGS         139 TARGET STATEMENTS
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  1
0CARD TARGET
  NO  STM.NO
 
0END OF PROGRAM
0  OPTIONS IN EFFECT - LINECOUNT=64,LINEWIDTH=131,  SOURCE,  FORTRAN  NUMBERING
0   0 ERRORS           0 WARNINGS         139 TARGET STATEMENTS
 00000    C   12/09/79 002251728  MEMBER NAME  TRLORD9  (PATRECSR)    SHELTRAN
 00001   2      SUBROUTINE TRLORD
 00002   3      IMPLICIT INTEGER*2 (H)
          C----------------------------------------------
          C  MACRO CWORKPR .... PATTERN RECOGNITION CWORK
          C----------------------------------------------
         4      COMMON /CWORK/ HPLAST,HPFREE,HPWRK(30),ADWRK(600),
               ,               HPRO,HNTR,HNTCEL(98),IPCL(200),NRHT(200),
               ,               NWR1(200),DS1(200),SL1(200),
               ,               NWR2(200),DS2(200),SL2(200),
               ,               LBL(200),NTREL(200),ICRO(200),
               ,               NTR,HNREL(100),HISTR(9,100),HRES(168),
               ,               NTRLM,RLMTR(3,5),
               ,               WRK(7000)
         5      DIMENSION TRKAR(200,11),ITRKAR(200,11),
               ,                         LMRTR(3,5)
         6      EQUIVALENCE (IPCL(1),TRKAR(1,1),ITRKAR(1,1))
         7      EQUIVALENCE (LMRTR(1,1),RLMTR(1,1))
         8      DIMENSION IWRK(7000),HWRK(14000),IDWRK(600),HDWRK(1200)
         9      EQUIVALENCE (IWRK(1),WRK(1),HWRK(1))
        10      EQUIVALENCE (IDWRK(1),ADWRK(1),HDWRK(1))
          C---------- END OF MACRO CWORKPR --------------
 00004  11      DIMENSION HORD(9)
 00005  12      CALL SETSL(HORD(1),0,18,0)
 00006  13      IF(NTR.LE.0) RETURN
 00007  15      FOR I=1,NTR
 00008  16         NELM=HNREL(I)
 00009  17         IF NELM.GT.1
 00010  18         THEN
 00011  21            FOR IJ=1,NELM
 00012  22               ITK=HISTR(IJ,I)
 00013  23               ITK=IABS(ITK)
 00014  24               IF ITK.GT.0
 00015  25               THEN
 00016  28                  IC=IPCL(ITK)
 00017  29                  IF(IC.LE.24) IRING=1
 00018  31                  IF(IC.GT.24.AND.IC.LE.48) IRING=2
 00019  33                  IF(IC.GT.48) IRING=3
 00020  35                  IW=NWR2(ITK)
 00021  36                  ISORT=SHFTL(IRING,5)
 00022  37                  ISORT=ISORT+IW
 00023  38                  HORD(IJ)=ISORT
 00024  39               CIF
 00025  40            CFOR
 00026  42            IT=NELM-1
 00027  43            FOR I1=1,IT
 00028  44               ITMP=I1+1
 00029  45               FOR I2=ITMP,NELM
 00030  46                  IF HORD(I1).LT.HORD(I2)
 00031  47                  THEN
 00032  50                     IEMP=HORD(I1)
 00033  51                     HORD(I1)=HORD(I2)
 00034  52                     HORD(I2)=IEMP
 00035  53                     IEMP=HISTR(I1,I)
 00036  54                     HISTR(I1,I)=HISTR(I2,I)
 00037  55                     HISTR(I2,I)=IEMP
 00038  56                  CIF
 00039  57               CFOR
 00040  59            CFOR
 00041  61         CIF
 00042  62      CFOR
 00043  64      NUM=100-NTR
 00044  65      IF NUM.GT.0
 00045  66      THEN
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  2
0CARD TARGET
  NO  STM.NO
 
 00046  69         FOR I=1,NUM
 00047  70            HNREL(NTR+I)=0
 00048  71            FOR J=1,9
 00049  72               HISTR(J,NTR+I)=0
 00050  73            CFOR
 00051  75         CFOR
 00052  77      CIF
 00053  78      RETURN
 00054  79      END
0END OF SEGMENT
0  OPTIONS IN EFFECT - LINECOUNT=64,LINEWIDTH=131,  SOURCE,  FORTRAN  NUMBERING
0   0 ERRORS           0 WARNINGS          78 TARGET STATEMENTS
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  1
0CARD TARGET
  NO  STM.NO
 
0END OF PROGRAM
0  OPTIONS IN EFFECT - LINECOUNT=64,LINEWIDTH=131,  SOURCE,  FORTRAN  NUMBERING
0   0 ERRORS           0 WARNINGS          78 TARGET STATEMENTS
 00000    C   17/04/80 609102054  MEMBER NAME  ZCHECK   (PATRECSR)    SHELTRAN
 00100   2      SUBROUTINE ZCHECK(DHRLIM)
 00200   3      IMPLICIT INTEGER*2 (H)
 00300    C---
 00400    C---     AFTER COMPLETED FITS OF TRACKS IN RFI, LOOP OVER ALL TRACKS
 00500    C---     AND CHECK PROXIMITY TO REMAINING TRACKS; MARK ALL HITS WHICH
 00600    C---     ARE INSIDE A LIMIT (DHRLIM), AS BAD.
 00700    C---                                             J.OLSSON 14.09.79
 00800    C---                      LAST UPDATE    10.09.81
 00810    C---   ERROR IN CELNEI CORRECTED  10.9.1986    J.OLSSON
 00900    C---
 01000   4      LOGICAL TBIT
          C-----------------------------------------------------------------------
          C                            MACRO CGRAPH .... GRAPHICS COMMON
          C-----------------------------------------------------------------------
          C
         5      LOGICAL DSPDTL,SSTPS,PSTPS,FREEZE
          C
         6      COMMON / CGRAPH / JUSCRN,NDDINN,NDDOUT,IDATSV(11),ICREC,MAXREC,
               +                  LSTCMD,ACMD,LASTVW,ISTANV,
               +                  SXIN,SXAX,SYIN,SYAX,XMIN,XMAX,YMIN,YMAX,
               +                  DSPDTL(30),SSTPS(10),PSTPS(10),FREEZE(30),
               +                  IREADM,LABEL,LSTPS(10),IPSVAR
          C
          C------- END OF MACRO CGRAPH -------------------------------------------
          C
 01200   7      COMMON / CJCELL / NCELL(3),NWIRES(3)
 00100    C-----------------------------------------------------------------------
 00200    C                            MACRO CJDRCH .... JET CHAMBER CONSTANTS.
 00300    C-----------------------------------------------------------------------
 00310    C
 00400   8      COMMON / CJDRCH / RDEC(4),PSIIN(3),RINCR(3),FIRSTW(3),FSENSW(3),
 00500         +                  RDEPTH,SWDEPL,YSUSPN,TIMDEL(2,3),ZMAX,ZOFFS,
 00510         +                  ZRESOL,ZNORM,ZAL,ZSCAL,DRIDEV,DRICOS,DRISIN,
 00600         +                  PEDES,TZERO(3),DRIROT(96,2),SINDRI(96,2),
 00701         +                  COSDRI(96,2),DRIVEL(96,2),T0FIX(3),
 00800         +                  ABERR(8), DUMJDC(20)
 00900    C
 01100    C      BLOCK DATA SET TO MC VALUES, KALIBR WILL SET REAL DATA VALUES
 01210    C--->  A CHANGE OF THIS COMMON MUST BE DONE SIMULTANEOUSLY WITH  <----
 01220    C--->  A CHANGE OF THE BLOCK DATA                                <----
 01230    C
 01300    C--------------------------- END OF MACRO CJDRCH -----------------------
 01400    C
          C----------------------------------------------------------------------
          C             MACRO CDATA .... BOS COMMON.
          C
          C             THIS MACRO ONLY DEFINES THE IDATA/HDATA/ADATA NAMES.
          C             THE ACTUAL SIZE OF /BCS/ IS FIXED ON MACRO CBCSMX
          C             OR BY OTHER MEANS. A DEFAULT SIZE OF 40000 IS GIVEN HERE.
          C
          C----------------------------------------------------------------------
          C
         9      COMMON /BCS/ IDATA(40000)
        10      DIMENSION HDATA(80000),ADATA(40000),IPNT(50)
        11      EQUIVALENCE (HDATA(1),IDATA(1),ADATA(1)),(IPNT(1),IDATA(55))
        12      EQUIVALENCE (NWORD,IPNT(50))
          C
          C------------------------ END OF MACRO CDATA --------------------------
 01500  13      COMMON /CHEADR/ HEAD(108)
          C----------------------------------------------------------------------
          C           MACRO CDSMAX .... PATTERN RECOGNITION CONSTANTS.
          C----------------------------------------------------------------------
        14      COMMON/CDSMAX/DSMAX(16,3,2),DIRWR1(24,2),DIRWR3(48,2)
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  2
0CARD TARGET
  NO  STM.NO
 
               *             ,DHALF(16,3,2),DTWICE(16,3,2),HMCH(16,3,2)
               *             ,IBCK(9),DBCK(30),TRMATS(96,2),TRMATC(96,2)
          C------------------------ END OF MACRO CDSMAX -------------------------
 01700  15      COMMON /CEE1/ EE1(96,2)
          C----------------------------------------------
          C  MACRO CPATLM .... PATTERN RECOGNITION LIMITS
          C----------------------------------------------
        16      COMMON /CPATLM/ PATRLM(5),FLINLM(10),TRELLM(20),ZFITLM(10),BKK(20)
               *               ,XYF(20),IGFP(20),XBKK(40),IADMIN(5),YBKK(20)
        17      INTEGER IXYF(20),LMPATR(5),LMFLIN(10)
        18      INTEGER LMTREL(20),LMZFIT(10),IBKK(20)
        19      DIMENSION GFP(20),IXBKK(40),IYBKK(20)
        20      EQUIVALENCE (PATRLM(1),LMPATR(1)),(IXBKK(1),XBKK(1)),(IYBKK(1),
               *YBKK(1))   ,(FLINLM(1),LMFLIN(1)),(TRELLM(1),LMTREL(1))
               *           ,(ZFITLM(1),LMZFIT(1)),(BKK(1),IBKK(1))
               *           ,(XYF(1),IXYF(1)),(GFP(1),IGFP(1)),(IADMIN(1),IMCERT)
               *           ,(IYBKK(20),IPPASS),(IADMIN(2),IPFAST)
          C----------- END OF MACRO CPATLM --------------
          C----------------------------------------------
          C  MACRO CWORKPR .... PATTERN RECOGNITION CWORK
          C----------------------------------------------
        21      COMMON /CWORK/ HPLAST,HPFREE,HPWRK(30),ADWRK(600),
               ,               HPRO,HNTR,HNTCEL(98),IPCL(200),NRHT(200),
               ,               NWR1(200),DS1(200),SL1(200),
               ,               NWR2(200),DS2(200),SL2(200),
               ,               LBL(200),NTREL(200),ICRO(200),
               ,               NTR,HNREL(100),HISTR(9,100),HRES(168),
               ,               NTRLM,RLMTR(3,5),
               ,               WRK(7000)
        22      DIMENSION TRKAR(200,11),ITRKAR(200,11),
               ,                         LMRTR(3,5)
        23      EQUIVALENCE (IPCL(1),TRKAR(1,1),ITRKAR(1,1))
        24      EQUIVALENCE (LMRTR(1,1),RLMTR(1,1))
        25      DIMENSION IWRK(7000),HWRK(14000),IDWRK(600),HDWRK(1200)
        26      EQUIVALENCE (IWRK(1),WRK(1),HWRK(1))
        27      EQUIVALENCE (IDWRK(1),ADWRK(1),HDWRK(1))
          C---------- END OF MACRO CWORKPR --------------
 02000  28      EQUIVALENCE
 02100         ,      (ADWRK(11),LAYER ),(ADWRK(12),NI    ),(ADWRK(13),NH    )
 02200         ,     ,(ADWRK(14),XHIT  ),(ADWRK(15),YHIT  ),(ADWRK(16),ZHIT  )
 02300         ,     ,(ADWRK(17),RHIT  ),(ADWRK(18),IERZRF),(ADWRK(19),LRFLAG)
 02400         ,     ,(ADWRK(20),INCELL),(ADWRK(21),IERFLG),(ADWRK(22),BETA  )
 02500  29      COMMON/CJTRIG/ PI,TWOPI
 02600  30      DIMENSION LCL(4,100),MASKY(4)
 02700  31      DIMENSION HELP1(2),HELP2(2),HCELLI(6),HELPX(2)
 02800  32      EQUIVALENCE (LABL1,HELP1(1)),(HELP2(1),LABL2),(LABLX,HELPX(1))
 02900  33      EQUIVALENCE (LCL(1,1),IWRK(1))
 03000  34      DATA HELP1/0,0/ ,HELP2/0,0/, LNRHIT/100/, MK1/Z7F/,MKZLAB /Z1/
 03100  35      DATA MKZ0LB /ZFFFE/
 03200  36      DATA HELPX/0,0/,ICALL /0/
 03300    C
 03500  37      IPATR=IBLN('PATR')                                                 POINTERS IN HDATA,IDATA
 03600  38      IPPATR = IDATA(IPATR)
 03800  39      IF(IPPATR.LE.0) RETURN                                             CHECK IF PATR BANK EXISTS
 03900  41      NTR = IDATA(IPPATR+2)
 04100  42      IF(NTR.LE.0) RETURN                                                IF NO TRACKS, RETURN
 04200  44      IJETC=IBLN('JETC')
 04300  45      IJHTL=IBLN('JHTL')
 04400  46      DELPHI = TWOPI/24.
 04500  47      LO = IDATA(IPPATR+1)
 04600  48      LTRBK = IDATA(IPPATR+3)
 04700  49      IPJCA = IDATA(IJETC)
 04800  50      IPJ = 2*IPJCA + 2
 05000  51      NHT = (HDATA(IPJ+97)-HDATA(IPJ+1))/4                               TOTAL NUMBER OF HITS
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  3
0CARD TARGET
  NO  STM.NO
 
 05100  52      HPFREE = 401
 05300  53      LP1 = HPFREE - 1                                                   LP1 = ARRAY RPHI (RADIUS OF HIT)
 05500  54      LP2 = LP1 + LNRHIT                                                 LP2 = ARRAY PHI (PHI OF HIT)
 05700  55      LP3 = LP2 + LNRHIT                                                 LP3 = ARRAY XHT (X OF HIT)
 05900  56      LP4 = LP3 + LNRHIT                                                 LP4 = ARRAY YHT (Y OF HIT)
 06100  57      LP5 = LP4 + LNRHIT                                                 LP5 = ARRAY HSADR (HIT ADRESS IN JETC)
 06300  58      LP6 = LP5 + LNRHIT                                                 LP6 = ARRAY HSWIR (WIRE NUMBER)
 06500  59      LP7 = LP6 + LNRHIT                                                 LP7 = ARRAY HSCEL (CELL NUMBER)
 06700  60      LP8 = LP7 + LNRHIT                                                 LP8 = ARRAY HSLAB (HIT ADRESS IN JHTL)
 06900  61      LP9 = LP8 + LNRHIT                                                 LP9 = ARRAY HSLRF (LRFLAG IN JHTL)
 07100  62      LPA = LP9 + LNRHIT                                                 LPA = ARRAY ZHIT  (Z OF HIT)
 07300  63      LPB = LPA + LNRHIT                                                 LPB = ARRAY ZLABEL (ZFIT LABEL)
 07500  64      HPFREE = LPB + LNRHIT + 1                                          UPDATE HPFREE
 07600  65      IPJ = IPJ + 95
 07700  66      IPJHTL = IDATA(IJHTL)
 07800  67      IPJH = 2*IPJHTL + 2
 07900  68      IF ICALL.EQ.0
 08000  69      THEN
 08100  72         PERFORM ZCHINT
 08200  75         ICALL = 1
 08300  76      CIF
 08500  77      PERFORM LCLMRK                                                     SET ARRAY WITH CELL OCCUPANCY
 08600    C
 08800  80      FOR ITR = 1,NTR                                                    LOOP OVER ALL TRACKS
 08900  81         IPPO1 = IPPATR + (ITR-1)*LTRBK + LO
 09000  82         IPPO = IPPO1
 09100  83         ITYPTR = IDATA(IPPO + 18)
 09300  84         IF ITYPTR.EQ.1                                                  CHECK IF CIRCLE TYPE FIT
 09400  85         THEN
 09500  88            PERFORM CIRPAR
 09600  91            IF IPRFL.EQ.0
 09700  92            THEN
 09800  95               RMIN1 = RMIN
 09900  96               RMAX1 = RMAX
 10000  97               XMIT1 = XMIT
 10100  98               YMIT1 = YMIT
 10200  99            CIF
 10300 100         CIF
 10500 101         IF ITYPTR.EQ.2                                                  CHECK IF PARABOLA TYPE FIT
 10600 102         THEN
 10700 105            PERFORM PARPAR
 10800 108            IF IPRFL.EQ.0
 10900 109            THEN
 11000 112               C1R = C1
 11100 113               C2R = C2
 11200 114               C3R = C3
 11300 115               C4R = C4
 11400 116               C5R = C5
 11500 117               C6R = C6
 11600 118            CIF
 11700 119         CIF
 11800 120         IPRFL1 = IPRFL
 11900 121         IF IPRFL1.EQ.0
 12000 122         THEN
 12200 125            NHIT = 0                                                     NR OF HITS / TRACK
 12300 126            NI = IPJ
 12400 127            IHITH = -1
 12600 128            FOR I = 1,6                                                  GET LIST OF CELL NUMBER FOR HIT CHECK
 12700 129               HCELLI(I) = IDATA(IPPO + 33 + I)
 12800 130            CFOR
 12900    C > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > >
 13100 132            FOR  IHT = 1,NHT                                             LOOP OVER ALL HITS, SELECT TRACK ITR
 13200 133               NI = NI + 4
 13300 134               IHITH = IHITH + 2
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  4
0CARD TARGET
  NO  STM.NO
 
 13400 135               IHITG = IHITH + 1
 13500 136               HELP1(2) = HDATA(IPJH + IHITH)
 13600 137               HELP2(2) = HDATA(IPJH + IHITG)
 13700 138               MTR = LAND(SHFTR(LABL1,1),MK1)
 13800 139               MTR2 = LAND(SHFTR(LABL2,1),MK1)
 13900 140               IAMB = 0
 14000 141               IF(MTR.EQ.ITR) IAMB = 1
 14100 143               IF(MTR2.EQ.ITR) IAMB = 2
 14200 145               IF IAMB.NE.0
 14300 146               THEN
 14400 149                  IF(IAMB.EQ.1) NH = IPJH + IHITH
 14500 151                  IF(IAMB.EQ.2) NH = IPJH + IHITG
 14600 153                  IF(IAMB.EQ.1) LABLX = LABL1
 14700 155                  IF(IAMB.EQ.2) LABLX = LABL2
 14800 157                  LRFLAG = -1
 14900 158                  IF(TBIT(LABLX,23)) LRFLAG = 1
 15100 160                  BETA = 1.                                              SET INPUT FOR JETXYZ
 15200 161                  CALL JETXYZ
 15300 162                  ITST = 1
 15400 163                  FOR I = 1,6
 15500 164                     IF(INCELL.EQ.HCELLI(I)) ITST = 0
 15600 166                  CFOR
 15700 168                  IF ITST.EQ.0
 15800 169                  THEN
 15900 172                     NHIT = NHIT + 1
 16100 173                     WRK(LP1+NHIT) = RHIT                                STORE RESULTS IN WRK ARRAY
 16200 174                     FIHIT = ATAN2(YHIT,XHIT)
 16300 175                     IF(FIHIT.LT.0.) FIHIT = FIHIT + TWOPI
 16400 177                     WRK(LP2+NHIT) = FIHIT
 16500 178                     WRK(LP3+NHIT) = XHIT
 16600 179                     WRK(LP4+NHIT) = YHIT
 16700 180                     IWRK(LP5+NHIT) = NI
 16900 181                     IWRK(LP6+NHIT) = LAYER + (INCELL - 1)*16            RANGE (0 - 1535)
 17100 182                     IWRK(LP7+NHIT) = INCELL                             RANGE (1 - 96)
 17200 183                     IWRK(LP8+NHIT) = NH
 17300 184                     IWRK(LP9+NHIT) = LRFLAG
 17400 185                     WRK(LPA+NHIT) = ZHIT
 17600 186                     IWRK(LPB+NHIT) = LAND(LABLX,MKZLAB)                 MARK BAD Z-COORDINATE
 17700 187                  CIF
 17800 188               CIF
 17900 189            CFOR
 18000    C > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > >
 18100    C-------------- END OF COORDINATE LOOP
 18300 191            IF NHIT.GT.3                                                 CHECK IF ANY HITS
 18400 192            THEN
 18600 195               FOR IHT = 1,NHIT                                          LOOP OVER THE HITS
 18700 196                  PERFORM LINEDS
 18900 199                  IF ITYPTR.EQ.1                                         FIND CROSS POINT WITH DRIFTSPACE
 19000 200                  THEN
 19100 203                     RMIN = RMIN1
 19200 204                     RMAX = RMAX1
 19300 205                     XMIT = XMIT1
 19400 206                     YMIT = YMIT1
 19500 207                     PERFORM XYTS
 19600 210                  CIF
 19700 211                  IF ITYPTR.EQ.2
 19800 212                  THEN
 19900 215                     C1 = C1R
 20000 216                     C2 = C2R
 20100 217                     C3 = C3R
 20200 218                     C4 = C4R
 20300 219                     C5 = C5R
 20400 220                     C6 = C6R
 20500 221                     PERFORM XYTSPR
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  5
0CARD TARGET
  NO  STM.NO
 
 20600 224                  CIF
 20700 225                  ICRFL1 = ICRFL
 20800 226                  IF ICRFL1.EQ.0
 20900 227                  THEN
 21000 230                     DISTA=(XTS-XW)**2+(YTS-YW)**2
 21100 231                     DISTA = SQRT(DISTA)
 21200 232                     XTS1 = XTS
 21300 233                     YTS1 = YTS
 21400 234                     RTS = SQRT(XTS**2 + YTS**2)
 21500 235                     INCL1 = IWRK(LP7+IHT)
 21700 236                     PERFORM CELNEI                                      FILL ARRAY WITH NEIGHBOR CELL-NRS
 21900 239                     FOR KTR = 1,NTR                                     LOOP OVER REMAINING TRACKS
 22100 240                        IF KTR.NE.ITR                                    SELECT OTHER TRACKS
 22200 241                        THEN
 22300 244                           ICHKFL = LAND(MASKY(1),LCL(1,KTR))
 22400         $                     + LAND(MASKY(2),LCL(2,KTR))
 22500         $                     + LAND(MASKY(3),LCL(3,KTR))
 22600         $                     + LAND(MASKY(4),LCL(4,KTR))
 22700 245                           IF ICHKFL.GT.0
 22800 246                           THEN
 22900 249                              IPPO = IPPATR + (KTR-1)*LTRBK + LO
 23000 250                              PERFORM ZOK
 23100 253                              IF IOKZ.EQ.0
 23200 254                              THEN
 23300 257                                 ITYPTS = IDATA(IPPO+18)
 23400 258                                 IF ITYPTS.EQ.1
 23500 259                                 THEN
 23600 262                                    PERFORM CIRPAR
 23700 265                                    IF IPRFL.EQ.0
 23800 266                                    THEN
 23900 269                                    PERFORM XYTS
 24000 272                                    CIF
 24100 273                                 CIF
 24200 274                                 IF ITYPTS.EQ.2
 24300 275                                 THEN
 24400 278                                    PERFORM PARPAR
 24500 281                                    IF IPRFL.EQ.0
 24600 282                                    THEN
 24700 285                                    PERFORM XYTSPR
 24800 288                                    CIF
 24900 289                                 CIF
 25100 290                                 IF IPRFL.EQ.0.AND.ICRFL.EQ.0            FIND CROSSPOINT WITH SAME DRIFTSPACE
 25200 291                                 THEN
 25300 294                                    PERFORM SAMCEL
 25400 297                                    IF ICLSAM.EQ.1
 25500 298                                    THEN
 25600 301                                    DISTB=(XTS-XW)**2+(YTS-YW)**2
 25700 302                                    DISTB = SQRT(DISTB)
 25800 303                                    DIST = ABS(DISTA-DISTB)
 26000 304                                    IF DIST.LT.DHRLIM                    CHECK DISTANCE BETWEEN CROSS POINTS
 26100 305                                    THEN
 26300 308                                    NH = IWRK(LP8+IHT)                   MARK THE HIT ACCORDINGLY
 26400 309                                    HELPX(2) = HDATA(NH)
 26500 310                                    LABLX = LAND(LABLX,MKZ0LB)
 26600 311                                    HDATA(NH) = HELPX(2)
 26700 312                                    XFOR
 26800 313                                    CIF
 26900 314                                    CIF
 27000 315                                 CIF
 27100 316                              CIF
 27200 317                           CIF
 27300 318                        CIF
 27400 319                     CFOR
 27500 321                  CIF
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  6
0CARD TARGET
  NO  STM.NO
 
 27600 322               CFOR
 27700 324            CIF
 27800 325         CIF
 27900 326      CFOR
 28000 328      RETURN
 28100    C---------
 28200 329      PROC LCLMRK
 28300    C SET ARRAY LCL WITH BIT PATTERN FOR CELL OCCUPANCY FOR EACH TRACK
 28400 330         IPPO = IPPATR - LTRBK + LO
 28500 331         FOR ITR = 1,NTR
 28600 332            LCL(1,ITR) = 0
 28700 333            LCL(2,ITR) = 0
 28800 334            LCL(3,ITR) = 0
 28900 335            LCL(4,ITR) = 0
 29000 336            IPPO = IPPO + LTRBK
 29100 337            IPP = IPPO + 33
 29200 338            FOR I = 1,6
 29300 339               INCE = IDATA(IPP+I)
 29400 340               IF INCE.GT.0
 29500 341               THEN
 29600 344                  IRNG = (INCE-1)/24 + 1
 29700 345                  INCE = INCE - (IRNG-1)*24
 29800 346                  MASK = 2**(INCE-1)
 29900 347                  LCL(IRNG,ITR) = LOR(LCL(IRNG,ITR),MASK)
 30000 348               ELSE
 30100 350                  XFOR
 30200 351               CIF
 30300 352            CFOR
 30400 354         CFOR
 30500 356      CPROC
 30600    C---------
 30700 358      PROC ZCHINT
 30800    CALCULATE ON FIRST CALL THE ARRAY WITH DRIFT DIRECTIONS FOR LINEDS
 30900 359         FOR INCELL = 1,96
 31000 360            IF INCELL.LT.49
 31100 361            THEN
 31200 364               II = INCELL
 31300 365               IF(II.GT.24) II = II - 24
 31400 367               FINC = FLOAT(II-1)*DELPHI + DELPHI*.5
 31500    C              FINC = ARSIN(DIRWR1(II,2))
 31600 368            ELSE
 31700 370               II = INCELL - 48
 31800    C              FINC = ARSIN(DIRWR3(II,2))
 31900 371               FINC = FLOAT(II-1)*DELPHI*.5 + DELPHI*.25
 32000 372            CIF
 32100 373            IF(FINC.LT.0.) FINC = FINC + TWOPI
 32200 375            EE1(INCELL,1) = TAN(FINC + .5*PI + DRIROT(INCELL,1))
 32300 376            EE1(INCELL,2) = TAN(FINC + .5*PI + DRIROT(INCELL,2))
 32400 377         CFOR
 32500 379      CPROC
 32600    C-------------------
 32700 381      PROC LINEDS
 32800    C GET EQUATION FOR STRAIGHT LINE THROUGH WIRE AND DRIFT SPACE
 32900 382         NI = IWRK(LP5 + IHT)
 33000 383         LRFLG = IWRK(LP9 + IHT)
 33100 384         IF(LRFLG.LT.0) LRFLG = 0
 33200 386         XHIT = WRK(LP3+IHT)
 33300 387         YHIT = WRK(LP4+IHT)
 33400 388         INCELL = IWRK(LP7+IHT)
 33500 389         E1 = EE1(INCELL,LRFLG+1)
 33600 390         NRING = INCELL - 1
 33700 391         NRING = NRING/24 + 1
 33800 392         IF(NRING.GT.3) NRING = 3
 33900 394         NCL = NCELL(NRING)
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  7
0CARD TARGET
  NO  STM.NO
 
 34000 395         RADD = RINCR(NRING)
 34100 396         RW = FSENSW(NRING) - RADD
 34200 397         NIW = IWRK(LP6+IHT) + 1
 34300 398         NEW = NIW - (NRING-1)*384
 34400 399         SHIFI = PSIIN(NRING)
 34500 400         NCE = SHFTR(NEW-1,4)
 34600 401         NWE = NEW - NCE*16
 34700 402         RW = RW + NWE*RADD
 34800 403         NUMCLO = 2
 34900 404         IF(NWE.LT.9) NUMCLO = 1
 35000 406         FACT = -1.
 35100 407         IF(TBIT(NWE,31)) FACT = 1.
 35200 409         FIW = SHIFI + NCE*TWOPI/FLOAT(NCL)
 35300 410         IF(FIW.LT.0.) FIW = FIW + TWOPI
 35400 412         IF(FIW.GT.TWOPI) FIW = FIW - TWOPI
 35500 414         COSPH = COS(FIW)
 35600 415         SINPH = SIN(FIW)
 35800 416         XW = RW*COSPH  - FACT*SINPH*SWDEPL                              COORDINATES OF WIRE
 35900 417         YW = RW*SINPH  + FACT*COSPH*SWDEPL
 36000    C--  STRAIGHT LINE EQUATION OF DRIFTSPACE THROUGH XW,YW
 36100    C        Y = YW - TGA*XW  +  TGA*X         Y = E1*X + E2
 36200 418         E2 = YW - E1*XW
 36300 419      CPROC
 36400    C---------
 36500 421      PROC XYTS
 36600    C GET CROSS POINT CIRCLE - DRIFT SPACE
 36700 422         ICRFL = 0
 36800 423         CONST1 = RMAX*RMIN + E2*E2 - 2.*E2*YMIT
 36900 424         CONST1 = CONST1/(1.+E1*E1)
 37000 425         CONST2 = E1*E2 - E1*YMIT - XMIT
 37100 426         CONST2 = CONST2/(1.+E1*E1)
 37200 427         RADD = CONST2*CONST2 - CONST1
 37300 428         IF(RADD.LE.0.) ICRFL = -1
 37400 430         IF ICRFL.EQ.0
 37500 431         THEN
 37600 434            RADD = AMAX1(RADD,.000001)
 37700 435            RADD = SQRT(RADD)
 37800 436            X1 = -CONST2 + RADD
 37900 437            X2 = -CONST2 - RADD
 38000 438            XTS = X1
 38100 439            IF(ABS(XHIT-X2).LT.ABS(XHIT-X1)) XTS = X2
 38200 441            YTS = E2 + E1*XTS
 38300 442         CIF
 38400 443      CPROC
 38500    C------------------------
 38600 445      PROC CIRPAR
 38700    C-- FROM TRACK BANK CIRCLE PARAMETERS, GET THOSE USED IN PROC XYTS
 38800 446         IPRFL = 0
 38900 447         RAD = ADATA(IPPO+19)
 39000 448         RMIN = ADATA(IPPO+20)
 39100 449         PHIMIT = ADATA(IPPO+21)
 39200 450         IF ABS(RAD).GT.1.E-08
 39300 451         THEN
 39400 454            RAD = ABS(1./RAD)
 39500 455            RMIT= RAD + RMIN
 39600 456            RMAX = RMIT + RAD
 39700 457            XMIT = RMIT*COS(PHIMIT)
 39800 458            YMIT = RMIT*SIN(PHIMIT)
 39900 459         ELSE
 40000 461            IPRFL = -1
 40100 462         CIF
 40200 463      CPROC
 40300    C--------------
 40400 465      PROC PARPAR
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  8
0CARD TARGET
  NO  STM.NO
 
 40500    C-- FROM TRACK BANK PARABOLA PARAMETERS, GET THOSE USED IN PROC XYTSPR
 40600 466         IPRFL = 0
 40700 467         A = ADATA(IPPO+19)
 40800 468         B = ADATA(IPPO+20)
 40900 469         C = ADATA(IPPO+21)
 41000 470         D = ADATA(IPPO+22)
 41100    C--
 41200 471         COSA = COS(A)
 41300 472         SINA = SIN(A)
 41400    C--             GET EQUATION FOR PARABOLA IN DETECTOR SYSTEM
 41500    C--             C1*Y**2 + C2*Y + C3*X**2 + C4*X + C5*XY + C6 = 0
 41600    C--
 41700 473         C1 = D*SINA*SINA
 41800 474         C2 = - 2.*D*(B*COSA*SINA + C*SINA*SINA) - COSA
 41900 475         C3 = D*COSA*COSA
 42000 476         C4 = - 2.*D*(B*COSA*COSA + C*COSA*SINA) + SINA
 42100 477         C5 = 2.*D*COSA*SINA
 42200 478         C6 = (B*COSA+C*SINA)
 42300 479         C6 = D*C6*C6 + C*COSA - B*SINA
 42400 480      CPROC
 42500    C--------------
 42600 482      PROC XYTSPR
 42700    C GET CROSS POINT PARABOLA - DRIFT SPACE
 42800 483         ICRFL = 0
 42900 484         C7 = C1*E1*E1 + C3 + C5*E1
 43000 485         C8 = 2.*C1*E1*E2 + C2*E1 + C4 + C5*E2
 43100 486         C9 = C1*E2*E2 + C2*E2 + C6
 43200 487         IF ABS(C7).GT..000001
 43300 488         THEN
 43400 491            DD = C8*C8 - 4.*C7*C9
 43500 492            IF DD.GT..000001
 43600 493            THEN
 43700 496               X1 = (-C8 + SQRT(DD))/(2.*C7)
 43800 497               X2 = (-C8 - SQRT(DD))/(2.*C7)
 43900 498               XTS = X1
 44000 499               IF(ABS(XHIT-X2).LT.ABS(XHIT-X1)) XTS = X2
 44100 501               YTS = E2 + E1*XTS
 44200 502            ELSE
 44300 504               ICRFL = -1
 44400 505            CIF
 44500 506         ELSE
 44600 508            ICRFL = -1
 44700 509         CIF
 44800 510      CPROC
 44900    C------------------------
 45000 512      PROC CELNEI
 45100    C     SET THE ARRAY MASKY WITH BIT PATTERN FOR NEIGHBOR CELLS
 45200 513         MASKY(1) = 0
 45300 514         MASKY(2) = 0
 45400 515         MASKY(3) = 0
 45500 516         MASKY(4) = 0
 45600 517         IF INCL1.LE.24
 45700 518         THEN
 45900 521            IF INCL1.EQ.1                                                CELL NR 1
 46000 522            THEN
 46100 525               MASKY(1) = 8388611
 46200 526               MASKY(2) = MASKY(1)
 46300 527               MASKY(3) = 7
 46400 528               MASKY(4) = 8388608
 46500 529            ELSE
 46700 531               IF INCL1.LT.24                                            CELL NR 2 - 23
 46800 532               THEN
 46900 535                  MASKY(1) = LOR(MASKY(1),2**(INCL1-2))
 47000 536                  MASKY(1) = LOR(MASKY(1),2**(INCL1-1))
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  9
0CARD TARGET
  NO  STM.NO
 
 47100 537                  MASKY(1) = LOR(MASKY(1),2**INCL1)
 47200 538                  MASKY(2) = MASKY(1)
 47300 539                  IF INCL1.LT.12
 47400 540                  THEN
 47500 543                     MASKY(3) = LOR(MASKY(3),2**(2*INCL1-3))
 47600 544                     MASKY(3) = LOR(MASKY(3),2**(2*INCL1-2))
 47700 545                     MASKY(3) = LOR(MASKY(3),2**(2*INCL1-1))
 47800 546                     MASKY(3) = LOR(MASKY(3),2**(2*INCL1))
 47900 547                  CIF
 48000 548                  IF INCL1.GT.13
 48100 549                  THEN
 48200 552                     INCK1 = INCL1 - 12
 48300 553                     MASKY(4) = LOR(MASKY(4),2**(2*INCK1-3))
 48400 554                     MASKY(4) = LOR(MASKY(4),2**(2*INCK1-2))
 48500 555                     MASKY(4) = LOR(MASKY(4),2**(2*INCK1-1))
 48600 556                     MASKY(4) = LOR(MASKY(4),2**(2*INCK1))
 48700 557                  CIF
 48800 558                  IF INCL1.EQ.12
 48900 559                  THEN
 49000 562                     MASKY(3) = 14680064
 49100 563                     MASKY(4) = 1
 49200 564                  CIF
 49300 565                  IF INCL1.EQ.13
 49400 566                  THEN
 49500 569                     MASKY(4) = 7
 49600 570                     MASKY(3) = 8388608
 49700 571                  CIF
 49900 572               ELSE                                                      CELL NR 24
 50000 574                  MASKY(1) = 12582913
 50100 575                  MASKY(2) = MASKY(1)
 50200 576                  MASKY(3) = 1
 50300 577                  MASKY(4) = 14680064
 50400 578               CIF
 50500 579            CIF
 50600 580         ELSE
 50700 582            IF INCL1.LE.48
 50800 583            THEN
 51000 586               IF INCL1.EQ.25                                            CELL NR 25
 51100 587               THEN
 51200 590                  MASKY(1) = 8388611
 51300 591                  MASKY(2) = MASKY(1)
 51400 592                  MASKY(3) = 7
 51500 593                  MASKY(4) = 8388608
 51600 594               ELSE
 51800 596                  IF INCL1.LT.48                                         CELL NR 26 - 47
 51900 597                  THEN
 52000 600                     INCK1 = INCL1 - 24
 52100 601                     MASKY(1) = LOR(MASKY(1),2**(INCK1-2))
 52200 602                     MASKY(1) = LOR(MASKY(1),2**(INCK1-1))
 52300 603                     MASKY(1) = LOR(MASKY(1),2**INCK1)
 52400 604                     MASKY(2) = MASKY(1)
 52500 605                     IF INCK1.LT.12
 52600 606                     THEN                                                CELL NR 26 - 35
 52700 609                        MASKY(3) = LOR(MASKY(3),2**(2*INCK1-3))
 52800 610                        MASKY(3) = LOR(MASKY(3),2**(2*INCK1-2))
 52900 611                        MASKY(3) = LOR(MASKY(3),2**(2*INCK1-1))
 53000 612                        MASKY(3) = LOR(MASKY(3),2**(2*INCK1))
 53100 613                     CIF
 53200 614                     IF INCK1.GT.13
 53300 615                     THEN                                                CELL NR 38 - 47
 53400 618                        INCK2 = INCK1 - 12
 53500 619                        MASKY(4) = LOR(MASKY(4),2**(2*INCK2-3))
 53600 620                        MASKY(4) = LOR(MASKY(4),2**(2*INCK2-2))
 53700 621                        MASKY(4) = LOR(MASKY(4),2**(2*INCK2-1))
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE 10
0CARD TARGET
  NO  STM.NO
 
 53800 622                        MASKY(4) = LOR(MASKY(4),2**(2*INCK2))
 53900 623                     CIF
 54000 624                     IF INCK1.EQ.12
 54100 625                     THEN                                                CELL NR 36
 54200 628                        MASKY(3) = 14680064
 54300 629                        MASKY(4) = 1
 54400 630                     CIF
 54500 631                     IF INCK1.EQ.13
 54600 632                     THEN                                                CELL NR 37
 54700 635                        MASKY(4) = 7
 54800 636                        MASKY(3) = 8388608
 54900 637                     CIF
 55100 638                  ELSE                                                   CELL NR 48
 55200 640                     MASKY(1) = 12582913
 55300 641                     MASKY(2) = MASKY(1)
 55400 642                     MASKY(3) = 1
 55500 643                     MASKY(4) = 14680064
 55600 644                  CIF
 55700 645               CIF
 55800 646            ELSE
 56000 648               IF INCL1.EQ.49                                            CELL NR 49
 56100 649               THEN
 56200 652                  MASKY(1) = 8388609
 56300 653                  MASKY(2) = MASKY(1)
 56400 654                  MASKY(3) = 3
 56500 655                  MASKY(4) = 8388608
 56600 656               ELSE
 56800 658                  IF INCL1.LT.96                                         CELL NR 50 - 95
 56900 659                  THEN
 57000 662                     INCK1 = INCL1 - 48
 57100 663                     INCK2 = INCK1/2
 57200 664                     MASKY(1) = LOR(MASKY(1),2**(INCK2-1))
 57300 665                     MASKY(1) = LOR(MASKY(1),2**INCK2)
 57400 666                     MASKY(2) = MASKY(1)
 57500 667                     IF INCK2.LT.12
 57600 668                     THEN                                                CELL NR 50 - 71
 57700 671                        MASKY(3) = LOR(MASKY(3),2**(INCK1-2))
 57710 672                        MASKY(3) = LOR(MASKY(3),2**(INCK1-1))
 57800 673                        MASKY(3) = LOR(MASKY(3),2**INCK1)
 57900 674                     CIF
 58000 675                     IF INCK2.EQ.12
 58100 676                     THEN                                                CELL NR 72 - 73
 58200 679                        IF(INCK1.EQ.24) MASKY(3) = 12582912
 58300 681                        IF(INCK1.EQ.25) MASKY(3) = 8388608
 58400 683                        IF(INCK1.EQ.24) MASKY(4) = 1
 58500 685                        IF(INCK1.EQ.25) MASKY(4) = 3
 58600 687                     CIF
 58700 688                     IF INCK2.GT.12
 58800 689                     THEN                                                CELL NR 74 - 95
 58810 692                        INCK1 = INCK1 - 24
 58900 693                        MASKY(4) = LOR(MASKY(4),2**(INCK1-2))
 58910 694                        MASKY(4) = LOR(MASKY(4),2**(INCK1-1))
 59000 695                        MASKY(4) = LOR(MASKY(4),2**INCK1)
 59100 696                     CIF
 59300 697                  ELSE                                                   CELL NR 96
 59400 699                     MASKY(1) = 8388609
 59500 700                     MASKY(2) = MASKY(1)
 59600 701                     MASKY(3) = 1
 59700 702                     MASKY(4) = 12582912
 59800 703                  CIF
 59900 704               CIF
 60000 705            CIF
 60100 706         CIF
 60200 707      CPROC
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE 11
0CARD TARGET
  NO  STM.NO
 
 60300    C------------------------
 60400 709      PROC SAMCEL
 60500    C CHECK IF CROSS POINT XTS,YTS  IN ACTUAL CELL (INCL1)
 60600 710         ICLSAM = 0
 60700 711         FII = ATAN2(YTS,XTS)
 60800 712         IF(FII.LT.0.) FII = FII + TWOPI
 60900 714         NFII = FII/DELPHI
 61000 715         IF(INCL1.GT.48) NFII = 2.*FII/DELPHI
 61100 717         NFII = NFII + 1
 61200 718         IF(INCL1.GT.24) NFII = NFII + 24
 61300 720         IF(INCL1.GT.48) NFII = NFII + 24
 61400 722         IF(INCL1.EQ.NFII) ICLSAM = 1
 61500 724      CPROC
 61600    C------------------------
 61700 726      PROC ZOK
 61800    C CHECK IF Z-COORDINATE OF FIT INSIDE DETECTOR FOR CHECK POINT
 61900 727         IOKZ = 0
 62000 728         ZTEST = ADATA(IPPO+30)*RTS + ADATA(IPPO+31)
 62100 729         IF(ABS(ZTEST).GT.ZMAX) IOKZ = 1
 62200 731      CPROC
 62300    C------------------------
 62400 733      END
0END OF SEGMENT
0  OPTIONS IN EFFECT - LINECOUNT=64,LINEWIDTH=131,  SOURCE,  FORTRAN  NUMBERING
0   0 ERRORS           0 WARNINGS         732 TARGET STATEMENTS
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  1
0CARD TARGET
  NO  STM.NO
 
0END OF PROGRAM
0  OPTIONS IN EFFECT - LINECOUNT=64,LINEWIDTH=131,  SOURCE,  FORTRAN  NUMBERING
0   0 ERRORS           0 WARNINGS         732 TARGET STATEMENTS
 00000    C   26/03/81            MEMBER NAME  ZRFIT    (PATRECSR)    SHELTRAN
 00100    C   27/09/79 103261204  MEMBER NAME  ORZRFIT  (JADESR)      SHELTRAN
 00200    C   26/09/79            MEMBER NAME  ZRFIT    (JADESR)      SHELTRAN
 00300    C   17/07/79 C9080501   MEMBER NAME  ZRFIT8   (JADESR)      SHELTRAN
 00400    C   17/07/79 C9071701   MEMBER NAME  ZRFITA   (PATRECS)     SHELTRAN
 00500    C   01/07/79            MEMBER NAME  ZRFIT9   (PATRECSR)    SHELTRAN
 00600    C   30/03/79 C9062901   MEMBER NAME  ZRFITT   (JADESR)      SHELTRAN
 00700    C   13/03/79 C9033001   MEMBER NAME  ORZRFIT  (JADESR)      SHELTRAN
 00800    C   13/03/79 C9031301   MEMBER NAME  ZRFIT9   (JADESR)      SHELTRAN
 00900   2      SUBROUTINE ZRFIT
 01000    C
 01100    C     LINEAR FIT OF Z-R OF TRACKS: P.STEFFEN(78/11/15)
 01200    C
 01300   3      IMPLICIT INTEGER*2 (H)
 01400    C
 01500    C     MODIFIED WITH PREPROCESSOR TO SELECT HITS ON TRACK
 01600    C              LINE ELEMENT METHOD  A LA FLINEL
 01700    C              HISTOGRAMMING METHOD A LA ZVERTF    P.STEFFEN 20.9.79
 01800    C
          C-------------------------------
          C  MACRO CHEADR .... HEADER BANK
          C-------------------------------
         4      COMMON /CHEADR/ IHEADR(54)
         5      INTEGER*2 HHEADR(108)
         6      EQUIVALENCE (IHEADR(1),HHEADR(1))
          C --
          C --  HHEADR(17) = EXPERIMENT NUMBER
          C --  HHEADR(18) = RUN NUMBER
          C --  HHEADR(19) = EVENT NUMBER
          C --  HHEADR(38) = MAGNETIC FIELD (GAUSS)
          C --
          C--------- END OF MACRO CHEADR ------------
 02000    C
 00100    C-----------------------------------------------------------------------
 00200    C                            MACRO CJDRCH .... JET CHAMBER CONSTANTS.
 00300    C-----------------------------------------------------------------------
 00310    C
 00400   7      COMMON / CJDRCH / RDEC(4),PSIIN(3),RINCR(3),FIRSTW(3),FSENSW(3),
 00500         +                  RDEPTH,SWDEPL,YSUSPN,TIMDEL(2,3),ZMAX,ZOFFS,
 00510         +                  ZRESOL,ZNORM,ZAL,ZSCAL,DRIDEV,DRICOS,DRISIN,
 00600         +                  PEDES,TZERO(3),DRIROT(96,2),SINDRI(96,2),
 00701         +                  COSDRI(96,2),DRIVEL(96,2),T0FIX(3),
 00800         +                  ABERR(8), DUMJDC(20)
 00900    C
 01100    C      BLOCK DATA SET TO MC VALUES, KALIBR WILL SET REAL DATA VALUES
 01210    C--->  A CHANGE OF THIS COMMON MUST BE DONE SIMULTANEOUSLY WITH  <----
 01220    C--->  A CHANGE OF THE BLOCK DATA                                <----
 01230    C
 01300    C--------------------------- END OF MACRO CJDRCH -----------------------
 01400    C
 02200    C
          C-----------------------------------------------------------------------
          C                            MACRO CGRAPH .... GRAPHICS COMMON
          C-----------------------------------------------------------------------
          C
         8      LOGICAL DSPDTL,SSTPS,PSTPS,FREEZE
          C
         9      COMMON / CGRAPH / JUSCRN,NDDINN,NDDOUT,IDATSV(11),ICREC,MAXREC,
               +                  LSTCMD,ACMD,LASTVW,ISTANV,
               +                  SXIN,SXAX,SYIN,SYAX,XMIN,XMAX,YMIN,YMAX,
               +                  DSPDTL(30),SSTPS(10),PSTPS(10),FREEZE(30),
               +                  IREADM,LABEL,LSTPS(10),IPSVAR
          C
          C------- END OF MACRO CGRAPH -------------------------------------------
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  2
0CARD TARGET
  NO  STM.NO
 
          C
          C----------------------------------------------
          C  MACRO CWORKPR .... PATTERN RECOGNITION CWORK
          C----------------------------------------------
        10      COMMON /CWORK/ HPLAST,HPFREE,HPWRK(30),ADWRK(600),
               ,               HPRO,HNTR,HNTCEL(98),IPCL(200),NRHT(200),
               ,               NWR1(200),DS1(200),SL1(200),
               ,               NWR2(200),DS2(200),SL2(200),
               ,               LBL(200),NTREL(200),ICRO(200),
               ,               NTR,HNREL(100),HISTR(9,100),HRES(168),
               ,               NTRLM,RLMTR(3,5),
               ,               WRK(7000)
        11      DIMENSION TRKAR(200,11),ITRKAR(200,11),
               ,                         LMRTR(3,5)
        12      EQUIVALENCE (IPCL(1),TRKAR(1,1),ITRKAR(1,1))
        13      EQUIVALENCE (LMRTR(1,1),RLMTR(1,1))
        14      DIMENSION IWRK(7000),HWRK(14000),IDWRK(600),HDWRK(1200)
        15      EQUIVALENCE (IWRK(1),WRK(1),HWRK(1))
        16      EQUIVALENCE (IDWRK(1),ADWRK(1),HDWRK(1))
          C---------- END OF MACRO CWORKPR --------------
 00100    C-------------------------------------------------------
 00200    C  MACRO CWORKEQ .... PATTERN RECOGNITION CWORK POINTERS
 00300    C-------------------------------------------------------
 00400  17      EQUIVALENCE
 00410    C                POINTERS FOR FXYZ HIT ARRAY .. PRIMARY L/R SOLUTION
 00500         #          (HPHT0,HPWRK( 1)),(HPHT9,HPWRK( 2)),(HLDHT,HPWRK( 3))
 00510    C                POINTERS FOR CWORK SINGLE TRACK PATR BANK
 00600         #         ,(HPTR0,HPWRK( 4)),(HPTR9,HPWRK( 5)),(HLDTR,HPWRK( 6))
 00610    C                POINTERS FOR TRACK ELEMENT HIT LABEL ARRAY
 00700         #         ,(HPHL0,HPWRK( 7)),(HPHL9,HPWRK( 8)),(HLDHL,HPWRK( 9))
 00710    C                POINTERS FOR FXYZ HIT ARRAY .. OPPOSITE L/R SOLUTION
 00800         #         ,(HPHT0A,HPWRK(10)),(HPHT9A,HPWRK(11)),(HLDHTA,HPWRK(12))
 00810    C               POINTER LIMIT ON FXYZ HIT ARRAY
 00900         #         ,(HPHTLM,HPWRK(13))
 00910    C               POINTERS FOR
 01000         #         ,(HPTE0,HPWRK(14)),(HPTE9,HPWRK(15)),(HLDTE,HPWRK(16))
 01100    C-------------- END OF MACRO CWORKEQ ------------------
 02600    C
 02700  18      DIMENSION SUM(10),HIST(200)
 02800  19      EQUIVALENCE
 02900         ,           (ICELL ,ADWRK(1)),(NHIT  ,ADWRK(2)),(IRING ,ADWRK(3))
 03000         ,         , (IERRCD,ADWRK(4)),(NTRKEL,ADWRK(5))
 03100         ,         , (SUM(1),ADWRK(101))
 03200    C
          C----------------------------------------------
          C  MACRO CPATLM .... PATTERN RECOGNITION LIMITS
          C----------------------------------------------
        20      COMMON /CPATLM/ PATRLM(5),FLINLM(10),TRELLM(20),ZFITLM(10),BKK(20)
               *               ,XYF(20),IGFP(20),XBKK(40),IADMIN(5),YBKK(20)
        21      INTEGER IXYF(20),LMPATR(5),LMFLIN(10)
        22      INTEGER LMTREL(20),LMZFIT(10),IBKK(20)
        23      DIMENSION GFP(20),IXBKK(40),IYBKK(20)
        24      EQUIVALENCE (PATRLM(1),LMPATR(1)),(IXBKK(1),XBKK(1)),(IYBKK(1),
               *YBKK(1))   ,(FLINLM(1),LMFLIN(1)),(TRELLM(1),LMTREL(1))
               *           ,(ZFITLM(1),LMZFIT(1)),(BKK(1),IBKK(1))
               *           ,(XYF(1),IXYF(1)),(GFP(1),IGFP(1)),(IADMIN(1),IMCERT)
               *           ,(IYBKK(20),IPPASS),(IADMIN(2),IPFAST)
          C----------- END OF MACRO CPATLM --------------
 03400    C
 03500  25      DATA SBRAT/2./, NPKMIN /4/, NBINZ/200/
 03600    C
 03700  26      IERRLB = 0
 03800    C
 04000    C     DATA NPR0 /0/                                                      PRINT OUT OF LIMITS
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  3
0CARD TARGET
  NO  STM.NO
 
 04100    C     IF(NPR0.EQ.0) PRINT 2002, ZFITLM
 04200    C2002 FORMAT('0LIMITS OF ZRFIT:',2F8.2,2I6,F8.2,6X,4F8.2,I6)
 04300    C     NPR0 = 1
 04400    C
 04500  27      IP0 = HPHT0
 04600  28      IP9 = HPHT9
 04700  29      IDP = HLDHT
 04800  30      IP8 = IP9 - IDP + 1
 05000  31      Z0 = .5*(WRK(IP0+5)+WRK(IP9-IDP+6))                                OFFSET FOR R-Z TO OVERCOME ROUNDING ERRORS
 05100  32      R0 = .5*(WRK(IP0+6)+WRK(IP9-IDP+7))
 05200    C
 05400  33      ZMAXLM = ZMAX + 20.                                                SET MAX Z OF DETECTOR
 05500    C
 05700  34      NHIT = 0                                                           INITIALIZE GOODNESS LABEL OF POINTS
 05800  35      NBAD = 0
 05900  36      FOR IP=HPHT0,HPHT9,HLDHT
 06000  37         IF(IWRK(IP+ 7).GE.10) IWRK(IP+7) = 16
 06100  39         IF(ABS(WRK(IP+ 5)).GE.ZMAXLM) IWRK(IP+7) = 16
 06200  41         IF(IWRK(IP+10).NE. 0) IWRK(IP+7) = LOR(IWRK(IP+7),8)
 06300  43         IF(IWRK(IP+ 7).EQ. 0) NHIT = NHIT + 1
 06400  45         IF(IWRK(IP+ 7).LT.16) NBAD = NBAD + 1
 06500  47      CFOR
 06600  49      NBAD = NBAD - NHIT
 06700
 06800    C
 07000  50      IF NHIT.LT.16 .AND. NBAD.GE.8                                      RESTORE DELETED HITS(KNTREL) IF TOO MANY
 07100  51      THEN
 07200  54         NHIT = 0
 07300  55         FOR IP=HPHT0,HPHT9,HLDHT
 07400  56            IF IWRK(IP+ 7).LT.16 .AND. IWRK(IP+10).EQ.0
 07500  57            THEN
 07600  60               IWRK(IP+7) = 0
 07700  61               NHIT = NHIT + 1
 07800  62            CIF
 07900  63         CFOR
 08000  65      CIF
 08100    C
 08300  66      IF NHIT.LT.3                                                       CHECK IF ENOUGH GOOD HITS
 08400  67      THEN
 08500  70         IWRK(HPTR0+28) = 1
 08600  71         WRK (HPTR0+29) = 0.
 08700  72         WRK (HPTR0+30) = 0.
 08800  73         WRK (HPTR0+31) = 1000000.
 08900  74         IWRK(HPTR0+32) = 0.
 09000  75         IWRK(HPTR0+47) = LOR(IWRK(HPTR0+47),384)
 09100  76         RETURN
 09200  77      CIF
 09300    C
 09500  78      IF LAND(LMZFIT(10),1).NE.0                                         POINT SELECTION 1 (P.ST.) ?????????
 09600  79      THEN
 09800  82         PERFORM ZSTRT1                                                  CHECK POINTS BEFORE DOING FIRST FIT
 09900  85      CIF
 10100  86      IF LAND(LMZFIT(10),2).NE.0                                         POINT SELECTION 2 (J.OL.) ?????????
 10200  87      THEN
 10400  90         PERFORM ZSTRT2                                                  CHECK POINTS BEFORE DOING FIRST FIT
 10500  93      CIF
 10600    C
 10700  94      NITER = 0
 10800  95      REPEAT
 10900    C
 11100  96         PERFORM LINFIT                                                  LINE FIT OF ALL POINTS
 11300  99         A1SV   = A1                                                     SAVE RESULT
 11400 100         B1SV   = B1
 11500 101         RMSSV  = RMS
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  4
0CARD TARGET
  NO  STM.NO
 
 11600 102         NDEGSV = NDEG
 11700    C
 11900 103         IF RMS.LE.ZFITLM(1) .OR. NDEG.LT.6                              CHECK IF RMS OK
 12100 104         THEN                                                            RMS IS GOOD
 12200 107            XREPEAT
 12300 108         CIF
 12400    C
 12600 109         IF LAND(LMZFIT(10),1).EQ.0                                      BAD RMS: REJECT BAD HITS
 12700 110         THEN
 12900 113            PERFORM ZSTRT1                                               PREPRO 2, IF NOT YET CALLED
 13000 116         ELSE
 13200 118            PERFORM MKPTHT                                               DELETE HITS FOUND BY PATROL
 13300 121         CIF
 13500 122         IF NBAD.EQ.0                                                    CHECK IF HITS REJECTED
 13600 123         THEN
 13700 126            XREPEAT
 13800 127         CIF
 13900    C
 14100 128         PERFORM LINFIT                                                  REPEAT LINE FIT WITHOUT BAD HITS
 14200 131         IF RMS.LE.ZFITLM(1)
 14300 132         THEN
 14500 135            A1SV   = A1                                                  SAVE RESULT
 14600 136            B1SV   = B1
 14700 137            RMSSV  = RMS
 14800 138            NDEGSV = NDEG
 14900    C
 15100 139            DZMAX = ZFITLM(2)*3                                          MARK HITS OUTSIDE 3 SIGMA DISTANCE
 15200 140            PERFORM MKBDHT
 15300 143            XREPEAT
 15400 144         CIF
 15500 145         NITER = NITER + 1
 15600 146      UNTIL NITER.GE.1
 15700    C
 15900 147      IF(RMS.GT.ZFITLM(1) .OR. NDEG.LT.6) IERRLB = LOR(IERRLB,128)
 16000    C
 16200 152      IWRK(HPTR0+28) = 1                                                 SAVE RESULTS IN WRK
 16300 153      WRK (HPTR0+29) = B1SV
 16400 154      WRK (HPTR0+30) = A1SV
 16500 155      WRK (HPTR0+31) = RMSSV
 16600 156      IWRK(HPTR0+32) = NDEGSV+2
 16700 157      IWRK(HPTR0+47) = LOR(IWRK(HPTR0+47),IERRLB)
 16800    C     PRINT 2000, NDEGSV,ZW1,ZW2,B1SV,A1SV,RMSSV
 16900    C       PERFORM PRINT
 17000    C
 17100 158      RETURN
 17200    C
 17300                                                                             ***************************
 17400                                                                             *      M K B D H T        *
 17600    C                                                                        ***************************
 17800 159      PROC MKBDHT                                                        MARK BAD HITS
 17900    C
 18000 160         NBAD = 0
 18100 161         NGOOD = 0
 18200 162         FOR IPHIT = HPHT0,HPHT9,HLDHT
 18300 163            IF IWRK(IPHIT+7).LE.8
 18400 164            THEN
 18500 167               R1 = WRK(IPHIT+6)
 18600 168               Z1 = WRK(IPHIT+5)
 18700 169               ZF = R1*B1 + A1
 18800 170               DZ = Z1 - ZF
 18900 171               IF ABS(DZ).GT.DZMAX
 19100 172               THEN                                                      MARK BAD AND GOOD HITS
 19200 175                  NBAD = NBAD + 1
 19300 176                  IWRK(IPHIT+7) = 1
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  5
0CARD TARGET
  NO  STM.NO
 
 19400 177               ELSE
 19600 179                  NGOOD = NGOOD + 1                                      COUNT HITS THAT CAN BE USED
 19700 180                  IWRK(IPHIT+7) = 0
 19800 181               CIF
 19900 182            CIF
 20000 183         CFOR
 20100    C
 20300 185         IF NGOOD.LT.LMZFIT(3)                                           DELETE BAD HIT LABELS IF NOT ENOUGH HITS LEFT
 20400 186         THEN
 20500 189            FOR IP1 = IP0,IP9,IDP
 20600 190               IWRK(IP1+7) = LAND(IWRK(IP1+7),14)
 20700    C         WRK(IP1+7) = BITOFF(WRK(IP1+7),31)
 20800 191            CFOR
 20900 193            NBAD = 0
 21000 194         CIF
 21100    C
 21200 195      CPROC
 21300    C
 21400                                                                             ***************************
 21500                                                                             *      M K P T H T        *
 21700    C                                                                        ***************************
 21900 197      PROC MKPTHT                                                        MARK PATROL-HITS
 22000    C
 22100 198         NBAD = 0
 22200 199         NGOOD = 0
 22300 200         FOR IPHIT = HPHT0,HPHT9,HLDHT
 22400 201            IF IWRK(IPHIT+7).LT.4
 22500 202            THEN
 22600 205               IF IABS(IWRK(IPHIT+8)).GE.1000
 22800 206               THEN                                                      MARK BAD AND GOOD HITS
 22900 209                  NBAD = NBAD + 1
 23000 210                  IWRK(IPHIT+7) = LOR(IWRK(IPHIT+7),4)
 23100 211               ELSE
 23300 213                  NGOOD = NGOOD + 1                                      COUNT HITS THAT CAN BE USED
 23400 214                  IWRK(IPHIT+7) = 0
 23500 215               CIF
 23600 216            CIF
 23700 217         CFOR
 23800 219      CPROC
 23900    C
 24000                                                                             ***************************
 24100                                                                             *      L I N F I T        *
 24300    C                                                                        ***************************
 24500 221      PROC LINFIT                                                        FIT LINE TO R-Z COORDINATES
 24600    C
 24700 222         IHIT = 0
 24800 223         SUM(1) = 0.
 24900 224         SUM(2) = 0.
 25000 225         SUM(3) = 0.
 25100 226         SUM(4) = 0.
 25200 227         SUM(5) = 0.
 25300 228         FOR IPHIT = IP0,IP9,IDP
 25400 229            IF IWRK(IPHIT+7).EQ.0
 25500 230            THEN
 25600 233               IHIT =  IHIT + 1
 25700 234               R1 = WRK(IPHIT+6) - R0
 25800 235               Z1 = WRK(IPHIT+5) - Z0
 25900 236               SUM( 1) = SUM( 1) + R1
 26000 237               SUM( 2) = SUM( 2) + R1**2
 26100 238               SUM( 3) = SUM( 3) + Z1
 26200 239               SUM( 4) = SUM( 4) + Z1**2
 26300 240               SUM( 5) = SUM( 5) + R1*Z1
 26400 241            CIF
 26500 242         CFOR
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  6
0CARD TARGET
  NO  STM.NO
 
 26600 244         ANHIT= IHIT
 26700 245         NDEG = IHIT - 2
 26800 246         IF NDEG.GT.0
 26900 247         THEN
 27000 250            ZW1  = (SUM(5)*ANHIT - SUM(1)*SUM(3))
 27100 251            ZW2  = (SUM(2)*ANHIT - SUM(1)**2)
 27200 252            B1   = ZW1 / ZW2
 27300 253            A1   =(SUM(3) - B1*SUM(1)) / ANHIT + Z0 - B1*R0
 27400 254            CHSQ = SUM(4)*ANHIT - SUM(3)**2 - ZW1**2/ZW2
 27500 255            RMS  = CHSQ / (IHIT*NDEG)
 27600 256            IF(RMS.GT.0) RMS = SQRT(RMS)
 27700 258         ELSE
 27800 260            B1   = 0.
 27900 261            A1   = 0.
 28000 262            RMS  = 1000000.
 28100 263         CIF
 28200    C     IF LBPR.NE.0
 28300    C     THEN
 28400    C       PERFORM PRINT
 28500    C     CIF
 28600 264      CPROC
 28700    C
 28800                                                                             ***************************
 28900                                                                             *      Z S T R T 2        *
 29100    C                                                                        ***************************
 29200 266      PROC ZSTRT2
 29400    C                                                                        CHECK POINTS BEFORE MAKING THE FIRST FIT
 29600    C                                                                        MARK BAD HITS WITH NO CLOSE ADJACENT ONES
 29700 267         SIGL2 = ZFITLM(2)*2.
 29800 268         SIGL4 = ZFITLM(2)*3.5
 29900 269         NHIT  = 0
 30000 270         IP10  = 0
 30100 271         IP3   = IP0
 30200 272         REPEAT
 30300 273            IF IWRK(IP3+ 7).EQ. 0
 30400 274            THEN
 30600 277               IF(IP10.LE.0) IP10 = IP3                                  POINTER TO 1. USEFUL POINT
 30800 279               NHIT = NHIT + 1                                           INITIALIZE BAD HIT LABEL
 30900 280               IF NHIT.EQ.1
 31100 281               THEN                                                      1. HIT
 31200 284                  R1 = WRK(IP3+6)
 31300 285                  Z1 = WRK(IP3+5)
 31400 286                  IP1 = IP3
 31500 287               ELSE
 31600 289                  IF NHIT.EQ.2
 31800 290                  THEN                                                   2. HIT
 31900 293                     R2 = WRK(IP3+6)
 32000 294                     Z2 = WRK(IP3+5)
 32100 295                     IP2 = IP3
 32200 296                  ELSE
 32400 298                     R3 = WRK(IP3+6)                                     3. HIT
 32500 299                     Z3 = WRK(IP3+5)
 32700 300                     DR31 = R3-R1                                        DEVIATION OF CENTRAL POINT FROM STRAIGHT LINE
 32800 301                     DELT = 0.
 32900 302                     IF(ABS(DR31).GT.15.) DELT = Z2-Z1 - (R2-R1)*(Z3-Z1)/DR31
 33000 304                     IF(ABS(DELT).GT.SIGL4) IWRK(IP2+7) = 4
 33100 306                     IF ABS(DELT).GT.SIGL2
 33200 307                     THEN
 33300 310                        IF(IP1.EQ.IP0) IWRK(IP1+7) = 4
 33400 312                        IF(IP3.EQ.IP8) IWRK(IP3+7) = 4
 33500 314                     CIF
 33600 315                     R1 = R2
 33700 316                     R2 = R3
 33800 317                     Z1 = Z2
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  7
0CARD TARGET
  NO  STM.NO
 
 33900 318                     Z2 = Z3
 34000 319                     IP1 = IP2
 34100 320                     IP2 = IP3
 34200 321                  CIF
 34300 322               CIF
 34400 323            CIF
 34500 324            IP3 = IP3 + IDP
 34600 325         UNTIL IP3.GT.IP9
 34800 326         IP90 = IP2                                                      LAST USEFUL POINT
 34900    C
 35000                                                                             CROSS CHECK REJECTED HITS
 35200 330         IP1 = IP10                                                      POINTER TO 1. GOOD HIT
 35400 331         IP2 = 0                                                         SEARCH 2. GOOD HIT
 35500 332         IP3 = IP1
 35600 333         REPEAT
 35700 334            IP3 = IP3 + IDP
 35800 335            IF IWRK(IP3+ 7).LE.4
 35900 336            THEN
 36100 339               IP2 = IP3                                                 COUNT GOOD HITS
 36200 340               XREPEAT
 36300 341            CIF
 36400 342         UNTIL IP3.EQ.IP9
 36500 343         IF IP2.LE.0
 36600 347         THEN
 36700 350            NHIT = 0
 36900 351         ELSE                                                            LOOP OVER REMAINING HITS
 37000 353            REPEAT
 37100 354               IP3 = IP3 + IDP
 37200 355               IF IWRK(IP3+ 7).LE.4
 37300 356               THEN
 37400 359                  IF IWRK(IP3+7).EQ.4 .OR. IWRK(IP1+7).EQ.4
 37500 360                  THEN
 37600 363                     R1 = WRK(IP1+6)
 37700 364                     Z1 = WRK(IP1+5)
 37800 365                     R2 = WRK(IP2+6)
 37900 366                     Z2 = WRK(IP2+5)
 38000 367                     R3 = WRK(IP3+6)
 38100 368                     Z3 = WRK(IP3+5)
 38300 369                     DR31 = R3-R1                                        DEVIATION OF CENTRAL POINT FROM STRAIGHT LINE
 38400 370                     DELT = 1000000.
 38500 371                     IF(ABS(DR31).GT.15.) DELT = Z2-Z1 - (R2-R1)*(Z3-Z1)/DR31
 38600 373                     IF ABS(DELT).LT.SIGL2
 38700 374                     THEN
 38900 377                        IWRK(IP1+7) = 0                                  MARK 1. + 3. HIT AS BEEING GOOD
 39000 378                        IWRK(IP3+7) = 0
 39100 379                     CIF
 39200 380                  CIF
 39300 381                  IP1 = IP2
 39400 382                  IP2 = IP3
 39500 383               CIF
 39600 384            UNTIL IP3.GE.IP90
 39800 385            NHIT = 0                                                     COUNT GOOD HITS
 39900 389            FOR IP1=IP0,IP9,IDP
 40000 390               IF(IWRK(IP1+7).EQ.0) NHIT = NHIT + 1
 40100 392            CFOR
 40200 394         CIF
 40300    C
 40500 395         IF NHIT.LT.LMZFIT(3)                                            DELETE BAD HIT LABELS IF NOT ENOUGH HITS LEFT
 40600 396         THEN
 40700 399            FOR IP1 = IP0,IP9,IDP
 40800 400               IWRK(IP1+7) = LAND(IWRK(IP1+7),11)
 40900    C         WRK(IP1+7) = BITOFF(WRK(IP1+7),29)
 41000 401            CFOR
 41100 403         CIF
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  8
0CARD TARGET
  NO  STM.NO
 
 41200    C
 41300 404      CPROC
 41400    C
 41500                                                                             ***************************
 41600                                                                             *      Z S T R T 1        *
 41800    C                                                                        ***************************
 42000 406      PROC ZSTRT1                                                        CHECK POINTS BEFORE MAKING THE FIRST FIT
 42100    C
 42300    C                                                                        FIND INTERSEPT WITH Z-AXIS
 42400    C
 42600 407         FOR I = 1,NBINZ                                                 ZERO HISTOGRAM
 42700 408            HIST(I) = 0
 42800 409         CFOR
 43000 411         AVRAD  = 0.                                                     AVERAGE RADIUS
 43100 412         NAVRAD = 0
 43300 413         IP91 = IP9 - IDP                                                LOOP OVER ALL PAIRS OF HITS
 43400 414         Z0HIST = -7000.
 43500 415         DZHIST = 70.
 43600 416         FOR IPHIT = IP0,IP91,IDP
 43700 417            IF IWRK(IPHIT+7).EQ.0
 43800 418            THEN
 44000 421               R1 = WRK(IPHIT+6)                                         1. HIT
 44100 422               AVRAD  = R1 + AVRAD
 44200 423               NAVRAD =  1 + NAVRAD
 44300 424               Z1 = WRK(IPHIT+5)
 44400 425               IP1 = IPHIT + IDP
 44500 426               FOR IPHIT2 = IP1,IP9,IDP
 44600 427                  IF IWRK(IPHIT2+7).EQ.0
 44700 428                  THEN
 44900 431                     R2 = WRK(IPHIT2+6)                                  2. HIT
 45000 432                     Z2 = WRK(IPHIT2+5)
 45100 433                     IF ABS(R1-R2).GT.ZFITLM(6)
 45200 434                     THEN
 45400 437                        ZCON = (Z1*R2 - R1*Z2)/(R2-R1)                   Z-INTERSEPT
 45500 438                        IZV = (ZCON - Z0HIST) / DZHIST + 1
 45600 439                        IF IZV.GT.0 .AND. IZV.LE.NBINZ
 45700 440                        THEN
 45900 443                           HIST(IZV) = HIST(IZV) + 1                     HISTOGRAM INTERSEPT
 46000 444                        CIF
 46100 445                     CIF
 46200 446                  CIF
 46300 447               CFOR
 46400 449            CIF
 46500 450         CFOR
 46600    C
 46800 452         PERFORM HEVAL                                                   FIND PEAK IN HISTOGRAM
 47000 455         ZVTX = ZPEAK                                                    Z(VERTEX)
 47100    C
 47300    C                                                                        DETERMINE SLOPE OF TRACK
 47400    C
 47600 456         IF INDLB.GT.0                                                   CHECK IF VERTEX FOUND
 47700 457         THEN
 47900 460            FOR I = 1,NBINZ                                              ZERO HISTOGRAM
 48000 461               HIST(I) = 0
 48100 462            CFOR
 48300 464            IF(NAVRAD.GT.0) AVRAD = AVRAD / NAVRAD                       AVERAGE RADIUS
 48500 466            Z0HIST = -3000.                                              PARAMETERS OF HISTOGRAM
 48600 467            DZHIST = 30.
 48800 468            FOR IPHIT = IP0,IP9,IDP                                      LOOP OVER ALL HITS
 48900 469               IF IWRK(IPHIT+7).LE.4
 49000 470               THEN
 49100 473                  IWRK(IPHIT+7) = 0
 49300 474                  ZCON = (WRK(IPHIT+5) - ZVTX) * AVRAD/WRK(IPHIT+6)      PROJECTION ON LINE OF AVER. RADIUS
 49400 475                  IZV  = (ZCON - Z0HIST) / DZHIST + 1
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  9
0CARD TARGET
  NO  STM.NO
 
 49500 476                  IF IZV.GT.0 .AND. IZV.LE.NBINZ
 49600 477                  THEN
 49800 480                     HIST(IZV) = HIST(IZV) + 1                           HISTOGRAM Z-PROJECTION
 49900 481                  CIF
 50000 482               CIF
 50100 483            CFOR
 50200    C
 50400 485            PERFORM HEVAL                                                FIND PEAK IN HISTOGRAM
 50600 488            IF INDLB.GT.0                                                CHECK IF PEAK FOUND
 50700 489            THEN
 50900 492               ZPRO = ZPEAK                                              SLOPE OF TRACK
 51000 493               SLOPE = ZPRO / AVRAD
 51100    C
 51300 494               SIG0 = ZFITLM(2)*4.                                       MARK HITS OUTSIDE 4 SIGMA
 51400 495               NHIT = 0
 51500 496               NBAD = 0
 51600 497               FOR IPHIT = IP0,IP9,IDP
 51700 498                  IF IWRK(IPHIT+7).LE.0
 51800 499                  THEN
 51900 502                     NHIT = NHIT + 1
 52000 503                     DZ = WRK(IPHIT+6)*SLOPE + ZVTX - WRK(IPHIT+5)
 52100 504                     IF ABS(DZ).GT.SIG0
 52200 505                     THEN
 52300 508                        NBAD = NBAD + 1
 52400 509                        IWRK(IPHIT+7) = LOR(IWRK(IPHIT+7),4)
 52500 510                     CIF
 52600 511                  CIF
 52700 512               CFOR
 52800    C
 53000 514               NHIT = NHIT - NBAD                                        DELETE BAD HIT LABELS IF NOT ENOUGH HITS LEFT
 53100 515               IF NHIT.LT.LMZFIT(3)
 53200 516               THEN
 53300 519                  FOR IPHIT = IP0,IP9,IDP
 53400 520                     IWRK(IPHIT+7) = LAND(IWRK(IPHIT+7),11)
 53500    C             WRK(IPHIT+7) = BITOFF(WRK(IPHIT+7),29)
 53600 521                  CFOR
 53700 523               CIF
 53800    C
 53900 524            CIF
 54000 525         CIF
 54100 526      CPROC
 54200    C
 54300                                                                             ***************************
 54400                                                                             *      H E V A L          *
 54600    C                                                                        ***************************
 54800 528      PROC HEVAL                                                         FIND BIN WITH MAX.CONTENT
 54900    C
 55100 529         NPEAK = 0                                                       FIND PEAK
 55200 530         IH9 = NBINZ-11
 55300 531         FOR IH=7,IH9
 55400 532            IHSUM = HIST(IH  )+HIST(IH+1)+HIST(IH+2)+HIST(IH+3)+HIST(IH+4)
 55500 533            IF IHSUM.GT.NPEAK
 55600 534            THEN
 55800 537               NPEAK = IHSUM                                             MEMORIZE PEAK
 55900 538               HPEAK = IH
 56000 539            CIF
 56100 540         CFOR
 56200 542         PEAK = NPEAK
 56300 543         INDLB =-1
 56400 544         IF NPEAK.GE.NPKMIN
 56500 545         THEN
 56700 548            INDLB = 1                                                    PEAK OK ... CALC. BACKGROUND
 56800 549            H1 = HPEAK - 7
 56900 550            H2 = HPEAK + 7
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE 10
0CARD TARGET
  NO  STM.NO
 
 57000 551            NBACK = HIST(H1  )+HIST(H1+1)+HIST(H1+2)+HIST(H1+3)+HIST(H1+4)
 57100         +      + HIST(H2  )+HIST(H2+1)+HIST(H2+2)+HIST(H2+3)+HIST(H2+4)
 57200 552            BACK = .5 * NBACK
 57400 553            IF(BACK*SBRAT.GT.PEAK) INDLB = 0                             BACKGROUND LOW ENOUGH ... SET IZRSLT(6) = 1
 57500    C
 57700 555            ZV = HIST(HPEAK+1)   + HIST(HPEAK+2)*2                       CALC. ACCURATE PEAK POS.
 57800         +      + HIST(HPEAK+3)*3 + HIST(HPEAK+4)*4
 57900 556            ZV = ZV / PEAK
 58000 557            DZ = HIST(HPEAK  )*(ZV   )**2 + HIST(HPEAK+1)*(ZV-1.)**2
 58100         +      + HIST(HPEAK+2)*(ZV-2.)**2 + HIST(HPEAK+3)*(ZV-3.)**2
 58200         +      + HIST(HPEAK+4)*(ZV-4.)**2
 58300 558            DZ = DZ * DZHIST**2 / PEAK
 58400 559            DZ = SQRT(DZ)
 58500 560            ZPEAK     = Z0HIST + (HPEAK+ZV-.5)*DZHIST
 58600    C     PRINT 2004, HIST
 58700    C     PRINT 2005, INDLB,HPEAK,H1,H2,ZPEAK,DZ,PEAK,BACK
 58800    C2004 FORMAT(1H0,40I3)
 58900    C2005 FORMAT(1H0,4I6,4F8.1)
 59000 561         CIF
 59100 562      CPROC
 59200    C
 59300                                                                             ***************************
 59400                                                                             *      P R I N T          *
 59600    C                                                                        ***************************
 59800    C     PROC PRINT                                                         PRINTOUT OF HIT-ARRAY
 59900    C
 60000    C       DATA NPR /0/
 60100    C       IF NPR.LE. 30
 60200    C       THEN
 60300    C       NPR = NPR + 1
 60400    C         WRITE(6,2992) HHEADR(17),HHEADR(18),HHEADR(19)
 60500    C         PRINT 2000, NHIT,ZW1,ZW2,B1,A1,RMS,CHSQ
 60600    C         PRINT 2000, NDEG,SUM(1),SUM(2),SUM(3),SUM(4),SUM(5)
 60700    C         FOR IPHT=HPHT0,HPHT9,HLDHT
 60800    C         I0 = IPHT
 60900    C         I9 = IPHT - 1 + HLDHT
 61000    C         PRINT 2001,(WRK(I1),I1=I0,I9)
 61100    C2992 FORMAT('0MESSAGE FOR P.STEFFEN: ERROR IN ZRFIT; EVENT:',3I6)
 61200    C2000 FORMAT(1H ,I4,9E13.5)
 61300    C2001 FORMAT(1H ,3I4,4F8.2,5I6,5F8.2,2I2)
 61400    C         CFOR
 61500    C       CIF
 61600    C     CPROC
 61700    C
 61800 564      END
0END OF SEGMENT
0  OPTIONS IN EFFECT - LINECOUNT=64,LINEWIDTH=131,  SOURCE,  FORTRAN  NUMBERING
0   0 ERRORS           0 WARNINGS         563 TARGET STATEMENTS
1VERSION 1 (MAR 81 )                    SHELTRAN                        PAGE  1
0CARD TARGET
  NO  STM.NO
 
0END OF PROGRAM
0  OPTIONS IN EFFECT - LINECOUNT=64,LINEWIDTH=131,  SOURCE,  FORTRAN  NUMBERING
0   0 ERRORS           0 WARNINGS         563 TARGET STATEMENTS
