C   20/03/97            MEMBER NAME  JEOSUM5  (PATRECSR)    SHELTRAN
C   26/06/87 712141919  MEMBER NAME  ADPATR   (S)           FORTRAN77
      SUBROUTINE ADPATR( NRUN )
C-----------------------------------------------------------
C   VERSION OF 26/06/87     LAST MOD 08/12/87   E ELSEN
C   ADJUST RUN DEPENDENT PATREC LIMITS
C-----------------------------------------------------------
      IMPLICIT INTEGER*2 (H)
#include "cpatlm.for"
      COMMON /BCS/ HW(1)
      INTEGER IW(1)
      EQUIVALENCE (IW(1),HW(1))
      INTEGER IPHEAD / 0 /
C
      IF( IPHEAD .LE. 0 ) IPHEAD = IBLN('HEAD')
      NPHEAD = IW(IPHEAD)
C
      IF( NRUN .GE. 24200 .OR.
     *  ( NRUN .LT. 100 .AND. HW(NPHEAD*2+8) .GT. 1985 ) ) THEN
        FLINLM(2) = 1.0
        GFP(3) = 2.0
        ZFITLM(1) = 70.
        ZFITLM(2) = 40.
      ELSE
        FLINLM(2) = 3.0
        GFP(3) = 4.5
        ZFITLM(1) = 50.
        ZFITLM(2) = 20.
      ENDIF
      END
C   26/06/87 707201014  MEMBER NAME  ADPATR0  (S)           FORTRAN77
      SUBROUTINE ADPATR( NRUN )
C-----------------------------------------------------------
C   VERSION OF 26/06/87     LAST MOD 26/06/87   E ELSEN
C   ADJUST RUN DEPENDENT PATREC LIMITS
C-----------------------------------------------------------
#include "cpatlm.for"
C
      IF( NRUN .GE. 24200 ) THEN
        FLINLM(2) = 1.0
        GFP(3) = 2.0
        ZFITLM(1) = 70.
        ZFITLM(2) = 40.
      ELSE
        FLINLM(2) = 3.0
        GFP(3) = 4.5
        ZFITLM(1) = 50.
        ZFITLM(2) = 20.
      ENDIF
      END
C   12/03/81 701121325  MEMBER NAME  DEADCL   (PATRECSR)    FORTRAN
C
      LOGICAL FUNCTION DEADCL(ICELL,NRUN)
C
C     LAST UPDATE :   26/04/80
C     LAST UPDATE :   04/11/80
C     LAST UPDATE :   01/03/81
C     LAST UPDATE :   11/03/81
C     LAST UPDATE :   09/01/87  E ELSEN
C     FUNCTION DEADCL COPES WITH FADC DATA BY CALLING DDC300
C     FUNCTION DEADCL NOW RUN# DEPENDENT
C
C     FUNCTION DEADCL ACCEPTS ONLY CELLNUMBERS BETWEEN 1 AND 96 INCL.
C     FUNCTION DEADCL RETURNS .TRUE.  IF THE CELL 'ICELL' IS DEAD
C     FUNCTION DEADCL RETURNS .FALSE. IF THE CELL 'ICELL' IS STILL ALIVE
C     FUNCTION DEADCL NOW ALSO APPLICABLE FOR MC-DATA:   MC INPUT IS
C                            READ IN FROM COMMON /CRDSTA/ AT EACH EVENT
C-----------------------------------------------------------------------
      INTEGER*2 HITD,HCELLD
      LOGICAL IC(96),LC(96),LCS(96)
      COMMON / CRDSTA / NDEAD, NCDEAD, HITD(10), HCELLD(10)
      EXTERNAL RDMTCO
      LOGICAL DDC300
C
      DATA MERR/0/
      DATA   IC /
     ,  .FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,
     ,  .FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,
     ,  .TRUE. ,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,
     ,  .FALSE.,.FALSE.,.FALSE.,.TRUE. ,.FALSE.,.FALSE.,.FALSE.,.FALSE.,
     ,  .FALSE.,.FALSE.,.FALSE.,.FALSE.,.TRUE. ,.FALSE.,.FALSE.,.FALSE.,
     ,  .FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,
     ,  .FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,
     ,  .FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,
     ,  .TRUE. ,.TRUE. ,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,
     ,  .FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,
     ,  .TRUE. ,.TRUE. ,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,
     ,  .FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE./
C
C                                      --- CHECK CELL NUMBER ---
  100 IF (ICELL.GE.1.AND.ICELL.LE.96) GOTO 110
      DEADCL = .TRUE.
      MERR = MERR + 1
      IF (MERR.LT.100) PRINT 6000, ICELL
 6000 FORMAT(' ********** ILLEGAL CELL NUMBER',I10,' FOUND **********')
      RETURN
C
C                                      --- CHECK RUN NUMBER ---
  110 IF (NRUN.LE.100) GOTO 300
C
C                                      --- REAL DATA ---
      DATA NCA /0/
      IF (NCA.EQ.0) PRINT 6101
 6101 FORMAT('0---->  DEADCL FUNCTION  <----  LAST UPDATE 12/01/87'/' ')
      NCA = NCA + 1
C
  112 IF (NRUN.LT.24200) GOTO 113
        DEADCL = DDC300( ICELL )
        RETURN
C
  113 IF (NRUN.LT.6286) GOTO 114
      DEADCL = .FALSE.
      RETURN
C
  114 IF (NRUN.LT.5800) GOTO 115
      DEADCL = .FALSE.
      IF (ICELL.EQ.65 .OR. ICELL.EQ.66) DEADCL = .TRUE.
      RETURN
C
  115 IF (NRUN.LT.5548) GOTO 120
      DEADCL = IC(ICELL)
      RETURN
C                                      --- OLD RUNS ---
  120 CALL UCOPY(IC(1),LC(1),96)
      IF (NRUN.NE.5547) GOTO 190
      DO 180 J=25,48
  180 LC(J) = .TRUE.
      GOTO 200
  190 LC(28) = .FALSE.
      IF (NRUN.GE.3311) GOTO 200
      LC(73) = .TRUE.
      LC(74) = .TRUE.
      IF (NRUN.GE.2789) GOTO 200
      LC(81) = .FALSE.
      LC(82) = .FALSE.
      IF (NRUN.GE.2776) GOTO 200
      LC(65) = .FALSE.
      LC(66) = .FALSE.
      IF (NRUN.GE.2745) GOTO 200
      LC(73) = .FALSE.
      LC(74) = .FALSE.
      IF (NRUN.GE.2304) GOTO 200
      LC(37) = .FALSE.
  200 DEADCL = LC(ICELL)
      RETURN
C
C                                      --- MONTE CARLO DATA ---
  300 CONTINUE
      DATA NCALL / 0 /
      NCALL = NCALL + 1
      DO 310 J=1,96
  310 LC(J) = .FALSE.
C                                      --- READ DEAD CELLS FROM /CRDSTA/
      MCDEAD = 0
      IF (NCDEAD.LE.0 .OR. NCDEAD.GT.10) GOTO 330
      MCDEAD = NCDEAD
      DO 320 K=1,NCDEAD
      KC = HCELLD(K)
      IF (KC.LE.0 .OR. KC.GT.96) GOTO 320
      LC(KC) = .TRUE.
  320 CONTINUE
C                                       --- AT 1. CALL:
C                                           PRINT DEAD CELL STATUS ---
  330 IF (NCALL.GT.1) GOTO 340
      PRINT 6600
      IF (MCDEAD.EQ.0) PRINT 6601
      IF (MCDEAD.NE.0) PRINT 6602, MCDEAD,(HCELLD(IPR),IPR=1,MCDEAD)
      PRINT 6603
 6600 FORMAT('0',16('DEADCELL'),'DEAD'/'       LOGICAL FUNCTION ',
     ,       '  D E A D C L   CALLED FOR MONTE CARLO DATA')
 6601 FORMAT('       NO DEAD CELLS FOUND IN COMMON/CRDSTA/')
 6602 FORMAT(' ',6X,I2,' DEAD CELLS FOUND IN COMMON/CRDSTA/ :',10I4)
 6603 FORMAT('       NO FURTHER CELLS SET TO <DEAD>'/
     ,       ' ',16('CELLDEAD'),'CELL'/' ')
      IF (NCALL.NE.1) GOTO 350
C
      DO 335 J=1,96
  335 LCS(J) = LC(J)
      GOTO 350
C                                      --- AT ALL LATER CALLS:
C                                          CHECK STATUS OF DEAD CELLS --
  340 ICHECK = 0
      DO 345 J=1,96
  345 ICHECK = ICHECK + LXOR(LC(J),LCS(J))
      IF (ICHECK.EQ.0) GOTO 350
C                                       --- PRINT NEW STATUS ---
      PRINT 6604
 6604 FORMAT('0',16('DEADCELL'),'DEAD'/'       STATUS OF DEAD CELLS IN',
     ,       ' MONTE CARLO CHANGED, NEW STATUS IS:')
      PRINT 6602, MCDEAD,(HCELLD(IPR),IPR=1,MCDEAD)
      PRINT 6603
C
      DO 348 J=1,96
  348 LCS(J) = LC(J)
C                                      --- CHECK CHANGE OF DEAD CELLS --
  350 DEADCL = LC(ICELL)
C
      RETURN
      END
      LOGICAL FUNCTION DDC300( ICELL )
C-----------------------------------------------------------
C  VERSION OF 09/01/87    LAST MOD 09/01/87    E ELSEN
C  CHECK STATUS OF CELL ICELL ( RANGE 1:96 )
C  IF NO HITS ARE FOUND IN THE JETC BANK IN THAT CELL AND
C     THE HARDWARE TRIGGER BIT HIT-WALL IS ON THEN
C        DDC300 = .TRUE.        ( CELL IS LIKELY TO BE DEAD )
C  ELSE  DDC300 = .FALSE.
C  ENDIF
C-----------------------------------------------------------
      IMPLICIT INTEGER*2 (H)
      COMMON / BCS / IW(1)
      DIMENSION HW(1)
      EQUIVALENCE (HW(1),IW(1))
      INTEGER CELL, SECTOR, TRIG2W, BIT, BITPAT
      INTEGER ONE / 1 /
      LOGICAL FIRST / .TRUE. /
C
      IF( .NOT. FIRST ) GO TO 1
C       WRITE(6,9201)
C9201   FORMAT(' +++ DDC300 VERSION OF 09-01-87')
        IPJETC = IBLN('JETC')
        IPTRIG = IBLN('TRIG')
        FIRST = .FALSE.
    1 CONTINUE
C
      CELL = ICELL - 1
      DDC300 = .FALSE.
      NPJETC = IW(IPJETC)
      IF( NPJETC.LE.0 ) GO TO 8000
        IF( HW(NPJETC*2+CELL+4) -
     *      HW(NPJETC*2+CELL+3) .GT. 0 ) GO TO 8000
C                                           CELL HAS NO HITS
C                                           HAS THE T2 BIT BEEN SET?
          NPTRIG = IW(IPTRIG)
          IF( NPTRIG.LE.0 ) GO TO 8000
            IF( IW(NPTRIG-1).LE.0 .OR. IW(NPTRIG-2).EQ.2 ) GO TO 100
              NPTRIG = IW(NPTRIG-1)
  100         IF( IW(NPTRIG-2) .NE. 2 ) GO TO 8000
C                                           TRIG 2 IS THERE
                IF( CELL.LT.48 ) GO TO 1000
                  SECTOR = MOD( CELL, 48 )
                  TRIG2W = SECTOR/8*2 + 2
                  BIT = MOD( CELL, 8 ) * 2 + 16
                  GO TO 1100
 1000           CONTINUE
                  SECTOR = MOD( CELL, 24 )
                  TRIG2W = SECTOR/4*2 + 2
                  BIT = MOD( CELL, 4 ) * 2
                  IF( CELL.LT.24 ) BIT = BIT + 8
 1100           CONTINUE
                BITPAT = SHFTL( ONE, BIT )
                DDC300 = LAND( IW(NPTRIG+TRIG2W), BITPAT ) .NE. 0
 8000 CONTINUE
      RETURN
      END
C   12/03/81 104071458  MEMBER NAME  DEADCL0  (PATRECSR)    FORTRAN
C
      LOGICAL FUNCTION DEADCL(ICELL,NRUN)
C
C     LAST UPDATE :   26/04/80
C     LAST UPDATE :   04/11/80
C     LAST UPDATE :   01/03/81
C     LAST UPDATE :   11/03/81
C     FUNCTION DEADCL NOW RUN# DEPENDENT
C     FUNCTION DEADCL ACCEPTS ONLY CELLNUMBERS BETWEEN 1 AND 96 INCL.
C     FUNCTION DEADCL RETURNS .TRUE.  IF THE CELL 'ICELL' IS DEAD
C     FUNCTION DEADCL RETURNS .FALSE. IF THE CELL 'ICELL' IS STILL ALIVE
C     FUNCTION DEADCL NOW ALSO APPLICABLE FOR MC-DATA:   MC INPUT IS
C                            READ IN FROM COMMON /CRDSTA/ AT EACH EVENT
C-----------------------------------------------------------------------
      INTEGER*2 HITD,HCELLD
      LOGICAL IC(96),LC(96),LCS(96)
      COMMON / CRDSTA / NDEAD, NCDEAD, HITD(10), HCELLD(10)
      EXTERNAL RDMTCO
C
      DATA MERR/0/
      DATA   IC /
     ,  .FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,
     ,  .FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,
     ,  .TRUE. ,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,
     ,  .FALSE.,.FALSE.,.FALSE.,.TRUE. ,.FALSE.,.FALSE.,.FALSE.,.FALSE.,
     ,  .FALSE.,.FALSE.,.FALSE.,.FALSE.,.TRUE. ,.FALSE.,.FALSE.,.FALSE.,
     ,  .FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,
     ,  .FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,
     ,  .FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,
     ,  .TRUE. ,.TRUE. ,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,
     ,  .FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,
     ,  .TRUE. ,.TRUE. ,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,
     ,  .FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE./
C
C                                      --- CHECK CELL NUMBER ---
  100 IF (ICELL.GE.1.AND.ICELL.LE.96) GOTO 110
      DEADCL = .TRUE.
      MERR = MERR + 1
      IF (MERR.LT.100) PRINT 6000, ICELL
 6000 FORMAT(' ********** ILLEGAL CELL NUMBER',I10,' FOUND **********')
      RETURN
C
C                                      --- CHECK RUN NUMBER ---
  110 IF (NRUN.LE.100) GOTO 300
C
C                                      --- REAL DATA ---
      DATA NCA /0/
      IF (NCA.EQ.0) PRINT 6101
 6101 FORMAT('0---->  DEADCL FUNCTION  <----  LAST UPDATE 11/03/81'/' ')
      NCA = NCA + 1
C
  113 IF (NRUN.LT.6286) GOTO 114
      DEADCL = .FALSE.
      RETURN
C
  114 IF (NRUN.LT.5800) GOTO 115
      DEADCL = .FALSE.
      IF (ICELL.EQ.65 .OR. ICELL.EQ.66) DEADCL = .TRUE.
      RETURN
C
  115 IF (NRUN.LT.5548) GOTO 120
      DEADCL = IC(ICELL)
      RETURN
C                                      --- OLD RUNS ---
  120 CALL UCOPY(IC(1),LC(1),96)
      IF (NRUN.NE.5547) GOTO 190
      DO 180 J=25,48
  180 LC(J) = .TRUE.
      GOTO 200
  190 LC(28) = .FALSE.
      IF (NRUN.GE.3311) GOTO 200
      LC(73) = .TRUE.
      LC(74) = .TRUE.
      IF (NRUN.GE.2789) GOTO 200
      LC(81) = .FALSE.
      LC(82) = .FALSE.
      IF (NRUN.GE.2776) GOTO 200
      LC(65) = .FALSE.
      LC(66) = .FALSE.
      IF (NRUN.GE.2745) GOTO 200
      LC(73) = .FALSE.
      LC(74) = .FALSE.
      IF (NRUN.GE.2304) GOTO 200
      LC(37) = .FALSE.
  200 DEADCL = LC(ICELL)
      RETURN
C
C                                      --- MONTE CARLO DATA ---
  300 CONTINUE
      DATA NCALL / 0 /
      NCALL = NCALL + 1
      DO 310 J=1,96
  310 LC(J) = .FALSE.
C                                      --- READ DEAD CELLS FROM /CRDSTA/
      MCDEAD = 0
      IF (NCDEAD.LE.0 .OR. NCDEAD.GT.10) GOTO 330
      MCDEAD = NCDEAD
      DO 320 K=1,NCDEAD
      KC = HCELLD(K)
      IF (KC.LE.0 .OR. KC.GT.96) GOTO 320
      LC(KC) = .TRUE.
  320 CONTINUE
C                                       --- AT 1. CALL:
C                                           PRINT DEAD CELL STATUS ---
  330 IF (NCALL.GT.1) GOTO 340
      PRINT 6600
      IF (MCDEAD.EQ.0) PRINT 6601
      IF (MCDEAD.NE.0) PRINT 6602, MCDEAD,(HCELLD(IPR),IPR=1,MCDEAD)
      PRINT 6603
 6600 FORMAT('0',16('DEADCELL'),'DEAD'/'       LOGICAL FUNCTION ',
     ,       '  D E A D C L   CALLED FOR MONTE CARLO DATA')
 6601 FORMAT('       NO DEAD CELLS FOUND IN COMMON/CRDSTA/')
 6602 FORMAT(' ',6X,I2,' DEAD CELLS FOUND IN COMMON/CRDSTA/ :',10I4)
 6603 FORMAT('       NO FURTHER CELLS SET TO <DEAD>'/
     ,       ' ',16('CELLDEAD'),'CELL'/' ')
      IF (NCALL.NE.1) GOTO 350
C
      DO 335 J=1,96
  335 LCS(J) = LC(J)
      GOTO 350
C                                      --- AT ALL LATER CALLS:
C                                          CHECK STATUS OF DEAD CELLS --
  340 ICHECK = 0
      DO 345 J=1,96
  345 ICHECK = ICHECK + LXOR(LC(J),LCS(J))
      IF (ICHECK.EQ.0) GOTO 350
C                                       --- PRINT NEW STATUS ---
      PRINT 6604
 6604 FORMAT('0',16('DEADCELL'),'DEAD'/'       STATUS OF DEAD CELLS IN',
     ,       ' MONTE CARLO CHANGED, NEW STATUS IS:')
      PRINT 6602, MCDEAD,(HCELLD(IPR),IPR=1,MCDEAD)
      PRINT 6603
C
      DO 348 J=1,96
  348 LCS(J) = LC(J)
C                                      --- CHECK CHANGE OF DEAD CELLS --
  350 DEADCL = LC(ICELL)
C
      RETURN
      END
C   06/12/79 102191154  MEMBER NAME  ERRORM   (PATRECSR)    FORTRAN
      SUBROUTINE ERRORM(SUBR,NERROR,NT)
      IMPLICIT INTEGER*2(H)
      REAL*8 SUBR
      COMMON/CADMIN/IEVTP,NREC,NRWRIT,NRERR
      COMMON/CHEADR/HEAD(17),HRUN,HEV
#include "cpatlm.for"
C
C
C-----------------------------------------------------------------------
C
C         -------------- SUBROUTINE ERRORM  ------------------
C         --- G.F.PEARCE .. LAST UPDATE : 1200 ON  6/12/80 ---
C
C     THIS SUBROUTINE PRINTS OUT A SINGLE LINE ERROR MESSAGE
C     REQUIRED :
C     SUBR   = ALPHANUMERIC SUBROUTINE NAME (8 BYTES) IN WHICH ERROR
C              OCCURRED (E.G. 'XYFIT   ')
C     NERROR = ERROR IDENTIFICATION NUMBER
C     NT     = TRACK NUMBER ON WHICH ERROR OCCURED
C
C-----------------------------------------------------------------------
C
C
      IXYF(11) = IXYF(11) - 1
      IF(IXYF(11).LT.0)RETURN
      PRINT1,SUBR,NERROR,NREC,HRUN,HEV,NT
 1    FORMAT(1X,20('#'),A8,' ERROR MESSAGE ',I3
     #  ,'  RECORD/RUN/EVENT/TRACK =',4I6,1X,20('#'))
      IF(IXYF(11).EQ.0)PRINT2
 2    FORMAT(1X,20('$'),' ERRORM ERROR MESSAGES NOW SUSPENDED')
      RETURN
      END
C   08/12/80 308171157  MEMBER NAME  FXYZNC   (JADESR)      FORTRAN
      SUBROUTINE FXYZ(NT)
      IMPLICIT INTEGER*2 (H)
      LOGICAL TBIT
C
C
C-----------------------------------------------------------------------
C
C         -------------- SUBROUTINE FXYZ(NT) -----------------
C         ---- G.F.PEARCE .. LAST UPDATE : 1030 ON 31/10/80 ----
C
C     THIS SUBROUTINE CALCULATES THE COORDINATES IN REAL SPACE OF ALL
C     HITS ASSOCIATED BY THE TRACK RECOGNITION PROGRAM WITH A SINGLE
C     TRACK. THE SINGLE TRACK FOR WHICH THIS IS DONE IS DEFINED BY THE
C     USER ON INPUT BY THE NUMBER NT, THIS BEING THE NUMBER OF THE
C     TRACK IN THE OUTPUT COMMON FROM SUBROUTINE BACKTR.
C
C     THE RESULTS ARE PLACED IN THE ARRAY WRK IN COMMON/CWORK/.
C     HPHT0    = POINTER TO FIRST WORD OF FIRST HIT IN WRK.
C     HPHT9    = POINTER TO LAST WORD OF LAST HIT IN WRK.
C     HLDHT    = NUMBER OF 4-BYTE WORDS STORED PER HIT IN WRK.
C     HPHT0A   = POINTER TO FIRST WORD OF FIRST HIT FOR COORDINATES
C                CALCULATED USING THE OPPOSITE L/R SOLUTION.
C                IF BACKTRACE HAS UNAMBIGUOUSLY RESOLVED THE L/R SOLN
C                THEN NO REVERSED L/R SOLN IS COMPUTED AND THIS POINTER
C                IS SET NEGATIVE.
C     HPHT9A   = POINTER TO LAST WORD OF LAST HIT IN WRK FOR OPPOSITE
C                L/R SOLUTION. ONLY SET WHEN IDWRK(1) IS NOT NEGATIVE.
C     HPHTLM   = LOWEST ALLOWABLE HPHT0 (CORRESPONDING TO NHITMAX)
C
C-----------------------------------------------------------------------
C
C
      COMMON/CADMIN/IEVTP,NREC,NRWRIT,NRERR
      COMMON/CHEADR/HEAD(20)
C
#include "calibr.for"
C
#include "cdata.for"
#include "ccycp.for"
#include "cworkpr.for"
#include "cworkeq.for"
      COMMON / CJDRCH / RDEC(4),PSIIN(3),RINCR(3),FIRSTW(3),FSENSW(3),
     * RDEPTH,SWDEPL,YSUSPN,TIMDEL(2,3),ZMAX,ZOFFS,ZRESOL,ZNORM,ZAL,
     * ZSCAL,DRIDEV,DRICOS,DRISIN,PEDES,TZERO(3),
     * DRIROT(96,2),SINDRI(96,2),COSDRI(96,2),DRIVEL(96,2),T0FIX(3),
     * CAB(8)
C  TEMPORARY INSTALLMENT OF ARRAY T0FIX, WILL BE PERMANENT LATER
#include "cdsmax.for"
#include "cpatlm.for"
C
C-----------------------------------------------------------------------
C    EQUIVALENCE OUTPUT BANK TO ADWRK FOR EASE OF TRANSFER TO HIT BANK
C-----------------------------------------------------------------------
C
         EQUIVALENCE (ADWRK( 1),LAYER)
         EQUIVALENCE (ADWRK( 2),NH1)
         EQUIVALENCE (ADWRK( 3),NH)
         EQUIVALENCE (ADWRK( 4),XHIT1)
         EQUIVALENCE (ADWRK( 5),YHIT1)
         EQUIVALENCE (ADWRK( 6),ZHIT1)
         EQUIVALENCE (ADWRK( 7),RHIT1)
         EQUIVALENCE (ADWRK( 8),IERZRF)
         EQUIVALENCE (ADWRK( 9),NLMIDO)
         EQUIVALENCE (ADWRK(10),INCELL)
         EQUIVALENCE (ADWRK(11),IERXYF)
         EQUIVALENCE (ADWRK(12),BETA)
         EQUIVALENCE (ADWRK(13),INRING)
         EQUIVALENCE (ADWRK(14),CHIXYF)
C -- MASKS MK1 TO EXTRACT TRACK ELEMENT NUMBER FROM HIT LABEL
C --       MK2 TO EXTRACT WIRE CROSSING FLAG
C --       MK3 TO EXTRACT FLAG ON UNRESOLVED L/R SOLUTION IN BACKTRACE
C --       MK4 TO EXTRACT FLAG ON TEST TRACK ELEMENT.
         INTEGER*4 MK1/Z00FE/ , MK2/Z100/ , MK3/Z1000/ , MK4/Z20000/
         HPWRK(30) = NT
C
C        ----------------------
C        POINTER INITIALISATION
C        ----------------------
C
         HLDHT = 14
         LONG = HLDHT * 4
         MAXHT = 80
         INHIT = HPFREE + MAXHT * HLDHT
         IF (INHIT.LE.HPLAST) GOTO10
C ----- ERROR 1 --------- NOT ENOUGH SPACE IN CWORK
         CALL ERRORM('FXYZ    ',1,NT)
         INHIT = HPLAST
         MAXHT = (HPLAST-HPFREE)/HLDHT
         IF (MAXHT.GE.8) GOTO10
C ----- ERROR 2 --------- HAD TO ABANDON TRACK NT
         CALL ERRORM('FXYZ    ',2,NT)
         HPHT0 = 1
         HPHT9 = 1
         GOTO1600
 10      HPHT9 = INHIT - 1
         HPHTLM = HPFREE
         HPFREE = INHIT
C
C        -------------------------------
C        OPPOSITE L/R AMBIGUITY POINTERS
C        AMBIGUITY 1 AT TOP, 2 AT BOTTOM
C        ------------------------------
C
         INHIT2 = -1
         IW1 = HISTR(1,NT)
         IW1 = LBL(IABS(IW1))
         LRNOWN = LAND(IW1,MK3)
         IF (TBIT(IXYF(1),26)) LRNOWN = 0
         IF (LRNOWN.EQ.0) GOTO50
C
         HLDHTA = HLDHT
         MAXHT = MAXHT / 2
         INHIT2 = INHIT - MAXHT * HLDHT
         HPHT9A = INHIT2 - 1
C
 50      NHIT = 0
         CHIXYF = 0
         NL = HNREL(NT)
         IF (NL.GT.0) GOTO60
C ----- ERROR 3 --------- NO TRACK ELEMENTS FROM BACKTRACE
         CALL ERRORM('FXYZ    ',3,NT)
         GOTO1590
 60      NLLAST = - 1
         NRLAST = - 1
C
C
C---------------------------------------------------------------------
C   LOOP OVER EACH TRACK ELEMENT BELONGING TO THIS TRACK. FOR
C   EACH TRACK ELEMENT STORE ALL REQUIRED INFORMATION BEFORE LOOPING
C   OVER HITS.
C---------------------------------------------------------------------
C
C
 1140    CONTINUE
C
C        -------------------------------
C        POINTER TO TRACK ELEMENT IN
C        COMMON/MIDOUT/. THIS CARRIES A
C        +VE/-VE SIGN INDICATING A RIGHT/
C        LEFT SOLUTION FROM BACKTRACING
C        -------------------------------
C
         NLMIDO = HISTR(NL,NT)
         IF (NLMIDO.NE.0)GOTO1150
C ----- ERROR 4 --------- TRACK ELEMENT ZERO FROM BACKTRACE
         CALL ERRORM('FXYZ    ',4,NT)
         GOTO1580
 1150    ILMIDO = IABS(NLMIDO)
         LABEL = LBL(ILMIDO)
C
C        -------------------------------
C        IS THIS A TEST TRACK ELEMENT ?
C        -------------------------------
C
         IERXYF=LAND(LABEL,MK4)
         IF(IERXYF.NE.0)IERXYF=2
C
C        -------------------------------
C        CELL NUMBER AND RING NUMBER
C        -------------------------------
C
         INCELL = IPCL(ILMIDO)
         INRING = 1
         IF(INCELL.GT.24)INRING = 2
         IF(INCELL.GT.48)INRING = 3
C
C        -------------------------------
C        LEFT/RIGHT AMBIGUITY FLAG FOR
C        FIRST HIT ON TRACK ELEMENT
C        -------------------------------
C
         IF (NLMIDO.GT.0) GOTO1160
         LRFLAG = - 1
         LR12 = 1
         GOTO1170
 1160    LRFLAG = + 1
         LR12   = 2
C
C        -------------------------------
C        LBZRCR = LABEL FOR WIRE CROSSING
C        IWCRS  = FIRST WIRE # AFTER ELEMENT
C                 CROSSES WIRE BOUNDARY.
C        -------------------------------
C
 1170    LBZRCR = LAND(LABEL,MK2)
         IWCRS = ICRO(ILMIDO)
C
C        ------------------------------
C        LORENTZ ANGLE TRANSFORMATION
C        AND DRIFT VELOCITY
C        ------------------------------
C
         TRLORX = TRMATS(INCELL,1)
         TRLORY = TRMATC(INCELL,1)
         SINLOR = SINDRI(INCELL,1)
         COSLOR = COSDRI(INCELL,1)
         DRFVEL = DRIVEL(INCELL,1)
C
C        ----------------
C        ABERATION ARRAYS
C        ----------------
C
C
C        CORRECTION CONSTANTS FOR INCELL
         IPJCOR = ICALIB(5) + INCELL
         IPJCOS = IPJCOR + (LR12-1)*96
         CCST0  = ACALIB(IPJCOS     )
         CCST1  = ACALIB(IPJCOS+ 192)
         CCST2  = ACALIB(IPJCOS+ 384)
         CCST51 = ACALIB(IPJCOR+ 576) * 10.
         CCST61 = ACALIB(IPJCOR+ 768) * 10.
         CCST81 = ACALIB(IPJCOR+1152)
C
C        -------------------------------
C        RING RADIUS AND WIRE SEPARATION
C        -------------------------------
C
         R0  = FSENSW(INRING)
         DR0 = RINCR(INRING)
C
C        --------------------------------------
C        COMPUTE AVERAGE ANGLE OF TRACK TO WIRE
C        PLANE OVER THIS TRACK ELEMENT. USE THIS
C        ANGLE TO COMPUTE THE CORRECTION TO DRIFT
C        SPACE REQUIRED TO CENTRE DRIFT TIME ON
C        DRIFT CHARGE CENTRE.
C        ---------------------------------------
C
         DXWR = DR0 * COSLOR
         DYWR = DR0 * SINLOR
C        FIRST HALF OF HITS
         BETA  = ( LRFLAG * SL1(ILMIDO) - DYWR )
         BETA = SQRT( DXWR**2 + BETA**2 ) / DXWR
C        SECOND HALF OF HITS
         LAYERM = LRFLAG
         IF (IWCRS.NE.0) LAYERM = - LAYERM
         BETA2 = ( LAYERM * SL2(ILMIDO) - DYWR )
         BETA2 = SQRT( DXWR**2 + BETA2**2 ) / DXWR
         BETA = (BETA + BETA2) / 2
         IF (BETA.LT.1.0) BETA = 1.0
         IF (BETA.GT.1.1) BETA = 1.1
         TANBET=SQRT(BETA**2-1.)
         BETAM1 = BETA-1
C
C        -----------------------------------
C        WMID FOR FIELD DISTORTION ABERATION
C        -----------------------------------
C
         WMID=7.5+(DS1(ILMIDO)+DS2(ILMIDO))*SINLOR/40
C
C        -------------------------------
C        TRACK ELEMENT NUMBER AS STORED
C        IN HIT LABEL DATA BANK.
C        -------------------------------
C
         NLWANT = NTREL(ILMIDO)
C
C        ----------------------------
C        DIRECTION OF WIRE PLANE
C        AND DRIFT SPACE DIRECTION
C        ----------------------------
C
         IW1 = INCELL - 24*(INRING-1)
         IF (INRING.EQ.3) GOTO1180
         DXWR   = DIRWR1(IW1,1)
         DYWR   = DIRWR1(IW1,2)
         GOTO1190
 1180    DXWR   = DIRWR3(IW1,1)
         DYWR   = DIRWR3(IW1,2)
C
C        ------------------------------
C        WIRE STAGGERING ( +/- SWDEPL )
C        ------------------------------
C
 1190    DDXWR = + SWDEPL * DYWR
         DDYWR = - SWDEPL * DXWR
C
C
C----------------------------------------------------------------------
C   LOOP OVER ALL HITS FOR THIS CELL AND SEARCH FOR HITS BELONGING
C   TO THIS TRACK ELEMENT.
C----------------------------------------------------------------------
C
C         ----------------------------
C         DETERMINE POINTERS TO
C         HIT ARRAY AND HIT LABEL
C         ----------------------------
          NH0 = HPTSEC(INCELL)
          NH9 = HPTSEC(INCELL+1)-1
          IF (NH0.GT.0.AND.NH9.GT.0) GOTO1230
C ----- ERROR 6 --------- HPTSEC POINTER IS -VE
         CALL ERRORM('FXYZ    ',6,NT)
          GOTO1580
 1230     NH  = SHFTR((NH0-HPTSEC(1)),1) + HPHL0
          NH1 = NH0
C
C         ----------------------------
C         LOOP OVER HITS IN CELL
C         ACCEPT HITS ON NLWANT BUT
C         PROTECT AGAINST HIT APPEARING
C         ON SUCCESSIVE TRACK ELEMENTS.
C         ----------------------------
C
 1240     CONTINUE
          IW1 = HWRK(NH)
          IW2 = HWRK(NH+1)
          NL1 = SHFTR(LAND(IW1,MK1),1)
          NL2 = SHFTR(LAND(IW2,MK1),1)
          IF(NL1.NE.NLWANT.AND.NL2.NE.NLWANT)GOTO1570
C
C         ------------------------------
C         THIS HIT IS ON REQUIRED TREL
C         REVERSE L/R AMBIGUITY IF THIS
C         HIT CROSSES WIRE BOUNDARY
C         -----------------------------
C
          IWIRE = HDATA(NH1  )
          IWIRE = SHFTR(IWIRE,3)
          LAYER = LAND(IWIRE,15)
          IF(LBZRCR.EQ.0 .OR. LAYER.NE.IWCRS)GOTO1250
C
C         ---------------------
C         REVERSE L/R AMBIGUITY
C         ---------------------
C
          LRFLAG = - LRFLAG
          NLMIDO = - NLMIDO
          IPJCOS = IPJCOR + (2-LR12)*96
          CCST0  = ACALIB(IPJCOS     )
          CCST1  = ACALIB(IPJCOS+ 192)
          CCST2  = ACALIB(IPJCOS+ 384)
C
C         ------------------------------
C         REJECT THIS HIT IF IT WAS ALSO
C         ON THE PRECEDING TRACK ELEMENT
C         ------------------------------
C
 1250     IF(INRING.NE.NRLAST)GOTO1260
          IF(NL1.EQ.NLLAST.OR.NL2.EQ.NLLAST)GOTO1570
C
C         ------------------------------
C         LOAD DRIFT TIME AND Z AMPLIT.
C         ------------------------------
C
 1260     IAMPL=HDATA(NH1+1)
          IAMPR=HDATA(NH1+2)
          IDRIFT=HDATA(NH1+3)
C
C         -----------------------------
C         FLAG BAD Z-COORDINATE IF DRIFT
C         TIME FOR THIS HIT IS WITHIN
C         DOUBLE HIT RESLN. OF ANOTHER
C         HIT ON THIS LAYER.
C         -----------------------------
C
          IERZRF=0
CC--CC    CLOSEST HIT WITH LOWER DRIFT TIME
CC--CC    NH2=NH1-4
CC--CC    IF(NH2.LT.NH0)GOTO1270
CC--CC    IWIRE2=HDATA(NH2)
CC--CC    IWIRE2=SHFTR(IWIRE2,3)
CC--CC    IF(IWIRE2.NE.IWIRE)GOTO1270
CC--CC    NEARH2=IDRIFT-HDATA(NH2+3)
CC--CC    IF(IABS(NEARH2).LE.IXYF(18))IERZRF=16
CC--CC    CLOSEST HIT WITH HIGHER DRIFT TIME
C1270     NH3=NH1+4
CC--CC    IF(NH3.GT.NH9)GOTO1280
CC--CC    IWIRE3=HDATA(NH3)
CC--CC    IWIRE3=SHFTR(IWIRE3,3)
CC--CC    IF(IWIRE3.NE.IWIRE)GOTO1280
CC--CC    NEARH3=IDRIFT-HDATA(NH3+3)
CC--CC    IF(IABS(NEARH3).LE.IXYF(18))IERZRF=16
C
C         ------------------------
C         CREATE SPACE FOR NEW HIT
C         ------------------------
C
 1280     IF(NHIT.LT.MAXHT)GOTO1290
C ----- ERROR 5 --------- RAN OUT OF SPACE IN CWORK FOR TRACK NT
          CALLERRORM('FXYZ    ',5,NT)
          GOTO1590
 1290     NHIT=NHIT+1
          INHIT=INHIT-HLDHT
C
C-----------------------------------------------------------------------
C   COMPUTE (X,Y,Z,R) FOR THIS HIT AND STORE IN THE COORDINATE ARRAY WRK
C-----------------------------------------------------------------------
C
C         ------------
C         Z-COORDINATE
C         ------------
C
          IF(IAMPR.LE.0.OR.IAMPL.LE.0)GOTO1310
          ZHIT1=IAMPR+IAMPL
          ZHIT1=.5*ZAL*FLOAT(IAMPR-IAMPL)/ZHIT1
          GOTO1320
 1310     IERZRF=16
          ZHIT1=0.0
 1320     CONTINUE
C
C         -----------
C         WIRE RADIUS
C         -----------
C
          RWIRE=R0+LAYER*DR0
C
C         ----------------------------
C         CORRECTION FOR WIRE POSITION
C         AT Z=0 PERP. TO WIRE PLANE
C         ----------------------------
C
          DWIRE = CCST51*(LAYER-7.5) + CCST61
          DWIREX = + DWIRE * DYWR
          DWIREY = + DWIRE * DXWR
C
C         ----------------
C         WIRE COORDINATES
C         ----------------
C
          ISTAG=-1
          IF(TBIT(LAYER,31))ISTAG=+1
          DX1=RWIRE*DXWR+ISTAG*DDXWR+DWIREX
          DY1=RWIRE*DYWR+ISTAG*DDYWR-DWIREY
C
C         --------------------------------
C         CONVERT DRIFT TIME INTO DISTANCE
C         --------------------------------
C
          DRIFT=IDRIFT*DRFVEL
          IF(HEAD(18).LE.0)DRIFT=DRIFT+0.5*DRFVEL
C
C         --------------------------------
C         DRIFT PATH DISPERSION CORRECTION
C         --------------------------------
C
          IF(DRIFT.GT.4.0)GOTO1360
          DRIFT=DRIFT+BETAM1*DRIFT
          GOTO1370
 1360     DRIFT=DRIFT+BETAM1*4.0
 1370     CONTINUE
C
C         --------------------------
C         EDGE WIRE FIELD DISTORTION
C         --------------------------
C
          IF(LAYER.GE.3)GOTO1380
          DRIFT=DRIFT*(1.-CCST1*(LAYER-3)**2)
          GOTO1390
 1380     IF(LAYER.LE.12)GOTO1390
          DRIFT=DRIFT*(1.-CCST2*(LAYER-12)**2)
 1390     CONTINUE
C
C         --------------------------------------
C         FIELD DISTORTIONS AT LARGE DRIFT TIMES
C         --------------------------------------
C
          IF(DRIFT.GT.CAB(7))
     #    DRIFT=DRIFT+LRFLAG*CCST0*(LAYER-WMID)*TANBET*(DRIFT-CAB(7))
C
C         ----------------------------------
C         DRIFT VELOCITY VARIATION NEAR WIRE
C         ----------------------------------
C
          IF(DRIFT.LT.CAB(4))DRIFT=DRIFT+CAB(5)*(DRIFT-CAB(4))**2
C
C         -------------------------
C         RESET -VE DRIFT TIMES TO
C         HELP L/R AMBIGUITY SOLN.
C         AS REQUESTED BY P.STEFFEN
C         -------------------------
C
          IF(DRIFT.LT.0.)DRIFT=0.05
C
C         ---------------------
C         X,Y AND R COORDINATES
C         ---------------------
C
          IF(LRFLAG.GT.0) GOTO 20
            XHIT1=DX1 - TRLORX*DRIFT * (1. - CCST81)
            YHIT1=DY1 - TRLORY*DRIFT * (1. - CCST81)
            GOTO 25
   20     CONTINUE
            XHIT1=DX1 + TRLORX*DRIFT * (1. + CCST81)
            YHIT1=DY1 + TRLORY*DRIFT * (1. + CCST81)
   25     CONTINUE
          DR2=DRIFT/RWIRE
          DR1=0.5*DR2**2
          DR2=-LRFLAG*DR2*SINLOR
          RHIT1=DR1+DR2
          RHIT1=RWIRE*(1+RHIT1-.5*RHIT1**2)
C
C         -----------------------------
C         LOAD COORDINATES AND INCREASE
C         POINTER INHIT FOR NEXT HIT
C         ------------------------------
C
          CALLMVCL(WRK(INHIT),0,ADWRK(1),0,LONG)
C
C         --------------------------------
C         IF BACKTR UNCERTAIN ABOUT L/R
C         SOLUTION, COMPUTE BOTH.
C         --------------------------------
C
          IF(LRNOWN.EQ.0)GOTO1570
          XHIT1=DX1-LRFLAG*TRLORX*DRIFT
          YHIT1=DY1-LRFLAG*TRLORY*DRIFT
          DR2=DRIFT/RWIRE
          DR1=0.5*DR2**2
          DR2=-LRFLAG*DR2*SINLOR
          RHIT1=DR1-DR2
          RHIT1=RWIRE*(1+RHIT1-.5*RHIT1**2)
          INHIT2=INHIT2-HLDHT
          CALLMVCL(WRK(INHIT2),0,ADWRK(1),0,LONG)
          IWRK(INHIT2+8)=-IWRK(INHIT2+8)
C
C         ----------------
C         FETCH NEXT LAYER
C         ----------------
C
 1570     NH=NH+2
          NH1=NH1+4
          IF(NH1.LE.NH9)GOTO1240
C
C         ------------------------
C         FETCH NEXT TRACK ELEMENT
C         ------------------------
C
          NLLAST=NLWANT
          NRLAST=INRING
 1580     NL=NL-1
          IF(NL.NE.0)GOTO1140
C
C         ---------------------------
C         END OF FXYZ - SET POINTERS
C         ---------------------------
C
 1590     HPHT0=INHIT
          HPHT0A=INHIT2
 1600     CONTINUE
C2005 FORMAT('0TRACK:',I6,/,(1X,3I6,4F9.3,4I4,F9.3,I6,F9.3))
C     PRINT 2005, HLDHT,(WRK(I),I=HPHT0,HPHT9)
          RETURN
          END
C   08/12/80 102191156  MEMBER NAME  FXYZ0    (PATRECSR)    FORTRAN
      SUBROUTINE FXYZ(NT)
      IMPLICIT INTEGER*2 (H)
      LOGICAL TBIT
C
C
C-----------------------------------------------------------------------
C
C         -------------- SUBROUTINE FXYZ(NT) -----------------
C         ---- G.F.PEARCE .. LAST UPDATE : 1030 ON 31/10/80 ----
C
C     THIS SUBROUTINE CALCULATES THE COORDINATES IN REAL SPACE OF ALL
C     HITS ASSOCIATED BY THE TRACK RECOGNITION PROGRAM WITH A SINGLE
C     TRACK. THE SINGLE TRACK FOR WHICH THIS IS DONE IS DEFINED BY THE
C     USER ON INPUT BY THE NUMBER NT, THIS BEING THE NUMBER OF THE
C     TRACK IN THE OUTPUT COMMON FROM SUBROUTINE BACKTR.
C
C     THE RESULTS ARE PLACED IN THE ARRAY WRK IN COMMON/CWORK/.
C     HPHT0    = POINTER TO FIRST WORD OF FIRST HIT IN WRK.
C     HPHT9    = POINTER TO LAST WORD OF LAST HIT IN WRK.
C     HLDHT    = NUMBER OF 4-BYTE WORDS STORED PER HIT IN WRK.
C     HPHT0A   = POINTER TO FIRST WORD OF FIRST HIT FOR COORDINATES
C                CALCULATED USING THE OPPOSITE L/R SOLUTION.
C                IF BACKTRACE HAS UNAMBIGUOUSLY RESOLVED THE L/R SOLN
C                THEN NO REVERSED L/R SOLN IS COMPUTED AND THIS POINTER
C                IS SET NEGATIVE.
C     HPHT9A   = POINTER TO LAST WORD OF LAST HIT IN WRK FOR OPPOSITE
C                L/R SOLUTION. ONLY SET WHEN IDWRK(1) IS NOT NEGATIVE.
C     HPHTLM   = LOWEST ALLOWABLE HPHT0 (CORRESPONDING TO NHITMAX)
C
C-----------------------------------------------------------------------
C
C
      COMMON/CADMIN/IEVTP,NREC,NRWRIT,NRERR
      COMMON/CHEADR/HEAD(20)
      COMMON/CALIBR/JPOINT(100),
     1HMUCAL(8370),HLGMAI(5760),HTAGSY(384),HJPULS(9216),
     1DELTA0(96,2),DELTA1(96,2),DELTA2(96,2),DELTA5(96,2),DELTA6(96,2)
#include "cdata.for"
#include "ccycp.for"
#include "cworkpr.for"
#include "cworkeq.for"
      COMMON / CJDRCH / RDEC(4),PSIIN(3),RINCR(3),FIRSTW(3),FSENSW(3),
     * RDEPTH,SWDEPL,YSUSPN,TIMDEL(2,3),ZMAX,ZOFFS,ZRESOL,ZNORM,ZAL,
     * ZSCAL,DRIDEV,DRICOS,DRISIN,PEDES,TZERO(3),
     * DRIROT(96,2),SINDRI(96,2),COSDRI(96,2),DRIVEL(96,2),T0FIX(3),
     * CAB(8)
C  TEMPORARY INSTALLMENT OF ARRAY T0FIX, WILL BE PERMANENT LATER
#include "cdsmax.for"
#include "cpatlm.for"
C
C-----------------------------------------------------------------------
C    EQUIVALENCE OUTPUT BANK TO ADWRK FOR EASE OF TRANSFER TO HIT BANK
C-----------------------------------------------------------------------
C
         EQUIVALENCE (ADWRK( 1),LAYER)
         EQUIVALENCE (ADWRK( 2),NH1)
         EQUIVALENCE (ADWRK( 3),NH)
         EQUIVALENCE (ADWRK( 4),XHIT1)
         EQUIVALENCE (ADWRK( 5),YHIT1)
         EQUIVALENCE (ADWRK( 6),ZHIT1)
         EQUIVALENCE (ADWRK( 7),RHIT1)
         EQUIVALENCE (ADWRK( 8),IERZRF)
         EQUIVALENCE (ADWRK( 9),NLMIDO)
         EQUIVALENCE (ADWRK(10),INCELL)
         EQUIVALENCE (ADWRK(11),IERXYF)
         EQUIVALENCE (ADWRK(12),BETA)
         EQUIVALENCE (ADWRK(13),INRING)
         EQUIVALENCE (ADWRK(14),CHIXYF)
C -- MASKS MK1 TO EXTRACT TRACK ELEMENT NUMBER FROM HIT LABEL
C --       MK2 TO EXTRACT WIRE CROSSING FLAG
C --       MK3 TO EXTRACT FLAG ON UNRESOLVED L/R SOLUTION IN BACKTRACE
C --       MK4 TO EXTRACT FLAG ON TEST TRACK ELEMENT.
         INTEGER*4 MK1/Z00FE/ , MK2/Z100/ , MK3/Z1000/ , MK4/Z20000/
         HPWRK(30) = NT
C
C        ----------------------
C        POINTER INITIALISATION
C        ----------------------
C
         HLDHT = 14
         LONG = HLDHT * 4
         MAXHT = 80
         INHIT = HPFREE + MAXHT * HLDHT
         IF (INHIT.LE.HPLAST) GOTO10
C ----- ERROR 1 --------- NOT ENOUGH SPACE IN CWORK
         CALL ERRORM('FXYZ    ',1,NT)
         INHIT = HPLAST
         MAXHT = (HPLAST-HPFREE)/HLDHT
         IF (MAXHT.GE.8) GOTO10
C ----- ERROR 2 --------- HAD TO ABANDON TRACK NT
         CALL ERRORM('FXYZ    ',2,NT)
         HPHT0 = 1
         HPHT9 = 1
         GOTO1600
 10      HPHT9 = INHIT - 1
         HPHTLM = HPFREE
         HPFREE = INHIT
C
C        -------------------------------
C        OPPOSITE L/R AMBIGUITY POINTERS
C        AMBIGUITY 1 AT TOP, 2 AT BOTTOM
C        ------------------------------
C
         INHIT2 = -1
         IW1 = HISTR(1,NT)
         IW1 = LBL(IABS(IW1))
         LRNOWN = LAND(IW1,MK3)
         IF (TBIT(IXYF(1),26)) LRNOWN = 0
         IF (LRNOWN.EQ.0) GOTO50
C
         HLDHTA = HLDHT
         MAXHT = MAXHT / 2
         INHIT2 = INHIT - MAXHT * HLDHT
         HPHT9A = INHIT2 - 1
C
 50      NHIT = 0
         CHIXYF = 0
         NL = HNREL(NT)
         IF (NL.GT.0) GOTO60
C ----- ERROR 3 --------- NO TRACK ELEMENTS FROM BACKTRACE
         CALL ERRORM('FXYZ    ',3,NT)
         GOTO1590
 60      NLLAST = - 1
         NRLAST = - 1
C
C
C---------------------------------------------------------------------
C   LOOP OVER EACH TRACK ELEMENT BELONGING TO THIS TRACK. FOR
C   EACH TRACK ELEMENT STORE ALL REQUIRED INFORMATION BEFORE LOOPING
C   OVER HITS.
C---------------------------------------------------------------------
C
C
 1140    CONTINUE
C
C        -------------------------------
C        POINTER TO TRACK ELEMENT IN
C        COMMON/MIDOUT/. THIS CARRIES A
C        +VE/-VE SIGN INDICATING A RIGHT/
C        LEFT SOLUTION FROM BACKTRACING
C        -------------------------------
C
         NLMIDO = HISTR(NL,NT)
         IF (NLMIDO.NE.0)GOTO1150
C ----- ERROR 4 --------- TRACK ELEMENT ZERO FROM BACKTRACE
         CALL ERRORM('FXYZ    ',4,NT)
         GOTO1580
 1150    ILMIDO = IABS(NLMIDO)
         LABEL = LBL(ILMIDO)
C
C        -------------------------------
C        IS THIS A TEST TRACK ELEMENT ?
C        -------------------------------
C
         IERXYF=LAND(LABEL,MK4)
         IF(IERXYF.NE.0)IERXYF=2
C
C        -------------------------------
C        CELL NUMBER AND RING NUMBER
C        -------------------------------
C
         INCELL = IPCL(ILMIDO)
         INRING = 1
         IF(INCELL.GT.24)INRING = 2
         IF(INCELL.GT.48)INRING = 3
C
C        -------------------------------
C        LEFT/RIGHT AMBIGUITY FLAG FOR
C        FIRST HIT ON TRACK ELEMENT
C        -------------------------------
C
         IF (NLMIDO.GT.0) GOTO1160
         LRFLAG = - 1
         LR12 = 1
         GOTO1170
 1160    LRFLAG = + 1
         LR12   = 2
C
C        -------------------------------
C        LBZRCR = LABEL FOR WIRE CROSSING
C        IWCRS  = FIRST WIRE # AFTER ELEMENT
C                 CROSSES WIRE BOUNDARY.
C        -------------------------------
C
 1170    LBZRCR = LAND(LABEL,MK2)
         IWCRS = ICRO(ILMIDO)
C
C        ------------------------------
C        LORENTZ ANGLE TRANSFORMATION
C        AND DRIFT VELOCITY
C        ------------------------------
C
         TRLORX = TRMATS(INCELL,1)
         TRLORY = TRMATC(INCELL,1)
         SINLOR = SINDRI(INCELL,1)
         COSLOR = COSDRI(INCELL,1)
         DRFVEL = DRIVEL(INCELL,1)
C
C        ----------------
C        ABERATION ARRAYS
C        ----------------
C
         DEL0=DELTA0(INCELL,LR12)
         DEL1=DELTA1(INCELL,LR12)
         DEL2=DELTA2(INCELL,LR12)
         DEL5=DELTA5(INCELL,1)
         DEL6=DELTA6(INCELL,1)
C
C        -------------------------------
C        RING RADIUS AND WIRE SEPARATION
C        -------------------------------
C
         R0  = FSENSW(INRING)
         DR0 = RINCR(INRING)
C
C        --------------------------------------
C        COMPUTE AVERAGE ANGLE OF TRACK TO WIRE
C        PLANE OVER THIS TRACK ELEMENT. USE THIS
C        ANGLE TO COMPUTE THE CORRECTION TO DRIFT
C        SPACE REQUIRED TO CENTRE DRIFT TIME ON
C        DRIFT CHARGE CENTRE.
C        ---------------------------------------
C
         DXWR = DR0 * COSLOR
         DYWR = DR0 * SINLOR
C        FIRST HALF OF HITS
         BETA  = ( LRFLAG * SL1(ILMIDO) - DYWR )
         BETA = SQRT( DXWR**2 + BETA**2 ) / DXWR
C        SECOND HALF OF HITS
         LAYERM = LRFLAG
         IF (IWCRS.NE.0) LAYERM = - LAYERM
         BETA2 = ( LAYERM * SL2(ILMIDO) - DYWR )
         BETA2 = SQRT( DXWR**2 + BETA2**2 ) / DXWR
         BETA = (BETA + BETA2) / 2
         IF (BETA.LT.1.0) BETA = 1.0
         IF (BETA.GT.1.1) BETA = 1.1
         TANBET=SQRT(BETA**2-1.)
         BETAM1 = BETA-1
C
C        -----------------------------------
C        WMID FOR FIELD DISTORTION ABERATION
C        -----------------------------------
C
         WMID=7.5+(DS1(ILMIDO)+DS2(ILMIDO))*SINLOR/40
C
C        -------------------------------
C        TRACK ELEMENT NUMBER AS STORED
C        IN HIT LABEL DATA BANK.
C        -------------------------------
C
         NLWANT = NTREL(ILMIDO)
C
C        ----------------------------
C        DIRECTION OF WIRE PLANE
C        AND DRIFT SPACE DIRECTION
C        ----------------------------
C
         IW1 = INCELL - 24*(INRING-1)
         IF (INRING.EQ.3) GOTO1180
         DXWR   = DIRWR1(IW1,1)
         DYWR   = DIRWR1(IW1,2)
         GOTO1190
 1180    DXWR   = DIRWR3(IW1,1)
         DYWR   = DIRWR3(IW1,2)
C
C        ------------------------------
C        WIRE STAGGERING ( +/- SWDEPL )
C        ------------------------------
C
 1190    DDXWR = + SWDEPL * DYWR
         DDYWR = - SWDEPL * DXWR
C
C
C----------------------------------------------------------------------
C   LOOP OVER ALL HITS FOR THIS CELL AND SEARCH FOR HITS BELONGING
C   TO THIS TRACK ELEMENT.
C----------------------------------------------------------------------
C
C         ----------------------------
C         DETERMINE POINTERS TO
C         HIT ARRAY AND HIT LABEL
C         ----------------------------
          NH0 = HPTSEC(INCELL)
          NH9 = HPTSEC(INCELL+1)-1
          IF (NH0.GT.0.AND.NH9.GT.0) GOTO1230
C ----- ERROR 6 --------- HPTSEC POINTER IS -VE
         CALL ERRORM('FXYZ    ',6,NT)
          GOTO1580
 1230     NH  = SHFTR((NH0-HPTSEC(1)),1) + HPHL0
          NH1 = NH0
C
C         ----------------------------
C         LOOP OVER HITS IN CELL
C         ACCEPT HITS ON NLWANT BUT
C         PROTECT AGAINST HIT APPEARING
C         ON SUCCESSIVE TRACK ELEMENTS.
C         ----------------------------
C
 1240     CONTINUE
          IW1 = HWRK(NH)
          IW2 = HWRK(NH+1)
          NL1 = SHFTR(LAND(IW1,MK1),1)
          NL2 = SHFTR(LAND(IW2,MK1),1)
          IF(NL1.NE.NLWANT.AND.NL2.NE.NLWANT)GOTO1570
C
C         ------------------------------
C         THIS HIT IS ON REQUIRED TREL
C         REVERSE L/R AMBIGUITY IF THIS
C         HIT CROSSES WIRE BOUNDARY
C         -----------------------------
C
          IWIRE = HDATA(NH1  )
          IWIRE = SHFTR(IWIRE,3)
          LAYER = LAND(IWIRE,15)
          IF(LBZRCR.EQ.0 .OR. LAYER.NE.IWCRS)GOTO1250
C
C         ---------------------
C         REVERSE L/R AMBIGUITY
C         ---------------------
C
          LRFLAG = - LRFLAG
          NLMIDO = - NLMIDO
          IF (LR12.EQ.1) LR12 = 3
          LR12 = LR12 - 1
          DEL0=DELTA0(INCELL,LR12)
          DEL1=DELTA1(INCELL,LR12)
          DEL2=DELTA2(INCELL,LR12)
C
C         ------------------------------
C         REJECT THIS HIT IF IT WAS ALSO
C         ON THE PRECEDING TRACK ELEMENT
C         ------------------------------
C
 1250     IF(INRING.NE.NRLAST)GOTO1260
          IF(NL1.EQ.NLLAST.OR.NL2.EQ.NLLAST)GOTO1570
C
C         ------------------------------
C         LOAD DRIFT TIME AND Z AMPLIT.
C         ------------------------------
C
 1260     IAMPL=HDATA(NH1+1)
          IAMPR=HDATA(NH1+2)
          IDRIFT=HDATA(NH1+3)
C
C         -----------------------------
C         FLAG BAD Z-COORDINATE IF DRIFT
C         TIME FOR THIS HIT IS WITHIN
C         DOUBLE HIT RESLN. OF ANOTHER
C         HIT ON THIS LAYER.
C         -----------------------------
C
          IERZRF=0
CC--CC    CLOSEST HIT WITH LOWER DRIFT TIME
CC--CC    NH2=NH1-4
CC--CC    IF(NH2.LT.NH0)GOTO1270
CC--CC    IWIRE2=HDATA(NH2)
CC--CC    IWIRE2=SHFTR(IWIRE2,3)
CC--CC    IF(IWIRE2.NE.IWIRE)GOTO1270
CC--CC    NEARH2=IDRIFT-HDATA(NH2+3)
CC--CC    IF(IABS(NEARH2).LE.IXYF(18))IERZRF=16
CC--CC    CLOSEST HIT WITH HIGHER DRIFT TIME
C1270     NH3=NH1+4
CC--CC    IF(NH3.GT.NH9)GOTO1280
CC--CC    IWIRE3=HDATA(NH3)
CC--CC    IWIRE3=SHFTR(IWIRE3,3)
CC--CC    IF(IWIRE3.NE.IWIRE)GOTO1280
CC--CC    NEARH3=IDRIFT-HDATA(NH3+3)
CC--CC    IF(IABS(NEARH3).LE.IXYF(18))IERZRF=16
C
C         ------------------------
C         CREATE SPACE FOR NEW HIT
C         ------------------------
C
 1280     IF(NHIT.LT.MAXHT)GOTO1290
C ----- ERROR 5 --------- RAN OUT OF SPACE IN CWORK FOR TRACK NT
          CALLERRORM('FXYZ    ',5,NT)
          GOTO1590
 1290     NHIT=NHIT+1
          INHIT=INHIT-HLDHT
C
C-----------------------------------------------------------------------
C   COMPUTE (X,Y,Z,R) FOR THIS HIT AND STORE IN THE COORDINATE ARRAY WRK
C-----------------------------------------------------------------------
C
C         ------------
C         Z-COORDINATE
C         ------------
C
          IF(IAMPR.LE.0.OR.IAMPL.LE.0)GOTO1310
          ZHIT1=IAMPR+IAMPL
          ZHIT1=.5*ZAL*FLOAT(IAMPR-IAMPL)/ZHIT1
          GOTO1320
 1310     IERZRF=16
          ZHIT1=0.0
 1320     CONTINUE
C
C         -----------
C         WIRE RADIUS
C         -----------
C
          RWIRE=R0+LAYER*DR0
C
C         ----------------------------
C         CORRECTION FOR WIRE POSITION
C         AT Z=0 PERP. TO WIRE PLANE
C         ----------------------------
C
          DWIRE = DEL5*(LAYER-7) + DEL6*10
          DWIREX = + DWIRE * DYWR
          DWIREY = + DWIRE * DXWR
C
C         ----------------
C         WIRE COORDINATES
C         ----------------
C
          ISTAG=-1
          IF(TBIT(LAYER,31))ISTAG=+1
          DX1=RWIRE*DXWR+ISTAG*DDXWR+DWIREX
          DY1=RWIRE*DYWR+ISTAG*DDYWR-DWIREY
C
C         --------------------------------
C         CONVERT DRIFT TIME INTO DISTANCE
C         --------------------------------
C
          DRIFT=IDRIFT*DRFVEL
          IF(HEAD(18).LE.0)DRIFT=DRIFT+0.5*DRFVEL
C
C         --------------------------------
C         DRIFT PATH DISPERSION CORRECTION
C         --------------------------------
C
          IF(DRIFT.GT.4.0)GOTO1360
          DRIFT=DRIFT+BETAM1*DRIFT
          GOTO1370
 1360     DRIFT=DRIFT+BETAM1*4.0
 1370     CONTINUE
C
C         --------------------------
C         EDGE WIRE FIELD DISTORTION
C         --------------------------
C
          IF(LAYER.GE.3)GOTO1380
          DRIFT=DRIFT*(1.-DEL1*(LAYER-3)**2)
          GOTO1390
 1380     IF(LAYER.LE.12)GOTO1390
          DRIFT=DRIFT*(1.-DEL2*(LAYER-12)**2)
 1390     CONTINUE
C
C         --------------------------------------
C         FIELD DISTORTIONS AT LARGE DRIFT TIMES
C         --------------------------------------
C
          IF(DRIFT.GT.CAB(7))
     #    DRIFT=DRIFT+LRFLAG*DEL0*(LAYER-WMID)*TANBET*(DRIFT-CAB(7))
C
C         ----------------------------------
C         DRIFT VELOCITY VARIATION NEAR WIRE
C         ----------------------------------
C
          IF(DRIFT.LT.CAB(4))DRIFT=DRIFT+CAB(5)*(DRIFT-CAB(4))**2
C
C         -------------------------
C         RESET -VE DRIFT TIMES TO
C         HELP L/R AMBIGUITY SOLN.
C         AS REQUESTED BY P.STEFFEN
C         -------------------------
C
          IF(DRIFT.LT.0.)DRIFT=0.05
C
C         ---------------------
C         X,Y AND R COORDINATES
C         ---------------------
C
          XHIT1=DX1+LRFLAG*TRLORX*DRIFT
          YHIT1=DY1+LRFLAG*TRLORY*DRIFT
          DR2=DRIFT/RWIRE
          DR1=0.5*DR2**2
          DR2=-LRFLAG*DR2*SINLOR
          RHIT1=DR1+DR2
          RHIT1=RWIRE*(1+RHIT1-.5*RHIT1**2)
C
C         -----------------------------
C         LOAD COORDINATES AND INCREASE
C         POINTER INHIT FOR NEXT HIT
C         ------------------------------
C
          CALLMVCL(WRK(INHIT),0,ADWRK(1),0,LONG)
C
C         --------------------------------
C         IF BACKTR UNCERTAIN ABOUT L/R
C         SOLUTION, COMPUTE BOTH.
C         --------------------------------
C
          IF(LRNOWN.EQ.0)GOTO1570
          XHIT1=DX1-LRFLAG*TRLORX*DRIFT
          YHIT1=DY1-LRFLAG*TRLORY*DRIFT
          DR2=DRIFT/RWIRE
          DR1=0.5*DR2**2
          DR2=-LRFLAG*DR2*SINLOR
          RHIT1=DR1-DR2
          RHIT1=RWIRE*(1+RHIT1-.5*RHIT1**2)
          INHIT2=INHIT2-HLDHT
          CALLMVCL(WRK(INHIT2),0,ADWRK(1),0,LONG)
          IWRK(INHIT2+8)=-IWRK(INHIT2+8)
C
C         ----------------
C         FETCH NEXT LAYER
C         ----------------
C
 1570     NH=NH+2
          NH1=NH1+4
          IF(NH1.LE.NH9)GOTO1240
C
C         ------------------------
C         FETCH NEXT TRACK ELEMENT
C         ------------------------
C
          NLLAST=NLWANT
          NRLAST=INRING
 1580     NL=NL-1
          IF(NL.NE.0)GOTO1140
C
C         ---------------------------
C         END OF FXYZ - SET POINTERS
C         ---------------------------
C
 1590     HPHT0=INHIT
          HPHT0A=INHIT2
 1600     CONTINUE
          RETURN
          END
*   27/10/80 203301359  MEMBER NAME  HALF     (PATRECSR)    ASSEMBLER
*
*      SUBROUTINE HALF(A,B,C)
*
*   INSTALLED BY G.F.PEARCE
*   PRISED FROM ITS AUTHOR D.WILLIAMS IN MY LAMP DAYS.
*
*   FORTRAN CALLABLE ROUTINE TO SPLIT THE CONTENTS OF AN I*2 WORD
*   INTO TWO HALVES AND PLACE THE RESULTS INTO TWO OTHER I*2 WORDS.
*   THIS ALLOWS SMALL INTEGERS TO BE STORED AS SINGLE BYTE WORDS
*   AND THEN USED AS DOUBLE BYTE WORDS.
*
*   A = I*2 WORD CONTAINING TWO SINGLE BYTE NUMBERS
*   B IS RETURNED CONTAINING HIGH-ORDER BYTE OF A
*   C IS RETURNED CONTAINING LOW-ORDER BYTE OF A
*
HALF CSECT
      USING *,15
      B START
      DC X'7'
      DC CL7'HALF   '              SET NAME FOR TRACEBACK
START STM 14,4,12(13)              SAVE REGISTERS
      LM 2,4,0(1)                  LM ARG ADDRESSES INTO R2-R4
      MVC 1(1,3),0(2)              PUT HI-ORDER BYTE INTO LO-ORDER B
      MVI 0(3),0                   ZERO HI-ORDER OF B
      MVC 1(1,4),1(2)              PUT LO-ORDER BYTE INTO LO-ORDER C
      MVI 0(4),0                   ZERO HI-ORDER BYTE OF C
      LM 2,4,28(13)                RESTORE REGISTERS
      MVI 12(13),X'FF'             INDICATE RETURN OF CONTROL
      BR 14                        RETURN
      END
C   24/10/80 110141330  MEMBER NAME  HITXYZ   (PATRECSR)    FORTRAN
          SUBROUTINE HITXYZ(IPHIT,LRSOLN,PHITRK,GRADZR,ZRINT,RESULT)
          IMPLICIT INTEGER*2(H)
          REAL*4 RESULT(14)
          LOGICAL TBIT
C
C
C-----------------------------------------------------------------------
C
C    ----------------------  SUBROUTINE HITXYZ -------------------------
C    ---------- G.F.PEARCE .. LAST UPDATE : 1600 ON 24/10/80 -----------
C    ------------ LATEST ABERATIONS BY T.NOZAKI ON 19/9/80 -------------
C
C     SUBROUTINE TO CALCULATE COORDINATES IN REAL SPACE OF ONE HIT
C     IN THE JADE JET CHAMBERS.
C
C     ALL INPUT/OUTPUT IS TRANSMITTED IN THE CALL PARAMETER LIST.
C     THIS CALL LIST IS DESCRIBED BELOW :
C
C     REQUIRED AS INPUT
C     -----------------
C
C 1.  IPHIT  = POINTER TO HIT IN 'JETC'
C
C 2.  LRSOLN = LEFT/RIGHT SOLUTION (-VE FOR LEFT, +VE FOR RIGHT)
C
C 3.  PHITRK = AZIMUTHAL ANGLE OF THE TRACK (IN R-PHI SPACE) AT THIS HIT
C
C 4.  GRADZR = GRADIENT  FROM THE TRACK FIT IN THE Z-R PLANE.
C
C 5.  ZRINT  = INTERCEPT FROM THE TRACK FIT IN THE Z-R PLANE.
C
C     RESULT ARRAY (OUTPUT FROM HITXYZ)
C     ---------------------------------
C
C (1).  LAYER STRUCK BY HIT (0-15)
C
C (2).  POINTER TO HIT IN 'JETC'
C
C (3).  POINTER TO HIT LABEL ARRAY   (DUMMY .. NOT SET BY HITXYZ)
C
C (4).  COMPUTED X COORDINATE
C
C (5).  COMPUTED Y COORDINATE
C
C (6).  COMPUTED Z COORDINATE
C
C (7).  COMPUTED R COORDINATE
C
C (8).  Z-R ERROR FLAG    (0 => GOOD HIT, 10 => BAD HIT)
C
C (9).  LEFT/RIGHT SOLUTION (-VE FOR LEFT, +VE FOR RIGHT)
C
C (10). CELL NUMBER
C
C (11). X-Y ERROR FLAG    (0 => GOOD HIT, 2 => BAD HIT)
C
C (12). SEC(GAMMA)        WHERE GAMMA IS THE ANGLE OF THE TRACK
C                         TO THE NORMAL TO THE DRIFT SPACE DIRN
C
C (13). RING NUMBER
C
C (14). CHI OF POINT TO FIT IN X-Y    (DUMMY .. NOT SET BY HITXYZ)
C
C-----------------------------------------------------------------------
C
C
          REAL*4 XYZHIT(14)
          LOGICAL*1 CALLED/.FALSE./
#include "cdata.for"
      COMMON / CJDRCH / RDEC(4),PSIIN(3),RINCR(3),FIRSTW(3),FSENSW(3),
     * RDEPTH,SWDEPL,YSUSPN,TIMDEL(2,3),ZMAX,ZOFFS,ZRESOL,ZNORM,ZAL,
     * ZSCAL,DRIDEV,DRICOS,DRISIN,PEDES,TZERO(3),
     * DRIROT(96,2),SINDRI(96,2),COSDRI(96,2),DRIVEL(96,2),T0FIX(3),
     * CABER1,CABER2,CABER3,CABER4,CABER5,CABER6,CABER7,CABER8
#include "cdsmax.for"
#include "cpatlm.for"
      COMMON/CALIBR/JPOINT(100),
     1HMUCAL(8370),HLGMAI(5760),HTAGSY(384),HJPULS(9216),
     1DELTA0(96,2),DELTA1(96,2),DELTA2(96,2),DELTA5(96,2),DELTA6(96,2)
C
C         ------------------------
C         EQUIVALENCE RESULT ARRAY
C         ------------------------
C
          EQUIVALENCE (XYZHIT( 1),LAYER)
          EQUIVALENCE (XYZHIT( 2),NH1)
          EQUIVALENCE (XYZHIT( 3),NH)
          EQUIVALENCE (XYZHIT( 4),XHIT1)
          EQUIVALENCE (XYZHIT( 5),YHIT1)
          EQUIVALENCE (XYZHIT( 6),ZHIT1)
          EQUIVALENCE (XYZHIT( 7),RHIT1)
          EQUIVALENCE (XYZHIT( 8),IERZRF)
          EQUIVALENCE (XYZHIT( 9),LRSIDE)
          EQUIVALENCE (XYZHIT(10),INCELL)
          EQUIVALENCE (XYZHIT(11),IERXYF)
          EQUIVALENCE (XYZHIT(12),SECGAM)
          EQUIVALENCE (XYZHIT(13),INRING)
          EQUIVALENCE (XYZHIT(14),CHIXYF)
          NH1=IPHIT
          LRSIDE=LRSOLN
C
C         ----------------
C         FETCH RUN NUMBER
C         ----------------
C
          IF(CALLED)GOTO100
          IPHEAD=IBLN('HEAD')
          CALLED=.TRUE.
  100     NRUN=2*IDATA(IPHEAD)
          IF(NRUN.GT.0)NRUN=HDATA(NRUN+10)
C
C         ------------------
C         DATA AND CONSTANTS
C         ------------------
C
          INWIRE=HDATA(NH1)
          INWIRE=SHFTR(INWIRE,3)
          IAMPL=HDATA(NH1+1)
          IAMPR=HDATA(NH1+2)
          IDRIFT=HDATA(NH1+3)
          LAYER=LAND(INWIRE,15)
          INCELL=LAND(SHFTR(INWIRE,4),127)+ 1
          INRING=1
          IF(INCELL.GT.24)INRING=2
          IF(INCELL.GT.48)INRING=3
          DR0=RINCR(INRING)
          JCELL=INCELL-24*(INRING-1)
          IF(INRING.EQ.3)GOTO160
          COSPHW=DIRWR1(JCELL,1)
          SINPHW=DIRWR1(JCELL,2)
          GOTO170
  160     COSPHW=DIRWR3(JCELL,1)
          SINPHW=DIRWR3(JCELL,2)
C
C         ---------------------------
C         CALCULATE Z AND FLAG ERRORS
C         ---------------------------
C
  170     IF(IAMPR.LE.0.OR.IAMPL.LE.0)GOTO180
          ZHIT1=IAMPR+IAMPL
          ZHIT1=.5*ZAL*FLOAT(IAMPR-IAMPL)/ZHIT1
          IERZRF=0
          GOTO190
  180     IERZRF=10
          ZHIT1=0.0
  190     CONTINUE
C
C         -------------------
C         COMPUTE WIRE RADIUS
C         -------------------
C
          RWIRE=FSENSW(INRING)+LAYER*DR0
C
C         ---------------
C         WIRE STAGGERING
C         ---------------
C
          STAG=-SWDEPL
          IF(TBIT(LAYER,31))STAG=+SWDEPL
C
C         -------------------
C         COMPUTE X,Y OF WIRE
C         -------------------
C
          XWIRE=RWIRE*COSPHW+STAG*SINPHW
          YWIRE=RWIRE*SINPHW-STAG*COSPHW
C
C         -----------------------
C         SET LEFT/RIGHT SOLUTION
C         -----------------------
C
          LRFLAG=ISIGN(1,LRSIDE)
  200     LR12=1
          IF(LRFLAG.GT.0)LR12=2
C
C         ---------------
C         A FEW CONSTANTS
C         ---------------
C
          SINA=SINDRI(INCELL,1)
          COSA=COSDRI(INCELL,1)
          TANA=SINA/COSA
          TRLORX=TRMATS(INCELL,1)
          TRLORY=TRMATC(INCELL,1)
          DRFVEL=DRIVEL(INCELL,1)
          TANPHW=SINPHW/COSPHW
C
C         -----------------------------
C         COMPUTE BETA AND GAMMA ANGLES
C         -----------------------------
C
          SINPHI=SIN(PHITRK)
          COSPHI=COS(PHITRK)
          COSGAM=TRLORY*COSPHI-TRLORX*SINPHI
          SINGAM=TRLORX*COSPHI+TRLORY*SINPHI
          TANGAM=SINGAM/COSGAM
          SECGAM=1./COSGAM
          SINBET=SINPHI*COSPHW-COSPHI*SINPHW
          COSBET=COSPHI*COSPHW+SINPHI*SINPHW
          TANBET=SINBET/COSBET
          TLTCOR=1./(COSA+SINA*TANBET)
C
C         --------------------------------
C         CONVERT DRIFT TIME INTO DISTANCE
C         --------------------------------
C
          DRIFT=IDRIFT*DRFVEL
C
C         -------------
C         T0 CORRECTION
C         -------------
C
          IF(NRUN.GT.0)DRIFT=DRIFT + 64*T0FIX(INRING)*DRFVEL
          IF(NRUN.LE.0)DRIFT=DRIFT+0.5*DRFVEL
C
C         --------------------------------------------
C         CALCULATE ROUGH COORDINATES (XHIT,YHIT,RHIT)
C         --------------------------------------------
C
          XHIT=XWIRE+LRFLAG*TRLORX*DRIFT
          YHIT=YWIRE+LRFLAG*TRLORY*DRIFT
          RHIT=SQRT(XHIT**2+YHIT**2)
C
C         -----------------------------
C         CALCULATE FITTED Z-COORDINATE
C         -----------------------------
C
          ZFIT=GRADZR*RHIT+ZRINT
C
C         -----------------------------
C         CORRECTION FOR TIME OF FLIGHT
C         -----------------------------
C
          DDRIFT=CABER6*SQRT(RHIT**2+ZFIT**2)
          DRIFT=DRIFT-DDRIFT
C
C         ---------------------------
C         PROPOGATION TIME ALONG WIRE
C         ---------------------------
C
          DDRIFT=CABER1*(1222.9-ABS(ZFIT))
          DRIFT=DRIFT-DDRIFT
C
C         -----------------------------
C         CORRECTION FOR WIRE POSITIONS
C         -----------------------------
C
          DDRIFT=CABER8*((DELTA5(INCELL,1)+DELTA5(INCELL,2)*ZFIT/1211.5)
     #    *(LAYER-7)+(DELTA6(INCELL,1)+DELTA6(INCELL,2)*ZFIT/1211.5))
     #        *TLTCOR
          DRIFT=ABS(DRIFT*LRFLAG-DDRIFT*10.)
C
C         --------------------------------
C         DRIFT PATH DISPERSION CORRECTION
C         --------------------------------
C
          DDRIFT=0.
          IF(DRIFT.GT.CABER2.AND.TANGAM.GE.0.)GOTO250
          IF(DRIFT.GT.CABER3.AND.TANGAM.LT.0.)GOTO255
          DDRIFT=(SECGAM-1.)*DRIFT
          GO TO 260
  250     DDRIFT=(SECGAM-1.)*CABER2
          GO TO 260
  255     DDRIFT=(SECGAM-1.)*CABER3
  260     CONTINUE
          DRIFT=DRIFT+DDRIFT
C
C         ----------------------------------
C         DRIFT VELOCITY VARIATION NEAR WIRE
C         ----------------------------------
C
          DDRIFT=0.
          IF(DRIFT.LT.CABER4 ) DDRIFT=CABER5*(DRIFT-CABER4)**2
          DRIFT=DRIFT+DDRIFT
C
C         ---------------------
C         EDGE WIRE DISTORTIONS
C         ---------------------
C
          IF(LAYER.GE.3) GO TO 271
          DDRIFT=DELTA1(INCELL,LR12)*(LAYER-3)**2*DRIFT
          GO TO 272
 271      IF(LAYER.LE.12)  GO TO 273
          DDRIFT=DELTA2(INCELL,LR12)*(LAYER-12)**2*DRIFT
 272      DRIFT=DRIFT-DDRIFT*CABER8
 273      CONTINUE
C
C         -------------------------------------
C         FIELD DISTORTION AT LARGE DRIFT TIMES
C         -------------------------------------
C
          DDRIFT=0.
          IF(DRIFT.LT.CABER7) GO TO 280
          WMID=7.5+(DRIFT*0.1+(7.5-LAYER)*TANBET*TLTCOR)*SINA*0.5
          DDRIFT=LAYER-WMID
          DDRIFT=-LRFLAG*DELTA0(INCELL,LR12)
     -                                     *TANGAM*DDRIFT*(DRIFT-CABER7)
          DRIFT=DRIFT-DDRIFT*CABER8
 280      CONTINUE
C
C         -------------------------
C         FINALLY CALCULATE (X,Y,R)
C         -------------------------
C
 300      XHIT1=XWIRE+LRFLAG*TRLORX*DRIFT
          YHIT1=YWIRE+LRFLAG*TRLORY*DRIFT
          RHIT1=SQRT(XHIT1**2+YHIT1**2)
          IERXYF=0
          NH=RESULT(3)
          CALLMVCL(RESULT(1),0,XYZHIT(1),0,56)
          RETURN
          END
C   16/02/81            MEMBER NAME  INCOSM   (PATRECSR)    FORTRAN
      SUBROUTINE INCOSM
C
C     THIS SUBROTINE OVERWRITES SOME LIMITS IN CPATLM
C     FOR COSMIC DATA
C
C
      IMPLICIT INTEGER*2 (H)
C
#include "cpatlm.for"
C
       XYF(2)=20.
       XYF(4)=20.
       GFP(2)=20.
       GFP(4)=20.
       IGFP(9)=1
       IGFP(10)=1
       RETURN
       END
C   08/12/80 706261842  MEMBER NAME  INPATR   (S)           FORTRAN
      SUBROUTINE INPATR
C
C----------------------------------------------------------------------
C   INITIALISATION OF PATTERN RECOGNITION PROGRAM LIMITS AND TOLERANCES
C   AUTHORED BY A VARIETY OF PEOPLE.
C   TAKE OUT A FEW LIMITS NOW RUN DEPENDENT IN ADPATR  E ELSEN 26/06/87
C----------------------------------------------------------------------
C
      IMPLICIT INTEGER*2 (H)
#include "cpatlm.for"
#include "cgraph.for"
C
C--------------------------------------------------------------------
C
C       IPFAST = 2 MEANS SLOWEST, MOST EFFICIENT VERSION
C                    OF PATTERN RECOGNITION
C
C       IPFAST = 1 MEANS INTERMEDIATE VERSION OF PATTERN RECOGNITION
C
C       IPFAST = 0 MEANS FASTEST VERSION OF PATTERN RECOGNITION
C
C--------------------------------------------------------------------
C
        IF(IPFAST.NE.0.AND.IPFAST.NE.2.AND.IPFAST.NE.1)
     %  WRITE(6,256) IPFAST
  256  FORMAT('0 @@@@@@@ ERROR IN INPATR INITIALIZATION , IPFAST=',I10,
     *'  IPFAST SET TO 2')
        IF(IPFAST.NE.0.AND.IPFAST.NE.2.AND.IPFAST.NE.1) IPFAST=2
C
C
C
C---------------------------------------------------------------------
C INTERMEDIATE PATREC .. IPFAST=1
C ===================
C
C---------------------------------------------------------------------
C
C-----------------------------
C     INITIALISE PATREC LIMITS
C-----------------------------
C
C     MIN. NUMBER OF HITS IN A CELL
      LMPATR(1) = 8
C
C     WEIGHT OF ORIGIN IN FINAL R-FI-FIT
      PATRLM(2) = 0.00
C
C     LENGTH OF ARRAY WRK IN /CWORK/
      LMPATR(5) = 6000
      LMPATR(5) = 7000
C
C-----------------------------
C     INITIALISE FLINEL LIMITS
C-----------------------------
C
C     LIMIT FOR DEF. OF CLOSE HITS
      FLINLM(1) = 10.
C
C     LIMIT FOR SLOPE AGREEMENT
C                                           NOW IN ADPATR
C     FLINLM(2) = 3.0
C-----------------------------
C     INITIALISE FTRKEL LIMITS
C-----------------------------
C
C     STAGGERING (*4)
      TRELLM( 1) = 2.40
C
C     LIMIT ON DEV. FROM STAGGERING  (*4)
      TRELLM( 2) = 2.50
C
C     MAX (STAGG.DIST. * (-1)**ILAY)
      TRELLM( 3) = .20
C
C     MAX. RMS OF GOOD TREL: SIG0 = (4)+(5)*CURV
      TRELLM( 4) = 0.35
      TRELLM( 5) = 0.15
C
C     MAX.# OF REJECTED HITS BEFORE CUT OF TREL
      LMTREL( 6) =   2
C
C     MIN. |SIGL-SIGR| FOR L/R DET.
      TRELLM( 7) = 0.10
C
C     SPECIAL LIMIT FOR STRAIGHT TRACKS AT ZERO
      TRELLM( 8) = 4.0
C
C     LIMIT OF CURV/2 FOR FIT OF 4-5-HIT TREL
      TRELLM( 9) = .05
C
C     LIMITS FOR ZERO APPROACHING TREL
      TRELLM(10) = 1.0
      TRELLM(11) = .10
      TRELLM(12) = 1000000.
C
C     LIMITS FOR # OF HITS / TREL
      LMTREL(13) = 4
C
C     SIGMA OF GOOD FIT
      TRELLM(14) = .24
C
C     MIN. DISTANEC OF 'ZERO APPROACHING TREL'
      TRELLM(15) = 1.0
C
C     LIMIT OF SIGMA FOR TREL-FIT
      TRELLM(16) = 0.25
C
C     LIMIT OF SIGMA FOR TREL-FIT *(# OF END POINTS AT WALL)
      TRELLM(17) = 0.35
C
C     LIMIT OF SIGMA FOR TREL-FIT *(# OF ENDPOINTS AT WIREPLANE)
      TRELLM(18) = 0.15
C
C     L/R DETERMINED IF |SIGL**2-SIGR**2|<LIMIT
      TRELLM(19) = 0.10
C
C     NOT YET USED
      TRELLM(20) = 0.0
11111 CONTINUE
C-----------------------------
C     INITIALISE BACKTR LIMITS
C-----------------------------
C
C     OVERLAP OF HITS FOR JOIN OF TRACKELS IN CELL
      IBKK(1)=1
C
C     GAP IN HITS FOR JOIN OF TRACKELS IN ONE CELL
      IBKK(2)=2
C
C     IF THE LAST WIRE HIT IS LESS THAN IBKK(3) OR FIRST
      IBKK(4)=3
C
C     WIRE GREATER THAN IBKK(4) A CHECK IS MADE TO SEE WHETHER
C     THE TRACK PASSES THROUGH THE CELL SIDEWALL
      IBKK(3)=12
C
C     FOR JOINING OF TWO TRACKELS IN ONE CELL AND FOR THE TRACKELS
C     TO BE CONSIDERED ON OPPOSITE SIDES OF THE WIRE PLANE:
C     THE SLOPES MUST BE CORRECT,CROSSING FLAGS CORRECT AND
C     DS1 OR DS2  .LT.BKK(5)
      BKK(5)=15.
C
C     OVERLAP OR GAP IN HITS FOR CONNECTION THROUGH
C     CELL SIDEWALL
      IBKK(6)=2
C
C     MIN OF FIRST WIRE HIT TO TRY CONNECTION WITHIN CELL
      IBKK(8)=3
C
C     DRIFT TIME TOLERANCE FOR MATCHING
C     TRACKELS WITHIN A CELL
      BKK(9)=5.
C
C     DIFFERENCE IN THE ABS VALUES OF THE SLOPES FOR A
C     CONNECTION SKIPPING RING TWO
      BKK(10)=0.
C
C     UPPER LIMIT FOR THE VALUE OF THE SLOPE FOR EACH
C     TRACKEL TO TRY A CONNECTION SKIPPING RING TWO
      BKK(11)=0.0
C
C     BKK(12) MULTIPLIES SLOPE FOR SLOPE COMPARISON
C     IN CONNECTION THROUGH CELL SIDEWALL
      BKK(12)=1.
C
C     BKK(13) IS CONSTANT TERM FOR SLOPE COMPARISON
C     FOR CONNECTION THROUGH CELL SIDEWALL
      BKK(13)=.07
C
C     BKK(14) MULTIPLIES SLOPE FOR SLOPE COMPARISON
C     FOR CONNECTION OF TRACKELS IN ONE CELL
      BKK(14)=.02
C
C     BKK(15) IS CONSTANT TERM FOR SLOPE COMPARISON
C     FOR CONNECTION OF TRACKELS IN ONE CELL
      BKK(15)=.05
C
C     IBKK(16) NE 0 FORCES FIT BEFORE CONNECTION WITHIN CELL
      IBKK(16)=1
C
C     IBKK(17) NE 0 FORCES FIT BEFORE SIDE CONNECTION
      IBKK(17)=0
C
C     IBKK(18) NE 0 FORCES FIT BEFORE RING CONNECTION
      IBKK(18)=1
C
C     IBKK(19) IS MIN NO OF HITS FOR BACKTR
C     TO BE FORCED(BY IBKK(20) BEING NE 0) TO
C     USE L-R AMBIGUITY FROM WIRE STAGGERING
      IBKK(19)=7
C
C     IBKK(20) NE 0 FORCES BACKTR TO USE THE L-R
C     AMBIGUITY FROM WIRE STAGGERING
      IBKK(20)=1
C
C     THE XBKK ARRAY IS FOR MATCHING BETWEEN RINGS IN BACKTRACE
C     IT IS ARRANGED IN 4 GROUPS OF 8 NUMBERS
C     THE FOUR GROUPS ARE THE TOLERANCES FOR :
C         XBKK(1)-(8) : DRIFT TIME MATCHING BETWEEN RINGS
C         XBKK(9)-(16) : CONSTANT THAT MULTIPLIES SLOPE FOR
C                        SLOPE COMPARISON
C         XBKK(17)-(24) : ADDITIVE CONSTANT FOR SLOPE COMPARISON
C         XBKK(25)-(32) : CONSTANT FOR DETERMING WHETHER
C                         TRACK CROSSES WIRE PLANE AS IT
C                         GOES FROM RING TO RING
C
C       WHITHIN EACH GROUP OF 8 THE FIRST 4 NUMBERS
C       REFER TO RING TO RING CONNECTION (ALWAYS WITHIN ONE SECTOR)
C       AND THE SECOND 4 REFER TO 'CORNER' CONNECTIONS (CROSSING
C       FROM ONE SECTOR TO ANOTHER)
C
C       EACH OF THESE GROUP OF 4 NUMBERS IS FURTHER DIVIDED INTO
C       2 GROUPS OF 2
C       THE FIRST GROUP IS USED FOR THE FIRST BACKTRACE PASS
C       AND THE SECOND GROUP OF TOLERANCES FOR THE SECOND PASS
C       WITH INCREASED TOLERANCES
C
C       FINALLY, THE 2 TOLERANCES IN THE SMALLEST SUB-SECTION:
C       THE FIRST IS FOR 'NORMAL' TRACK CONNECTIONS
C       THE SECOND IS FOR CONNECTIONS WHERE AT LEAST ONE TRACKEL
C       IS SHORT (LT 8 HITS)
C
C
      XBKK(1)=1.
      XBKK(2)=1.
      XBKK(3)=3.
      XBKK(4)=4.
      XBKK(5)=1.
      XBKK(6)=1.
      XBKK(7)=3.
      XBKK(8)=4.
      XBKK(9)=.01
      XBKK(10)=.02
      XBKK(11)=.03
      XBKK(12)=.04
      XBKK(13)=.01
      XBKK(14)=.02
      XBKK(15)=.03
      XBKK(16)=.04
      XBKK(17)=.04
      XBKK(18)=.04
      XBKK(19)=.1
      XBKK(20)=.1
      XBKK(21)=.04
      XBKK(22)=.04
      XBKK(23)=.1
      XBKK(24)=.1
      XBKK(25)=1.
      XBKK(26)=2.
      XBKK(27)=5.
      XBKK(28)=10.
      XBKK(29)=3.
      XBKK(30)=6.
      XBKK(31)=6.
      XBKK(32)=10.
C
C  IYBKK(1) NE 0 FORCES FIT BEFORE SKIP-RING CONNECTION
      IYBKK(1)=0
C
C   LIMITS FOR FIT WITHIN BACKTRACE
C   YBKK(2) GIVES UPPER LIMIT FOR RMS FOR WHOLE TRACK
C    FOR CONNECTION WITHIN CELL
      YBKK(2)=.5
C
C   YBKK(3) GIVES UPPER LIMIT FOR RESIDUAL/PT FOR CANDIDATE TRACK
C    ELEMENT  FOR CONNECTION WITHIN CELL
      YBKK(3)=.5
C
C   YBKK(4) GIVES UPPER LIMIT FOR RMS FOR WHOLE TRACK
C    FOR RING CONNECTION
      YBKK(4)=.5
C
C   YBKK(5) GIVES UPPER LIMIT FOR RESIDUAL/PT FOR CANDIDATE TRACK
C    ELEMENT  FOR RING CONNECTION
      YBKK(5)=.5
C
C   YBKK(6) GIVES UPPER LIMIT FOR RMS FOR WHOLE TRACK
C    FOR SIDE CONNECTION
      YBKK(6)=5.
C
C   YBKK(7) GIVES UPPER LIMIT FOR RESIDUAL/PT FOR CANDIDATE TRACK
C    ELEMENT  FOR SIDE CONNECTION
      YBKK(7)=5.
C
C   YBKK(8) GIVES UPPER LIMIT FOR RMS FOR WHOLE TRACK
C    FOR SKIP-RING CONNECTION
      YBKK(8)=0.
22222 CONTINUE
C
C
C---------------------------------------
C     INITIALIZATION OF BAKPAK LIMITS
C---------------------------------------
C
C     IBKK(7) IS LAYER GAP FOR BAKPAK TO TRY CONNECTION
      IBKK(7) = 4
C
C     XBKK(33) IS RMS LIMIT FOR FIRST PASS IN BAKPAK
      XBKK(33)=.5
C
C
C     XBKK(34) IS RMS LIMIT FOR SECOND PASS IN BAKPAK
      XBKK(34)=1.
C
C   IYBKK(11) NE 0 CAUSES BAKPAK TO BE CALLED FOR FIRST PASS
       IYBKK(11)=0
C
C   IYBKK(15) NE 0 CAUSES BAKPAK TO BE CALLED FOR SECOND PASS
       IYBKK(15)=1
C
C    IYBKK(10) IS DIF BETWEEN EXPECTED CELL AND ACTUAL
C       CELL TO ATTEMPT CONNECTION IN BAKPAK
        IYBKK(10)=1
C
C     IXBKK(35).NE. 0 MEANS PATROL IS CALLED INSIDE BAKPAK
      IXBKK(35)=0
C
C     IYBKK(9) IS MIN NO OF HITS FOR PATROL TO FIND
C        TO MAKE SKIP RING CONNECTION IN BAKPAK
      IYBKK(9)=6
C
C     IYBKK(16) IS MIN NO OF HITS FOR PATROL TO FIND
C        TO MAKE SKIP RING CONNECTION IN BAKPAK
C       WITH WALL CROSSING IN RING 2
      IYBKK(16)=5
33333 CONTINUE
C
C
C---------------------------------------
C     INITIALIZATION OF XYFIT LIMITS
C---------------------------------------
C
C     XYFIT CONTROL WORD (VIA BIT STRUCTURE)
C     BIT ON MEANS :
C     BIT 31 .. MAKE A SINGLE FIT TO THE HITS AND STOP
C     BIT 30 .. NEVER PERFORM A CIRCLE FIT
C     BIT 29 .. RECALCULATE ABERRATIONS AND MAKE ONE MORE FIT
C     BIT 28 .. STORE TRACK ELEMENT CHI**2'S WHEN BIT 31 SET
C     BIT 27 .. STOP TRYING TO REJECT WORST TRACK ELEMENT
C     BIT 26 .. NEVER CHECK L/R SOLUTION WITH FIT
C     BIT 25 .. NOT USED
      IXYF(1) = 1
C
C     GOOD TRACK FIT CHI**2 CUT    CUT = (2) + (L/R) * (3)
      XYF(2) = 0.6
      XYF(3) = 0 0
C
C     HIT RESIDUAL CUTS            CUT = (4) + (L/R) * (5)
      XYF(4) = 3.0
      XYF(5) = 0.0
C
C     CIRCLE FIT NEVER MADE WHEN CURVATURE LESS THAN XYF(6)
C     MOM=0.03*H*RAD (MMS,KG,MEV/C)
      XYF(6) = 3.0E-4
C
C     MINIMUM SIGNIFICANT FRACTIONAL CHANGE IN CHI**2 REQUIRED TO
C     UNAMBIGUOUSLY DETERMINE LEFT/RIGHT SOLUTION
      XYF(7) = 0.2
C
C     CIRCLE FIT ITERATION LIMIT ON FRACTIONAL RADIUS ADJUSTMENT
      XYF(8) = 0.05
C
C     SPARE
      IXYF(9) = 0
C
C     CIRCLE FIT NEVER MADE WHEN PARABOLA FIT CHI**2 EXCEEDS XYF(10)
      XYF(10) = 10.0
C
C     LIMIT ON NUMBER OF LINES OF ERROR PRINT FROM FXYZ/XYFIT/PATROL
      IXYF(11) = 200
C
C     SPARE
      IXYF(15) = 0
C     SPARE
      IXYF(16) = 0
C     SPARE
      IXYF(17) = 0
C     Z-AMPLITUDE DOUBLE HIT RESOLUTION
      IXYF(18) = 0
C     PRINT FLAG (FXYZ)
      IXYF(19) = 0
C     PRINT FLAG (XYFIT)
      IXYF(20) = 0
44444 CONTINUE
C---------------------------------------
C     INITIALIZATION OF PATROL TOLERANCES
C---------------------------------------
C
C     PATROL CONTROL WORD
C     BIT 31 .. NEVER CALL A RE-FIT AFTER FINDING EXTRA HITS
C     BIT 30 .. ONLY SEARCH RINGS "WITHOUT" HITS ON THIS TRACK
C     BIT 29 .. IGNORE ALL HITS THAT "ARE" ON TRACK ELEMENTS
C     BIT 28 .. ONLY SEARCH RINGS "WITH" HITS ALREADY ON THIS TRACK
C     BIT 27 .. SPARE
C     BIT 26 .. SPARE
C     BIT 25 .. IGNORE ALL HITS THAT "ARE NOT" ON TRACK ELEMENTS
      IGFP(1) = 0
C
C     RMS OF FIT AT WHICH PATROL NOT RUN.
      GFP(2) = 3.
C
C     DOUBLE HIT RESOLUTION .. DONT LOOK FOR MORE HITS CLOSER THAN THIS
C                                           NOW IN ADPATR
C     GFP(3) = 4.5
C
C     HIT RESIDUAL CUTS            CUT = (4) + (L/R) * (5)
      GFP(4) = 2.9
      GFP(5) = 0.0
C
C     MAXIMUM # OF SUCCESSIVE FRUITLESS LAYERS ALLOWED IN NEW RING
      IGFP(6) = 3
C
C     MAXIMUM RADIAL GAP ON EXTRAPOLATION
       GFP(7) = 50.0
C
C     DELTA(R) TO DEFINE CONSECUTIVE HITS
       GFP(8) = 15.0
C
C     MINIMUM # OF CONSECUTIVE HITS REQUIRED ON EXTRAPOLATION
      IGFP(9) = 2
C
C     NO. NEW HITS FOUND BEFORE RE-FIT CALLED
      IGFP(10) = 3
C
C     WALL CROSSING LIMIT
      GFP(11) = 0.8
C
C     EXTRA HOLE SIZE ALLOWED ON GFP(7) WHEN CROSSING RING GAP
      GFP(12) = 50.0
C     MAXIMUM NUMBER OF RE-FITS
      IGFP(13) = 10
C
C     CURVATURE ABOVE WHICH PATROL NOT CALLED
      GFP(14) = 1.0E-2
C
C     ITERATION LIMIT ON CONVERTING PARABOLA TO CIRCLE
      GFP(15) = 0.05
C     SPARE
      IGFP(16) = 0
C     SPARE
      IGFP(17) = 0
C     SPARE
      IGFP(18) = 0
C     SPARE
      IGFP(19) = 0
C     PRINT FLAG
      IGFP(20) = 0
55555 CONTINUE
C----------------------------
C     INITIALISE ZRFIT LIMITS
C----------------------------
C
C     LIMIT FOR RMS OF FIT
C                                           NOW IN ADPATR
C     ZFITLM( 1) =   50.
C
C     SIGMA OF Z
C                                           NOW IN ADPATR
C     ZFITLM( 2) =   20.
C
C     LIMIT FOR HITS PER SEGMENT
      LMZFIT( 3) = 6
C
C     LIMIT FOR # OF SEGMENTS
      LMZFIT( 4) = 2
C
C     LIMIT FOR # OF SEGMENTS
      ZFITLM( 5) = .05
C
C     LIMIT FOR DELTA(R) FOR VERTEX DET.
      ZFITLM( 6) =   50.
C
C     LABEL FOR HIT SELECTION PREPROCESSOR
      LMZFIT(10) = 2
C
C--------------------------------------------
C     INITIALISATION OF ADMINISTRATION LIMITS
C--------------------------------------------
C
C     INITIALIZATION OF IMCERT
C     1 = NO DELETION OF COVERED + SHORT TRACKS
C     0 = DELETION OF COVERED + SHORT TRACKS
      IMCERT=0
C
C     IXBKK(40) NE 0 MEANS KNTREL ITERATES WITH
C     UPDATED BACKTR ARRAYS
      IXBKK(40)=0
C
C     IXBKK(39) GIVES MAX NO OF ALLOWED ITERATIONS
      IXBKK(39)=2
C
C     IXBKK(38) NE 0 CAUSES PRINT IN KNTREL
C     BIT 31 ON - MIN PRINT
C     BIT 30 ON - HIT LABEL IN CWORK
C     BIT 29 ON - HIT LABEL IN CDATA
C     BIT 28 ON - PCWORK PRINT
C     BIT 26 ON - BAKPAK PRINT
      IXBKK(38)=0
C
C     IXBKK(37) IS MIN NO OF UNUSED HITS LEFT ON A TRACKEL
C     FOR IT TO BE BROUGHT BACK AS A SEPARATE TRACK
      IXBKK(37)=5
C
C     IXBKK(36) IS MAX NO OF HITS LEFT UNCORRELATED
C     BEFORE TRACKEL IS ASSIGNED TO TRACK
      IXBKK(36)=1
C
C     IYBKK(14) .NE. 0  CAUSES BACKGROUND TRACKS TO BE DELETED
        IYBKK(14)=1
C
C     YBKK(12) IS LOWER LIMIT ON CURVATURE FOR DEFINITION
C      OF BACKGROUND TRACK
       YBKK(12)=.003
C
C      YBKK(13) IS UPPER LIMIT ON COS OF ANGLE THAT THE SARTPOINT
C      OF THE TRACK MAKES WITH WIRE PLANE TO DEFINE A BACKGROUND TRACK
      YBKK(13)=.9
C
C       YBKK(15) IS INTERSECT OF TRACK WITH BEAM LINE
C        ABOVE WHICH TRACK IS DELETED AS BACKGROUND
         YBKK(15)=100.
C
C    ******* SPECIAL FOR TEST OF ZCHECK **************
      IYBKK(20)=0
C--------------------------------------------------------------------
C
C           END OF  IPFAST = 1  SECTION OF INPATR
C
C--------------------------------------------------------------------
C
        IF(IPFAST.EQ.1) RETURN
        IF(IPFAST.EQ.2) GO TO 102
C
C
C
C
C
C#####################################################################
C FASTEST LEAST EFFICIENT PATREC .. IPFAST=0
C ==============================
C       OVERWRITE SOME LIMITS TO GET FAST VERSION OF PATREC
C#####################################################################
66666 CONTINUE
C
C
C-----------------------------
C     INITIALISE FTRKEL LIMITS
C-----------------------------
C
C     MAX.# OF REJECTED HITS BEFORE CUT OF TREL
      LMTREL( 6) =   1
C
C     LIMIT OF CURV/2 FOR FIT OF 4-5-HIT TREL
      TRELLM( 9) = .005
C
C     LIMITS FOR # OF HITS / TREL
      LMTREL(13) = 6
C
C     SIGMA OF GOOD FIT
      TRELLM(14) = .30
C
C     LIMIT OF SIGMA FOR TREL-FIT
      TRELLM(16) = 0.45
C
C-----------------------------
C     INITIALISE BACKTR LIMITS
C-----------------------------
C
C     IBKK(16) NE 0 FORCES FIT BEFORE CONNECTION WITHIN CELL
      IBKK(16)=0
C
C     IBKK(17) NE 0 FORCES FIT BEFORE SIDE CONNECTION
      IBKK(17)=0
C
C     IBKK(18) NE 0 FORCES FIT BEFORE RING CONNECTION
      IBKK(18)=0
C
C     THE XBKK ARRAY IS FOR MATCHING BETWEEN RINGS IN BACKTRACE
C     IT IS ARRANGED IN 4 GROUPS OF 8 NUMBERS
C     THE FOUR GROUPS ARE THE TOLERANCES FOR :
C         XBKK(1)-(8) : DRIFT TIME MATCHING BETWEEN RINGS
C         XBKK(9)-(16) : CONSTANT THAT MULTIPLIES SLOPE FOR
C                        SLOPE COMPARISON
C         XBKK(17)-(24) : ADDITIVE CONSTANT FOR SLOPE COMPARISON
C         XBKK(25)-(32) : CONSTANT FOR DETERMING WHETHER
C                         TRACK CROSSES WIRE PLANE AS IT
C                         GOES FROM RING TO RING
C
C       WHITHIN EACH GROUP OF 8 THE FIRST 4 NUMBERS
C       REFER TO RING TO RING CONNECTION (ALWAYS WITHIN ONE SECTOR)
C       AND THE SECOND 4 REFER TO 'CORNER' CONNECTIONS (CROSSING
C       FROM ONE SECTOR TO ANOTHER)
C
C       EACH OF THESE GROUP OF 4 NUMBERS IS FURTHER DIVIDED INTO
C       2 GROUPS OF 2
C       THE FIRST GROUP IS USED FOR THE FIRST BACKTRACE PASS
C       AND THE SECOND GROUP OF TOLERANCES FOR THE SECOND PASS
C       WITH INCREASED TOLERANCES
C
C       FINALLY, THE 2 TOLERANCES IN THE SMALLEST SUB-SECTION:
C       THE FIRST IS FOR 'NORMAL' TRACK CONNECTIONS
C       THE SECOND IS FOR CONNECTIONS WHERE AT LEAST ONE TRACKEL
C       IS SHORT (LT 8 HITS)
C
      XBKK(1)=8.
      XBKK(2)=8.
      XBKK(3)=20.
      XBKK(4)=45.
      XBKK(5)=8.
      XBKK(6)=8.
      XBKK(7)=20.
      XBKK(8)=45.
      XBKK(9)=.05
      XBKK(10)=.08
      XBKK(11)=.12
      XBKK(12)=.17
      XBKK(13)=.06
      XBKK(14)=.12
      XBKK(15)=.12
      XBKK(16)=.17
      XBKK(17)=.12
      XBKK(18)=.12
      XBKK(19)=.40
      XBKK(20)=.40
      XBKK(21)=.12
      XBKK(22)=.25
      XBKK(23)=.4
      XBKK(24)=.4
      XBKK(25)=1.
      XBKK(26)=2.
      XBKK(27)=5.
      XBKK(28)=10.
      XBKK(29)=3.
      XBKK(30)=6.
      XBKK(31)=6.
      XBKK(32)=10.
77777 CONTINUE
C
C
C---------------------------------------
C     INITIALIZATION OF BAKPAK LIMITS
C---------------------------------------
C
C   IYBKK(11) NE 0 CAUSES BAKPAK TO BE CALLED FOR FIRST PASS
       IYBKK(11)=0
C
C   IYBKK(15) NE 0 CAUSES BAKPAK TO BE CALLED FOR SECOND PASS
       IYBKK(15)=0
C
C
C
C---------------------------------------
C     INITIALIZATION OF XYFIT LIMITS
C---------------------------------------
C
C
C     1).NO CLEVER HIT DELETION BY FIT
C     2).KILL ALL CIRCLE FITS
      IXYF(1)=3
C---------------------------------------
C     INITIALIZATION OF PATROL LIMITS
C---------------------------------------
C
C     KILL PATROL COMPLETELY
      GFP(2) = 0.
C
C----------------------------
C     INITIALISE ZRFIT LIMITS
C----------------------------
C
C     LABEL FOR HIT SELECTION PREPROCESSOR
      LMZFIT(10) = 2
C
C--------------------------------------------
C     INITIALISATION OF ADMINISTRATION LIMITS
C--------------------------------------------
C
C     INITIALIZATION OF IMCERT
C     1 = NO DELETION OF COVERED + SHORT TRACKS
C     0 = DELETION OF COVERED + SHORT TRACKS
      IMCERT=0
C
C     IXBKK(40) NE 0 MEANS KNTREL ITERATES WITH
C     UPDATED BACKTR ARRAYS
      IXBKK(40)=0
C
C     IXBKK(39) GIVES MAX NO OF ALLOWED ITERATIONS
      IXBKK(39)=0
C
C     IYBKK(14) .NE. 0  CAUSES BACKGROUND TRACKS TO BE DELETED
        IYBKK(14)=0
C
      RETURN
C
C--------------------------------------------------------------------
C           END OF  IPFAST = 0  SECTION OF INPATR
C--------------------------------------------------------------------
C
C
 102   CONTINUE
C
C
C
C
C
C#####################################################################
C SLOWEST BUT BEST VERSION OF PATREC .. IPFAST=2
C ==================================
C       OVERWRITE SOME LIMITS TO GET EFFICIENT VERSION OF PATREC
C#####################################################################
C
C
C---------------------------------------
C     INITIALIZATION OF BAKPAK LIMITS
C---------------------------------------
C
C   IYBKK(11) NE 0 CAUSES BAKPAK TO BE CALLED FOR FIRST PASS
       IYBKK(11)=1
C
C     IXBKK(35).NE. 0 MEANS PATROL IS CALLED INSIDE BAKPAK
      IXBKK(35)=1
C
C
C
C--------------------------------------------
C     INITIALISATION OF ADMINISTRATION LIMITS
C--------------------------------------------
C
C     IXBKK(39) GIVES MAX NO OF ALLOWED ITERATIONS
      IXBKK(39)=5
C
      RETURN
C--------------------------------------------------------------------
C           END OF  IPFAST = 2  SECTION OF INPATR
C--------------------------------------------------------------------
C
      END
      BLOCK DATA
C
      IMPLICIT INTEGER*2 (H)
C
#include "cpatlm.for"
C
       DATA IPFAST/2/
       END
C   08/12/80 201131512  MEMBER NAME  INPATR8  (JADESR)      FORTRAN
      SUBROUTINE INPATR
C
C----------------------------------------------------------------------
C   INITIALISATION OF PATTERN RECOGNITION PROGRAM LIMITS AND TOLERANCES
C   AUTHORED BY A VARIETY OF PEOPLE.
C----------------------------------------------------------------------
C
      IMPLICIT INTEGER*2 (H)
#include "cpatlm.for"
#include "cgraph.for"
C
C--------------------------------------------------------------------
C
C       IPFAST = 2 MEANS SLOWEST, MOST EFFICIENT VERSION
C                    OF PATTERN RECOGNITION
C
C       IPFAST = 1 MEANS INTERMEDIATE VERSION OF PATTERN RECOGNITION
C
C       IPFAST = 0 MEANS FASTEST VERSION OF PATTERN RECOGNITION
C
C--------------------------------------------------------------------
C
        IF(IPFAST.NE.0.AND.IPFAST.NE.2.AND.IPFAST.NE.1)
     %  WRITE(6,256) IPFAST
  256  FORMAT('0 @@@@@@@ ERROR IN INPATR INITIALIZATION , IPFAST=',I10,
     *'  IPFAST SET TO 2')
        IF(IPFAST.NE.0.AND.IPFAST.NE.2.AND.IPFAST.NE.1) IPFAST=2
C
C
C
C---------------------------------------------------------------------
C INTERMEDIATE PATREC .. IPFAST=1
C ===================
C
C---------------------------------------------------------------------
C
C-----------------------------
C     INITIALISE PATREC LIMITS
C-----------------------------
C
C     MIN. NUMBER OF HITS IN A CELL
      LMPATR(1) = 8
C
C     WEIGHT OF ORIGIN IN FINAL R-FI-FIT
      PATRLM(2) = 0.00
C
C     LENGTH OF ARRAY WRK IN /CWORK/
      LMPATR(5) = 6000
      LMPATR(5) = 7000
C
C-----------------------------
C     INITIALISE FLINEL LIMITS
C-----------------------------
C
C     LIMIT FOR DEF. OF CLOSE HITS
      FLINLM(1) = 10.
C
C     LIMIT FOR SLOPE AGREEMENT
      FLINLM(2) = 3.0
C-----------------------------
C     INITIALISE FTRKEL LIMITS
C-----------------------------
C
C     STAGGERING (*4)
      TRELLM( 1) = 2.40
C
C     LIMIT ON DEV. FROM STAGGERING  (*4)
      TRELLM( 2) = 2.50
C
C     MAX (STAGG.DIST. * (-1)**ILAY)
      TRELLM( 3) = .20
C
C     MAX. RMS OF GOOD TREL: SIG0 = (4)+(5)*CURV
      TRELLM( 4) = 0.35
      TRELLM( 5) = 0.15
C
C     MAX.# OF REJECTED HITS BEFORE CUT OF TREL
      LMTREL( 6) =   2
C
C     MIN. |SIGL-SIGR| FOR L/R DET.
      TRELLM( 7) = 0.10
C
C     SPECIAL LIMIT FOR STRAIGHT TRACKS AT ZERO
      TRELLM( 8) = 4.0
C
C     LIMIT OF CURV/2 FOR FIT OF 4-5-HIT TREL
      TRELLM( 9) = .05
C
C     LIMITS FOR ZERO APPROACHING TREL
      TRELLM(10) = 1.0
      TRELLM(11) = .10
      TRELLM(12) = 1000000.
C
C     LIMITS FOR # OF HITS / TREL
      LMTREL(13) = 4
C
C     SIGMA OF GOOD FIT
      TRELLM(14) = .24
C
C     MIN. DISTANEC OF 'ZERO APPROACHING TREL'
      TRELLM(15) = 1.0
C
C     LIMIT OF SIGMA FOR TREL-FIT
      TRELLM(16) = 0.25
C
C     LIMIT OF SIGMA FOR TREL-FIT *(# OF END POINTS AT WALL)
      TRELLM(17) = 0.35
C
C     LIMIT OF SIGMA FOR TREL-FIT *(# OF ENDPOINTS AT WIREPLANE)
      TRELLM(18) = 0.15
C
C     L/R DETERMINED IF |SIGL**2-SIGR**2|<LIMIT
      TRELLM(19) = 0.10
C
C     NOT YET USED
      TRELLM(20) = 0.0
11111 CONTINUE
C-----------------------------
C     INITIALISE BACKTR LIMITS
C-----------------------------
C
C     OVERLAP OF HITS FOR JOIN OF TRACKELS IN CELL
      IBKK(1)=1
C
C     GAP IN HITS FOR JOIN OF TRACKELS IN ONE CELL
      IBKK(2)=2
C
C     IF THE LAST WIRE HIT IS LESS THAN IBKK(3) OR FIRST
      IBKK(4)=3
C
C     WIRE GREATER THAN IBKK(4) A CHECK IS MADE TO SEE WHETHER
C     THE TRACK PASSES THROUGH THE CELL SIDEWALL
      IBKK(3)=12
C
C     FOR JOINING OF TWO TRACKELS IN ONE CELL AND FOR THE TRACKELS
C     TO BE CONSIDERED ON OPPOSITE SIDES OF THE WIRE PLANE:
C     THE SLOPES MUST BE CORRECT,CROSSING FLAGS CORRECT AND
C     DS1 OR DS2  .LT.BKK(5)
      BKK(5)=15.
C
C     OVERLAP OR GAP IN HITS FOR CONNECTION THROUGH
C     CELL SIDEWALL
      IBKK(6)=2
C
C     MIN OF FIRST WIRE HIT TO TRY CONNECTION WITHIN CELL
      IBKK(8)=3
C
C     DRIFT TIME TOLERANCE FOR MATCHING
C     TRACKELS WITHIN A CELL
      BKK(9)=5.
C
C     DIFFERENCE IN THE ABS VALUES OF THE SLOPES FOR A
C     CONNECTION SKIPPING RING TWO
      BKK(10)=0.
C
C     UPPER LIMIT FOR THE VALUE OF THE SLOPE FOR EACH
C     TRACKEL TO TRY A CONNECTION SKIPPING RING TWO
      BKK(11)=0.0
C
C     BKK(12) MULTIPLIES SLOPE FOR SLOPE COMPARISON
C     IN CONNECTION THROUGH CELL SIDEWALL
      BKK(12)=1.
C
C     BKK(13) IS CONSTANT TERM FOR SLOPE COMPARISON
C     FOR CONNECTION THROUGH CELL SIDEWALL
      BKK(13)=.07
C
C     BKK(14) MULTIPLIES SLOPE FOR SLOPE COMPARISON
C     FOR CONNECTION OF TRACKELS IN ONE CELL
      BKK(14)=.02
C
C     BKK(15) IS CONSTANT TERM FOR SLOPE COMPARISON
C     FOR CONNECTION OF TRACKELS IN ONE CELL
      BKK(15)=.05
C
C     IBKK(16) NE 0 FORCES FIT BEFORE CONNECTION WITHIN CELL
      IBKK(16)=1
C
C     IBKK(17) NE 0 FORCES FIT BEFORE SIDE CONNECTION
      IBKK(17)=0
C
C     IBKK(18) NE 0 FORCES FIT BEFORE RING CONNECTION
      IBKK(18)=1
C
C     IBKK(19) IS MIN NO OF HITS FOR BACKTR
C     TO BE FORCED(BY IBKK(20) BEING NE 0) TO
C     USE L-R AMBIGUITY FROM WIRE STAGGERING
      IBKK(19)=7
C
C     IBKK(20) NE 0 FORCES BACKTR TO USE THE L-R
C     AMBIGUITY FROM WIRE STAGGERING
      IBKK(20)=1
C
C     THE XBKK ARRAY IS FOR MATCHING BETWEEN RINGS IN BACKTRACE
C     IT IS ARRANGED IN 4 GROUPS OF 8 NUMBERS
C     THE FOUR GROUPS ARE THE TOLERANCES FOR :
C         XBKK(1)-(8) : DRIFT TIME MATCHING BETWEEN RINGS
C         XBKK(9)-(16) : CONSTANT THAT MULTIPLIES SLOPE FOR
C                        SLOPE COMPARISON
C         XBKK(17)-(24) : ADDITIVE CONSTANT FOR SLOPE COMPARISON
C         XBKK(25)-(32) : CONSTANT FOR DETERMING WHETHER
C                         TRACK CROSSES WIRE PLANE AS IT
C                         GOES FROM RING TO RING
C
C       WHITHIN EACH GROUP OF 8 THE FIRST 4 NUMBERS
C       REFER TO RING TO RING CONNECTION (ALWAYS WITHIN ONE SECTOR)
C       AND THE SECOND 4 REFER TO 'CORNER' CONNECTIONS (CROSSING
C       FROM ONE SECTOR TO ANOTHER)
C
C       EACH OF THESE GROUP OF 4 NUMBERS IS FURTHER DIVIDED INTO
C       2 GROUPS OF 2
C       THE FIRST GROUP IS USED FOR THE FIRST BACKTRACE PASS
C       AND THE SECOND GROUP OF TOLERANCES FOR THE SECOND PASS
C       WITH INCREASED TOLERANCES
C
C       FINALLY, THE 2 TOLERANCES IN THE SMALLEST SUB-SECTION:
C       THE FIRST IS FOR 'NORMAL' TRACK CONNECTIONS
C       THE SECOND IS FOR CONNECTIONS WHERE AT LEAST ONE TRACKEL
C       IS SHORT (LT 8 HITS)
C
C
      XBKK(1)=1.
      XBKK(2)=1.
      XBKK(3)=3.
      XBKK(4)=4.
      XBKK(5)=1.
      XBKK(6)=1.
      XBKK(7)=3.
      XBKK(8)=4.
      XBKK(9)=.01
      XBKK(10)=.02
      XBKK(11)=.03
      XBKK(12)=.04
      XBKK(13)=.01
      XBKK(14)=.02
      XBKK(15)=.03
      XBKK(16)=.04
      XBKK(17)=.04
      XBKK(18)=.04
      XBKK(19)=.1
      XBKK(20)=.1
      XBKK(21)=.04
      XBKK(22)=.04
      XBKK(23)=.1
      XBKK(24)=.1
      XBKK(25)=1.
      XBKK(26)=2.
      XBKK(27)=5.
      XBKK(28)=10.
      XBKK(29)=3.
      XBKK(30)=6.
      XBKK(31)=6.
      XBKK(32)=10.
C
C  IYBKK(1) NE 0 FORCES FIT BEFORE SKIP-RING CONNECTION
      IYBKK(1)=0
C
C   LIMITS FOR FIT WITHIN BACKTRACE
C   YBKK(2) GIVES UPPER LIMIT FOR RMS FOR WHOLE TRACK
C    FOR CONNECTION WITHIN CELL
      YBKK(2)=.5
C
C   YBKK(3) GIVES UPPER LIMIT FOR RESIDUAL/PT FOR CANDIDATE TRACK
C    ELEMENT  FOR CONNECTION WITHIN CELL
      YBKK(3)=.5
C
C   YBKK(4) GIVES UPPER LIMIT FOR RMS FOR WHOLE TRACK
C    FOR RING CONNECTION
      YBKK(4)=.5
C
C   YBKK(5) GIVES UPPER LIMIT FOR RESIDUAL/PT FOR CANDIDATE TRACK
C    ELEMENT  FOR RING CONNECTION
      YBKK(5)=.5
C
C   YBKK(6) GIVES UPPER LIMIT FOR RMS FOR WHOLE TRACK
C    FOR SIDE CONNECTION
      YBKK(6)=5.
C
C   YBKK(7) GIVES UPPER LIMIT FOR RESIDUAL/PT FOR CANDIDATE TRACK
C    ELEMENT  FOR SIDE CONNECTION
      YBKK(7)=5.
C
C   YBKK(8) GIVES UPPER LIMIT FOR RMS FOR WHOLE TRACK
C    FOR SKIP-RING CONNECTION
      YBKK(8)=0.
22222 CONTINUE
C
C
C---------------------------------------
C     INITIALIZATION OF BAKPAK LIMITS
C---------------------------------------
C
C     IBKK(7) IS LAYER GAP FOR BAKPAK TO TRY CONNECTION
      IBKK(7) = 4
C
C     XBKK(33) IS RMS LIMIT FOR FIRST PASS IN BAKPAK
      XBKK(33)=.5
C
C
C     XBKK(34) IS RMS LIMIT FOR SECOND PASS IN BAKPAK
      XBKK(34)=1.
C
C   IYBKK(11) NE 0 CAUSES BAKPAK TO BE CALLED FOR FIRST PASS
       IYBKK(11)=0
C
C   IYBKK(15) NE 0 CAUSES BAKPAK TO BE CALLED FOR SECOND PASS
       IYBKK(15)=1
C
C    IYBKK(10) IS DIF BETWEEN EXPECTED CELL AND ACTUAL
C       CELL TO ATTEMPT CONNECTION IN BAKPAK
        IYBKK(10)=1
C
C     IXBKK(35).NE. 0 MEANS PATROL IS CALLED INSIDE BAKPAK
      IXBKK(35)=0
C
C     IYBKK(9) IS MIN NO OF HITS FOR PATROL TO FIND
C        TO MAKE SKIP RING CONNECTION IN BAKPAK
      IYBKK(9)=6
C
C     IYBKK(16) IS MIN NO OF HITS FOR PATROL TO FIND
C        TO MAKE SKIP RING CONNECTION IN BAKPAK
C       WITH WALL CROSSING IN RING 2
      IYBKK(16)=5
33333 CONTINUE
C
C
C---------------------------------------
C     INITIALIZATION OF XYFIT LIMITS
C---------------------------------------
C
C     XYFIT CONTROL WORD (VIA BIT STRUCTURE)
C     BIT ON MEANS :
C     BIT 31 .. MAKE A SINGLE FIT TO THE HITS AND STOP
C     BIT 30 .. NEVER PERFORM A CIRCLE FIT
C     BIT 29 .. RECALCULATE ABERRATIONS AND MAKE ONE MORE FIT
C     BIT 28 .. STORE TRACK ELEMENT CHI**2'S WHEN BIT 31 SET
C     BIT 27 .. STOP TRYING TO REJECT WORST TRACK ELEMENT
C     BIT 26 .. NEVER CHECK L/R SOLUTION WITH FIT
C     BIT 25 .. NOT USED
      IXYF(1) = 1
C
C     GOOD TRACK FIT CHI**2 CUT    CUT = (2) + (L/R) * (3)
      XYF(2) = 0.6
      XYF(3) = 0 0
C
C     HIT RESIDUAL CUTS            CUT = (4) + (L/R) * (5)
      XYF(4) = 3.0
      XYF(5) = 0.0
C
C     CIRCLE FIT NEVER MADE WHEN CURVATURE LESS THAN XYF(6)
C     MOM=0.03*H*RAD (MMS,KG,MEV/C)
      XYF(6) = 3.0E-4
C
C     MINIMUM SIGNIFICANT FRACTIONAL CHANGE IN CHI**2 REQUIRED TO
C     UNAMBIGUOUSLY DETERMINE LEFT/RIGHT SOLUTION
      XYF(7) = 0.2
C
C     CIRCLE FIT ITERATION LIMIT ON FRACTIONAL RADIUS ADJUSTMENT
      XYF(8) = 0.05
C
C     SPARE
      IXYF(9) = 0
C
C     CIRCLE FIT NEVER MADE WHEN PARABOLA FIT CHI**2 EXCEEDS XYF(10)
      XYF(10) = 10.0
C
C     LIMIT ON NUMBER OF LINES OF ERROR PRINT FROM FXYZ/XYFIT/PATROL
      IXYF(11) = 200
C
C     SPARE
      IXYF(15) = 0
C     SPARE
      IXYF(16) = 0
C     SPARE
      IXYF(17) = 0
C     Z-AMPLITUDE DOUBLE HIT RESOLUTION
      IXYF(18) = 0
C     PRINT FLAG (FXYZ)
      IXYF(19) = 0
C     PRINT FLAG (XYFIT)
      IXYF(20) = 0
44444 CONTINUE
C---------------------------------------
C     INITIALIZATION OF PATROL TOLERANCES
C---------------------------------------
C
C     PATROL CONTROL WORD
C     BIT 31 .. NEVER CALL A RE-FIT AFTER FINDING EXTRA HITS
C     BIT 30 .. ONLY SEARCH RINGS "WITHOUT" HITS ON THIS TRACK
C     BIT 29 .. IGNORE ALL HITS THAT "ARE" ON TRACK ELEMENTS
C     BIT 28 .. ONLY SEARCH RINGS "WITH" HITS ALREADY ON THIS TRACK
C     BIT 27 .. SPARE
C     BIT 26 .. SPARE
C     BIT 25 .. IGNORE ALL HITS THAT "ARE NOT" ON TRACK ELEMENTS
      IGFP(1) = 0
C
C     RMS OF FIT AT WHICH PATROL NOT RUN.
      GFP(2) = 3.
C
C     DOUBLE HIT RESOLUTION .. DONT LOOK FOR MORE HITS CLOSER THAN THIS
      GFP(3) = 4.5
C
C     HIT RESIDUAL CUTS            CUT = (4) + (L/R) * (5)
      GFP(4) = 2.9
      GFP(5) = 0.0
C
C     MAXIMUM # OF SUCCESSIVE FRUITLESS LAYERS ALLOWED IN NEW RING
      IGFP(6) = 3
C
C     MAXIMUM RADIAL GAP ON EXTRAPOLATION
       GFP(7) = 50.0
C
C     DELTA(R) TO DEFINE CONSECUTIVE HITS
       GFP(8) = 15.0
C
C     MINIMUM # OF CONSECUTIVE HITS REQUIRED ON EXTRAPOLATION
      IGFP(9) = 2
C
C     NO. NEW HITS FOUND BEFORE RE-FIT CALLED
      IGFP(10) = 3
C
C     WALL CROSSING LIMIT
      GFP(11) = 0.8
C
C     EXTRA HOLE SIZE ALLOWED ON GFP(7) WHEN CROSSING RING GAP
      GFP(12) = 50.0
C     MAXIMUM NUMBER OF RE-FITS
      IGFP(13) = 10
C
C     CURVATURE ABOVE WHICH PATROL NOT CALLED
      GFP(14) = 1.0E-2
C
C     ITERATION LIMIT ON CONVERTING PARABOLA TO CIRCLE
      GFP(15) = 0.05
C     SPARE
      IGFP(16) = 0
C     SPARE
      IGFP(17) = 0
C     SPARE
      IGFP(18) = 0
C     SPARE
      IGFP(19) = 0
C     PRINT FLAG
      IGFP(20) = 0
55555 CONTINUE
C----------------------------
C     INITIALISE ZRFIT LIMITS
C----------------------------
C
C     LIMIT FOR RMS OF FIT
      ZFITLM( 1) =   50.
C
C     SIGMA OF Z
      ZFITLM( 2) =   20.
C
C     LIMIT FOR HITS PER SEGMENT
      LMZFIT( 3) = 6
C
C     LIMIT FOR # OF SEGMENTS
      LMZFIT( 4) = 2
C
C     LIMIT FOR # OF SEGMENTS
      ZFITLM( 5) = .05
C
C     LIMIT FOR DELTA(R) FOR VERTEX DET.
      ZFITLM( 6) =   50.
C
C     LABEL FOR HIT SELECTION PREPROCESSOR
      LMZFIT(10) = 2
C
C--------------------------------------------
C     INITIALISATION OF ADMINISTRATION LIMITS
C--------------------------------------------
C
C     INITIALIZATION OF IMCERT
C     1 = NO DELETION OF COVERED + SHORT TRACKS
C     0 = DELETION OF COVERED + SHORT TRACKS
      IMCERT=0
C
C     IXBKK(40) NE 0 MEANS KNTREL ITERATES WITH
C     UPDATED BACKTR ARRAYS
      IXBKK(40)=0
C
C     IXBKK(39) GIVES MAX NO OF ALLOWED ITERATIONS
      IXBKK(39)=2
C
C     IXBKK(38) NE 0 CAUSES PRINT IN KNTREL
C     BIT 31 ON - MIN PRINT
C     BIT 30 ON - HIT LABEL IN CWORK
C     BIT 29 ON - HIT LABEL IN CDATA
C     BIT 28 ON - PCWORK PRINT
C     BIT 26 ON - BAKPAK PRINT
      IXBKK(38)=0
C
C     IXBKK(37) IS MIN NO OF UNUSED HITS LEFT ON A TRACKEL
C     FOR IT TO BE BROUGHT BACK AS A SEPARATE TRACK
      IXBKK(37)=5
C
C     IXBKK(36) IS MAX NO OF HITS LEFT UNCORRELATED
C     BEFORE TRACKEL IS ASSIGNED TO TRACK
      IXBKK(36)=1
C
C     IYBKK(14) .NE. 0  CAUSES BACKGROUND TRACKS TO BE DELETED
        IYBKK(14)=1
C
C     YBKK(12) IS LOWER LIMIT ON CURVATURE FOR DEFINITION
C      OF BACKGROUND TRACK
       YBKK(12)=.003
C
C      YBKK(13) IS UPPER LIMIT ON COS OF ANGLE THAT THE SARTPOINT
C      OF THE TRACK MAKES WITH WIRE PLANE TO DEFINE A BACKGROUND TRACK
      YBKK(13)=.9
C
C       YBKK(15) IS INTERSECT OF TRACK WITH BEAM LINE
C        ABOVE WHICH TRACK IS DELETED AS BACKGROUND
         YBKK(15)=100.
C
C    ******* SPECIAL FOR TEST OF ZCHECK **************
      IYBKK(20)=0
C--------------------------------------------------------------------
C
C           END OF  IPFAST = 1  SECTION OF INPATR
C
C--------------------------------------------------------------------
C
        IF(IPFAST.EQ.1) RETURN
        IF(IPFAST.EQ.2) GO TO 102
C
C
C
C
C
C#####################################################################
C FASTEST LEAST EFFICIENT PATREC .. IPFAST=0
C ==============================
C       OVERWRITE SOME LIMITS TO GET FAST VERSION OF PATREC
C#####################################################################
66666 CONTINUE
C
C
C-----------------------------
C     INITIALISE FTRKEL LIMITS
C-----------------------------
C
C     MAX.# OF REJECTED HITS BEFORE CUT OF TREL
      LMTREL( 6) =   1
C
C     LIMIT OF CURV/2 FOR FIT OF 4-5-HIT TREL
      TRELLM( 9) = .005
C
C     LIMITS FOR # OF HITS / TREL
      LMTREL(13) = 6
C
C     SIGMA OF GOOD FIT
      TRELLM(14) = .30
C
C     LIMIT OF SIGMA FOR TREL-FIT
      TRELLM(16) = 0.45
C
C-----------------------------
C     INITIALISE BACKTR LIMITS
C-----------------------------
C
C     IBKK(16) NE 0 FORCES FIT BEFORE CONNECTION WITHIN CELL
      IBKK(16)=0
C
C     IBKK(17) NE 0 FORCES FIT BEFORE SIDE CONNECTION
      IBKK(17)=0
C
C     IBKK(18) NE 0 FORCES FIT BEFORE RING CONNECTION
      IBKK(18)=0
C
C     THE XBKK ARRAY IS FOR MATCHING BETWEEN RINGS IN BACKTRACE
C     IT IS ARRANGED IN 4 GROUPS OF 8 NUMBERS
C     THE FOUR GROUPS ARE THE TOLERANCES FOR :
C         XBKK(1)-(8) : DRIFT TIME MATCHING BETWEEN RINGS
C         XBKK(9)-(16) : CONSTANT THAT MULTIPLIES SLOPE FOR
C                        SLOPE COMPARISON
C         XBKK(17)-(24) : ADDITIVE CONSTANT FOR SLOPE COMPARISON
C         XBKK(25)-(32) : CONSTANT FOR DETERMING WHETHER
C                         TRACK CROSSES WIRE PLANE AS IT
C                         GOES FROM RING TO RING
C
C       WHITHIN EACH GROUP OF 8 THE FIRST 4 NUMBERS
C       REFER TO RING TO RING CONNECTION (ALWAYS WITHIN ONE SECTOR)
C       AND THE SECOND 4 REFER TO 'CORNER' CONNECTIONS (CROSSING
C       FROM ONE SECTOR TO ANOTHER)
C
C       EACH OF THESE GROUP OF 4 NUMBERS IS FURTHER DIVIDED INTO
C       2 GROUPS OF 2
C       THE FIRST GROUP IS USED FOR THE FIRST BACKTRACE PASS
C       AND THE SECOND GROUP OF TOLERANCES FOR THE SECOND PASS
C       WITH INCREASED TOLERANCES
C
C       FINALLY, THE 2 TOLERANCES IN THE SMALLEST SUB-SECTION:
C       THE FIRST IS FOR 'NORMAL' TRACK CONNECTIONS
C       THE SECOND IS FOR CONNECTIONS WHERE AT LEAST ONE TRACKEL
C       IS SHORT (LT 8 HITS)
C
      XBKK(1)=8.
      XBKK(2)=8.
      XBKK(3)=20.
      XBKK(4)=45.
      XBKK(5)=8.
      XBKK(6)=8.
      XBKK(7)=20.
      XBKK(8)=45.
      XBKK(9)=.05
      XBKK(10)=.08
      XBKK(11)=.12
      XBKK(12)=.17
      XBKK(13)=.06
      XBKK(14)=.12
      XBKK(15)=.12
      XBKK(16)=.17
      XBKK(17)=.12
      XBKK(18)=.12
      XBKK(19)=.40
      XBKK(20)=.40
      XBKK(21)=.12
      XBKK(22)=.25
      XBKK(23)=.4
      XBKK(24)=.4
      XBKK(25)=1.
      XBKK(26)=2.
      XBKK(27)=5.
      XBKK(28)=10.
      XBKK(29)=3.
      XBKK(30)=6.
      XBKK(31)=6.
      XBKK(32)=10.
77777 CONTINUE
C
C
C---------------------------------------
C     INITIALIZATION OF BAKPAK LIMITS
C---------------------------------------
C
C   IYBKK(11) NE 0 CAUSES BAKPAK TO BE CALLED FOR FIRST PASS
       IYBKK(11)=0
C
C   IYBKK(15) NE 0 CAUSES BAKPAK TO BE CALLED FOR SECOND PASS
       IYBKK(15)=0
C
C
C
C---------------------------------------
C     INITIALIZATION OF XYFIT LIMITS
C---------------------------------------
C
C
C     1).NO CLEVER HIT DELETION BY FIT
C     2).KILL ALL CIRCLE FITS
      IXYF(1)=3
C---------------------------------------
C     INITIALIZATION OF PATROL LIMITS
C---------------------------------------
C
C     KILL PATROL COMPLETELY
      GFP(2) = 0.
C
C----------------------------
C     INITIALISE ZRFIT LIMITS
C----------------------------
C
C     LABEL FOR HIT SELECTION PREPROCESSOR
      LMZFIT(10) = 2
C
C--------------------------------------------
C     INITIALISATION OF ADMINISTRATION LIMITS
C--------------------------------------------
C
C     INITIALIZATION OF IMCERT
C     1 = NO DELETION OF COVERED + SHORT TRACKS
C     0 = DELETION OF COVERED + SHORT TRACKS
      IMCERT=0
C
C     IXBKK(40) NE 0 MEANS KNTREL ITERATES WITH
C     UPDATED BACKTR ARRAYS
      IXBKK(40)=0
C
C     IXBKK(39) GIVES MAX NO OF ALLOWED ITERATIONS
      IXBKK(39)=0
C
C     IYBKK(14) .NE. 0  CAUSES BACKGROUND TRACKS TO BE DELETED
        IYBKK(14)=0
C
      RETURN
C
C--------------------------------------------------------------------
C           END OF  IPFAST = 0  SECTION OF INPATR
C--------------------------------------------------------------------
C
C
 102   CONTINUE
C
C
C
C
C
C#####################################################################
C SLOWEST BUT BEST VERSION OF PATREC .. IPFAST=2
C ==================================
C       OVERWRITE SOME LIMITS TO GET EFFICIENT VERSION OF PATREC
C#####################################################################
C
C
C---------------------------------------
C     INITIALIZATION OF BAKPAK LIMITS
C---------------------------------------
C
C   IYBKK(11) NE 0 CAUSES BAKPAK TO BE CALLED FOR FIRST PASS
       IYBKK(11)=1
C
C     IXBKK(35).NE. 0 MEANS PATROL IS CALLED INSIDE BAKPAK
      IXBKK(35)=1
C
C
C
C--------------------------------------------
C     INITIALISATION OF ADMINISTRATION LIMITS
C--------------------------------------------
C
C     IXBKK(39) GIVES MAX NO OF ALLOWED ITERATIONS
      IXBKK(39)=5
C
      RETURN
C--------------------------------------------------------------------
C           END OF  IPFAST = 2  SECTION OF INPATR
C--------------------------------------------------------------------
C
      END
      BLOCK DATA
C
      IMPLICIT INTEGER*2 (H)
C
#include "cpatlm.for"
C
       DATA IPFAST/2/
       END
C   08/11/78 102191158  MEMBER NAME  JDMAIN   (PATRECSR)    FORTRAN
C
C     MAIN PROGRAM FOR TESTS: P.STEFFEN(78/11/15)
C
      IMPLICIT INTEGER*2 (H)
C
      COMMON /CDATA/ NWORD,IDATA(4000)
                     DIMENSION HJCA(10)
                     EQUIVALENCE (HJCA(1),IDATA(1))
                     EQUIVALENCE (IPJCA,IDATA(61))
C
      COMMON /CBIN/ TIME(6),ZOF,ZRS,ZL,ZSC,EPSI(3),DOUB(3),IPN(3)
C
      COMMON /CCYCP/ HPTSEC(98)
C
      COMMON /CZVPAR/ LBZVDF,ZLOW,  BINZ,  NBINZ,
     ,                NWRDR1,LWRDC0,LWRDC1,LWRDC2,
     ,                IDZ1LM,IDZ2LM,NPKMIN,SBRAT,DFIMAX,
     ,                DZVPAR(5),
     ,                ZVTX,DZV1,DZV2,PEAK,BACK,IFLAG,
     ,                HUFLO(2),HOFLO(2),MAXZ ,HIST(100)
C
      COMMON /CWORK/ WORK(5000)
C
      COMMON /CLBPGM/ LBPGM(30)
C
      DATA NUNIT /1/
      DATA NREC /0/
C
 2001 FORMAT('0EOF REACHED ... STOP,',I6,' RECORDS READ')
 2002 FORMAT('0TIME LIMIT  ... STOP,',I6,' RECORDS READ')
C
C
 100   CONTINUE
C                                       CHECK TIME
        IF(IUHR(2).NE.1) GOTO 905
C                                                 READ MC-DATA
        NREC = NREC + 1
        CALL READMC(NUNIT,'DE',&900)
C                                         INITIALIZATION AFTER 1. RECORD
        IF(NREC.EQ.1) CALL INIT0
C                                                 FILL JCA-ARRAY
        NWORD2 = NWORD + NWORD
C                                                 INITIALIZE PGM-LABEL
        DO 120 I1=1,30
           LBPGM(I1) = 0
120     CONTINUE
C                                                 CHECK IF HITS IN JET C
      IF(IPJCA.LE.0) GOTO 100
C                                       PREPARE CYCLIC POINTER ARRAY
        CALL PRCYCP
C                                                 CALC. Z(VERTEX)
        CALL ZVERTF
C
        PRINT 2901, NREC, NWORD2
2901    FORMAT(1H1,'EVENT =',2I6,/,(1X,20I6))
C                                                 CHECK IF GOOD VERTEX
      IF(IFLAG.LT.0 .OR. ABS(ZVTX).GT.200.)  GOTO 100


C                                                 PATREC
      CALL PATREC
C                                                 CHECK IF END OF LOOP
      GOTO 100
C
 905  WRITE(6,2002) NREC
      GOTO 910
C                                                  EOF ... FINAL EVAL.
 900  CONTINUE
        WRITE(6,2001) NREC
 910    CONTINUE
        STOP
C
       END
C
      SUBROUTINE INIT0
C
C     CALL OF DIFFERENT INITIALIZATION ROUTINES
C
      CALL INITZV
      CALL INPATR
      CALL INPATC
      RETURN
      END
C   08/12/80 308171346  MEMBER NAME  PATROLNC (JADESR)      FORTRAN
      SUBROUTINE PATROL(RMIN,RMAX)
      IMPLICIT INTEGER*2(H)
      LOGICAL TBIT
C
C
C----------------------------------------------------------------------
C       --------------  SUBROUTINE PATROL  -----------------
C       ---- G.F.PEARCE .. LAST UPDATE : 2020 ON  4/11/82 ----
C   SUBROUTINE TO SEARCH AND RECORD HITS MISSED BY THE PATTERN
C   RECOGNITION PROGRAMS. IF SUFFICIENT NEW HITS ARE FOUND A REFIT
C   OF THE TRACK IS MADE AND PATROL THEN RECALLS ITSELF.
C
C   TO SATISFY CERTAIN COMPLAINTS MANY VERBOSE COMMENTS HAVE BEEN
C   INTRODUCED. HOPEFULLY EVERYONE ELSE WILL DO THE SAME, BUT I DOUBT IT
C
C  CONTROLLING PATROL.
C  ===================
C                   CONTROL OF THE PARAMETERS AND LIMITS USED BY
C  THIS PROGRAM IS ACHIEVED THROUGH THE ARRAY GFP IN COMMON CPATLM.
C  FOR DETAILS SEE THE INITIALISING ROUTINE INPATR.
C
C  PATROL ERROR MESSAGES
C  =====================
C  PATROL ERROR 1 => PATROL CALLED FOR A TRACK WITH ILLEGAL FIT TYPE
C  PATROL ERROR 2 => NOT ENOUGH ROOM IN CWORK TO STORE ANY MORE HITS
C  PATROL ERROR 3 => ILLEGAL RETURN VALUE - THIS SHOULD NEVER HAPPEN
C  PATROL ERROR 4 => THERE WERE NO GOOD HITS ON THE TRACK WHEN PATROL
C                    WAS CALLED - PATROL IGNORES THIS TRACK.
C  PATROL ERROR 5 => A POINTER WAS -VE. PROBABLY HPTSEC OVERFLOWED
C  PATROL ERROR 6 => PATROL FOUND A HOLE BIGGER THAN THE TRACK. THIS
C                    IS ALMOST CERTAINLY A BACKTRACE ERROR RESULTING
C                    IN THE WRONG ORDERING OF TRACK ELEMENTS. (THEY
C                    SHOULD BE SUPPLIED BY BACKTR RADIALLY ORDERED)
C  PATROL ERROR 7 => OVERSIZE CORRECTION WHEN CONVERTING A PARABOLA TO
C                    A CIRCLE. THE PREVIOUS ITERATION IS USED AND
C                    PATROL CONTINUES.
C  PATROL ERROR 8 => TOO MANY REFITS CALLED BY PATROL. PATROL STOPS
C                    AND RETURNS THOSE HITS ALREADY FOUND.
C  PATROL ERROR 9 => FAILED TO CALCULATE DRIFT PATH DISPERSION
C                    CORRECTION. IT IS ASSUMED TO BE MAXIMUM.
C
C----------------------------------------------------------------------
C
C
#include "calibr.for"
C
#include "cworkpr.for"
C
#include "cworkeq.for"
C
C=======EQUIVALENCES TO MACROS=======
      REAL*4 SL12(600,2)
      EQUIVALENCE (SL1(1),SL12(1,1))
      INTEGER*4 MINCL(3),MAXCL(3)
      EQUIVALENCE (MINCL(1),IBCK(4)) , (MAXCL(1),IBCK(1))
C====================================
C
#include "cdatamin.for"
C
#include "ccycp.for"
C
#include "cdsmax.for"
C
      COMMON / CJDRCH / RDEC(4),PSIIN(3),RINCR(3),FIRSTW(3),FSENSW(3),
     * RDEPTH,SWDEPL,YSUSPN,TIMDEL(2,3),ZMAX,ZOFFS,ZRESOL,ZNORM,ZAL,
     * ZSCAL,DRIDEV,DRICOS,DRISIN,PEDES,TZERO(3),
     * DRIROT(96,2),SINDRI(96,2),COSDRI(96,2),DRIVEL(96,2),T0FIX(3),
     * CAB(8)
C
#include "cpatlm.for"
C
      COMMON/CHEADR/HEAD(20)
C
C-------------------------------------------
C    EQUIVALENCE HIT BANK TO ADWRK
C-------------------------------------------
C
          EQUIVALENCE(ADWRK( 1),LAYERJ)
          EQUIVALENCE(ADWRK( 2),NH1)
          EQUIVALENCE(ADWRK( 3),NH)
          EQUIVALENCE(ADWRK( 4),XJETHT)
          EQUIVALENCE(ADWRK( 5),YJETHT)
          EQUIVALENCE(ADWRK( 6),ZJETHT)
          EQUIVALENCE(ADWRK( 7),RJETHT)
          EQUIVALENCE(ADWRK( 8),IERZRF)
          EQUIVALENCE(ADWRK( 9),LRTREL)
          EQUIVALENCE(ADWRK(10),INCELL)
          EQUIVALENCE(ADWRK(11),IERXYF)
          EQUIVALENCE(ADWRK(12),BETA)
          EQUIVALENCE(ADWRK(13),INRING)
          EQUIVALENCE(ADWRK(14),CHIXYF)
C
C-------------------------------------------
C         EQUIVALENCE TRACK BANK TO ADWRK
C-------------------------------------------
C
          EQUIVALENCE(ADWRK(21),XSTR)
          EQUIVALENCE(ADWRK(22),YSTR)
          EQUIVALENCE(ADWRK(23),RSTR)
          EQUIVALENCE(ADWRK(28),XEND)
          EQUIVALENCE(ADWRK(29),YEND)
          EQUIVALENCE(ADWRK(30),REND)
          EQUIVALENCE(ADWRK(34),IAMFIT)
          EQUIVALENCE(ADWRK(35),COEFF1,RAD)
          EQUIVALENCE(ADWRK(36),COEFF2,DMID)
          EQUIVALENCE(ADWRK(37),COEFF3,EPSILN)
          EQUIVALENCE(ADWRK(38),COEFF4)
          EQUIVALENCE(ADWRK(40),NPUSED)
          EQUIVALENCE(ADWRK(41),CURV)
C
C-------------------------------------------
C        EQUIVALENCES TO CWORK 'ZERO' ARRAY
C-------------------------------------------
C
          REAL*4 ZERO(100)
          EQUIVALENCE (ADWRK(41),ZERO(1))
          LOGICAL*1 CLFLAG(100)
          INTEGER*2 WIRMSK(96),RGFLAG(4)
          EQUIVALENCE (ZERO( 1),CLFLAG(1))
C         EQUIVALENCE (ZERO(25),CLFLAG(100))
          EQUIVALENCE (ZERO(26),WIRMSK(1))
C         EQUIVALENCE (ZERO(73),WIRMSK(96))
          EQUIVALENCE (ZERO(74),RGFLAG(1))
C         EQUIVALENCE (ZERO(75),RGFLAG(3))
          EQUIVALENCE (ZERO(76),JETCL)
          EQUIVALENCE (ZERO(77),NCELLS)
          EQUIVALENCE (ZERO(78),LAYTRY)
          EQUIVALENCE (ZERO(79),LAYINT)
          EQUIVALENCE (ZERO(80),LAYEXT)
C
C-------------------------------------------
C     EQUIVALENCES TO CWORK OF WORK ARRAY
C-------------------------------------------
C
          INTEGER*2 CELLPN(20,2),NWSET(20),WIRSET
C
C-------------------------------------------
C        DECLARATION OF 'MEMORY' VARIABLES
C-------------------------------------------
C
          REAL*4 PIE/3.14159/,TWOPIE/6.28318/
          INTEGER*4 BIT26/Z00000020/,BIT31N/ZFFFFFFFE/
          INTEGER*4 MSKLBL/Z000000FE/
          INTEGER*2 LAYBIT(16)/
     #    Z0001 , Z0002 , Z0004 , Z0008 ,
     #    Z0010 , Z0020 , Z0040 , Z0080 ,
     #    Z0100 , Z0200 , Z0400 , Z0800 ,
     #    Z1000 , Z2000 , Z4000 , Z8000 /
          INTEGER*2 LAYMSK(16,2) /
     #    ZFFFE , ZFFFC , ZFFF8 , ZFFF0 ,
     #    ZFFE0 , ZFFC0 , ZFF80 , ZFF00 ,
     #    ZFE00 , ZFC00 , ZF800 , ZF000 ,
     #    ZE000 , ZC000 , Z8000 , Z0000 ,
     #    Z0000 , Z0001 , Z0003 , Z0007 ,
     #    Z000F , Z001F , Z003F , Z007F ,
     #    Z00FF , Z01FF , Z03FF , Z07FF ,
     #    Z0FFF , Z1FFF , Z3FFF , Z7FFF /
          LOGICAL*1 PRINT
          NTRAK = HPWRK(30)
          NREFIT=0
C#######################################################################
      PRINT = .FALSE.
      IF(NTRAK.EQ.IGFP(20)) PRINT = .TRUE.
      IF(IGFP(20).LT.0.AND.NTRAK.GE.IABS(IGFP(20))) PRINT=.TRUE.
C#######################################################################
C==============================================
C==============================================
C         INITIALISATION
C==============================================
C==============================================
          KNTRL=IGFP(1)
 510      CONTINUE
C#######################################################################
          IF(PRINT)PRINT511,NTRAK,IGFP(1)
 511  FORMAT(1X,38('=')/' PATROL TRACK',I4,' GFP(1) = ',Z8/1X,38('='))
C#######################################################################
          ISTORY=IWRK(HPTR0+47)
          LNBYTE=HLDHT * 4
C==============================================
C==============================================
C         COMPUTE TRACK PARAMETERS
C==============================================
C==============================================
          IAMFIT=IWRK(HPTR0+17)
          IF(IAMFIT.EQ.1.OR.IAMFIT.EQ.2)GOTO520
C ----- ERROR 1 ILLEGAL FIT TYPE
          CALLERRORM('PATROL  ',1,NTRAK)
          GOTO7000
 520      CURV=WRK(HPTR0+24)
C#######################################################################
      IF(PRINT.AND.ABS(CURV).GE.GFP(14)) PRINT521,CURV
 521  FORMAT(' PATROL ABANDONED .. CURVATURE TOO HIGH ',E11.4)
C#######################################################################
          IF(ABS(CURV).GE.GFP(14))GOTO7000
          COEFF1=WRK(HPTR0+18)
          COEFF2=WRK(HPTR0+19)
          COEFF3=WRK(HPTR0+20)
          COEFF4=WRK(HPTR0+21)
          XSTR=WRK(HPTR0+4)
          YSTR=WRK(HPTR0+5)
          RSTR=WRK(HPTR0+6)-5.
          XEND=WRK(HPTR0+11)
          YEND=WRK(HPTR0+12)
          REND=WRK(HPTR0+13)+5.
          TRLEN2=(XSTR-XEND)**2+(YSTR-YEND)**2
          GOTO(910,920),IAMFIT
C
C         --------------------
C         TYPE 1 .. CIRCLE FIT
C         --------------------
C
 910      RAD=1./RAD
          DMID=DMID+RAD
          DMIDSQ=DMID**2
          XMID=DMID*COS(EPSILN)
          YMID=DMID*SIN(EPSILN)
          GOTO990
C
C         -----------------------
C         TYPE 2 .. PARABOLA FIT
C         -----------------------
C
 920      S1=SIN(COEFF1)
          S2=COS(COEFF1)
          RAD=1./(2*COEFF4)
          XMID=COEFF2-RAD*S1
          YMID=COEFF3+RAD*S2
C         CORRECT INSCRIBED CIRCLE
          IF(ABS(RAD).GE.30000)GOTO931
          IS3=0
 930      IS3=IS3+1
          S4=(XSTR-XMID)**2+(YSTR-YMID)**2-RAD**2
          S4=8*S4/TRLEN2
          S5=S4*RAD
          IF(ABS(S4).LE.0.4)GOTO933
C ----- ERROR 7 OVERSIZE CIRCLE CORRECTION
          IF(PRINT)CALLERRORM('PATROL  ',7,NTRAK)
          GOTO931
 933      RAD=RAD+S5
          XMID=XMID-S5*S1
          YMID=YMID+S5*S2
C#######################################################################
      IF(PRINT) PRINT981,RAD,XMID,YMID,S4
 981  FORMAT(' CIRCLE CORRECTION..RAD/X0/Y0 =',3E11.4,' CORRN =',F7.3)
C#######################################################################
          IF(S4.GT.GFP(15).AND.IS3.LT.5)GOTO930
 931      EPSILN=ATAN2(YMID,XMID)
          DMIDSQ=XMID**2 + YMID**2
          DMID=SQRT(DMIDSQ)
C
C         --------------------------
C         CLEAN UP CIRCLE PARAMETERS
C         --------------------------
C
 990      RAD=ABS(RAD)
          RADSQ=RAD**2
          RAD2=RAD*2
C
C==============================================
C==============================================
C         CALCULATE RESIDUAL CUTS
C==============================================
C==============================================
C
          NPUSED=IWRK(HPTR0+23)
          S1=10*NPUSED*ABS(CURV)
          IF(S1.GT.1.0)S1=1.0
          CODE0=GFP(4)+S1*GFP(5)
          CODE2=GFP(3)
C#######################################################################
      IF(PRINT) PRINT991,NPUSED,CODE0,CODE2,RSTR,REND
 991  FORMAT(' PATROL CUTS..NPUSED =',I4,' CODE0/CODE2 =',2F4.1/
     #       '           RSTR/REND =',2E11.4)
C#######################################################################
C
C==============================================
C==============================================
C         FLAG HITS ALREADY ATTACHED TO TRACK
C==============================================
C==============================================
C
          CALLSETSL(ZERO(1),0,320,0.)
          LAYSNT=0
          INCELL=0
          JETWR=-1
          IPHT=HPHT9-HLDHT+1
 1010     IF(IWRK(IPHT+10).EQ.0)GOTO1030
 1020     IPHT=IPHT-HLDHT
          IF(IPHT.LT.HPHT0)GOTO1060
          GOTO1010
 1030     JNCELL=IWRK(IPHT+9)
          IF(JNCELL.NE.INCELL)GOTO1050
C
C         ----------------------
C         NEW LAYER --- OLD CELL
C         ----------------------
C
 1040     IS1=IS1+1
          LAYSNT=LAYSNT+1
          LAYER=IWRK(IPHT)+1
          WIRSET=LOR(WIRSET,LAYBIT(LAYER))
          IPHST=IPHT
          GOTO1020
 1050     IF(INCELL.EQ.0)GOTO1070
C
C         --------------------------------
C         CELL COMPLETED -- LOAD END FLAGS
C         --------------------------------
C
 1060     CELLPN(NC,2)=IPHST
          WIRMSK(INCELL)=WIRSET
          NWSET(NC)=IS1
          IF(IPHT.LT.HPHT0)GOTO1110
C
C         ----------------------------
C         NEW CELL -- INITIALISE FLAGS
C         ----------------------------
C
 1070     INCELL=JNCELL
          INRING=IWRK(IPHT+12)
          RGFLAG(INRING)=INRING + 1
          WIRSET=WIRMSK(INCELL)
          IF(CLFLAG(INCELL))GOTO1080
          NCELLS=NCELLS+1
          NC=NCELLS
          IS1=0
          CLFLAG(INCELL)=.TRUE.
          CELLPN(NC,1)=IPHT
          GOTO1040
C
C         -----------------------------
C         OLD CELL AGAIN -- RESET FLAGS
C         -----------------------------
C
 1080     DO 1090 NC=1,NCELLS
          JNCELL=CELLPN(NC,1)
          JNCELL=IWRK(JNCELL+9)
          IF(JNCELL.EQ.INCELL)GOTO1100
 1090     CONTINUE
 1100     IS1=NWSET(NC)
          GOTO1040
 1110     IF(LAYSNT.GE.4)GOTO1120
C ----- ERROR 4 NO GOOD HITS FROM FIT !!!
          CALLERRORM('PATROL  ',4,NTRAK)
          GOTO7000
 1120     IF(TBIT(KNTRL,30))GOTO3000
C
C==============================================
C==============================================
C         LOOK FOR NEW HITS IN CELLS WITH HITS
C==============================================
C==============================================
C
          DO 2200 NC=1,NCELLS
          IRETRN=1
          IPHT=CELLPN(NC,1)
          INCELL=IWRK(IPHT+9)
          INRING=IWRK(IPHT+12)
C
C         -----------------------
C         CHECK FOR UNUSED LAYERS
C         -----------------------
C
          IS1=NWSET(NC)
C#######################################################################
          NH0 = HPTSEC(INCELL)
          NH9 = HPTSEC(INCELL+1) - 1
          IS2 = SHFTR(NH9-NH0,2) + 1
      IF (PRINT) PRINT2011,INCELL,WIRMSK(INCELL),IS1,IS2
 2011 FORMAT(' SEARCH OLD CELL',I3,' MASK = Z',Z4,' WIRES GOT =',I3,
     #' HITS AVAILABLE =',I4)
C#######################################################################
          IF(IS1.EQ.16)GOTO2100
C         NH0=FIRST HIT, NH9 = LAST HIT
          NH0=HPTSEC(INCELL)
          NH9=HPTSEC(INCELL+1)-4
          IF(NH0.GT.0)GOTO2010
C ----- ERROR 5 POINTER -VE .. SUSPECT HPTSEC OVERFLOW
          CALLERRORM('PATROL  ',5,NTRAK)
          GOTO2100
 2010     IS2=SHFTR(NH9-NH0,2)+1
          IF(IS2.LE.IS1)GOTO2100
C
C         -----------------------
C         CHECK ALL UNUSED LAYERS
C         -----------------------
C
C         SET IPHST TO LOWEST R HIT (HIGH IPHT)
CCCC      IPHST=IPHT
          IPHST=HPHT9 - HLDHT + 1
          WIRSET=WIRMSK(INCELL)
          DO 2020 NH1=NH0,NH9,4
          INWIRE=HDATA(NH1)
          INWIRE=SHFTR(INWIRE,3)
          LAYER=LAND(INWIRE,15)+1
          MAND=LAND(WIRSET,LAYBIT(LAYER))
          IF(MAND.NE.0)GOTO2020
          GOTO8000
 2020     CONTINUE
          WIRMSK(INCELL)=WIRSET
C
C==============================================
C==============================================
C  LOOK FOR NEW HITS IN CELLS ADJACENT TO CELLS
C  ALREADY CONTAINING HITS ON THE TRACK
C  IEND = 1 => LOW R.   IEND = 2 => HIGH R.
C==============================================
C==============================================
C
 2100     IRETRN=2
          JNCELL = INCELL
          DO 2195 IEND=1,2
C
C         --------------------------
C         REJECT WALL CROSSING IF NO
C         LAYERS IN THE ADJACENT CELL
C         COULD HAVE BEEN HIT.
C         --------------------------
C
          IPHT=CELLPN(NC,IEND)
          LAYER=IWRK(IPHT) + 1
          NLMIDO=IWRK(IPHT+8)
          LRINDX=1
          IF(NLMIDO.GT.0)LRINDX=2
          NWLIM=HMCH(LAYER,INRING,LRINDX)+1
C######################################################################
      INCELL = JNCELL + ISIGN(1,NLMIDO)
      IF(INCELL.GT.MAXCL(INRING)) INCELL=MINCL(INRING)
      IF(INCELL.LT.MINCL(INRING)) INCELL= MAXCL(INRING)
      IF (PRINT) PRINT2111,IEND,INCELL,LAYER,NLMIDO,NWLIM
 2111 FORMAT('        END',I2,' = CELL',I3,' LAYER',I3,' NLMIDO =',I5,
     #' NWLIM =',I3)
C######################################################################
          IF(NWLIM.LT.1.OR.NWLIM.GT.16)GOTO2195
C
C         ------------------------------------------
C         HAS THE ADJACENT CELL ALREADY BEEN CHECKED
C         ------------------------------------------
C
          INCELL=JNCELL+ISIGN(1,NLMIDO)
          IF(INCELL.GT.MAXCL(INRING))INCELL=MINCL(INRING)
          IF(INCELL.LT.MINCL(INRING))INCELL=MAXCL(INRING)
C######################################################################
      IF (PRINT.AND.CLFLAG(INCELL)) PRINT2121,INCELL
 2121 FORMAT('          CELL',I3,'  ALREADY CHECKED')
C######################################################################
          IF (CLFLAG(INCELL)) GOTO2195
C
C         -----------------------------------
C         ARE THERE ANY HITS IN THIS NEW CELL
C         -----------------------------------
C
          NH0 = HPTSEC(INCELL)
          NH9 = HPTSEC(INCELL+1) - 4
          IF (NH0.GT.0) GOTO2130
          CALLERRORM('PATROL  ',5,NTRAK)
          GOTO2195
 2130     CONTINUE
C######################################################################
      IF (PRINT.AND.(NH9.LT.NH0)) PRINT2122,INCELL,NH0,NH9
 2122 FORMAT('          CELL',I3,' HAS NO HITS',2I10)
C######################################################################
          IF(NH9.LT.NH0)GOTO2195
C
C         -------------------------------
C         REJECT CELL IF END HIT TOO FAR
C         FROM CELL BOUNDARY IN DRIFT SPACE
C         --------------------------------
C
          NLMIDO=IABS(NLMIDO)
          IF(NLMIDO.GT.199)GOTO2180
          DRIFT=HDATA(IWRK(IPHT+1)+3)
          IF(LAYER.GE.9)GOTO2140
          DRIFT=DRIFT*TIMDEL(1,INRING)
          GOTO2150
 2140     DRIFT=DRIFT*TIMDEL(2,INRING)
 2150     S2=SL12(NLMIDO,IEND)
          IS1=LAYER
          IF(IEND.EQ.2)GOTO2160
          S2=-S2
          IF (IS1.NE.1)IS1=IS1-1
          GOTO2170
 2160     IF(IS1.NE.16)IS1=IS1+1
 2170     DRIFT=ABS(DRIFT+S2)
          S2=DSMAX(IS1,INRING,LRINDX)*GFP(11)
C######################################################################
      IF (PRINT.AND.(DRIFT.LT.S2)) PRINT2171,INCELL,DRIFT,S2
 2171 FORMAT('          CELL',I3,' OUTSIDE DSMAX ',2F6.1)
C######################################################################
          IF(DRIFT.LT.S2)GOTO2195
C
C         ---------------------------------
C         MASK OUT DISALLOWED HITS AND
C         CHECK FIT RESIDUAL ON ALLOWED HITS
C         ---------------------------------
C
C         SET START POINTER TO LOWEST R HIT (HIGH IPHT)
 2180     IPHST=HPHT9-HLDHT+1
          WIRSET=WIRMSK(INCELL)
          WIRSET=LOR(WIRSET,LAYMSK(NWLIM,IEND))
C######################################################################
      IF (PRINT) PRINT2181,WIRMSK(INCELL),LAYMSK(NWLIM,IEND)
 2181 FORMAT('        SEARCH WITH WIRE MASK =Z',Z4,' AND Z',Z4)
C######################################################################
          NH1=NH0
 2185     INWIRE=HDATA(NH1)
          INWIRE=SHFTR(INWIRE,3)
          LAYER=LAND(INWIRE,15)+1
          MAND=LAND(WIRSET,LAYBIT(LAYER))
          IF(MAND.NE.0)GOTO2190
          GOTO8000
 2190     NH1=NH1+4
          IF(NH1.LE.NH9)GOTO2185
          WIRMSK(INCELL)=WIRSET
 2195     CONTINUE
 2200     CONTINUE
C
C==============================================
C==============================================
C         LOOK FOR NEW HITS IN MISSING RINGS
C==============================================
C==============================================
C
C
C--------------------------------
C  STEP 1. DETERMINE MISSING RING
C--------------------------------
C
 3000     NRMISS=RGFLAG(1)+RGFLAG(2)+RGFLAG(3)-1
C
C         -------------------------
C         IS THERE A MISSING RING ?
C         -------------------------
C
          IF(NRMISS.GE.7)GOTO4000
          IF (TBIT(KNTRL,28).AND.NRMISS.NE.5)GOTO4000
C         REQUIRED TO AVOID RUTHERFORD 0C4
          LAYLST=0
          IPHST=HPHT9-HLDHT+1
          GOTO(3110,3120,3130,3140,3150,3160),NRMISS
C         BOTH RINGS 2 AND 3 MISSING
 3110     INRING=2
          GOTO3200
C         BOTH RINGS 1 AND 3 MISSING
 3120     INRING=1
          GOTO3200
C         BOTH RINGS 1 AND 2 MISSING
 3130     INRING=2
          GOTO3200
C         ONLY RING 3 MISSING
 3140     INRING=3
          GOTO3200
C         ONLY RING 2 MISSING
 3150     INRING=2
          GOTO3200
C         ONLY RING 1 MISSING
 3160     INRING=1
C
C-----------------------------------------------
C  STEP 2.  DETERMINE CELLS INTERSECTED BY TRACK
C-----------------------------------------------
C
 3200     IRETRN=3
          S1=FSENSW(INRING)
          S2=S1+15*RINCR(INRING)
          IF(.NOT.TBIT(NRMISS,30))GOTO3240
          S1=S2
          S2=FSENSW(INRING)
C
C         ---------------------------------
C         COMPUTE RING INTERSECTION AZIMUTH
C         FOR ENTRY AND EXIT RADII
C         ---------------------------------
C
 3240     S1=(S1**2+DMIDSQ-RADSQ)/(2*S1*DMID)
          S2=(S2**2+DMIDSQ-RADSQ)/(2*S2*DMID)
C#######################################################################
      IF (ABS(S1).LE.1.0.OR.ABS(S2).LE.1.0) GOTO3245
      IF (PRINT) PRINT3241,INRING
 3241 FORMAT(' RING',I2,' NOT REACHED BY TRACK')
 3245  CONTINUE
C#######################################################################
          IF(ABS(S1).LE.1.0)GOTO3250
          IF(ABS(S2).GT.1.0)GOTO4000
          S1=SIGN(1.0,S1)
          GOTO3260
 3250     IF(ABS(S2).GT.1.0)S2=SIGN(1.0,S2)
 3260     S1=ARCOS(S1)
          S2=ARCOS(S2)
C
C         ------------------------
C         HAVE TWO SOLNS OF COURSE
C         DECIDE ON CORRECT ONE.
C         ------------------------
C
          S3=EPSILN-S1
          S1=EPSILN+S1
          S5=ATAN2(YSTR,XSTR)
          S4=ABS(S1-S5)
          IF(S4.GT.PIE)S4=TWOPIE-S4
          S5=ABS(S3-S5)
          IF(S5.GT.PIE)S5=TWOPIE-S5
          IF(S5.LT.S4)GOTO3270
          S2=EPSILN+S2
          GOTO3280
 3270     S1=S3
          S2=EPSILN-S2
 3280     IF(S1.LT.0.)S1=S1+TWOPIE
          IF(S2.LT.0.)S2=S2+TWOPIE
C
C         ---------------------------------
C         COMPUTE CELL RANGE TO BE SEARCHED
C         ---------------------------------
C
          S3=0.2618
          IF(INRING.EQ.3)S3=0.1309
          INCELL=S1/S3
          INCEL2=S2/S3
          INC=ISIGN(1,INCEL2-INCELL)
          IS1=MINCL(INRING)
          IS2=MAXCL(INRING)
          INCELL=IS1+INCELL
          INCEL2=IS1+INCEL2
          IF(INCELL.EQ.IS1.AND.INCEL2.EQ.IS2)INC=-1
          IF(INCELL.EQ.IS2.AND.INCEL2.EQ.IS1)INC=+1
C#######################################################################
      IF (PRINT) PRINT3296,INRING,INCELL,INCEL2,INC,NRMISS
 3296 FORMAT(' SEARCH RING',I2,' CELLS',I3,' TO',I3,' INC/NRMISS =',2I2)
C######################################################################
C
C-----------------------------------
C  STEP 3. LOOP OVER SELECTED CELLS
C-----------------------------------
C
          WIRSET=WIRMSK(INCELL)
C
C         ---------------------------------
C         GET POINTERS TO HITS IN THIS CELL
C         NH0 = FIRST HIT , NH9 = LAST HIT
C         ---------------------------------
C
 3410     NH0=HPTSEC(INCELL)
          NH9=HPTSEC(INCELL+1)-4
C######################################################################
      IF (PRINT.AND.(NH9.LT.NH0)) PRINT3411,INRING,INCELL,NH0,NH9
 3411 FORMAT(' RING',I2,' CELL',I3,' HAS NO HITS',2I10)
C######################################################################
          IF(NH0.GT.0)GOTO3420
          CALLERRORM('PATROL  ',5,NTRAK)
          GOTO3500
 3420     IF(NH9.LT.NH0)GOTO3500
          INCNH1=4
          IF(.NOT.TBIT(NRMISS,30))GOTO3430
          IS1=NH0
          NH0=NH9
          NH9=IS1
          INCNH1=-4
C
C         ---------------------------------
C         LOOP OVER ALL HITS IN CELL INCELL
C         ---------------------------------
C
 3430     NH1=NH0
          LAYLST=0
          LAYTRY=0
C######################################################################
      IF (PRINT) PRINT3431,INCELL,WIRSET
 3431 FORMAT('            CELL',I3,' SET MASK =Z',Z4)
C######################################################################
 3440     INWIRE=HDATA(NH1)
          INWIRE=SHFTR(INWIRE,3)
          LAYER=LAND(INWIRE,15)+1
          MAND=LAND(WIRSET,LAYBIT(LAYER))
          IF(MAND.NE.0)GOTO3480
          GOTO8000
C         GOOD HIT
 3450     LAYLST=LAYER
          GOTO3480
C         BAD HIT
 3470     IF(NRMISS.NE.5.AND.LAYTRY.GE.IGFP(6))GOTO3510
 3480     IF(NH1.EQ.NH9)GOTO3490
          NH1=NH1+INCNH1
          GOTO3440
C
C         --------------
C         GOTO NEXT CELL
C         --------------
C
 3490     WIRMSK(INCELL)=WIRSET
 3500     IF(INCELL.EQ.INCEL2)GOTO3520
          INCELL=INCELL+INC
          IF(INCELL.GT.MAXCL(INRING))INCELL=MINCL(INRING)
          IF(INCELL.LT.MINCL(INRING))INCELL=MAXCL(INRING)
C         SET MINIMUM LAYER FOR NEW CELL
          WIRSET=WIRMSK(INCELL)
          IF(LAYLST.EQ.0)GOTO3410
          IS1=1
          IF(INC.GT.0)IS1=2
          NWLIM=HMCH(LAYLST,INRING,IS1)+1
          IS2=2
          IF(NH9.LT.NH0)IS2=1
          WIRSET=LOR(WIRSET,LAYMSK(NWLIM,IS2))
C######################################################################
      IF(PRINT)PRINT3501,INCELL,LAYMSK(NWLIM,IS2),WIRSET
 3501 FORMAT('     "OR" NEXT CELL',I3,' MASK WITH Z',Z4,' GIVING Z',Z4)
C######################################################################
          GOTO3410
C
C         -------------------------
C         END OF LOOP OVER NEW RING
C         -------------------------
C
 3510     WIRMSK(INCELL)=WIRSET
 3520     CONTINUE
C
C==============================================
C==============================================
C         END OF PATROL HIT SEARCH
C==============================================
C==============================================
C
 4000     CONTINUE
C######################################################################
      IF (PRINT) PRINT4001,LAYINT,LAYEXT
 4001 FORMAT(' HIT SEARCH OVER. FOUND INTERP. =',I3,' EXTRAP. =',I3)
      IF(PRINT)CALLPCWORK(0,0,0,1,0)
C######################################################################
C
C         -----------------------------------------
C         LOOK FOR UNWANTED HITS FROM EXTRAPOLATION
C         -----------------------------------------
C
          IPHT=HPHT0
          S4=REND
 4010     S1=0.
          IS2=0
          IS3=IPHT
 4020     IF(IWRK(IPHT+10).NE.0)GOTO4040
          RJETHT=WRK(IPHT+6)
          IF(S1.EQ.0.)GOTO4030
          IF(ABS(RJETHT-S1).GT.GFP(8))GOTO4050
 4030     S1=RJETHT
          IS2=IS2+1
          IF(HLDHT*(RJETHT-S4).LT.0.)GOTO4060
 4040     IPHT=IPHT+HLDHT
          GOTO4020
C         DEMAND IGFP(9) CONSEC HITS
 4050     IF(IS2.LT.IGFP(9))GOTO4055
C         DONT ALLOW BIG HOLES
          IS5=IPHT
 4051     IS5=IS5-HLDHT
          IF(IS5.GE.HPHT0.AND.IS5.LT.HPHT9)GOTO4052
C ----- ERROR 6 PATROL FINDS HOLE BIGGER THAN TRACK. PROBABLE CAUSE
C ----- ERROR 6 IS A BACKTRACE ERROR IN TRACK ELEMENT ORDERING
          CALLERRORM('PATROL  ',6,NTRAK)
          IF(HLDHT.LT.0)HLDHT=-HLDHT
          CALLPCWORK(0,0,0,1,0)
          GOTO7000
 4052     IF(IWRK(IS5+10).NE.0)GOTO4051
          S2=(WRK(IPHT+3)-WRK(IS5+3))**2+(WRK(IPHT+4)-WRK(IS5+4))**2
          S2=SQRT(S2)-GFP(7)
          IF(IWRK(IS5+12).NE.IWRK(IPHT+12))S2=S2-GFP(12)
          IF(S2.LE.0.0)GOTO4056
 4055     IS3=IPHT
 4056     IS2=0
          GOTO4030
C         TRUE PATROL END POINT FOUND
C         MASK OUT UNWANTED HITS
 4060     IF(HLDHT.LT.0)GOTO4090
          IPHT=IS3
 4070     IPHT=IPHT-HLDHT
          IF(IPHT.LT.HPHT0)GOTO4080
C######################################################################
      IF (PRINT) PRINT4071,IPHT,IWRK(IPHT+9),IWRK(IPHT),IWRK(IPHT+8)
     # ,IWRK(IPHT+10)
 4071 FORMAT(' DELETE HIT..IPHT',I5,' CELL',I3,' LAYER',I3,' LRTREL',I5
     #,' IERXYF',I3)
C######################################################################
          IF(IWRK(IPHT+10).NE.0)GOTO4070
          IF(WRK(IPHT+6).GT.REND)LAYEXT=LAYEXT-1
          IWRK(IPHT+10)=2
          GOTO4070
 4080     IPHT=HPHT9-HLDHT+1
          HLDHT=-HLDHT
          S4=RSTR
          GOTO4010
 4090     CONTINUE
          IPHT=IS3
 4091     IPHT=IPHT-HLDHT
          IF(IPHT.GT.HPHT9)GOTO4100
          IF(IWRK(IPHT+10).NE.0)GOTO4091
          IF(WRK(IPHT+6).LT.RSTR)LAYEXT=LAYEXT-1
          IWRK(IPHT+10)=2
C######################################################################
      IF (PRINT) PRINT4071,IPHT,IWRK(IPHT+9),IWRK(IPHT),IWRK(IPHT+8)
     # ,IWRK(IPHT+10)
C######################################################################
          GOTO4091
 4100     HLDHT=-HLDHT
C######################################################################
      IF (PRINT) PRINT4101,LAYINT,LAYEXT
 4101 FORMAT(' END OF DELETE.   FOUND INTERP. =',I3,' EXTRAP. =',I3)
      IF (PRINT) CALLPCWORK(0,0,0,1,0)
C######################################################################
C
C         -------------------------------------
C         CALL REFIT WITH NEW HITS IF NECESSARY
C         -------------------------------------
C
 5000     IF(TBIT(KNTRL,31))GOTO7000
C         REFIT IF HAVE MANY MORE HITS
          IF(LAYINT.GE.IGFP(10))GOTO5010
          IF(LAYEXT.GT.0)GOTO5010
          GOTO7000
 5010     NREFIT=NREFIT+1
          IF(NREFIT.LE.IGFP(13))GOTO5015
C ----- ERROR 8 PATROL HAS CALLED TOO MANY REFITS .. END PATROL
                   CALLERRORM('PATROL  ',8,NTRAK)
          GOTO7000
 5015     IXYF1=IXYF(1)
          IXYF(1)=1
C######################################################################
      IF (PRINT) PRINT5011
 5011 FORMAT(' CALL XYFIT ')
C######################################################################
          RSTRSV=RSTR+5.
          RENDSV=REND-5.
          CALLXYFIT
          IXYF(1)=IXYF1
C         REPEAT PATROL IF FIT WAS GOOD
          IF(WRK(HPTR0+22).LE.GFP(2))GOTO510
C
C         ----------------------------------
C         REFIT WAS BAD. MASK OUT PATROLLED
C         HITS AND REINSTATE ORIGINAL FIT
C         ----------------------------------
C
          IWRK(HPTR0+47)=LOR (IWRK(HPTR0+47),BIT26)
          IWRK(HPTR0+47)=LAND(IWRK(HPTR0+47),BIT31N)
          IPHT=HPHT0+10
 5020     IF(IWRK(IPHT).EQ.1)IWRK(IPHT)=0
          IF(IABS(IWRK(IPHT-2)).LT.1000)GOTO5021
          RJETHT=WRK(IPHT-4)
          IF(RJETHT.GE.RSTRSV.AND.RJETHT.LE.RENDSV)GOTO5021
          IWRK(IPHT)=2
 5021     IPHT=IPHT+HLDHT
          IF(IPHT.LT.HPHT9)GOTO5020
C######################################################################
      IF (PRINT) PRINT4201
 4201 FORMAT(' PATROL RE-FIT WAS BAD. DELETE PATROLLED HITS AND REFIT')
C######################################################################
          IXYF1=IXYF(1)
          IXYF(1)=1
          CALLXYFIT
          IXYF(1)=IXYF1
C
C         ----------------------
C         FINAL EXIT FROM PATROL
C         ----------------------
C
 7000     IWRK(HPTR0+47)=ISTORY
C######################################################################
      IF (PRINT) PRINT4801,LAYINT
 4801 FORMAT(1X,10('#'),' EXIT PATROL. LAYINT =',I3)
C#######################################################################
          RETURN
C
C==============================================
C==============================================
C         CALCULATE RESIDUAL OF TEST HIT AND
C         LOAD INTO HIT ARRAY IF ACCEPTABLE
C==============================================
C==============================================
C
C         -------------------------
C         COMPUTE HIT LABEL POINTER
C         IS1=0 => HIT NOT ON TREL
C         -------------------------
C
 8000     IF(NH1.GT.0)GOTO8001
          CALLERRORM('PATROL  ',5,NTRAK)
          GOTO8750
 8001     NH=SHFTR((NH1-HPTSEC(1)),1)+HPHL0
          IS1=HWRK(NH)
          IS1=LAND(IS1,MSKLBL)
          IF(IS1.EQ.0)GOTO8010
          IF(TBIT(KNTRL,29))GOTO8750
          GOTO8020
 8010     IF(TBIT(KNTRL,25))GOTO8750
 8020     CONTINUE
C
C         ----------------------------------
C         SET UP CELL AND LAYER CONSTANTS.
C         SKIP IF SAME WIRE ETC AS LAST TIME
C         ----------------------------------
C
          IF(INWIRE.EQ.JETWR)GOTO8120
          JETWR=INWIRE
C         NEW LAYER BEING TRIED .. INCREMENT LAYTRY
          LAYTRY=LAYTRY+1
          IF(INCELL.EQ.JETCL)GOTO8100
          JETCL=INCELL
          TRLORX=TRMATS(INCELL,1)
          TRLORY=TRMATC(INCELL,1)
          SINLOR=SINDRI(INCELL,1)
          COSLOR=COSDRI(INCELL,1)
          DRFVEL=DRIVEL(INCELL,1)
C         CORRECTION CONSTANTS FOR INCELL
          IPJCOR = ICALIB(5) + INCELL
          CCST01 = ACALIB(IPJCOR     )
          CCST02 = ACALIB(IPJCOR+  96)
          CCST11 = ACALIB(IPJCOR+ 192)
          CCST12 = ACALIB(IPJCOR+ 288)
          CCST21 = ACALIB(IPJCOR+ 384)
          CCST22 = ACALIB(IPJCOR+ 480)
          CCST51 = ACALIB(IPJCOR+ 576) * 10.
          CCST61 = ACALIB(IPJCOR+ 768) * 10.
          CCST81 = ACALIB(IPJCOR+1152)
          RSENSW=FSENSW(INRING)
          DR0=RINCR(INRING)
          IS1=INCELL-24*(INRING-1)
          IF(INRING.EQ.3)GOTO8030
          DXWR=DIRWR1(IS1,1)
          DYWR=DIRWR1(IS1,2)
          GOTO8040
 8030     DXWR=DIRWR3(IS1,1)
          DYWR=DIRWR3(IS1,2)
 8040     SWDEPX=SWDEPL*DXWR
          SWDEPY=SWDEPL*DYWR
C
C         ------------------------------
C         COMPUTE (X,Y,R) OF SIGNAL WIRE
C         ------------------------------
C
 8100     LAYERJ=LAYER-1
          RWIRE=RSENSW+LAYERJ*DR0
          IF(TBIT(LAYERJ,31))GOTO8110
          XWIRE=RWIRE*DXWR-SWDEPY
          YWIRE=RWIRE*DYWR+SWDEPX
          GOTO8120
 8110     XWIRE=RWIRE*DXWR+SWDEPY
          YWIRE=RWIRE*DYWR-SWDEPX
 8120     CONTINUE
          IF(HPHT0.GT.HPHTLM)GOTO8200
C ----- ERROR 2 NOT ENOUGH ROOM IN CWORK
          CALLERRORM('PATROL  ',2,NTRAK)
          GOTO7000
C
C         --------------------------------
C         COMPUTE DRIFT DISTANCE FROM TIME
C         NOTE THAT DRIFT DISTANCE IS +VE
C         --------------------------------
C
 8200     IDRIFT=HDATA(NH1+3)
          DRIFT=IDRIFT*DRFVEL
          IF(HEAD(18).LE.0)DRIFT=DRIFT+0.5*DRFVEL
C
C         --------------------------------
C         DRIFT PATH DISPERSION CORRECTION
C         --------------------------------
C
          XJETHT=XWIRE-TRLORX*DRIFT-XMID
          YJETHT=YWIRE-TRLORY*DRIFT-YMID
          XJET2 =XWIRE+TRLORX*DRIFT-XMID
          YJET2 =YWIRE+TRLORY*DRIFT-YMID
          S3=SINLOR*DXWR-COSLOR*DYWR
          S4=COSLOR*DXWR+SINLOR*DYWR
          XX = ABS(S3*XJETHT+S4*YJETHT)
          IF(XX.NE.0.)GOTO1350
          CALLERRORM('PATROL  ',9,NTRAK)
C ----- ERROR 9  FAILED TO CALCULATE DRIFT PATH DISPERSION
C ----- ERROR 9  CORRECTION. ASSUME IT TO BE MAXIMUM
          BETA = 1.1
          GOTO1355
 1350     BETA = RAD/XX
          IF(BETA.LT.1.0)BETA=1.0
          IF(BETA.GT.1.2)BETA=1.1
 1355     XX=ABS(S3*XJET2+S4*YJET2)
          IF(XX.NE.0.) GOTO1360
          CALLERRORM('PATROL  ',9,NTRAK)
          BETA2 = 1.1
          GOTO1365
 1360     BETA2=RAD/XX
          IF(BETA2.LT.1.0)BETA2=1.0
          IF(BETA2.GT.1.1)BETA2=1.1
 1365     CONTINUE
C
          SCALE=DRIFT
          IF(DRIFT.GT.4.)SCALE=4.
          DRIFT1=DRIFT+(BETA-1.)*SCALE
          DRIFT2=DRIFT+(BETA2-1.)*SCALE
C
C         --------------------------
C         EDGE WIRE FIELD DISTORTION
C         --------------------------
C
          IF(LAYER.GE.3)GOTO1370
          DRIFT1=DRIFT1*(1.-CCST11*(LAYER-3)**2)
          DRIFT2=DRIFT2*(1.-CCST12*(LAYER-3)**2)
          GOTO1380
 1370     IF(LAYER.LE.12)GOTO1380
          DRIFT1=DRIFT1*(1.-CCST21*(LAYER-12)**2)
          DRIFT2=DRIFT2*(1.-CCST22*(LAYER-12)**2)
 1380     CONTINUE
C         ----------------------------------
C         DRIFT VELOCITY VARIATION NEAR WIRE
C         ----------------------------------
C
          IF(DRIFT1.LT.CAB(4))DRIFT1=DRIFT1+CAB(5)*(DRIFT1-CAB(4))**2
          IF(DRIFT2.LT.CAB(4))DRIFT2=DRIFT2+CAB(5)*(DRIFT2-CAB(4))**2
C         ---------------------
C         RESET -VE DRIFT TIMES
C         ---------------------
C
          IF(DRIFT1.LT.0.)DRIFT1=0.05
          IF(DRIFT2.LT.0.)DRIFT2=0.05
C
C         --------------------------------
C         COMPUTE X,Y COORDINATES FOR BOTH
C         LEFT (-VE) AND RIGHT (+VE) SOLNS
C         --------------------------------
C
          XJETHT=XWIRE-TRLORX*DRIFT1
          YJETHT=YWIRE-TRLORY*DRIFT1
          XJET2 =XWIRE+TRLORX*DRIFT2
          YJET2 =YWIRE+TRLORY*DRIFT2
C
C         --------------------------------
C         COMPUTE RESIDUALS FOR BOTH L/R
C         SOLUTIONS AND TAKE THE SMALLEST
C         --------------------------------
C
          CHIXYF=(XJETHT-XMID)**2+(YJETHT-YMID)**2
          CHIXYF=(CHIXYF-RADSQ)/RAD2
          S2=(XJET2-XMID)**2+(YJET2-YMID)**2
          S2=(S2-RADSQ)/RAD2
          LRTREL=-1
          DRIFT=DRIFT1
          IF(ABS(CHIXYF).LT.ABS(S2))GOTO8410
          LRTREL=1
          DRIFT=DRIFT2
          XJETHT=XJET2
          YJETHT=YJET2
          CHIXYF=S2
          BETA=BETA2
C
C         ----------------------
C         DETERMINE ACCEPT CODE
C         ----------------------
C
 8410     S2=ABS(CHIXYF)
          IERXYF=3
          IF(S2.GT.CODE2)GOTO8750
          IF(S2.GT.CODE0)GOTO8420
          IERXYF=0
          LAYTRY=0
          GOTO8430
 8420     IERXYF=2
 8430     CONTINUE
C
C         --------------------------------
C         COMPUTE RADIAL COORDINATE
C         TEST AGAINST USER DEFINED LIMITS
C         --------------------------------
C
          RJETHT=DRIFT/RWIRE
          RJETHT=RJETHT*(0.5*RJETHT-LRTREL*SINLOR)
          RJETHT=RWIRE*(1+RJETHT-.5*RJETHT**2)
          IF(RJETHT.LT.RMIN.OR.RJETHT.GT.RMAX)GOTO8750
C
C         -----------------------------
C         SET IERZRF = 16 IF THERE IS A
C         SECOND HIT WITHIN THE SOFTWARE
C         DOUBLE HIT RESOLUTION IXYF(18)
C         -----------------------------
C
          IERZRF=0
CC--CC    CLOSEST HIT WITH LOWER DRIFT TIME
CC--CC    IS2=NH1-4
CC--CC    IF(IS2.LT.NH0)GOTO8510
CC--CC    IS1=HDATA(IS2)
CC--CC    IS1=SHFTR(IS1,3)
CC--CC    IF(IS1.NE.INWIRE)GOTO8510
CC--CC    IS2=IDRIFT-HDATA(IS2+3)
CC--CC    IF(IABS(IS2).LE.IXYF(18))IERZRF=16
CC--CC    CLOSEST HIT WITH HIGHER DRIFT TIME
C8510     IS2=NH1+4
CC--CC    IF(IS2.GT.NH9)GOTO8520
CC--CC    IS1=HDATA(IS2)
CC--CC    IS1=SHFTR(IS1,3)
CC--CC    IF(IS1.NE.INWIRE)GOTO8520
CC--CC    IS2=IDRIFT-HDATA(IS2+3)
CC--CC    IF(IABS(IS2).LE.IXYF(18))IERZRF=16
C
C         ----------------------------------
C         COMPUTE Z-COORDINATE. IF EITHER Z-
C         AMPLITUDE IS <= 0 SET IERZRF = 16
C         ----------------------------------
C
 8520     IS1=HDATA(NH1+1)
          IS2=HDATA(NH1+2)
          IF(IS2.LE.0.OR.IS1.LE.0)GOTO8540
          ZJETHT=IS2+IS1
          ZJETHT=.5*ZAL*FLOAT(IS2-IS1)/ZJETHT
          GOTO8600
 8540     IERZRF=16
          ZJETHT=0
C
C         -----------------------------------
C         START SEARCH FOR INSERTION POINT AT
C         IPHT AND WORK DOWN (TO HIGHER R)
C         UNTIL A HIT OF GREATER R IS FOUND.
C         -----------------------------------
C
 8600     IF(IWRK(IPHST+1).EQ.NH1)GOTO8640
          IF(WRK(IPHST+6).GE.RJETHT)GOTO8610
          IPHST=IPHST-HLDHT
          IF(IPHST.GE.HPHT0)GOTO8600
C
C         -----------------------------------------
C         IPHST POINTS TO FIRST HIT WITH R > RJETHT
C         MAKE ROOM FOR NEW HIT IN HIT BANK
C         -----------------------------------------
C
 8610     LRTREL=1000*LRTREL
          IS1=4*(IPHST-HPHT0+HLDHT)
          HPHT0=HPHT0-HLDHT
          IF(IS1.NE.0)CALLMVCL(WRK(HPHT0),0,IWRK(HPHT0),LNBYTE,IS1)
          CALLMVCL(WRK(IPHST),0,ADWRK(1),0,LNBYTE)
C         IPHST NOW POINTS TO THE HIT JUST INSERTED
C
C         -----------------------------------
C         IF MEMORY OF CELL POINTERS IS STILL
C         REQUIRED THEY MUST NOW BE RESET TO
C         ALLOW FOR THE NEWLY INSERTED HIT
C         -----------------------------------
C
          IF(IRETRN.EQ.3)GOTO8700
          DO 8630 N=1,NCELLS
          IF(CELLPN(N,2).LE.IPHST)CELLPN(N,2)=CELLPN(N,2)-HLDHT
          IF(N.EQ.NC)GOTO8630
          IF(CELLPN(N,1).LE.IPHST)CELLPN(N,1)=CELLPN(N,1)-HLDHT
 8630     CONTINUE
          GOTO8700
 8640     IS1=IABS(IWRK(IPHST+8))
          IF(IS1.LT.1000)IS1=IS1+1000
          LRTREL=LRTREL*IS1
          CALLMVCL(WRK(IPHST),0,ADWRK(1),0,LNBYTE)
C
C         ---------------
C         GOOD HIT RETURN
C         ---------------
C
 8700     WIRSET=LOR(WIRSET,LAYBIT(LAYER))
C######################################################################
      LL = ISIGN(LAYERJ,LRTREL)
      IF (PRINT) PRINT8701,INCELL,LL,BETA,RJETHT,CHIXYF,IERXYF,IPHST
 8701 FORMAT(' CELL',I3,' LAYER',I3,' BETA',F5.2,' R=',F6.1,
     #' RES=',F7.2,I3,' ---ACCEPT---',I5)
C######################################################################
          IF(IERXYF.NE.0)GOTO8750
          IF(RJETHT.GT.REND.OR.RJETHT.LT.RSTR)GOTO8710
          LAYINT=LAYINT+1
          GOTO8720
 8710     LAYEXT=LAYEXT+1
 8720     GOTO(2020,2190,3450),IRETRN
C
C         ---------------
C         BAD  HIT RETURN
C         ---------------
C
 8750     CONTINUE
C######################################################################
      IF (IERXYF.LE.2) GOTO8755
      LL = ISIGN(LAYERJ,LRTREL)
      IF (PRINT) PRINT8751,INCELL,LL,BETA,RJETHT,CHIXYF,IERXYF
 8751 FORMAT(' CELL',I3,' LAYER',I3,' BETA',F5.2,' R=',F6.1,
     #' RES=',F7.2,I3,' ---REJECT---')
 8755  CONTINUE
C######################################################################
          GOTO(2020,2190,3470),IRETRN
C ----- ERROR 3 ILLEGAL RETURN VALUE
          CALLERRORM('PATROL  ',3,NTRAK)
          RETURN
      END
C   08/12/80 211042028  MEMBER NAME  PATROL0  (PATRECSR)    FORTRAN
      SUBROUTINE PATROL(RMIN,RMAX)
      IMPLICIT INTEGER*2(H)
      LOGICAL TBIT
C
C
C----------------------------------------------------------------------
C       --------------  SUBROUTINE PATROL  -----------------
C       ---- G.F.PEARCE .. LAST UPDATE : 2020 ON  4/11/82 ----
C   SUBROUTINE TO SEARCH AND RECORD HITS MISSED BY THE PATTERN
C   RECOGNITION PROGRAMS. IF SUFFICIENT NEW HITS ARE FOUND A REFIT
C   OF THE TRACK IS MADE AND PATROL THEN RECALLS ITSELF.
C
C   TO SATISFY CERTAIN COMPLAINTS MANY VERBOSE COMMENTS HAVE BEEN
C   INTRODUCED. HOPEFULLY EVERYONE ELSE WILL DO THE SAME, BUT I DOUBT IT
C
C  CONTROLLING PATROL.
C  ===================
C                   CONTROL OF THE PARAMETERS AND LIMITS USED BY
C  THIS PROGRAM IS ACHIEVED THROUGH THE ARRAY GFP IN COMMON CPATLM.
C  FOR DETAILS SEE THE INITIALISING ROUTINE INPATR.
C
C  PATROL ERROR MESSAGES
C  =====================
C  PATROL ERROR 1 => PATROL CALLED FOR A TRACK WITH ILLEGAL FIT TYPE
C  PATROL ERROR 2 => NOT ENOUGH ROOM IN CWORK TO STORE ANY MORE HITS
C  PATROL ERROR 3 => ILLEGAL RETURN VALUE - THIS SHOULD NEVER HAPPEN
C  PATROL ERROR 4 => THERE WERE NO GOOD HITS ON THE TRACK WHEN PATROL
C                    WAS CALLED - PATROL IGNORES THIS TRACK.
C  PATROL ERROR 5 => A POINTER WAS -VE. PROBABLY HPTSEC OVERFLOWED
C  PATROL ERROR 6 => PATROL FOUND A HOLE BIGGER THAN THE TRACK. THIS
C                    IS ALMOST CERTAINLY A BACKTRACE ERROR RESULTING
C                    IN THE WRONG ORDERING OF TRACK ELEMENTS. (THEY
C                    SHOULD BE SUPPLIED BY BACKTR RADIALLY ORDERED)
C  PATROL ERROR 7 => OVERSIZE CORRECTION WHEN CONVERTING A PARABOLA TO
C                    A CIRCLE. THE PREVIOUS ITERATION IS USED AND
C                    PATROL CONTINUES.
C  PATROL ERROR 8 => TOO MANY REFITS CALLED BY PATROL. PATROL STOPS
C                    AND RETURNS THOSE HITS ALREADY FOUND.
C  PATROL ERROR 9 => FAILED TO CALCULATE DRIFT PATH DISPERSION
C                    CORRECTION. IT IS ASSUMED TO BE MAXIMUM.
C
C----------------------------------------------------------------------
C
      COMMON/CALIBR/JPOINT(100),
     1HMUCAL(8370),HLGMAI(5760),HTAGSY(384),HJPULS(9216),
     1DELTA0(96,2),DELTA1(96,2),DELTA2(96,2),DELTA5(96,2),DELTA6(96,2)
C
#include "cworkpr.for"
C
#include "cworkeq.for"
C
C=======EQUIVALENCES TO MACROS=======
      REAL*4 SL12(600,2)
      EQUIVALENCE (SL1(1),SL12(1,1))
      INTEGER*4 MINCL(3),MAXCL(3)
      EQUIVALENCE (MINCL(1),IBCK(4)) , (MAXCL(1),IBCK(1))
C====================================
C
#include "cdatamin.for"
C
#include "ccycp.for"
C
#include "cdsmax.for"
C
      COMMON / CJDRCH / RDEC(4),PSIIN(3),RINCR(3),FIRSTW(3),FSENSW(3),
     * RDEPTH,SWDEPL,YSUSPN,TIMDEL(2,3),ZMAX,ZOFFS,ZRESOL,ZNORM,ZAL,
     * ZSCAL,DRIDEV,DRICOS,DRISIN,PEDES,TZERO(3),
     * DRIROT(96,2),SINDRI(96,2),COSDRI(96,2),DRIVEL(96,2),T0FIX(3),
     * CAB(8)
C
#include "cpatlm.for"
C
      COMMON/CHEADR/HEAD(20)
C
C-------------------------------------------
C    EQUIVALENCE HIT BANK TO ADWRK
C-------------------------------------------
C
          EQUIVALENCE(ADWRK( 1),LAYERJ)
          EQUIVALENCE(ADWRK( 2),NH1)
          EQUIVALENCE(ADWRK( 3),NH)
          EQUIVALENCE(ADWRK( 4),XJETHT)
          EQUIVALENCE(ADWRK( 5),YJETHT)
          EQUIVALENCE(ADWRK( 6),ZJETHT)
          EQUIVALENCE(ADWRK( 7),RJETHT)
          EQUIVALENCE(ADWRK( 8),IERZRF)
          EQUIVALENCE(ADWRK( 9),LRTREL)
          EQUIVALENCE(ADWRK(10),INCELL)
          EQUIVALENCE(ADWRK(11),IERXYF)
          EQUIVALENCE(ADWRK(12),BETA)
          EQUIVALENCE(ADWRK(13),INRING)
          EQUIVALENCE(ADWRK(14),CHIXYF)
C
C-------------------------------------------
C         EQUIVALENCE TRACK BANK TO ADWRK
C-------------------------------------------
C
          EQUIVALENCE(ADWRK(21),XSTR)
          EQUIVALENCE(ADWRK(22),YSTR)
          EQUIVALENCE(ADWRK(23),RSTR)
          EQUIVALENCE(ADWRK(28),XEND)
          EQUIVALENCE(ADWRK(29),YEND)
          EQUIVALENCE(ADWRK(30),REND)
          EQUIVALENCE(ADWRK(34),IAMFIT)
          EQUIVALENCE(ADWRK(35),COEFF1,RAD)
          EQUIVALENCE(ADWRK(36),COEFF2,DMID)
          EQUIVALENCE(ADWRK(37),COEFF3,EPSILN)
          EQUIVALENCE(ADWRK(38),COEFF4)
          EQUIVALENCE(ADWRK(40),NPUSED)
          EQUIVALENCE(ADWRK(41),CURV)
C
C-------------------------------------------
C        EQUIVALENCES TO CWORK 'ZERO' ARRAY
C-------------------------------------------
C
          REAL*4 ZERO(100)
          EQUIVALENCE (ADWRK(41),ZERO(1))
          LOGICAL*1 CLFLAG(100)
          INTEGER*2 WIRMSK(96),RGFLAG(4)
          EQUIVALENCE (ZERO( 1),CLFLAG(1))
C         EQUIVALENCE (ZERO(25),CLFLAG(100))
          EQUIVALENCE (ZERO(26),WIRMSK(1))
C         EQUIVALENCE (ZERO(73),WIRMSK(96))
          EQUIVALENCE (ZERO(74),RGFLAG(1))
C         EQUIVALENCE (ZERO(75),RGFLAG(3))
          EQUIVALENCE (ZERO(76),JETCL)
          EQUIVALENCE (ZERO(77),NCELLS)
          EQUIVALENCE (ZERO(78),LAYTRY)
          EQUIVALENCE (ZERO(79),LAYINT)
          EQUIVALENCE (ZERO(80),LAYEXT)
C
C-------------------------------------------
C     EQUIVALENCES TO CWORK OF WORK ARRAY
C-------------------------------------------
C
          INTEGER*2 CELLPN(20,2),NWSET(20),WIRSET
C
C-------------------------------------------
C        DECLARATION OF 'MEMORY' VARIABLES
C-------------------------------------------
C
          REAL*4 PIE/3.14159/,TWOPIE/6.28318/
          INTEGER*4 BIT26/Z00000020/,BIT31N/ZFFFFFFFE/
          INTEGER*4 MSKLBL/Z000000FE/
          INTEGER*2 LAYBIT(16)/
     #    Z0001 , Z0002 , Z0004 , Z0008 ,
     #    Z0010 , Z0020 , Z0040 , Z0080 ,
     #    Z0100 , Z0200 , Z0400 , Z0800 ,
     #    Z1000 , Z2000 , Z4000 , Z8000 /
          INTEGER*2 LAYMSK(16,2) /
     #    ZFFFE , ZFFFC , ZFFF8 , ZFFF0 ,
     #    ZFFE0 , ZFFC0 , ZFF80 , ZFF00 ,
     #    ZFE00 , ZFC00 , ZF800 , ZF000 ,
     #    ZE000 , ZC000 , Z8000 , Z0000 ,
     #    Z0000 , Z0001 , Z0003 , Z0007 ,
     #    Z000F , Z001F , Z003F , Z007F ,
     #    Z00FF , Z01FF , Z03FF , Z07FF ,
     #    Z0FFF , Z1FFF , Z3FFF , Z7FFF /
          LOGICAL*1 PRINT
          NTRAK = HPWRK(30)
          NREFIT=0
C#######################################################################
      PRINT = .FALSE.
      IF(NTRAK.EQ.IGFP(20)) PRINT = .TRUE.
      IF(IGFP(20).LT.0.AND.NTRAK.GE.IABS(IGFP(20))) PRINT=.TRUE.
C#######################################################################
C==============================================
C==============================================
C         INITIALISATION
C==============================================
C==============================================
          KNTRL=IGFP(1)
 510      CONTINUE
C#######################################################################
          IF(PRINT)PRINT511,NTRAK,IGFP(1)
 511  FORMAT(1X,38('=')/' PATROL TRACK',I4,' GFP(1) = ',Z8/1X,38('='))
C#######################################################################
          ISTORY=IWRK(HPTR0+47)
          LNBYTE=HLDHT * 4
C==============================================
C==============================================
C         COMPUTE TRACK PARAMETERS
C==============================================
C==============================================
          IAMFIT=IWRK(HPTR0+17)
          IF(IAMFIT.EQ.1.OR.IAMFIT.EQ.2)GOTO520
C ----- ERROR 1 ILLEGAL FIT TYPE
          CALLERRORM('PATROL  ',1,NTRAK)
          GOTO7000
 520      CURV=WRK(HPTR0+24)
C#######################################################################
      IF(PRINT.AND.ABS(CURV).GE.GFP(14)) PRINT521,CURV
 521  FORMAT(' PATROL ABANDONED .. CURVATURE TOO HIGH ',E11.4)
C#######################################################################
          IF(ABS(CURV).GE.GFP(14))GOTO7000
          COEFF1=WRK(HPTR0+18)
          COEFF2=WRK(HPTR0+19)
          COEFF3=WRK(HPTR0+20)
          COEFF4=WRK(HPTR0+21)
          XSTR=WRK(HPTR0+4)
          YSTR=WRK(HPTR0+5)
          RSTR=WRK(HPTR0+6)-5.
          XEND=WRK(HPTR0+11)
          YEND=WRK(HPTR0+12)
          REND=WRK(HPTR0+13)+5.
          TRLEN2=(XSTR-XEND)**2+(YSTR-YEND)**2
          GOTO(910,920),IAMFIT
C
C         --------------------
C         TYPE 1 .. CIRCLE FIT
C         --------------------
C
 910      RAD=1./RAD
          DMID=DMID+RAD
          DMIDSQ=DMID**2
          XMID=DMID*COS(EPSILN)
          YMID=DMID*SIN(EPSILN)
          GOTO990
C
C         -----------------------
C         TYPE 2 .. PARABOLA FIT
C         -----------------------
C
 920      S1=SIN(COEFF1)
          S2=COS(COEFF1)
          RAD=1./(2*COEFF4)
          XMID=COEFF2-RAD*S1
          YMID=COEFF3+RAD*S2
C         CORRECT INSCRIBED CIRCLE
          IF(ABS(RAD).GE.30000)GOTO931
          IS3=0
 930      IS3=IS3+1
          S4=(XSTR-XMID)**2+(YSTR-YMID)**2-RAD**2
          S4=8*S4/TRLEN2
          S5=S4*RAD
          IF(ABS(S4).LE.0.4)GOTO933
C ----- ERROR 7 OVERSIZE CIRCLE CORRECTION
          IF(PRINT)CALLERRORM('PATROL  ',7,NTRAK)
          GOTO931
 933      RAD=RAD+S5
          XMID=XMID-S5*S1
          YMID=YMID+S5*S2
C#######################################################################
      IF(PRINT) PRINT981,RAD,XMID,YMID,S4
 981  FORMAT(' CIRCLE CORRECTION..RAD/X0/Y0 =',3E11.4,' CORRN =',F7.3)
C#######################################################################
          IF(S4.GT.GFP(15).AND.IS3.LT.5)GOTO930
 931      EPSILN=ATAN2(YMID,XMID)
          DMIDSQ=XMID**2 + YMID**2
          DMID=SQRT(DMIDSQ)
C
C         --------------------------
C         CLEAN UP CIRCLE PARAMETERS
C         --------------------------
C
 990      RAD=ABS(RAD)
          RADSQ=RAD**2
          RAD2=RAD*2
C
C==============================================
C==============================================
C         CALCULATE RESIDUAL CUTS
C==============================================
C==============================================
C
          NPUSED=IWRK(HPTR0+23)
          S1=10*NPUSED*ABS(CURV)
          IF(S1.GT.1.0)S1=1.0
          CODE0=GFP(4)+S1*GFP(5)
          CODE2=GFP(3)
C#######################################################################
      IF(PRINT) PRINT991,NPUSED,CODE0,CODE2,RSTR,REND
 991  FORMAT(' PATROL CUTS..NPUSED =',I4,' CODE0/CODE2 =',2F4.1/
     #       '           RSTR/REND =',2E11.4)
C#######################################################################
C
C==============================================
C==============================================
C         FLAG HITS ALREADY ATTACHED TO TRACK
C==============================================
C==============================================
C
          CALLSETSL(ZERO(1),0,320,0.)
          LAYSNT=0
          INCELL=0
          JETWR=-1
          IPHT=HPHT9-HLDHT+1
 1010     IF(IWRK(IPHT+10).EQ.0)GOTO1030
 1020     IPHT=IPHT-HLDHT
          IF(IPHT.LT.HPHT0)GOTO1060
          GOTO1010
 1030     JNCELL=IWRK(IPHT+9)
          IF(JNCELL.NE.INCELL)GOTO1050
C
C         ----------------------
C         NEW LAYER --- OLD CELL
C         ----------------------
C
 1040     IS1=IS1+1
          LAYSNT=LAYSNT+1
          LAYER=IWRK(IPHT)+1
          WIRSET=LOR(WIRSET,LAYBIT(LAYER))
          IPHST=IPHT
          GOTO1020
 1050     IF(INCELL.EQ.0)GOTO1070
C
C         --------------------------------
C         CELL COMPLETED -- LOAD END FLAGS
C         --------------------------------
C
 1060     CELLPN(NC,2)=IPHST
          WIRMSK(INCELL)=WIRSET
          NWSET(NC)=IS1
          IF(IPHT.LT.HPHT0)GOTO1110
C
C         ----------------------------
C         NEW CELL -- INITIALISE FLAGS
C         ----------------------------
C
 1070     INCELL=JNCELL
          INRING=IWRK(IPHT+12)
          RGFLAG(INRING)=INRING + 1
          WIRSET=WIRMSK(INCELL)
          IF(CLFLAG(INCELL))GOTO1080
          NCELLS=NCELLS+1
          NC=NCELLS
          IS1=0
          CLFLAG(INCELL)=.TRUE.
          CELLPN(NC,1)=IPHT
          GOTO1040
C
C         -----------------------------
C         OLD CELL AGAIN -- RESET FLAGS
C         -----------------------------
C
 1080     DO 1090 NC=1,NCELLS
          JNCELL=CELLPN(NC,1)
          JNCELL=IWRK(JNCELL+9)
          IF(JNCELL.EQ.INCELL)GOTO1100
 1090     CONTINUE
 1100     IS1=NWSET(NC)
          GOTO1040
 1110     IF(LAYSNT.GE.4)GOTO1120
C ----- ERROR 4 NO GOOD HITS FROM FIT !!!
          CALLERRORM('PATROL  ',4,NTRAK)
          GOTO7000
 1120     IF(TBIT(KNTRL,30))GOTO3000
C
C==============================================
C==============================================
C         LOOK FOR NEW HITS IN CELLS WITH HITS
C==============================================
C==============================================
C
          DO 2200 NC=1,NCELLS
          IRETRN=1
          IPHT=CELLPN(NC,1)
          INCELL=IWRK(IPHT+9)
          INRING=IWRK(IPHT+12)
C
C         -----------------------
C         CHECK FOR UNUSED LAYERS
C         -----------------------
C
          IS1=NWSET(NC)
C#######################################################################
          NH0 = HPTSEC(INCELL)
          NH9 = HPTSEC(INCELL+1) - 1
          IS2 = SHFTR(NH9-NH0,2) + 1
      IF (PRINT) PRINT2011,INCELL,WIRMSK(INCELL),IS1,IS2
 2011 FORMAT(' SEARCH OLD CELL',I3,' MASK = Z',Z4,' WIRES GOT =',I3,
     #' HITS AVAILABLE =',I4)
C#######################################################################
          IF(IS1.EQ.16)GOTO2100
C         NH0=FIRST HIT, NH9 = LAST HIT
          NH0=HPTSEC(INCELL)
          NH9=HPTSEC(INCELL+1)-4
          IF(NH0.GT.0)GOTO2010
C ----- ERROR 5 POINTER -VE .. SUSPECT HPTSEC OVERFLOW
          CALLERRORM('PATROL  ',5,NTRAK)
          GOTO2100
 2010     IS2=SHFTR(NH9-NH0,2)+1
          IF(IS2.LE.IS1)GOTO2100
C
C         -----------------------
C         CHECK ALL UNUSED LAYERS
C         -----------------------
C
C         SET IPHST TO LOWEST R HIT (HIGH IPHT)
CCCC      IPHST=IPHT
          IPHST=HPHT9 - HLDHT + 1
          WIRSET=WIRMSK(INCELL)
          DO 2020 NH1=NH0,NH9,4
          INWIRE=HDATA(NH1)
          INWIRE=SHFTR(INWIRE,3)
          LAYER=LAND(INWIRE,15)+1
          MAND=LAND(WIRSET,LAYBIT(LAYER))
          IF(MAND.NE.0)GOTO2020
          GOTO8000
 2020     CONTINUE
          WIRMSK(INCELL)=WIRSET
C
C==============================================
C==============================================
C  LOOK FOR NEW HITS IN CELLS ADJACENT TO CELLS
C  ALREADY CONTAINING HITS ON THE TRACK
C  IEND = 1 => LOW R.   IEND = 2 => HIGH R.
C==============================================
C==============================================
C
 2100     IRETRN=2
          JNCELL = INCELL
          DO 2195 IEND=1,2
C
C         --------------------------
C         REJECT WALL CROSSING IF NO
C         LAYERS IN THE ADJACENT CELL
C         COULD HAVE BEEN HIT.
C         --------------------------
C
          IPHT=CELLPN(NC,IEND)
          LAYER=IWRK(IPHT) + 1
          NLMIDO=IWRK(IPHT+8)
          LRINDX=1
          IF(NLMIDO.GT.0)LRINDX=2
          NWLIM=HMCH(LAYER,INRING,LRINDX)+1
C######################################################################
      INCELL = JNCELL + ISIGN(1,NLMIDO)
      IF(INCELL.GT.MAXCL(INRING)) INCELL=MINCL(INRING)
      IF(INCELL.LT.MINCL(INRING)) INCELL= MAXCL(INRING)
      IF (PRINT) PRINT2111,IEND,INCELL,LAYER,NLMIDO,NWLIM
 2111 FORMAT('        END',I2,' = CELL',I3,' LAYER',I3,' NLMIDO =',I5,
     #' NWLIM =',I3)
C######################################################################
          IF(NWLIM.LT.1.OR.NWLIM.GT.16)GOTO2195
C
C         ------------------------------------------
C         HAS THE ADJACENT CELL ALREADY BEEN CHECKED
C         ------------------------------------------
C
          INCELL=JNCELL+ISIGN(1,NLMIDO)
          IF(INCELL.GT.MAXCL(INRING))INCELL=MINCL(INRING)
          IF(INCELL.LT.MINCL(INRING))INCELL=MAXCL(INRING)
C######################################################################
      IF (PRINT.AND.CLFLAG(INCELL)) PRINT2121,INCELL
 2121 FORMAT('          CELL',I3,'  ALREADY CHECKED')
C######################################################################
          IF (CLFLAG(INCELL)) GOTO2195
C
C         -----------------------------------
C         ARE THERE ANY HITS IN THIS NEW CELL
C         -----------------------------------
C
          NH0 = HPTSEC(INCELL)
          NH9 = HPTSEC(INCELL+1) - 4
          IF (NH0.GT.0) GOTO2130
          CALLERRORM('PATROL  ',5,NTRAK)
          GOTO2195
 2130     CONTINUE
C######################################################################
      IF (PRINT.AND.(NH9.LT.NH0)) PRINT2122,INCELL,NH0,NH9
 2122 FORMAT('          CELL',I3,' HAS NO HITS',2I10)
C######################################################################
          IF(NH9.LT.NH0)GOTO2195
C
C         -------------------------------
C         REJECT CELL IF END HIT TOO FAR
C         FROM CELL BOUNDARY IN DRIFT SPACE
C         --------------------------------
C
          NLMIDO=IABS(NLMIDO)
          IF(NLMIDO.GT.199)GOTO2180
          DRIFT=HDATA(IWRK(IPHT+1)+3)
          IF(LAYER.GE.9)GOTO2140
          DRIFT=DRIFT*TIMDEL(1,INRING)
          GOTO2150
 2140     DRIFT=DRIFT*TIMDEL(2,INRING)
 2150     S2=SL12(NLMIDO,IEND)
          IS1=LAYER
          IF(IEND.EQ.2)GOTO2160
          S2=-S2
          IF (IS1.NE.1)IS1=IS1-1
          GOTO2170
 2160     IF(IS1.NE.16)IS1=IS1+1
 2170     DRIFT=ABS(DRIFT+S2)
          S2=DSMAX(IS1,INRING,LRINDX)*GFP(11)
C######################################################################
      IF (PRINT.AND.(DRIFT.LT.S2)) PRINT2171,INCELL,DRIFT,S2
 2171 FORMAT('          CELL',I3,' OUTSIDE DSMAX ',2F6.1)
C######################################################################
          IF(DRIFT.LT.S2)GOTO2195
C
C         ---------------------------------
C         MASK OUT DISALLOWED HITS AND
C         CHECK FIT RESIDUAL ON ALLOWED HITS
C         ---------------------------------
C
C         SET START POINTER TO LOWEST R HIT (HIGH IPHT)
 2180     IPHST=HPHT9-HLDHT+1
          WIRSET=WIRMSK(INCELL)
          WIRSET=LOR(WIRSET,LAYMSK(NWLIM,IEND))
C######################################################################
      IF (PRINT) PRINT2181,WIRMSK(INCELL),LAYMSK(NWLIM,IEND)
 2181 FORMAT('        SEARCH WITH WIRE MASK =Z',Z4,' AND Z',Z4)
C######################################################################
          NH1=NH0
 2185     INWIRE=HDATA(NH1)
          INWIRE=SHFTR(INWIRE,3)
          LAYER=LAND(INWIRE,15)+1
          MAND=LAND(WIRSET,LAYBIT(LAYER))
          IF(MAND.NE.0)GOTO2190
          GOTO8000
 2190     NH1=NH1+4
          IF(NH1.LE.NH9)GOTO2185
          WIRMSK(INCELL)=WIRSET
 2195     CONTINUE
 2200     CONTINUE
C
C==============================================
C==============================================
C         LOOK FOR NEW HITS IN MISSING RINGS
C==============================================
C==============================================
C
C
C--------------------------------
C  STEP 1. DETERMINE MISSING RING
C--------------------------------
C
 3000     NRMISS=RGFLAG(1)+RGFLAG(2)+RGFLAG(3)-1
C
C         -------------------------
C         IS THERE A MISSING RING ?
C         -------------------------
C
          IF(NRMISS.GE.7)GOTO4000
          IF (TBIT(KNTRL,28).AND.NRMISS.NE.5)GOTO4000
C         REQUIRED TO AVOID RUTHERFORD 0C4
          LAYLST=0
          IPHST=HPHT9-HLDHT+1
          GOTO(3110,3120,3130,3140,3150,3160),NRMISS
C         BOTH RINGS 2 AND 3 MISSING
 3110     INRING=2
          GOTO3200
C         BOTH RINGS 1 AND 3 MISSING
 3120     INRING=1
          GOTO3200
C         BOTH RINGS 1 AND 2 MISSING
 3130     INRING=2
          GOTO3200
C         ONLY RING 3 MISSING
 3140     INRING=3
          GOTO3200
C         ONLY RING 2 MISSING
 3150     INRING=2
          GOTO3200
C         ONLY RING 1 MISSING
 3160     INRING=1
C
C-----------------------------------------------
C  STEP 2.  DETERMINE CELLS INTERSECTED BY TRACK
C-----------------------------------------------
C
 3200     IRETRN=3
          S1=FSENSW(INRING)
          S2=S1+15*RINCR(INRING)
          IF(.NOT.TBIT(NRMISS,30))GOTO3240
          S1=S2
          S2=FSENSW(INRING)
C
C         ---------------------------------
C         COMPUTE RING INTERSECTION AZIMUTH
C         FOR ENTRY AND EXIT RADII
C         ---------------------------------
C
 3240     S1=(S1**2+DMIDSQ-RADSQ)/(2*S1*DMID)
          S2=(S2**2+DMIDSQ-RADSQ)/(2*S2*DMID)
C#######################################################################
      IF (ABS(S1).LE.1.0.OR.ABS(S2).LE.1.0) GOTO3245
      IF (PRINT) PRINT3241,INRING
 3241 FORMAT(' RING',I2,' NOT REACHED BY TRACK')
 3245  CONTINUE
C#######################################################################
          IF(ABS(S1).LE.1.0)GOTO3250
          IF(ABS(S2).GT.1.0)GOTO4000
          S1=SIGN(1.0,S1)
          GOTO3260
 3250     IF(ABS(S2).GT.1.0)S2=SIGN(1.0,S2)
 3260     S1=ARCOS(S1)
          S2=ARCOS(S2)
C
C         ------------------------
C         HAVE TWO SOLNS OF COURSE
C         DECIDE ON CORRECT ONE.
C         ------------------------
C
          S3=EPSILN-S1
          S1=EPSILN+S1
          S5=ATAN2(YSTR,XSTR)
          S4=ABS(S1-S5)
          IF(S4.GT.PIE)S4=TWOPIE-S4
          S5=ABS(S3-S5)
          IF(S5.GT.PIE)S5=TWOPIE-S5
          IF(S5.LT.S4)GOTO3270
          S2=EPSILN+S2
          GOTO3280
 3270     S1=S3
          S2=EPSILN-S2
 3280     IF(S1.LT.0.)S1=S1+TWOPIE
          IF(S2.LT.0.)S2=S2+TWOPIE
C
C         ---------------------------------
C         COMPUTE CELL RANGE TO BE SEARCHED
C         ---------------------------------
C
          S3=0.2618
          IF(INRING.EQ.3)S3=0.1309
          INCELL=S1/S3
          INCEL2=S2/S3
          INC=ISIGN(1,INCEL2-INCELL)
          IS1=MINCL(INRING)
          IS2=MAXCL(INRING)
          INCELL=IS1+INCELL
          INCEL2=IS1+INCEL2
          IF(INCELL.EQ.IS1.AND.INCEL2.EQ.IS2)INC=-1
          IF(INCELL.EQ.IS2.AND.INCEL2.EQ.IS1)INC=+1
C#######################################################################
      IF (PRINT) PRINT3296,INRING,INCELL,INCEL2,INC,NRMISS
 3296 FORMAT(' SEARCH RING',I2,' CELLS',I3,' TO',I3,' INC/NRMISS =',2I2)
C######################################################################
C
C-----------------------------------
C  STEP 3. LOOP OVER SELECTED CELLS
C-----------------------------------
C
          WIRSET=WIRMSK(INCELL)
C
C         ---------------------------------
C         GET POINTERS TO HITS IN THIS CELL
C         NH0 = FIRST HIT , NH9 = LAST HIT
C         ---------------------------------
C
 3410     NH0=HPTSEC(INCELL)
          NH9=HPTSEC(INCELL+1)-4
C######################################################################
      IF (PRINT.AND.(NH9.LT.NH0)) PRINT3411,INRING,INCELL,NH0,NH9
 3411 FORMAT(' RING',I2,' CELL',I3,' HAS NO HITS',2I10)
C######################################################################
          IF(NH0.GT.0)GOTO3420
          CALLERRORM('PATROL  ',5,NTRAK)
          GOTO3500
 3420     IF(NH9.LT.NH0)GOTO3500
          INCNH1=4
          IF(.NOT.TBIT(NRMISS,30))GOTO3430
          IS1=NH0
          NH0=NH9
          NH9=IS1
          INCNH1=-4
C
C         ---------------------------------
C         LOOP OVER ALL HITS IN CELL INCELL
C         ---------------------------------
C
 3430     NH1=NH0
          LAYLST=0
          LAYTRY=0
C######################################################################
      IF (PRINT) PRINT3431,INCELL,WIRSET
 3431 FORMAT('            CELL',I3,' SET MASK =Z',Z4)
C######################################################################
 3440     INWIRE=HDATA(NH1)
          INWIRE=SHFTR(INWIRE,3)
          LAYER=LAND(INWIRE,15)+1
          MAND=LAND(WIRSET,LAYBIT(LAYER))
          IF(MAND.NE.0)GOTO3480
          GOTO8000
C         GOOD HIT
 3450     LAYLST=LAYER
          GOTO3480
C         BAD HIT
 3470     IF(NRMISS.NE.5.AND.LAYTRY.GE.IGFP(6))GOTO3510
 3480     IF(NH1.EQ.NH9)GOTO3490
          NH1=NH1+INCNH1
          GOTO3440
C
C         --------------
C         GOTO NEXT CELL
C         --------------
C
 3490     WIRMSK(INCELL)=WIRSET
 3500     IF(INCELL.EQ.INCEL2)GOTO3520
          INCELL=INCELL+INC
          IF(INCELL.GT.MAXCL(INRING))INCELL=MINCL(INRING)
          IF(INCELL.LT.MINCL(INRING))INCELL=MAXCL(INRING)
C         SET MINIMUM LAYER FOR NEW CELL
          WIRSET=WIRMSK(INCELL)
          IF(LAYLST.EQ.0)GOTO3410
          IS1=1
          IF(INC.GT.0)IS1=2
          NWLIM=HMCH(LAYLST,INRING,IS1)+1
          IS2=2
          IF(NH9.LT.NH0)IS2=1
          WIRSET=LOR(WIRSET,LAYMSK(NWLIM,IS2))
C######################################################################
      IF(PRINT)PRINT3501,INCELL,LAYMSK(NWLIM,IS2),WIRSET
 3501 FORMAT('     "OR" NEXT CELL',I3,' MASK WITH Z',Z4,' GIVING Z',Z4)
C######################################################################
          GOTO3410
C
C         -------------------------
C         END OF LOOP OVER NEW RING
C         -------------------------
C
 3510     WIRMSK(INCELL)=WIRSET
 3520     CONTINUE
C
C==============================================
C==============================================
C         END OF PATROL HIT SEARCH
C==============================================
C==============================================
C
 4000     CONTINUE
C######################################################################
      IF (PRINT) PRINT4001,LAYINT,LAYEXT
 4001 FORMAT(' HIT SEARCH OVER. FOUND INTERP. =',I3,' EXTRAP. =',I3)
      IF(PRINT)CALLPCWORK(0,0,0,1,0)
C######################################################################
C
C         -----------------------------------------
C         LOOK FOR UNWANTED HITS FROM EXTRAPOLATION
C         -----------------------------------------
C
          IPHT=HPHT0
          S4=REND
 4010     S1=0.
          IS2=0
          IS3=IPHT
 4020     IF(IWRK(IPHT+10).NE.0)GOTO4040
          RJETHT=WRK(IPHT+6)
          IF(S1.EQ.0.)GOTO4030
          IF(ABS(RJETHT-S1).GT.GFP(8))GOTO4050
 4030     S1=RJETHT
          IS2=IS2+1
          IF(HLDHT*(RJETHT-S4).LT.0.)GOTO4060
 4040     IPHT=IPHT+HLDHT
          GOTO4020
C         DEMAND IGFP(9) CONSEC HITS
 4050     IF(IS2.LT.IGFP(9))GOTO4055
C         DONT ALLOW BIG HOLES
          IS5=IPHT
 4051     IS5=IS5-HLDHT
          IF(IS5.GE.HPHT0.AND.IS5.LT.HPHT9)GOTO4052
C ----- ERROR 6 PATROL FINDS HOLE BIGGER THAN TRACK. PROBABLE CAUSE
C ----- ERROR 6 IS A BACKTRACE ERROR IN TRACK ELEMENT ORDERING
          CALLERRORM('PATROL  ',6,NTRAK)
          IF(HLDHT.LT.0)HLDHT=-HLDHT
          CALLPCWORK(0,0,0,1,0)
          GOTO7000
 4052     IF(IWRK(IS5+10).NE.0)GOTO4051
          S2=(WRK(IPHT+3)-WRK(IS5+3))**2+(WRK(IPHT+4)-WRK(IS5+4))**2
          S2=SQRT(S2)-GFP(7)
          IF(IWRK(IS5+12).NE.IWRK(IPHT+12))S2=S2-GFP(12)
          IF(S2.LE.0.0)GOTO4056
 4055     IS3=IPHT
 4056     IS2=0
          GOTO4030
C         TRUE PATROL END POINT FOUND
C         MASK OUT UNWANTED HITS
 4060     IF(HLDHT.LT.0)GOTO4090
          IPHT=IS3
 4070     IPHT=IPHT-HLDHT
          IF(IPHT.LT.HPHT0)GOTO4080
C######################################################################
      IF (PRINT) PRINT4071,IPHT,IWRK(IPHT+9),IWRK(IPHT),IWRK(IPHT+8)
     # ,IWRK(IPHT+10)
 4071 FORMAT(' DELETE HIT..IPHT',I5,' CELL',I3,' LAYER',I3,' LRTREL',I5
     #,' IERXYF',I3)
C######################################################################
          IF(IWRK(IPHT+10).NE.0)GOTO4070
          IF(WRK(IPHT+6).GT.REND)LAYEXT=LAYEXT-1
          IWRK(IPHT+10)=2
          GOTO4070
 4080     IPHT=HPHT9-HLDHT+1
          HLDHT=-HLDHT
          S4=RSTR
          GOTO4010
 4090     CONTINUE
          IPHT=IS3
 4091     IPHT=IPHT-HLDHT
          IF(IPHT.GT.HPHT9)GOTO4100
          IF(IWRK(IPHT+10).NE.0)GOTO4091
          IF(WRK(IPHT+6).LT.RSTR)LAYEXT=LAYEXT-1
          IWRK(IPHT+10)=2
C######################################################################
      IF (PRINT) PRINT4071,IPHT,IWRK(IPHT+9),IWRK(IPHT),IWRK(IPHT+8)
     # ,IWRK(IPHT+10)
C######################################################################
          GOTO4091
 4100     HLDHT=-HLDHT
C######################################################################
      IF (PRINT) PRINT4101,LAYINT,LAYEXT
 4101 FORMAT(' END OF DELETE.   FOUND INTERP. =',I3,' EXTRAP. =',I3)
      IF (PRINT) CALLPCWORK(0,0,0,1,0)
C######################################################################
C
C         -------------------------------------
C         CALL REFIT WITH NEW HITS IF NECESSARY
C         -------------------------------------
C
 5000     IF(TBIT(KNTRL,31))GOTO7000
C         REFIT IF HAVE MANY MORE HITS
          IF(LAYINT.GE.IGFP(10))GOTO5010
          IF(LAYEXT.GT.0)GOTO5010
          GOTO7000
 5010     NREFIT=NREFIT+1
          IF(NREFIT.LE.IGFP(13))GOTO5015
C ----- ERROR 8 PATROL HAS CALLED TOO MANY REFITS .. END PATROL
                   CALLERRORM('PATROL  ',8,NTRAK)
          GOTO7000
 5015     IXYF1=IXYF(1)
          IXYF(1)=1
C######################################################################
      IF (PRINT) PRINT5011
 5011 FORMAT(' CALL XYFIT ')
C######################################################################
          RSTRSV=RSTR+5.
          RENDSV=REND-5.
          CALLXYFIT
          IXYF(1)=IXYF1
C         REPEAT PATROL IF FIT WAS GOOD
          IF(WRK(HPTR0+22).LE.GFP(2))GOTO510
C
C         ----------------------------------
C         REFIT WAS BAD. MASK OUT PATROLLED
C         HITS AND REINSTATE ORIGINAL FIT
C         ----------------------------------
C
          IWRK(HPTR0+47)=LOR (IWRK(HPTR0+47),BIT26)
          IWRK(HPTR0+47)=LAND(IWRK(HPTR0+47),BIT31N)
          IPHT=HPHT0+10
 5020     IF(IWRK(IPHT).EQ.1)IWRK(IPHT)=0
          IF(IABS(IWRK(IPHT-2)).LT.1000)GOTO5021
          RJETHT=WRK(IPHT-4)
          IF(RJETHT.GE.RSTRSV.AND.RJETHT.LE.RENDSV)GOTO5021
          IWRK(IPHT)=2
 5021     IPHT=IPHT+HLDHT
          IF(IPHT.LT.HPHT9)GOTO5020
C######################################################################
      IF (PRINT) PRINT4201
 4201 FORMAT(' PATROL RE-FIT WAS BAD. DELETE PATROLLED HITS AND REFIT')
C######################################################################
          IXYF1=IXYF(1)
          IXYF(1)=1
          CALLXYFIT
          IXYF(1)=IXYF1
C
C         ----------------------
C         FINAL EXIT FROM PATROL
C         ----------------------
C
 7000     IWRK(HPTR0+47)=ISTORY
C######################################################################
      IF (PRINT) PRINT4801,LAYINT
 4801 FORMAT(1X,10('#'),' EXIT PATROL. LAYINT =',I3)
C#######################################################################
          RETURN
C
C==============================================
C==============================================
C         CALCULATE RESIDUAL OF TEST HIT AND
C         LOAD INTO HIT ARRAY IF ACCEPTABLE
C==============================================
C==============================================
C
C         -------------------------
C         COMPUTE HIT LABEL POINTER
C         IS1=0 => HIT NOT ON TREL
C         -------------------------
C
 8000     IF(NH1.GT.0)GOTO8001
          CALLERRORM('PATROL  ',5,NTRAK)
          GOTO8750
 8001     NH=SHFTR((NH1-HPTSEC(1)),1)+HPHL0
          IS1=HWRK(NH)
          IS1=LAND(IS1,MSKLBL)
          IF(IS1.EQ.0)GOTO8010
          IF(TBIT(KNTRL,29))GOTO8750
          GOTO8020
 8010     IF(TBIT(KNTRL,25))GOTO8750
 8020     CONTINUE
C
C         ----------------------------------
C         SET UP CELL AND LAYER CONSTANTS.
C         SKIP IF SAME WIRE ETC AS LAST TIME
C         ----------------------------------
C
          IF(INWIRE.EQ.JETWR)GOTO8120
          JETWR=INWIRE
C         NEW LAYER BEING TRIED .. INCREMENT LAYTRY
          LAYTRY=LAYTRY+1
          IF(INCELL.EQ.JETCL)GOTO8100
          JETCL=INCELL
          TRLORX=TRMATS(INCELL,1)
          TRLORY=TRMATC(INCELL,1)
          SINLOR=SINDRI(INCELL,1)
          COSLOR=COSDRI(INCELL,1)
          DRFVEL=DRIVEL(INCELL,1)
          DEL11=DELTA1(INCELL,1)
          DEL12=DELTA1(INCELL,2)
          DEL21=DELTA2(INCELL,1)
          DEL22=DELTA2(INCELL,2)
          RSENSW=FSENSW(INRING)
          DR0=RINCR(INRING)
          IS1=INCELL-24*(INRING-1)
          IF(INRING.EQ.3)GOTO8030
          DXWR=DIRWR1(IS1,1)
          DYWR=DIRWR1(IS1,2)
          GOTO8040
 8030     DXWR=DIRWR3(IS1,1)
          DYWR=DIRWR3(IS1,2)
 8040     SWDEPX=SWDEPL*DXWR
          SWDEPY=SWDEPL*DYWR
C
C         ------------------------------
C         COMPUTE (X,Y,R) OF SIGNAL WIRE
C         ------------------------------
C
 8100     LAYERJ=LAYER-1
          RWIRE=RSENSW+LAYERJ*DR0
          IF(TBIT(LAYERJ,31))GOTO8110
          XWIRE=RWIRE*DXWR-SWDEPY
          YWIRE=RWIRE*DYWR+SWDEPX
          GOTO8120
 8110     XWIRE=RWIRE*DXWR+SWDEPY
          YWIRE=RWIRE*DYWR-SWDEPX
 8120     CONTINUE
          IF(HPHT0.GT.HPHTLM)GOTO8200
C ----- ERROR 2 NOT ENOUGH ROOM IN CWORK
          CALLERRORM('PATROL  ',2,NTRAK)
          GOTO7000
C
C         --------------------------------
C         COMPUTE DRIFT DISTANCE FROM TIME
C         NOTE THAT DRIFT DISTANCE IS +VE
C         --------------------------------
C
 8200     IDRIFT=HDATA(NH1+3)
          DRIFT=IDRIFT*DRFVEL
          IF(HEAD(18).LE.0)DRIFT=DRIFT+0.5*DRFVEL
C
C         --------------------------------
C         DRIFT PATH DISPERSION CORRECTION
C         --------------------------------
C
          XJETHT=XWIRE-TRLORX*DRIFT-XMID
          YJETHT=YWIRE-TRLORY*DRIFT-YMID
          XJET2 =XWIRE+TRLORX*DRIFT-XMID
          YJET2 =YWIRE+TRLORY*DRIFT-YMID
          S3=SINLOR*DXWR-COSLOR*DYWR
          S4=COSLOR*DXWR+SINLOR*DYWR
          XX = ABS(S3*XJETHT+S4*YJETHT)
          IF(XX.NE.0.)GOTO1350
          CALLERRORM('PATROL  ',9,NTRAK)
C ----- ERROR 9  FAILED TO CALCULATE DRIFT PATH DISPERSION
C ----- ERROR 9  CORRECTION. ASSUME IT TO BE MAXIMUM
          BETA = 1.1
          GOTO1355
 1350     BETA = RAD/XX
          IF(BETA.LT.1.0)BETA=1.0
          IF(BETA.GT.1.2)BETA=1.1
 1355     XX=ABS(S3*XJET2+S4*YJET2)
          IF(XX.NE.0.) GOTO1360
          CALLERRORM('PATROL  ',9,NTRAK)
          BETA2 = 1.1
          GOTO1365
 1360     BETA2=RAD/XX
          IF(BETA2.LT.1.0)BETA2=1.0
          IF(BETA2.GT.1.1)BETA2=1.1
 1365     CONTINUE
C
          SCALE=DRIFT
          IF(DRIFT.GT.4.)SCALE=4.
          DRIFT1=DRIFT+(BETA-1.)*SCALE
          DRIFT2=DRIFT+(BETA2-1.)*SCALE
C
C         --------------------------
C         EDGE WIRE FIELD DISTORTION
C         --------------------------
C
          IF(LAYER.GE.3)GOTO1370
          DRIFT1=DRIFT1*(1.-DEL11*(LAYER-3)**2)
          DRIFT2=DRIFT2*(1.-DEL12*(LAYER-3)**2)
          GOTO1380
 1370     IF(LAYER.LE.12)GOTO1380
          DRIFT1=DRIFT1*(1.-DEL21*(LAYER-12)**2)
          DRIFT2=DRIFT2*(1.-DEL22*(LAYER-12)**2)
 1380     CONTINUE
C         ----------------------------------
C         DRIFT VELOCITY VARIATION NEAR WIRE
C         ----------------------------------
C
          IF(DRIFT1.LT.CAB(4))DRIFT1=DRIFT1+CAB(5)*(DRIFT1-CAB(4))**2
          IF(DRIFT2.LT.CAB(4))DRIFT2=DRIFT2+CAB(5)*(DRIFT2-CAB(4))**2
C         ---------------------
C         RESET -VE DRIFT TIMES
C         ---------------------
C
          IF(DRIFT1.LT.0.)DRIFT1=0.05
          IF(DRIFT2.LT.0.)DRIFT2=0.05
C
C         --------------------------------
C         COMPUTE X,Y COORDINATES FOR BOTH
C         LEFT (-VE) AND RIGHT (+VE) SOLNS
C         --------------------------------
C
          XJETHT=XWIRE-TRLORX*DRIFT1
          YJETHT=YWIRE-TRLORY*DRIFT1
          XJET2 =XWIRE+TRLORX*DRIFT2
          YJET2 =YWIRE+TRLORY*DRIFT2
C
C         --------------------------------
C         COMPUTE RESIDUALS FOR BOTH L/R
C         SOLUTIONS AND TAKE THE SMALLEST
C         --------------------------------
C
          CHIXYF=(XJETHT-XMID)**2+(YJETHT-YMID)**2
          CHIXYF=(CHIXYF-RADSQ)/RAD2
          S2=(XJET2-XMID)**2+(YJET2-YMID)**2
          S2=(S2-RADSQ)/RAD2
          LRTREL=-1
          DRIFT=DRIFT1
          IF(ABS(CHIXYF).LT.ABS(S2))GOTO8410
          LRTREL=1
          DRIFT=DRIFT2
          XJETHT=XJET2
          YJETHT=YJET2
          CHIXYF=S2
          BETA=BETA2
C
C         ----------------------
C         DETERMINE ACCEPT CODE
C         ----------------------
C
 8410     S2=ABS(CHIXYF)
          IERXYF=3
          IF(S2.GT.CODE2)GOTO8750
          IF(S2.GT.CODE0)GOTO8420
          IERXYF=0
          LAYTRY=0
          GOTO8430
 8420     IERXYF=2
 8430     CONTINUE
C
C         --------------------------------
C         COMPUTE RADIAL COORDINATE
C         TEST AGAINST USER DEFINED LIMITS
C         --------------------------------
C
          RJETHT=DRIFT/RWIRE
          RJETHT=RJETHT*(0.5*RJETHT-LRTREL*SINLOR)
          RJETHT=RWIRE*(1+RJETHT-.5*RJETHT**2)
          IF(RJETHT.LT.RMIN.OR.RJETHT.GT.RMAX)GOTO8750
C
C         -----------------------------
C         SET IERZRF = 16 IF THERE IS A
C         SECOND HIT WITHIN THE SOFTWARE
C         DOUBLE HIT RESOLUTION IXYF(18)
C         -----------------------------
C
          IERZRF=0
CC--CC    CLOSEST HIT WITH LOWER DRIFT TIME
CC--CC    IS2=NH1-4
CC--CC    IF(IS2.LT.NH0)GOTO8510
CC--CC    IS1=HDATA(IS2)
CC--CC    IS1=SHFTR(IS1,3)
CC--CC    IF(IS1.NE.INWIRE)GOTO8510
CC--CC    IS2=IDRIFT-HDATA(IS2+3)
CC--CC    IF(IABS(IS2).LE.IXYF(18))IERZRF=16
CC--CC    CLOSEST HIT WITH HIGHER DRIFT TIME
C8510     IS2=NH1+4
CC--CC    IF(IS2.GT.NH9)GOTO8520
CC--CC    IS1=HDATA(IS2)
CC--CC    IS1=SHFTR(IS1,3)
CC--CC    IF(IS1.NE.INWIRE)GOTO8520
CC--CC    IS2=IDRIFT-HDATA(IS2+3)
CC--CC    IF(IABS(IS2).LE.IXYF(18))IERZRF=16
C
C         ----------------------------------
C         COMPUTE Z-COORDINATE. IF EITHER Z-
C         AMPLITUDE IS <= 0 SET IERZRF = 16
C         ----------------------------------
C
 8520     IS1=HDATA(NH1+1)
          IS2=HDATA(NH1+2)
          IF(IS2.LE.0.OR.IS1.LE.0)GOTO8540
          ZJETHT=IS2+IS1
          ZJETHT=.5*ZAL*FLOAT(IS2-IS1)/ZJETHT
          GOTO8600
 8540     IERZRF=16
          ZJETHT=0
C
C         -----------------------------------
C         START SEARCH FOR INSERTION POINT AT
C         IPHT AND WORK DOWN (TO HIGHER R)
C         UNTIL A HIT OF GREATER R IS FOUND.
C         -----------------------------------
C
 8600     IF(IWRK(IPHST+1).EQ.NH1)GOTO8640
          IF(WRK(IPHST+6).GE.RJETHT)GOTO8610
          IPHST=IPHST-HLDHT
          IF(IPHST.GE.HPHT0)GOTO8600
C
C         -----------------------------------------
C         IPHST POINTS TO FIRST HIT WITH R > RJETHT
C         MAKE ROOM FOR NEW HIT IN HIT BANK
C         -----------------------------------------
C
 8610     LRTREL=1000*LRTREL
          IS1=4*(IPHST-HPHT0+HLDHT)
          HPHT0=HPHT0-HLDHT
          IF(IS1.NE.0)CALLMVCL(WRK(HPHT0),0,IWRK(HPHT0),LNBYTE,IS1)
          CALLMVCL(WRK(IPHST),0,ADWRK(1),0,LNBYTE)
C         IPHST NOW POINTS TO THE HIT JUST INSERTED
C
C         -----------------------------------
C         IF MEMORY OF CELL POINTERS IS STILL
C         REQUIRED THEY MUST NOW BE RESET TO
C         ALLOW FOR THE NEWLY INSERTED HIT
C         -----------------------------------
C
          IF(IRETRN.EQ.3)GOTO8700
          DO 8630 N=1,NCELLS
          IF(CELLPN(N,2).LE.IPHST)CELLPN(N,2)=CELLPN(N,2)-HLDHT
          IF(N.EQ.NC)GOTO8630
          IF(CELLPN(N,1).LE.IPHST)CELLPN(N,1)=CELLPN(N,1)-HLDHT
 8630     CONTINUE
          GOTO8700
 8640     IS1=IABS(IWRK(IPHST+8))
          IF(IS1.LT.1000)IS1=IS1+1000
          LRTREL=LRTREL*IS1
          CALLMVCL(WRK(IPHST),0,ADWRK(1),0,LNBYTE)
C
C         ---------------
C         GOOD HIT RETURN
C         ---------------
C
 8700     WIRSET=LOR(WIRSET,LAYBIT(LAYER))
C######################################################################
      LL = ISIGN(LAYERJ,LRTREL)
      IF (PRINT) PRINT8701,INCELL,LL,BETA,RJETHT,CHIXYF,IERXYF,IPHST
 8701 FORMAT(' CELL',I3,' LAYER',I3,' BETA',F5.2,' R=',F6.1,
     #' RES=',F7.2,I3,' ---ACCEPT---',I5)
C######################################################################
          IF(IERXYF.NE.0)GOTO8750
          IF(RJETHT.GT.REND.OR.RJETHT.LT.RSTR)GOTO8710
          LAYINT=LAYINT+1
          GOTO8720
 8710     LAYEXT=LAYEXT+1
 8720     GOTO(2020,2190,3450),IRETRN
C
C         ---------------
C         BAD  HIT RETURN
C         ---------------
C
 8750     CONTINUE
C######################################################################
      IF (IERXYF.LE.2) GOTO8755
      LL = ISIGN(LAYERJ,LRTREL)
      IF (PRINT) PRINT8751,INCELL,LL,BETA,RJETHT,CHIXYF,IERXYF
 8751 FORMAT(' CELL',I3,' LAYER',I3,' BETA',F5.2,' R=',F6.1,
     #' RES=',F7.2,I3,' ---REJECT---')
 8755  CONTINUE
C######################################################################
          GOTO(2020,2190,3470),IRETRN
C ----- ERROR 3 ILLEGAL RETURN VALUE
          CALLERRORM('PATROL  ',3,NTRAK)
          RETURN
      END
C   10/09/79 102191201  MEMBER NAME  PCCYCP   (PATRECSR)    FORTRAN
      SUBROUTINE PCCYCP
      IMPLICIT INTEGER*2(H)
C
C
C----------------------------------------------------------------------
C
C         --------------  SUBROUTINE PCCYCP  -----------------
C         --- G.F.PEARCE .. LAST UPDATE : 1200 ON 10/09/79 ---
C
C   SUBROUTINE TO DUMP THE PATTERN RECOGNITION COMMON /CCYCP/
C
C  CONTENTS OF /CCYCP/
C  -------------------
C
C  HPTSEC(I)   ..  POINTER TO FIRST I*2 WORD OF DATA FOR THE FIRST HIT
C              ..  OF CELL I IN THE /BCS/ COMMON.
C
C----------------------------------------------------------------------
C
C
#include "ccycp.for"
      PRINT11
 11   FORMAT(
     # 1X,47('-')/
     # ' DUMP OF PATTERN RECOGNITION POINTER ARRAY HPTSEC'/
     # 1X,47('-'))
      PRINT12,(HPTSEC(I),I=1,98)
 12   FORMAT( 4(1X,20I6/),1X,18I6 )
      RETURN
      END
C   20/09/79 102191201  MEMBER NAME  PCJDRC   (PATRECSR)    FORTRAN
      SUBROUTINE PCJDRC
#include "cjdrch.for"
C
C
C----------------------------------------------------------------------
C         --------------  SUBROUTINE PCJDRC  -----------------
C         --- G.F.PEARCE .. LAST UPDATE : 1800 ON 11/09/79 ---
C
C   SUBROUTINE TO DUMP ALL OF THE JET CHAMBER CONSTANTS COMMON /CJDRCH/
C
C  CONTENTS OF /CJDRCH/  ####### COMPILED BY G.F.PEARCE #######
C  ====================
C
C  RDEC  (I)   ..  MEAN RADII OF CHAMBER WALLS
C  PSIIN (I)   ..  ANGULAR INCREMENT OF FIRST WIRE LINE
C  RINCR (I)   ..  DISTANCE BETWEEN TWO POTENTIAL WIRES
C  FIRSTW(I)   ..  RADII OF FIRST MAIN POTENTIAL WIRES IN EACH RING
C  FSENSW(I)   ..  RADII OF FIRST SENSE WIRES IN EACH RING
C  RDEPTH      ..  DIFFERENCE OF TWO CHAMBER RADII
C  SWDEPL      ..  WIRE STAGGERING ( > 0 MEANS +VE PHI FOR ZEROTH WIRE)
C  YSUSPN      ..  MAXIMUM VERTICAL DISPLACEMENT OF WIRE DUE TO GRAVITY
C  TIMDEL(J,I) ..  SIZE OF JET CHAMBER TIMING BIN (IN MMS)
C                  I = 1,2,3 FOR RINGS 1,2,3 RESPECTIVELY
C                  J = 1,2 FOR LAYERS 0-7 AND 8-15 RESPECTIVELY
C  ZMAX        ..  SENSITIVE HALF LENGTH OF WIRES
C  ZOFFS       ..  OFFSET OF WIRES
C  ZRESOL      ..  RESOLUTION IN Z
C  ZNORM       ..  Z NORMALISATION
C  ZAL         ..  WIRE LENGTH
C  ZSCAL       ..
C  DRIDEV      ..  ANGLE OF DRIFT SPACE TO WIRE PLANE
C  DRICOS      ..  COSINE(DRIDEV)
C  DRISIN      ..  SINE(DRIDEV)
C  DRIROT(I,J) .. DRIDEV FOR EACH SIDE (J=1,2) OF EACH CELL (I)
C                 J = 1 GIVES LEFT SIDE.   J = 2 GIVES RIGHT SIDE
C  SINDRI(I,J) .. SINE(DRIROT)
C  COSDRI(I,J) .. COSINE(DRIROT)
C
C----------------------------------------------------------------------
C
C
      PRINT11
 11   FORMAT(
     # 1X,45('-')/
     # ' DUMP OF JET CHAMBER CONSTANTS COMMON /CJDRCH/'/
     # 1X,45('-'))
C
      PRINT12,(RDEC(I),I=1,4)
     #       ,(PSIIN(I),I=1,3)
     #       ,(RINCR(I),I=1,3)
     #       ,(FIRSTW(I),I=1,3)
     #       ,(FSENSW(I),I=1,3)
     #       , RDEPTH,SWDEPL,YSUSPN,ZMAX,ZOFFS,ZRESOL,ZNORM,ZAL,ZSCAL
     #       ,DRIDEV,DRISIN,DRICOS
 12   FORMAT(' RDEC   .. CHAMBER WALL RADII .................. ',4E11.4/
     #       ' PSIIN  .. ANGULAR INCREMENT OF FIRST WIRE ..... ',3E11.4/
     #       ' RINCR  .. POTENTIAL WIRE SEPERATION ........... ',3E11.4/
     #       ' FIRSTW .. RADII OF FIRST POTENTIAL WIRES ...... ',3E11.4/
     #       ' FSENSW .. RADII OF FIRST SENSE WIRES .......... ',3E11.4/
     #       ' RDEPTH .. DIFFERENCE OF TWO CHAMBER RADII ..... ', E11.4/
     #       ' SWDEPL .. WIRE STAGGERING ..................... ', E11.4/
     #       ' YSUSPN .. MAX. VERTICAL GRAVITY DISPLACEMENT .. ', E11.4/
     #       ' ZMAX   .. SENSITIVE HALF LENGTH OF WIRES ...... ', E11.4/
     #       ' ZOFFS  .. WIRE OFFSET ......................... ', E11.4/
     #       ' ZRESOL .. RESOLUTION IN Z ..................... ', E11.4/
     #       ' ZNORM  .. NORMALISATION IN Z .................. ', E11.4/
     #       ' ZAL    .. WIRE LENGTH ......................... ', E11.4/
     #       ' ZSCAL  ..                                       ', E11.4/
     #       ' DRIDEV .. FOLLOWED BY SINE AND COSINE ......... ',3E11.4)
C
      PRINT13,((TIMDEL(J,I),J=1,2),I=1,3)
 13   FORMAT(' TIMDEL .. SIZE OF TIMING BINS (MMS) ........... ',6E11.4)
      RETURN
      END
C   29/01/80 004241343  MEMBER NAME  PCWORK   (PATRECSR)    FORTRAN
      SUBROUTINE PCWORK(IF1,IF2,IF3,IF4,IF5)
      IMPLICIT INTEGER*2(H)
C
C
C----------------------------------------------------------------------
C         --------------  SUBROUTINE PCWORK  -----------------
C         --- G.F.PEARCE .. LAST UPDATE : 1400 ON 10/09/79 ---
C
C   SUBROUTINE TO DUMP ALL OR PARTS OF THE PATTERN RECOGNITION /CWORK/
C   THE LEVEL OF OUTPUT IS CONTROLLED BY THE FLAGS 'IF' VIZ.
C
C   IF1 = 1/0 => PRINT/NOPRINT OF TRACK ELEMENT HIT LABEL ARRAY
C   IF2 = 1/0 => PRINT/NOPRINT OF TRACK ELEMENTS
C   IF3 = 1/0 => PRINT/NOPRINT OF BACKTR RESULTS (CONNECTED TR.ELEMENTS)
C   IF4 = 1/0 => PRINT/NOPRINT OF TRACK COORDINATES (FXYZ/PATROL)
C   IF5 = 1/0 => PRINT/NOPRINT OF CWORK TRACK BANK (XYFIT/ZRFIT/CNTREL)
C----------------------------------------------------------------------
C
C
C=======================================================================
C
C  CONTENTS OF /CWORK/  ####### COMPILED BY G.F.PEARCE #######
C  ====================
C                        IN JET CHAMBER PATTERN RECOGNITION PROGRAMS
C
C       ----------------------
C   1). POINTERS AND WORKSPACE
C       ----------------------
C  HPLAST     = POINTER TO LAST AVAILABLE LOCATION IN ARRAY WRK
C  HPFREE     = POINTER TO FIRST CURRENTLY AVAILABLE LOCATION IN WRK
C  HPWRK      = RESERVED FOR POINTERS (SEE HPHT0 ETC.. BELOW)
C  HPHT0      = POINTER TO FIRST WORD OF HIT COORDINATE ARRAY
C  HPHT9      = POINTER TO LAST  WORD OF HIT COORDINATE ARRAY
C  HLDHT      = NUMBER OF 4 BYTE WORDS STORED PER HIT IN COORD. ARRAY
C  HPHT0A     = POINTER TO FIRST WORD OF SECOND ARRAY OF HIT COORDINATES
C               THIS ARRAY IS USED IN CASES WHERE THE BACKTRACE ROUTINE
C               COULD NOT UNAMBIGUOUSLY RESOLVE THE L/R AMBIGUITY. IN
C               SUCH A CASE THE HIT COORDINATES ARE COMPUTED FOR BOTH
C               L/R SOLUTIONS AND THE SECOND SOLUTION STORED HERE.
C               WHEN THE L/R AMBIGUITY IS RESOLVED THIS POINTER IS -VE.
C               AND THE SECOND SET OF COORDINATES DO NOT EXIST.
C  HPHT9A     = POINTER TO LAST WORD OF SECOND HIT COORDINATE ARRAY
C  HLDHTA     = NUMBER OF 4 BYTE WORDS STORED PER HIT ISECOND ARRAY
C  HPHTLM     = LIMIT ON HPHT0 FOR ADDING NEW HITS
C  HPTR0      = POINTER TO FIRST WORD OF TRACK BANK
C  HPTR9      = POINTER TO LAST  WORD OF TRACK BANK
C  HLDTR      = NUMBER OF 4 BYTE WORDS STORED PER FIT IN TRACK BANK
C  HPHL0      = POINTER TO FIRST WORD OF HIT LABEL ARRAY
C  HPHL9      = POINTER TO LAST WORD OF HIT LABEL ARRAY
C  HLDHL      = NUMBER OF WORDS STORED FOR EACH HIT IN HIT LABEL
C
C  ADWRK    ..   WORK ARRAY 600 WORDS LONG.
C
C       -----------------------------------
C   2). OUTPUT FROM TRACK ELEMENT ROUTINES.
C       -----------------------------------
C
C  HPRO       = ?
C
C  HNTR       = TOTAL NUMBER OF TRACK ELEMENTS IN ALL RINGS
C
C  HNTCEL(I)  = ELEMENT NUMBER OF FIRST TRACK ELEMENT IN CELL I
C                (IF (I).EQ.(I+1) THERE IS NO ELEMENT IN CELL I)
C
C  ITRKAR(I,J) = INFORMATION FOR I'TH TRACK ELEMENT. J AS FOLLOWS
C   J   NAME               CONTENTS
C  --- ------             ----------
C   1  IPCL  = CELL NUMBER CONTAINING TRACK ELEMENT I
C   2  NRHT  = NUMBER OF HITS ON TRACK ELEMENT
C   3  NWR1  = WIRE NUMBER OF FIRST HIT ON TRACK ELEMENT (0->15)
C   4  DS1   = DRIFT DISTANCE OF FIRST HIT ON TRACK ELEMENT (MM)
C   5  SL1   = DRIFT SLOPE FOR 1ST HIT ON TRACK ELEMENT(MM/WIRE SPACING)
C              ( (DS(2)-DS(0))/2 WHERE DS(0)=DRIFT DISTANCE FOR WIRE 0)
C   6  NWR2  = WIRE NUMBER OF LAST HIT ON TRACK ELEMENT (0->15)
C   7  DS2   = DRIFT DISTANCE OF LAST HIT ON TRACK ELEMENT (MM)
C   8  SL2   = DRIFT SLOPE FOR LAST HIT ON TRACK ELEMENT ( SEE SL1 )
C   9  LBL   = TRACK ELEMENT BIT CODED HISTORY WORD
C              BIT 13 ON  =>  L/R AMBIGUITY UNSOLVED
C  10  NTREL = TRACK ELEMENT NUMBER WRITTEN INTO THE HIT LABEL OF
C              EACH HIT ON THIS TRACK ELEMENT.
C  11  ICRO  =  WIRE NUMBER OF FIRST WIRE STRUCK AFTER TRACK ELEMENT
C               CROSSED WIRE BOUNDARY. IF ZERO NO CROSSING HAS OCCURED.
C
C
C       -------------------------------
C   3). OUTPUT FROM BACKTRACING ROUTINE
C       -------------------------------
C
C   NTR        = TOTAL NUMBER OF TRACKS FOUND BY BACKTRACE PROGRAM.
C   HNREL(I)   = NUMBER OF TRACK ELEMENTS ASSOCIATED WITH TRACK I
C   HISTR(I,J) = TRACK ELEMENT NUMBER FOR EACH TRACK ELEMENT (J)
C                 ASSIGNED TO TRACK NUMBER I.
C   HRES(I)    = RESERVED FOR GRAPHICS
C
C
C       ----------------------------------
C   4). OUTPUT FROM HIT COORDINATE ROUTINE (FXYZ+PATROL)
C       ----------------------------------
C
C     RELEVANT POINTERS ARE HPHT0,HPHT9,HLDHT (SEE 'POINTERS' ABOVE)
C
C     LOCATION     ALIAS               CONTENTS
C     --------     -----               --------
C     WRK      ..   HIT AND FIT INFORMATION .. SEE BELOW
C
C     FOR EACH HIT THE FOLLOWING INFORMATION IS STORED IN WRK/IWRK
C     ( HIT 1 BEING USED AS AN EXAMPLE )
C
C     IWRK(HPHT0+ 0) = LAYER NUMBER (0-15)
C     IWRK(HPHT0+ 1) = POINTER TO FIRST DATA WORD (IN BCS)
C     IWRK(HPHT0+ 2) = POINTER TO TRACK ELEMENT HIT LABEL WORD IN CWORK
C     WRK (HPHT0+ 3) = X COORDINATE (MMS)
C     WRK (HPHT0+ 4) = Y COORDINATE (MMS)
C     WRK (HPHT0+ 5) = Z COORDINATE (MMS)
C     WRK (HPHT0+ 6) = R COORDINATE (MMS)
C     WRK (HPHT0+ 7) = Z-COORDINATE ERROR FLAG. 0 => GOOD HIT IN R-Z FIT
C                                               2 => BAD  HIT IN R-Z FIT
C                                              10 => BAD L/R AMPLITUDES
C     IWRK(HPHT0+ 8) = TRACK ELEMENT NUMBER ON WHICH HIT WAS FOUND
C                      CARRIES SIGN OF L/R AMBIGUITY(-VE=LEFT,+VE=RIGHT)
C                      IF THIS IS +/- 1000, THEN HIT WAS FOUND BY PATROL
C     IWRK(HPHT0+ 9) = CELL NUMBER
C     IWRK(HPHT0+10) = X-Y FIT ERROR FLAG. 0 => GOOD HIT USED IN XYFIT
C                                          1 => BAD  HIT USED IN XYFIT
C                                        > 1 => BAD  HIT NOT USED IN FIT
C     WRK (HPHT0+11) = 1/COSINE OF ANGLE OF TRACK TO THE NORMAL TO THE
C                      DRIFT SPACE USED FOR ABERATION CORRECTION.
C     IWRK(HPHT0+12) = RING NUMBER
C     WRK (HPHT0+13) = RESIDUAL (FITTED-MEASURED) OF HIT FROM X-Y FIT.
C
C
C
C       ---------------------------
C   4). OUTPUT FROM FITTING PROGRAM (XYFIT)..  I.E. TRACK BANK
C       ---------------------------
C
C     RELEVANT POINTERS ARE HPTR0,HPTR9,HLDTR .. SEE 'POINTERS' ABOVE.
C
C     IWRK(HPTR0+ 0) = TRACK NUMBER
C     IWRK(HPTR0+ 1) = IDENTIFIER OF PROGRAM
C     IWRK(HPTR0+ 2) = DATE OF PRODUCTION
C     IWRK(HPTR0+ 3) = TYPE OF POINT (FOR FIRST MEASURED POINT)
C     IWRK(HPTR0+ 4) = X COORDINATE  (FOR FIRST MEASURED POINT)
C     IWRK(HPTR0+ 5) = Y COORDINATE  (FOR FIRST MEASURED POINT)
C     WRK (HPTR0+ 6) = Z COORDINATE  (FOR FIRST MEASURED POINT)
C     WRK (HPTR0+ 7) = DX            (FOR FIRST MEASURED POINT)
C     WRK (HPTR0+ 8) = DY            (FOR FIRST MEASURED POINT)
C     WRK (HPTR0+ 9) = DZ            (FOR FIRST MEASURED POINT)
C     WRK (HPTR0+10) = TYPE OF POINT (FOR LAST  MEASURED POINT)
C     WRK (HPTR0+11) = X COORDINATE  (FOR LAST  MEASURED POINT)
C     WRK (HPTR0+12) = Y COORDINATE  (FOR LAST  MEASURED POINT)
C     WRK (HPTR0+13) = Z COORDINATE  (FOR LAST  MEASURED POINT)
C     WRK (HPTR0+14) = DX            (FOR LAST  MEASURED POINT)
C     WRK (HPTR0+15) = DY            (FOR LAST  MEASURED POINT)
C     WRK (HPTR0+16) = DZ            (FOR LAST  MEASURED POINT)
C     IWRK(HPTR0+17) = TYPE OF FITTING PROGRAM USED IN X-Y PLANE
C                    = 1 FOR CIRCLE FIT
C                    = 2 FOR PARABOLA FIT
C     IWRK(HPTR0+18) = FIRST FIT PARAMETER  FROM XYFIT
C     IWRK(HPTR0+19) = SECOND FIT PARAMETER FROM XYFIT
C     IWRK(HPTR0+20) = THIRD FIT PARAMETER  FROM XYFIT
C     IWRK(HPTR0+21) = FOURTH FIT PARAMETER FROM XYFIT
C     IWRK(HPTR0+22) = RMS PER D.F. FROM XYFIT
C     WRK (HPTR0+23) = NUMBER OF POINTS USED IN XYFIT
C     WRK (HPTR0+24) = TRACK CURVATURE
C     WRK (HPTR0+25) = DELTA CURVATURE
C     WRK (HPTR0+26) = TRACK CURVATURE AT FIRST MEASURED POINT
C     WRK (HPTR0+27) = TRACK CURVATURE AT LAST  MEASURED POINT
C     IWRK(HPTR0+28) = TYPE OF FITTING PROGRAM USED IN Z-R PLANE
C     WRK (HPTR0+29) = FIRST FIT PARAMETER FROM ZRFIT  (SLOPE)
C     WRK (HPTR0+30) = SECOND FIT PARAMETER FROM ZRFIT(INTERCEPT)
C     WRK (HPTR0+31) = RMS PER D.F. FROM ZRFIT
C     IWRK(HPTR0+32) = NUMBER OF POINTS USED IN ZRFIT
C     IWRK(HPTR0+33) = CELL NUMBERS THAT CONTAIN HITS ON THE TRACK
C     IWRK(HPTR0+34) =   "     "      "     "      "   "  "    "
C     IWRK(HPTR0+35) =   "     "      "     "      "   "  "    "
C     IWRK(HPTR0+36) =   "     "      "     "      "   "  "    "
C     IWRK(HPTR0+37) =   "     "      "     "      "   "  "    "
C     IWRK(HPTR0+38) =   "     "      "     "      "   "  "    "
C     IWRK(HPTR0+39) = POINTER TO CORRESPONDING LEAD GLASS CLUSTER
C     IWRK(HPTR0+40) = POINTER TO CORRESPONDING MUON CHAMBER HITS
C     IWRK(HPTR0+41) = POINTER TO CORRESPONDING TRACK BANK IN TP BANK
C     IWRK(HPTR0+42) = POINTER TO CORRESPONDING TOF BANK
C     IWRK(HPTR0+43) = FREE
C     IWRK(HPTR0+44) = FREE
C     IWRK(HPTR0+45) = FREE
C     IWRK(HPTR0+46) = FREE
C     IWRK(HPTR0+47) = BIT CODED ERROR CODE (ALL BITS OFF => ALL OK)
C                      BIT 31 => BAD FIT IN X-Y PLANE
C                      BIT 30 => L/R AMBIGUITY OF TRACK UNCERTAIN
C                      BIT 29 => XYFIT TRIED REJECTING THE TRACK ELEMENT
C                               WITH THE WORST CHI**2 TO RECOVER FROM A
C                               BAD INITIAL FIT.
C                      BIT 28 => XYFIT TRIED RESTARTING BY FITTING ONLY
C                               THE LONGEST TRACK ELEMENT IN ORDER TO
C                               RECOVER FROM A BAD INITIAL FIT AFTER
C                               THE BIT 29 PROCEDURE ABOVE FAILED.
C                      BIT 27 => PATROL ADDED > IXYF( ) (SEE CPATLM) NEW
C                                HITS TO THE TRACK WHICH ALSO BELONG TO
C                                ANOTHER TRACK IN THIS EVENT
C                      BIT 26 => PATROL CALLED FOR A RE-FIT TO THE TRACK
C                                AFTER FINDING SOME NEW HITS AND THIS
C                                FAILED (BAD CHI**2). THE FIT IN THE
C                                TRACK BANK WILL CORRESPOND TO THE LAST
C                                GOOD FIT OF THIS TRACK.
C                      BIT 25 => VERY LOW MOMENTUM TRACK
C                      BIT 24 => BAD FIT IN Z-R PLANE
C                      BIT 23 => > N POINTS REJECTED BY ZRFIT.
C                      BIT 22 => TRACK NOT CONNECTED INTO RING 1 BY
C                                BACKTRACE PROGRAM (ALTHOUGH IF SUCH
C                                HITS EXIST THEY WILL HAVE BEEN FOUND
C                                AT A LATER STAGE BY THE PATROL PROGRAM
C                                AND INCLUDED ON THE TRACK).
C                      BIT 21 => TRACK NOT CONNECTED INTO RING 2 BY
C                                BACKTRACE PROGRAM ALTHOUGH BOTH RINGS
C                                1 AND 3 WERE PRESENT.  (AGAIN IF SUCH
C                                HITS EXIST THEY WILL HAVE BEEN FOUND
C                                AT A LATER STAGE BY THE PATROL PROGRAM
C                                AND INCLUDED ON THE TRACK).
C
C=======================================================================
#include "cworkpr.for"
#include "cworkeq.for"
#include "cdata.for"
C
C
C----------------------------------------------------------------------
C                      DUMP OF CWORK HIT LABEL ARRAY
C----------------------------------------------------------------------
C
      IF (IF1.EQ.0) GOTO20
C=====
      PRINT11,HPHL0,HPHL9,HLDHL
 11   FORMAT(
     # 1X,46('-')/
     # ' DUMP OF TREL HIT LABEL ARRAY FROM PATREC CWORK',
     # ' .. HPHL0  =',I5,' HPHL9  =',I5,' HLDHL  =',I5/
     # 1X,46('-'))
      I1 = HPHL0
      I2 = HPHL9
      PRINT12,(HWRK(I),I=I1,I2)
 12   FORMAT(   13(    ' ',Z4,',',Z4,     ) )
C
C----------------------------------------------------------------------
C              DUMP OF RESULTS OF TRACK ELEMENT ROUTINE
C----------------------------------------------------------------------
C
 20   IF (IF2.EQ.0) GOTO30
C=====
      PRINT21
 21   FORMAT(
     # 1X,40('-')/
     # ' DUMP OF TRACK ELEMENTS FROM PATREC CWORK'/
     # 1X,40('-'))
C=====
      PRINT22,HPRO,HNTR,(HNTCEL(I),I=1,98)
 22   FORMAT(
     #' HPRO =',I10,5X,'HNTR = TOTAL NO OF TRACK ELEMENTS =',I6/
     #' HNTCEL =',31I4/9X,31I4/9X,31I4/9X,4I4)
C=====
      PRINT23
 23   FORMAT(
     #' TREL IPCL NRHT',
     #'  NWR1    DS1    SL1 ',
     #'  NWR2    DS2    SL2 ',
     #'   LABEL   NTREL ICRO')
      IMAX = HNTR
C=====
      PRINT24,(I,IPCL(I),NRHT(I),NWR1(I),DS1(I),SL1(I),NWR2(I),
     #DS2(I),SL2(I),LBL(I),NTREL(I),ICRO(I),I=1,IMAX)
 24   FORMAT(1X,I3,1X, I4,1X, I4,1X, I5,1X, F7.1, F7.1, I6,1X,
     # F7.1 , F7.1 , 3X,Z8, I5,1X, I3)
C=====
      PRINT29
 29   FORMAT(1X,20('-'),' END OF TRACK ELEMENT DUMP ',20('-'))
C
C----------------------------------------------------------------------
C               DUMP OF RESULTS OF BACKTRACE PROGRAM
C----------------------------------------------------------------------
C
 30   IF (IF3.EQ.0) GOTO40
C=====
      PRINT31
 31   FORMAT(
     # 1X,42('-')/
     # ' DUMP OF BACKTRACE RESULT FROM PATREC CWORK'/
     # 1X,42('-'))
C=====
      PRINT32,NTR
 32   FORMAT(' NTR = NUMBER OF TRACKS =',I4)
C=====
      DO 34 I=1,NTR
      JJ=HNREL(I)
      PRINT33,I,JJ,(HISTR(J,I),J=1,JJ)
 33   FORMAT(' TRACK',I3,I6,' TRACK ELEMENTS =',9I4)
 34   CONTINUE
      PRINT39
 39   FORMAT(1X,20('-'),' END OF BACKTRACE DUMP ',20('-'))
C
C----------------------------------------------------------------------
C              DUMP OF HIT COORDINATE ARRAY (FXYZ)
C----------------------------------------------------------------------
C
 40   IF (IF4.EQ.0) GOTO50
C=====
      NHIT = 0
      IF (HLDHT.GT.0) NHIT = (HPHT9-HPHT0+1)/HLDHT
C=====
      PRINT41,HPHT0,HPHT9,HLDHT,HPHL0,HPHL9,HLDHL
     #       ,HPHT0A,HPHT9A,HLDHTA
     #       ,HPHTLM,NHIT
 41   FORMAT(
     # 1X,30('-'), ' .. HPHT0  =',I5,' HPHT9  =',I5,' HLDHT  =',I3,
     #             ' .. HPHL0  =',I5,' HPHL9  =',I5,' HLDHL  =',I5/
     #  ' FXYZ HIT ARRAY IN PATREC CWORK',
     #  ' .. HPHT0A =',I5,' HPHT9A =',I5,' HLDHTA =',I3/
     # 1X,30('-'), ' .. HPHTLM =',I4,' TOTAL NUMBER OF HITS =',I4)
C=====
      IF (HPHT0.LE.0) GOTO45
      IF (HLDHT.LE.0) GOTO45
      IF (HPHT9.LE.HPHT0) GOTO45
      IF (HPHT9.GT.10000) GOTO45
C=====
      PRINT42
 42   FORMAT(' LOCN'
     #,   ' RING CELL LAYER  TREL'
     #,   '  DATA  DRIFT   IAMPL  IAMPR'
     #,   ' HPHL'
     #,   '   BETA'
     #,   '     X        Y        Z        R   '
     #,   '  XY-CHI'
     #,   '  XYF ZRF')
C=====
      I1 = HPHT0
      I2 = HPHT9
      I3 = HLDHT
      DO 43 I=I1,I2,I3
      JJ  = IWRK(I+1)
      IAL = HDATA(JJ+1)
      IAR = HDATA(JJ+2)
      IDS = HDATA(JJ+3)
      PRINT44,I,
     # IWRK(I+12),IWRK(I+9),IWRK(I),IWRK(I+8),
     # IWRK(I+1),IDS,IAL,IAR,
     # IWRK(I+2),WRK(I+11),WRK(I+3),WRK(I+4),
     # WRK(I+5),WRK(I+6),WRK(I+13),IWRK(I+10),
     # IWRK(I+7)
 43   CONTINUE
 44   FORMAT(I5
     #,      I4 , I5 , I5 , I7
     #,      I7,I7,I7,I7
     #,      I6
     #,      F7.3
     #,      4(1X,F8.2)
     #,      F8.3
     #,      2I4)
      GOTO48
C=====
 45   PRINT46
 46   FORMAT(' ------ POINTER ERROR ------')
C=====
 48   CONTINUE
      PRINT49
 49   FORMAT(1X,20('-'),' END OF HIT COORDINATE DUMP ',20('-'))
C
C----------------------------------------------------------------------
C                    DUMP OF TRACK BANK FROM CWORK
C----------------------------------------------------------------------
C
 50   IF (IF5.EQ.0) GOTO60
C=====
      I = HPTR0
      PRINT51,IWRK(I),IWRK(I+1),IWRK(I+2) , HPTR0,HPTR9,HLDTR
 51   FORMAT(
     # 1X,35('-')/
     #  ' DUMP OF TRACK BANK FROM PATREC CWORK',
     #  ' .. TRACK',I3,' PROGRAM =',I3,' DATE =',I9/
     # 1X,35('-'),
     # 2X,'HPTR0 =',I5,2X,'HPTR9 =',I5,2X,'HLDTR =',I4)
C=====
      PRINT52
C      START POINT TYPE,X,Y,Z,DX,DY,DZ
     #,IWRK(I+3),WRK(I+4),WRK(I+5),WRK(I+6),WRK(I+7),WRK(I+8),WRK(I+9)
C      END   POINT TYPE,X,Y,Z,DX,DY,DZ
     #,IWRK(I+10),WRK(I+11),WRK(I+12),WRK(I+13),WRK(I+14),WRK(I+15)
     #           ,WRK(I+16)
C      FIT TYPE, FIT PARAMETERS, RMS AND NO. POINTS USED FOR X-Y PLANE
     #,IWRK(I+17),WRK(I+18),WRK(I+19),WRK(I+20),WRK(I+21),WRK(I+22)
     #,IWRK(I+23)
C      TRACK CURVATURES FROM X-Y FIT
     #,WRK(I+24),WRK(I+25),WRK(I+26),WRK(I+27)
C
 52   FORMAT(
     #' FIRST POINT ON TRACK ... TYPE =',I3,
     #' (X,Y,Z) = (',3E11.4,')',' (DX,DY,DZ) = (',3E11.4,')'/
C    #
     #' LAST  POINT ON TRACK ... TYPE =',I3,
     #' (X,Y,Z) = (',3E11.4,')',' (DX,DY,DZ) = (',3E11.4,')'/
C    #
     #' XYFIT .. PROGRAM TYPE =',I3,' FITTED PARAMETERS = (',4E11.4,')',
     #' RMS =',E11.4,' POINTS USED =',I4/
C    #
     # 28X,'CURVATURE =(',E11.4,' +-',E11.4,')',
     #'   CURVATURE AT START AND END POINTS = (',E11.4,',',E11.4,')')
C=====
      PRINT53,IWRK(I+28),WRK(I+29),WRK(I+30),WRK(I+31),IWRK(I+32)
 53   FORMAT(
     #' ZRFIT .. PROGRAM TYPE =',I3,' FITTED PARAMETERS = (',2E12.4,')',
     #' RMS =',E11.4,' POINTS USED =',I4)
C=====
      PRINT54,IWRK(I+33),IWRK(I+34),IWRK(I+35),IWRK(I+36),IWRK(I+37),
     #        IWRK(I+38)
 54   FORMAT(' CELLS CONTAINING HITS ON THE TRACK ARE',6I4)
C=====
      PRINT55,IWRK(I+39),IWRK(I+40),IWRK(I+41),IWRK(I+42)
 55   FORMAT(' POINTERS TO THE CONNECTED :',
     #'  1) LEAD GLASS CLUSTER =',I5,
     #'  2) MUON HITS =',I5,
     #'  3) TP TRACK BANK =',I5,
     #'  4) TOF BANK =',I5)
C=====
      PRINT58,IWRK(I+47)
 58   FORMAT(' TRACK ERROR CODE BIT STRUCTURE =',Z4)
C=====
      PRINT59
 59   FORMAT(1X,20('-'),' END OF TRACK BANK DUMP ',20('-'))
 60   CONTINUE
      RETURN
      END
C   17/02/81            MEMBER NAME  PRCYCP   (PATRECSR)    FORTRAN
      SUBROUTINE PRCYCP
C
C     SETUP POINTER ARRAY FOR ALL CELLS: P.STEFFEN(78/11/15)
C
      IMPLICIT INTEGER*2 (H)
      COMMON /CDATA/ NWORD,HJCA(120),IPJCA4
      COMMON /CCYCP/ HPTSEC(98)
      COMMON /CLBPGM/ LBPGM(30)
C
C     SET PROGRAM LABEL
      LBPGM(1) = LBPGM(1) + 1
C     ADDRESS OF POINTERS TO CELLS (-1)
      IPJCA2 = IPJCA4 * 2
C
C     COPY CELL POINTERS + CALC. LENGTH
      IP0 = IPJCA2 + 98
      DO 100 ISEG=1,96
        ISEGO = ISEG + IPJCA2
        HPTSEC(ISEG) = HJCA(ISEGO) + IP0
 100  CONTINUE
      HPTSEC(97) = HJCA(ISEGO+1) + IP0
      HPTSEC(98) = 0
      RETURN
      END
C   20/09/79 102161800  MEMBER NAME  PRPATR   (PATRECSR)    FORTRAN
      SUBROUTINE PRPATR
C
C   ****************************
C   *    PRINT BANK 'PATR'     *
C   ****************************
C
      IMPLICIT INTEGER*2 (H)
C
#include "cdata.for"
C
C                              STOP EVENT ANALYSIS AFTER PATREC
C
C     PRINT OUT OF TRACK BANKS
      IP = IDATA(IBLN('PATR'))
   51 IF(IP.LE.0) GOTO 52
        PRINT 2101,IDATA(IP-3),IDATA(IP-2),IDATA(IP-1),IDATA(IP),
     ,             IDATA(IP+1),IDATA(IP+2),IDATA(IP+3),IP
 2101   FORMAT(1H0,A4,8I12)
        IP0 = IP-3
        IP9 = IP+IDATA(IP+1)
        PRINT 2201,(IDATA(I1),I1=IP0,IP9)
 2201   FORMAT(1H0,A4,20I6)
        NTR = IDATA(IP+2)
        LDTR = IDATA(IP+3)
        IF(NTR.LE.0) GOTO 59
          JP0 = IP+IDATA(IP+1) + 1
          JP9 = JP0 + LDTR*NTR - 1
          DO 56 JP1 = JP0,JP9,LDTR
            I0 = JP1
            I9 = I0 + LDTR - 1
            PRINT 2202,(IDATA(I1),I1=I0,I9)
 2202 FORMAT(1H0,2I3,I8,2(I4,3F6.1,3F6.3),
     ,     /,14X,I3,4E13.5,F6.2,I3,4E13.5,
     ,     /,14X,I3,2F8.3,F6.1,I3,10X,6I3,8I6,2X,Z4)
  56      CONTINUE
  59    CONTINUE
        IP = IDATA(IP-1)
      GOTO 51
  52  CONTINUE
C
      RETURN
C
      END
C   25/03/81            MEMBER NAME  PRTRAK   (PATRECSR)    FORTRAN
      SUBROUTINE PRTRAK(IPPATR,NTRAK)
      IMPLICIT INTEGER*2(H)
C----------------------------------------------------------------------
C         --------------- SUBROUTINE PRTRAK ------------------
C         ---- G.F.PEARCE .. LAST UPDATE : 1400 ON 24/03/81 ----
C
C     PROGRAM TO PRINT OUT THE CONTENTS OF THE 'PATR' BANK FOR A GIVEN
C     TRACK.
C
C     IPPATR = BOS POINTER TO 'PATR' BANK  ( = IDATA(IBLN('PATR')) )
C     NTRAK  = REQUIRED TRACK NUMBER
C
C     PRINTOUT IS DIRECTED TO LINE PRINTER UNIT
C
C----------------------------------------------------------------------
#include "cdata.for"
      REAL*8 TYPE(2)/'REALDATA',' MCARLO '/
      INTEGER*2 HDENT(2)
      EQUIVALENCE (IDENTY,HDENT(1))
C------------------------
C CHECK FOR FALSE POINTER
C------------------------
      IF(IPPATR.GE.1)GOTO20
      PRINT10,IPPATR
 10   FORMAT(' ******* PRTRAK ERROR .. POINTER ERROR, IPPATR=',I6)
      RETURN
C------------
C PRINT TITLE
C------------
 20   NBANK=IDATA(IPPATR-2)
      NTRTOT=IDATA(IPPATR+2)
      LTR=IDATA(IPPATR+3)
      ITYPE=1
      IF(NBANK.EQ.12)ITYPE=2
      PRINT30,IDATA(IPPATR-3),NBANK,NTRAK,NTRTOT,TYPE(ITYPE)
 30   FORMAT(/1X,50('-')/
     - ' PRINTOUT OF BANK ',A4,' BANK NUMBER',I3,' FOR TRACK',I4,
     - ' .. TOTAL NUMBER OF TRACKS =',I4,3X,' ***** ',A8,' *****'/
     - 1X,50('-'))
C---------------
C TRACK EXISTS ?
C---------------
      IF(NTRAK.LE.NTRTOT.AND.NTRAK.GE.1)GOTO50
      PRINT40
 40   FORMAT(' ******* PRTRAK ERROR .. NON-EXISTENT TRACK')
      RETURN
C-------------
C TRACK HEADER
C-------------
 50   IP=IPPATR+IDATA(IPPATR+1)
      IP=IP+LTR*(NTRAK-1)
      IDENTY=IDATA(IP+2)
      IDATE=IDATA(IP+3)
      IF(NBANK.EQ.12)GOTO70
      PRINT60,IDATA(IP+1),IDATE,HDENT(2)
 60   FORMAT(/' TRACK',I3,'  DATE OF PATTERN RECOGNITION =',I6,
     -        '    PROGRAM IDENTIFIER =',Z2)
      GOTO90
 70   PRINT80,IDATA(IP+1),HDENT(1),HDENT(2),IDATE
 80   FORMAT(/' TRACK',I3,' NUMBER OF 4-VECTORS =',I4,
     - ' PARTICLE TYPE =',I3,' DATE OF PATTERN RECOGNITION =',I6)
C---------------------
C START AND END POINTS
C---------------------
 90   PRINT100,IDATA(IP+4),ADATA(IP+5),ADATA(IP+6),ADATA(IP+7)
     -                    ,ADATA(IP+8),ADATA(IP+8),ADATA(IP+10)
 100  FORMAT(/' START POINT .. TYPE =',I3,4X,
     -      ' POSITION  X = ',E11.4,'   Y = ',E11.4,'   Z = ',E11.4/24X,
     - '      DIRN COS DX = ',E11.4,'  DY = ',E11.4,'  DZ = ',E11.4)
      PRINT110,IDATA(IP+11),ADATA(IP+12),ADATA(IP+13),ADATA(IP+14)
     -                     ,ADATA(IP+15),ADATA(IP+16),ADATA(IP+17)
 110  FORMAT(/' END   POINT .. TYPE =',I3,4X,
     -      ' POSITION  X = ',E11.4,'   Y = ',E11.4,'   Z = ',E11.4/24X,
     - '      DIRN COS DX = ',E11.4,'  DY = ',E11.4,'  DZ = ',E11.4)
C-------------------
C X-Y FIT PARAMETERS
C-------------------
      PRINT120,IDATA(IP+18),ADATA(IP+19),ADATA(IP+20),ADATA(IP+21),
     -         ADATA(IP+22),ADATA(IP+23),IDATA(IP+24),
     -         ADATA(IP+25),ADATA(IP+26),ADATA(IP+27),ADATA(IP+28)
 120  FORMAT(/' X-Y FIT     .. TYPE =',I2,' FIT PARAMETERS = 1)',E11.4,
     - ' 2)',E11.4,' 3)',E11.4,' 4)',E11.4/
     - 16X,'RMS = ',E11.4,' NUMBER OF HITS USED IN FIT =',I4/
     - 16X,'TRACK CURVATURE = ',E11.4,' ERROR = ',E11.4,
     - ' START CURVATURE = ',E11.4,'  END CURVATURE = ',E11.4)
C-------------------
C Z-R FIT PARAMETERS
C-------------------
      PRINT140,IDATA(IP+29),ADATA(IP+30),ADATA(IP+31),ADATA(IP+32),
     -         IDATA(IP+33)
 140  FORMAT(/' Z-R FIT     .. TYPE =',I2,
     - '    FIT PARAMETERS = 1) ',E11.4, ' 2) ',E11.4,
     - '    RMS = ',E11.4,' NUMBER OF HITS USED =',I4)
C----------------------
C CELLS STRUCK BY TRACK
C----------------------
      PRINT150,IDATA(IP+34),IDATA(IP+35),IDATA(IP+36),IDATA(IP+37),
     -         IDATA(IP+38),IDATA(IP+39)
 150  FORMAT(/' CELLS HIT   ..  ',6I4)
C--------------------------------
C CONNECTIONS WITH OTHER ANALYSES
C--------------------------------
      PRINT160,IDATA(IP+40),IDATA(IP+41),IDATA(IP+42),IDATA(IP+43)
 160  FORMAT(/' POINTERS    ..  1) LEAD GLASS CLUSTER =',I6,
     -       '    2) MUON HITS =',I6,
     -       '    3) TP TRACK BANK =',I6,
     -       '    4) TOF BANK =',I6)
C-----------------------
C ADDITIONAL INFORMATION
C-----------------------
      PRINT170,IDATA(IP+44),ADATA(IP+45),ADATA(IP+46),IDATA(IP+47)
 170  FORMAT(/' ADDITIONAL INFORMATION FLAG =',I3,2X,
     -       ' FIRST VALID Z-COORDINATE =',E11.4,3X,
     -       ' LAST VALID Z-COORDINATE =',E11.4//
     -       ' NUMBER OF HITS ATTACHED TO TRACK =',I5)
C--------------
C TRACK HISTORY
C--------------
      IDENTY=IDATA(IP+48)
      PRINT180,IDENTY
 180  FORMAT(/' TRACK HISTORY WORD = ',Z4)
C---------
C TP FIT ?
C---------
      IF(LTR.GT.48)GOTO200
      PRINT190,LTR
 190  FORMAT(' ** THIS BANK CONTAINS A PATREC FIT AND NOT A TP FIT **')
      RETURN
C-------------
C R-PHI ERRORS
C-------------
 200  PRINT210,ADATA(IP+49),ADATA(IP+50),ADATA(IP+51),ADATA(IP+52),
     -         ADATA(IP+53),ADATA(IP+54),ADATA(IP+55)
 210  FORMAT(/' ERRORS FROM ..  R-PHI CHI**2 = ',E11.4,
     -                       '  COV(PHI**2) = ',E11.4,
     -                       '  COV(PHI*RMIN) = ',E11.4,
     -                       '  COV(RMIN**2)    = ',E11.4/
     -        '   TP FIT    ..',30X,'COV(PHI*K)  = ',E11.4,
     -                       '  COV(RMIN*K)   = ',E11.4,
     -                       '  COV(K**2)       = ',E11.4)
C-----------
C Z-R ERRORS
C-----------
      PRINT220,ADATA(IP+56),ADATA(IP+57),ADATA(IP+58),ADATA(IP+59)
 220  FORMAT( '             ..  Z-R CHI**2   = ',E11.4,
     -                       '  COV(Z0**2)  = ',E11.4,
     -                       '  COV(Z0*DZ/DR) = ',E11.4,
     -                       '  COV((DZ/DR)**2) = ',E11.4)
C---------------------
C DATE OF TP TRACK FIT
C---------------------
      PRINT230,IDATA(IP+60)
 230  FORMAT(/' TP FIT DATE ..  ',I5)
C------------
C END OF DUMP
C------------
 300  PRINT310
 310  FORMAT(/1X,16('-'),' END OF PATR DUMP ',16('-'))
      RETURN
      END
*   24/10/80 102191205  MEMBER NAME  SPREAD   (PATRECSR)    ASSEMBLER
*
*
*     SUBROUTINE SPREAD(A,B,C)
*
*     INSTALLED BY G.F.PEARCE
*
*     FORTRAN CALLABLE ROUTINE TO UNPACK A BIT PATTERN
*
*    A = I*2 BIT PATTERN
*    B = 16 DIMENSIONED I*4 ARRAY RETURNED WITH SET BIT NUMBERS
*        (I.E. B(1)=NUMBER OF 1ST BIT SET ETC.....)
*         BEWARE OF NOTATION .. BIT 1 IS LOWEST ORDER BIT
*    C = RETURNS WITH TOTAL NUMBER OF BITS SET (I*4)
*
*
SPREAD   CSECT
      USING *,15
      B START
      DC X'7'
      DC CL7'SPREAD '
*
START STM 14,12,12(13)                      SAVE THE REGISTERS
*
      LM 2,4,0(1)                           LOAD ARGUMENT ADDRESSES
*
* SCAN LOOP
*
      LA 9,16                               COMPARISON REGISTER
      LA 6,0                                CURRENT INDEX COUNT
      LA 8,1                                INCREMENT OF LOOP
      LA 11,0                               WORK REGISTER
      LA 12,1                               SHIFTING MASK REGISTER
      LA 7,0                                BIT COUNTER (=3RD ARGUMENT)
      L 5,0(2)                              BIT PATTERN
      SRL 5,16                              RIGHT ADJUST IT
      L 10,=F'-4'                           SUBSCRIPT COUNTER
*
PLUS  BXH  6,8,NEND                         TEST IF END OF LOOP
      LR  11,12                             LOAD AND TEST BIT PATTERN
      NR 11,5                               "AND" OF BIT PATTERN + MASK
      BC 4,MINUS                            GOTO BIT SET CODING
      SLL 12,1                              SHIFT LEFT OF MASK REGISTER
      B PLUS                                GOTO PLUS
*
MINUS A 7,=F'1'                             INCREMENT BIT THE COUNTER
      A 10,=F'4'                            INCREMENT SUBSCRIPT COUNTER
      ST 6,0(10,3)                          STORE BIT NUMBER
*
      SLL 12,1                              SHIFT LEFT ONE BIT
      B PLUS                                GOTO PLUS
*
NEND  ST 7,0(4)                             COPY ACROSS BIT COUNT
      LM 2,12,28(13)                        RESTORE REGISTERS
      MVI 12(13),X'FF'                      INDICATE RETURN OF CONTROL
      BR 14                                 RETURN
      END
C   15/02/81 610020943  MEMBER NAME  XYFIT    (PATRECSR)    FORTRAN
          SUBROUTINE XYFIT
          IMPLICIT INTEGER*2(H)
#include "cworkpr.for"
#include "cworkeq.for"
#include "cpatlm.for"
#include "cxyfit.for"
C
C
C-------------------------------------------------------------------
C
C       ERROR IN PARFIT: DIVISION BY ZERO IN CASE OF CURV. = 0.0
C       CURV. SET TO 1.E-8 IN THIS CASE (P. STEFFEN, 02/10/86)
C-------------------------------------------------------------------
C
C       ------------------ SUBROUTINE XYFIT   ----------------
C       ---- G.F.PEARCE .. LAST UPDATE : 1200 ON  4/02/81 ----
C
C    ROUTINE TO PERFORM A FAST PARABOLA OR CIRCLE FIT TO A GIVEN TRACK
C    IN REAL COORDINATE SPACE. THE TRACK INPUT IS PROVIDED VIA THE
C    WORKING COMMON CWORK. THIS IS BEST DONE BY THE ROUTINE FXYZ.
C
C    THE FIT RESULT IS RETURNED AS A SINGLE TRACK TRACK BANK AGAIN IN
C    THE WORKING COMMON CWORK. (REFER TO POINTERS HPTR0,HPTR9,HLDTR)
C
C    FIT HISTORY IS RETURNED AS THE FOLLOWING BIT STRUCTURE IN THE TRACK
C    HISTORY WORD :
C    BIT 31   ...  FINAL FIT WAS GOOD/BAD (BIT OFF/ON)
C    BIT 30   ...  L/R AMBIGUITIES STILL UNCERTAIN AFTER FIT (BIT ON)
C    BIT 29   ...  FIT WAS TRIED WITHOUT WORST TRACK ELEMENT (BIT ON)
C    BIT 28   ...  FIT WAS TRIED USING ONLY THE BEST TRACK ELEMENT
C    BIT 27   ...  PATROL FOUND GREATER THAN 3 NEW HITS THAT WERE ALSO
C             ...  ON ANOTHER TRACK.
C    BIT 26   ...  PATROL CALLED A RE-FIT WHICH FAILED
C
C    CONTROLLING XYFIT.
C    =================
C                     CONTROL OF THE PARAMETERS AND LIMITS USED BY
C    THIS PROGRAM IS ACHIEVED THROUGH THE ARRAY XYF IN COMMON CPATLM.
C    FOR DETAILS SEE THE INITIALISING ROUTINE INPATR.
C
C-------------------------------------------------------------------
C
C
          NTRAK = HPWRK(30)
C#######################################################################
      PRINT = .FALSE.
      IF (NTRAK.EQ.IXYF(20)) PRINT=.TRUE.
      IF (IXYF(20).LT.0.AND.NTRAK.GE.IABS(IXYF(20))) PRINT=.TRUE.
      IF (TBIT(IXYF(1),28)) PRINT=.FALSE.
      IF (PRINT) PRINT9,NTRAK,IXYF(1)
 9    FORMAT(1X,39('=')/' XYFIT - TRACK',I4,' XYF(1) = ',Z8/1X,39('='))
C#######################################################################
C
C         ===================================
C         ===================================
C         INITIALISATION AND TESTS FOR ERRORS
C         ===================================
C         ===================================
C
          ISTORY=0
          KNTROL=IXYF(1)
          SETFLG=.TRUE.
          NHIT=(HPHT9-HPHT0+1)/HLDHT
          IF(NHIT.GE.4.AND.NHIT.LE.80)GOTO20
C ERRORM 1 ---------- NOT ENOUGH HITS TO FIT --------------------------
          CALLERRORM('   XYFIT',1,NTRAK)
C         ----------------------
C         ABANDON FIT .. GIVE UP
C         ----------------------
 10       RMSFIT=1000000.
          ISTORY=LOR(ISTORY,1)
          GOTO990
C
C         =======================================
C         =======================================
C         FIT PARABOLA AND DETERMINE L/R SOLUTION
C         =======================================
C         =======================================
C
 20       CALLLRFIT
          IF(FATAL)GOTO10
          IF(.NOT.BADFIT.OR.NBAD.EQ.0)GOTO700
          IF(TBIT(KNTROL,31))GOTO700
C
C         =========================================
C         =========================================
C         TRY A FIT WITHOUT THE WORST TRACK ELEMENT
C         =========================================
C         =========================================
C
          CALLTRLCHI
C         ------------------------
C         FIND WORST TRACK ELEMENT
C         (DEMAND > 5 POINTS LEFT)
C         ------------------------
          IF(NTRTOT.LE.1)GOTO900
          CHI=0
          NTRMSK=0
          DO 420 N=1,NTRTOT
          CHITR(N)=CHITR(N)/NHITIN(N)
          IF(NHIT-NHITIN(N).LE.4)GOTO420
          IF(CHITR(N).LE.CHI)GOTO420
          CHI=CHITR(N)
          NTRMSK=JTR(N)
 420      CONTINUE
          IF(TBIT(KNTROL,27))GOTO500
C#######################################################################
      IF (PRINT) PRINT421,NTRMSK
 421  FORMAT(' ****** MASK OUT TRACK ELEMENT',I3)
C#######################################################################
C         ----------------------------
C         MASK OUT WORST TRACK ELEMENT
C         (NTRBAD) AND REPEAT THE FIT.
C         ----------------------------
          IF(NTRMSK.EQ.0)GOTO900
          IPHIT=HPHT0+10
430       ISP1=IABS(IWRK(IPHIT-2))
          IF(ISP1.EQ.NTRMSK.OR.ISP1.EQ.1000)GOTO440
          IWRK(IPHIT)=0
          GOTO450
 440      IWRK(IPHIT)=9
 450      IPHIT=IPHIT+HLDHT
          IF(IPHIT.LT.HPHT9)GOTO430
C         -----------------
C         CALL PARABOLA FIT
C         -----------------
          ISTORY=LOR(ISTORY,4)
          CALLPARFIT
          IF(FATAL)GOTO10
          IF(.NOT.BADFIT)GOTO600
C
C         ===============================
C         ===============================
C         TRY A FIT WITH ONLY THE LONGEST
C         ===============================
C         ===============================
C
 500      IF(NTRTOT.LE.2)GOTO900
          ISP1=0
          DO 530 N=1,NTRTOT
          IF(NHITIN(N)-ISP1)530,510,520
 510      IF(CHITR(N).GT.CHI)GOTO530
 520      CHI=CHITR(N)
          ISP1=NHITIN(N)
          NTRMSK=JTR(N)
 530      CONTINUE
C#######################################################################
      IF (PRINT) PRINT531,NTRMSK
 531  FORMAT(' ****** FIT ONLY TRACK ELEMENT ',I4)
C#######################################################################
          IF (ISP1.LE.4) GOTO900
C         ----------------------------------
C         MASK OUT ALL TRACK ELEMENTS EXCEPT
C         THE LONGEST (NTRGUT) AND REFIT.
C         ----------------------------------
          IPHIT=HPHT0+10
 540      ISP1=IABS(IWRK(IPHIT-2))
          IF(ISP1.EQ.NTRMSK)GOTO550
          IWRK(IPHIT)=9
          GOTO560
 550      IWRK(IPHIT)=0
 560      CONTINUE
          IPHIT=IPHIT+HLDHT
          IF(IPHIT.LT.HPHT9)GOTO540
          ISTORY=LOR(ISTORY,8)
          CALLPARFIT
          IF(FATAL)GOTO10
          IF(BADFIT)GOTO900
C
C         =======================================
C         =======================================
C         REFIT IF SOME BAD HITS WERE RECOLLECTED
C         =======================================
C         =======================================
C
 600      IF(NEXTRA.LE.IGFP(10))GOTO700
C#######################################################################
      IF (PRINT) PRINT601,NEXTRA
 601  FORMAT(' ****** REFIT WITH EXTRA POINTS .. ',I5)
C#######################################################################
          CALLPARFIT
          IF(FATAL)GOTO900
          IF(.NOT.BADFIT)GOTO600
C
C         ================================
C         ================================
C         CONVERT PARABOLA FIT INTO CIRCLE
C         ================================
C         ================================
C
 700      IF(TBIT(KNTROL,30))GOTO800
C#######################################################################
      IF (PRINT.AND.ABS(CURV).LT.XYF(6))PRINT701,CURV,XYF(6)
 701  FORMAT(' ****** NO CIRCLE FIT .. LOW CURVATURE ',2E11.4)
C#######################################################################
          IF(ABS(CURV).LT.XYF(6))GOTO800
C#######################################################################
      IF (PRINT.AND.CHIFIT.GT.XYF(10))PRINT702,CHIFIT,XYF(10)
 702  FORMAT(' ****** NO CIRCLE FIT .. BAD PARAB CHI ',2E11.4)
C#######################################################################
          IF(CHIFIT.GT.XYF(10))GOTO800
C         ----------
C         FIT CIRCLE
C         ----------
          CALLCIRFIT
          IF(.NOT.FATAL)CALLRESIDS
C
C         ===================================
C         ===================================
C         RECALCULATE ABERRATIONS IF REQUIRED
C         ===================================
C         ===================================
C
 800      IF(.NOT.TBIT(KNTROL,29))GOTO900
          IF(NGOOD.LE.3)GOTO900
          CALLNEWINC
C
C         ==================================
C         ==================================
C         LOAD RESULTS INTO CWORK TRACK BANK
C         ==================================
C         ==================================
C
 900      NPTYPE=NMPROG
          RMSFIT=SQRT(CHIFIT)
          NPUSED=NPTS
          COEFF2=XMID+C2*COSTH-C3*SINTH
          COEFF3=YMID+C2*SINTH+C3*COSTH
          X1=XFIRST-C2
          X2=XLAST-C2
          GOTO(910,950),NMPROG
C         -------------------------
C         COMPUTE CIRCLE PARAMETERS
C         CURVATURE, R0-R, EPSILON
C         -------------------------
 910      CURVT=1.0 / C4
          COEFF4=ATAN2(COEFF3,COEFF2)
          COEFF2=SQRT(COEFF2**2+COEFF3**2)-ABS(C4)
          COEFF3=COEFF4
          COEFF1=ABS(CURVT)
C         CIRCLE END POINTS AND GRADIENTS
          Y1=C4**2-X1**2
          IF(Y1.LT.0.) PRINT9991,Y1,NREC,HRUN,HEV,HPWRK(30)
 9991   FORMAT(' XYFIT .. -VE SQRT ON Y1',E11.4,4I10)
          IF(Y1.LT.0.)RMSFIT=1000000.
          IF(Y1.LT.0.)Y1=1.
          Y1=SIGN(SQRT(Y1),CURVT)
          SP1=-X1/Y1
          Y1=Y1+C3
          Y2=C4**2-X2**2
         IF(Y2.LT.0.)PRINT9992,Y2,NREC,HRUN,HEV,HPWRK(30)
 9992   FORMAT(' XYFIT .. -VE SQRT ON Y2',E11.4,4I10)
          IF(Y2.LT.0.)RMSFIT=1000000.
          IF(Y2.LT.0.)Y2=1.
          Y2=SIGN(SQRT(Y2),CURVT)
          SP2=-X2/Y2
          Y2=Y2+C3
          GOTO980
C         --------------------------------------
C         COMPUTE PARABOLA PARAMETERS
C         Y1 = C4 * X1**2
C         WHERE X1 = (X-C2)*COSTH + (Y-C3)*SINTH
C         AND   Y1 = (Y-C3)*COSTH - (X-C2)*SINTH
C         --------------------------------------
 950      COEFF1=ATAN2(SINTH,COSTH)
C         COEFF2=COEFF2
C         COEFF3=COEFF3
          COEFF4=C4
          CURVT=-2*C4
C         PARABOLA END POINTS
          Y1=C4*X1**2+C3
          Y2=C4*X2**2+C3
C         PARABOLA END DIRECTIONS
          SP1=-CURVT*X1
          SP2=-CURVT*X2
 980      CONTINUE
C         -----------------
C         FITTED END POINTS
C         -----------------
          XSTR=XFIRST*COSTH-Y1*SINTH+XMID
          YSTR=XFIRST*SINTH+Y1*COSTH+YMID
          RSTR=SQRT(XSTR**2+YSTR**2)
          XEND=XLAST*COSTH-Y2*SINTH+XMID
          YEND=XLAST*SINTH+Y2*COSTH+YMID
          REND=SQRT(XEND**2+YEND**2)
C         -----------------
C         DIRECTION COSINES
C         -----------------
          CS1 = 1. / SQRT(SP1**2 + 1.)
          SN1 = CS1 * SP1
          DXSTR=CS1*COSTH-SN1*SINTH
          DYSTR=CS1*SINTH+SN1*COSTH
          DRSTR=0
          CS2 = 1. / SQRT(SP2**2 + 1.)
          SN2 = CS2 * SP2
          DXEND=CS2*COSTH-SN2*SINTH
          DYEND=CS2*SINTH+SN2*COSTH
          DREND=0.
C         ------------------------
C         START AND END CURVATURES
C         ------------------------
          CURV1=CURVT
          CURV2=CURVT
          DCURV=0.
C         ------------------
C         TYPE OF END POINTS
C         ------------------
          TYPE1=0
          TYPE2=0
C         -------------------------
C         LOAD OUTPUT BANK IN CWORK
C         -------------------------
 990      IPHIT=HPTR0+3
          CALLMVCL(WRK(IPHIT),0,ADWRK(1),0,100)
          IPHIT=HPTR0+47
          IF(BADFIT)ISTORY=LOR(ISTORY,1)
          IWRK(IPHIT)=LOR(IWRK(IPHIT),ISTORY)
C#######################################################################
      IF (PRINT) CALL PCWORK(0,0,0,0,1)
C#######################################################################
C
C         ==========================================
C         ==========================================
C         COMPUTE TRACK ELEMENT CHI**2 FOR BACKTRACE
C         ==========================================
C         ==========================================
C
          IF(TBIT(KNTROL,28))CALLTRLCHI
          IF(TBIT(KNTROL,28))CALL MVCL(ADWRK(81),0,JTR(1),0,80)
          RETURN
          END
          SUBROUTINE LRFIT
          IMPLICIT INTEGER*2(H)
C
C
C
C
C
C=======================================================================
C=======================================================================
C=======================================================================
C=======================================================================
C
C               DETERMINE LEFT/RIGHT AMBIGUITY BY FITTING
C
C=======================================================================
C=======================================================================
C=======================================================================
C=======================================================================
C
C
C
C
C
#include "cpatlm.for"
#include "cworkpr.for"
#include "cworkeq.for"
#include "cxyfit.for"
          LOGICAL*1 LRDONE
C         --------------
C         FIT SOLUTION 1
C         --------------
          SETFLG=.FALSE.
          CALLPARFIT
          SETFLG=.TRUE.
          IF(FATAL)RETURN
 6010     IF(HPHT0A.LE.0)RETURN
CONTROL BIT 26 IS TESTED IN FXYZ
          LRDONE=.FALSE.
          CHILST=CHIFIT
C         --------------
C         FIT SOLUTION 2
C         --------------
          LPHT0=HPHT0
          LPHT9=HPHT9
          HPHT0=HPHT0A
          HPHT9=HPHT9A
          CALLPARFIT
          HPHT0=LPHT0
          HPHT9=LPHT9
          IF(FATAL)GOTO6070
          IF(CHILST.LT.CHIFIT)GOTO6040
C         ---------------
C         KEEP SOLUTION 2
C         ---------------
          IPHIT=HPHT0A
          ISP1=NHIT*HLDHT*4
          CALLMVCL(WRK(LPHT0),0,WRK(IPHIT),0,ISP1)
          IF((CHILST-CHIFIT).GT.XYF(7)*CHIFIT)LRDONE=.TRUE.
          GOTO6060
C         ---------------
C         KEEP SOLUTION 1
C         ---------------
 6040     IF((CHIFIT-CHILST).GT.XYF(7)*CHILST)LRDONE=.TRUE.
          CHILST=CHIFIT
          CALLPARFIT
          IF(FATAL)GOTO6080
C         ---------------------
C         IS L/R NOW RESOLVED ?
C         ---------------------
 6060     IF(.NOT.LRDONE)ISTORY=LOR(ISTORY,2)
C#######################################################################
      IF(LRDONE.AND.PRINT) PRINT6061,CHILST,CHIFIT
 6061 FORMAT(' ****** L/R SOLNS FITTED SUCCESSFULLY ..',2F10.2)
      IF(.NOT.LRDONE.AND.PRINT)PRINT6062,CHILST,CHIFIT
 6062 FORMAT(' ****** L/R SOLNS FITTED UNSUCCESSFULLY ..',2F10.2)
C#######################################################################
          HPHT0A=-HPHT0A
          RETURN
C         --------------------
C         SOLN 2 FIT WAS FATAL
C         --------------------
 6070     FATAL=.FALSE.
C ERRORM 5 ------------ FITTING SOLN 1 IN LRFIT WAS FATAL -------------
          CALLERRORM('   XYFIT',5,NTRAK)
          CALLRESIDS
          GOTO6060
C         -------------------------
C         RECALLING FIT 1 WAS FATAL
C         -------------------------
 6080     CONTINUE
C ERRORM 6 ---------- RECALLING SOLN 1 IN LRFIT WAS FATAL -------------
          CALLERRORM('   XYFIT',6,NTRAK)
          RETURN
          END
          SUBROUTINE PARFIT
          IMPLICIT INTEGER*2(H)
C
C
C
C
C
C=======================================================================
C=======================================================================
C=======================================================================
C=======================================================================
C
C               FORM PARABOLIC LEAST SQUARES FIT TO TRACK
C
C=======================================================================
C=======================================================================
C=======================================================================
C=======================================================================
C
C
C
C
C
#include "cworkpr.for"
#include "cworkeq.for"
#include "cpatlm.for"
#include "cxyfit.for"
          FATAL=.FALSE.
C         ---------------------------
C         FIND INNER AND OUTER POINTS
C         ON TRACK TO DETERMINE SLOPE
C         ---------------------------
C         OUTER POINT (BEGINNING OF ARRAY)
          IS3=0
          IS1=0
          IPHIT=HPHT0+10
 5010     IF(IWRK(IPHIT).NE.0)GOTO5020
          IS3=IS3+1
          IS2=IPHIT
          IF(IS1.EQ.0)IS1=IPHIT
 5020     IPHIT=IPHIT+HLDHT
          IF(IPHIT.LT.HPHT9)GOTO5010
          IF(IS3.GE.4)GOTO5030
C ERRORM 2 ---------- NO GOOD POINTS TO FIT ---------------------------
          IF(IS3.LE.0)CALLERRORM('   XYFIT',2,NTRAK)
C ERRORM 3 ---------- NOT ENOUGH GOOD POINTS TO FIT -------------------
          IF(IS3.GT.0)CALLERRORM('   XYFIT',3,NTRAK)
          FATAL=.TRUE.
          RETURN
 5030     CONTINUE
          XEND=WRK(IS1-7)
          YEND=WRK(IS1-6)
          XSTR=WRK(IS2-7)
          YSTR=WRK(IS2-6)
          NMPROG=2
C         --------------------------
C         EVALUATE SLOPE OF SYMMETRY
C         AXES AND ROUGH ORIGIN.
C         --------------------------
          COSTH=XEND-XSTR
          SINTH=YEND-YSTR
          XMID=(XSTR+XEND)/2
          YMID=(YSTR+YEND)/2
          SP1=1.0/SQRT(COSTH**2+SINTH**2)
          COSTH=COSTH*SP1
          SINTH=SINTH*SP1
C         -------------------------
C         TRANSFORM COORDINATES AND
C         PERFORM PARABOLIC FIT.
C         -------------------------
          ISP5=0
          SUMX=0
          SUMY=0
          SUMXY=0
          SUMX2=0
          SUMX3=0
          SUMX4=0
          SUMX2Y=0
          NPTS=0
          IPHIT=HPHT0+3
          DO 5050 N=1,NHIT
          SP2=WRK(IPHIT)-XMID
          Y1=WRK(IPHIT+1)-YMID
          X1=SP2*COSTH+Y1*SINTH
          Y1=Y1*COSTH-SP2*SINTH
          AX(N)=X1
          AY(N)=Y1
          USED(N)=.FALSE.
          IF(IWRK(IPHIT+7).NE.0)GOTO5050
          USED(N)=.TRUE.
          NPTS=NPTS+1
          SUMX=SUMX+X1
          SUMY=SUMY+Y1
          SUMXY=SUMXY+X1*Y1
          SP2=X1**2
          SUMX2=SUMX2+SP2
          SUMX3=SUMX3+X1*SP2
          SUMX4=SUMX4+SP2**2
          SUMX2Y=SUMX2Y+SP2*Y1
 5050     IPHIT=IPHIT+HLDHT
C         ---------------------------
C         COMPUTE PARABOLA PARAMETERS
C         ---------------------------
 5060     CONTINUE
          SP1=SUMX*SUMY/NPTS-SUMXY
          SP2=SUMX*SUMX2/NPTS-SUMX3
          SP3=SUMX**2/NPTS-SUMX2
          SP4=SUMX2*SUMY/NPTS-SUMX2Y
          SP5=SUMX2**2/NPTS-SUMX4
          C2=SP3*SP5-SP2**2
          C4=(SP3*SP4-SP1*SP2)/C2
C
C !!!!!   THE FOLLOWING STATEMENT INSERTED IN ORDER TO AVOID
C !!!!!   DIVISION BY ZERO 5 STATEMENTS FURTHER ON (P.STEFFEN)
          IF(ABS(C4) .LT. 1.E-8) C4 = 1.E-8
C
          C2=(SP1*SP5-SP2*SP4)/C2
          C3=(SUMY-C4*SUMX2-C2*SUMX)/NPTS
          CURV=-2*C4
          C2=C2/CURV
          C3=C3-C4*C2*C2
          NDF=NPTS-4
          ENTRYRESIDS
C
C
C
C
C
C=======================================================================
C=======================================================================
C=======================================================================
C=======================================================================
C
C          COMPUTE CHI**2 AND HIT RESIDUALS FOR CURRENT FIT
C
C=======================================================================
C=======================================================================
C=======================================================================
C=======================================================================
C
C
C
C
C
C    FLAG = 0 => HIT WITHIN  ACCEPTANCE CUT (CODE0)
C    FLAG = 1 => HIT OUTSIDE ACCEPTANCE CUT BUT USED IN FIT
C    FLAG = 2 => HIT OUTSIDE ACCEPTANCE CUT BUT WITHIN DOUBLE HIT RESLN
C    FLAG = 3 => HIT OUTSIDE DOUBLE HIT RESOLUTION
          NBAD=0
          NEXTRA=0
          ISP5=0
          CHIFIT=0
C         COMPUTE RESIDUAL CUT
          RADBIT=10*NPTS*ABS(CURV)
          IF(RADBIT.GT.1.0)RADBIT=1.0
          CODE0=XYF(4)+RADBIT*XYF(5)
          CODE2=GFP(3)
          CHSLIM=XYF(2)+RADBIT*XYF(3)
          IF(NMPROG.EQ.2)GOTO4001
          SP1=C4**2
          SP2=0.5/ABS(C4)
 4001     CONTINUE
          IPHIT=HPHT0+10
          DO 4050 N=1,NHIT
          X1=AX(N)
          SP3=(X1-C2)**2
          Y1=AY(N)-C3
          IF(NMPROG.EQ.2)GOTO4010
          CHI=(SP3+Y1**2-SP1)*SP2
          GOTO4020
 4010     CHI=C4*SP3-Y1
 4020     WRK(IPHIT+3)=CHI
          IF(USED(N))CHIFIT=CHIFIT+CHI**2
          IF(.NOT.SETFLG)GOTO4050
          CHI=ABS(CHI)
          IF(CHI.GT.CODE0)GOTO4030
C         GOOD RESIDUAL TO NEW FIT
          IWRK(IPHIT)=0
          IF(USED(N))GOTO4025
          NEXTRA=NEXTRA+1
          GOTO4050
 4025     XFIRST=X1
          IF(ISP5.EQ.0)ISP5=N
          GOTO4050
C         BAD RESIDUAL TO NEW FIT
 4030     IWRK(IPHIT)=2
          IF(CHI.GT.CODE2)IWRK(IPHIT)=3
          IF(.NOT.USED(N))GOTO4050
          IWRK(IPHIT)=1
          NBAD=NBAD+1
 4050     IPHIT=IPHIT+HLDHT
          IF (NDF.GT.0)CHIFIT=CHIFIT/NDF
          NGOOD=NPTS-NBAD+NEXTRA
C####################################################################
      RAD = 1.0/CURV
      IF(PRINT)PRINT4051,NMPROG,NPTS,NGOOD,NBAD,NEXTRA,RAD,
     # CODE0,CHSLIM,CHIFIT
 4051 FORMAT(' FIT ',I1,' #POINTS USED/GOOD/BAD/EXTRA =',4I3,
     #' RADIUS =',E11.4,' CODE0 =',F4.1,' CHSLIM =',F4.1,
     #'  CHI**2 =',F7.3,' ######')
      IF (PRINT) CALL PCWORK(0,0,0,1,0)
C####################################################################
          IF(ISP5.NE.0)GOTO4080
          XLAST=AX(1)
          XFIRST=AX(NHIT)
          GOTO4090
 4080     XLAST=AX(ISP5)
C         ------------------------
C         LABEL AS GOOD OR BAD FIT
C         ------------------------
 4090     BADFIT=.FALSE.
          IF(CHIFIT.GT.CHSLIM)BADFIT=.TRUE.
          RETURN
          END
          SUBROUTINE CIRFIT
          IMPLICIT INTEGER*2(H)
C
C
C
C
C
C=======================================================================
C=======================================================================
C=======================================================================
C=======================================================================
C
C                    CIRCLE FIT USING PARABOLA
C
C=======================================================================
C=======================================================================
C=======================================================================
C=======================================================================
C
C
C
C
C
#include "cworkpr.for"
#include "cworkeq.for"
#include "cxyfit.for"
#include "cpatlm.for"
          FATAL=.TRUE.
C ERRORM 4 ------------ NOT ENOUGH HITS FOR CIRCLE -------------------
          IF(NPTS.LE.3)CALLERRORM('   XYFIT',4,NTRAK)
C         ---------------------------
C         START WITH INSCRIBED CIRCLE
C         ---------------------------
          NSERR=0
          IF(CURV.NE.0.0)GOTO900
C ERRORM 10 ----------- CURVATURE ZERO FROM PARFIT -------------------
          CALLERRORM('   XYFIT',10,NTRAK)
          RETURN
 900      C4C=1.0/ABS(CURV)
          C3C=C3-SIGN(C4C,CURV)
          NCLOOP=0
C         NO FIT FOR NPTS <= 4
          IF(NPTS.LE.4)GOTO1051
C         ----------------------------------
C         DETERMINE AVERAGE RADIAL DEVIATION
C         -----------------------------------
 1000     SP2=C4C**2
          DR1=0.
          CHICIR=0.
          DO 1010 N=1,NHIT
          IF(.NOT.USED(N))GOTO1010
          X1=AX(N)-C2
          Y1=AY(N)-C3C
          SP1=X1**2+Y1**2-SP2
          DR1=DR1+SP1
          CHICIR=CHICIR+SP1**2
 1010     CONTINUE
C         --------------------
C         STOP ITERATING NOW ?
C         --------------------
          IF(C4C.NE.0.0)GOTO1011
C ERRORM 11 ------------- CIRCLE FIT ERROR ZERO RADIUS --------------
          CALL ERRORM('   XYFIT',11,NTRAK)
          RETURN
 1011     CHICIR=CHICIR/(4.0*SP2*(NPTS-3))
C#######################################################################
          IF(PRINT)PRINT1012,NCLOOP,CHICIR,CHIL1,CHIFIT
 1012     FORMAT(' CIRCLE FIT LOOP',I3,1X,' CHI**2 =',F7.3,' OLD=',F7.3,
     #    ' PARAB=',F7.3)
C#######################################################################
          IF(CHICIR.LE.0.)GOTO1050
          IF(NCLOOP.EQ.0)GOTO1020
          IF(NCLOOP.GE.8)GOTO1080
          IF(CHICIR.GT.CHIL1)GOTO1070
          IF(ABS(CHICIR-CHIL1).LE.XYF(8)*CHIL1)GOTO1050
C         ------------------------------------
C         CORRECT FOR AVERAGE RADIAL DEVIATION
C         ------------------------------------
 1020     CHIL1=CHICIR
          C3CL1=C3C
          C4CL1=C4C
          NCLOOP=NCLOOP+1
          IF(C4C.NE.0.0)GOTO1021
C ERRORM 12 ------------- CIRCLE FIT ERROR,ZERO RADIUS -----------------
          CALL ERRORM('   XYFIT',12,NTRAK)
          RETURN
 1021     DR1=DR1/(2.0*C4C*NPTS)
          C4C=C4C+DR1
          C3C=C3C-SIGN(DR1,CURV)
C         -------------------------
C         FIT PARABOLA TO RESIDUALS
C         -------------------------
          SP2=C4C**2
          SP1=0.5/C4C
          SUMX=0
          SUMY=0
          SUMXY=0
          SUMX2=0
          N=NHIT
 1030     IF(.NOT.USED(N))GOTO1040
          X2=AX(N)-C2
          SP3=X2**2
          Y2=AY(N)-C3C
          Y2=-(SP3+Y2**2-SP2)*SP1
          SUMX=SUMX+X2
          SUMX2=SUMX2+SP3
          SUMXY=SUMXY+X2*Y2
          SUMY=SUMY+Y2
 1040     N=N-1
          IF(N.GT.0)GOTO1030
C         ------------------------------
C         SOLUTION FOR CIRCLE PARAMETERS
C         ------------------------------
          SPA=SUMX2*NPTS-SUMX**2
          IF( (SPA.NE.0.0).AND.(SP2.NE.0.0).AND.(X1.NE.X2) )GOTO1041
C ERRORM 14 ----------- CIRCLE FIT PARAMETER ERROR ---------------
          CALL ERRORM('   XYFIT',14,NTRAK)
          RETURN
 1041     SP1=(SUMXY*NPTS-SUMX*SUMY)/SPA
          DR2=2*C4C*(SUMY-SP1*SUMX)/NPTS
          SP3=(X2-X1)**2/(4*SP2)
          IF(SP3.GT.1.0)GOTO1060
          SP3=(1.0-SQRT(1.0-SP3))*C4C
          IF(SP3.NE.0.)GOTO1045
C ERRORM 7 ---------- TRACK START AND END ERROR -----------------------
          CALLERRORM('   XYFIT',7,NTRAK)
          RETURN
 1045     DR2=-DR2/SP3
          C4C=C4C+DR2
          C3C=C3C-SIGN(DR2,CURV)
C#######################################################################
          IF(PRINT)PRINT1046,DR1,DR2,C4C,X1,X2
 1046 FORMAT(' ..  DR1=',E11.4,' DR2=',E11.4,
     # '  RAD=',E11.4,'  FIRST/LAST PTS=',2E11.4)
C#######################################################################
          GOTO1000
C         ----------------
C         CIRCLE FIT ENDED
C         ----------------
 1050     IF(CHICIR.GT.10*CHIFIT)GOTO1090
 1051     NMPROG=1
          C3=C3C
          C4=-SIGN(C4C,C4)
          CURV=1.0/C4
          NDF=NPTS-3
          FATAL=.FALSE.
C#######################################################################
          IF(PRINT)PRINT1052,NCLOOP,NPTS,C4
 1052     FORMAT(' EXIT CIRCLE FIT AFTER',I2,' ITERATIONS. NPTS=',I3,
     #    ' RADIUS =',E11.4)
C#######################################################################
          RETURN
C         ------------------------
C         FAILURE .. SAGITTA ERROR
C         ------------------------
 1060     CONTINUE
C#######################################################################
          IF(PRINT)PRINT1061,NSERR,SP3
 1061     FORMAT(' ****** CIRCLE SAGITTA ERROR ',I4,2X,E11.4)
C#######################################################################
          IF(NSERR.GE.2)RETURN
          NSERR=NSERR+1
          C4C=ABS(X2-X1)*0.6
          C3C=C3-SIGN(C4C,CURV)
          GOTO1000
C         --------------------------
C         FAILURE .. NON-CONVERGENCE
C         --------------------------
 1070     CONTINUE
C#######################################################################
      IF (PRINT) PRINT1071,CHICIR,CHIL1,CHIFIT
 1071 FORMAT(' CIRCLE FIT NOT CONVERGING ',3E11.4)
C#######################################################################
          IF(CHIL1.GT.CHIFIT)RETURN
          C4C=C4CL1
          C3C=C3CL1
          CHICIR=CHIL1
C#######################################################################
      IF (PRINT) PRINT1076
 1076 FORMAT(' CONVERGENCE SAVED BY USING LAST ITERATION')
C#######################################################################
          GOTO1050
C         -------------------------
C         FAILURE .. TOO MANY LOOPS
C         -------------------------
 1080     IF(CHICIR.GT.CHIFIT)GOTO1050
C#######################################################################
          IF(PRINT)PRINT1081
 1081     FORMAT(' CIRCLE FIT USING TOO MANY ITERATIONS')
C#######################################################################
          RETURN
C         ----------------------------
C         FAILURE .. CHI**2 > 10*PARAB
C         ----------------------------
 1090     CONTINUE
          RETURN
          END
          SUBROUTINE NEWINC
          IMPLICIT INTEGER*2(H)
C
C
C
C
C
C=======================================================================
C=======================================================================
C=======================================================================
C=======================================================================
C
C          ADJUST ALL HIT COORDINATES FOR NEW TRACK INCLINATION
C
C=======================================================================
C=======================================================================
C=======================================================================
C=======================================================================
C
C
C
C
C
C%MACRO 'F11GOD.PATRECSR(CJDRCH)'
C%MACRO 'F11GOD.PATRECSR(CDSMAX)'
C%MACRO 'F11GOD.PATRECSR(CWORKPR)'
C%MACRO 'F11GOD.PATRECSR(CWORKEQ)'
C%MACRO 'F11GOD.PATRECSR(CXYFIT)'
C-- ERROR 1 ==> NEWINC COMMENTED OUT
          CALL ERRORM('NEWINC  ',1,0)
C         INTEGER*4 BIT29N/ZFFFB/
C         IF(.NOT.TBIT(KNTROL,29))RETURN
C         SP2=XMID+C2*COSTH-C3*SINTH
C         SP3=YMID+C2*SINTH+C3*COSTH
C         IPHIT=HPHT0+3
C         GOTO(2010,2020),NMPROG
C2010     R1=ABS(C4)
C         GOTO2030
C2020     R1=1.0/(2*C4)
C         SP2=SP2-R1*SINTH
C         SP3=SP3+R1*COSTH
C         R1=ABS(R1)
C2030     INCELL=IWRK(IPHIT+6)
C         INRING=IWRK(IPHIT+9)
C         IF(IWRK(IPHIT+5).GT.0)GOTO2040
C         LRFLAG=-1
C         LRAMB=1
C         GOTO2050
C2040     LRFLAG=+1
C         LRAMB=2
C2050     TRLORX=TRMATS(INCELL,LRAMB)
C         TRLORY=TRMATC(INCELL,LRAMB)
C         SINLOR=SINDRI(INCELL,LRAMB)
C         COSLOR=COSDRI(INCELL,LRAMB)
C         ISP5=INCELL-24*(INRING-1)
C         IF(INRING.EQ.3)GOTO2060
C         DXWR=DIRWR1(ISP5,1)
C         DYWR=DIRWR1(ISP5,2)
C         GOTO2070
C2060     DXWR=DIRWR3(ISP5,1)
C         DYWR=DIRWR3(ISP5,2)
C2070     TRABX=SINLOR*DXWR-COSLOR*DYWR
C         TRABY=COSLOR*DXWR+SINLOR*DYWR
C         X1=WRK(IPHIT)
C         Y1=WRK(IPHIT+1)
C         BETA=R1/ABS(TRABX*(X1-SP2)+TRABY*(Y1-SP3))
C         IF(BETA.LT.1.0)BETA=1.0
C         IF(BETA.GT.1.2)BETA=1.1
C         SP5=LRFLAG*(BETA-WRK(IPHIT+8))*2.9
C         WRK(IPHIT)=X1+TRLORX*SP5
C         WRK(IPHIT+1)=Y1+TRLORY*SP5
C         WRK(IPHIT+8)=BETA
C         IPHIT=IPHIT+HLDHT
C         IF(IPHIT.LT.HPHT9)GOTO2030
C         KNTROL=LAND(KNTROL,BIT29N)
C2090     CONTINUE
C#######################################################################
C     IF (PRINT) PRINT2091
C2091 FORMAT(' ****** ABERRATIONS CORRECTED ')
C#######################################################################
          RETURN
          END
          SUBROUTINE TRLCHI
          IMPLICIT INTEGER*2(H)
C
C
C
C
C
C=======================================================================
C=======================================================================
C=======================================================================
C=======================================================================
C
C          COMPUTE CHI**2 CONTRIBUTION FROM EACH TRACK ELEMENT
C
C=======================================================================
C=======================================================================
C=======================================================================
C=======================================================================
C
C
C
C
C
#include "cworkpr.for"
#include "cworkeq.for"
#include "cxyfit.for"
          ISP2=0
          J=0
          IPHIT=HPHT0+8
 3010     ISP1=IABS(IWRK(IPHIT))
C         -----------------------
C         IGNORE 'PATROLLED' HITS
C         -----------------------
          IF(ISP1.GE.1000)GOTO3030
          IF(ISP1.EQ.ISP2)GOTO3020
C         -----------------
C         NEW TRACK ELEMENT
C         -----------------
          J=J+1
          NHITIN(J)=0
          CHITR(J)=0
          ISP2=ISP1
          JTR(J)=ISP1
C         --------------------------------
C         INCREMENT TRACK ELEMENT COUNTERS
C         --------------------------------
 3020     CHITR(J)=CHITR(J)+WRK(IPHIT+5)**2
          NHITIN(J)=NHITIN(J)+1
 3030     IPHIT=IPHIT+HLDHT
          IF(IPHIT.LT.HPHT9)GOTO3010
          NTRTOT=J
C######################################################################
      IF (PRINT) PRINT3031,(JTR(N),NHITIN(N),CHITR(N),N=1,NTRTOT)
 3031 FORMAT(' TREL CHI**2 COMPUTED ',10(I3,I3,F10.4))
C######################################################################
          RETURN
          END
