C   20/03/97 703202231  MEMBER NAME  JEOSUM2  (PATRECSR)    SHELTRAN
C   13/01/82            MEMBER NAME  PATRCO   (PATRECSR)    SHELTRAN
C   09/07/80 201111008  MEMBER NAME  ORPATRCO (JADESR)      SHELTRAN
      SUBROUTINE PATRCO(IND)
C
C     MAIN SUBROUTINE FOR PATREC IN JET CHAMBERS
C     SELECTING ONLY TRACKS FROM ORIGIN (P>200MEV)
C     PETER STEFFEN  9/07/80
C
      IMPLICIT INTEGER*2 (H)
C
#include "cheadr.for"
#include "cdata.for"
#include "ccycp.for"
C
#include "cjdrch.for"
#include "cdsmax.for"
#include "cpatlm.for"
C
#include "cworkpr.for"
#include "cworkeq.for"
C
      EQUIVALENCE
     ,           (ICELL ,IDWRK(1)),(NHIT  ,IDWRK(2)),(IRING ,IDWRK(3))
     ,         , (IERRCD,IDWRK(4)),(NTRKEL,IDWRK(5))
     ,         , (ITR   ,IDWRK(7)),(ITRNG ,IDWRK(8))
C
C
      COMMON /CLBPGM/ LBPGM(30)
      INTEGER MSKHIT(16) /1,2,4,8,16,32,64,128,Z100,Z200,Z400,Z800,
     ,                    Z1000,Z2000,Z4000,Z8000/
C
      DATA HPS /2HPS/
      DATA PATR /'PATR'/, LHEAD,LTRBK /8,48/
      DATA JHTL /'JHTL'/
C
 2991 FORMAT('0/BCS/ TOO SHORT FOR TRACK BANK; EVENT:',3I6,
     ,       ', IRET=',I2,',NTR,LENGTH=',I3,1X,I4)
 2992 FORMAT('0/CWORK/ TOO SHORT FOR PATREC; EVENT:',3I6)
 2993 FORMAT('0/BCS/ TOO SHORT FOR PATREC; EVENT:',3I6,' ,IERR=',I2)
 2994 FORMAT('0WRONG POINTER IN JETC-BANK; EVENT:',3I6,' ,POINTER:',
     ,        /,(1X,24I5))
C
N     CHECK INDEX
      IF IND.EQ.2
      THEN
        CALL PATREC(0)
        RETURN
      CIF
C
C
N     INITIALIZE POINTERS
      DATA LBINIT /0/
      IF LBINIT .EQ. 0
      THEN
        LBINIT = 0
        IQPATR = IBLN('PATR')
        IQJHTL = IBLN('JHTL')
        IQJETC = IBLN('JETC')
C       CONST. FOR VAR. OF DRIFT VEL.
        DSD0   =-.63
        DSD1   = 1.8
        DSD2   = 4.0
        DRV0   = 0.8
        DRV1   = (DSD2 - (DSD1-DSD0)*DRV0) / (DSD2-DSD1)
      CIF
C
N     INITIALIZE # OF TRACKS
      NTR = 0
C
N     SET UP PATR-ARRAY IF NO HITS
      IPJETC = IDATA(IQJETC)
      IF IPJETC.LE.0
      THEN
        IPPATR = IDATA(IQPATR)
        IF IPPATR.LE.0
        THEN
          NBNK = 10
          IZW = LHEAD
          CALL CCRE(IPPATR,PATR,NBNK,IZW,IERR)
N         CHECK IF IERR = 0
          IF(IERR.NE.0) RETURN
          CALL BSAW(1,PATR)
N         PRESET # OF TRACKS + LENGTH OF TRACK-VECTOR
          IDATA(IPPATR+1) = LHEAD
          IDATA(IPPATR+3) = LTRBK
        CIF
        RETURN
      CIF
C
N     # OF HITS IN JETC
      NHITJC = HDATA(IPJETC*2+99) / 4
C
N     INITIALIZE ARRAYS IN OUTPUT AREA
      PERFORM INAROU
C
N     POINTER TO 1. FREE LOC. IN /CWORK/
      HPFREE = 1
      HPLAST = LMPATR(5)
C
      PERFORM PRCYCP
N     CHECK IF POINTERS OK
      IF IERRFL.NE.0
      THEN
        I1 = IPJCA2 + 1
        I9 = I1 + 97
        WRITE(6,2994) HHEADR(17),HHEADR(18),HHEADR(19),
     ,                (HDATA(I),I=I1,I9)
        CALL BDLS(PATR,NBNK)
        CALL BDLS(JHTL,NBNK)
        RETURN
      CIF
C
N     CHECK IF ENOUGH SPACE IN /CWORK/
      IF (HPFREE+NHITJC+96*12+10*17 - 1).LT.LMPATR(5)
      THEN
N       ZERO HIT LABEL ARRAY OF TRACK ELEMENTS
        PERFORM ZRHTLB
      ELSE
        WRITE(6,2992) HHEADR(17),HHEADR(18),HHEADR(19)
        CALL BDLS(PATR,NBNK)
        CALL BDLS(JHTL,NBNK)
        RETURN
      CIF
N     MEMORIZE 1. FREE LOCATION IN CWORK
      HPFRE0 = HPFREE
C
N     INITIALISE TRKEL ARRAY FOR TRACING
      HPRO = HPS
      ITR = 1
      IRINGO = 0
C
N     LOOP OVER ALL CELLS
      JCELL=97
      REPEAT
        JCELL = JCELL - 1
N       NUMBER OF HITS IN CELL
        MHIT = (HPTSEC(JCELL+1)-HPTSEC(JCELL)) / 4
N       CHECK IF AT LEAST NHMIN HITS IN CELL
        IF MHIT.GE.5
        THEN
N         SET RING + CELL NUMBER
          IRING = 3
          IF(JCELL.LE.48) IRING = 2
          IF(JCELL.LE.24) IRING = 1
          ICELL = JCELL
C
N         INITIALIZE ERR.CODE
          IERRCD = 0
C
N         SEARCH FOR TRACK ELEMENTS
          HPFREE = HPFRE0
          PERFORM SRTREL
C
        CIF
      UNTIL JCELL.EQ.25
      HPFREE = HPFRE0
C
N     READJUST RECORD LENGTH + # OF TRACKS
      LENG  = IDATA(IPPATR+2)*IDATA(IPPATR+3) + IDATA(IPPATR+1)
      NDIFF = LENG - IDATA(IPPATR)
      CALL BCHM(IPPATR,NDIFF,IRET)
C
N     CHECK IF REMAINING TRACKS WANTED
N     CALL PATREC(1) TO OBTAIN REMAINING TRACKS
      IF(IND.NE.0) CALL PATREC(1)
C
N     ELIMINATE COVERED TRACKS (ALREADY CALLED IN PATREC)
C     CALL TRHTCK(IDATA(IQPATR),IDATA(IQJHTL))
C
      RETURN
C
N     ***************************
N     *      S R T R E L        *
N     ***************************
C
N     SEARCH FOR TREL IN CELL + CALL TRACING
      PROC SRTREL
C
N       PREPAR HIT ARRAY OF CELL FOR PATREC
N       SET DRIFT SPACE BIN
        DSBIN1 = TIMDEL(1,IRING)
        DSBIN2 = TIMDEL(2,IRING)
N       START POINTER OF CELL
        IP0 = HPTSEC(ICELL)
N       END POINTER OF CELL
        IP9 = HPTSEC(ICELL+1) - 1
N       START POINTER TO HIT LABEL ARRAY -1
        IPHL = (HPTSEC(ICELL)-HPTSEC(1))/4 + IDATA(IQJHTL) + 1
N       POINTER OF NEW HIT ARRAY
        HPHT0 = HPFREE
        HLDHT = 12
        IPHT  = HPHT0
N       COUNTER FOR NUMBER OF HITS IN HIT ARRAY
        LBHITW = 0
        NWRD2 = NWORD*2
C
N       LOOP OVER ALL HITS OF CELL
        ILAY0 = -10
        MLAY  = 0
        JHIT  = 0
        FOR IP=IP0,IP9,4
          IPHL = IPHL + 1
          IF IDATA(IPHL).EQ.0
          THEN
          IF HDATA(IP+1).GT.0 .AND. HDATA(IP+2).GT.0
          THEN
            IWIR = HDATA(IP)
            IWIR = SHFTR(IWIR,3)
N           LAYER NUMBER WITHIN RING 3
            ILAYR = LAND(IWIR,15)
            LBHITW = LOR(LBHITW,MSKHIT(ILAYR+1))
N           CHANGE DRIFT SPACE BIN FOR 8 HIGHER LAYERS
            IF(ILAYR.GE.8) DSBIN1 = DSBIN2
N           DRIFT SPACE
            DS =(HDATA(IP+3)) * DSBIN1
            DS = DS
            IF DS.LT.4.0
            THEN
              IF DS.GT.DSD1
              THEN
                DS = (DSD1-DSD0)*DRV0 + (DS-DSD1)*DRV1
              ELSE
                DS = (DS-DSD0)*DRV0
              CIF
              IF(DS.LT.0.1) DS = 0.1
            CIF
N           SET ARRAY
            WRK(IPHT+ 2)  = DS
            IWRK(IPHT  ) = ILAYR
N           BACK POINTER
            IWRK(IPHT+ 1) = IP
            IWRK(IPHT+ 3) = 0
            IWRK(IPHT+ 4) = 0
            IWRK(IPHT+ 5) = 0
            IWRK(IPHT+ 6) = 0
            IWRK(IPHT+ 7) = 0
            IWRK(IPHT+ 8) = 0
            IWRK(IPHT+ 9) = 0
            IWRK(IPHT+10) = 0
            IWRK(IPHT+11) = 0
N           INCREASE POINTERS
            IPHT = IPHT + HLDHT
N           INCREASE HIT COUNTER
            JHIT = JHIT + 1
            IF(ILAYR.NE.ILAY0) MLAY = MLAY + 1
            ILAY0 = ILAYR
          CIF
          CIF
        CFOR
C
N       NUMBER OF HITS
        NHIT = JHIT
N       SET START + END POINTER IN ARRAY
        HPHT9 = IPHT - 1
        HPFREE= IPHT
        IF MLAY.GE.5
        THEN
C
N         CHECK IF AT LEAST 3 ADJACENT HITS
          LBHT = LBHITW
          LBAD = 0
          FOR I=1,14
            IF LAND(LBHT,7).EQ.7
            THEN
              LBAD = 1
              XFOR
            CIF
            LBHT = SHFTR(LBHT,1)
          CFOR
          IF LBAD.NE.0
          THEN
C
N           FIND TRACKELEMENT FROM ORIGIN IN CELL
N           AND CALL TRACE
            NTRKEL = 0
            CALL FTRELO
          CIF
        CIF
C
N       FREE AREA IN CWORK
        HPFREE = HPFRE0
      CPROC
C
N     ***************************
N     *      I N A R O U        *
N     ***************************
C
N     INITIALIZE ARRAYS IN OUTPUT AREA
      PROC INAROU
C
N       POINTER TO 'JHTL' + 'PATR'
        IPJHTL = IDATA(IQJHTL)
        IPPATR = IDATA(IQPATR)
N       GET BANK #
        NBKPAT = 10
        IF(IPPATR.GT.0) NBKPAT = IDATA(IPPATR-2) - 1
        NBKHTL = 10
        IF(IPJHTL.GT.0) NBKHTL = IDATA(IPJHTL-2) - 1
        NBNK = MIN0(10,NBKPAT,NBKHTL)
C
          IZW = NHITJC + 1
          CALL CCRE(IPJHTL,JHTL,NBNK,IZW,IERR)
          LBRHTL = 0
          IF(IERR.NE.0) LBRHTL = 1
C
N         INITIALIZE BOS BANK OF 30 TRACKS
          IZW = LTRBK*30 + LHEAD
          CALL CCRE(IPPATR,PATR,NBNK,IZW,IERR)
N         CHECK IF IERR = 0
          IF IERR.NE.0 .OR. LBRHTL.NE.0
          THEN
N           NOT ENOUGH SPACE FOR 'PATR' BANK
            WRITE(6,2993) HHEADR(17),HHEADR(18),HHEADR(19),IERR
            CALL BDLS(PATR,NBNK)
            CALL BDLS(JHTL,NBNK)
            RETURN
          CIF
          CALL BSAW(1,PATR)
          CALL BSAW(1,JHTL)
N         PRESET # OF TRACKS + LENGTH OF TRACK-VECTOR
          IDATA(IPPATR+1) = LHEAD
          IDATA(IPPATR+2) = 0
          IDATA(IPPATR+3) = LTRBK
          IDATA(IPPATR+4) = IDATA(IPJHTL-2)
          IDATA(IPPATR+5) = NHITJC
          IDATA(IPPATR+6) = NHITJC
          IDATA(IPPATR+7) = NHITJC
          IDATA(IPPATR+8) = 0
C
      CPROC
C
N     ***************************
N     *      P R C Y C P        *
N     ***************************
C
N     PREPARE CYCLIC POINTER ARRAY
      PROC PRCYCP
C
N     ADDRESS OF POINTERS TO CELLS (-1)
      IPJCA2 = IPJETC*2 + 2
N     COPY CELL POINTERS + CALC. LENGTH
      IP0 = IPJCA2 + 98
      IERRFL = 0
      IPCLL = IPJCA2
      FOR ICLL=1,96
        IPCLL = IPCLL + 1
        HPTSEC(ICLL) = HDATA(IPCLL) + IP0
        IF(HDATA(IPCLL+1).LT.HDATA(IPCLL)) IERRFL = 1
      CFOR
      HPTSEC(97) = HDATA(IPCLL+1) + IP0
      HPTSEC(98) = 0
C
      CPROC
C
N     ***************************
N     *      Z R H T L B        *
N     ***************************
C
N     ZERO HIT LABEL ARRAY OF TRACK ELEMENTS
      PROC ZRHTLB
C
      HPHL0 = HPFREE*2 - 1
      HLDHL = NHITJC*2
      HPHL9 = HPHL0 + HLDHL - 1
      NBYTHT = HLDHL*2
      ZERO = 0
      CALL SETSL(HWRK(HPHL0),0,NBYTHT,ZERO)
N     SET POINTER TO 1. FREE LOCATION IN /CWORK/
      HPFREE = HPFREE + NHITJC
C
      CPROC
C
      END
C   16/12/82 411291851  MEMBER NAME  PATRC1   (PATRECSR)    SHELTRAN
      SUBROUTINE PATRC1(IDRENT)
C
C     MAIN SUBROUTINE FOR PATREC IN JET CHAMBERS
C     PETER STEFFEN  6/ 4/79
C
      IMPLICIT INTEGER*2 (H)
      LOGICAL TBIT
C
#include "cheadr.for"
#include "cdata.for"
#include "ccycp.for"
C
#include "cworkpr.for"
#include "cworkeq.for"
C
      EQUIVALENCE
     ,           (ICELL ,IDWRK(1)),(NHIT  ,IDWRK(2)),(IRING ,IDWRK(3))
     ,         , (IERRCD,IDWRK(4)),(NTRKEL,IDWRK(5))
     ,         , (ITR   ,IDWRK(7)),(ITRNG ,IDWRK(8))
C
#include "cpatlm.for"
C
      COMMON /CLBPGM/ LBPGM(30)
      DIMENSION HEARR(30)
C
      DATA HPS /2HPS/
      DATA PATR /'PATR'/, LHEAD,LTRBK /8,48/
      DATA JHTL /'JHTL'/
      DATA JETC /'JETC'/
C
C2003 FORMAT(1H0,A4,I6,2(/,1X,24I4),/,1X,50I2,
C    ,       90(/,1X,2I6,I3,2F10.3,I3,2F10.3,1X,Z4,2I3))
C2004 FORMAT(1H0,'BACKTR:',5X,20I6)
C2005 FORMAT(1H ,12X,20I6)
C2008 FORMAT(' HIT LABEL OF TRELS:',2I6,/,(12X,20(2X,Z4)))
 2009 FORMAT('0CHANGE OF POINTERS:',10I8)
 2991 FORMAT('0/BCS/ TOO SHORT FOR TRACK BANK; EVENT:',3I6,
     ,       ', IRET=',I2,',NTR,LENGTH=',I3,1X,I4)
 2992 FORMAT('0/CWORK/ TOO SHORT FOR PATREC; EVENT:',3I6)
 2993 FORMAT('0/BCS/ TOO SHORT FOR PATREC; EVENT:',3I6,' ,IERR=',I2)
 2994 FORMAT('0WRONG POINTER IN JETC-BANK; EVENT:',3I6,' ,POINTER:',
     ,        (/,1X,24I5))
C    ,        /,(1X,24I5))
C
N     INITIALIZE # OF TRACKS
      NTR = 0
C
N     SET UP PATR-ARRAY IF NO HITS
      IPJETC = IDATA(IBLN(JETC))
      IF IPJETC.LE.0
      THEN
        IPPATR = IDATA(IBLN(PATR))
        IF IPPATR.LE.0
        THEN
          NBNK = 10
          IZW = LHEAD
          CALL CCRE(IPPATR,PATR,NBNK,IZW,IERR)
N         CHECK IF IERR = 0
          IF(IERR.NE.0) RETURN
          CALL BSAW(1,PATR)
N         PRESET # OF TRACKS + LENGTH OF TRACK-VECTOR
          IDATA(IPPATR+1) = LHEAD
          IDATA(IPPATR+3) = LTRBK
        CIF
        RETURN
      CIF
C
N     # OF HITS IN JETC
      NHITJC = HDATA(IPJETC*2+99) / 4
C
N     INITIALIZE ARRAYS IN OUTPUT AREA
      PERFORM INAROU
C
N     POINTER TO 1. FREE LOC. IN /CWORK/
      HPFREE = 1
      HPLAST = LMPATR(5)
C
N     PREPARE CYCLIC POINTER ARRAY
      PERFORM PRCYCP
N     CHECK IF POINTERS OK
      IF IERRFL.NE.0
      THEN
        I1 = IPJCA2 + 1
        I9 = I1 + 97
        WRITE(6,2994) HHEADR(17),HHEADR(18),HHEADR(19),
     ,                (HDATA(I),I=I1,I9)
        CALL BDLS(PATR,NBNK)
        CALL BDLS(JHTL,NBNK)
        RETURN
      CIF
C
N     CHECK IF ENOUGH SPACE IN /CWORK/
      IF (HPFREE+NHITJC+96*12+10*17 - 1).LT.LMPATR(5)
      THEN
N       ZERO HIT LABEL ARRAY OF TRACK ELEMENTS
        PERFORM ZRHTLB
      ELSE
        WRITE(6,2992) HHEADR(17),HHEADR(18),HHEADR(19)
        CALL BDLS(PATR,NBNK)
        CALL BDLS(JHTL,NBNK)
        RETURN
      CIF
N     MEMORIZE 1. FREE LOCATION IN CWORK
      HPFRE0 = HPFREE
C
N     INITIALISE TRKEL ARRAY FOR TRACING
      HPRO = HPS
      ITR = 1
      IRINGO = 0
C
N     LOOP OVER ALL CELLS
      JCELL=0
      REPEAT
        JCELL = JCELL + 1
N       ZERO TRACK COUNTER FOR CELL
        HNTCEL(JCELL) = ITR
N       NUMBER OF HITS IN CELL
        MHIT = (HPTSEC(JCELL+1)-HPTSEC(JCELL)) / 4
N       CHECK IF AT LEAST NHMIN HITS IN CELL
        IF MHIT.GE.5
        THEN
N         SET RING + CELL NUMBER
          IRING = 3
          IF(JCELL.LE.48) IRING = 2
          IF(JCELL.LE.24) IRING = 1
N         RESTART TRACK COUNTING WITH NEW RING
          IF IRING.NE.IRINGO
          THEN
            IRINGO = IRING
            ITRNG = 1
          CIF
          ICELL = JCELL
C
N         INITIALIZE ERR.CODE
          IERRCD = 0
C
N         SEARCH FOR TRACK ELEMENTS
          HPFREE = HPFRE0
          CALL SRTREL
C
        CIF
      UNTIL JCELL.EQ.96
      HNTCEL(97) = ITR
      HNTR = ITR - 1
C
N     PRINTOUT
C       I9 = ITR - 1
C       PRINT 2003, HPRO,HNTR,HNTCEL,((TRKAR(I1,I2),I2=1,11),I1=1,I9)
C       I0 = HPHL0
C       I9 = HPHL9
C       PRINT 2008, I0,I9,(HWRK(I1),I1=I0,I9)
C
N     CONNECT TRELS
      HPFREE = HPFRE0
N     INITIALISE DATE
C
N     BACKTRACING IF TRELS
      NTR = 0
      IF(HNTR.GT.0) CALL BACKTR(0,0)
C         PRINT 2004,NTR, (HNREL(I1),I1=1,NTR)
C         FOR ITR=1,NTR
C           NELM = HNREL(ITR)
C           PRINT 2005, (HISTR(I1,ITR),I1=1,NELM)
C         CFOR
C
N       CHECK IF ANY TRACKS
        IF NTR.GT.0
        THEN
C
N         SPACE IN BCS FOR UP TO 10 ADDITIONAL TRACKS
          LENGTR =(NTR+10)*LTRBK
          CALL BCHM(IPPATR,LENGTR,IRET)
N         CHECK IF ENOUGH SPACE AVAILABLE
          IF IRET.NE.0
          THEN
            WRITE(6,2991) HHEADR(17),HHEADR(18),HHEADR(19),
     ,                    IRET,NTR,LENGTR
            NTR = 0
            CALL BDLS(PATR,NBNK)
            CALL BDLS(JHTL,NBNK)
            RETURN
          CIF
N         CHECK IF POINTERS HAVE CHANGED
          IPJETC = IDATA(IBLN(JETC))
          IP0 = IPJETC*2 + 101
          IF IP0.NE.HPTSEC(1)
          THEN
            PRINT 2009, IPJETC,IP0,HPTSEC(1)
            PERFORM PRCYCP
          CIF
        CIF
C
      RETURN
C
N     ***************************
N     *      I N A R O U        *
N     ***************************
C
N     INITIALIZE ARRAYS IN OUTPUT AREA
      PROC INAROU
C
N       POINTER TO 'JHTL' + 'PATR'
        IPJHTL = IDATA(IBLN(JHTL))
        IPPATR = IDATA(IBLN(PATR))
N       GET BANK #
        NBKPAT = 10
        IF(IPPATR.GT.0) NBKPAT = IDATA(IPPATR-2) - 1
        NBKHTL = 10
        IF(IPJHTL.GT.0) NBKHTL = IDATA(IPJHTL-2) - 1
        NBNK = MIN0(10,NBKPAT,NBKHTL)
N       CHECK IF HIT LABEL EXISTING
        IF IPJHTL.EQ.0 .OR. IDRENT.EQ.0
        THEN
          IZW = NHITJC + 1
          CALL CCRE(IPJHTL,JHTL,NBNK,IZW,IERR)
          LBRHTL = 0
          IF(IERR.NE.0) LBRHTL = 1
        CIF
C
N       INITIALIZE BOS BANK OF TRACKS
        IF IPPATR.EQ.0 .OR. IDRENT.EQ.0
        THEN
          IZW = LHEAD
          CALL CCRE(IPPATR,PATR,NBNK,IZW,IERR)
N         CHECK IF IERR = 0
          IF IERR.NE.0 .OR. LBRHTL.NE.0
          THEN
N           NOT ENOUGH SPACE FOR 'PATR' BANK
            WRITE(6,2993) HHEADR(17),HHEADR(18),HHEADR(19),IERR
            CALL BDLS(PATR,NBNK)
            CALL BDLS(JHTL,NBNK)
            RETURN
          CIF
          CALL BSAW(1,PATR)
          CALL BSAW(1,JHTL)
N         PRESET # OF TRACKS + LENGTH OF TRACK-VECTOR
          IDATA(IPPATR+1) = LHEAD
          IDATA(IPPATR+2) = 0
          IDATA(IPPATR+3) = LTRBK
          IDATA(IPPATR+4) = IDATA(IPJHTL-2)
          IDATA(IPPATR+5) = NHITJC
          IDATA(IPPATR+6) = NHITJC
          IDATA(IPPATR+7) = NHITJC
          IDATA(IPPATR+8) = 0
N       HIT LABEL BANK EXISTS + SHALL BE EXTENDED
        ELSE
N         MOVE TRACK BANK TO END
          CALL CMVE(IPPATR,IERR)
        CIF
C
      CPROC
C
N     ***************************
N     *      P R C Y C P        *
N     ***************************
C
N     PREPARE CYCLIC POINTER ARRAY
      PROC PRCYCP
C
N     ADDRESS OF POINTERS TO CELLS (-1)
      IPJCA2 = IPJETC*2 + 2
N     COPY CELL POINTERS + CALC. LENGTH
      IP0 = IPJCA2 + 98
      IERRFL = 0
      IPCLL = IPJCA2
      FOR ICLL=1,96
        IPCLL = IPCLL + 1
        HPTSEC(ICLL) = HDATA(IPCLL) + IP0
        IF(HDATA(IPCLL+1).LT.HDATA(IPCLL)) IERRFL = 1
      CFOR
      HPTSEC(97) = HDATA(IPCLL+1) + IP0
      HPTSEC(98) = 0
C
      CPROC
C
N     ***************************
N     *      Z R H T L B        *
N     ***************************
C
N     ZERO HIT LABEL ARRAY OF TRACK ELEMENTS
      PROC ZRHTLB
C
      HPHL0 = HPFREE*2 - 1
      HLDHL = NHITJC*2
      HPHL9 = HPHL0 + HLDHL - 1
      NBYTHT = HLDHL*2
      ZERO = 0
      CALL SETSL(HWRK(HPHL0),0,NBYTHT,ZERO)
N     SET POINTER TO 1. FREE LOCATION IN /CWORK/
      HPFREE = HPFREE + NHITJC
C
      CPROC
C
      END
C   16/12/82         0  MEMBER NAME  PATRC10  (PATRECSR)    SHELTRAN
      SUBROUTINE PATRC1(IDRENT)
C
C     MAIN SUBROUTINE FOR PATREC IN JET CHAMBERS
C     PETER STEFFEN  6/ 4/79
C
      IMPLICIT INTEGER*2 (H)
      LOGICAL TBIT
C
#include "cheadr.for"
#include "cdata.for"
#include "ccycp.for"
C
#include "cworkpr.for"
#include "cworkeq.for"
C
      EQUIVALENCE
     ,           (ICELL ,IDWRK(1)),(NHIT  ,IDWRK(2)),(IRING ,IDWRK(3))
     ,         , (IERRCD,IDWRK(4)),(NTRKEL,IDWRK(5))
     ,         , (ITR   ,IDWRK(7)),(ITRNG ,IDWRK(8))
C
#include "cpatlm.for"
C
      COMMON /CLBPGM/ LBPGM(30)
      DIMENSION HEARR(30)
C
      DATA HPS /2HPS/
      DATA PATR /'PATR'/, LHEAD,LTRBK /8,48/
      DATA JHTL /'JHTL'/
      DATA JETC /'JETC'/
C
C2003 FORMAT(1H0,A4,I6,2(/,1X,24I4),/,1X,50I2,
C    ,       90(/,1X,2I6,I3,2F10.3,I3,2F10.3,1X,Z4,2I3))
C2004 FORMAT(1H0,'BACKTR:',5X,20I6)
C2005 FORMAT(1H ,12X,20I6)
C2008 FORMAT(' HIT LABEL OF TRELS:',2I6,/,(12X,20(2X,Z4)))
 2991 FORMAT('0/BCS/ TOO SHORT FOR TRACK BANK; EVENT:',3I6,
     ,       ', IRET=',I2,',NTR,LENGTH=',I3,1X,I4)
 2992 FORMAT('0/CWORK/ TOO SHORT FOR PATREC; EVENT:',3I6)
 2993 FORMAT('0/BCS/ TOO SHORT FOR PATREC; EVENT:',3I6,' ,IERR=',I2)
 2994 FORMAT('0WRONG POINTER IN JETC-BANK; EVENT:',3I6,' ,POINTER:',
     ,        /,(1X,24I5))
C
N     INITIALIZE # OF TRACKS
      NTR = 0
C
N     SET UP PATR-ARRAY IF NO HITS
      IPJETC = IDATA(IBLN(JETC))
      IF IPJETC.LE.0
      THEN
        IPPATR = IDATA(IBLN(PATR))
        IF IPPATR.LE.0
        THEN
          NBNK = 10
          IZW = LHEAD
          CALL CCRE(IPPATR,PATR,NBNK,IZW,IERR)
N         CHECK IF IERR = 0
          IF(IERR.NE.0) RETURN
          CALL BSAW(1,PATR)
N         PRESET # OF TRACKS + LENGTH OF TRACK-VECTOR
          IDATA(IPPATR+1) = LHEAD
          IDATA(IPPATR+3) = LTRBK
        CIF
        RETURN
      CIF
C
N     # OF HITS IN JETC
      NHITJC = HDATA(IPJETC*2+99) / 4
C
N     INITIALIZE ARRAYS IN OUTPUT AREA
      PERFORM INAROU
C
N     POINTER TO 1. FREE LOC. IN /CWORK/
      HPFREE = 1
      HPLAST = LMPATR(5)
C
N     PREPARE CYCLIC POINTER ARRAY
      PERFORM PRCYCP
N     CHECK IF POINTERS OK
      IF IERRFL.NE.0
      THEN
        I1 = IPJCA2 + 1
        I9 = I1 + 97
        WRITE(6,2994) HHEADR(17),HHEADR(18),HHEADR(19),
     ,                (HDATA(I),I=I1,I9)
        CALL BDLS(PATR,NBNK)
        CALL BDLS(JHTL,NBNK)
        RETURN
      CIF
C
N     CHECK IF ENOUGH SPACE IN /CWORK/
      IF (HPFREE+NHITJC+96*12+10*17 - 1).LT.LMPATR(5)
      THEN
N       ZERO HIT LABEL ARRAY OF TRACK ELEMENTS
        PERFORM ZRHTLB
      ELSE
        WRITE(6,2992) HHEADR(17),HHEADR(18),HHEADR(19)
        CALL BDLS(PATR,NBNK)
        CALL BDLS(JHTL,NBNK)
        RETURN
      CIF
N     MEMORIZE 1. FREE LOCATION IN CWORK
      HPFRE0 = HPFREE
C
N     INITIALISE TRKEL ARRAY FOR TRACING
      HPRO = HPS
      ITR = 1
      IRINGO = 0
C
N     LOOP OVER ALL CELLS
      JCELL=0
      REPEAT
        JCELL = JCELL + 1
N       ZERO TRACK COUNTER FOR CELL
        HNTCEL(JCELL) = ITR
N       NUMBER OF HITS IN CELL
        MHIT = (HPTSEC(JCELL+1)-HPTSEC(JCELL)) / 4
N       CHECK IF AT LEAST NHMIN HITS IN CELL
        IF MHIT.GE.5
        THEN
N         SET RING + CELL NUMBER
          IRING = 3
          IF(JCELL.LE.48) IRING = 2
          IF(JCELL.LE.24) IRING = 1
N         RESTART TRACK COUNTING WITH NEW RING
          IF IRING.NE.IRINGO
          THEN
            IRINGO = IRING
            ITRNG = 1
          CIF
          ICELL = JCELL
C
N         INITIALIZE ERR.CODE
          IERRCD = 0
C
N         SEARCH FOR TRACK ELEMENTS
          HPFREE = HPFRE0
          CALL SRTREL
C
        CIF
      UNTIL JCELL.EQ.96
      HNTCEL(97) = ITR
      HNTR = ITR - 1
C
N     PRINTOUT
C       I9 = ITR - 1
C       PRINT 2003, HPRO,HNTR,HNTCEL,((TRKAR(I1,I2),I2=1,11),I1=1,I9)
C       I0 = HPHL0
C       I9 = HPHL9
C       PRINT 2008, I0,I9,(HWRK(I1),I1=I0,I9)
C
N     CONNECT TRELS
      HPFREE = HPFRE0
N     INITIALISE DATE
C
N     BACKTRACING IF TRELS
      NTR = 0
      IF(HNTR.GT.0) CALL BACKTR(0,0)
C         PRINT 2004,NTR, (HNREL(I1),I1=1,NTR)
C         FOR ITR=1,NTR
C           NELM = HNREL(ITR)
C           PRINT 2005, (HISTR(I1,ITR),I1=1,NELM)
C         CFOR
C
N       SPACE IN BCS FOR UP TO 10 ADDITIONAL TRACKS
        LENGTR =(NTR+10)*LTRBK
        CALL BCHM(IPPATR,LENGTR,IRET)
N       CHECK IF ENOUGH SPACE AVAILABLE
        IF IRET.NE.0
        THEN
          WRITE(6,2991) HHEADR(17),HHEADR(18),HHEADR(19),
     ,                  IRET,NTR,LENGTR
          NTR = 0
          CALL BDLS(PATR,NBNK)
          CALL BDLS(JHTL,NBNK)
          RETURN
        CIF
N       CHECK IF POINTERS HAVE CHANGED
        IPJETC = IDATA(IBLN(JETC))
        IP0 = IPJETC*2 + 101
        IF IP0.NE.HPTSEC(1)
        THEN
      PRINT 2009, IPJETC,IP0,HPTSEC(1)
 2009 FORMAT('0CHANGE OF POINTERS:',10I8)
          PERFORM PRCYCP
        CIF
C
      RETURN
C
N     ***************************
N     *      I N A R O U        *
N     ***************************
C
N     INITIALIZE ARRAYS IN OUTPUT AREA
      PROC INAROU
C
N       POINTER TO 'JHTL' + 'PATR'
        IPJHTL = IDATA(IBLN(JHTL))
        IPPATR = IDATA(IBLN(PATR))
N       GET BANK #
        NBKPAT = 10
        IF(IPPATR.GT.0) NBKPAT = IDATA(IPPATR-2) - 1
        NBKHTL = 10
        IF(IPJHTL.GT.0) NBKHTL = IDATA(IPJHTL-2) - 1
        NBNK = MIN0(10,NBKPAT,NBKHTL)
N       CHECK IF HIT LABEL EXISTING
        IF IPJHTL.EQ.0 .OR. IDRENT.EQ.0
        THEN
          IZW = NHITJC + 1
          CALL CCRE(IPJHTL,JHTL,NBNK,IZW,IERR)
          LBRHTL = 0
          IF(IERR.NE.0) LBRHTL = 1
        CIF
C
N       INITIALIZE BOS BANK OF TRACKS
        IF IPPATR.EQ.0 .OR. IDRENT.EQ.0
        THEN
          IZW = LHEAD
          CALL CCRE(IPPATR,PATR,NBNK,IZW,IERR)
N         CHECK IF IERR = 0
          IF IERR.NE.0 .OR. LBRHTL.NE.0
          THEN
N           NOT ENOUGH SPACE FOR 'PATR' BANK
            WRITE(6,2993) HHEADR(17),HHEADR(18),HHEADR(19),IERR
            CALL BDLS(PATR,NBNK)
            CALL BDLS(JHTL,NBNK)
            RETURN
          CIF
          CALL BSAW(1,PATR)
          CALL BSAW(1,JHTL)
N         PRESET # OF TRACKS + LENGTH OF TRACK-VECTOR
          IDATA(IPPATR+1) = LHEAD
          IDATA(IPPATR+2) = 0
          IDATA(IPPATR+3) = LTRBK
          IDATA(IPPATR+4) = IDATA(IPJHTL-2)
          IDATA(IPPATR+5) = NHITJC
          IDATA(IPPATR+6) = NHITJC
          IDATA(IPPATR+7) = NHITJC
          IDATA(IPPATR+8) = 0
N       HIT LABEL BANK EXISTS + SHALL BE EXTENDED
        ELSE
N         MOVE TRACK BANK TO END
          CALL CMVE(IPPATR,IERR)
        CIF
C
      CPROC
C
N     ***************************
N     *      P R C Y C P        *
N     ***************************
C
N     PREPARE CYCLIC POINTER ARRAY
      PROC PRCYCP
C
N     ADDRESS OF POINTERS TO CELLS (-1)
      IPJCA2 = IPJETC*2 + 2
N     COPY CELL POINTERS + CALC. LENGTH
      IP0 = IPJCA2 + 98
      IERRFL = 0
      IPCLL = IPJCA2
      FOR ICLL=1,96
        IPCLL = IPCLL + 1
        HPTSEC(ICLL) = HDATA(IPCLL) + IP0
        IF(HDATA(IPCLL+1).LT.HDATA(IPCLL)) IERRFL = 1
      CFOR
      HPTSEC(97) = HDATA(IPCLL+1) + IP0
      HPTSEC(98) = 0
C
      CPROC
C
N     ***************************
N     *      Z R H T L B        *
N     ***************************
C
N     ZERO HIT LABEL ARRAY OF TRACK ELEMENTS
      PROC ZRHTLB
C
      HPHL0 = HPFREE*2 - 1
      HLDHL = NHITJC*2
      HPHL9 = HPHL0 + HLDHL - 1
      NBYTHT = HLDHL*2
      ZERO = 0
      CALL SETSL(HWRK(HPHL0),0,NBYTHT,ZERO)
N     SET POINTER TO 1. FREE LOCATION IN /CWORK/
      HPFREE = HPFREE + NHITJC
C
      CPROC
C
      END
C   08/12/80 102191200  MEMBER NAME  PATREC   (PATRECSR)    SHELTRAN
      SUBROUTINE PATREC(IDRENT)
C
C     MAIN SUBROUTINE FOR PATREC IN JET CHAMBERS
C     PETER STEFFEN  6/ 4/79
C
      IMPLICIT INTEGER*2 (H)
      LOGICAL TBIT
#include "cworkpr.for"
#include "cworkeq.for"
#include "cdata.for"
      COMMON /CHEADR/ IHEADR(54)
      DIMENSION HEARR(200)
C
N     INITIALIZE POINTERS
      DATA LBINIT /0/
      IF LBINIT .EQ. 0
      THEN
        LBINIT = 0
        IQPATR = IBLN('PATR')
        IQJHTL = IBLN('JHTL')
        IQJETC = IBLN('JETC')
        IQHEAD = IBLN('HEAD')
      CIF
C
      IPHEAD=IDATA(IQHEAD)
      IF(IPHEAD.GE.1) CALL MVCL(IHEADR(1),0,IDATA(IPHEAD-3),0,216)
C
N     PATREC UPT TO BACKTR
      CALL PATRC1(IDRENT)
C
N     CONTINUE WITH ANALYSIS
      IF NTR.GT.0
      THEN
        FOR IMO=1,NTR
          HEARR(IMO)=IMO
        CFOR
        ITRK=NTR
N       NO LIMITS IN RADIUS FOR PATROL
        NTRLM = 0
N       FIT TRACKS, FILL 'PATR', ADMINISTRATION
        CALL KNTREL(HEARR,ITRK)
C
      CIF
C
      RETURN
C
      END
C   13/01/82            MEMBER NAME  PRHTAR   (PATRECSR)    SHELTRAN
C   24/03/80 201111011  MEMBER NAME  ORPRHTAR (JADESR)      SHELTRAN
C   10/09/79 C9091001   MEMBER NAME  PRHTAR9  (JADESR)      SHELTRAN
C   13/03/79 C9062901   MEMBER NAME  ORPRHTAR (JADESR)      SHELTRAN
C   13/03/79            MEMBER NAME  PRHTARP8 (JADESR)      SHELTRAN
      SUBROUTINE PRHTAR
C
C     GENERATE ARRAY OF HITS FROM ONE CELL: P.STEFFEN(78/11/15)
C
      IMPLICIT INTEGER*2 (H)
C
#include "cdata.for"
#include "ccycp.for"
C
#include "cworkpr.for"
#include "cworkeq.for"
C
      EQUIVALENCE
     ,            (ICELL,IDWRK(1)),(NHIT,IDWRK(2)),(IRING,IDWRK(3))
C
#include "cjdrch.for"
C
N     INITIALIZE POINTERS
      DATA LBINIT /0/
      IF LBINIT .EQ. 0
      THEN
        LBINIT = 0
        IQJHTL = IBLN('JHTL')
C       CONST. FOR VAR. OF DRIFT VEL.
        DSD0   =-.63
        DSD1   = 1.8
        DSD2   = 4.0
        DRV0   = 0.8
        DRV1   = (DSD2 - (DSD1-DSD0)*DRV0) / (DSD2-DSD1)
      CIF
C
N     SET DRIFT SPACE BIN
      DSBIN1 = TIMDEL(1,IRING)
      DSBIN2 = TIMDEL(2,IRING)
N     START POINTER OF CELL
      IP0 = HPTSEC(ICELL)
N     END POINTER OF CELL
      IP9 = HPTSEC(ICELL+1) - 1
N     START POINTER TO HIT LABEL ARRAY -1
      IPHL = (HPTSEC(ICELL)-HPTSEC(1))/4 + IDATA(IQJHTL) + 1
N     POINTER OF NEW HIT ARRAY
      HPHT0 = HPFREE
      HLDHT = 12
      IPHT  = HPHT0
N     COUNTER FOR NUMBER OF HITS IN HIT ARRAY
      JHIT = 0
      NWRD2 = NWORD*2
N     LOOP OVER ALL HITS OF CELL
      FOR IP=IP0,IP9,4
        IPHL = IPHL + 1
        IF IDATA(IPHL).EQ.0
        THEN
        IF HDATA(IP+1).GT.0 .AND. HDATA(IP+2).GT.0
        THEN
          IWIR = HDATA(IP)
          IWIR = SHFTR(IWIR,3)
N         LAYER NUMBER WITHIN RING 3
          ILAYR = LAND(IWIR,15)
N         CHANGE DRIFT SPACE BIN FOR 8 HIGHER LAYERS
          IF(ILAYR.GE.8) DSBIN1 = DSBIN2
N         DRIFT SPACE
          DS =(HDATA(IP+3)) * DSBIN1
          IF DS.LT.4.0
          THEN
            IF DS.GT.DSD1
            THEN
              DS = (DSD1-DSD0)*DRV0 + (DS-DSD1)*DRV1
            ELSE
              DS = (DS-DSD0)*DRV0
            CIF
            IF(DS.LT.0.1) DS = 0.1
          CIF
N         SET ARRAY
          WRK(IPHT+2)  = AMAX1(DS,0.)
          IWRK(IPHT  ) = ILAYR
N         BACK POINTER
          IWRK(IPHT+1) = IP
          IWRK(IPHT+4) = 0
          IWRK(IPHT+5) = 0
          IWRK(IPHT+6) = 0
          IWRK(IPHT+7) = 0
N         INCREASE POINTERS
          IPHT = IPHT + HLDHT
N         INCREASE HIT COUNTER
          JHIT = JHIT + 1
        CIF
        CIF
      CFOR
C
N     NUMBER OF HITS
      NHIT = JHIT
N     SET START + END POINTER IN ARRAY
      HPHT9 = IPHT - 1
      HPFREE= IPHT
C
      RETURN
      END
C   18/01/80 102270037  MEMBER NAME  PRXYTR   (PATRECSR)    SHELTRAN
      SUBROUTINE PRXYTR
C
      IMPLICIT INTEGER*2 (H)
      LOGICAL TBIT
C
C     SUBROUTINE TO CALCULATE COORDINATES (X,Y) OF ALL TRKEL'S
C     AUTHOR: P. STEFFEN(78/11/21)
C
C     RESULTS ARE PLACED IN COMMON/CWORK/ VIZ.
C     IHIT = TOTAL NUMBER OF HITS ON TRACK
C     FIRST HIT STARTS IN LOCATION WRK(HPTE0) WHERE IPTR0 IS DEFINED
C     BY THE CALLING ROUTINE.
C
C     FOR EACH TRKEL THESE WORDS CONTAIN THE FOLLOWING INFORMATION
C
C     IWRK(IPTR   )  = CELL #
C     IWRK(IPTR+ 1)  = TRKEL #
C     IWRK(IPTR+ 2)  = # OF HITS OF TRKEL
C     WRK (IPTR+ 3)  = X COORD. AT START (L)
C     WRK (IPTR+ 4)  = Y COORD. AT START (L)
C     WRK (IPTR+ 5)  = X-DIR. AT START   (L)
C     WRK (IPTR+ 6)  = Y-DIR. AT START   (L)
C     WRK (IPTR+ 7)  = X COORD. AT START (R)
C     WRK (IPTR+ 8)  = Y COORD. AT START (R)
C     WRK (IPTR+ 9)  = X-DIR. AT START   (R)
C     WRK (IPTR+10)  = Y-DIR. AT START   (R)
C     WRK (IPTR+11)  = X COORD. AT END   (L)
C     WRK (IPTR+12)  = Y COORD. AT END   (L)
C     WRK (IPTR+13)  = X-DIR. AT END     (L)
C     WRK (IPTR+14)  = Y-DIR. AT END     (L)
C     WRK (IPTR+15)  = X COORD. AT END   (R)
C     WRK (IPTR+16)  = Y COORD. AT END   (R)
C     WRK (IPTR+17)  = X-DIR. AT END     (R)
C     WRK (IPTR+18)  = Y-DIR. AT END     (R)
C     WRK (IPTR+19)  = LABEL
C     WRK (IPTR+20)  = # OF DOWN-CONNECT.
C     WRK (IPTR+21)  = # OF UP-CONNECT.
C     WRK (IPTR+22)  = POINTER TO DOWN-CONNECT.
C     WRK (IPTR+23)  = ...
C     WRK (IPTR+24)  = ...
C     WRK (IPTR+25)  = ...
C     WRK (IPTR+26)  = POINTER TO UP-CONNECT.
C     WRK (IPTR+27)  = ...
C     WRK (IPTR+28)  = ...
C     WRK (IPTR+29)  = ...
C
C-----------------------------------------------------------------------
C
#include "cjdrch.for"
C
#include "cworkpr.for"
#include "cworkeq.for"
C
#include "cdsmax.for"
C
C
N     POINTER TO TREL + LENGTH OF VECTOR
      IPTR  = HPFREE
      HPTE0 = HPFREE
C     HLDTE = 38
N     INITIALIZE ARRAY TO ZERO
      NBYTE = HLDTE*HNTR*4
      CALL SETSL(IWRK(IPTR),0,NBYTE,0)
C     PRINT 2902, TRMATS,TRMATL
C2902 FORMAT(' LORANG:',24F5.2)
C
N     LOOP OVER ALL TREL'S
      FOR ITREL=1,HNTR
N       CELL #
        JCELL = ITRKAR(ITREL,1)
        IWRK(IPTR   ) = JCELL
        IWRK(IPTR+ 1) = ITREL
        IWRK(IPTR+ 2) = ITRKAR(ITREL, 2)
        IWRK(IPTR+19) = ITRKAR(ITREL, 9)
C
N       DIRECTIONS OF WIRE PLANE + DRIFT SPACE
C
        IF JCELL.LE.24
N       RING 1
        THEN
          JRING = 1
          DXWR=DIRWR1(JCELL  ,1)
          DYWR=DIRWR1(JCELL  ,2)
          TRLOXL=TRMATS(JCELL  ,1)
          TRLOYL=TRMATC(JCELL  ,1)
          TRLOXR=TRMATS(JCELL  ,2)
          TRLOYR=TRMATC(JCELL  ,2)
        ELSE
        IF JCELL.LE.48
N       RING2
        THEN
          JRING = 2
          DXWR=DIRWR1(JCELL-24,1)
          DYWR=DIRWR1(JCELL-24,2)
          TRLOXL=TRMATS(JCELL  ,1)
          TRLOYL=TRMATC(JCELL  ,1)
          TRLOXR=TRMATS(JCELL  ,2)
          TRLOYR=TRMATC(JCELL  ,2)
N       RING3
        ELSE
          JRING = 3
          DXWR=DIRWR3(JCELL-48,1)
          DYWR=DIRWR3(JCELL-48,2)
          TRLOXL=TRMATS(JCELL  ,1)
          TRLOYL=TRMATC(JCELL  ,1)
          TRLOXR=TRMATS(JCELL  ,2)
          TRLOYR=TRMATC(JCELL  ,2)
        CIF
        CIF
C
N       LOAD RADIUS AND WIRE SPACING
        R0 = FSENSW(JRING)
        DR0= RINCR (JRING)
N       RADIUS AROUND WIRE FOR CORR. OF DRIFTSPACE
        DRC = DR0*.5
C
N       START OF TREL
C
N       LAYER #
        ILAYR = ITRKAR(ITREL,3)
N       DRIFT SPACE
        DRSP1 = TRKAR(ITREL,4)
        DRSP2 = DRSP1 + TRKAR(ITREL,5)
N       CHECK IF SLOPE > 1. CLOSE TO ZERO
        IF DRSP1.LT.DRC .AND. ABS(DRSP2-DRSP1).GE.DRC
        THEN
N         MOVE 1. POINT 1 LAYER UP
          DWIR = ITRKAR(ITREL,6)-ILAYR
          CRV  = 0.
          IF(DWIR.GT.0.) CRV = (TRKAR(ITREL,8)-TRKAR(ITREL,5))/DWIR
          SLOPE = CRV*.5 + DRSP2-DRSP1
          DRSP1 = DRSP1 + SLOPE
          DRSP2 = CRV*.5 + SLOPE + DRSP1
          ILAYR = ILAYR + 1
        CIF
C
N       POSITION OF SENSE WIRE
        R1 = R0 + DR0*ILAYR
        R2 = R1 + DR0
        X1 = R1*DXWR
        X2 = R2*DXWR
        Y1 = R1*DYWR
        Y2 = R2*DYWR
C
N       COORDINATES
C
N       CHECK IF HIT CLOSE TO WIRE
        IF DRSP1.LT.DRC
        THEN
          SNFI = (DRSP2 - DRSP1) / DR0
          CSFI = SQRT(1.-SNFI**2)
          DRSPC = DRSP1/CSFI
          XL  = X1 + DYWR*DRSPC
          YL  = Y1 - DXWR*DRSPC
          DXL =-DXWR*CSFI - DYWR*SNFI
          DYL = DXWR*SNFI - DYWR*CSFI
          XR  = X1 - DYWR*DRSPC
          YR  = Y1 + DXWR*DRSPC
          DXR =-DXWR*CSFI + DYWR*SNFI
          DYR =-DXWR*SNFI - DYWR*CSFI
        ELSE
          YL  = Y1 - TRLOYL*DRSP1
          DYL = Y2 - TRLOYL*DRSP2 - YL
          XL  = X1 - TRLOXL*DRSP1
          DXL = X2 - TRLOXL*DRSP2 - XL
          DISTL = SQRT(DXL**2+DYL**2)
          DXL =-DXL / DISTL
          DYL =-DYL / DISTL
N         ANGULAR CORRECTION
          COSGL = -DXL*TRLOYL + DYL*TRLOXL
          DDRSP = (1./COSGL - 1.) * DRC
C     PRINT 2901, ITREL,IPTR,XL,YL,DXL,DYL,COSGL,DDRSP,TRLOXL,TRLOYL
C2901 FORMAT(' PRXYTR:',I3,I6,2F8.2,6F8.3)
          XL =-DDRSP*TRLOXL + XL
          YL =-DDRSP*TRLOYL + YL
C
          YR  = Y1 + TRLOYR*DRSP1
          DYR = Y2 + TRLOYR*DRSP2 - YR
          XR  = X1 + TRLOXR*DRSP1
          DXR = X2 + TRLOXR*DRSP2 - XR
          DISTR = SQRT(DXR**2+DYR**2)
          DXR =-DXR / DISTR
          DYR =-DYR / DISTR
N         ANGULAR CORRECTION
          COSGR = -DXR*TRLOYR + DYR*TRLOXR
          DDRSP = (1./COSGR - 1.) * DRC
C     PRINT 2901, ITREL,IPTR,XR,YR,DXR,DYR,COSGR,DDRSP,TRLOXR,TRLOYR
          XR = DDRSP*TRLOXR + XR
          YR = DDRSP*TRLOYR + YR
        CIF
C
        WRK(IPTR+ 3) = XL
        WRK(IPTR+ 4) = YL
        WRK(IPTR+ 5) = DXL
        WRK(IPTR+ 6) = DYL
        WRK(IPTR+ 7) = XR
        WRK(IPTR+ 8) = YR
        WRK(IPTR+ 9) = DXR
        WRK(IPTR+10) = DYR
C
N       END OF TREL
C
N       LAYER #
        ILAYR = ITRKAR(ITREL,6)
N       DRIFT SPACE
        DRSP1 = TRKAR(ITREL,7)
        DRSP2 = DRSP1 - TRKAR(ITREL,8)
N       CHECK IF SLOPE > 1. CLOSE TO ZERO
        IF DRSP1.LT.DRC .AND. ABS(DRSP2-DRSP1).GE.DRC
        THEN
N         MOVE LAST POINT 1 LAYER DOWN
          DWIR = ILAYR - ITRKAR(ITREL,3)
          CRV  = 0.
          IF(DWIR.GT.0.) CRV = (TRKAR(ITREL,8)-TRKAR(ITREL,5))/DWIR
          SLOPE =-CRV*.5 + DRSP1-DRSP2
          DRSP1 = DRSP1 - SLOPE
          DRSP2 = CRV*.5 - SLOPE + DRSP1
          ILAYR = ILAYR - 1
        CIF
C
N       POSITION OF SENSE WIRE
        R1 = R0 + DR0*ILAYR
        R2 = R1 - DR0
          X1 = R1*DXWR
          X2 = R2*DXWR
          Y1 = R1*DYWR
          Y2 = R2*DYWR
C
N       COORDINATES
C
N       CHECK IF HIT CLOSE TO WIRE
        IF DRSP1.LT.DRC
        THEN
          SNFI = (DRSP2 - DRSP1) / DR0
          CSFI = SQRT(1.-SNFI**2)
          DRSPC = DRSP1/CSFI
          XL  = X1 + DYWR*DRSPC
          YL  = Y1 - DXWR*DRSPC
          DXL =-DXWR*CSFI + DYWR*SNFI
          DYL =-DXWR*SNFI - DYWR*CSFI
          XR  = X1 - DYWR*DRSPC
          YR  = Y1 + DXWR*DRSPC
          DXR =-DXWR*CSFI - DYWR*SNFI
          DYR = DXWR*SNFI - DYWR*CSFI
        ELSE
          YL  = Y1 - TRLOYL*DRSP1
          DYL = Y2 - TRLOYL*DRSP2 - YL
          XL  = X1 - TRLOXL*DRSP1
          DXL = X2 - TRLOXL*DRSP2 - XL
          DISTL = SQRT(DXL**2+DYL**2)
          DXL = DXL / DISTL
          DYL = DYL / DISTL
N         ANGULAR CORRECTION
          COSGL = -DXL*TRLOYL + DYL*TRLOXL
          DDRSP = (1./COSGL - 1.) * DRC
C     PRINT 2901, ITREL,IPTR,XL,YL,DXL,DYL,COSGL,DDRSP,TRLOXL,TRLOYL
          XL =-DDRSP*TRLOXL + XL
          YL =-DDRSP*TRLOYL + YL
C
          YR  = Y1 + TRLOYR*DRSP1
          DYR = Y2 + TRLOYR*DRSP2 - YR
          XR  = X1 + TRLOXR*DRSP1
          DXR = X2 + TRLOXR*DRSP2 - XR
          DISTR = SQRT(DXR**2+DYR**2)
          DXR = DXR / DISTR
          DYR = DYR / DISTR
N         ANGULAR CORRECTION
          COSGR = -DXR*TRLOYR + DYR*TRLOXR
          DDRSP = (1./COSGR - 1.) * DRC
C     PRINT 2901, ITREL,IPTR,XR,YR,DXR,DYR,COSGR,DDRSP,TRLOXR,TRLOYR
          XR = DDRSP*TRLOXR + XR
          YR = DDRSP*TRLOYR + YR
        CIF
C
        IF TBIT(ITRKAR(ITREL,9),23)
N       ZERO CROSSING
        THEN
          WRK(IPTR+15) = XL
          WRK(IPTR+16) = YL
          WRK(IPTR+17) = DXL
          WRK(IPTR+18) = DYL
          WRK(IPTR+11) = XR
          WRK(IPTR+12) = YR
          WRK(IPTR+13) = DXR
          WRK(IPTR+14) = DYR
N       NOT ZERO CROSSING
        ELSE
          WRK(IPTR+11) = XL
          WRK(IPTR+12) = YL
          WRK(IPTR+13) = DXL
          WRK(IPTR+14) = DYL
          WRK(IPTR+15) = XR
          WRK(IPTR+16) = YR
          WRK(IPTR+17) = DXR
          WRK(IPTR+18) = DYR
        CIF
C
N       INCREASE POINTER
        IPTR = IPTR + HLDTE
      CFOR
C
N     SET POINTER TO LAST LOCATION
      HPFREE = IPTR
      HPTE9  = IPTR - 1
      RETURN
      END
C   22/01/81 102191204  MEMBER NAME  REFITO   (PATRECSR)    SHELTRAN
      SUBROUTINE REFITO(IPTR,IPJHTL,XO,YO,WGHTO)
C
C        REFIT TRACK ITRK IN 'PATR'-BANK USING ORIGIN
C        P. STEFFEN                    22/08/80
C
      IMPLICIT INTEGER*2 (H)
C
#include "cheadr.for"
      EQUIVALENCE (HHEADR(18),HRUN)
C
#include "cdata.for"
#include "ccycp.for"
C
#include "cworkpr.for"
#include "cworkeq.for"
C
      EQUIVALENCE
     ,          (HPCO0 ,HPWRK(17)),(HPCO9 ,HPWRK(18)),(HLDCO ,HPWRK(19))
     ,         ,(ICELL ,IDWRK( 1)),(MHIT  ,IDWRK( 2)),(IRING ,IDWRK( 3))
     ,         ,(IERRCD,IDWRK( 4)),(NTRKEL,IDWRK( 5))
C
#include "cpatlm.for"
C
#include "cjdrch.for"
#include "cdsmax.for"
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
      INTEGER DATE(5), IDAY /0/
      DIMENSION ITRCLL(6), NCNCK(24)
C
N     MASK FOR L/R BIT IN HIT LABEL
      INTEGER MKLRT1 /Z1000000/, MKLRT2 /Z100/
C
N     MASK FOR TRACKS AT CELL WALL
      INTEGER MKBDCL(3) /Z10,Z20,Z40/
C
C     I0 = IPTR + 1
C     I9 = IPTR + 48
C     PRINT 2001, (IDATA(I1),I1=I0,I9)
C     I0 = IPJHTL*2 + 1
C     I9 = I0 + IDATA(IPJHTL)*2 - 1
C     PRINT 2000, IPJHTL,I0,I9,(HDATA(I1),I1=I0,I9)
C     IPJETC = IDATA(IBLN('JETC'))
C     I0 = IPJETC*2 + 1
C     I9 = I0 + 109
C     PRINT 2000, IPJETC,I0,I9,(HDATA(I1),I1=I0,I9)
C2000 FORMAT('0REFIT:',3I8,/,(20(1X,Z4)))
C2001 FORMAT(1H0,2I3,I8,2(I4,3F6.1,3F6.3),
C    ,     /,14X,I3,4E13.5,F6.2,I3,4E13.5,
C    ,     /,14X,I3,2F8.3,F6.1,I3,10X,6I3,8I6,2X,Z4)
C2002 FORMAT('0FETCH:',2I3,2I5,12F9.5)
C2003 FORMAT('0ROTATION:',10F10.5)
C2004 FORMAT('0CIRC.CENTRE:',2I3, F10.5,2F10.0,F8.1,2F8.1)
C2005 FORMAT('0TRACK:',I6,/,(1X,3I6,4F8.1,I4,F6.2,2I4,F8.3,I6,F8.1))
C2006 FORMAT(1X,I6,5F8.2,F12.1,5F8.2)
C2007 FORMAT(' FETCH:',I3,9F8.4,F10.5,F6.0)
C2008 FORMAT(' FIT:',2I3,F8.2,F5.0,F10.6,F7.3,F5.1,F6.3,F5.1)
C2009 FORMAT(' JHTL:',I8,1X,Z8,3I5)
C2011 FORMAT('0ABERR:',10F10.6)
C2010 FORMAT(' HIT:',I6,12F8.2)
C2014 FORMAT('0FIT-BANK:',5F8.3,5X,5F8.3,5X,F8.5,2F8.1)
C2016 FORMAT('0ITRCLL =',6I8,/,(9X,6F8.3))
C2107 FORMAT(' SIGLM:',10F8.3)
C
N     INITIALIZATION
      DATA LBINIT /0/
      IF LBINIT .EQ. 0
      THEN
        LBINIT = 1
        PERFORM INIT
      CIF
C
N     RESERVE SPACE IN CWORK
      HPFREE = 1
      HPFRE1 = HPFREE
      HPCO0  = HPFREE
      HLDCO  = 14
      HPFREE = HLDCO*100 + HPCO0
      HPCO9 = HPFREE - 1
C
N     GET RUN #
      IPHEAD = IDATA(IQHEAD)*2
      NRUN = HDATA(IPHEAD+10)
C
N     COPY TRACK BANK
      HPTR0 = HPFREE
      CALL MVC(IWRK(HPTR0),0,IDATA(IPTR+1),0,192)
C
N     TRACK #
      ITRK = IDATA(IPTR+1)
C
N     CENTRE OF CIRCLE (USED FOR ANGULAR CORRECTION)
      IF IDATA(IPTR+18).EQ.1
      THEN
N       CIRCLE PARAMETERS
        ALFA  = ADATA(IPTR+21)
        CRV   = ADATA(IPTR+19)
        IF(ABS(CRV).LT.1.E-8) CRV = SIGN(1.E-8,CRV)
        RAD   =  1./CRV + ADATA(IPTR+20)
        XCIRC = COS(ALFA) * RAD
        YCIRC = SIN(ALFA) * RAD
        CHARGE = SIGN(1.,ADATA(IPTR+25))
      ELSE
N       PARABOLA PARAMETERS
        CRV   = ADATA(IPTR+22)*2.
        IF(ABS(CRV).LT.1.E-8) CRV = SIGN(1.E-8,CRV)
        ALFA  = ADATA(IPTR+19)
        XCIRC =-SIN(ALFA)/CRV + ADATA(IPTR+20)
        YCIRC = COS(ALFA)/CRV + ADATA(IPTR+21)
        CHARGE =-SIGN(1.,ADATA(IPTR+22))
      CIF
      ZVERT = ADATA(IPTR+31)
      ZSLOP = ADATA(IPTR+30)
      COSTHI = SQRT(ZSLOP**2 + 1.)
C     PRINT 2004,ITRK,IDATA(IPTR+18),ALFA,XCIRC,YCIRC,ZVERT,ZSLOP,COSTHI
C     PRINT 2011,ABERR
C
N     ROTATION ANGLE (USING LAST POINT OF TRACK)
      XX    = ADATA(IPTR+12)
      YY    = ADATA(IPTR+13)
      RR    = SQRT(XX**2+YY**2)
      CSROT = XX / RR
      SNROT = YY / RR
      X0   = XO*CSROT + YO*SNROT
      Y0   =-XO*SNROT + YO*CSROT
      WGHT0 = AMIN1(WGHTO,1.0)
      WGHT0 = AMAX1(WGHTO,0.0)
C     PRINT 2003, CSROT,SNROT,XX,YY,X0,Y0,WGHT0
C
N     FILL CELL ARRAY
      PERFORM SELCLL
C
N     LOOP OVER ALL CELLS + FETCH HITS
      KCLL = 0
      NHIT = 0
      IPCO = HPCO0
C
N     LOOP OVER RINGS
      JRING = 0
N     INITIALIZE LABEL FOR DEAD CELLS +
N     TRACKS AT CELL WALLS
      LBCELL = 0
      REPEAT
      JRING = JRING + 1
        NHRNG = 0
        NCLL = 0
        REPEAT
        NCLL = NCLL + 1
        KCLL = KCLL + 1
          JCELL = ITRCLL(KCLL)
          IF JCELL.NE.0
          THEN
            PERFORM FETCH
            NHRNG = NHRNG + JHIT
          CIF
        UNTIL NCLL.EQ.2
N       SET LABEL FOR TRACK AT CELL BOUND.
        IF(JCELL.NE.0) LBCELL = LOR(MKBDCL(JRING),LBCELL)
      UNTIL KCLL.EQ.6
      HPCO9 = IPCO - 1
C     PRINT 2005, LBCELL,(WRK(I),I=HPCO0,HPCO9)
C
N     1. PARABOLA FIT
N     LAST RING INCLUDED IN FIT
      JRINGL = 3
      PERFORM FPARA0
C
N     RELABEL HITS
      ALBLM1 = 0.6
      ALBLM2 = 3.0
      PERFORM LABEL
C     PRINT 2005, LBCELL,(WRK(I),I=HPCO0,HPCO9)
C
N     REFIT PARABOLA
      PERFORM FPARA0
C
N     RELABEL HITS
      PERFORM LABEL
C     PRINT 2005, LBCELL,(WRK(I),I=HPCO0,HPCO9)
C
N     SET UP FIT-BANK
      PERFORM FITBNK
C
N     CHECK IF BAD FIT AND LOW MOMENTUM
      IF ABS(PAR1).GT..00030 .AND. SIG.GT..06
      THEN
        IF SIG.GT..10 .OR. IDATA(IPTR+24)-INT(S0).GT.8
        THEN
          ALBLM1 = 1.5
          ALBLM2 = 3.0
          PERFORM LABEL
          JRINGL = 2
          PERFORM FPARA0
          ALBLM1 = 0.6
          PERFORM LABEL
          PERFORM FPARA0
          PERFORM LABEL
          IF SIG.LT..10
          THEN
            PERFORM FITBK1
          CIF
        CIF
      CIF
C
      HPFREE = HPFRE1
      RETURN
C
N     *************************
N     *      F P A R A 0      *
N     *************************
C
C
N     PARABOLA FIT THROUG ORIGIN
      PROC FPARA0
C
N     GET EQUATIONS
N     WEIGHT ORIGIN AS POINT OF PARABOLA
      S0 = WGHT0
      S1 = 0.
      S2 = 0.
      S3 = 0.
      S4 = 0.
      S5 = 0.
      S6 = 0.
      S7 = Y0 * WGHT0
      IPCO = HPCO0
      REPEAT
       IF IWRK(IPCO+ 7).EQ.0 .AND. IWRK(IPCO+12).LE.JRINGL
       THEN
          X = WRK(IPCO+3)
          Y = WRK(IPCO+4)
          X2 = X**2
          S1 = S1 + X
          S2 = S2 + X2
          S3 = S3 + X*X2
          S4 = S4 + X2**2
          S5 = S5 + Y*X2
          S6 = S6 + Y*X
          S7 = S7 + Y
          S0 = S0 + 1.
        CIF
      IPCO = IPCO + HLDCO
      UNTIL IPCO.GT.HPCO9
      IF S0.LT.2.5
      THEN
        SIG = 1000.
      ELSE
C
N       SOLVE EQUATIONS FOR PARABOLA FIT
        F1 = 1. / S4
        XX12 = S3*F1
        XX13 = S2*F1
        YY1  = S5*F1
        XX22 = S2 - S3*XX12
        XX23 = S1 - S3*XX13
        YY2  = S6 - S3*YY1
        XX32 = S1 - S2*XX12
        XX33 = S0 - S2*XX13
        YY3  = S7 - S2*YY1
        IF XX22.GT.XX32
        THEN
          XX23 = XX23 / XX22
          YY2  = YY2  / XX22
          PAR3 = (YY3 - XX32*YY2) / (XX33 - XX32*XX23)
          PAR2 = YY2 - XX23*PAR3
        ELSE
          XX33 = XX33 / XX32
          YY3  = YY3  / XX32
          PAR3 = (YY2 - XX22*YY3) / (XX23 - XX22*XX33)
          PAR2 = YY3 - XX33*PAR3
        CIF
        PAR1 = YY1 - XX12*PAR2 - XX13*PAR3
        DEG = S0 - WGHT0 - 2.
C
C
N       CALC. CHISQ + SOLVE L/R AMBIGUITY
        CHISQ = 0.
        DCHIM1 = 0.
        IHITM1 = 0
        IHSTRT = 0
        IPCO = HPCO0
        REPEAT
         IF IWRK(IPCO+ 7).EQ.0 .AND. IWRK(IPCO+12).LE.JRINGL
         THEN
            IF(IHSTRT.EQ.0) IHSTRT = IPCO
            IHEND = IPCO
            X = WRK(IPCO+3)
            Y = WRK(IPCO+4)
            F = (PAR1 *X + PAR2 )*X + PAR3
            DCHI = Y - F
            WRK(IPCO+13) = DCHI
N           SUM FOR RMS
            CHISQ = CHISQ + DCHI**2
N           KEEP BIGGEST RMS
C           IF ABS(DCHI).GE.DCHIM1
C           THEN
C             DCHIM1 = ABS(DCHI)
C             IHITM1 = IPCO
C           CIF
C     PRINT 2006, IPCO,X,Y,F,DCHI,CHISQ
          CIF
        IPCO = IPCO + HLDCO
        UNTIL IPCO.GT.HPCO9
        SIG    =      CHISQ  / DEG
C     PRINT 2008, JRINGL,IWRK(IHEND),SIG,DEG,PAR1,PAR2,PAR3,
C    ,            WGHT0,Y0
C
N       SET LIMIT FOR SIGMA
        SIGLM = TRELLM(16)**2
      CIF
C
      CPROC
C
N     *************************
N     *      S E L C L L      *
N     *************************
C
C
N     SELECT CELLS CONTAINING TRACK
      PROC SELCLL
C
        FOR I=1,6
          ITRCLL(I) = 0
        CFOR
        IPC0 = IPTR + 34
        IPC9 = IPC0 +  5
        ICELL = 0
        FOR IPC = IPC0,IPC9
          JCELL = IDATA(IPC)
          IF JCELL.GT. 0 .AND. JCELL.LE.96
          THEN
            JRING = 1
            IF(JCELL.GT.24) JRING = 2
            IF(JCELL.GT.48) JRING = 3
            JPC = JRING*2 - 1
            IF ITRCLL(JPC).EQ.0
            THEN
              ITRCLL(JPC) = JCELL
            ELSE
              IF(ITRCLL(JPC).NE.JCELL) ITRCLL(JPC+1) = JCELL
            CIF
            ICELL = JCELL
            IRING = JRING
          CIF
        CFOR
C
C     PRINT 2016, ITRCLL
      CPROC
C
N     *************************
N     *      F E T C H        *
N     *************************
C
C
N     FETCH HITS IN CELL
      PROC FETCH
C
N       DIR. OF SENSEW. + DRIFTSP.
        IF JRING.NE.3
        THEN
          IC1 = JCELL
          IF(IC1.GT.24) IC1 = IC1 - 24
          CSROT0 = DIRWR1(IC1,1)
          SNROT0 = DIRWR1(IC1,2)
        ELSE
          IC1 = JCELL - 48
          CSROT0 = DIRWR3(IC1,1)
          SNROT0 = DIRWR3(IC1,2)
        CIF
        DRICS  = TRMATC(JCELL,2)
        DRISN  = TRMATS(JCELL,2)
        DRITG  = DRISN/DRICS
        DRISNF = DRISN * .05
C
N       LOAD RADIUS AND WIRE SPACING
        R0 = FSENSW(JRING)
        DR = RINCR (JRING)
C
N       ANGLE OF TRACK IN RING
        R1   = DR*7.5 + R0
        DX   = R1 * CSROT0 - XCIRC
        DY   = R1 * SNROT0 - YCIRC
        RR   = SQRT(DX**2 + DY**2) * CHARGE
        CSB  = DX / RR
        SNB  = DY / RR
        TGB  = CSB/SNB
C
N       SET DRIFT SPACE BIN
        DSBIN1 = DRIVEL(JCELL,1)
        IF(NRUN.GT.100) DS0 = T0FIX(JRING)*DSBIN1*64.
        IF(NRUN.LE.100) DS0 = DSBIN1*.5
N       ANGLE(TRACK,DRIFT DIRECT.)
        TANBET = ABS((TGB-DRITG)/(TGB*DRITG+1.))
C     PRINT 2007, JCELL,CSROT0,SNROT0,DRICS,DRISN,CSB,SNB,CHARGE,TANBET,
C    ,            DSBIN1,DS0
N       CORRECTION CONSTANTS FOR JCELL
        CCST01 = DELTA0(JCELL,1)*TANBET
        CCST02 = DELTA0(JCELL,2)*TANBET
        CCST11 = DELTA1(JCELL,1)
        CCST12 = DELTA1(JCELL,2)
        CCST21 = DELTA2(JCELL,1)
        CCST22 = DELTA2(JCELL,2)
        CCST51 = DELTA5(JCELL,1) * 10.
        CCST52 = DELTA5(JCELL,2) / 121.15
        CCST61 = DELTA6(JCELL,1) * 10.
        CCST62 = DELTA6(JCELL,2) / 121.15
C     PRINT 2002, JRING,JCELL,IP,IP9,CCST01,CCST02,CCST11,CCST12,
C    ,            CCST21,CCST22,CCST51,CCST52,CCST61,CCST62
N       COUNTER FOR NUMBER OF HITS FOUND
        JHIT = 0
        NHIT   = 0
        NHGOOD = 0
N       PRESET LAST LAYER
        ILAYL =-99
N       LOOP OVER ALL HITS OF CELL
        IPCO = IPCO - HLDCO
        IPJETC = IDATA(IQJETC)*2
        IP0    = IPJETC + 100
        IPCLL  = IPJETC + 2 + JCELL
        IP     = HDATA(IPCLL  ) + IP0
        IP9    = HDATA(IPCLL+1) + IP0
        IPHL   = IPJHTL + 2 + HDATA(IPCLL)/4
C     PRINT 2002, JRING,JCELL,IP,IP9,TGB,SNB,CSB,DRISN,DRICS
        WHILE IP.LT.IP9
C
N         CHECK TRACK # OF HIT LABEL
          LB   = IDATA(IPHL)
          ITR1 = LAND(SHFTR(LB,17),127)
          ITR2 = LAND(SHFTR(LB, 1),127)
C     PRINT 2009, IPHL,LB,ITR1,ITR2,ITRK
          IF ITR1.EQ.ITRK .OR. ITR2.EQ.ITRK
          THEN
C
N           L/R FROM HIT LABEL
            LBLR = 0
            IF(ITR1.EQ.ITRK) LBLR = LAND(LB,MKLRT1)
            IF(ITR2.EQ.ITRK) LBLR = LAND(LB,MKLRT2)
            LBSIDE =-1
            IF(LBLR.NE.0) LBSIDE = 1
            LBLR = LBSIDE
C
            IWIR = HDATA(IP)
            IWIR = SHFTR(IWIR,3)
N           LAYER NUMBER WITHIN RING 3
            ILAY = LAND(IWIR,15)
N           DRIFT SPACE
            DS =(HDATA(IP+3)) * DSBIN1
      DATA NPRHT /0/
      NPRHT = NPRHT + 1
C     IF(NPRHT.LE.25) PRINT 2019, IWIR,ILAY,JCELL,HDATA(IP+3),DS,DSBIN1
C2019 FORMAT(' HIT ',4I6,F6.1)
            X1   = ILAY * DR + R0
            Z1   = X1*ZSLOP + ZVERT
N           CORRECTION FOR TOF + PROPAG. ALONG WIRE
            DDS = (1222.9-ABS(Z1))*ABERR(1) + ABERR(6)*R1*COSTHI
            DSC = DS - DDS + DS0
            Y1   = SWDEPL
            IF(LAND(ILAY,1).NE.0) Y1 =-Y1
            Y1   = (7-ILAY)*(CCST52*Z1+CCST51) - CCST62*Z1-CCST61 + Y1
            X    = X1*CSROT0 - Y1*SNROT0
            Y    = X1*SNROT0 + Y1*CSROT0
            IF DS.LE.DRC
            THEN
              IF DS.LT.4.0
              THEN
                IF DS.GT.DSD1
                THEN
                  DSC = (DSD1-DSD0)*DRV0 + (DS-DSD1)*DRV1
                ELSE
                  DSC = (DS-DSD0)*DRV0
                CIF
                IF(DSC.LT.0.1) DSC = 0.1
              CIF
              DXR  = DSC * CSB
              DYR  = DSC * SNB
              DXL =-DXR
              DYL =-DYR
            ELSE
C
N             EDGE WIRE FIELD DISTORTION
              IF ILAY.LT. 3
              THEN
                DILAY =-(ILAY- 3)**2
                DSCL  = (DILAY*CCST11 + 1.) * DSC
                DSCR  = (DILAY*CCST12 + 1.) * DSC
              ELSE
              IF ILAY.GT.12
              THEN
                DILAY =-(ILAY-12)**2
                DSCL  = (DILAY*CCST21 + 1.) * DSC
                DSCR  = (DILAY*CCST22 + 1.) * DSC
              ELSE
                DSCL = DSC
                DSCR = DSC
              CIF
              CIF
C
N             FIELD DISTORTIONS AT LARGE DRIFT TIMES
              IF DSC.GT.ABERR(7)
              THEN
                DWIR  = ILAY - 7.5
                DWIRC = DSC*DRISNF
                DWIRL = DWIR + DWIRC
                DWIRR = DWIR - DWIRC
                DSCL  = (DSCL-ABERR(7))*DWIRL*CCST01 + DSCL
                DSCR  =-(DSCR-ABERR(7))*DWIRR*CCST02 + DSCR
              CIF
              DXR  = (DSCR-DRC)*DRISN + DRC*CSB
              DYR  = (DSCR-DRC)*DRICS + DRC*SNB
              DXL  =-(DSCL-DRC)*DRISN - DRC*CSB
              DYL  =-(DSCL-DRC)*DRICS - DRC*SNB
            CIF
C     PRINT 2010, ILAY,DS,DSC,DSCL,DSCR,XL,XR,X,Y,DXL,DXR,DYL,DYR
            XL   = DXL + X
            YL   = DYL + Y
            XXL  = XL*CSROT + YL*SNROT
            YYL  =-XL*SNROT + YL*CSROT
            XR   = DXR + X
            YR   = DYR + Y
            XXR  = XR*CSROT + YR*SNROT
            YYR  =-XR*SNROT + YR*CSROT
N           SET ARRAY
C     PRINT 2010, ILAY,DS,XXL,YYL,X1,Z1,XXR,YYR,Y1
C
N           CHECK IF LEFT + RIGHT SOLUTION POSSIBLE
            NLRSOL = 1
            IF(DS.LT.2.0) NLRSOL = 2
C
N           LOOP OVER LEFT +/OR RIGHT SOLUTION
            ILRSOL = 0
            REPEAT
            ILRSOL = ILRSOL + 1
C
N             SELECT SIDE
              IF NLRSOL.EQ.1 .AND. LBSIDE.LT.0  .OR.
     ?           NLRSOL.EQ.2 .AND. ILRSOL.EQ.1
              THEN
N               LEFT SIDE
                LBSIDE =-1
                XX  = XXL
                YY  = YYL
              ELSE
N               RIGHT SIDE
                LBSIDE = 1
                XX  = XXR
                YY  = YYR
              CIF
C
N             HIT QUALITY:
              LBGOOD = 0
              IF(LBSIDE.NE.LBLR) LBGOOD = 1
N             NEW LAYER?
              IF ILAY.NE.ILAYL .OR. LBGDL.LE.1.AND.LBGOOD.LE.1
              THEN
                LBREG = 1
N               INCREASE HIT COUNTER
                JHIT = JHIT + 1
                IPCO = IPCO + HLDCO
              ELSE
N               2 HITS IN SAME LAYER, SELECT CLOSEST
                LBREG = 0
                IF(LBGOOD.LT.IWRK(IPCO+7)) LBREG = 1
              CIF
N             REGISTER NEW HIT?
              IF LBREG.NE.0
              THEN
                NHIT   = NHIT   + 1
                IF(LBGOOD.LE.1) NHGOOD = NHGOOD + 1
                IWRK(IPCO   ) = ILAY
                IWRK(IPCO+ 1) = IP
                IWRK(IPCO+ 2) = LBSIDE
                WRK (IPCO+ 3) = XX
                WRK (IPCO+ 4) = YY
                WRK (IPCO+ 5) = 0.
                WRK (IPCO+ 6) = 0.
                IWRK(IPCO+ 7) = LBGOOD
                WRK (IPCO+ 8) = DS
                IWRK(IPCO+ 9) = JCELL
                IWRK(IPCO+10) = LBGOOD
                WRK (IPCO+11) = TGB
                IWRK(IPCO+12) = JRING
                WRK (IPCO+13) = 0.
                ILAYL = ILAY
                LBGDL = LBGOOD
              CIF
C
            UNTIL ILRSOL.GE.NLRSOL
C
          CIF
C
        IPHL = IPHL + 1
        IP   = IP   + 4
        CWHILE
N       SET IPCO TO 1. FREE LOCATION
        IPCO = IPCO + HLDCO
C
N       SET LABEL FOR DEAD CELL
        IF NHIT.LE.2
        THEN
          REPEAT
            IF JCELL.EQ.17
            THEN
              IF NRUN.GE.539
              THEN
                LBCELL = LOR(LBCELL,1)
                JHIT = 16
                NHIT = 16
              CIF
              XREPEAT
            CIF
            IF JCELL.EQ.37
            THEN
              IF NRUN.GE.2303
              THEN
                LBCELL = LOR(LBCELL,2)
                JHIT = 16
                NHIT = 16
              CIF
              XREPEAT
            CIF
            IF JCELL.EQ.65 .OR. JCELL.EQ.66 .OR.
     ?         JCELL.EQ.81 .OR. JCELL.EQ.82
            THEN
              IF NRUN.GE.2783
              THEN
                LBCELL = LOR(LBCELL,4)
                JHIT = 16
                NHIT = 16
              CIF
              XREPEAT
            CIF
C
          UNTIL .TRUE.
C
        CIF
C
      CPROC
C
N     *************************
N     *      F I T B N K      *
N     *************************
C
C
N     SET UP FIT-BANK
      PROC FITBNK
C
N     START + END POINTS
      XST  = WRK(IHSTRT+ 3)
      YST  = WRK(IHSTRT+ 4)
      XEN  = WRK(IHEND + 3)
      YEN  = WRK(IHEND + 4)
N     DIRECTION AT START + END POINT
      TGST = PAR1*XST*2 + PAR2
      DXST = 1./SQRT(TGST**2+1.)
      DYST = DXST * TGST
      TGEN = PAR1*XEN*2 + PAR2
      DXEN = 1./SQRT(TGEN**2+1.)
      DYEN = DXEN * TGEN
N     MIN. OF PARABOLA
      XMIN = -PAR2*.5 / PAR1
      YMIN = (PAR1*XMIN + PAR2)*XMIN + PAR3
N     CURVATURE
      CURV =-PAR1 * 2.
C
N     USE ZFIT RESULTS FROM PATR-BANK
      ZV0  = ADATA(IPTR+31)
      TGTH = ADATA(IPTR+30)
      CSTH = 1./SQRT(TGTH**2+1.)
      SNTH = CSTH * TGTH
C
C     PRINT 2014, XST,YST,DXST,DYST,TGST,XEN,YEN,DXEN,DYEN,TGEN,CURV,
C    ,            XMIN,YMIN
C
N     FILL FIT-BANK
      IP    = HPTR0 - 1
      IWRK(IP+ 1) = ITRK
      IWRK(IP+ 2) = 32
      IWRK(IP+ 3) = IDAY
      IWRK(IP+ 4) = 8
      WRK (IP+ 5) = XST *CSROT - YST *SNROT
      WRK (IP+ 6) = XST *SNROT + YST *CSROT
      WRK (IP+ 7) = SQRT(WRK(IP+ 5)**2 + WRK(IP+ 6)**2) * TGTH + ZV0
      WRK (IP+ 8) = (DXST*CSROT - DYST*SNROT)*CSTH
      WRK (IP+ 9) = (DXST*SNROT + DYST*CSROT)*CSTH
      WRK (IP+10) = SNTH
      IWRK(IP+11) = 0
      WRK (IP+12) = XEN *CSROT - YEN *SNROT
      WRK (IP+13) = XEN *SNROT + YEN *CSROT
      WRK (IP+14) = SQRT(WRK(IP+12)**2 + WRK(IP+13)**2) * TGTH + ZV0
      WRK (IP+15) = (DXEN*CSROT - DYEN*SNROT)*CSTH
      WRK (IP+16) = (DXEN*SNROT + DYEN*CSROT)*CSTH
      WRK (IP+17) = SNTH
      IWRK(IP+18) = 2
      WRK (IP+19) = ATAN2(SNROT,CSROT)
      WRK (IP+20) = XMIN*CSROT - YMIN*SNROT
      WRK (IP+21) = XMIN*SNROT + YMIN*CSROT
      WRK (IP+22) = PAR1
      WRK (IP+23) = SQRT(SIG)
      IWRK(IP+24) = S0 + .001
      WRK (IP+25) = CURV
      WRK (IP+26) = 0.
      WRK (IP+27) = CURV
      WRK (IP+28) = CURV
      I0 = IP+ 1
      I9 = IP+28
C     PRINT 2001,(WRK(I1),I1=I0,I9)
      CPROC
C
N     *************************
N     *      F I T B K 1      *
N     *************************
C
C
N     CHANGE FIT BANK (1.POINT)
      PROC FITBK1
C
N     START POINT
      XST  = WRK(IHSTRT+ 3)
      YST  = WRK(IHSTRT+ 4)
N     DIRECTION AT START POINT
      TGST = PAR1*XST*2 + PAR2
      DXST = 1./SQRT(TGST**2+1.)
      DYST = DXST * TGST
N     MIN. OF PARABOLA
      XMIN = -PAR2*.5 / PAR1
      YMIN = (PAR1*XMIN + PAR2)*XMIN + PAR3
N     CURVATURE
      CURV =-PAR1 * 2.
C
N     USE ZFIT RESULTS FROM PATR-BANK
      ZV0  = ADATA(IPTR+31)
      TGTH = ADATA(IPTR+30)
      CSTH = 1./SQRT(TGTH**2+1.)
      SNTH = CSTH * TGTH
C
C     PRINT 2014, XST,YST,DXST,DYST,TGST,XEN,YEN,DXEN,DYEN,TGEN,CURV,
C    ,            XMIN,YMIN
C
N     FILL FIT-BANK
      IP    = HPTR0 - 1
      IWRK(IP+ 4) = 16
      WRK (IP+ 5) = XST *CSROT - YST *SNROT
      WRK (IP+ 6) = XST *SNROT + YST *CSROT
      WRK (IP+ 7) = SQRT(WRK(IP+ 5)**2 + WRK(IP+ 6)**2) * TGTH + ZV0
      WRK (IP+ 8) = (DXST*CSROT - DYST*SNROT)*CSTH
      WRK (IP+ 9) = (DXST*SNROT + DYST*CSROT)*CSTH
      WRK (IP+10) = SNTH
      IWRK(IP+18) = 2
      WRK (IP+19) = ATAN2(SNROT,CSROT)
      WRK (IP+20) = XMIN*CSROT - YMIN*SNROT
      WRK (IP+21) = XMIN*SNROT + YMIN*CSROT
      WRK (IP+22) = PAR1
      WRK (IP+23) = SQRT(SIG)
      IWRK(IP+24) = S0 + .001
      WRK (IP+25) = CURV
      WRK (IP+26) = 0.
      WRK (IP+27) = CURV
      WRK (IP+28) = CURV
      I0 = IP+ 1
      I9 = IP+28
C     PRINT 2001,(WRK(I1),I1=I0,I9)
      CPROC
C
C
N     *************************
N     *      L A B E L        *
N     *************************
C
C
N     LABEL USED HITS
      PROC LABEL
C
N       PRESET LAST HIT POINTER
        IWL = -999
        FOR IP = HPCO0,HPCO9,HLDCO
          IW0 = IWRK(IP)
          X   = WRK(IP+3)
          Y   = WRK(IP+4)
          F   = (PAR1*X + PAR2)*X + PAR3
          DF  = F - Y
N         SELECT CLOSEST HIT
          LBGOOD = 4
          IF(ABS(DF).LT.ALBLM2) LBGOOD = 1
          IF(ABS(DF).LT.ALBLM1) LBGOOD = 0
          IWRK(IP+ 7) = LBGOOD
          WRK (IP+13) = DF
C
N         CHECK IF 2 HITS FROM SAME WIRE
          IF IWL.EQ.IW0
          THEN
N           SELECT CLOSEST HIT
            IF ABS(DFL).LT.ABS(DF)
            THEN
              IWRK(IP +7) = 16
            ELSE
              IWRK(IPL+7) = 16
            CIF
          CIF
N         STORE LAST POINTERS + DF
          IWL = IW0
          IPL = IP
          DFL = DF
        CFOR
C
      CPROC
C
C
N     *************************
N     *      I N I T          *
N     *************************
C
C
N     INITIALIZE CONSTANTS
      PROC INIT
C
        IQJETC = IBLN('JETC')
        IQHEAD = IBLN('HEAD')
C
        IWRK(IP+ 3) = IDAY
        CALL DAY2(DATE)
        IDAY = DATE(1)*1000 + DATE(2)
C
N       RADIUS AROUND WIRE FOR CORR. OF DRIFTSPACE
        DRC = RINCR(1)*.5 * DRICOS
C       CONST. FOR VAR. OF DRIFT VEL.
        IF NRUN.LE.100
        THEN
          DSD0   = .0
          DSD1   = 5.0
          DSD2   = 5.0
          DRV0   = 1.0
          DRV1   = 1.0
        ELSE
          DSD0   =-.63
          DSD1   = 1.8
          DSD2   = 4.0
          DRV0   = 0.8
          DRV1   = (DSD2 - (DSD1-DSD0)*DRV0) / (DSD2-DSD1)
        CIF
      CPROC
C
      END
C   20/02/81 107101015  MEMBER NAME  RINCON1  (PATRECSR)    SHELTRAN
      SUBROUTINE RINCON
C
C     BACKTRACING VERSION 5 (MAR 2,79)
C     THIS SUBROUTINE IS CALLED BY BACKTR TO
C     JOIN TRACK ELEMENTS ACROSS RING BOUNDARIES
C
      IMPLICIT INTEGER*2 (H)
C
C
#include "cjdrch.for"
#include "cworkmx.for"
#include "cworkpr.for"
#include "cdsmax.for"
#include "cpatlm.for"
      DIMENSION LSTCL(3),LFTCL(3),NCELL(3),TANDEL(3)
      EQUIVALENCE (IBCK(1),LSTCL(1)),(IBCK(4),LFTCL(1))
      EQUIVALENCE (IBCK(7),NCELL(1)),(DBCK(1),TANDEL(1))
      DIMENSION HTEMP(9)
      DATA MSKCR1,MSKCR2,MSKERR,MSKLR0 /Z100,Z200,Z4000,Z1000/
      DATA MSKFIT,MSKAIT /Z20000,ZFFFDFFFF/
N     PERFORM ONCE FOR LR AMBIGUITY AS GIVEN IN MIDOUT
N     IF THIS IS NOT SUCCESSFUL WE WILL TRY AGAIN WITH LR=-LR
      FOR II=1,2
      IRL=0
N     PUT CELL NUMBER OF CANDIDATE TRACK IN ICX
      PERFORM FNDCEL
N     ELEMENTS IN THIS CELL ?
      IF HNTCEL(ICX+1) - HNTCEL(ICX).GT.0
      THEN
N     NUMBER OF ELEMENTS
      NTRLX1 = HNTCEL(ICX)
      NTRLX2 = HNTCEL(ICX+1)-1
C     PRINT 2222,ICX,NTRLX1,NTRLX2
C2222 FORMAT(' TRY RING CON    CELL=',I4,' TRACKS=',2I4)
N     NEW RING NUMBER
      KRING = LRING - 1
N     INITIALIZE FOR USE IN CASE THERE IS MORE THAN ONE MATCH
N     INITIALIZE CORNER FLAG
      LRCORN=0
N     LOOP OVER ELEMENTS IN NEW CELL
      FOR KX = NTRLX1,NTRLX2
N     HAS THIS TRACK BEEN USED YET?
      IF HUSE(KX).EQ.0
      THEN
N     MATCHING FROM RING 3 AND FROM RING 2 MUST BE HANDLED DIFFERENTLY
      IF KRING.EQ.2
      THEN
      PERFORM MATCH1
N     FOR MATCHING BETWEEN RING 2 AND RING 1
      ELSE
      PERFORM MATCH2
      CIF
      CIF
      CFOR
N     SEE IF WE'VE BEEN SUCCESSFUL
      CIF
N     IF WE'VE FAILED THEN TRY A CORNER CONNECTION
N     TRY A CONNECTION ON RIGHT SIDE
N     FIND CELL NUMBER OF CANDIDATE TRACK
      PERFORM FNDCEL
      KRING=LRING-1
      ICX=ICX+1
      IF(ICX.GT.LSTCL(KRING)) ICX=ICX-NCELL(KRING)
N     TRY CORNER CONNECTION WITH FLAG SET FOR RIGHT
      LRCORN=1
      PERFORM CORNER
N     TRY A LEFT CONNECTION
      PERFORM FNDCEL
      KRING=LRING-1
      ICX=ICX-1
      IF(ICX.LT.LFTCL(KRING)) ICX=ICX+NCELL(KRING)
N     TRY A LEFT CORNER CONNECTION
      LRCORN=-1
      PERFORM CORNER
      IF IRIFLG.EQ.1
N     IF SUCCESSFUL SEE IF THERE IS A
      THEN
N     BETTER MATCH TO THIS CANDIDATE
      PERFORM LKAHED
      CIF
      KMP1=HISTR(1,NTR)
      KMP1=IABS(KMP1)
      KMP1=IPCL(KMP1)
      KMP2=HISTR(HNREL(NTR),NTR)
      KMP2=IABS(KMP2)
      KMP2=IPCL(KMP2)
N     HAVE WE BEEN SUCCESSFUL
      PERFORM PRESTO
N     IF WE'VE SUCCEEDED THEN END THE 'FOR' LOOP
      IF IRIFLG.NE.0.OR.IPST.EQ.0.OR.LR.EQ.0.OR.IBKK(20).NE.0.AND.
     $IJFLG.EQ.0.AND.NRHT(K).GE.IBKK(19).OR.KMP1.NE.KMP2
      THEN
      XFOR
      ELSE
N     OTHERWISE TRY THE OTHER AMBIGUITY
      LR=-LR
C     PRINT 389
C389  FORMAT(' *************** ERROR IN LR FLAG IN RINCON *******')
      CIF
      CFOR
      RETURN
C
C     ******************************************************
C
      PROC LKAHED
C
C     THIS PROC IS ENTERED AFTER ASUCCESSFUL RING
C     CONNECTION. IT CHECKS TO SEE IF THERE EXISTS
C     A BETTER MATCH TO THIS CANDIDATE TRACK
C     WITH ANOTHER PARENT
C
      IBFIT=-4
      IRT=IRL
      ITMP=LR
N     REMEMBER THESE FLAGS
      ITMP1=K
      ITMP2=ICL
N     FOR EACH CANDIDATE
      FOR JK=1,IRT
      LRCORN=0
      KX=ITK(JK,1)
      ICX=IPCL(KX)
      IC1=ICX+24
      IC2=IC1
N     FOR RING 2 TO RING 1 CONNECTION)
      IF LRING.EQ.3
      THEN
      IC1=2*ICX-1
      IC2=IC1+1
      CIF
      ICZ=IC1
      IF HNTCEL(IC2+1)-HNTCEL(IC1).GT.0
      THEN
      NTRLX3=HNTCEL(IC1)
      NTRLX4=HNTCEL(IC2+1)-1
C     CALL CHKX(63,NTRLX3,NTRLX4,IC1)
N     TRY ALL THE PARENTS
      FOR IB=NTRLX3,NTRLX4
      IBFIT=-4
      IF HUSE(IB).EQ.0.OR.LAND(LBL(IB),MSKERR).NE.0
      THEN
      K=IB
      ICL=IPCL(IB)
C     CALL CHKX(64,K,IB,ICL)
      IF KRING.EQ.2
      THEN
      LR=0
      PERFORM LRPAR
N     RING 3 TO RING 2 CONNECTION
      PERFORM MATCH1
      ELSE
      LR=ITK(JK,3)
      PERFORM LRPAR
N     RING 2 TO RING 1 CONNECTION
      PERFORM MATCH2
      CIF
      CIF
      CFOR
      CIF
      IC1=ICZ+1
      IF(LRING.EQ.3) IC1=ICZ+2
      IF(IC1.GT.LSTCL(LRING)) IC1=IC1-NCELL(LRING)
      IC2=IC1
      IF(LRING.EQ.3) IC2=IC1+1
      IF HNTCEL(IC2+1)-HNTCEL(IC1).GT.0
      THEN
      NTRLX3=HNTCEL(IC1)
      NTRLX4=HNTCEL(IC2+1)-1
C     CALL CHKX(73,NTRLX3,NTRLX4,IC1)
N     TRY ALL THE PARENTS
      FOR IB=NTRLX3,NTRLX4
      IBFIT=-4
      IF HUSE(IB).EQ.0.OR.LAND(LBL(IB),MSKERR).NE.0
      THEN
      K=IB
      ICL=IPCL(IB)
C     CALL CHKX(74,K,IB,ICL)
      LRCORN=-1
      LR=0
      PERFORM LRPAR
      PERFORM MATCH3
      CIF
      CFOR
      CIF
      IC1=ICZ-1
      IF(LRING.EQ.3) IC1=ICZ-2
      IF(IC1.LT.LFTCL(LRING)) IC1=IC1+NCELL(LRING)
      IC2=IC1
      IF(LRING.EQ.3) IC2=IC1+1
      IF HNTCEL(IC2+1)-HNTCEL(IC1).GT.0
      THEN
      NTRLX3=HNTCEL(IC1)
      NTRLX4=HNTCEL(IC2+1)-1
C     CALL CHKX(83,NTRLX3,NTRLX4,IC1)
N     TRY ALL THE PARENTS
      FOR IB=NTRLX3,NTRLX4
      IBFIT=-4
      IF HUSE(IB).EQ.0.OR.LAND(LBL(IB),MSKERR).NE.0
      THEN
      K=IB
      ICL=IPCL(IB)
C     CALL CHKX(84,K,IB,ICL)
      LRCORN=1
      LR=0
      PERFORM LRPAR
      PERFORM MATCH3
      CIF
      CFOR
      CIF
      CFOR
      LR=ITMP
N     RESET FLAGS
      ICL=ITMP2
      K=ITMP1
      IBFIT=0
      CPROC
C
C   *************************************************************
C
      PROC MATCH1
C
C     THIS PROC CALLED FOR MATCHING
C     FROM RING 3 TO RING 2
C
N     COMPUTE QUANTITIES USED IN MATCHING FROM RING 3 TO RING 2
      PERFORM DSRIN
N     HERE WE KNOW THE L-R AMBIGUITY IN RING 3
      IF LR.NE.0
      THEN
      LRT=LR
N     TRY A CONNECTION
      PERFORM JOIN
N     HERE WE DON'T KNOW THE L-R SOL'N IN RING 3
      ELSE
N     FIRST TRY RIGHT SOLN
      DSEX=DSEXR
      LRT=1
      SLEX=SLEXR
      PERFORM JOIN
N     THEN TRY THE LEFT SOLN
      DSEX=DSEXL
      LRT=-1
      SLEX=SLEXL
      PERFORM JOIN
      CIF
      CPROC
C
C     ***********************************************************
C
      PROC MATCH2
C
C     THIS PROC CALLED FOR MATCHING
C     BETWEEN RING 2 TO RING 1
C
      LR1=LR
N     SET LR FLAG ARBITRARILY 1 IF IT IS ZERO
      IF(LR.EQ.0) LR1=1
      IF(LR.EQ.0.AND.IBKK(20).NE.0.AND.NRHT(K).GE.IBKK(19)) IJFLG=1
      LRT=LR1
      LRS=LR1
      PERFORM NOTH
      PERFORM FCNT
      SL=SL1K-FCONT*.5*(W3-W2)
N     COMPUTE EXPECTED DRIFT SPACE
      DSEX=D-SL*(W3-W2)
N     TRY A CONNECTION
      PERFORM JOIN
      CPROC
C
C   *************************************************************
C
      PROC FNDCEL
C
C     IF A TRACK EXISTS IN CELL 'ICL',RING 'LRING'
C     THEN THIS PROC PLACES IN ICX THE CELL WHERE
C     A MATCHING TRACK ACROSS THE RING SHOULD BE FOUND
C
      ICX=ICL
N     EXPECTED CELLNUMBER IN NEXT RING
      IF(LRING.EQ.3) ICX =(ICX+1)/2
      IF(LRING.EQ.2) ICX = ICX - 24
      CPROC
C
C     **********************************************************
C
      PROC PRESTO
C
C     THIS PROC CHOOSES BEST MATCH(WHEN MORE THAN ONE EXISTS)
C     AND STORES IT AWAY
C
N     AT LEAST ONE MATCH
      IF IRIFLG.EQ.1
      THEN
N     IS THERE ONLY ONE SOLN?
      IF IRL.GT.1
      THEN
N     CHOOSE ONE
      CALL CHOOSE
      CIF
      IF IRIFLG.EQ.1
      THEN
      K=ITK(1,1)
      IKX=K
N     CHANGE THE AMBIGUITY OF THE PARENT
      IF(LR.EQ.0.AND.ITK(1,2).EQ.-1) HISTR(1,NTR)=-HISTR(1,NTR)
N     RESET POINTERS AND STORE IT AWAY
      ICL=IPCL(IKX)
      LRCORN=0
      IPAR=ITK(1,4)
      IPAR=IPCL(IPAR)+ICL
      IF(LAND(IPAR,1).EQ.1) LRCORN=1
      IF(LRCORN.EQ.1.OR.KRING.EQ.2) IJFLG=0
C     IF(LR.EQ.0.AND.KRING.EQ.1.AND.LRCORN.EQ.0) IJFLG=1
      LR=ITK(1,3)
      IF(II.EQ.2) CALL COREC
      IF(KMP1.EQ.KMP2.AND.KRING.EQ.1.AND.II.EQ.2.AND.LRCORN.EQ.0)
     * IJFLG=1
      LRING=KRING
      CALL BSTORE
      IPST=0
      CIF
      CIF
      CPROC
C
C     *************************************************************
C
      PROC CORNER
C
C     THIS PROC MATCHES TRACKS ACROSS RINGS
C     WHEN THEY HAVE CROSSED THE CORNER OF THE CELL WALLS
C
N     ANY ELEMENTS IN THE EXPECTED CELL?
      IF HNTCEL(ICX+1)-HNTCEL(ICX).GT.0
      THEN
N     EXPECTED NUMBER OF TRACKS
      NTRLX1=HNTCEL(ICX)
      NTRLX2=HNTCEL(ICX+1)-1
      FOR KX=NTRLX1,NTRLX2
N     HAS IT BEEN USED YET?
      IF HUSE(KX).EQ.0
      THEN
      PERFORM MATCH3
      CIF
      CFOR
      CIF
      CPROC
C
C     ***********************************************************
C
      PROC MATCH3
C
C
N     INITIALIZE QUANTITIES FOR CORNER MATCHING
      PERFORM DSCORN
C     PRINT 6654,ICX,KX
C6654 FORMAT(' TRY CORNER CONNECTION,CELL=',I4,' TRACK=',I4)
N     TRY A CONNECTION
      LR1=-LRCORN
      IF LR.NE.0
      THEN
      LRT=LR
      PERFORM JOIN
      ELSE
      LRT=1
      DSEX=DSEXR
      SLEX=SLEXR
      PERFORM JOIN
      LRT=-1
      DSEX=DSEXL
      SLEX=SLEXL
      PERFORM JOIN
      CIF
      CPROC
C
C     **************************************************************
C
      PROC JOIN
C
C     THIS PROC ATTEMPTS TO JOIN TRACKS ACROSS A RING BOUNDARY
C
      IOFF=0
      IF(NRHT(K).LE.6.OR.NRHT(KX).LE.6) IOFF=IOFF+1
      IF(ITOL.NE.1) IOFF=IOFF+2
      IF(LRCORN.NE.0) IOFF=IOFF+4
      DSM=XBKK(IOFF+1)
      SLCON=XBKK(IOFF+9)
      SLX=XBKK(IOFF+17)
      DX=XBKK(IOFF+25)
C     ISIS=(3+LR1)/2
C     DT=DSMAX(NWR2(KX)+1,KRING,ISIS)
C     IF(ABS(DSEX).GT.DT) DSEX=SIGN(DT,DSEX)
N     CROSSING THE WIRE PLANEIN THE CELL WALL
      ICROSS=0
      MAMB=0
      IF(NRHT(KX).GE.IBKK(19).AND.IBKK(20).NE.0) MAMB=1
      IF MAMB.NE.0
      THEN
      JT=IKX
      IKX=KX
      CALL LFRT(LRC)
      IF LRC.NE.0
      THEN
      IF(LAND(LBL(KX),MSKCR1).NE.0) LRC=-LRC
      IF(LRC.NE.LR1) ICROSS=1
C     IF(LRC.NE.LR1) PRINT 632,KX
C632  FORMAT('  CROSSING FORCED FOR TRACK',I5)
      CIF
      IKX=JT
      CIF
      EPS=-.00001
      IF MAMB.EQ.0.OR.MAMB.NE.0.AND.LRC.EQ.0
      THEN
      IF(DSEX.LT.0..AND.SL2(KX).LT.EPS.OR.DSEX.LT.DX.AND.
     * DS2(KX).LT.DX.AND.SL2(KX).LT.EPS) ICROSS=1
       CIF
      DTMP=DSEX-DS2(KX)
      IF(ICROSS.EQ.1) DTMP=DSEX+DS2(KX)
C     CALL CHKX(-99,DSEX,DTMP,DSM)
N     IS THE EXPECTED DRIFT SPACE CLOSE ENOUGH?
      IF ABS(DTMP).LT.DSM
      THEN
C     PRINT 2223,DTMP,KX,LRT,LR1,KRING,K
C2223 FORMAT(' RING CONNECTION,EXPECTED-ACTUAL DRIFT TIME='
C    * ,F7.3,' TRACK=',I4,' LR(PARENT)=',I4,' LR(CANDIDATE)=',I4,
C    * ' RING=',I4,' PARENT TRACK',I4)
      IF(ICROSS.EQ.1) LR1=-LR1
C     IF(ICROSS.EQ.1) PRINT 4428,K,KX,DSEX
C4428 FORMAT(' WIRE CROSSING AT CELL BOUNDARY FROM TRACK',I4,' TO TRACK,
C    *',I4,' DSEX=',F7.3)
      INTFLG=0
      IKX=0
      ICFIT=IBFIT
      IBFIT=-1
N     WE WILL NOW CHECK TO SEE IF
      IF HNTCEL(ICX+1)-HNTCEL(ICX) .GT. 1
N     THIS CANDIDATE JOINS INSIDE A CELL
      THEN
N     WITH A TRACK ELEMENT IN THE UPPER
      NTRLX1=HNTCEL(ICX)
N     HALF OF THE CELL
      NTRLX2=HNTCEL(ICX+1)-1
N     LOOP OVER ALL TRACK ELS IN THIS CELL
      FOR KK=NTRLX1,NTRLX2
N     WITH LOWER TRACK EL FIXED AT KX
      IF HUSE(KK).EQ.0
      THEN
      IW=NWR1(KK)
      IF IW.GE.ILBOT
      THEN
N     TRY CONNECTION WITHIN A CELL
      CALL  INTJN1(KK,KX,INTFLG,DT)
N     SUCCESS SO REJECT THIS RING CONNECTION
      IF INTFLG.NE.0
      THEN
C     PRINT 675
C675  FORMAT(' REJECTED BECAUSE OF INTJN')
      XFOR
      CIF
      CIF
      CIF
      CFOR
      CIF
      IF LRCORN.NE.0.AND.INTFLG.EQ.0
      THEN
      LRY=LR1
      IF LRCORN.EQ.1
      THEN
      LR1=1
      ICT=ICX-1
      IF(ICT.LT.LFTCL(KRING)) ICT=ICT+NCELL(KRING)
      CIF
      IF LRCORN.EQ.-1
      THEN
      LR1=2
      ICT=ICX+1
      IF(ICT.GT.LSTCL(KRING)) ICT=ICT-NCELL(KRING)
      CIF
      IF HNTCEL(ICT+1)-HNTCEL(ICT).GT.0
      THEN
C     PRINT 9654
C9654 FORMAT(' ======= ATTEMPT SIDOUT ==============')
      A=TRKAR(KX,8)
      DS=TRKAR(KX,7)
      IW=ITRKAR(KX,6)
      IUDFLG=3
      ILIM=ILOUT
      KT=KX
      CALL SIDE1
C     IF(IKX.NE.0) PRINT 2349
C2349 FORMAT('   REJECTED BECAUSE OF SIDOUT  ')
      CIF
      LR1=LRY
      CIF
      IBFIT=ICFIT
N     THIS CANDIDATE DOES NOT INTJOIN
      IF INTFLG.EQ.0.AND.IKX.EQ.0
      THEN
N     IF ENOUGH HITS COMPARE SLOPES
C     IF NRHT(K).GT.6.AND.NRHT(KX).GT.6
C     THEN
N     COMPARE SLOPES
      PERFORM SLRIN2
C     ELSE
C     PERFORM TK
C     DTEMP(IRL)=ABS(DTMP)
C     CIF
      CIF
      CIF
      CPROC
C
C     ******************************************************
C
      PROC DSCORN
C
C     THIS PROC INITIALIZES QUANTITIES USED IN COMPARING
C     DRIFT TIMES FOR CORNER MATCHING
C
      PERFORM NOTH
      IF KRING.EQ.2
      THEN
      IF LAND(ICL,1).EQ.1
      THEN
      KR=3
      IN1=19
      IN2=21
      IN3=20
      JR=KRING
      IN4=10
      IN5=12
      IN6=13
      PERFORM DSINIT
      CIF
      IF LAND(ICL,1).NE.1
      THEN
      KR=KRING
      IN1=11
      IN2=13
      IN3=12
      JR=3
      IN4=18
      IN5=20
      IN6=21
      PERFORM DSINIT
      CIF
      ELSE
      KR=KRING
      IN1=15
      IN2=17
      IN3=16
      JR=KRING
      IN4=14
      IN5=16
      IN6=17
      PERFORM DSINIT
      CIF
      CPROC
C
C      *********************************************************
C
C
      PROC DSINIT
C
C
C
C
      IF LRCORN.EQ.1
      THEN
      DSMX=DTWICE(NWR2(KX)+1,KR,1)
      X1=DBCK(IN1)
      IF LR.EQ.0.OR.LR.EQ.1
      THEN
      X2=DBCK(IN2)
      LRS=1
      PERFORM FCNT
      PERFORM XQQ
      DSEX=DSMX-XQ
      CIF
      IF(LR.EQ.0) DSEXR=DSEX
      IF(LR.EQ.0) SLEXR=SLEX
      IF LR.EQ.0.OR.LR.EQ.-1
      THEN
      X2=DBCK(IN3)
      LRS=-1
      PERFORM FCNT
      PERFORM XQQ
      DSEX=DSMX+XQ
      CIF
      IF(LR.EQ.0) DSEXL=DSEX
      IF(LR.EQ.0) SLEXL=SLEX
      ELSE
      DSMX=DTWICE(NWR2(KX)+1,JR,2)
      X1=DBCK(IN4)
      IF LR.EQ.0.OR.LR.EQ.1
      THEN
      X2=DBCK(IN5)
      LRS=1
      PERFORM FCNT
      PERFORM XQQ
      DSEX=DSMX+XQ
      CIF
      IF(LR.EQ.0) DSEXR=DSEX
      IF(LR.EQ.0) SLEXR=SLEX
      IF LR.EQ.0.OR.LR.EQ.-1
      THEN
      X2=DBCK(IN6)
      LRS=-1
      PERFORM FCNT
      PERFORM XQQ
      DSEX=DSMX-XQ
      CIF
      IF(LR.EQ.0) DSEXL=DSEX
      IF(LR.EQ.0) SLEXL=SLEX
      CIF
      CPROC
C
C     ******************************************************
C
      PROC SLRIN2
C
C     THIS PROC TRANSFORMS SLOPES THEN COMPARES THEM
C
      IF KRING.EQ.2.OR.LRCORN.NE.0
N     FOR RING 3 TO RING 2 OR CORNER CONNECTION
      THEN
      SL=SLEX
      IF(LRT*LR1.EQ.1) SL=-SL
      IF(ICROSS.EQ.1) SL=-SL
N     T IS ANGLE BETWEEN WIRE PLANES FOR
      T=DBCK(6)
N     PARENT AND CANDIDATE
      IF(KRING.EQ.2.AND.LRCORN.NE.0) T=DBCK(7)
      IF(KRING.EQ.1.AND.LRCORN.NE.0) T=TANDEL(2)
      IF(LAND(ICL,1).EQ.1.AND.LRCORN.EQ.1.OR.
     * LAND(ICL,1).NE.1.AND.LRCORN.EQ.-1) T=DBCK(22)
N     ROTATE TO NEW WIRE CO-ORDINATE SYSTEM
N     EXPECTED SLOPE
      SLEX=(T-SL)/(1.+SL*T)
      CIF
N     CORRECT EXPECTED SLOPE IF IT CROSSES WIRE PLANE
      IF(ICROSS.EQ.1) SLEX=-SLEX
N     IN THE CELL WALL
N     CANDIDATE SLOPE
      SL=SL2(KX)/RINCR(KRING)
N     TRANSFORM CANDIDATE SLOPE
      SLC=SLCOR(SL,LR1)
      SLTMP=SLC-SLEX
N     TOLERANCE ON SLOPE MATCHING
      SLOLIM=(ABS(SLEX)+ABS(SLC))/2.*SLX+SLCON
C      PRINT 2229,KX,SLTMP,SLOLIM,K
C2229 FORMAT(' COMPARE SLOPES, TRACK=',I4,' SL-SLEX ',F7.3,' SLOLIM'
N    * ,F7.3,' PARENT TRACK',I4)
N     DO THE SLOPES AGREE
      IF ABS(SLC-SLEX) .LT. SLOLIM
      THEN
      IXXB=0
      IF IBKK(18).NE.0.AND.IBFIT.EQ.0
      THEN
      PERFORM FITRIN
      CIF
      IF IXXB.EQ.0
      THEN
N     STORE AWAY TRACK
      PERFORM TK
      DTEMP(IRL)=ABS(DTMP*(SLC-SLEX))
      CIF
      CIF
      CPROC
C
C    *********************************************************
C
      PROC TK
C
C     THIS PROC FILLS ITK ARRAY
C
      IRIFLG=1
      IF IRL.LT.10
      THEN
      IRL=IRL+1
N     CANDIDATE TRACK EL
      ITK(IRL,1)=KX
N     CANDIDATE LR
      ITK(IRL,3)=LR1
N     PARENT LR
      ITK(IRL,2)=LRT
N     PARENT TRACK EL
      ITK(IRL,4)=K
      ELSE
C     PRINT 4953
C4953 FORMAT(' TOO MANY CHOICES   ¢¢¢¢¢¢¢¢¢¢¢¢¢¢¢¢¢¢¢¢¢¢')
      CIF
      CPROC
C
C    ************************************************************
C
      PROC DSRIN
C
C     THIS PROC COMPUTES QUANTITIES USED IN MATCHING
C     DRIFT TIMES FOR TRACKS PASSING FROM RING 3 TO RING 2
C     THE EXPECTED DRIFT TIMES ARE PUT INTO DSEX,DSEXR,DSEXL
C
      PERFORM NOTH
N     ODD CELL IN RING 3
      IF LAND(ICL,1).EQ.1
      THEN
      LR1=-1
      DSMX=DHALF(NWR2(KX)+1,KRING,1)
      IF LR.EQ.-1.OR.LR.EQ.0
      THEN
      LRS=-1
      PERFORM FCNT
      X1=DBCK(5)
      X2=DBCK(8)
      PERFORM XQQ
      DSEX=DSMX+XQ
      CIF
      IF(LR.EQ.0) DSEXL=DSEX
      IF(LR.EQ.0) SLEXL=SLEX
      IF LR.EQ.1.OR.LR.EQ.0
      THEN
      LRS=1
      PERFORM FCNT
      X1=DBCK(5)
      X2=DBCK(9)
      PERFORM XQQ
      DSEX=DSMX-XQ
      CIF
      IF(LR.EQ.0) DSEXR=DSEX
      IF(LR.EQ.0) SLEXR=SLEX
      CIF
N     EVEN CELL IN RING 3
      IF LAND(ICL,1).NE.1
      THEN
      LR1=1
      DSMX=DHALF(NWR2(KX)+1,KRING,2)
      IF LR.EQ.-1.OR.LR.EQ.0
      THEN
      LRS=-1
      PERFORM FCNT
      X1=DBCK(4)
      X2=DBCK(9)
      PERFORM XQQ
      DSEX=DSMX-XQ
      CIF
      IF(LR.EQ.0) DSEXL=DSEX
      IF(LR.EQ.0) SLEXL=SLEX
      IF LR.EQ.1.OR.LR.EQ.0
      THEN
      LRS=1
      PERFORM FCNT
      X1=DBCK(4)
      X2=DBCK(8)
      PERFORM XQQ
      DSEX=DSMX+XQ
      CIF
      IF(LR.EQ.0) DSEXR=DSEX
      IF(LR.EQ.0) SLEXR=SLEX
      CIF
      CPROC
C
C    **********************************************************
C
      PROC FCNT
C
C     THIS PROC COMPUTES SLOPE CONTINUATION FACTOR
C
N     TRANSFORM SL1(K)
      SLC1=SLCOR(SL1K,LRS)
N     CHECK FOR CROSSING THE WIRE PLANE
      IF(LAND(LBL(K),MSKCR1).NE.0.AND.LAND(LBL(K),MSKCR2).EQ.0)LRS=-LRS
N     TRANSFORM SL2(K)
      SLC2=SLCOR(SL2K,LRS)
N     TO GET CORRECT CONTINUATION FACTOR IF TRACK CROSSES
N     THE WIRE PLANE
      IF LAND(LBL(K),MSKCR1).NE.0.AND.LAND(LBL(K),MSKCR2).EQ.0
      THEN
      SLC2=ABS(SLC2)
      IF(SLC1.LT.0.) SLC2=-SLC2
      CIF
N     COMPUTE CONTIUATION FACTOR FOR PARENT TRACK
      FCONT=(SLC2-SLC1)/(NWR2(K)-NWR1(K))/RINCR(KRING+1)
      IF(ABS(FCONT).GT..001.AND.NRHT(K).LE.8) FCONT=FCONT/2.
N     EXPECTED SLOPE USING CONT FACTOR
      SLEX=SLC1-FCONT*(W3-W2)
C     PRINT 612,FCONT,SLEX
C612  FORMAT(' SLOPE CONT FACTOR= ',F10.5,' EXPECTED SLOPE= ',F10.5)
      CPROC
C     ************************************************************
C
      PROC NOTH
C
C     THIS PROC COMPUTES WIRE DISTANCES ETC. FOR USE IN
C     MATCHING DRIFT TIMES BETWEEN RING 3 AND RING 2
C
      SL1K=SL1(K)/RINCR(KRING+1)
      SL2K=SL2(K)/RINCR(KRING+1)
      D=DS1(K)
      W3=FSENSW(KRING+1)+NWR1(K)*RINCR(KRING+1)
      W2=FSENSW(KRING)+NWR2(KX)*RINCR(KRING)
      CPROC
C
C     ***********************************************************
C
      PROC XQQ
C
C     THIS PROC COMPUTES QUANTITIES USED IN MATCHING
C     DRIFT TIMES BETWEEN RING 3 AND RING 2
C
      SL=SL1K-FCONT*.5*(W3-W2)
      X=D*DRICOS/X1
      XQ=W3-(W2*DRICOS+D*X2)/X1
      XQ=X-SL*DRICOS*XQ/(X1-SL*X2)
      CPROC
C
C     *************************************************************
C
      PROC LRPAR
C
C     THIS PROC EXTRACTS LR AMBIGUITY FOR PREVIOUSLY
C     STORED TRACK ELEMENT
C
      IF LAND(LBL(K),MSKERR).NE.0.AND.LAND(LBL(K),MSKLR0).EQ.0
      THEN
      FOR KTR=1,100
      ITMM=HNREL(KTR)
      IF ITMM.GT.0
      THEN
      JA=HISTR(ITMM,KTR)
      IF IABS(JA).EQ.K
      THEN
      LR=ISIGN(1,JA)
      XFOR
      CIF
      ELSE
      XFOR
      CIF
      CFOR
C     CALL CHKX(27,LR,K,NTR)
      CIF
      CPROC
C
C    ********************************************************
C
      PROC FITRIN
      IXXB=0
      IF HNREL(NTR).LT.9
      THEN
      CALL MVC(HTEMP(1),0,HISTR(1,NTR),0,18)
      IKFLG=IJFLG
      IF(II.EQ.2) CALL COREC
      IJFLG=IKFLG
      HNREL(NTR)=HNREL(NTR)+1
      LRC=LR1
      IF(LAND(LBL(KX),MSKCR1).NE.0) LRC=-LRC
      HISTR(HNREL(NTR),NTR)=KX*LRC
      IF(LR.EQ.0.AND.LRT.EQ.-1) HISTR(1,NTR)=-HISTR(1,NTR)
C     LBL(KX)=LOR(LBL(KX),MSKFIT)
      IAB=HNREL(NTR)
      CALL BAKFIT(IXXB,2)
C     IF(IXXB.NE.0) PRINT 36
C36   FORMAT('   RING  FIT    ')
C     IF(IXXB.NE.0) PRINT 37,KX,NTR,(HISTR(IR,NTR),IR=1,IAB)
C     IF(IXXB.NE.0) PRINT 38,(HTEMP(IR),IR=1,9)
C37   FORMAT(' KX, NTR,HISTR :',11I5)
C38   FORMAT(' OLD HISTR :',9I5)
C     LBL(KX)=LAND(LBL(KX),MSKAIT)
      HNREL(NTR)=HNREL(NTR)-1
      CALL MVC(HISTR(1,NTR),0,HTEMP(1),0,18)
      CIF
      CPROC
      END
C   24/03/80 102191205  MEMBER NAME  RSTBTR   (PATRECSR)    SHELTRAN
      SUBROUTINE RSTBTR(IPJHTL)
C
C     RESTORE BACKTRACE RESULTS FROM BANK 'JHTL'
C
C     AUTHOR: P. STEFFEN (79/09/10)
C
      IMPLICIT INTEGER*2 (H)
C
#include "cdata.for"
#include "ccycp.for"
C
#include "cjdrch.for"
C
#include "cworkpr.for"
#include "cworkeq.for"
C
N     LABEL FOR HITLABEL IN /CWORK/ + L/R
      DATA MKHTL1 /Z8400/, MKATR /Z100/, MKHTL2 /Z7FFF/
N     HIT LABEL FOR SOLVED L/R AMBIG.
      DATA  MKLRSV / Z800/
N     LABEL FOR BAD HITS
      DATA  MKBDHT / Z600/
C
N     LABEL FOR TREL (L/R)
      DATA MKLFTR,MKRTTR / Z400, Z800/
N     LABEL FOR ZERO CROSSING TRKEL
      DATA LBZRCR / Z100/
C
C2000 FORMAT(1X,20I6)
C2001 FORMAT(1H0,A4,I6,2(/,1X,24I4),/,1X,50I2,
C    ,       90(/,1X,2I6,I3,2F10.3,I3,2F10.3,1X,Z4,2I3))
C2002 FORMAT(' HIT LABEL OF TRELS:',2I6,/,(12X,20(2X,Z4)))
C2004 FORMAT(1H0,'BACKTR:',5X,20I6)
C2005 FORMAT(1H ,12X,20I6)
C2006 FORMAT(1H ,I2,3I6,6X,I4,F8.2)
C2007 FORMAT('0TREL:',3I4,8(I6,F6.1),/,18X,8(I6,F6.1))
C2008 FORMAT(1X,20(2X,Z4))
C2009 FORMAT(1H ,15F8.2)
C2010 FORMAT(1H0,2I6,I3,2F10.3,I3,2F10.3,1X,Z4,2I3)
C
C
N     PRINTOUT
C     I9 = HNTR
C     PRINT 2001, HPRO,HNTR,HNTCEL,((TRKAR(I1,I2),I2=1,11),I1=1,I9)
C     I0 = HPHL0
C     I9 = HPHL9
C     PRINT 2002, I0,I9,(HWRK(I1),I1=I0,I9)
C     PRINT 2004,NTR, (HNREL(I1),I1=1,NTR)
C     FOR ITR=1,NTR
C       NELM = HNREL(ITR)
C       PRINT 2005, (HISTR(I1,ITR),I1=1,NELM)
C     CFOR
C
N     COPY 'JHTL' TO /CWORK/
      NBYTE = IDATA(IPJHTL)*4 - 4
      CALL MVCL(HWRK(HPHL0),0,IDATA(IPJHTL+2),0,NBYTE)
      HLDHL = IDATA(IPJHTL)*2 - 2
      HPHL9 = HLDHL + HPHL0 - 1
      HPFREE = (HPHL9+1)/2 + 1
      HPHT0  = HPFREE
C
C     PRINT 2002, I0,I9,(HWRK(I1),I1=I0,I9)
N     DELETE ALL BAD HITS
      FOR I=HPHL0,HPHL9,2
        IZW = HWRK(I  )
        IF LAND(IZW,MKBDHT).NE.0
        THEN
          HWRK(I) = HWRK(I+1)
          IZW     = HWRK(I+1)
          HWRK(I+1) = 0
C         PRINT 2008,MKBDHT,IZW,HWRK(I),HWRK(I+1)
          IF(LAND(IZW,MKBDHT).NE.0) HWRK(I  ) = 0
        ELSE
          IZW = HWRK(I+1)
          IF(LAND(IZW,MKBDHT).NE.0) HWRK(I+1) = 0
        CIF
      CFOR
C     PRINT 2002, I0,I9,(HWRK(I1),I1=I0,I9)
C
N     INITIALIZE MIDOUT
      NBYTE = 200
      CALL SETSL(HNREL(1),0,NBYTE,0)
      NTR   = 0
      HNTR  = 0
C
N     LOOP OVER ALL CELLS
      ICELL = 1
      ITREL = 0
      ITRBK = 0
      REPEAT
N       POINTER TO HITS OF SELECTED CELL
        IPHIT0 = HPTSEC(ICELL  )
        IPHIT9 = HPTSEC(ICELL+1) - 4
C
N       RESET TREL# FOR EACH RING
        IF(ICELL.EQ.25) ITREL = 0
        IF(ICELL.EQ.49) ITREL = 0
C
N       GET DRIFTTIME CONSTANTS
        IRING = 1
        IF(ICELL.GE.25) IRING = 2
        IF(ICELL.GE.49) IRING = 3
        DSBIN1 = TIMDEL(1,IRING)
        DSBIN2 = TIMDEL(2,IRING)
C
N       CHECK IF HITS IN CELL
        IF IPHIT9.GE.IPHIT0
        THEN
C
N         POINTER TO HIT LABEL
          IPHTL0 = (IPHIT0-HPTSEC(1))/2 + HPHL0
C
N         LOOP OVER CELL HITS UNTIL NO MORE HIT FOUND
          REPEAT
            IPHIT = IPHIT0
            IPHTL = IPHTL0
            ITR   = 0
            DSBIN = DSBIN1
            NHT   = 0
            IPHTW = HPHT0
N           LABEL FOR DET. OF 1. + 2. ZERO-XING
            ZCRLB1 = 0.
            ZCRLB2 = 0.
            WHILE IPHIT.LE.IPHIT9
N             HIT LABEL
              LHTL1 = HWRK(IPHTL  )
              LHTL2 = HWRK(IPHTL+1)
N             TRACK #
              NTR1  = 0
              NTR2  = 0
             IF(LAND(LHTL1,MKHTL1).EQ.0) NTR1 = LAND(SHFTR(LHTL1,1),127)
             IF(LAND(LHTL2,MKHTL1).EQ.0) NTR2 = LAND(SHFTR(LHTL2,1),127)
C
N             SET TRACK# + TREL#
              IF ITR.EQ.0
              THEN
                IF NTR1.NE.0
                THEN
                  ITR = NTR1
                ELSE
                  IF(NTR2.NE.0) ITR = NTR2
                CIF
                IF(ITR.NE.0) ITREL = ITREL + 1
              CIF
C
N             CHECK IF HIT BELONGS TO TRACK
              IF ITR.NE.0 .AND. (NTR1.EQ.ITR .OR. NTR2.EQ.ITR)
              THEN
C
N               SET TREL# AND MARK HIT LABEL
                IF ITR.EQ.NTR1
                THEN
                  LBHIT = LAND(MKATR,LHTL1)
N                 SET SIGN FOR L/R
                  SGNLR =-1.
                  IF(LBHIT.NE.0) SGNLR = 1.
                  LBHIT = LOR (ITREL*2,LBHIT)
                  LBHIT = LOR (MKHTL1 ,LBHIT)
                  LBHIT = LOR (MKLRSV ,LBHIT)
                  HWRK(IPHTL  ) = LBHIT
                CIF
                IF ITR.EQ.NTR2
                THEN
                  LBHIT = LAND(MKATR,LHTL2)
N                 SET SIGN FOR L/R
                  SGNLR =-1.
                  IF(LBHIT.NE.0) SGNLR = 1.
                  LBHIT = LOR (ITREL*2,LBHIT)
                  LBHIT = LOR (MKHTL1 ,LBHIT)
                  LBHIT = LOR (MKLRSV ,LBHIT)
                  HWRK(IPHTL+1) = LBHIT
                CIF
C
N               GET DATA OF HIT
                IWIR = HDATA(IPHIT  )
                ILAY = LAND(SHFTR(IWIR,3),15)
                IF(ILAY.GE.8) DSBIN = DSBIN2
                ITAU = HDATA(IPHIT+3)
                DRSP          = ITAU*DSBIN*SGNLR
C
N               CHECK IF 2. ZERO-XING
                IF(ZCRLB1.EQ.0. .AND. DRSP.NE.0.) ZCRLB1 = SIGN(1.,DRSP)
                IF(ZCRLB1*DRSP.LT.0.) ZCRLB2 =-ZCRLB1
                IF ZCRLB2*DRSP.LT.0.
                THEN
N                 2. ZERO-XING FOUND: CUT TREL
                  HWRK(IPHTL  ) = LHTL1
                  HWRK(IPHTL+1) = LHTL2
                  XWHILE
                CIF
C
N               STORE HIT
                NHT = NHT + 1
                IWRK(IPHTW  ) = ILAY
                WRK (IPHTW+1) = DRSP
                IPHTW = IPHTW + 2
              CIF
            IPHTL = IPHTL + 2
            IPHIT = IPHIT + 4
            CWHILE
C
N           CHECK IF NEW TREL
            IF ITR.GT.0
            THEN
N             SETUP MIDOUT
              PERFORM MIDOUT
            CIF
          UNTIL ITR.EQ.0
C
        CIF
      ICELL = ICELL + 1
      UNTIL ICELL.GT.96
C
N     SET # OF TRELS
      HNTR = ITRBK
C
N     DETERMINE CELL POINTERS
      ICELL0 = 0
      FOR ITRBK=1,HNTR
        ICELL = IPCL(ITRBK)
        IF ICELL.NE.ICELL0
        THEN
          ICELL0 = ICELL0 + 1
          FOR IC=ICELL0,ICELL
            HNTCEL(IC) = ITRBK
          CFOR
          ICELL0 = ICELL
        CIF
      CFOR
      ICELL0 = ICELL0 + 1
      ITRBK = HNTR + 1
      FOR IC=ICELL0,97
        HNTCEL(IC) = ITRBK
      CFOR
      HNTCEL(98) = 0
C
N     GET TRELS IN ORDER
      CALL TRLORD
C
N     BIT OFF IN HITLABEL FOR USED HITS
      FOR I=HPHL0,HPHL9
        IZW = HWRK(I)
        IZW = LAND(IZW,MKHTL2)
        HWRK(I) = IZW
      CFOR
C
N     PRINTOUT
C     I9 = HNTR
C     PRINT 2001, HPRO,HNTR,HNTCEL,((TRKAR(I1,I2),I2=1,11),I1=1,I9)
C     I0 = HPHL0
C     I9 = HPHL9
C     PRINT 2002, I0,I9,(HWRK(I1),I1=I0,I9)
C     PRINT 2004,NTR, (HNREL(I1),I1=1,NTR)
C     FOR ITR=1,NTR
C       NELM = HNREL(ITR)
C        PRINT 2005, (HISTR(I1,ITR),I1=1,NELM)
C     CFOR
C     I0 = IPJHTL*2+3
C     I9 = I0 + IDATA(IPJHTL)*2 - 3
C     PRINT 2002, I0,I9,(HDATA(I1),I1=I0,I9)
C
      RETURN
C
N     ***************************
N     *      M I D O U T        *
N     ***************************
C
N     SETUP MIDOUT
      PROC MIDOUT
C
N       CHECK IF HIT LABEL EXISTING
        HPHT9 = IPHTW - 1
C     PRINT 2007, ICELL,ITREL,ITR,(WRK(I1),I1=HPHT0,HPHT9)
N       INCREASE COUNTER OF TREL
        ITRBK = ITRBK + 1
C
N       DETERMINE RESULTS OF TREL SEARCH
        DS10  =  WRK(HPHT0+1)
        DS20  =  WRK(HPHT9  )
        IF NHT.LT.4
        THEN
          IF NHT.EQ.1
          THEN
            SL10 = 0.
            SL20 = 0.
          ELSE
            IDWIR =  IWRK(HPHT9-1)-IWRK(HPHT0)
            SL10  =  0.
            IF(IDWIR.NE.0) SL10  =  (DS20-DS10)/IDWIR
            SL20  =  SL10
          CIF
        ELSE
          SL10  =  (WRK(HPHT0+7)-DS10)/(IWRK(HPHT0+6)-IWRK(HPHT0  ))
          SL20  =  (WRK(HPHT9-6)-DS20)/(IWRK(HPHT9-7)-IWRK(HPHT9-1))
          WR10  =  (IWRK(HPHT0+6)+IWRK(HPHT0  ))*.5
          WR20  =  (IWRK(HPHT9-7)+IWRK(HPHT9-1))*.5
          DSL   =  0.
          DWR   =  WR20 - WR10
          IF(DWR.GT.0) DSL   =  (SL20-SL10) / DWR
C     PRINT 2009, DS10,DS20,SL10,SL20,WR10,WR20,DWR,DSL
          IF DSL.NE.0.
          THEN
            SL10 = SL10 + (IWRK(HPHT0  )-WR10)*DSL
            SL20 = SL20 + (IWRK(HPHT9-1)-WR20)*DSL
          CIF
        CIF
C     PRINT 2009, DS10,DS20,SL10,SL20,WR10,WR20,DWR,DSL
C
N       LABEL OF TREL
        LBTREL       = MKRTTR
        IF(DS10.LT.0.) LBTREL = MKLFTR
        IF(DS10.EQ.0 .AND. DS20.LT.0) LBTREL = MKLFTR
        ITRBKS = ITRBK
        ITRS   = ITR
        IF LBTREL.EQ.MKLFTR
        THEN
          ITRBKS =-ITRBK
          ITRS   =-ITR
          DS10   =-DS10
          SL10   =-SL10
          DS20   =-DS20
          SL20   =-SL20
        CIF
C     PRINT 2009, DS10,DS20,SL10,SL20,WR10,WR20,DWR,DSL
C
N       ZERO CROSSING TREL
        IZRCR = 0
        IF DS10*DS20 .LT.0.
        THEN
          DS20 =-DS20
          SL20 =-SL20
          LBTREL = LOR(LBTREL,LBZRCR)
          DS0 = WRK(HPHT0+1)
          FOR IP=HPHT0,HPHT9,2
            IF DS0*WRK(IP+1).LT.0
            THEN
              XFOR
            CIF
            IZRCR = IWRK(IP)
          CFOR
          IZRCR = IZRCR + 1
        CIF
C     PRINT 2009, DS10,DS20,SL10,SL20,WR10,WR20,DWR,DSL
C
N       STORE RESULT OF TREL SEARCH
        IPCL (ITRBK) =  ICELL
        NRHT (ITRBK) =  NHT
        NWR1 (ITRBK) =  IWRK(HPHT0  )
        DS1  (ITRBK) =  DS10
        SL1  (ITRBK) =  SL10
        NWR2 (ITRBK) =  IWRK(HPHT9-1)
        DS2  (ITRBK) =  DS20
        SL2  (ITRBK) =  SL20
        LBL  (ITRBK) =  LBTREL
        NTREL(ITRBK) =  ITREL
        ICRO (ITRBK) =  IZRCR
C     PRINT 2010, (TRKAR(ITRBK,I1),I1=1,11)
C
N       STORE RESULT OF BACKTRACE
        MTREL = HNREL(ITR)
        IF(MTREL.LT.9) MTREL = MTREL + 1
        HISTR(MTREL,ITR) = ITRBKS
        HNREL(ITR) = MTREL
        HRES(ITRBK) = ITRS
        NTR = MAX0(NTR,ITR)
C
      CPROC
C
      END
C   24/03/80 109291155  MEMBER NAME  SRTREL   (PATRECSR)    SHELTRAN
      SUBROUTINE SRTREL
C
C     SUBROUTINE FOR SEARCH OF TRACK ELEMENTS WITHIN CELL
C     PETER STEFFEN:  6/ 4/79
C
      IMPLICIT INTEGER*2 (H)
      LOGICAL TBIT
C
#include "cdata.for"
#include "ccycp.for"
C
#include "cworkpr.for"
#include "cworkeq.for"
C
      EQUIVALENCE
     ,           (ICELL ,IDWRK(1)),(NHIT  ,IDWRK(2)),(IRING ,IDWRK(3))
     ,         , (IERRCD,IDWRK(4)),(NTRKEL,IDWRK(5))
     ,         , (ITR   ,IDWRK(7)),(ITRNG ,IDWRK(8))
C
#include "cpatlm.for"
C
N     MASK FOR GOOD TRKELS
      DATA MKTREL / Z3000/
N     MASKS FOR TRKEL LABEL FOR TRACING
      DATA MKLBTC / ZFFF/
N     MASK FOR LEFT/RIGHT BITS
      DATA MKLFTR / Z 30000/, MKRGHT / Z20000/
N     HIT LABEL FOR SOLVED L/R AMBIG.
      INTEGER  MKLRHT(3) / Z800, Z0, Z900/
N     LABEL FOR ZERO CROSSING TRKEL
      DATA LBZRCR / Z100/
C
C2000 FORMAT(1H0,'ERROR CODE:',I4, ', ICELL:',I3,', TRACKS:',I9)
C2001 FORMAT(1X,/,(1X,2I6,2F6.2,2X,Z4,6I6,F6.2))
C2002 FORMAT(/,(1X,3I6,4F8.5,I3,2F6.2,I3,2F6.2,2X,Z4,2X,Z4,2X,Z5,F6.2))
C
N     ADDRESS OF POINTER TO HIT LABEL
      DATA NANF /0/
      IF(NANF.EQ.0) IQPATR= IBLN('PATR')
      NANF = 1
C
N     POINTER TO 'PATR'-BANK
      IPPATR = IDATA(IQPATR)
C               PRINT 2000, IERRCD, ICELL, IPPATR
N         MEMORIZE 1. FREE LOCATION
          HPFRE0 = HPFREE
N         PREPAR HIT ARRAY OF CELL FOR PATREC
          CALL PRHTAR
          IF NHIT.GE.5
          THEN
C
N           FIND LINELS WITHIN CELL
            CALL FLINEL
C
N           FIND TRKELS FROM LINELS
            CALL FTRKEL
C
            IF NTRKEL.GT.0
N           ANALYSE TRKELS WITHIN CELL
            THEN
C
COMMENT OUT CALL TO DUMMY ROUTINE ATRKEL ... GFP 1/4/81
C
CCCCCC        CALL ATRKEL
C             IF IERRCD.NE.-1
C             THEN
C               PRINT 2000, IERRCD, ICELL, NTRCNT
C               PRINT 2001, (WRK(I1),I1=HPHT0,HPHT9)
C               PRINT 2002, (WRK(I1),I1=HPTR0,HPTR9)
C             CIF
C
N             FILL TRKEL ARRAY FOR TRACING
              PERFORM PRBTAR
            CIF
C
N           COUNT UNCORRELATED LINELS
            NLINUC = 0
            FOR IP=HPHT0,HPHT9,HLDHT
              IF(IWRK(IP+9).EQ.0 .AND. LAND(IWRK(IP+4),7).NE.0)
     .        NLINUC = NLINUC + 1
            CFOR
N           INCREASE COUNTER OF UNCORRELATED LINELS
            IDATA(IPPATR+7) = IDATA(IPPATR+7) + NLINUC
          CIF
C
N         FREE AREA IN CWORK
          HPFREE = HPFRE0
C
      RETURN
C
N     ***************************
N     *      P R B T A R        *
N     ***************************
C
N     PREPARE ARRAY FOR BACKTRACING
      PROC PRBTAR
C
N       SET TRACK ARRAY
C
        ICLL16 = (ICELL-1) * 16
        NTRCLL = 0
        FOR IPTR = HPTR0,HPTR9,HLDTR
          IF ITR.LE.200 .AND. ITRNG.LT.128
          THEN
          IF LAND(IWRK(IPTR+15),MKTREL).NE.0
          THEN
            NTRCLL = NTRCLL + 1
C
N           LABEL
            LB = LAND(IWRK(IPTR+15),MKLBTC)
N           DRIFT SPACE OF 1. + LAST POINT
            DRSP1 = WRK(IPTR+ 8)
            DRSP2 = WRK(IPTR+11)
            IF(DRSP1*DRSP2.LT.0) LB = LOR(LB,LBZRCR)
N           LABEL FOR LEFT OR RIGHT SOLUTION
            LBLR = LAND(IWRK(IPTR+15),MKLFTR)
N           FLIP L/R BITS IF 1. POINT -VE
            IF(DRSP1.LT.0..AND.LBLR.NE.0.AND.LBLR.NE.MKLFTR)
     .         LBLR = LXOR(LBLR,MKLFTR)
            LB = LOR(LB,SHFTR(LBLR,6))
C
            ITRKAR(ITR, 1) = ICELL
            ITRKAR(ITR, 2) = IWRK(IPTR+ 2)
            ITRKAR(ITR, 3) = IWRK(IPTR+ 7)
            TRKAR (ITR, 4) = ABS(DRSP1)
            DRSL1          = WRK(IPTR+ 9)
            IF(DRSP1.LT.0.)  DRSL1 =-DRSL1
            TRKAR (ITR, 5) = DRSL1
            ITRKAR(ITR, 6) = IWRK(IPTR+10)
            TRKAR (ITR, 7) = ABS(DRSP2)
            DRSL2          = WRK(IPTR+12)
            IF(DRSP2.LT.0.)  DRSL2 =-DRSL2
            TRKAR (ITR, 8) = DRSL2
            ITRKAR(ITR, 9) = LB
            ITRKAR(ITR,10) = ITRNG
C
N           LABEL INTERMEDIATE HIT ARRAY
C
N           L/R INDEX OF HITS
            IDXLR =-1
            IF(LBLR.EQ.MKRGHT) IDXLR = 1
            IF(DRSP1.LT.0.) IDXLR =-IDXLR
            IDXLR1 = IDXLR
N           PRESET LAYER OF ZERO CROSSING
            ILAYZ =-1
N           LOOP OVER ALL HITS
            FOR IP=HPHT0,HPHT9,HLDHT
              IF IWRK(IP+9).EQ.IPTR .OR.IWRK(IP+10).EQ.IPTR
              THEN
                DRSP = WRK(IP+2)
            IF(IWRK(IP+10).EQ.IPTR .AND. TBIT(IWRK(IP+4),20)) DRSP=-DRSP
                IF(DRSP.NE.0.) IDXLR1 = IDXLR
                IF DRSP*DRSP1.LT.0.
                THEN
                  IDXLR1 =-IDXLR
                  IF(ILAYZ.LT. 0) ILAYZ = IWRK(IP)
                CIF
                IPLBHT = (IWRK(IP+1) - HPTSEC(1))/2 + HPHL0
                LBHIT = ITRNG*2
                LBHIT = LOR(LBHIT,MKLRHT(IDXLR1+2))
C     PRINT 2003, IPLBHT,HPHL0,HPTSEC(1),LBHIT
C2003 FORMAT(1X,3I6,4X,Z4)
                IF HWRK(IPLBHT).EQ.0
                THEN
                  HWRK(IPLBHT) = LBHIT
                ELSE
                  IF(HWRK(IPLBHT+1).EQ.0) HWRK(IPLBHT+1) = LBHIT
                CIF
              CIF
            CFOR
C
N           SET LAYER # OF ZERO CROSSING
            IF(LAND(LB,LBZRCR).NE.0 .AND. ILAYZ.LT.0)
     .                                    ILAYZ = IWRK(IPTR+10) + 1
            IF(ILAYZ.LT.0) ILAYZ = 0
            ITRKAR(ITR,11) = ILAYZ
            ITR   = ITR   + 1
            ITRNG = ITRNG + 1
          CIF
          CIF
        CFOR
C
      CPROC
C
      END
C   29/07/80 102191206  MEMBER NAME  STTRKO   (PATRECSR)    SHELTRAN
      SUBROUTINE STTRKO(ILAYMX)
C
C     STORES TRACK IN 'PATR'-BANK
C     LABELS HITS  IN 'JHTL'-BANK
C     P. STEFFEN 8/07/80
C
      IMPLICIT INTEGER*2 (H)
      LOGICAL TBIT
C
      COMMON/CHEADR/HEAD(17),HRUN,HEV
      COMMON/CADMIN/IEVTP,NREC,NRWRIT,NRERR
C
#include "cdata.for"
#include "ccycp.for"
C
#include "cjdrch.for"
C
#include "cworkpr.for"
#include "cworkeq.for"
C
      EQUIVALENCE
     ,          (HPCO0 ,HPWRK(17)),(HPCO9 ,HPWRK(18)),(HLDCO ,HPWRK(19))
     ,         ,(ICELL ,IDWRK( 1)),(MHIT  ,IDWRK( 2)),(IRING ,IDWRK( 3))
     ,         ,(IERRCD,IDWRK( 4)),(NTRKEL,IDWRK( 5))
C
      INTEGER DATE(5), IDAY /0/
C
C
C
      DATA MAXTRK/ 50/
      DATA MKBDHT /Z600/
C
C
      DATA LBINIT /0/
      IF LBINIT.EQ.0
      THEN
        LBINIT=1
        IQJHTL = IBLN('JHTL')
        IQPATR = IBLN('PATR')
      CIF
C
N     INITIALISE DATE
      IF IDAY.EQ.0
      THEN
        CALL DAY2(DATE)
        IDAY = DATE(1)*1000 + DATE(2)
      CIF
C
N     POINTER TO 'JHTL'-BANK
      IPJHTL = IDATA(IQJHTL)*2 + 2
N     POINTER TO 'PATR'-BANK
      IPPATR = IDATA(IQPATR)
N     CURRENT NUMBER OF TRACKS
      ITRBK = IDATA(IPPATR+2)
N     LENGTH OF TRACK BANK
      LTRBK = IDATA(IPPATR+3)
N     POINTER TO NEXT TRACK BANK - 1
      IPTRBK = IPPATR + IDATA(IPPATR+1) + ITRBK*LTRBK
C
N     CHECK IF SPACE FOR NEW TRACK
      IF(IPTRBK+LTRBK-IPPATR.GT.IDATA(IPPATR)) RETURN
C
C     PRINT 2005, (WRK(I),I=HPHT0,HPHT9)
C
N     PREPARE GOODNESS LABELS FOR ZRFIT
      FOR IP=HPHT0,HPHT9,HLDHT
N       SET ERROR LABEL FOR Z-R FIT
        IWRK(IP+10) = IWRK(IP+ 7)
        IWRK(IP+ 7) = 0
        IF(IWRK(IP+10).GT.1) IWRK(IP+7) = 16
N       CALCULATE R
        WRK (IP+ 6) = ((WRK(IP+4)/WRK(IP+3))**2 *.5 + 1.) * WRK(IP+3)
N       CALCULATE Z
        IP0 = IWRK(IP+1)
        IAMPL = HDATA(IP0+1)
        IAMPR = HDATA(IP0+2)
        IF IAMPR.LE.0.OR.IAMPL.LE.0
        THEN
          WRK (IP+5) = 0.
          IWRK(IP+7) = 16
        ELSE
          Z1 = IAMPR + IAMPL
          WRK(IP+5) = FLOAT(IAMPR-IAMPL) * ZAL*.5 / Z1
        CIF
      CFOR
C2005 FORMAT('0TRACK:',/,(1X,3I6,4F8.1,I4,F6.2,2I4,F8.3,I6,F8.1))
C     PRINT 2005, (WRK(I),I=HPHT0,HPHT9)
C
N     Z-R FIT
      CALL ZRFIT
C
N     CHECK IF TRACK LEAVES AT MAX. LAYER
      ZLYMX = 1400.
      IF ILAYMX.LT.40
      THEN
        IZW = ILAYMX - 1 + 3
        JRING = IZW / 16
        ILAY  =-JRING*16 + IZW
        RMAX  = ILAY*RINCR(JRING+1) + FSENSW(JRING+1)
        ZLYMX = RMAX*WRK(HPTR0+29) + WRK(HPTR0+30)
      CIF
C
      IF ABS(ZLYMX)+ 50. .LT. ZMAX
      THEN
C     PRINT 2004, ICELL,ILAYMX,RMAX,ZLYMX,ZMAX
C     PRINT 2005, (WRK(I),I=HPHT0,HPHT9)
C2004   FORMAT('0STTRKO-REJECT:',2I6,3F10.1)
        RETURN
      CIF
C
N     REGISTER TRACK IN PATR BANK
      PERFORM TRKBNK
      IDATA(IPPATR+2) = ITRBK
C
      RETURN
C
N     ***************************
N     *      T R K B N K        *
N     ***************************
C
N     SET TRACK BANK IN /CDATA/
      PROC TRKBNK
C
N     CALC. Z AND DIRECTIONS
      JP = HPTR0
      IWRK(HPTR0+47)=LOR(IWRK(HPTR0+47),512)
      WRK(JP+ 6) = WRK(JP+ 6)*WRK(JP+29) + WRK(JP+30)
      WRK(JP+13) = WRK(JP+13)*WRK(JP+29) + WRK(JP+30)
      WRK(JP+ 9)= WRK(JP+ 9)*WRK(JP+29)
      WRK(JP+16)= WRK(JP+16)*WRK(JP+29)
      ALGINV = 1./SQRT(WRK(JP+ 7)**2+WRK(JP+ 8)**2+WRK(JP+ 9)**2)
      WRK(JP+ 7) = WRK(JP+ 7) * ALGINV
      WRK(JP+ 8) = WRK(JP+ 8) * ALGINV
      WRK(JP+ 9) = WRK(JP+ 9) * ALGINV
      ALGINV = 1./SQRT(WRK(JP+14)**2+WRK(JP+15)**2+WRK(JP+16)**2)
      WRK(JP+14) = WRK(JP+14) * ALGINV
      WRK(JP+15) = WRK(JP+15) * ALGINV
      WRK(JP+16) = WRK(JP+16) * ALGINV
C
N     INCREASE TRACK BANK COUNTER
      ITRBK = ITRBK + 1
      IP0 = IPTRBK + 1
      IP9 = IPTRBK + LTRBK
      FOR IP = IP0,IP9
        IDATA(IP) = 0
      CFOR
      IDATA(IPTRBK+ 1) = ITRBK
      IDATA(IPTRBK+ 2) = 16
      IDATA(IPTRBK+ 3) = IDAY
C
N     RESULTS FROM X-Y-FIT + ZRFIT
      IP1 = HPTR0+3
      IP9 = IP1+29
      JP  = IPTRBK + 3
      FOR IP=IP1,IP9
        JP = JP + 1
        IDATA(JP) = IWRK(IP)
      CFOR
      IDATA(IPTRBK+47)=IWRK(HPTR0+46)
      IDATA(IPTRBK+48)=IWRK(HPTR0+47)
C
N     POINTER TO FIRST CELL -1
      IPCLL = IPTRBK + 33
      IPCLLM = IPCLL + 6
N     INITIALIZE CELL #
      JCELL0 = -1
C
      IF ITRBK.LE.MAXTRK
      THEN
N     SET HIT LABELS
N     LOOP OVER ALL HITS
      IPJET0 = HPTSEC(1)
      FOR IP=HPHT0,HPHT9,HLDHT
N       LABEL FOR BAD HITS
        LBBDHT = IWRK(IP+10)
N       SELECT ONLY ACCEPTED HITS
        IF LBBDHT.LE.1
        THEN
          LBBDHT = SHFTL(LBBDHT,9)
N         POINTER TO HIT LABEL IN CWORK
          IPHTLB = SHFTR((IWRK(IP+1)-IPJET0),1) + IPJHTL
N         TRACK NO
N         SET TRACK #
          LBHIT = ITRBK*2
N         SET L/R BIT
          IF(IWRK(IP+2).GT.0) LBHIT = LOR(LBHIT,256)
N         FETCH HIT LABEL OF TRACK
          LBHIT1 = HDATA(IPHTLB+1)
          LBHIT2 = HDATA(IPHTLB+2)
          IRES = ABS(WRK(IP+13)) * 5.
          IF(IRES.GT.31) IRES=31
          IRES=SHFTL(IRES,11)
          LBHIT=LBHIT+IRES
C     PRINT 2002, LBHIT,LBHIT1,LBHIT2
C2002 FORMAT(' LABEL:',10(2X,Z4))
C
          IF LAND(LBHIT1,MKBDHT).NE.0
N         PRIOR HIT IS BAD(XYFIT)
          THEN
            IF LBBDHT.EQ.0
N           THIS HIT IS GOOD
            THEN
              LBHIT1 = LBHIT
N             SET BIT FOR BAD Z-COORDINATE
              LBHIT1 = LOR(LBHIT1,1)
              LBHIT2 = 0
N           NEW HIT IS ALSO BAD
            ELSE
N             SET BIT FOR BAD  Z-COORDINATE
              LBHIT1 = LOR(LBHIT1,1)
              LBHIT  = LOR(LBHIT ,1)
              IF(LBHIT2.EQ.0) LBHIT2 = LOR(LBHIT,LBBDHT)
            CIF
N         NO BAD PRIOR HIT
          ELSE
            IF LBHIT1.EQ.0
N           FIRST TRACK FOR THIS HIT NOW
            THEN
              LBHIT1 = LOR(LBHIT,LBBDHT)
N             SET BIT FOR GOOD  Z-COORDINATE
              IF(IWRK(IP+7).EQ.0) LBHIT1 = LOR(LBHIT1,1)
N           SECOND TRACK FOR THIS HIT NOW
            ELSE
              IF LBBDHT.EQ.0
              THEN
                LBHIT2 = LOR(LBHIT,LBBDHT)
N               SET BIT FOR BAD Z-COORDINATE
                LBHIT1 = LOR(LBHIT1,1)
                LBHIT2 = LOR(LBHIT2,1)
              CIF
            CIF
          CIF
          HDATA(IPHTLB+1) = LBHIT1
          HDATA(IPHTLB+2) = LBHIT2
          JCELL = IWRK(IP+9)
          IF JCELL.NE.JCELL0
          THEN
            JCELL0 = JCELL
            IPCLL  = IPCLL + 1
            IF(IPCLL.GT.IPCLLM) IPCLL = IPCLLM
            IDATA(IPCLL) = JCELL0
          CIF
        CIF
      CFOR
C
      DATA NPR /0/
      NPR = NPR + 1
      I0 = IPTRBK + 1
      I9 = IPTRBK + LTRBK
C     IF(NPR.LE.12) PRINT 2904,(IDATA(I1),I1=I0,I9)
C2904 FORMAT(1H0,2I3,I8,2(I4,3F6.1,3F6.3),
C    ,     /,14X,I3,4E13.5,F6.2,I3,4E13.5,
C    ,     /,14X,I3,2F8.3,F6.1,I3,10X,6I3,5I6,2F6.0,I6,2X,Z4)
      CIF
C
N     INCREASE POINTER TO TRACK BANK
      IPTRBK = IPTRBK + LTRBK
C
      CPROC
C
      END
C   29/10/80 405092108  MEMBER NAME  TRACEO   (PATRECSR)    SHELTRAN
      SUBROUTINE TRACEO(ITRK,PAR1,PAR2,PAR3)
C
C        FIND HITS OF TRACKS FROM ORIGIN
C        P. STEFFEN                     2/07/80
C
      IMPLICIT INTEGER*2 (H)
      LOGICAL DEADCL
C
#include "cheadr.for"
      EQUIVALENCE (HHEADR(18),HRUN)
C
#include "cdata.for"
#include "ccycp.for"
C
#include "cworkpr.for"
#include "cworkeq.for"
C
      EQUIVALENCE
     ,          (HPCO0 ,HPWRK(17)),(HPCO9 ,HPWRK(18)),(HLDCO ,HPWRK(19))
     ,         ,(ICELL ,IDWRK( 1)),(MHIT  ,IDWRK( 2)),(IRING ,IDWRK( 3))
     ,         ,(IERRCD,IDWRK( 4)),(NTRKEL,IDWRK( 5))
C
#include "cpatlm.for"
C
#include "cjdrch.for"
#include "cdsmax.for"
C
#include "calibr.for"
C
      DIMENSION ITRCLL(6),CSRCLL(6),SNRCLL(6), NCNCK(24)
      DIMENSION CSRNG1(3),SNRNG1(3),CSRNG3(4),SNRNG3(4)
C
N     CONSTANTS FOR ANGULAR CORRECTION
      DATA NCOAR / 15/, DTGB / .15/
      REAL TGCOAR(15) /-99.,-.45, 12*0., 99./
      REAL T0COAR(60) / .000, .000, .000, .000, .000,
     ,     .000, .000,-.020,-.060,-.130,-.030, .100, .200, .200, .200,
     ,                  .000, .000, .010, .110, .100,
     ,     .075, .050, .025, .005, .015, .065, .060, .060, .060, .060,
     ,                  .190, .190, .180, .165, .140,
     ,     .120, .100, .075, .050, .010,-.050,-.075,-.035, .000, .000,
     ,                  .110, .110, .115, .140, .135,
     ,     .085, .045, .030, .040, .050, .055, .055, .055, .055, .055/
      REAL SLCOAR(60) / 60*0./
C
N     MASK FOR TRACKS AT CELL WALL + IN DEAD CELLS
      INTEGER MKBDCL(3) /Z10,Z20,Z40/
      INTEGER MKDDCL(3) /Z01,Z02,Z04/
C
C     IF(ICELL.GT.84) RETURN
C     PRINT 2900, IRING, ICELL, ITRK,PAR1,PAR2,PAR3
C     PRINT 2901, (WRK(I1),I1=HPHT0,HPHT9)
C2900 FORMAT(1H0,'RING:',I4, ', ICELL:',I3,', TRACK:',I4,3F10.5)
C2901 FORMAT(1X,/,(1X,2I6,2F6.2,2X,Z4,4F7.1,2I6,F6.2))
C2902 FORMAT(/,(1X,3I6,4F8.5,I3,2F6.2,I3,2F6.2,2X,Z4,2X,Z4,2X,Z5,F6.2))
C2904 FORMAT(1H0,2I3,I8,2(I4,3F6.1,3F6.3),
C    ,     /,14X,I3,4E13.5,F6.2,I3,4E13.5,
C    ,     /,14X,I3,2F8.3,F6.1,I3,10X,6I3,8I6,2X,Z4)
C2001 FORMAT('0TRACK0-INIT.:',3F10.5,F10.3,3F10.5,2F6.2)
C2002 FORMAT('0FETCH:',4I6,F10.1,6F9.5)
C2003 FORMAT('0ROTATION:',10F10.5)
C2004 FORMAT('0WALLS:',2I3,3F10.5)
C2005 FORMAT('0TRACK:',I6,/,(1X,3I6,4F9.5,I4,F9.5,2I4,F9.5,I6,F9.5))
C2006 FORMAT(1X,I6,5F8.2,F12.1,5F8.2)
C2007 FORMAT(' SIDE?',3I6,3F8.1)
C2008 FORMAT(' FIT:',2I3,F8.2,F5.0,F10.6,F7.3,F5.1,F6.3,F5.1)
C2009 FORMAT(' ROTATION:',2I6,10F10.5)
C2010 FORMAT(' HIT:',I6,12F8.2)
C2012 FORMAT('0FITBNK:',2I3,8F9.5)
C2014 FORMAT('0FIT-BANK:',5F8.3,5X,5F8.3,5X,F8.5,2F8.1)
C2015 FORMAT(' SELCLL:',2I4,8F8.3)
C2016 FORMAT('0ITRCLL =',6I8,/,(9X,6F8.3))
C2019 FORMAT(' TRACK IN DEAD CELL:',10I6)
C2107 FORMAT(' SIGLM:',10F8.3)
C
N     INITIALIZATION
      DATA LBINIT /0/
      IF LBINIT .EQ. 0
      THEN
        LBINIT = 1
        PERFORM INIT
      CIF
C
N     RESERVE SPACE IN CWORK
      HPCO0  = HPFREE
      HLDCO  = 14
      HPFREE = HLDCO*100 + HPCO0
      HPCO9 = HPFREE - 1
      IPCOMX= HPFREE - HLDCO
C
N     LOAD RADIUS AND WIRE SPACING
      R0 = FSENSW(IRING)
      DR = RINCR (IRING)
C
N     ROTAION ANGLE
      X0    = DR*15. + R0
      Y0    = (PAR1*X0 + PAR2) * X0
      TGROT = Y0 / X0
      CSROT = 1. / SQRT(TGROT**2 + 1.)
      SNROT = CSROT*TGROT
      CSROT0= CSROT
      SNROT0= SNROT
C     PRINT 2003, TGROT,CSROT,SNROT,X0,Y0,PAR1,PAR2,PAR3,WGHT0,Y0
C
N     PREPARE COORDINATE ARRAY
      PERFORM PRCOAR
C
N     REFIT PARABOLA THROUGH ORIGIN
      WGHT0 = .01
      Y0    = 0.
      PERFORM FPARA0
      IF(S0.LT.3.5 .OR. SIG.GT.100.) RETURN
C
N     CHECK IF DIST. TO ORIGIN ACCEPTABLE
      DORIG = PAR3
      IF(PAR1.LT.0) DORIG =-PAR3
      IF DORIG.GT.11. .OR. DORIG.LT.-3.
      THEN
N       TOO BIG DIST., REPEAT FIT WITH RESTRICTION
        WGHT0 = 1.0
        Y0 = SIGN(10.,PAR1)
        IF(DORIG.LT.0) Y0 =-SIGN(2.,PAR1)
        PERFORM FPARA0
      CIF
C
N     CHECK IF GOOD FIT
      IF(SIG.GT.0.15) RETURN
      IF(S0 .LT. 4.5) RETURN
      IF(SIG.GT.0.06 .AND. S0 .LT. 6.5) RETURN
C
N     START TRACING INWARDS
      JCELL = ICELL
      JRING = IRING
C
N     SELECT CELLS
      PERFORM SELCLL
C
N     LOOP OVER ALL CELLS + FETCH HITS
      KCLL = 0
      NHIT = 0
      IPCO = HPCO0
C
N     LOOP OVER RINGS
      JRING = 0
N     INITIALIZE LABEL FOR DEAD CELLS +
N     TRACKS AT CELL WALLS
      LBCELL = 0
N     INITIALIZE LABEL FOR >100 HITS
      LBHTMX = 0
      REPEAT
      JRING = JRING + 1
        NHRNG = 0
        NCLL = 0
        REPEAT
        NCLL = NCLL + 1
        KCLL = KCLL + 1
          JCELL = ITRCLL(KCLL)
          IF JCELL.NE.0
          THEN
            CSROT = CSRCLL(KCLL)
            SNROT = SNRCLL(KCLL)
            PERFORM FETCH
            NHRNG = NHRNG + JHIT
N           STOP IF > 100 HITS FOR THIS TRACK
            IF(LBHTMX.NE.0) RETURN
          CIF
        UNTIL NCLL.EQ.2
        IF(NHRNG.LT.2 .AND. JRING.LT.IRING) RETURN
N       SET LABEL FOR TRACK AT CELL BOUND.
        IF(JCELL.NE.0) LBCELL = LOR(MKBDCL(JRING),LBCELL)
      UNTIL KCLL.EQ.6
      HPCO9 = IPCO - 1
C
N     LABEL HITS BELONGING TO TRACK
      CALL LBHTRO(ITRK,PAR1,PAR2,PAR3,INDPAR)
C     PRINT 2005, INDPAR,(WRK(I),I=HPCO0,HPCO9)
C
N     FIT PARABOLA
      IF INDPAR.EQ.0
      THEN
        WGHT0 = 0.10
        Y0 = 0.
      ELSE
        WGHT0 = 0.03
        Y0 = PAR3
      CIF
      PERFORM FPARA0
      IF(S0.LT.3.5 .OR. SIG.GT.100.) RETURN
C
N     RELABEL HITS
      ALBLM1 = 0.6
      ALBLM2 = 3.0
      PERFORM LABEL
C
N     REFIT PARABOLA
      WGHT0 = PATRLM(2)
      SIG0  = SIG
      PERFORM FPARA0
C
N     STOP IF <8 GOOD HITS OR BAD FIT
      IF(S0.LT.7.5 .OR. SIG.GT.100.) RETURN
C
N     RELABEL HITS
      ALBLM1 = 0.6
      ALBLM2 = 3.0
      PERFORM LABEL
C
N     REFIT IF MORE THAN 4 NEW HITS LABELED
      WHILE  NHITLB-S0 .GT. 4.5 .OR. SIG0-SIG.GT..25
        SIG0  = SIG
        PERFORM FPARA0
        PERFORM LABEL
      CWHILE
C     PRINT 2005, INDPAR,(WRK(I),I=HPCO0,HPCO9)
C
N     CHECK IF ACCEPTABLE TRACK
      IF SIG.LE.0.1225
      THEN
C
N       CHECK IF GOOD TRACK
        CALL CKTRKO(LBCKTR,LBCELL)
        IF(LBCKTR.LE.16) RETURN
C
N       SET UP FIT-BANK
        PERFORM FITBNK
N       STORE TRACK IN 'PATR'-BANK
N       AND REGISTER HITS IN 'JHTL'-BANK
        HPHT0S = HPHT0
        HPHT9S = HPHT9
        HLDHTS = HLDHT
        HPHT0  = HPCO0
        HPHT9  = HPCO9
        HLDHT  = HLDCO
C
        CALL STTRKO(LBCKTR)
C
        HPHT0  = HPHT0S
        HPHT9  = HPHT9S
        HLDHT  = HLDHTS
      CIF
      RETURN
C
C
N     *************************
N     *      P R C O A R      *
N     *************************
C
C
N     PREPARE COORDINATE ARRAY
      PROC PRCOAR
C
N     ANGLE OF TRACK IN RING
      XR1  = DR*7.5 + R0
      TGB  = PAR1*XR1 * 2. + PAR2
      CSB  = 1. / SQRT(TGB**2+1.)
      SNB  = CSB * TGB
C
N     CALCULATE X,Y COORDINATES + FILL ARRAY
      DRISN  = SINDRI(ICELL,1)
      DRICS  = COSDRI(ICELL,1)
      IHIT = 0
      IPCO = HPCO0
      IP = HPHT9 - HLDHT + 1
C     PRINT 2002, IRING,ICELL,IP,HPHT0,XR1,TGB,SNB,CSB,DRISN,DRICS
      REPEAT
        LBSIDE  = 0
        LBGOOD = 0
        IF IABS(IWRK(IP+ 9)).EQ.ITRK
        THEN
          LBSIDE = -1
          IF(LAND(IWRK(IP+4),2).NE.0) LBSIDE = 1
          IF(IWRK(IP+ 9).LT.0) LBGOOD = 1
        ELSE
        IF IABS(IWRK(IP+10)).EQ.ITRK
        THEN
          LBSIDE = -1
          IF(LAND(IWRK(IP+4),8).NE.0) LBSIDE = 1
          IF(IWRK(IP+10).LT.0) LBGOOD = 1
        CIF
        CIF
C
N       CHECK IF SELECTED HIT
        IF LBSIDE.NE.0
        THEN
          ILAY = IWRK(IP  )
          Y    = SWDEPL
          IF(LAND(ILAY,1).NE.0) Y =-Y
          DS   =  WRK(IP+2)
          X    = ILAY * DR + R0
          IF DS.LE.DRC
          THEN
            DX   =-DS * SNB
            DY   = DS * CSB
          ELSE
            DX   =-(DS-DRC)*DRISN - DRC*SNB
            DY   = (DS-DRC)*DRICS + DRC*CSB
          CIF
          X    = DX*LBSIDE + X
          Y    = DY*LBSIDE + Y
          XX   = X*CSROT + Y*SNROT
          YY   =-X*SNROT + Y*CSROT
C
          IF(LBGOOD.LE.2) IHIT = IHIT + 1
C
N         FILL COORDINATE ARRAY
          IWRK(IPCO   ) = ILAY
          IWRK(IPCO+ 1) = IWRK(IP+1)
          IWRK(IPCO+ 2) = LBSIDE
          WRK (IPCO+ 3) = XX
          WRK (IPCO+ 4) = YY
          WRK (IPCO+ 5) = 0.
          WRK (IPCO+ 6) = 0.
          IWRK(IPCO+ 7) = LBGOOD
          WRK (IPCO+ 8) = DS
          IWRK(IPCO+ 9) = ICELL
          IWRK(IPCO+10) = LBGOOD
          WRK (IPCO+11) = TGB
          IWRK(IPCO+12) = IRING
          WRK (IPCO+13) = 0.
          IPCO = IPCO + HLDCO
        CIF
      IP = IP - HLDHT
      UNTIL IP.LT.HPHT0
      NHIT = IHIT
      HPCO9 = IPCO - 1
C     PRINT 2005, NHIT,(WRK(I),I=HPCO0,HPCO9)
C
      CPROC
C
N     *************************
N     *      F P A R A 0      *
N     *************************
C
C
N     PARABOLA FIT THROUG ORIGIN
      PROC FPARA0
C
N     GET EQUATIONS
N     WEIGHT ORIGIN AS POINT OF PARABOLA
      S0 = WGHT0
      S1 = 0.
      S2 = 0.
      S3 = 0.
      S4 = 0.
      S5 = 0.
      S6 = 0.
      S7 = Y0 * WGHT0
      IPCO = HPCO0
      REPEAT
       IF IWRK(IPCO+ 7).EQ.0
       THEN
          X = WRK(IPCO+3)
          Y = WRK(IPCO+4)
          X2 = X**2
          S1 = S1 + X
          S2 = S2 + X2
          S3 = S3 + X*X2
          S4 = S4 + X2**2
          S5 = S5 + Y*X2
          S6 = S6 + Y*X
          S7 = S7 + Y
          S0 = S0 + 1.
        CIF
      IPCO = IPCO + HLDCO
      UNTIL IPCO.GT.HPCO9
C
N     CALCULATE PARAMETERS
C
      IF S0.LT.3.5
      THEN
        SIG = 1000.
      ELSE
C
N       SOLVE EQUATIONS FOR PARABOLA FIT
        F1 = 1. / S4
        XX12 = S3*F1
        XX13 = S2*F1
        YY1  = S5*F1
        XX22 = S2 - S3*XX12
        XX23 = S1 - S3*XX13
        YY2  = S6 - S3*YY1
        XX32 = S1 - S2*XX12
        XX33 = S0 - S2*XX13
        YY3  = S7 - S2*YY1
        IF XX22.GT.XX32
        THEN
          XX23 = XX23 / XX22
          YY2  = YY2  / XX22
          DET  = XX33 - XX32*XX23
          IF ABS(DET).GT.1.E-30
          THEN
            PAR3 = (YY3 - XX32*YY2) / DET
            PAR2 = YY2 - XX23*PAR3
          CIF
        ELSE
          XX33 = XX33 / XX32
          YY3  = YY3  / XX32
          DET  = XX23 - XX22*XX33
          IF ABS(DET).GT.1.E-30
          THEN
            PAR3 = (YY2 - XX22*YY3) / DET
            PAR2 = YY3 - XX33*PAR3
          CIF
        CIF
      IF ABS(DET).LE.1.E-30
      THEN
        SIG = 1000.
      ELSE
        PAR1 = YY1 - XX12*PAR2 - XX13*PAR3
        DEG = S0 - WGHT0 - 2.
        IF(WGHT0.LT..001) DEG = DEG - 1.
C
C
N       CALC. CHISQ + SOLVE L/R AMBIGUITY
        CHISQ = 0.
        DCHIM1 = 0.
        IHITM1 = 0
        IPCO = HPCO0
        REPEAT
         IF IWRK(IPCO+ 7).EQ.0
         THEN
            X = WRK(IPCO+3)
            Y = WRK(IPCO+4)
            F = (PAR1 *X + PAR2 )*X + PAR3
            DCHI = Y - F
            WRK(IPCO+13) = DCHI
N           SUM FOR RMS
            CHISQ = CHISQ + DCHI**2
N           KEEP BIGGEST RMS
C           IF ABS(DCHI).GE.DCHIM1
C           THEN
C             DCHIM1 = ABS(DCHI)
C             IHITM1 = IPCO
C           CIF
C     PRINT 2006, IPCO,X,Y,F,DCHI,CHISQ
          CIF
        IPCO = IPCO + HLDCO
        UNTIL IPCO.GT.HPCO9
        SIG    =      CHISQ  / DEG
C     PRINT 2008, IWRK(IHSTRT),IWRK(IHEND),SIG,DEG,PAR1,PAR2,PAR3,
C    ,            WGHT0,Y0
C
N       SET LIMIT FOR SIGMA
        SIGLM = TRELLM(16)**2
C
      CIF
      CIF
C
      CPROC
C
N     *************************
N     *      S E L C L L      *
N     *************************
C
C
N     SELECT CELLS CONTAINING TRACK
      PROC SELCLL
C
N       BASIC CELL #
        ICELL0 = ICELL - 1
        IF(ICELL.GT.24) ICELL0 = ICELL - 25
        IF(ICELL.GT.48) ICELL0 = (ICELL-49)/2
C
N       ROTATION INTO BASIC CELL SYSTEM
        IF IRING.NE.3
        THEN
          TGR1 = TGROT
          SNR1 = SNROT
          CSR1 = CSROT
        ELSE
          IF LAND(ICELL,1).EQ.0
          THEN
            CSR1 = CSROT*CSFI3 - SNROT*SNFI3
            SNR1 = CSROT*SNFI3 + SNROT*CSFI3
          ELSE
            CSR1 = CSROT*CSFI3 + SNROT*SNFI3
            SNR1 =-CSROT*SNFI3 + SNROT*CSFI3
          CIF
          TGR1 = SNR1 / CSR1
        CIF
C     PRINT 2015, ICELL,ICELL0,SNR1,CSR1,TGR1,SNROT,CSROT,SNFI3,CSFI3
C
N       LOOP OVER ALL RINGS
        JRING = 0
        WHILE JRING.LT.3
        JRING = JRING + 1
C
N         1. + LAST POINT IN RING
          R0 = FSENSW(JRING)
          DR = RINCR (JRING)
          X1 = R0 - DR*2.
          X2 = R0 + DR*17.
          Y1 = (PAR1*X1 + PAR2)*X1 + PAR3
          Y2 = (PAR1*X2 + PAR2)*X2 + PAR3
N         ROTATE POINTS INTO CELL SYSTEM
          XX1 = X1*CSR1 - Y1*SNR1
          YY1 = X1*SNR1 + Y1*CSR1
          XX2 = X2*CSR1 - Y2*SNR1
          YY2 = X2*SNR1 + Y2*CSR1
C     PRINT 2015, JRING,ICELL0,XX1,YY1,XX2,YY2,R0,DR
C
N         FIND CELLS
          ICELL1 = 0
          LBINV  = 0
          REPEAT
          IF JRING.EQ.3
          THEN
N           RING 3
N           CHECK IF TRACK PASSES CENTRAL WALL
            IF ABS(YY1).LT.3.0 .OR. ABS(YY2).LT.3.0 .OR. YY1*YY2.LE.0.
            THEN
              ICELL1 =  2
              LBINV = 1
              IF(YY1.GT.YY2) LBINV =-1
              XREPEAT
            CIF
N           CHECK IF TRACK PASSES SIDE WALL
            DY1 = ABS(YY1) - TGFI1*XX1
            DY2 = ABS(YY2) - TGFI1*XX2
            IF ABS(DY1).LT.3.0 .OR. ABS(DY2).LT.3.0 .OR. DY1*DY2.LE.0.
            THEN
              ICELL1 =  1
              IF(YY1.GT.0) ICELL1 = 3
              LBINV  = 1
              IF((DY2-DY1)*YY1 .LT. 0.) LBINV =-1
              XREPEAT
            CIF
N           TRACK STAYS IN ONE CELL
            ICELL1 =  2
            IF(YY1.GT.0.) ICELL1 = 3
            IF DY1.GT.0
            THEN
              ICELL1 =  1
              IF(YY1.GT.0.) ICELL1 = 4
            CIF
            XREPEAT
          CIF
C
N         RING 1, 2
N         CHECK IF TRACK PASSES SIDE WALL
          DY1 = ABS(YY1) - TGFI1*XX1
          DY2 = ABS(YY2) - TGFI1*XX2
          IF ABS(DY1).LT.3.0 .OR. ABS(DY2).LT.3.0 .OR. DY1*DY2.LE.0.
          THEN
            ICELL1 =  1
            IF(YY1.GT.0) ICELL1 = 2
            LBINV  =  1
            IF((DY2-DY1)*YY1.LT.0.) LBINV =-1
            XREPEAT
          CIF
N         TRACK STAYS IN ONE CELL
          ICELL1 =  2
          IF DY1.GT.0.
          THEN
            ICELL1 =  1
            IF(YY1.GT.0.) ICELL1 = 3
          CIF
          UNTIL .TRUE.
C     PRINT 2015, ICELL1,LBINV ,DY1,DY2
C
N         GET CELL # AND ROTATION MATRIX
          IC2 = 0
          CSROT2 = 0.
          SNROT2 = 0.
          IF JRING.NE.3
          THEN
            IC1 = ICELL1 + ICELL0 - 1
            IF(IC1.LT. 1)  IC1 = IC1 + 24
            IF(IC1.GT.24)  IC1 = IC1 - 24
            IF(JRING.EQ.2) IC1 = IC1 + 24
N           ROTATION MATRIX
            CSROT1 = CSRNG1(ICELL1)
            SNROT1 = SNRNG1(ICELL1)
C
            IF LBINV.NE.0
            THEN
              IC2 = ICELL1 + ICELL0
              IF(IC2.LT. 1)  IC2 = IC2 + 24
              IF(IC2.GT.24)  IC2 = IC2 - 24
              IF(JRING.EQ.2) IC2 = IC2 + 24
N             ROTATION MATRIX
              CSROT2 = CSRNG1(ICELL1+1)
              SNROT2 = SNRNG1(ICELL1+1)
            CIF
          ELSE
            IC1 = ICELL1 + ICELL0*2 + 47
            IF(IC1.LT.49)  IC1 = IC1 + 48
            IF(IC1.GT.96)  IC1 = IC1 - 48
N           ROTATION MATRIX
            CSROT1 = CSRNG3(ICELL1)
            SNROT1 = SNRNG3(ICELL1)
C
            IF LBINV.NE.0
            THEN
              IC2 = ICELL1 + ICELL0*2 + 48
              IF(IC2.LT.49)  IC2 = IC2 + 48
              IF(IC2.GT.96)  IC2 = IC2 - 48
N             ROTATION MATRIX
              CSROT2 = CSRNG3(ICELL1+1)
              SNROT2 = SNRNG3(ICELL1+1)
            CIF
          CIF
C
N         REVERSE ORDER OF CELLS IF NECESSAIRY
          IF LBINV.LT.0
          THEN
            IZW    = IC2
            IC2    = IC1
            IC1    = IZW
            ZWZ    = CSROT2
            CSROT2 = CSROT1
            CSROT1 = ZWZ
            ZWZ    = SNROT2
            SNROT2 = SNROT1
            SNROT1 = ZWZ
          CIF
C
C     PRINT 2015, IC1,IC2,CSROT1,SNROT1,CSROT2,SNROT2
          ITRCLL(JRING*2-1) = IC1
          ITRCLL(JRING*2  ) = IC2
          CSRCLL(JRING*2-1) = CSROT1*CSR1 + SNROT1*SNR1
          SNRCLL(JRING*2-1) =-SNROT1*CSR1 + CSROT1*SNR1
          CSRCLL(JRING*2  ) = CSROT2*CSR1 + SNROT2*SNR1
          SNRCLL(JRING*2  ) =-SNROT2*CSR1 + CSROT2*SNR1
        CWHILE
C     PRINT 2016, ITRCLL,CSRCLL,SNRCLL
      CPROC
C
N     *************************
N     *      F E T C H        *
N     *************************
C
C
N     FETCH HITS IN CELL
      PROC FETCH
C
N       LOAD RADIUS AND WIRE SPACING
        R0 = FSENSW(JRING)
        DR = RINCR (JRING)
C
N       ANGLE OF TRACK IN RING
        XR1  = DR*7.5 + R0
        TGB  = PAR1*XR1 * 2. + PAR2
        XX   = 1. / SQRT(TGB**2+1.)
        YY   = XX * TGB
N       ROTATE
        CSB  = XX*CSROT - YY*SNROT
        SNB  = XX*SNROT + YY*CSROT
        TGB  = SNB/CSB
C
C
N       SET DRIFT SPACE BIN
        DSBIN1 = DRIVEL(JCELL,1)
        DS0 = 0.
        IF(HRUN.LE.100) DS0 = DSBIN1*.5
        DRISN  = SINDRI(JCELL,1)
        DRICS  = COSDRI(JCELL,1)
        DRISNF = DRISN * .05
        DRITG  = DRISN/DRICS
N       ANGLE(TRACK,DRIFT DIRECT.)
        TANBET = (DRITG - TGB) / (TGB*DRITG + 1.)
C
N       SET ANGULAR CORRECTION
        FOR I1=1,NCOAR
          IDX = I1
          IF(TANBET.LT.TGCOAR(IDX)) XFOR
        CFOR
        KRNG = JRING
        IF(KRNG.EQ.3 .AND. AND(JCELL,1).EQ.0) KRNG = 4
        IBIN = (KRNG-1)*NCOAR  + IDX
        T0CORR = (TANBET-TGCOAR(IDX)) * SLCOAR(IBIN) + T0COAR(IBIN)
C
N       CORRECTION CONSTANTS FOR JCELL
        IPJCOR = ICALIB(5) + JCELL
        CCST01 = ACALIB(IPJCOR     ) * ABS(TANBET)
        CCST02 = ACALIB(IPJCOR+  96) * ABS(TANBET)
        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)
N       CORRECTION CONSTANTS FOR JCELL
C     PRINT 2002, IRING,ICELL,IP,HPHT0,XR1,CCST01,CCST02,CCST11,CCST12,
C    ,            CCST21,CCST22
N       COUNTER FOR NUMBER OF HITS FOUND
        JHIT = 0
        NHIT   = 0
        NHGOOD = 0
N       PRESET LAST LAYER
        ILAYL =-99
N       LOOP OVER ALL HITS OF CELL
        IPCO = IPCO - HLDCO
        IP9 = HPTSEC(JCELL+1)
        IP  = HPTSEC(JCELL  )
C     PRINT 2002, JRING,JCELL,IP,IP9,XR1,TGB,SNB,CSB,DRISN,DRICS,TANBET
        WHILE IP.LT.IP9
          IWIR = HDATA(IP)
          IWIR = SHFTR(IWIR,3)
N         LAYER NUMBER WITHIN RING 3
          ILAY = LAND(IWIR,15)
N         DRIFT SPACE
          DS =(HDATA(IP+3)) * DSBIN1
          DSC = DS + DS0
          Y    = SWDEPL
          IF(LAND(ILAY,1).NE.0) Y  =-Y
          Y    = (7.5-ILAY)*CCST51 - CCST61 + Y
          X    = ILAY * DR + R0
          IF DSC.LE.DRC
          THEN
            IF DSC.LT.DSD2
            THEN
              IF DSC.LT.DSD1
              THEN
                DSC = DSC + DDS1 + (DSC-DSD1)*DRV1
              ELSE
                DSC = DSC + DDS2 + (DSC-DSD2)*DRV2
              CIF
              IF(DSC.LT.0.1) DSC = 0.1
            ELSE
N             ANGULAR CORRECTION
              DSC = (DSC-DSD2)/(DRC-DSD2) * T0CORR + DSC
            CIF
            DXR  =-DSC * SNB
            DYR  = DSC * CSB
            DXL  =-DXR
            DYL  =-DYR
          ELSE
C
N           ANGULAR CORRECTION
            DSC = DSC + T0CORR
N           EDGE WIRE FIELD DISTORTION
            IF ILAY.LT. 3
            THEN
              DILAY =-(ILAY- 3)**2
              DSCL  = (DILAY*CCST11 + 1.) * DSC * (1. - CCST81)
              DSCR  = (DILAY*CCST12 + 1.) * DSC * (1. + CCST81)
            ELSE
            IF ILAY.GT.12
            THEN
              DILAY =-(ILAY-12)**2
              DSCL  = (DILAY*CCST21 + 1.) * DSC * (1. - CCST81)
              DSCR  = (DILAY*CCST22 + 1.) * DSC * (1. + CCST81)
            ELSE
              DSCL = DSC * (1. - CCST81)
              DSCR = DSC * (1. + CCST81)
            CIF
            CIF
C
N           FIELD DISTORTIONS AT LARGE DRIFT TIMES
            IF DSC.GT.ABERR(7)
            THEN
              DWIR  = ILAY - 7.5
              DWIRC = DSC*DRISNF
              DWIRL = DWIR + DWIRC
              DWIRR = DWIR - DWIRC
              DSCL  = (DSCL-ABERR(7))*DWIRL*CCST01 + DSCL
              DSCR  =-(DSCR-ABERR(7))*DWIRR*CCST02 + DSCR
            CIF
            DXR  =-(DSCR-DRC)*DRISN - DRC*SNB
            DYR  = (DSCR-DRC)*DRICS + DRC*CSB
            DXL  = (DSCL-DRC)*DRISN + DRC*SNB
            DYL  =-(DSCL-DRC)*DRICS - DRC*CSB
          CIF
          XL   = DXL + X
          YL   = DYL + Y
          XXL  = XL*CSROT + YL*SNROT
          YYL  =-XL*SNROT + YL*CSROT
          FL   = (PAR1*XXL + PAR2)*XXL + PAR3
          DFL  = FL - YYL
          XR   = DXR + X
          YR   = DYR + Y
          XXR  = XR*CSROT + YR*SNROT
          YYR  =-XR*SNROT + YR*CSROT
          FR   = (PAR1*XXR + PAR2)*XXR + PAR3
          DFR  = YYR - FR
N         SET ARRAY
C     PRINT 2010, ILAY,DS,DSC,DSCL,DSCR,XL,XR,X,Y,DXL,DXR,DYL,DYR
C
N         CHECK IF LEFT + RIGHT SOLUTION POSSIBLE
          NLRSOL = 1
          IF(DSC.LT.2.0 .AND. DSC.NE.0 .AND. JCELL.NE.ICELL) NLRSOL = 2
C
N         LOOP OVER LEFT +/OR RIGHT SOLUTION
          ILRSOL = 0
          REPEAT
          ILRSOL = ILRSOL + 1
C
N           SELECT SIDE
            IF NLRSOL.EQ.1 .AND. ABS(DFL).LT.ABS(DFR) .OR.
     ?         NLRSOL.EQ.2 .AND. ILRSOL.EQ.1
            THEN
N             LEFT SIDE
              LBSIDE =-1
              XX  = XXL
              YY  = YYL
              DF  = DFL
            ELSE
N             RIGHT SIDE
              LBSIDE = 1
              XX  = XXR
              YY  = YYR
              DF  = DFR
            CIF
C
N           HIT QUALITY:
            LBGOOD = 0
            IF(ABS(DF).GT.2.0) LBGOOD = 1
            IF(ABS(DF).GT.5.0) LBGOOD = 8
            IF(DF.LE.-10.0) LBGOOD = 4
            IF(DF.GT.-10.0 .AND. DF.LT.-5.0) LBGOOD = 2
N           NEW LAYER?
            IF ILAY.NE.ILAYL .OR. LBGDL.LE.1.AND.LBGOOD.LE.1
            THEN
              LBREG = 1
N             INCREASE HIT COUNTER
              JHIT = JHIT + 1
              IPCO = IPCO + HLDCO
            ELSE
N             2 HITS IN SAME LAYER, SELECT CLOSEST
              LBREG = 0
              IF(LBGOOD.LT.IWRK(IPCO+7)) LBREG = 1
            IF(LBGOOD.GE.4 .AND. ABS(DF).LT.ABS(WRK(IPCO+13))) LBREG = 1
            CIF
N           REGISTER NEW HIT?
            IF LBREG.NE.0
            THEN
N             STOP IF > 100 HITS
              IF IPCO.GT.IPCOMX
              THEN
                LBHTMX = 1
                XWHILE
               CIF

              NHIT   = NHIT   + 1
              IF(LBGOOD.LE.1) NHGOOD = NHGOOD + 1
              IWRK(IPCO   ) = ILAY
              IWRK(IPCO+ 1) = IP
              IWRK(IPCO+ 2) = LBSIDE
              WRK (IPCO+ 3) = XX
              WRK (IPCO+ 4) = YY
              WRK (IPCO+ 5) = 0.
              WRK (IPCO+ 6) = 0.
              IWRK(IPCO+ 7) = LBGOOD
              WRK (IPCO+ 8) = DSC
              IWRK(IPCO+ 9) = JCELL
              IWRK(IPCO+10) = LBGOOD
              WRK (IPCO+11) = TANBET
              IWRK(IPCO+12) = JRING
              WRK (IPCO+13) = DF
              ILAYL = ILAY
              LBGDL = LBGOOD
            CIF
C
          UNTIL ILRSOL.GE.NLRSOL
C
        IP = IP + 4
        CWHILE
C
N       CHECK IF <100 HITS
        IF LBHTMX.EQ.0
        THEN
N         SET IPCO TO 1. FREE LOCATION
          IPCO = IPCO + HLDCO
C
N         SET LABEL FOR DEAD CELL
          IF NHIT.LE.2
          THEN
            NRUN = HRUN
            IF DEADCL(JCELL,NRUN)
            THEN
              LBCELL = LOR(LBCELL,MKDDCL(JRING))
              JHIT = 16
              NHIT = 16
C     PRINT 2019, JCELL,JRING,NRUN,LBCELL
            CIF
          CIF
C
        CIF
      CPROC
C
N     *************************
N     *      F I T B N K      *
N     *************************
C
C
N     SET UP FIT-BANK
      PROC FITBNK
C
N     START + END POINTS
      XST = 10000.
      XEN =     0.
      FOR IPCO = HPCO0,HPCO9,HLDCO
        IF IWRK(IPCO+7).EQ.0
        THEN
          X = WRK(IPCO+3)
          IF(X.GT.XEN) XEN = X
          IF(X.LT.XST) XST = X
        CIF
      CFOR
      YST = (PAR1*XST + PAR2)*XST + PAR3
      YEN = (PAR1*XEN + PAR2)*XEN + PAR3
N     DIRECTION AT START + END POINT
      TGST = PAR1*XST*2 + PAR2
      DXST = 1./SQRT(TGST**2+1.)
      DYST = DXST * TGST
      TGEN = PAR1*XEN*2 + PAR2
      DXEN = 1./SQRT(TGEN**2+1.)
      DYEN = DXEN * TGEN
N     MIN. OF PARABOLA
      XMIN = -PAR2*.5 / PAR1
      YMIN = (PAR1*XMIN + PAR2)*XMIN + PAR3
N     CURVATURE
C     CURV =-PAR1 * 2.
      CVZW = TGST**2+1.
      CVST =-PAR1 * 2 / (SQRT(CVZW)*CVZW)
C
C     PRINT 2014, XST,YST,DXST,DYST,TGST,XEN,YEN,DXEN,DYEN,TGEN,CURV,
C    ,            XMIN,YMIN
C
N     DIRECTION FOR ROTATION
      JCELLD = ICELL
      IF(ICELL.GT.24) JCELLD = ICELL - 24
      IF(ICELL.GT.48) JCELLD = ICELL - 48
      IF IRING.NE.3
      THEN
        DXWR  = DIRWR1(JCELLD,1)
        DYWR  = DIRWR1(JCELLD,2)
      ELSE
        DXWR  = DIRWR3(JCELLD,1)
        DYWR  = DIRWR3(JCELLD,2)
      CIF
C
N     ROTATION INTO CELL SYSTEM
      XX = DXWR*CSROT0 - DYWR*SNROT0
      YY = DXWR*SNROT0 + DYWR*CSROT0
      UN = SQRT(XX**2 + YY**2)
C
C     PRINT 2012,ICELL,JCELLD,DXWR,DYWR,CSROT0,SNROT0,XX,YY,UN
      CSROT = XX
      SNROT = YY
C
N     FILL FIT-BANK
      HPTR0 = HPFREE
      IP    = HPTR0 - 1
      IWRK(IP+ 1) = 0
      IWRK(IP+ 2) = 16
      IWRK(IP+ 3) = 0
      IWRK(IP+ 4) = INDPAR + 1
      WRK (IP+ 5) = XST *CSROT - YST *SNROT
      WRK (IP+ 6) = XST *SNROT + YST *CSROT
      WRK (IP+ 7) = SQRT(WRK(IP+ 5)**2 + WRK(IP+ 6)**2)
      WRK (IP+ 8) = DXST*CSROT - DYST*SNROT
      WRK (IP+ 9) = DXST*SNROT + DYST*CSROT
      WRK (IP+10) = 1.
      IWRK(IP+11) = 0
      WRK (IP+12) = XEN *CSROT - YEN *SNROT
      WRK (IP+13) = XEN *SNROT + YEN *CSROT
      WRK (IP+14) = SQRT(WRK(IP+12)**2 + WRK(IP+13)**2)
      WRK (IP+15) = DXEN*CSROT - DYEN*SNROT
      WRK (IP+16) = DXEN*SNROT + DYEN*CSROT
      WRK (IP+17) = 1.
      IWRK(IP+18) = 2
      WRK (IP+19) = ATAN2(SNROT,CSROT)
      WRK (IP+20) = XMIN*CSROT - YMIN*SNROT
      WRK (IP+21) = XMIN*SNROT + YMIN*CSROT
      WRK (IP+22) = PAR1
      WRK (IP+23) = SQRT(SIG)
      IWRK(IP+24) = S0 + .001
      WRK (IP+25) = CVST
      WRK (IP+26) = 0.
      WRK (IP+27) = CVST
      WRK (IP+28) = CVST
      I0 = IP+ 1
      I9 = IP+28
C     PRINT 2904,(WRK(I1),I1=I0,I9)
      CPROC
C
C
N     *************************
N     *      L A B E L        *
N     *************************
C
C
N     LABEL USED HITS
      PROC LABEL
C
N       PRESET LAST HIT POINTER
        IWL = -999
        NHITLB = 0
        FOR IP = HPCO0,HPCO9,HLDCO
          IW0 = IWRK(IP)
          X   = WRK(IP+3)
          Y   = WRK(IP+4)
          F   = (PAR1*X + PAR2)*X + PAR3
          DF  = F - Y
N         SELECT CLOSEST HIT
          IF ABS(DF).LT.ALBLM1
          THEN
            LBGOOD = 0
            NHITLB = NHITLB + 1
          ELSE
            LBGOOD = 4
            IF(ABS(DF).LT.ALBLM2) LBGOOD = 1
          CIF
          IWRK(IP+ 7) = LBGOOD
          WRK (IP+13) = DF
C
N         CHECK IF 2 HITS FROM SAME WIRE
          IF IWL.EQ.IW0
          THEN
N           SELECT CLOSEST HIT
            IF ABS(DFL).LT.ABS(DF)
            THEN
              IF(LBGOOD.EQ.0) NHITLB = NHITLB - 1
              IWRK(IP +7) = 16
            ELSE
              IF(IWRK(IPL+7).EQ.0) NHITLB = NHITLB - 1
              IWRK(IPL+7) = 16
            CIF
          CIF
N         STORE LAST POINTERS + DF
          IWL = IW0
          IPL = IP
          DFL = DF
        CFOR
C
      CPROC
C
C
N     *************************
N     *      I N I T          *
N     *************************
C
C
N     INITIALIZE CONSTANTS
      PROC INIT
C
        DFI0 = 3.1415927 / 12.
        DFI1 = DFI0 * .5
        DFI3 = DFI1 * .5
        DFI4 = DFI3 + DFI1
        SNFI0 = SIN(DFI0)
        CSFI0 = COS(DFI0)
        TGFI0 = SNFI0/CSFI0
        SNFI1 = SIN(DFI1)
        CSFI1 = COS(DFI1)
        TGFI1 = SNFI1/CSFI1
        SNFI3 = SIN(DFI3)
        CSFI3 = COS(DFI3)
        TGFI3 = SNFI3/CSFI3
        SNFI4 = SIN(DFI4)
        CSFI4 = COS(DFI4)
C
N       ROTATION MATRICES FOR CELLS
        CSRNG1(1) = CSFI0
        CSRNG1(2) = 1.
        CSRNG1(3) = CSFI0
        SNRNG1(1) =-SNFI0
        SNRNG1(2) = 0.
        SNRNG1(3) = SNFI0
        CSRNG3(1) = CSFI4
        CSRNG3(2) = CSFI3
        CSRNG3(3) = CSFI3
        CSRNG3(4) = CSFI4
        SNRNG3(1) =-SNFI4
        SNRNG3(2) =-SNFI3
        SNRNG3(3) = SNFI3
        SNRNG3(4) = SNFI4
C
N       RADIUS AROUND WIRE FOR CORR. OF DRIFTSPACE
        DRC = RINCR(1)*.5 * DRICOS
C       CONST. FOR VAR. OF DRIFT VEL.
        IQHEAD = IBLN('HEAD')
        IPHEAD = IDATA(IQHEAD)*2
        NRUN = HDATA(IPHEAD+10)
        IF NRUN.LE.100
        THEN
          DSD0   = 0.0
          DSD1   = 0.0
          DSD2   = 0.0
          DDS0   = 0.0
          DDS1   = 0.0
          DDS2   = 0.0
          DRV1   = 0.0
          DRV2   = 0.0
        ELSE
          DSD0   =-0.400
          DSD1   = 0.300
          DSD2   = 2.500
          DDS0   = 0.720
          DDS1   = 0.330
          DDS2   = 0.0
          DRV1   = (DDS0-DDS1) / (DSD0-DSD1)
          DRV2   = (DDS1-DDS2) / (DSD1-DSD2)
        CIF
C     PRINT 2091, DSD0,DDS0,DSD1,DDS1,DSD2,DDS2,DRV1,DRV2,DRC
C2091 FORMAT(' DSD,DDS=',3(F9.3,F7.3),F11.5,F9.5,F9.3,F8.3)
C
N       INITIALIZE ANGULAR CORRECTION CONSTANTS
        I9 = NCOAR - 1
        FOR I1=2,I9
          IF(I1.GT.2) TGCOAR(I1   ) = TGCOAR(I1- 1) + DTGB
          SLCOAR(I1   ) = (T0COAR(I1   )-T0COAR(I1- 1)) / DTGB
          SLCOAR(I1+15) = (T0COAR(I1+15)-T0COAR(I1+14)) / DTGB
          SLCOAR(I1+30) = (T0COAR(I1+30)-T0COAR(I1+29)) / DTGB
          SLCOAR(I1+45) = (T0COAR(I1+45)-T0COAR(I1+44)) / DTGB
        CFOR
C     PRINT 2092, TGCOAR,T0COAR,SLCOAR
C2092 FORMAT('0ANG.CORR.:',15F8.3,/,(11X,15F8.3))
C
      CPROC
C
      END
C   29/10/80 308170745  MEMBER NAME  TRACEOOC (FITSR)       SHELTRAN
      SUBROUTINE TRACEO(ITRK,PAR1,PAR2,PAR3)
C
C        FIND HITS OF TRACKS FROM ORIGIN
C        P. STEFFEN                     2/07/80
C
      IMPLICIT INTEGER*2 (H)
      LOGICAL DEADCL
C
#include "cheadr.for"
      EQUIVALENCE (HHEADR(18),HRUN)
C
#include "cdata.for"
#include "ccycp.for"
C
#include "cworkpr.for"
#include "cworkeq.for"
C
      EQUIVALENCE
     ,          (HPCO0 ,HPWRK(17)),(HPCO9 ,HPWRK(18)),(HLDCO ,HPWRK(19))
     ,         ,(ICELL ,IDWRK( 1)),(MHIT  ,IDWRK( 2)),(IRING ,IDWRK( 3))
     ,         ,(IERRCD,IDWRK( 4)),(NTRKEL,IDWRK( 5))
C
#include "cpatlm.for"
C
#include "cjdrch.for"
#include "cdsmax.for"
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
      DIMENSION ITRCLL(6),CSRCLL(6),SNRCLL(6), NCNCK(24)
      DIMENSION CSRNG1(3),SNRNG1(3),CSRNG3(4),SNRNG3(4)
C
N     MASK FOR TRACKS AT CELL WALL + IN DEAD CELLS
      INTEGER MKBDCL(3) /Z10,Z20,Z40/
      INTEGER MKDDCL(3) /Z01,Z02,Z04/
C
C     IF(ICELL.GT.84) RETURN
C     PRINT 2900, IRING, ICELL, ITRK,PAR1,PAR2,PAR3
C     PRINT 2901, (WRK(I1),I1=HPHT0,HPHT9)
C2900 FORMAT(1H0,'RING:',I4, ', ICELL:',I3,', TRACK:',I4,3F10.5)
C2901 FORMAT(1X,/,(1X,2I6,2F6.2,2X,Z4,4F7.1,2I6,F6.2))
C2902 FORMAT(/,(1X,3I6,4F8.5,I3,2F6.2,I3,2F6.2,2X,Z4,2X,Z4,2X,Z5,F6.2))
C2904 FORMAT(1H0,2I3,I8,2(I4,3F6.1,3F6.3),
C    ,     /,14X,I3,4E13.5,F6.2,I3,4E13.5,
C    ,     /,14X,I3,2F8.3,F6.1,I3,10X,6I3,8I6,2X,Z4)
C2001 FORMAT('0TRACK0-INIT.:',3F10.5,F10.3,3F10.5,2F6.2)
C2002 FORMAT('0FETCH:',4I6,F10.1,6F9.5)
C2003 FORMAT('0ROTATION:',10F10.5)
C2004 FORMAT('0WALLS:',2I3,3F10.5)
C2005 FORMAT('0TRACK:',I6,/,(1X,3I6,4F9.5,I4,F9.5,2I4,F9.5,I6,F9.5))
C2006 FORMAT(1X,I6,5F8.2,F12.1,5F8.2)
C2007 FORMAT(' SIDE?',3I6,3F8.1)
C2008 FORMAT(' FIT:',2I3,F8.2,F5.0,F10.6,F7.3,F5.1,F6.3,F5.1)
C2009 FORMAT(' ROTATION:',2I6,10F10.5)
C2010 FORMAT(' HIT:',I6,12F8.2)
C2012 FORMAT('0FITBNK:',2I3,8F9.5)
C2014 FORMAT('0FIT-BANK:',5F8.3,5X,5F8.3,5X,F8.5,2F8.1)
C2015 FORMAT(' SELCLL:',2I4,8F8.3)
C2016 FORMAT('0ITRCLL =',6I8,/,(9X,6F8.3))
C2019 FORMAT(' TRACK IN DEAD CELL:',10I6)
C2107 FORMAT(' SIGLM:',10F8.3)
C
N     INITIALIZATION
      DATA LBINIT /0/
      IF LBINIT .EQ. 0
      THEN
        LBINIT = 1
        PERFORM INIT
      CIF
C
N     RESERVE SPACE IN CWORK
      HPCO0  = HPFREE
      HLDCO  = 14
      HPFREE = HLDCO*100 + HPCO0
      HPCO9 = HPFREE - 1
      IPCOMX= HPFREE - HLDCO
C
N     LOAD RADIUS AND WIRE SPACING
      R0 = FSENSW(IRING)
      DR = RINCR (IRING)
C
N     ROTAION ANGLE
      X0    = DR*15. + R0
      Y0    = (PAR1*X0 + PAR2) * X0
      TGROT = Y0 / X0
      CSROT = 1. / SQRT(TGROT**2 + 1.)
      SNROT = CSROT*TGROT
      CSROT0= CSROT
      SNROT0= SNROT
C     PRINT 2003, TGROT,CSROT,SNROT,X0,Y0,PAR1,PAR2,PAR3,WGHT0,Y0
C
N     PREPARE COORDINATE ARRAY
      PERFORM PRCOAR
C
N     REFIT PARABOLA THROUGH ORIGIN
      WGHT0 = .01
      Y0    = 0.
      PERFORM FPARA0
      IF(S0.LT.3.5 .OR. SIG.GT.100.) RETURN
C
N     CHECK IF DIST. TO ORIGIN ACCEPTABLE
      DORIG = PAR3
      IF(PAR1.LT.0) DORIG =-PAR3
      IF DORIG.GT.11. .OR. DORIG.LT.-3.
      THEN
N       TOO BIG DIST., REPEAT FIT WITH RESTRICTION
        WGHT0 = 1.0
        Y0 = SIGN(10.,PAR1)
        IF(DORIG.LT.0) Y0 =-SIGN(2.,PAR1)
        PERFORM FPARA0
      CIF
C
N     CHECK IF GOOD FIT
      IF(SIG.GT.0.15) RETURN
      IF(S0 .LT. 4.5) RETURN
      IF(SIG.GT.0.06 .AND. S0 .LT. 6.5) RETURN
C
N     START TRACING INWARDS
      JCELL = ICELL
      JRING = IRING
C
N     SELECT CELLS
      PERFORM SELCLL
C
N     LOOP OVER ALL CELLS + FETCH HITS
      KCLL = 0
      NHIT = 0
      IPCO = HPCO0
C
N     LOOP OVER RINGS
      JRING = 0
N     INITIALIZE LABEL FOR DEAD CELLS +
N     TRACKS AT CELL WALLS
      LBCELL = 0
N     INITIALIZE LABEL FOR >100 HITS
      LBHTMX = 0
      REPEAT
      JRING = JRING + 1
        NHRNG = 0
        NCLL = 0
        REPEAT
        NCLL = NCLL + 1
        KCLL = KCLL + 1
          JCELL = ITRCLL(KCLL)
          IF JCELL.NE.0
          THEN
            CSROT = CSRCLL(KCLL)
            SNROT = SNRCLL(KCLL)
            PERFORM FETCH
            NHRNG = NHRNG + JHIT
N           STOP IF > 100 HITS FOR THIS TRACK
            IF(LBHTMX.NE.0) RETURN
          CIF
        UNTIL NCLL.EQ.2
        IF(NHRNG.LT.2 .AND. JRING.LT.IRING) RETURN
N       SET LABEL FOR TRACK AT CELL BOUND.
        IF(JCELL.NE.0) LBCELL = LOR(MKBDCL(JRING),LBCELL)
      UNTIL KCLL.EQ.6
      HPCO9 = IPCO - 1
C
N     LABEL HITS BELONGING TO TRACK
      CALL LBHTRO(ITRK,PAR1,PAR2,PAR3,INDPAR)
C     PRINT 2005, INDPAR,(WRK(I),I=HPCO0,HPCO9)
C
N     FIT PARABOLA
      IF INDPAR.EQ.0
      THEN
        WGHT0 = 0.10
        Y0 = 0.
      ELSE
        WGHT0 = 0.03
        Y0 = PAR3
      CIF
      PERFORM FPARA0
      IF(S0.LT.3.5 .OR. SIG.GT.100.) RETURN
C
N     RELABEL HITS
      ALBLM1 = 0.6
      ALBLM2 = 3.0
      PERFORM LABEL
C
N     REFIT PARABOLA
      WGHT0 = PATRLM(2)
      SIG0  = SIG
      PERFORM FPARA0
C
N     STOP IF <8 GOOD HITS OR BAD FIT
      IF(S0.LT.7.5 .OR. SIG.GT.100.) RETURN
C
N     RELABEL HITS
      ALBLM1 = 0.6
      ALBLM2 = 3.0
      PERFORM LABEL
C
N     REFIT IF MORE THAN 4 NEW HITS LABELED
      WHILE  NHITLB-S0 .GT. 4.5 .OR. SIG0-SIG.GT..25
        SIG0  = SIG
        PERFORM FPARA0
        PERFORM LABEL
      CWHILE
C     PRINT 2005, INDPAR,(WRK(I),I=HPCO0,HPCO9)
C
N     CHECK IF ACCEPTABLE TRACK
      IF SIG.LE.0.1225
      THEN
C
N       CHECK IF GOOD TRACK
        CALL CKTRKO(LBCKTR,LBCELL)
        IF(LBCKTR.LE.16) RETURN
C
N       SET UP FIT-BANK
        PERFORM FITBNK
N       STORE TRACK IN 'PATR'-BANK
N       AND REGISTER HITS IN 'JHTL'-BANK
        HPHT0S = HPHT0
        HPHT9S = HPHT9
        HLDHTS = HLDHT
        HPHT0  = HPCO0
        HPHT9  = HPCO9
        HLDHT  = HLDCO
C
        CALL STTRKO(LBCKTR)
C
        HPHT0  = HPHT0S
        HPHT9  = HPHT9S
        HLDHT  = HLDHTS
      CIF
      RETURN
C
C
N     *************************
N     *      P R C O A R      *
N     *************************
C
C
N     PREPARE COORDINATE ARRAY
      PROC PRCOAR
C
N     ANGLE OF TRACK IN RING
      XR1  = DR*7.5 + R0
      TGB  = PAR1*XR1 * 2. + PAR2
      CSB  = 1. / SQRT(TGB**2+1.)
      SNB  = CSB * TGB
C
N     CALCULATE X,Y COORDINATES + FILL ARRAY
      DRISN  = SINDRI(ICELL,1)
      DRICS  = COSDRI(ICELL,1)
      IHIT = 0
      IPCO = HPCO0
      IP = HPHT9 - HLDHT + 1
C     PRINT 2002, IRING,ICELL,IP,HPHT0,XR1,TGB,SNB,CSB,DRISN,DRICS
      REPEAT
        LBSIDE  = 0
        LBGOOD = 0
        IF IABS(IWRK(IP+ 9)).EQ.ITRK
        THEN
          LBSIDE = -1
          IF(LAND(IWRK(IP+4),2).NE.0) LBSIDE = 1
          IF(IWRK(IP+ 9).LT.0) LBGOOD = 1
        ELSE
        IF IABS(IWRK(IP+10)).EQ.ITRK
        THEN
          LBSIDE = -1
          IF(LAND(IWRK(IP+4),8).NE.0) LBSIDE = 1
          IF(IWRK(IP+10).LT.0) LBGOOD = 1
        CIF
        CIF
C
N       CHECK IF SELECTED HIT
        IF LBSIDE.NE.0
        THEN
          ILAY = IWRK(IP  )
          Y    = SWDEPL
          IF(LAND(ILAY,1).NE.0) Y =-Y
          DS   =  WRK(IP+2)
          X    = ILAY * DR + R0
          IF DS.LE.DRC
          THEN
            DX   =-DS * SNB
            DY   = DS * CSB
          ELSE
            DX   =-(DS-DRC)*DRISN - DRC*SNB
            DY   = (DS-DRC)*DRICS + DRC*CSB
          CIF
          X    = DX*LBSIDE + X
          Y    = DY*LBSIDE + Y
          XX   = X*CSROT + Y*SNROT
          YY   =-X*SNROT + Y*CSROT
C
          IF(LBGOOD.LE.2) IHIT = IHIT + 1
C
N         FILL COORDINATE ARRAY
          IWRK(IPCO   ) = ILAY
          IWRK(IPCO+ 1) = IWRK(IP+1)
          IWRK(IPCO+ 2) = LBSIDE
          WRK (IPCO+ 3) = XX
          WRK (IPCO+ 4) = YY
          WRK (IPCO+ 5) = 0.
          WRK (IPCO+ 6) = 0.
          IWRK(IPCO+ 7) = LBGOOD
          WRK (IPCO+ 8) = DS
          IWRK(IPCO+ 9) = ICELL
          IWRK(IPCO+10) = LBGOOD
          WRK (IPCO+11) = TGB
          IWRK(IPCO+12) = IRING
          WRK (IPCO+13) = 0.
          IPCO = IPCO + HLDCO
        CIF
      IP = IP - HLDHT
      UNTIL IP.LT.HPHT0
      NHIT = IHIT
      HPCO9 = IPCO - 1
C     PRINT 2005, NHIT,(WRK(I),I=HPCO0,HPCO9)
C
      CPROC
C
N     *************************
N     *      F P A R A 0      *
N     *************************
C
C
N     PARABOLA FIT THROUG ORIGIN
      PROC FPARA0
C
N     GET EQUATIONS
N     WEIGHT ORIGIN AS POINT OF PARABOLA
      S0 = WGHT0
      S1 = 0.
      S2 = 0.
      S3 = 0.
      S4 = 0.
      S5 = 0.
      S6 = 0.
      S7 = Y0 * WGHT0
      IPCO = HPCO0
      REPEAT
       IF IWRK(IPCO+ 7).EQ.0
       THEN
          X = WRK(IPCO+3)
          Y = WRK(IPCO+4)
          X2 = X**2
          S1 = S1 + X
          S2 = S2 + X2
          S3 = S3 + X*X2
          S4 = S4 + X2**2
          S5 = S5 + Y*X2
          S6 = S6 + Y*X
          S7 = S7 + Y
          S0 = S0 + 1.
        CIF
      IPCO = IPCO + HLDCO
      UNTIL IPCO.GT.HPCO9
C
N     CALCULATE PARAMETERS
C
      IF S0.LT.3.5
      THEN
        SIG = 1000.
      ELSE
C
N       SOLVE EQUATIONS FOR PARABOLA FIT
        F1 = 1. / S4
        XX12 = S3*F1
        XX13 = S2*F1
        YY1  = S5*F1
        XX22 = S2 - S3*XX12
        XX23 = S1 - S3*XX13
        YY2  = S6 - S3*YY1
        XX32 = S1 - S2*XX12
        XX33 = S0 - S2*XX13
        YY3  = S7 - S2*YY1
        IF XX22.GT.XX32
        THEN
          XX23 = XX23 / XX22
          YY2  = YY2  / XX22
          DET  = XX33 - XX32*XX23
          IF ABS(DET).GT.1.E-30
          THEN
            PAR3 = (YY3 - XX32*YY2) / DET
            PAR2 = YY2 - XX23*PAR3
          CIF
        ELSE
          XX33 = XX33 / XX32
          YY3  = YY3  / XX32
          DET  = XX23 - XX22*XX33
          IF ABS(DET).GT.1.E-30
          THEN
            PAR3 = (YY2 - XX22*YY3) / DET
            PAR2 = YY3 - XX33*PAR3
          CIF
        CIF
      IF ABS(DET).LE.1.E-30
      THEN
        SIG = 1000.
      ELSE
        PAR1 = YY1 - XX12*PAR2 - XX13*PAR3
        DEG = S0 - WGHT0 - 2.
        IF(WGHT0.LT..001) DEG = DEG - 1.
C
C
N       CALC. CHISQ + SOLVE L/R AMBIGUITY
        CHISQ = 0.
        DCHIM1 = 0.
        IHITM1 = 0
        IPCO = HPCO0
        REPEAT
         IF IWRK(IPCO+ 7).EQ.0
         THEN
            X = WRK(IPCO+3)
            Y = WRK(IPCO+4)
            F = (PAR1 *X + PAR2 )*X + PAR3
            DCHI = Y - F
            WRK(IPCO+13) = DCHI
N           SUM FOR RMS
            CHISQ = CHISQ + DCHI**2
N           KEEP BIGGEST RMS
C           IF ABS(DCHI).GE.DCHIM1
C           THEN
C             DCHIM1 = ABS(DCHI)
C             IHITM1 = IPCO
C           CIF
C     PRINT 2006, IPCO,X,Y,F,DCHI,CHISQ
          CIF
        IPCO = IPCO + HLDCO
        UNTIL IPCO.GT.HPCO9
        SIG    =      CHISQ  / DEG
C     PRINT 2008, IWRK(IHSTRT),IWRK(IHEND),SIG,DEG,PAR1,PAR2,PAR3,
C    ,            WGHT0,Y0
C
N       SET LIMIT FOR SIGMA
        SIGLM = TRELLM(16)**2
C
      CIF
      CIF
C
      CPROC
C
N     *************************
N     *      S E L C L L      *
N     *************************
C
C
N     SELECT CELLS CONTAINING TRACK
      PROC SELCLL
C
N       BASIC CELL #
        ICELL0 = ICELL - 1
        IF(ICELL.GT.24) ICELL0 = ICELL - 25
        IF(ICELL.GT.48) ICELL0 = (ICELL-49)/2
C
N       ROTATION INTO BASIC CELL SYSTEM
        IF IRING.NE.3
        THEN
          TGR1 = TGROT
          SNR1 = SNROT
          CSR1 = CSROT
        ELSE
          IF LAND(ICELL,1).EQ.0
          THEN
            CSR1 = CSROT*CSFI3 - SNROT*SNFI3
            SNR1 = CSROT*SNFI3 + SNROT*CSFI3
          ELSE
            CSR1 = CSROT*CSFI3 + SNROT*SNFI3
            SNR1 =-CSROT*SNFI3 + SNROT*CSFI3
          CIF
          TGR1 = SNR1 / CSR1
        CIF
C     PRINT 2015, ICELL,ICELL0,SNR1,CSR1,TGR1,SNROT,CSROT,SNFI3,CSFI3
C
N       LOOP OVER ALL RINGS
        JRING = 0
        WHILE JRING.LT.3
        JRING = JRING + 1
C
N         1. + LAST POINT IN RING
          R0 = FSENSW(JRING)
          DR = RINCR (JRING)
          X1 = R0 - DR*2.
          X2 = R0 + DR*17.
          Y1 = (PAR1*X1 + PAR2)*X1 + PAR3
          Y2 = (PAR1*X2 + PAR2)*X2 + PAR3
N         ROTATE POINTS INTO CELL SYSTEM
          XX1 = X1*CSR1 - Y1*SNR1
          YY1 = X1*SNR1 + Y1*CSR1
          XX2 = X2*CSR1 - Y2*SNR1
          YY2 = X2*SNR1 + Y2*CSR1
C     PRINT 2015, JRING,ICELL0,XX1,YY1,XX2,YY2,R0,DR
C
N         FIND CELLS
          ICELL1 = 0
          LBINV  = 0
          REPEAT
          IF JRING.EQ.3
          THEN
N           RING 3
N           CHECK IF TRACK PASSES CENTRAL WALL
            IF ABS(YY1).LT.3.0 .OR. ABS(YY2).LT.3.0 .OR. YY1*YY2.LE.0.
            THEN
              ICELL1 =  2
              LBINV = 1
              IF(YY1.GT.YY2) LBINV =-1
              XREPEAT
            CIF
N           CHECK IF TRACK PASSES SIDE WALL
            DY1 = ABS(YY1) - TGFI1*XX1
            DY2 = ABS(YY2) - TGFI1*XX2
            IF ABS(DY1).LT.3.0 .OR. ABS(DY2).LT.3.0 .OR. DY1*DY2.LE.0.
            THEN
              ICELL1 =  1
              IF(YY1.GT.0) ICELL1 = 3
              LBINV  = 1
              IF((DY2-DY1)*YY1 .LT. 0.) LBINV =-1
              XREPEAT
            CIF
N           TRACK STAYS IN ONE CELL
            ICELL1 =  2
            IF(YY1.GT.0.) ICELL1 = 3
            IF DY1.GT.0
            THEN
              ICELL1 =  1
              IF(YY1.GT.0.) ICELL1 = 4
            CIF
            XREPEAT
          CIF
C
N         RING 1, 2
N         CHECK IF TRACK PASSES SIDE WALL
          DY1 = ABS(YY1) - TGFI1*XX1
          DY2 = ABS(YY2) - TGFI1*XX2
          IF ABS(DY1).LT.3.0 .OR. ABS(DY2).LT.3.0 .OR. DY1*DY2.LE.0.
          THEN
            ICELL1 =  1
            IF(YY1.GT.0) ICELL1 = 2
            LBINV  =  1
            IF((DY2-DY1)*YY1.LT.0.) LBINV =-1
            XREPEAT
          CIF
N         TRACK STAYS IN ONE CELL
          ICELL1 =  2
          IF DY1.GT.0.
          THEN
            ICELL1 =  1
            IF(YY1.GT.0.) ICELL1 = 3
          CIF
          UNTIL .TRUE.
C     PRINT 2015, ICELL1,LBINV ,DY1,DY2
C
N         GET CELL # AND ROTATION MATRIX
          IC2 = 0
          CSROT2 = 0.
          SNROT2 = 0.
          IF JRING.NE.3
          THEN
            IC1 = ICELL1 + ICELL0 - 1
            IF(IC1.LT. 1)  IC1 = IC1 + 24
            IF(IC1.GT.24)  IC1 = IC1 - 24
            IF(JRING.EQ.2) IC1 = IC1 + 24
N           ROTATION MATRIX
            CSROT1 = CSRNG1(ICELL1)
            SNROT1 = SNRNG1(ICELL1)
C
            IF LBINV.NE.0
            THEN
              IC2 = ICELL1 + ICELL0
              IF(IC2.LT. 1)  IC2 = IC2 + 24
              IF(IC2.GT.24)  IC2 = IC2 - 24
              IF(JRING.EQ.2) IC2 = IC2 + 24
N             ROTATION MATRIX
              CSROT2 = CSRNG1(ICELL1+1)
              SNROT2 = SNRNG1(ICELL1+1)
            CIF
          ELSE
            IC1 = ICELL1 + ICELL0*2 + 47
            IF(IC1.LT.49)  IC1 = IC1 + 48
            IF(IC1.GT.96)  IC1 = IC1 - 48
N           ROTATION MATRIX
            CSROT1 = CSRNG3(ICELL1)
            SNROT1 = SNRNG3(ICELL1)
C
            IF LBINV.NE.0
            THEN
              IC2 = ICELL1 + ICELL0*2 + 48
              IF(IC2.LT.49)  IC2 = IC2 + 48
              IF(IC2.GT.96)  IC2 = IC2 - 48
N             ROTATION MATRIX
              CSROT2 = CSRNG3(ICELL1+1)
              SNROT2 = SNRNG3(ICELL1+1)
            CIF
          CIF
C
N         REVERSE ORDER OF CELLS IF NECESSAIRY
          IF LBINV.LT.0
          THEN
            IZW    = IC2
            IC2    = IC1
            IC1    = IZW
            ZWZ    = CSROT2
            CSROT2 = CSROT1
            CSROT1 = ZWZ
            ZWZ    = SNROT2
            SNROT2 = SNROT1
            SNROT1 = ZWZ
          CIF
C
C     PRINT 2015, IC1,IC2,CSROT1,SNROT1,CSROT2,SNROT2
          ITRCLL(JRING*2-1) = IC1
          ITRCLL(JRING*2  ) = IC2
          CSRCLL(JRING*2-1) = CSROT1*CSR1 + SNROT1*SNR1
          SNRCLL(JRING*2-1) =-SNROT1*CSR1 + CSROT1*SNR1
          CSRCLL(JRING*2  ) = CSROT2*CSR1 + SNROT2*SNR1
          SNRCLL(JRING*2  ) =-SNROT2*CSR1 + CSROT2*SNR1
        CWHILE
C     PRINT 2016, ITRCLL,CSRCLL,SNRCLL
      CPROC
C
N     *************************
N     *      F E T C H        *
N     *************************
C
C
N     FETCH HITS IN CELL
      PROC FETCH
C
N       LOAD RADIUS AND WIRE SPACING
        R0 = FSENSW(JRING)
        DR = RINCR (JRING)
C
N       ANGLE OF TRACK IN RING
        XR1  = DR*7.5 + R0
        TGB  = PAR1*XR1 * 2. + PAR2
        XX   = 1. / SQRT(TGB**2+1.)
        YY   = XX * TGB
N       ROTATE
        CSB  = XX*CSROT - YY*SNROT
        SNB  = XX*SNROT + YY*CSROT
        TGB  = SNB/CSB

C
N       SET DRIFT SPACE BIN
        DSBIN1 = DRIVEL(JCELL,1)
        DS0 = 0.
        IF(HRUN.LE.100) DS0 = DSBIN1*.5
        DRISN  = SINDRI(JCELL,1)
        DRICS  = COSDRI(JCELL,1)
        DRISNF = DRISN * .05
N       ANGLE(TRACK,DRIFT DIRECT.)
        DRITG  = DRISN/DRICS
        TANBET = ABS((TGB-DRITG)/(TGB*DRITG+1.))
N       CORRECTION CONSTANTS FOR JCELL
        CCST01 = DELTA0(JCELL,1)*TANBET
        CCST02 = DELTA0(JCELL,2)*TANBET
        CCST11 = DELTA1(JCELL,1)
        CCST12 = DELTA1(JCELL,2)
        CCST21 = DELTA2(JCELL,1)
        CCST22 = DELTA2(JCELL,2)
        CCST51 = DELTA5(JCELL,1) * 10.
        CCST61 = DELTA6(JCELL,1) * 10.
C     PRINT 2002, IRING,ICELL,IP,HPHT0,XR1,CCST01,CCST02,CCST11,CCST12,
C    ,            CCST21,CCST22
N       COUNTER FOR NUMBER OF HITS FOUND
        JHIT = 0
        NHIT   = 0
        NHGOOD = 0
N       PRESET LAST LAYER
        ILAYL =-99
N       LOOP OVER ALL HITS OF CELL
        IPCO = IPCO - HLDCO
        IP9 = HPTSEC(JCELL+1)
        IP  = HPTSEC(JCELL  )
C     PRINT 2002, JRING,JCELL,IP,IP9,XR1,TGB,SNB,CSB,DRISN,DRICS,TANBET
        WHILE IP.LT.IP9
          IWIR = HDATA(IP)
          IWIR = SHFTR(IWIR,3)
N         LAYER NUMBER WITHIN RING 3
          ILAY = LAND(IWIR,15)
N         DRIFT SPACE
          DS =(HDATA(IP+3)) * DSBIN1 + DS0
          DSC = DS
          Y    = SWDEPL
          IF(LAND(ILAY,1).NE.0) Y =-Y
          Y    = (7-ILAY)*CCST51 - CCST61 + Y
          X    = ILAY * DR + R0
          IF DS.LE.DRC
          THEN
            IF DS.LT.4.0
            THEN
              IF DS.GT.DSD1
              THEN
                DSC = (DSD1-DSD0)*DRV0 + (DS-DSD1)*DRV1
              ELSE
                DSC = (DS-DSD0)*DRV0
              CIF
              IF(DSC.LT.0.1) DSC = 0.1
            CIF
            DXR  =-DSC * SNB
            DYR  = DSC * CSB
            DXL  =-DXR
            DYL  =-DYR
           ELSE
C
N           EDGE WIRE FIELD DISTORTION
            IF ILAY.LT. 3
            THEN
              DILAY =-(ILAY- 3)**2
              DSCL  = (DILAY*CCST11 + 1.) * DSC
              DSCR  = (DILAY*CCST12 + 1.) * DSC
            ELSE
            IF ILAY.GT.12
            THEN
              DILAY =-(ILAY-12)**2
              DSCL  = (DILAY*CCST21 + 1.) * DSC
              DSCR  = (DILAY*CCST22 + 1.) * DSC
            ELSE
              DSCL = DSC
              DSCR = DSC
            CIF
            CIF
C
N           FIELD DISTORTIONS AT LARGE DRIFT TIMES
            IF DSC.GT.ABERR(7)
            THEN
              DWIR  = ILAY - 7.5
              DWIRC = DSC*DRISNF
              DWIRL = DWIR + DWIRC
              DWIRR = DWIR - DWIRC
              DSCL  = (DSCL-ABERR(7))*DWIRL*CCST01 + DSCL
              DSCR  =-(DSCR-ABERR(7))*DWIRR*CCST02 + DSCR
            CIF
            DXR  =-(DSCR-DRC)*DRISN - DRC*SNB
            DYR  = (DSCR-DRC)*DRICS + DRC*CSB
            DXL  = (DSCL-DRC)*DRISN + DRC*SNB
            DYL  =-(DSCL-DRC)*DRICS - DRC*CSB
          CIF
          XL   = DXL + X
          YL   = DYL + Y
          XXL  = XL*CSROT + YL*SNROT
          YYL  =-XL*SNROT + YL*CSROT
          FL   = (PAR1*XXL + PAR2)*XXL + PAR3
          DFL  = FL - YYL
          XR   = DXR + X
          YR   = DYR + Y
          XXR  = XR*CSROT + YR*SNROT
          YYR  =-XR*SNROT + YR*CSROT
          FR   = (PAR1*XXR + PAR2)*XXR + PAR3
          DFR  = YYR - FR
N         SET ARRAY
C     PRINT 2010, ILAY,DS,DSC,DSCL,DSCR,XL,XR,X,Y,DXL,DXR,DYL,DYR
C
N         CHECK IF LEFT + RIGHT SOLUTION POSSIBLE
          NLRSOL = 1
          IF(DS.LT.2.0 .AND. DS.NE.0 .AND. JCELL.NE.ICELL) NLRSOL = 2
C
N         LOOP OVER LEFT +/OR RIGHT SOLUTION
          ILRSOL = 0
          REPEAT
          ILRSOL = ILRSOL + 1
C
N           SELECT SIDE
            IF NLRSOL.EQ.1 .AND. ABS(DFL).LT.ABS(DFR) .OR.
     ?         NLRSOL.EQ.2 .AND. ILRSOL.EQ.1
            THEN
N             LEFT SIDE
              LBSIDE =-1
              XX  = XXL
              YY  = YYL
              DF  = DFL
            ELSE
N             RIGHT SIDE
              LBSIDE = 1
              XX  = XXR
              YY  = YYR
              DF  = DFR
            CIF
C
N           HIT QUALITY:
            LBGOOD = 0
            IF(ABS(DF).GT.2.0) LBGOOD = 1
            IF(ABS(DF).GT.5.0) LBGOOD = 8
            IF(DF.LE.-10.0) LBGOOD = 4
            IF(DF.GT.-10.0 .AND. DF.LT.-5.0) LBGOOD = 2
N           NEW LAYER?
            IF ILAY.NE.ILAYL .OR. LBGDL.LE.1.AND.LBGOOD.LE.1
            THEN
              LBREG = 1
N             INCREASE HIT COUNTER
              JHIT = JHIT + 1
              IPCO = IPCO + HLDCO
            ELSE
N             2 HITS IN SAME LAYER, SELECT CLOSEST
              LBREG = 0
              IF(LBGOOD.LT.IWRK(IPCO+7)) LBREG = 1
            IF(LBGOOD.GE.4 .AND. ABS(DF).LT.ABS(WRK(IPCO+13))) LBREG = 1
            CIF
N           REGISTER NEW HIT?
            IF LBREG.NE.0
            THEN
N             STOP IF > 100 HITS
              IF IPCO.GT.IPCOMX
              THEN
                LBHTMX = 1
                XWHILE
               CIF

              NHIT   = NHIT   + 1
              IF(LBGOOD.LE.1) NHGOOD = NHGOOD + 1
              IWRK(IPCO   ) = ILAY
              IWRK(IPCO+ 1) = IP
              IWRK(IPCO+ 2) = LBSIDE
              WRK (IPCO+ 3) = XX
              WRK (IPCO+ 4) = YY
              WRK (IPCO+ 5) = 0.
              WRK (IPCO+ 6) = 0.
              IWRK(IPCO+ 7) = LBGOOD
              WRK (IPCO+ 8) = DSC
              IWRK(IPCO+ 9) = JCELL
              IWRK(IPCO+10) = LBGOOD
              WRK (IPCO+11) = TANBET
              IWRK(IPCO+12) = JRING
              WRK (IPCO+13) = DF
              ILAYL = ILAY
              LBGDL = LBGOOD
            CIF
C
          UNTIL ILRSOL.GE.NLRSOL
C
        IP = IP + 4
        CWHILE
C
N       CHECK IF <100 HITS
        IF LBHTMX.EQ.0
        THEN
N         SET IPCO TO 1. FREE LOCATION
          IPCO = IPCO + HLDCO
C
N         SET LABEL FOR DEAD CELL
          IF NHIT.LE.2
          THEN
            NRUN = HRUN
            IF DEADCL(JCELL,NRUN)
            THEN
              LBCELL = LOR(LBCELL,MKDDCL(JRING))
              JHIT = 16
              NHIT = 16
C     PRINT 2019, JCELL,JRING,NRUN,LBCELL
            CIF
          CIF
C
        CIF
      CPROC
C
N     *************************
N     *      F I T B N K      *
N     *************************
C
C
N     SET UP FIT-BANK
      PROC FITBNK
C
N     START + END POINTS
      XST = 10000.
      XEN =     0.
      FOR IPCO = HPCO0,HPCO9,HLDCO
        IF IWRK(IPCO+7).EQ.0
        THEN
          X = WRK(IPCO+3)
          IF(X.GT.XEN) XEN = X
          IF(X.LT.XST) XST = X
        CIF
      CFOR
      YST = (PAR1*XST + PAR2)*XST + PAR3
      YEN = (PAR1*XEN + PAR2)*XEN + PAR3
N     DIRECTION AT START + END POINT
      TGST = PAR1*XST*2 + PAR2
      DXST = 1./SQRT(TGST**2+1.)
      DYST = DXST * TGST
      TGEN = PAR1*XEN*2 + PAR2
      DXEN = 1./SQRT(TGEN**2+1.)
      DYEN = DXEN * TGEN
N     MIN. OF PARABOLA
      XMIN = -PAR2*.5 / PAR1
      YMIN = (PAR1*XMIN + PAR2)*XMIN + PAR3
N     CURVATURE
      CURV =-PAR1 * 2.
C
C     PRINT 2014, XST,YST,DXST,DYST,TGST,XEN,YEN,DXEN,DYEN,TGEN,CURV,
C    ,            XMIN,YMIN
C
N     DIRECTION FOR ROTATION
      JCELLD = ICELL
      IF(ICELL.GT.24) JCELLD = ICELL - 24
      IF(ICELL.GT.48) JCELLD = ICELL - 48
      IF IRING.NE.3
      THEN
        DXWR  = DIRWR1(JCELLD,1)
        DYWR  = DIRWR1(JCELLD,2)
      ELSE
        DXWR  = DIRWR3(JCELLD,1)
        DYWR  = DIRWR3(JCELLD,2)
      CIF
C
N     ROTATION INTO CELL SYSTEM
      XX = DXWR*CSROT0 - DYWR*SNROT0
      YY = DXWR*SNROT0 + DYWR*CSROT0
      UN = SQRT(XX**2 + YY**2)
C
C     PRINT 2012,ICELL,JCELLD,DXWR,DYWR,CSROT0,SNROT0,XX,YY,UN
      CSROT = XX
      SNROT = YY
C
N     FILL FIT-BANK
      HPTR0 = HPFREE
      IP    = HPTR0 - 1
      IWRK(IP+ 1) = 0
      IWRK(IP+ 2) = 16
      IWRK(IP+ 3) = 0
      IWRK(IP+ 4) = INDPAR + 1
      WRK (IP+ 5) = XST *CSROT - YST *SNROT
      WRK (IP+ 6) = XST *SNROT + YST *CSROT
      WRK (IP+ 7) = SQRT(WRK(IP+ 5)**2 + WRK(IP+ 6)**2)
      WRK (IP+ 8) = DXST*CSROT - DYST*SNROT
      WRK (IP+ 9) = DXST*SNROT + DYST*CSROT
      WRK (IP+10) = 1.
      IWRK(IP+11) = 0
      WRK (IP+12) = XEN *CSROT - YEN *SNROT
      WRK (IP+13) = XEN *SNROT + YEN *CSROT
      WRK (IP+14) = SQRT(WRK(IP+12)**2 + WRK(IP+13)**2)
      WRK (IP+15) = DXEN*CSROT - DYEN*SNROT
      WRK (IP+16) = DXEN*SNROT + DYEN*CSROT
      WRK (IP+17) = 1.
      IWRK(IP+18) = 2
      WRK (IP+19) = ATAN2(SNROT,CSROT)
      WRK (IP+20) = XMIN*CSROT - YMIN*SNROT
      WRK (IP+21) = XMIN*SNROT + YMIN*CSROT
      WRK (IP+22) = PAR1
      WRK (IP+23) = SQRT(SIG)
      IWRK(IP+24) = S0 + .001
      WRK (IP+25) = CURV
      WRK (IP+26) = 0.
      WRK (IP+27) = CURV
      WRK (IP+28) = CURV
      I0 = IP+ 1
      I9 = IP+28
C     PRINT 2904,(WRK(I1),I1=I0,I9)
      CPROC
C
C
N     *************************
N     *      L A B E L        *
N     *************************
C
C
N     LABEL USED HITS
      PROC LABEL
C
N       PRESET LAST HIT POINTER
        IWL = -999
        NHITLB = 0
        FOR IP = HPCO0,HPCO9,HLDCO
          IW0 = IWRK(IP)
          X   = WRK(IP+3)
          Y   = WRK(IP+4)
          F   = (PAR1*X + PAR2)*X + PAR3
          DF  = F - Y
N         SELECT CLOSEST HIT
          IF ABS(DF).LT.ALBLM1
          THEN
            LBGOOD = 0
            NHITLB = NHITLB + 1
          ELSE
            LBGOOD = 4
            IF(ABS(DF).LT.ALBLM2) LBGOOD = 1
          CIF
          IWRK(IP+ 7) = LBGOOD
          WRK (IP+13) = DF
C
N         CHECK IF 2 HITS FROM SAME WIRE
          IF IWL.EQ.IW0
          THEN
N           SELECT CLOSEST HIT
            IF ABS(DFL).LT.ABS(DF)
            THEN
              IF(LBGOOD.EQ.0) NHITLB = NHITLB - 1
              IWRK(IP +7) = 16
            ELSE
              IF(IWRK(IPL+7).EQ.0) NHITLB = NHITLB - 1
              IWRK(IPL+7) = 16
            CIF
          CIF
N         STORE LAST POINTERS + DF
          IWL = IW0
          IPL = IP
          DFL = DF
        CFOR
C
      CPROC
C
C
N     *************************
N     *      I N I T          *
N     *************************
C
C
N     INITIALIZE CONSTANTS
      PROC INIT
C
        DFI0 = 3.1415927 / 12.
        DFI1 = DFI0 * .5
        DFI3 = DFI1 * .5
        DFI4 = DFI3 + DFI1
        SNFI0 = SIN(DFI0)
        CSFI0 = COS(DFI0)
        TGFI0 = SNFI0/CSFI0
        SNFI1 = SIN(DFI1)
        CSFI1 = COS(DFI1)
        TGFI1 = SNFI1/CSFI1
        SNFI3 = SIN(DFI3)
        CSFI3 = COS(DFI3)
        TGFI3 = SNFI3/CSFI3
        SNFI4 = SIN(DFI4)
        CSFI4 = COS(DFI4)
C
N       ROTATION MATRICES FOR CELLS
        CSRNG1(1) = CSFI0
        CSRNG1(2) = 1.
        CSRNG1(3) = CSFI0
        SNRNG1(1) =-SNFI0
        SNRNG1(2) = 0.
        SNRNG1(3) = SNFI0
        CSRNG3(1) = CSFI4
        CSRNG3(2) = CSFI3
        CSRNG3(3) = CSFI3
        CSRNG3(4) = CSFI4
        SNRNG3(1) =-SNFI4
        SNRNG3(2) =-SNFI3
        SNRNG3(3) = SNFI3
        SNRNG3(4) = SNFI4
C
N       RADIUS AROUND WIRE FOR CORR. OF DRIFTSPACE
        DRC = RINCR(1)*.5 * DRICOS
C       CONST. FOR VAR. OF DRIFT VEL.
        IF HRUN.LE.100
        THEN
          DSD0   = .0
          DSD1   = 5.0
          DSD2   = 5.0
          DRV0   = 1.0
          DRV1   = 1.0
        ELSE
          DSD0   =-.63
          DSD1   = 1.8
          DSD2   = 4.0
          DRV0   = 0.8
          DRV1   = (DSD2 - (DSD1-DSD0)*DRV0) / (DSD2-DSD1)
        CIF

C     PRINT 2001, DFI0,DFI1,DFI3,DRC,TGFI0,TGFI1,TGFI3,DRV0,DRV1
      CPROC
C
      END
C   31/01/80 102191206  MEMBER NAME  TRCDCK   (PATRECSR)    SHELTRAN
      SUBROUTINE TRCDCK
C
      IMPLICIT INTEGER*2 (H)
      LOGICAL TBIT
C
C     SUBROUTINE TO CHECK TRACK CANDIDATES
C     AUTHOR: P. STEFFEN(78/11/21)
C
#include "cpatlm.for"
C
#include "cworkpr.for"
      COMMON /CWORK/ DWORK(1000)
#include "cworkeq.for"
      EQUIVALENCE
     ,           (ICELL ,IDWRK(1)),(NHIT  ,IDWRK(2)),(IRING ,IDWRK(3))
     ,         , (IERRCD,IDWRK(4)),(NTRKEL,IDWRK(5))
C
      DIMENSION NTRC( 3), LHIT(3),MHIT(3)
C
N     I2-I4 CONVERSION:
      INTEGER*2 HZW(2)
      EQUIVALENCE (HZW(1),IZW)
C
N     LIMITS
      COMMON /CPTSLM/ BKTRLM(20),HXREF(200,3)
                      INTEGER LMBKTR(20)
                      EQUIVALENCE (BKTRLM(1),LMBKTR(1))
C
 2003 FORMAT(1H0,A4,I6,2(/,1X,24I4),/,1X,50I2)
 2004 FORMAT(1H0,'BACKTR:',5X,20I6)
 2005 FORMAT(1H ,12X,20I6)
 2006 FORMAT(1X,4I6,I3,2F10.3,I3,2F10.3,1X,Z5,2I3,2X,3I3)
C
      IF(HNTR.LE.0) RETURN
C
N     MIN. # OF UNIQUE HITS OF TRCAND
      PERFORM PRINT
      MINHIT = 1
      PERFORM REDUCE
      PERFORM PRINT
      MINHIT = 5
      PERFORM REDUCE
      PERFORM PRINT
C
      RETURN
C
C
      PROC REDUCE
C
N     SEARCH FOR TRELS CORRELATED WITH >1 TRCD
      FOR ITRL=1,HNTR
        IF HXREF(ITRL,2).NE.0
        THEN
          NTRC(1) = HXREF(ITRL,1)
          NTRC(2) = HXREF(ITRL,2)
          NTRC(3) = HXREF(ITRL,3)
          LHIT(1) = 0
          LHIT(2) = 0
          LHIT(3) = 0
          MHIT(1) = 0
          MHIT(2) = 0
          MHIT(3) = 0
C     PRINT 2010, ITRL,NTRC
C2010 FORMAT(' COVERED TREL:',10I6)
N         CHECK IF TRCD HAVE UNIQUE TREL WITH >4 HITS
          ITRC = 1
          REPEAT
            JTRC = NTRC(ITRC)
            NTRL = HNREL(JTRC)
N           LOOP OVER ALL TRELS OF 'JTRC'
            LHIT0 = 0
            MHIT0 = 0
            FOR JTRL=1,NTRL
              KTRL = HISTR(JTRL,JTRC)
              KTRL = IABS(KTRL)
              IF HXREF(KTRL,2).EQ.0
              THEN
N               COUNT HITS OF UNIQUE TRELS
                MHIT0 = NRHT(KTRL) + MHIT0
              ELSE
N               COUNT HITS OF COMMON TRELS
                LHIT0 = NRHT(KTRL) + LHIT0
              CIF
            CFOR
N           MARK TRCD WITH <4 UNIQUE HITS
            IF(MHIT0.LT.MINHIT) NTRC(ITRC) =-NTRC(ITRC)
            MHIT(ITRC) = MHIT0
            LHIT(ITRC) = LHIT0
C     PRINT 2011, ITRC,JTRC,NTRL,MHIT0,LHIT0,NTRC(ITRC)
C2011 FORMAT(' UNIQUE HITS:',10I6)
          ITRC = ITRC + 1
          UNTIL ITRC.GT.3 .OR. NTRC(ITRC).EQ.0
C
N         CHECK IF NO GOOD TRCD
          IF NTRC(1).LE.0 .AND. NTRC(2).LE.0 .AND. NTRC(3).LE.0
          THEN
N           KEEP LONGEST TRCD
            LHIT(1) = MHIT(1) + LHIT(1)
            LHIT(2) = MHIT(2) + LHIT(2)
            LHIT(3) = MHIT(3) + LHIT(3)
            IF(MAX0(LHIT(1),LHIT(2)).LT.LHIT(3)) NTRC(3) =-NTRC(3)
            IF(MAX0(LHIT(1),LHIT(3)).LT.LHIT(2)) NTRC(2) =-NTRC(2)
            IF(MAX0(LHIT(2),LHIT(3)).LT.LHIT(1)) NTRC(1) =-NTRC(1)
            IF NTRC(1).LE.0 .AND. NTRC(2).LE.0 .AND. NTRC(3).LE.0
            THEN
N             2 TRCD OF EQUAL LENGTH
              IF LHIT(1).GE.LHIT(2)
              THEN
                NTRC(1) =-NTRC(1)
              ELSE
                NTRC(2) =-NTRC(2)
              CIF
            CIF
          CIF
C     PRINT 2012, TRC,LHIT,MHIT
C2012 FORMAT(' CHECK:',10I6)
C
N         DELETE BAD TRCD
          ITRC = 1
          REPEAT
            JTRC = NTRC(ITRC)
N           CHECK IF BAD TRCD
            IF JTRC.LT.0
            THEN
              JTRC = IABS(JTRC)
              NTRL = HNREL(JTRC)
N             LOOP OVER ALL TRELS OF 'JTRC'
              FOR JTRL=1,NTRL
                KTRL = HISTR(JTRL,JTRC)
                KTRL = IABS(KTRL)
N               DELETE TRACK IN XREF
                IF HXREF(KTRL,1).EQ.JTRC
                THEN
                  HXREF(KTRL,1) = HXREF(KTRL,2)
                  HXREF(KTRL,2) = HXREF(KTRL,3)
                  HXREF(KTRL,3) = 0
                ELSE
                  IF HXREF(KTRL,2).EQ.JTRC
                  THEN
                    HXREF(KTRL,2) = HXREF(KTRL,3)
                    HXREF(KTRL,3) = 0
                  ELSE
                    IF(HXREF(KTRL,3).EQ.JTRC) HXREF(KTRL,3)=0
                  CIF
                CIF
              CFOR
C
N             REMOVE DELETED TRACK
              NBYTE = (NTR-JTRC)*2
              IF(NBYTE.GT.0)
     ?        CALL MVC(HNREL(JTRC),0,HNREL(JTRC+1),0,NBYTE)
              NBYTE = NBYTE*9
              IF(NBYTE.GT.0)
     ?        CALL MVCL(HISTR(1,JTRC),0,HISTR(1,JTRC+1),0,NBYTE)
              HNREL(NTR) = 0
              CALL SETS(HISTR(1,NTR),0,18,0)
              NTR = NTR - 1
              FOR I=1,HNTR
                IF(HXREF(I,1).GT.JTRC) HXREF(I,1) = HXREF(I,1) - 1
                IF(HXREF(I,2).GT.JTRC) HXREF(I,2) = HXREF(I,2) - 1
                IF(HXREF(I,3).GT.JTRC) HXREF(I,3) = HXREF(I,3) - 1
              CFOR
C
            CIF
          ITRC = ITRC + 1
          UNTIL ITRC.GT.3 .OR. NTRC(ITRC).EQ.0
        CIF
      CFOR
C
C       PRINT 2003, HPRO,HNTR,HNTCEL
C       IP0 = HPTE0
C       FOR I1=1,HNTR
C       PRINT 2006, IP0,I1,(TRKAR(I1,I2),I2=1,11),
C    ,              HXREF(I1,1),HXREF(I1,2),HXREF(I1,3)
C          IP0 = IP0 + HLDTE
C       CFOR
C         PRINT 2004,NTR, (HNREL(I1),I1=1,NTR)
C         FOR ITR=1,NTR
C           NELM = HNREL(ITR)
C           PRINT 2005, (HISTR(I1,ITR),I1=1,NELM)
C         CFOR
C
      CPROC
C
      PROC PRINT
        PRINT 2003, HPRO,HNTR,HNTCEL
        IP0 = HPTE0
        FOR I1=1,HNTR
        PRINT 2006, IP0,I1,(TRKAR(I1,I2),I2=1,11),
     ,              HXREF(I1,1),HXREF(I1,2),HXREF(I1,3)
           IP0 = IP0 + HLDTE
        CFOR
        PRINT 2004,NTR, (HNREL(I1),I1=1,NTR)
        FOR ITR=1,NTR
          NELM = HNREL(ITR)
          PRINT 2005, (HISTR(I1,ITR),I1=1,NELM)
        CFOR
      CPROC
C
      END
C   13/11/80 102191206  MEMBER NAME  TRHTCK   (PATRECSR)    SHELTRAN
      SUBROUTINE TRHTCK(IPPATR,IPJHTL)
C
C     CHECK HITS OF TRACKS + REMOVE COVERED TRACKS
C
C     AUTHOR: P. STEFFEN (80/08/18)
C
      IMPLICIT INTEGER*2 (H)
C
#include "cdata.for"
#include "ccycp.for"
C
#include "cjdrch.for"
C
#include "cworkpr.for"
#include "cworkeq.for"
C
N     COUNTER FOR HITS ON TRACK
      DIMENSION NCNT1(127),NCNT2(127)
C
C2001 FORMAT(1H0,40I3,/,1X,40I3,/,1X,40I3,/,1X,7I3)
C2002 FORMAT(' TRHTCK, "JHTL":',6I8,/,(12X,20(2X,Z4)))
C2004 FORMAT(' ELIMTR:',20I6)
C2005 FORMAT(' ELIMTR:',1X,20I6)
C
N     NO CHECK IF NO TRACKS
      NTR1   = IDATA(IPPATR+ 2)
      IF(NTR1.LE.0) RETURN
      LPATR = IDATA(IPPATR)
C     CALL PRPATR
C
      IPHL0 = IPJHTL*2 + 3
      ILDHL = IDATA(IPJHTL)*2 - 2
      IPHL9 = ILDHL + IPHL0 - 1
      I0 = IPHL0
      I9 = IPHL9
      I1 = IDATA(IBLN('PATR'))
      I2 = IDATA(IBLN('JHTL'))
C     PRINT 2002, I0,I9,IPPATR,IPJHTL,I1,I2,(HDATA(I1),I1=I0,I9)
C
N     COUNT HITS OF TRACK
      CALL SETSL(NCNT1(1),0,1016,0)
      FOR I=IPHL0,IPHL9,2
        IZW1  = HDATA(I  )
        ITRK1 = LAND(SHFTR(IZW1,1),127)
        IF ITRK1.GT.0
        THEN
          IZW2  = HDATA(I+1)
          ITRK2 = LAND(SHFTR(IZW2,1),127)
          IF ITRK2.LE.0
          THEN
C           PRINT 2008,MKBDHT,IZW,HDATA(I),HDATA(I+1)
            NCNT1(ITRK1) = NCNT1(ITRK1) + 1
          ELSE
            NCNT2(ITRK1) = NCNT2(ITRK1) + 1
            NCNT2(ITRK2) = NCNT2(ITRK2) + 1
          CIF
        CIF
      CFOR
C
N     ELIMINATE COVERED OR TOO SHORT TRACKS
C     PRINT 2001, NCNT1,NCNT2
      MTR = 0
      IPTR9 = IDATA(IPPATR) + IPPATR
      FOR ITR=1,NTR1
        IF NCNT1(ITR).LT.5 .OR. NCNT1(ITR)+NCNT2(ITR).LT.8
        THEN
          PERFORM ELIMTR
          NCNT1(ITR) =-NCNT1(ITR)
        ELSE
N         COUNT REMAINING TRACKS
          MTR = MTR + 1
        CIF
      CFOR
C
C
      IDATA(IPPATR+2) = MTR
C
N     READJUST RECORD LENGTH + # OF TRACKS
      LENG  = IDATA(IPPATR+2)*IDATA(IPPATR+3) + IDATA(IPPATR+1)
      NDIFF = LENG - IDATA(IPPATR)
      IF(NDIFF.NE.0) CALL BCHM(IPPATR,NDIFF,IRET)
C
      RETURN
C
C
N     ***************************
N     *      E L I M T R        *
N     ***************************
C
N     ELIMINATE TRACK ITR
      PROC ELIMTR
C
N       LOOP OVER HIT LABEL ARRAY
        JTR = MTR + 1
        ITRDIF = ITR - JTR
C       PRINT 2004, ITR,MTR,JTR,ITRDIF
        IF NCNT1(ITR).NE.0 .OR. NCNT2(ITR).NE.0
        THEN
          FOR I=IPHL0,IPHL9,2
            IZW1  = HDATA(I  )
            ITRK1 = LAND(SHFTR(IZW1,1),127)
            IZW2  = HDATA(I+1)
            ITRK2 = LAND(SHFTR(IZW2,1),127)
            IF ITRK2.EQ.JTR
            THEN
              HDATA(I+1) = 0
              ITRK2 = 0
              IND1  = ITRK1 + ITRDIF
              NCNT1(IND1) = NCNT1(IND1) + 1
              NCNT2(IND1) = NCNT2(IND1) - 1
C     DATA NPREL /0/
C     NPREL = NPREL + 1
C     IF(NPREL.LE.90) PRINT 2005, ITR,JTR,ITRK1,ITRK2,IND1
            CIF
            IF ITRK1.EQ.JTR
            THEN
              HDATA(I ) = HDATA(I+1)
              HDATA(I+1) = 0
              ITRK1 = ITRK2
              ITRK2 = 0
              IF ITRK1.GT.0
              THEN
                IND1  = ITRK1 + ITRDIF
                NCNT1(IND1) = NCNT1(IND1) + 1
                NCNT2(IND1) = NCNT2(IND1) - 1
C     NPREL = NPREL + 1
C     IF(NPREL.LE.90) PRINT 2005, ITR,JTR,ITRK1,ITRK2,IND1
              CIF
            CIF
C           DECREASE TRACK # FOR HIGHER TRACK #'S
            IF(ITRK1.GT.JTR) HDATA(I  ) = HDATA(I  )-2
            IF(ITRK2.GT.JTR) HDATA(I+1) = HDATA(I+1)-2
          CFOR
C     PRINT 2002, I0,I9,IPPATR,IPJHTL,I1,I2,(HDATA(I1),I1=I0,I9)
        CIF
C     PRINT 2001, NCNT1,NCNT2
C
N       ELIMINATE TRACK IN PATR-BANK
        LTRBK = IDATA(IPPATR+3)
        IPTR1 = IPPATR + IDATA(IPPATR+1) + MTR*LTRBK
        IPTR2 = IPTR1 + LTRBK
        NBYTE = (IPTR9 -IPTR2 + 1) * 4
        IF NBYTE.GT.0
        THEN
          CALL MVCL(IDATA(IPTR1+1),0,IDATA(IPTR2+1),0,NBYTE)
C     CALL PRPATR
          FOR IP=IPTR1,IPTR9,LTRBK
            IDATA(IP+1) = IDATA(IP+1) - 1
          CFOR
        CIF
        IPTR9 = IPTR9 - LTRBK
C     CALL PRPATR
C
      CPROC
C
      END
C   12/09/79 002251728  MEMBER NAME  TRLORD9  (PATRECSR)    SHELTRAN
      SUBROUTINE TRLORD
      IMPLICIT INTEGER*2 (H)
#include "cworkpr.for"
      DIMENSION HORD(9)
      CALL SETSL(HORD(1),0,18,0)
      IF(NTR.LE.0) RETURN
      FOR I=1,NTR
      NELM=HNREL(I)
      IF NELM.GT.1
      THEN
      FOR IJ=1,NELM
      ITK=HISTR(IJ,I)
      ITK=IABS(ITK)
      IF ITK.GT.0
      THEN
      IC=IPCL(ITK)
      IF(IC.LE.24) IRING=1
      IF(IC.GT.24.AND.IC.LE.48) IRING=2
      IF(IC.GT.48) IRING=3
      IW=NWR2(ITK)
      ISORT=SHFTL(IRING,5)
      ISORT=ISORT+IW
      HORD(IJ)=ISORT
      CIF
      CFOR
      IT=NELM-1
      FOR I1=1,IT
      ITMP=I1+1
      FOR I2=ITMP,NELM
      IF HORD(I1).LT.HORD(I2)
      THEN
      IEMP=HORD(I1)
      HORD(I1)=HORD(I2)
      HORD(I2)=IEMP
      IEMP=HISTR(I1,I)
      HISTR(I1,I)=HISTR(I2,I)
      HISTR(I2,I)=IEMP
      CIF
      CFOR
      CFOR
      CIF
      CFOR
      NUM=100-NTR
      IF NUM.GT.0
      THEN
      FOR I=1,NUM
      HNREL(NTR+I)=0
      FOR J=1,9
      HISTR(J,NTR+I)=0
      CFOR
      CFOR
      CIF
      RETURN
      END
C   17/04/80 609102054  MEMBER NAME  ZCHECK   (PATRECSR)    SHELTRAN
      SUBROUTINE ZCHECK(DHRLIM)
      IMPLICIT INTEGER*2 (H)
C---
C---     AFTER COMPLETED FITS OF TRACKS IN RFI, LOOP OVER ALL TRACKS
C---     AND CHECK PROXIMITY TO REMAINING TRACKS; MARK ALL HITS WHICH
C---     ARE INSIDE A LIMIT (DHRLIM), AS BAD.
C---                                             J.OLSSON 14.09.79
C---                      LAST UPDATE    10.09.81
C---   ERROR IN CELNEI CORRECTED  10.9.1986    J.OLSSON
C---
      LOGICAL TBIT
#include "cgraph.for"
      COMMON / CJCELL / NCELL(3),NWIRES(3)
#include "cjdrch.for"
#include "cdata.for"
      COMMON /CHEADR/ HEAD(108)
#include "cdsmax.for"
      COMMON /CEE1/ EE1(96,2)
#include "cpatlm.for"
#include "cworkpr.for"
      EQUIVALENCE
     ,      (ADWRK(11),LAYER ),(ADWRK(12),NI    ),(ADWRK(13),NH    )
     ,     ,(ADWRK(14),XHIT  ),(ADWRK(15),YHIT  ),(ADWRK(16),ZHIT  )
     ,     ,(ADWRK(17),RHIT  ),(ADWRK(18),IERZRF),(ADWRK(19),LRFLAG)
     ,     ,(ADWRK(20),INCELL),(ADWRK(21),IERFLG),(ADWRK(22),BETA  )
      COMMON/CJTRIG/ PI,TWOPI
      DIMENSION LCL(4,100),MASKY(4)
      DIMENSION HELP1(2),HELP2(2),HCELLI(6),HELPX(2)
      EQUIVALENCE (LABL1,HELP1(1)),(HELP2(1),LABL2),(LABLX,HELPX(1))
      EQUIVALENCE (LCL(1,1),IWRK(1))
      DATA HELP1/0,0/ ,HELP2/0,0/, LNRHIT/100/, MK1/Z7F/,MKZLAB /Z1/
      DATA MKZ0LB /ZFFFE/
      DATA HELPX/0,0/,ICALL /0/
C
N     POINTERS IN HDATA,IDATA
      IPATR=IBLN('PATR')
      IPPATR = IDATA(IPATR)
N     CHECK IF PATR BANK EXISTS
      IF(IPPATR.LE.0) RETURN
      NTR = IDATA(IPPATR+2)
N     IF NO TRACKS, RETURN
      IF(NTR.LE.0) RETURN
      IJETC=IBLN('JETC')
      IJHTL=IBLN('JHTL')
      DELPHI = TWOPI/24.
      LO = IDATA(IPPATR+1)
      LTRBK = IDATA(IPPATR+3)
      IPJCA = IDATA(IJETC)
      IPJ = 2*IPJCA + 2
N     TOTAL NUMBER OF HITS
      NHT = (HDATA(IPJ+97)-HDATA(IPJ+1))/4
      HPFREE = 401
N     LP1 = ARRAY RPHI (RADIUS OF HIT)
      LP1 = HPFREE - 1
N     LP2 = ARRAY PHI (PHI OF HIT)
      LP2 = LP1 + LNRHIT
N     LP3 = ARRAY XHT (X OF HIT)
      LP3 = LP2 + LNRHIT
N     LP4 = ARRAY YHT (Y OF HIT)
      LP4 = LP3 + LNRHIT
N     LP5 = ARRAY HSADR (HIT ADRESS IN JETC)
      LP5 = LP4 + LNRHIT
N     LP6 = ARRAY HSWIR (WIRE NUMBER)
      LP6 = LP5 + LNRHIT
N     LP7 = ARRAY HSCEL (CELL NUMBER)
      LP7 = LP6 + LNRHIT
N     LP8 = ARRAY HSLAB (HIT ADRESS IN JHTL)
      LP8 = LP7 + LNRHIT
N     LP9 = ARRAY HSLRF (LRFLAG IN JHTL)
      LP9 = LP8 + LNRHIT
N     LPA = ARRAY ZHIT  (Z OF HIT)
      LPA = LP9 + LNRHIT
N     LPB = ARRAY ZLABEL (ZFIT LABEL)
      LPB = LPA + LNRHIT
N     UPDATE HPFREE
      HPFREE = LPB + LNRHIT + 1
      IPJ = IPJ + 95
      IPJHTL = IDATA(IJHTL)
      IPJH = 2*IPJHTL + 2
      IF ICALL.EQ.0
      THEN
         PERFORM ZCHINT
         ICALL = 1
      CIF
N     SET ARRAY WITH CELL OCCUPANCY
      PERFORM LCLMRK
C
N     LOOP OVER ALL TRACKS
      FOR ITR = 1,NTR
         IPPO1 = IPPATR + (ITR-1)*LTRBK + LO
         IPPO = IPPO1
         ITYPTR = IDATA(IPPO + 18)
N     CHECK IF CIRCLE TYPE FIT
         IF ITYPTR.EQ.1
         THEN
            PERFORM CIRPAR
            IF IPRFL.EQ.0
            THEN
               RMIN1 = RMIN
               RMAX1 = RMAX
               XMIT1 = XMIT
               YMIT1 = YMIT
            CIF
         CIF
N     CHECK IF PARABOLA TYPE FIT
         IF ITYPTR.EQ.2
         THEN
            PERFORM PARPAR
            IF IPRFL.EQ.0
            THEN
               C1R = C1
               C2R = C2
               C3R = C3
               C4R = C4
               C5R = C5
               C6R = C6
            CIF
         CIF
         IPRFL1 = IPRFL
         IF IPRFL1.EQ.0
         THEN
N     NR OF HITS / TRACK
            NHIT = 0
            NI = IPJ
            IHITH = -1
N     GET LIST OF CELL NUMBER FOR HIT CHECK
            FOR I = 1,6
               HCELLI(I) = IDATA(IPPO + 33 + I)
            CFOR
C > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > >
N     LOOP OVER ALL HITS, SELECT TRACK ITR
            FOR  IHT = 1,NHT
               NI = NI + 4
               IHITH = IHITH + 2
               IHITG = IHITH + 1
               HELP1(2) = HDATA(IPJH + IHITH)
               HELP2(2) = HDATA(IPJH + IHITG)
               MTR = LAND(SHFTR(LABL1,1),MK1)
               MTR2 = LAND(SHFTR(LABL2,1),MK1)
               IAMB = 0
               IF(MTR.EQ.ITR) IAMB = 1
               IF(MTR2.EQ.ITR) IAMB = 2
               IF IAMB.NE.0
               THEN
                  IF(IAMB.EQ.1) NH = IPJH + IHITH
                  IF(IAMB.EQ.2) NH = IPJH + IHITG
                  IF(IAMB.EQ.1) LABLX = LABL1
                  IF(IAMB.EQ.2) LABLX = LABL2
                  LRFLAG = -1
                  IF(TBIT(LABLX,23)) LRFLAG = 1
N     SET INPUT FOR JETXYZ
                  BETA = 1.
                  CALL JETXYZ
                  ITST = 1
                  FOR I = 1,6
                     IF(INCELL.EQ.HCELLI(I)) ITST = 0
                  CFOR
                  IF ITST.EQ.0
                  THEN
                     NHIT = NHIT + 1
N     STORE RESULTS IN WRK ARRAY
                     WRK(LP1+NHIT) = RHIT
                     FIHIT = ATAN2(YHIT,XHIT)
                     IF(FIHIT.LT.0.) FIHIT = FIHIT + TWOPI
                     WRK(LP2+NHIT) = FIHIT
                     WRK(LP3+NHIT) = XHIT
                     WRK(LP4+NHIT) = YHIT
                     IWRK(LP5+NHIT) = NI
N     RANGE (0 - 1535)
                     IWRK(LP6+NHIT) = LAYER + (INCELL - 1)*16
N     RANGE (1 - 96)
                     IWRK(LP7+NHIT) = INCELL
                     IWRK(LP8+NHIT) = NH
                     IWRK(LP9+NHIT) = LRFLAG
                     WRK(LPA+NHIT) = ZHIT
N     MARK BAD Z-COORDINATE
                     IWRK(LPB+NHIT) = LAND(LABLX,MKZLAB)
                  CIF
               CIF
            CFOR
C > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > >
C-------------- END OF COORDINATE LOOP
N     CHECK IF ANY HITS
            IF NHIT.GT.3
            THEN
N     LOOP OVER THE HITS
               FOR IHT = 1,NHIT
                  PERFORM LINEDS
N     FIND CROSS POINT WITH DRIFTSPACE
                  IF ITYPTR.EQ.1
                  THEN
                     RMIN = RMIN1
                     RMAX = RMAX1
                     XMIT = XMIT1
                     YMIT = YMIT1
                     PERFORM XYTS
                  CIF
                  IF ITYPTR.EQ.2
                  THEN
                     C1 = C1R
                     C2 = C2R
                     C3 = C3R
                     C4 = C4R
                     C5 = C5R
                     C6 = C6R
                     PERFORM XYTSPR
                  CIF
                  ICRFL1 = ICRFL
                  IF ICRFL1.EQ.0
                  THEN
                     DISTA=(XTS-XW)**2+(YTS-YW)**2
                     DISTA = SQRT(DISTA)
                     XTS1 = XTS
                     YTS1 = YTS
                     RTS = SQRT(XTS**2 + YTS**2)
                     INCL1 = IWRK(LP7+IHT)
N     FILL ARRAY WITH NEIGHBOR CELL-NRS
                     PERFORM CELNEI
N     LOOP OVER REMAINING TRACKS
                     FOR KTR = 1,NTR
N     SELECT OTHER TRACKS
                        IF KTR.NE.ITR
                        THEN
                           ICHKFL = LAND(MASKY(1),LCL(1,KTR))
     $                            + LAND(MASKY(2),LCL(2,KTR))
     $                            + LAND(MASKY(3),LCL(3,KTR))
     $                            + LAND(MASKY(4),LCL(4,KTR))
                           IF ICHKFL.GT.0
                           THEN
                              IPPO = IPPATR + (KTR-1)*LTRBK + LO
                              PERFORM ZOK
                              IF IOKZ.EQ.0
                              THEN
                                 ITYPTS = IDATA(IPPO+18)
                                 IF ITYPTS.EQ.1
                                 THEN
                                    PERFORM CIRPAR
                                    IF IPRFL.EQ.0
                                    THEN
                                       PERFORM XYTS
                                    CIF
                                 CIF
                                 IF ITYPTS.EQ.2
                                 THEN
                                    PERFORM PARPAR
                                    IF IPRFL.EQ.0
                                    THEN
                                       PERFORM XYTSPR
                                    CIF
                                 CIF
N     FIND CROSSPOINT WITH SAME DRIFTSPACE
                                 IF IPRFL.EQ.0.AND.ICRFL.EQ.0
                                 THEN
                                    PERFORM SAMCEL
                                    IF ICLSAM.EQ.1
                                    THEN
                                       DISTB=(XTS-XW)**2+(YTS-YW)**2
                                       DISTB = SQRT(DISTB)
                                       DIST = ABS(DISTA-DISTB)
N     CHECK DISTANCE BETWEEN CROSS POINTS
                                       IF DIST.LT.DHRLIM
                                       THEN
N     MARK THE HIT ACCORDINGLY
                                          NH = IWRK(LP8+IHT)
                                          HELPX(2) = HDATA(NH)
                                          LABLX = LAND(LABLX,MKZ0LB)
                                          HDATA(NH) = HELPX(2)
                                          XFOR
                                       CIF
                                    CIF
                                 CIF
                              CIF
                           CIF
                        CIF
                     CFOR
                  CIF
               CFOR
            CIF
         CIF
      CFOR
      RETURN
C---------
      PROC LCLMRK
C SET ARRAY LCL WITH BIT PATTERN FOR CELL OCCUPANCY FOR EACH TRACK
      IPPO = IPPATR - LTRBK + LO
      FOR ITR = 1,NTR
         LCL(1,ITR) = 0
         LCL(2,ITR) = 0
         LCL(3,ITR) = 0
         LCL(4,ITR) = 0
         IPPO = IPPO + LTRBK
         IPP = IPPO + 33
         FOR I = 1,6
            INCE = IDATA(IPP+I)
            IF INCE.GT.0
            THEN
               IRNG = (INCE-1)/24 + 1
               INCE = INCE - (IRNG-1)*24
               MASK = 2**(INCE-1)
               LCL(IRNG,ITR) = LOR(LCL(IRNG,ITR),MASK)
            ELSE
               XFOR
            CIF
         CFOR
      CFOR
      CPROC
C---------
      PROC ZCHINT
CALCULATE ON FIRST CALL THE ARRAY WITH DRIFT DIRECTIONS FOR LINEDS
         FOR INCELL = 1,96
            IF INCELL.LT.49
            THEN
               II = INCELL
               IF(II.GT.24) II = II - 24
               FINC = FLOAT(II-1)*DELPHI + DELPHI*.5
C              FINC = ARSIN(DIRWR1(II,2))
            ELSE
               II = INCELL - 48
C              FINC = ARSIN(DIRWR3(II,2))
               FINC = FLOAT(II-1)*DELPHI*.5 + DELPHI*.25
            CIF
            IF(FINC.LT.0.) FINC = FINC + TWOPI
            EE1(INCELL,1) = TAN(FINC + .5*PI + DRIROT(INCELL,1))
            EE1(INCELL,2) = TAN(FINC + .5*PI + DRIROT(INCELL,2))
         CFOR
      CPROC
C-------------------
      PROC LINEDS
C GET EQUATION FOR STRAIGHT LINE THROUGH WIRE AND DRIFT SPACE
         NI = IWRK(LP5 + IHT)
         LRFLG = IWRK(LP9 + IHT)
         IF(LRFLG.LT.0) LRFLG = 0
         XHIT = WRK(LP3+IHT)
         YHIT = WRK(LP4+IHT)
         INCELL = IWRK(LP7+IHT)
         E1 = EE1(INCELL,LRFLG+1)
         NRING = INCELL - 1
         NRING = NRING/24 + 1
         IF(NRING.GT.3) NRING = 3
         NCL = NCELL(NRING)
         RADD = RINCR(NRING)
         RW = FSENSW(NRING) - RADD
         NIW = IWRK(LP6+IHT) + 1
         NEW = NIW - (NRING-1)*384
         SHIFI = PSIIN(NRING)
         NCE = SHFTR(NEW-1,4)
         NWE = NEW - NCE*16
         RW = RW + NWE*RADD
         NUMCLO = 2
         IF(NWE.LT.9) NUMCLO = 1
         FACT = -1.
         IF(TBIT(NWE,31)) FACT = 1.
         FIW = SHIFI + NCE*TWOPI/FLOAT(NCL)
         IF(FIW.LT.0.) FIW = FIW + TWOPI
         IF(FIW.GT.TWOPI) FIW = FIW - TWOPI
         COSPH = COS(FIW)
         SINPH = SIN(FIW)
N     COORDINATES OF WIRE
         XW = RW*COSPH  - FACT*SINPH*SWDEPL
         YW = RW*SINPH  + FACT*COSPH*SWDEPL
C--  STRAIGHT LINE EQUATION OF DRIFTSPACE THROUGH XW,YW
C        Y = YW - TGA*XW  +  TGA*X         Y = E1*X + E2
         E2 = YW - E1*XW
      CPROC
C---------
      PROC XYTS
C GET CROSS POINT CIRCLE - DRIFT SPACE
         ICRFL = 0
         CONST1 = RMAX*RMIN + E2*E2 - 2.*E2*YMIT
         CONST1 = CONST1/(1.+E1*E1)
         CONST2 = E1*E2 - E1*YMIT - XMIT
         CONST2 = CONST2/(1.+E1*E1)
         RADD = CONST2*CONST2 - CONST1
         IF(RADD.LE.0.) ICRFL = -1
         IF ICRFL.EQ.0
         THEN
            RADD = AMAX1(RADD,.000001)
            RADD = SQRT(RADD)
            X1 = -CONST2 + RADD
            X2 = -CONST2 - RADD
            XTS = X1
            IF(ABS(XHIT-X2).LT.ABS(XHIT-X1)) XTS = X2
            YTS = E2 + E1*XTS
         CIF
      CPROC
C------------------------
      PROC CIRPAR
C-- FROM TRACK BANK CIRCLE PARAMETERS, GET THOSE USED IN PROC XYTS
         IPRFL = 0
         RAD = ADATA(IPPO+19)
         RMIN = ADATA(IPPO+20)
         PHIMIT = ADATA(IPPO+21)
         IF ABS(RAD).GT.1.E-08
         THEN
            RAD = ABS(1./RAD)
            RMIT= RAD + RMIN
            RMAX = RMIT + RAD
            XMIT = RMIT*COS(PHIMIT)
            YMIT = RMIT*SIN(PHIMIT)
         ELSE
            IPRFL = -1
         CIF
      CPROC
C--------------
      PROC PARPAR
C-- FROM TRACK BANK PARABOLA PARAMETERS, GET THOSE USED IN PROC XYTSPR
         IPRFL = 0
         A = ADATA(IPPO+19)
         B = ADATA(IPPO+20)
         C = ADATA(IPPO+21)
         D = ADATA(IPPO+22)
C--
         COSA = COS(A)
         SINA = SIN(A)
C--             GET EQUATION FOR PARABOLA IN DETECTOR SYSTEM
C--             C1*Y**2 + C2*Y + C3*X**2 + C4*X + C5*XY + C6 = 0
C--
         C1 = D*SINA*SINA
         C2 = - 2.*D*(B*COSA*SINA + C*SINA*SINA) - COSA
         C3 = D*COSA*COSA
         C4 = - 2.*D*(B*COSA*COSA + C*COSA*SINA) + SINA
         C5 = 2.*D*COSA*SINA
         C6 = (B*COSA+C*SINA)
         C6 = D*C6*C6 + C*COSA - B*SINA
      CPROC
C--------------
      PROC XYTSPR
C GET CROSS POINT PARABOLA - DRIFT SPACE
         ICRFL = 0
         C7 = C1*E1*E1 + C3 + C5*E1
         C8 = 2.*C1*E1*E2 + C2*E1 + C4 + C5*E2
         C9 = C1*E2*E2 + C2*E2 + C6
         IF ABS(C7).GT..000001
         THEN
            DD = C8*C8 - 4.*C7*C9
            IF DD.GT..000001
            THEN
               X1 = (-C8 + SQRT(DD))/(2.*C7)
               X2 = (-C8 - SQRT(DD))/(2.*C7)
               XTS = X1
               IF(ABS(XHIT-X2).LT.ABS(XHIT-X1)) XTS = X2
               YTS = E2 + E1*XTS
            ELSE
               ICRFL = -1
            CIF
         ELSE
            ICRFL = -1
         CIF
      CPROC
C------------------------
      PROC CELNEI
C     SET THE ARRAY MASKY WITH BIT PATTERN FOR NEIGHBOR CELLS
      MASKY(1) = 0
      MASKY(2) = 0
      MASKY(3) = 0
      MASKY(4) = 0
      IF INCL1.LE.24
      THEN
N     CELL NR 1
         IF INCL1.EQ.1
         THEN
            MASKY(1) = 8388611
            MASKY(2) = MASKY(1)
            MASKY(3) = 7
            MASKY(4) = 8388608
         ELSE
N     CELL NR 2 - 23
            IF INCL1.LT.24
            THEN
               MASKY(1) = LOR(MASKY(1),2**(INCL1-2))
               MASKY(1) = LOR(MASKY(1),2**(INCL1-1))
               MASKY(1) = LOR(MASKY(1),2**INCL1)
               MASKY(2) = MASKY(1)
               IF INCL1.LT.12
               THEN
                  MASKY(3) = LOR(MASKY(3),2**(2*INCL1-3))
                  MASKY(3) = LOR(MASKY(3),2**(2*INCL1-2))
                  MASKY(3) = LOR(MASKY(3),2**(2*INCL1-1))
                  MASKY(3) = LOR(MASKY(3),2**(2*INCL1))
               CIF
               IF INCL1.GT.13
               THEN
                  INCK1 = INCL1 - 12
                  MASKY(4) = LOR(MASKY(4),2**(2*INCK1-3))
                  MASKY(4) = LOR(MASKY(4),2**(2*INCK1-2))
                  MASKY(4) = LOR(MASKY(4),2**(2*INCK1-1))
                  MASKY(4) = LOR(MASKY(4),2**(2*INCK1))
               CIF
               IF INCL1.EQ.12
               THEN
                  MASKY(3) = 14680064
                  MASKY(4) = 1
               CIF
               IF INCL1.EQ.13
               THEN
                  MASKY(4) = 7
                  MASKY(3) = 8388608
               CIF
N     CELL NR 24
            ELSE
               MASKY(1) = 12582913
               MASKY(2) = MASKY(1)
               MASKY(3) = 1
               MASKY(4) = 14680064
            CIF
         CIF
      ELSE
         IF INCL1.LE.48
         THEN
N     CELL NR 25
            IF INCL1.EQ.25
            THEN
               MASKY(1) = 8388611
               MASKY(2) = MASKY(1)
               MASKY(3) = 7
               MASKY(4) = 8388608
            ELSE
N     CELL NR 26 - 47
               IF INCL1.LT.48
               THEN
                  INCK1 = INCL1 - 24
                  MASKY(1) = LOR(MASKY(1),2**(INCK1-2))
                  MASKY(1) = LOR(MASKY(1),2**(INCK1-1))
                  MASKY(1) = LOR(MASKY(1),2**INCK1)
                  MASKY(2) = MASKY(1)
                  IF INCK1.LT.12
N     CELL NR 26 - 35
                  THEN
                     MASKY(3) = LOR(MASKY(3),2**(2*INCK1-3))
                     MASKY(3) = LOR(MASKY(3),2**(2*INCK1-2))
                     MASKY(3) = LOR(MASKY(3),2**(2*INCK1-1))
                     MASKY(3) = LOR(MASKY(3),2**(2*INCK1))
                  CIF
                  IF INCK1.GT.13
N     CELL NR 38 - 47
                  THEN
                     INCK2 = INCK1 - 12
                     MASKY(4) = LOR(MASKY(4),2**(2*INCK2-3))
                     MASKY(4) = LOR(MASKY(4),2**(2*INCK2-2))
                     MASKY(4) = LOR(MASKY(4),2**(2*INCK2-1))
                     MASKY(4) = LOR(MASKY(4),2**(2*INCK2))
                  CIF
                  IF INCK1.EQ.12
N     CELL NR 36
                  THEN
                     MASKY(3) = 14680064
                     MASKY(4) = 1
                  CIF
                  IF INCK1.EQ.13
N     CELL NR 37
                  THEN
                     MASKY(4) = 7
                     MASKY(3) = 8388608
                  CIF
N     CELL NR 48
               ELSE
                  MASKY(1) = 12582913
                  MASKY(2) = MASKY(1)
                  MASKY(3) = 1
                  MASKY(4) = 14680064
               CIF
            CIF
         ELSE
N     CELL NR 49
            IF INCL1.EQ.49
            THEN
               MASKY(1) = 8388609
               MASKY(2) = MASKY(1)
               MASKY(3) = 3
               MASKY(4) = 8388608
            ELSE
N     CELL NR 50 - 95
               IF INCL1.LT.96
               THEN
                  INCK1 = INCL1 - 48
                  INCK2 = INCK1/2
                  MASKY(1) = LOR(MASKY(1),2**(INCK2-1))
                  MASKY(1) = LOR(MASKY(1),2**INCK2)
                  MASKY(2) = MASKY(1)
                  IF INCK2.LT.12
N     CELL NR 50 - 71
                  THEN
                     MASKY(3) = LOR(MASKY(3),2**(INCK1-2))
                     MASKY(3) = LOR(MASKY(3),2**(INCK1-1))
                     MASKY(3) = LOR(MASKY(3),2**INCK1)
                  CIF
                  IF INCK2.EQ.12
N     CELL NR 72 - 73
                  THEN
                     IF(INCK1.EQ.24) MASKY(3) = 12582912
                     IF(INCK1.EQ.25) MASKY(3) = 8388608
                     IF(INCK1.EQ.24) MASKY(4) = 1
                     IF(INCK1.EQ.25) MASKY(4) = 3
                  CIF
                  IF INCK2.GT.12
N     CELL NR 74 - 95
                  THEN
                     INCK1 = INCK1 - 24
                     MASKY(4) = LOR(MASKY(4),2**(INCK1-2))
                     MASKY(4) = LOR(MASKY(4),2**(INCK1-1))
                     MASKY(4) = LOR(MASKY(4),2**INCK1)
                  CIF
N     CELL NR 96
               ELSE
                  MASKY(1) = 8388609
                  MASKY(2) = MASKY(1)
                  MASKY(3) = 1
                  MASKY(4) = 12582912
               CIF
            CIF
         CIF
      CIF
      CPROC
C------------------------
      PROC SAMCEL
C CHECK IF CROSS POINT XTS,YTS  IN ACTUAL CELL (INCL1)
      ICLSAM = 0
      FII = ATAN2(YTS,XTS)
      IF(FII.LT.0.) FII = FII + TWOPI
      NFII = FII/DELPHI
      IF(INCL1.GT.48) NFII = 2.*FII/DELPHI
      NFII = NFII + 1
      IF(INCL1.GT.24) NFII = NFII + 24
      IF(INCL1.GT.48) NFII = NFII + 24
      IF(INCL1.EQ.NFII) ICLSAM = 1
      CPROC
C------------------------
      PROC ZOK
C CHECK IF Z-COORDINATE OF FIT INSIDE DETECTOR FOR CHECK POINT
         IOKZ = 0
         ZTEST = ADATA(IPPO+30)*RTS + ADATA(IPPO+31)
         IF(ABS(ZTEST).GT.ZMAX) IOKZ = 1
      CPROC
C------------------------
      END
C   26/03/81            MEMBER NAME  ZRFIT    (PATRECSR)    SHELTRAN
C   27/09/79 103261204  MEMBER NAME  ORZRFIT  (JADESR)      SHELTRAN
C   26/09/79            MEMBER NAME  ZRFIT    (JADESR)      SHELTRAN
C   17/07/79 C9080501   MEMBER NAME  ZRFIT8   (JADESR)      SHELTRAN
C   17/07/79 C9071701   MEMBER NAME  ZRFITA   (PATRECS)     SHELTRAN
C   01/07/79            MEMBER NAME  ZRFIT9   (PATRECSR)    SHELTRAN
C   30/03/79 C9062901   MEMBER NAME  ZRFITT   (JADESR)      SHELTRAN
C   13/03/79 C9033001   MEMBER NAME  ORZRFIT  (JADESR)      SHELTRAN
C   13/03/79 C9031301   MEMBER NAME  ZRFIT9   (JADESR)      SHELTRAN
      SUBROUTINE ZRFIT
C
C     LINEAR FIT OF Z-R OF TRACKS: P.STEFFEN(78/11/15)
C
      IMPLICIT INTEGER*2 (H)
C
C     MODIFIED WITH PREPROCESSOR TO SELECT HITS ON TRACK
C              LINE ELEMENT METHOD  A LA FLINEL
C              HISTOGRAMMING METHOD A LA ZVERTF    P.STEFFEN 20.9.79
C
#include "cheadr.for"
C
#include "cjdrch.for"
C
#include "cgraph.for"
#include "cworkpr.for"
#include "cworkeq.for"
C
      DIMENSION SUM(10),HIST(200)
      EQUIVALENCE
     ,           (ICELL ,ADWRK(1)),(NHIT  ,ADWRK(2)),(IRING ,ADWRK(3))
     ,         , (IERRCD,ADWRK(4)),(NTRKEL,ADWRK(5))
     ,         , (SUM(1),ADWRK(101))
C
#include "cpatlm.for"
C
      DATA SBRAT/2./, NPKMIN /4/, NBINZ/200/
C
      IERRLB = 0
C
N     PRINT OUT OF LIMITS
C     DATA NPR0 /0/
C     IF(NPR0.EQ.0) PRINT 2002, ZFITLM
C2002 FORMAT('0LIMITS OF ZRFIT:',2F8.2,2I6,F8.2,6X,4F8.2,I6)
C     NPR0 = 1
C
      IP0 = HPHT0
      IP9 = HPHT9
      IDP = HLDHT
      IP8 = IP9 - IDP + 1
N     OFFSET FOR R-Z TO OVERCOME ROUNDING ERRORS
      Z0 = .5*(WRK(IP0+5)+WRK(IP9-IDP+6))
      R0 = .5*(WRK(IP0+6)+WRK(IP9-IDP+7))
C
N     SET MAX Z OF DETECTOR
      ZMAXLM = ZMAX + 20.
C
N     INITIALIZE GOODNESS LABEL OF POINTS
      NHIT = 0
      NBAD = 0
      FOR IP=HPHT0,HPHT9,HLDHT
        IF(IWRK(IP+ 7).GE.10) IWRK(IP+7) = 16
        IF(ABS(WRK(IP+ 5)).GE.ZMAXLM) IWRK(IP+7) = 16
        IF(IWRK(IP+10).NE. 0) IWRK(IP+7) = LOR(IWRK(IP+7),8)
        IF(IWRK(IP+ 7).EQ. 0) NHIT = NHIT + 1
        IF(IWRK(IP+ 7).LT.16) NBAD = NBAD + 1
      CFOR
      NBAD = NBAD - NHIT

C
N     RESTORE DELETED HITS(KNTREL) IF TOO MANY
      IF NHIT.LT.16 .AND. NBAD.GE.8
      THEN
      NHIT = 0
        FOR IP=HPHT0,HPHT9,HLDHT
          IF IWRK(IP+ 7).LT.16 .AND. IWRK(IP+10).EQ.0
          THEN
            IWRK(IP+7) = 0
            NHIT = NHIT + 1
          CIF
        CFOR
      CIF
C
N     CHECK IF ENOUGH GOOD HITS
      IF NHIT.LT.3
      THEN
        IWRK(HPTR0+28) = 1
        WRK (HPTR0+29) = 0.
        WRK (HPTR0+30) = 0.
        WRK (HPTR0+31) = 1000000.
        IWRK(HPTR0+32) = 0.
        IWRK(HPTR0+47) = LOR(IWRK(HPTR0+47),384)
        RETURN
      CIF
C
N     POINT SELECTION 1 (P.ST.) ?????????
      IF LAND(LMZFIT(10),1).NE.0
      THEN
N       CHECK POINTS BEFORE DOING FIRST FIT
        PERFORM ZSTRT1
      CIF
N     POINT SELECTION 2 (J.OL.) ?????????
      IF LAND(LMZFIT(10),2).NE.0
      THEN
N       CHECK POINTS BEFORE DOING FIRST FIT
        PERFORM ZSTRT2
      CIF
C
      NITER = 0
      REPEAT
C
N       LINE FIT OF ALL POINTS
        PERFORM LINFIT
N       SAVE RESULT
        A1SV   = A1
        B1SV   = B1
        RMSSV  = RMS
        NDEGSV = NDEG
C
N       CHECK IF RMS OK
        IF RMS.LE.ZFITLM(1) .OR. NDEG.LT.6
N       RMS IS GOOD
        THEN
          XREPEAT
        CIF
C
N       BAD RMS: REJECT BAD HITS
        IF LAND(LMZFIT(10),1).EQ.0
        THEN
N         PREPRO 2, IF NOT YET CALLED
          PERFORM ZSTRT1
        ELSE
N         DELETE HITS FOUND BY PATROL
          PERFORM MKPTHT
        CIF
N       CHECK IF HITS REJECTED
        IF NBAD.EQ.0
        THEN
          XREPEAT
        CIF
C
N       REPEAT LINE FIT WITHOUT BAD HITS
        PERFORM LINFIT
        IF RMS.LE.ZFITLM(1)
        THEN
N         SAVE RESULT
          A1SV   = A1
          B1SV   = B1
          RMSSV  = RMS
          NDEGSV = NDEG
C
N         MARK HITS OUTSIDE 3 SIGMA DISTANCE
          DZMAX = ZFITLM(2)*3
          PERFORM MKBDHT
          XREPEAT
        CIF
      NITER = NITER + 1
      UNTIL NITER.GE.1
C
N
      IF(RMS.GT.ZFITLM(1) .OR. NDEG.LT.6) IERRLB = LOR(IERRLB,128)
C
N     SAVE RESULTS IN WRK
      IWRK(HPTR0+28) = 1
      WRK (HPTR0+29) = B1SV
      WRK (HPTR0+30) = A1SV
      WRK (HPTR0+31) = RMSSV
      IWRK(HPTR0+32) = NDEGSV+2
      IWRK(HPTR0+47) = LOR(IWRK(HPTR0+47),IERRLB)
C     PRINT 2000, NDEGSV,ZW1,ZW2,B1SV,A1SV,RMSSV
C       PERFORM PRINT
C
      RETURN
C
N     ***************************
N     *      M K B D H T        *
N     ***************************
C
N     MARK BAD HITS
      PROC MKBDHT
C
        NBAD = 0
        NGOOD = 0
        FOR IPHIT = HPHT0,HPHT9,HLDHT
          IF IWRK(IPHIT+7).LE.8
          THEN
            R1 = WRK(IPHIT+6)
            Z1 = WRK(IPHIT+5)
            ZF = R1*B1 + A1
            DZ = Z1 - ZF
            IF ABS(DZ).GT.DZMAX
N           MARK BAD AND GOOD HITS
            THEN
              NBAD = NBAD + 1
              IWRK(IPHIT+7) = 1
            ELSE
N             COUNT HITS THAT CAN BE USED
              NGOOD = NGOOD + 1
              IWRK(IPHIT+7) = 0
            CIF
          CIF
        CFOR
C
N     DELETE BAD HIT LABELS IF NOT ENOUGH HITS LEFT
      IF NGOOD.LT.LMZFIT(3)
      THEN
        FOR IP1 = IP0,IP9,IDP
          IWRK(IP1+7) = LAND(IWRK(IP1+7),14)
C         WRK(IP1+7) = BITOFF(WRK(IP1+7),31)
        CFOR
        NBAD = 0
      CIF
C
      CPROC
C
N     ***************************
N     *      M K P T H T        *
N     ***************************
C
N     MARK PATROL-HITS
      PROC MKPTHT
C
        NBAD = 0
        NGOOD = 0
        FOR IPHIT = HPHT0,HPHT9,HLDHT
          IF IWRK(IPHIT+7).LT.4
          THEN
            IF IABS(IWRK(IPHIT+8)).GE.1000
N           MARK BAD AND GOOD HITS
            THEN
              NBAD = NBAD + 1
              IWRK(IPHIT+7) = LOR(IWRK(IPHIT+7),4)
            ELSE
N             COUNT HITS THAT CAN BE USED
              NGOOD = NGOOD + 1
              IWRK(IPHIT+7) = 0
            CIF
          CIF
        CFOR
      CPROC
C
N     ***************************
N     *      L I N F I T        *
N     ***************************
C
N     FIT LINE TO R-Z COORDINATES
      PROC LINFIT
C
        IHIT = 0
        SUM(1) = 0.
        SUM(2) = 0.
        SUM(3) = 0.
        SUM(4) = 0.
        SUM(5) = 0.
        FOR IPHIT = IP0,IP9,IDP
          IF IWRK(IPHIT+7).EQ.0
          THEN
            IHIT =  IHIT + 1
            R1 = WRK(IPHIT+6) - R0
            Z1 = WRK(IPHIT+5) - Z0
            SUM( 1) = SUM( 1) + R1
            SUM( 2) = SUM( 2) + R1**2
            SUM( 3) = SUM( 3) + Z1
            SUM( 4) = SUM( 4) + Z1**2
            SUM( 5) = SUM( 5) + R1*Z1
          CIF
        CFOR
        ANHIT= IHIT
        NDEG = IHIT - 2
        IF NDEG.GT.0
        THEN
          ZW1  = (SUM(5)*ANHIT - SUM(1)*SUM(3))
          ZW2  = (SUM(2)*ANHIT - SUM(1)**2)
          B1   = ZW1 / ZW2
          A1   =(SUM(3) - B1*SUM(1)) / ANHIT + Z0 - B1*R0
          CHSQ = SUM(4)*ANHIT - SUM(3)**2 - ZW1**2/ZW2
          RMS  = CHSQ / (IHIT*NDEG)
          IF(RMS.GT.0) RMS = SQRT(RMS)
        ELSE
          B1   = 0.
          A1   = 0.
          RMS  = 1000000.
        CIF
C     IF LBPR.NE.0
C     THEN
C       PERFORM PRINT
C     CIF
      CPROC
C
N     ***************************
N     *      Z S T R T 2        *
N     ***************************
C
      PROC ZSTRT2
N     CHECK POINTS BEFORE MAKING THE FIRST FIT
C
N     MARK BAD HITS WITH NO CLOSE ADJACENT ONES
C
      SIGL2 = ZFITLM(2)*2.
      SIGL4 = ZFITLM(2)*3.5
      NHIT  = 0
      IP10  = 0
      IP3   = IP0
      REPEAT
        IF IWRK(IP3+ 7).EQ. 0
        THEN
N         POINTER TO 1. USEFUL POINT
          IF(IP10.LE.0) IP10 = IP3
N         INITIALIZE BAD HIT LABEL
          NHIT = NHIT + 1
          IF NHIT.EQ.1
N         1. HIT
          THEN
            R1 = WRK(IP3+6)
            Z1 = WRK(IP3+5)
            IP1 = IP3
          ELSE
            IF NHIT.EQ.2
N           2. HIT
            THEN
              R2 = WRK(IP3+6)
              Z2 = WRK(IP3+5)
              IP2 = IP3
            ELSE
N             3. HIT
              R3 = WRK(IP3+6)
              Z3 = WRK(IP3+5)
N             DEVIATION OF CENTRAL POINT FROM STRAIGHT LINE
              DR31 = R3-R1
              DELT = 0.
              IF(ABS(DR31).GT.15.) DELT = Z2-Z1 - (R2-R1)*(Z3-Z1)/DR31
              IF(ABS(DELT).GT.SIGL4) IWRK(IP2+7) = 4
              IF ABS(DELT).GT.SIGL2
              THEN
                IF(IP1.EQ.IP0) IWRK(IP1+7) = 4
                IF(IP3.EQ.IP8) IWRK(IP3+7) = 4
              CIF
              R1 = R2
              R2 = R3
              Z1 = Z2
              Z2 = Z3
              IP1 = IP2
              IP2 = IP3
            CIF
          CIF
        CIF
      IP3 = IP3 + IDP
      UNTIL IP3.GT.IP9
N     LAST USEFUL POINT
      IP90 = IP2
C
N     CROSS CHECK REJECTED HITS
N     POINTER TO 1. GOOD HIT
      IP1 = IP10
N     SEARCH 2. GOOD HIT
      IP2 = 0
      IP3 = IP1
      REPEAT
      IP3 = IP3 + IDP
        IF IWRK(IP3+ 7).LE.4
        THEN
N         COUNT GOOD HITS
          IP2 = IP3
          XREPEAT
        CIF
      UNTIL IP3.EQ.IP9
      IF IP2.LE.0
      THEN
        NHIT = 0
N     LOOP OVER REMAINING HITS
      ELSE
        REPEAT
        IP3 = IP3 + IDP
          IF IWRK(IP3+ 7).LE.4
          THEN
            IF IWRK(IP3+7).EQ.4 .OR. IWRK(IP1+7).EQ.4
            THEN
              R1 = WRK(IP1+6)
              Z1 = WRK(IP1+5)
              R2 = WRK(IP2+6)
              Z2 = WRK(IP2+5)
              R3 = WRK(IP3+6)
              Z3 = WRK(IP3+5)
N             DEVIATION OF CENTRAL POINT FROM STRAIGHT LINE
              DR31 = R3-R1
              DELT = 1000000.
              IF(ABS(DR31).GT.15.) DELT = Z2-Z1 - (R2-R1)*(Z3-Z1)/DR31
              IF ABS(DELT).LT.SIGL2
              THEN
N               MARK 1. + 3. HIT AS BEEING GOOD
                IWRK(IP1+7) = 0
                IWRK(IP3+7) = 0
              CIF
            CIF
            IP1 = IP2
            IP2 = IP3
          CIF
        UNTIL IP3.GE.IP90
N       COUNT GOOD HITS
        NHIT = 0
        FOR IP1=IP0,IP9,IDP
          IF(IWRK(IP1+7).EQ.0) NHIT = NHIT + 1
        CFOR
      CIF
C
N     DELETE BAD HIT LABELS IF NOT ENOUGH HITS LEFT
      IF NHIT.LT.LMZFIT(3)
      THEN
        FOR IP1 = IP0,IP9,IDP
          IWRK(IP1+7) = LAND(IWRK(IP1+7),11)
C         WRK(IP1+7) = BITOFF(WRK(IP1+7),29)
        CFOR
      CIF
C
      CPROC
C
N     ***************************
N     *      Z S T R T 1        *
N     ***************************
C
N     CHECK POINTS BEFORE MAKING THE FIRST FIT
      PROC ZSTRT1
C
N     FIND INTERSEPT WITH Z-AXIS
C
C
N     ZERO HISTOGRAM
      FOR I = 1,NBINZ
        HIST(I) = 0
      CFOR
N     AVERAGE RADIUS
      AVRAD  = 0.
      NAVRAD = 0
N     LOOP OVER ALL PAIRS OF HITS
      IP91 = IP9 - IDP
      Z0HIST = -7000.
      DZHIST = 70.
      FOR IPHIT = IP0,IP91,IDP
        IF IWRK(IPHIT+7).EQ.0
        THEN
N         1. HIT
          R1 = WRK(IPHIT+6)
          AVRAD  = R1 + AVRAD
          NAVRAD =  1 + NAVRAD
          Z1 = WRK(IPHIT+5)
          IP1 = IPHIT + IDP
          FOR IPHIT2 = IP1,IP9,IDP
            IF IWRK(IPHIT2+7).EQ.0
            THEN
N             2. HIT
              R2 = WRK(IPHIT2+6)
              Z2 = WRK(IPHIT2+5)
              IF ABS(R1-R2).GT.ZFITLM(6)
              THEN
N               Z-INTERSEPT
                ZCON = (Z1*R2 - R1*Z2)/(R2-R1)
                IZV = (ZCON - Z0HIST) / DZHIST + 1
                IF IZV.GT.0 .AND. IZV.LE.NBINZ
                THEN
N                 HISTOGRAM INTERSEPT
                  HIST(IZV) = HIST(IZV) + 1
                CIF
              CIF
            CIF
          CFOR
        CIF
      CFOR
C
N     FIND PEAK IN HISTOGRAM
      PERFORM HEVAL
N     Z(VERTEX)
      ZVTX = ZPEAK
C
N     DETERMINE SLOPE OF TRACK
C
C
N     CHECK IF VERTEX FOUND
      IF INDLB.GT.0
      THEN
N       ZERO HISTOGRAM
        FOR I = 1,NBINZ
          HIST(I) = 0
        CFOR
N       AVERAGE RADIUS
        IF(NAVRAD.GT.0) AVRAD = AVRAD / NAVRAD
N       PARAMETERS OF HISTOGRAM
        Z0HIST = -3000.
        DZHIST = 30.
N       LOOP OVER ALL HITS
        FOR IPHIT = IP0,IP9,IDP
          IF IWRK(IPHIT+7).LE.4
          THEN
            IWRK(IPHIT+7) = 0
N           PROJECTION ON LINE OF AVER. RADIUS
            ZCON = (WRK(IPHIT+5) - ZVTX) * AVRAD/WRK(IPHIT+6)
            IZV  = (ZCON - Z0HIST) / DZHIST + 1
            IF IZV.GT.0 .AND. IZV.LE.NBINZ
            THEN
N             HISTOGRAM Z-PROJECTION
              HIST(IZV) = HIST(IZV) + 1
            CIF
          CIF
        CFOR
C
N       FIND PEAK IN HISTOGRAM
        PERFORM HEVAL
N       CHECK IF PEAK FOUND
        IF INDLB.GT.0
        THEN
N         SLOPE OF TRACK
          ZPRO = ZPEAK
          SLOPE = ZPRO / AVRAD
C
N         MARK HITS OUTSIDE 4 SIGMA
          SIG0 = ZFITLM(2)*4.
          NHIT = 0
          NBAD = 0
          FOR IPHIT = IP0,IP9,IDP
            IF IWRK(IPHIT+7).LE.0
            THEN
              NHIT = NHIT + 1
              DZ = WRK(IPHIT+6)*SLOPE + ZVTX - WRK(IPHIT+5)
              IF ABS(DZ).GT.SIG0
              THEN
                NBAD = NBAD + 1
                IWRK(IPHIT+7) = LOR(IWRK(IPHIT+7),4)
              CIF
            CIF
          CFOR
C
N         DELETE BAD HIT LABELS IF NOT ENOUGH HITS LEFT
          NHIT = NHIT - NBAD
          IF NHIT.LT.LMZFIT(3)
          THEN
            FOR IPHIT = IP0,IP9,IDP
              IWRK(IPHIT+7) = LAND(IWRK(IPHIT+7),11)
C             WRK(IPHIT+7) = BITOFF(WRK(IPHIT+7),29)
            CFOR
          CIF
C
        CIF
      CIF
      CPROC
C
N     ***************************
N     *      H E V A L          *
N     ***************************
C
N     FIND BIN WITH MAX.CONTENT
      PROC HEVAL
C
N       FIND PEAK
        NPEAK = 0
        IH9 = NBINZ-11
        FOR IH=7,IH9
          IHSUM = HIST(IH  )+HIST(IH+1)+HIST(IH+2)+HIST(IH+3)+HIST(IH+4)
          IF IHSUM.GT.NPEAK
          THEN
N           MEMORIZE PEAK
            NPEAK = IHSUM
            HPEAK = IH
          CIF
        CFOR
        PEAK = NPEAK
        INDLB =-1
        IF NPEAK.GE.NPKMIN
        THEN
N       PEAK OK ... CALC. BACKGROUND
          INDLB = 1
          H1 = HPEAK - 7
          H2 = HPEAK + 7
          NBACK = HIST(H1  )+HIST(H1+1)+HIST(H1+2)+HIST(H1+3)+HIST(H1+4)
     +          + HIST(H2  )+HIST(H2+1)+HIST(H2+2)+HIST(H2+3)+HIST(H2+4)
          BACK = .5 * NBACK
N         BACKGROUND LOW ENOUGH ... SET IZRSLT(6) = 1
          IF(BACK*SBRAT.GT.PEAK) INDLB = 0
C
N         CALC. ACCURATE PEAK POS.
          ZV = HIST(HPEAK+1)   + HIST(HPEAK+2)*2
     +        + HIST(HPEAK+3)*3 + HIST(HPEAK+4)*4
          ZV = ZV / PEAK
          DZ = HIST(HPEAK  )*(ZV   )**2 + HIST(HPEAK+1)*(ZV-1.)**2
     +       + HIST(HPEAK+2)*(ZV-2.)**2 + HIST(HPEAK+3)*(ZV-3.)**2
     +       + HIST(HPEAK+4)*(ZV-4.)**2
          DZ = DZ * DZHIST**2 / PEAK
          DZ = SQRT(DZ)
          ZPEAK     = Z0HIST + (HPEAK+ZV-.5)*DZHIST
C     PRINT 2004, HIST
C     PRINT 2005, INDLB,HPEAK,H1,H2,ZPEAK,DZ,PEAK,BACK
C2004 FORMAT(1H0,40I3)
C2005 FORMAT(1H0,4I6,4F8.1)
        CIF
      CPROC
C
N     ***************************
N     *      P R I N T          *
N     ***************************
C
N     PRINTOUT OF HIT-ARRAY
C     PROC PRINT
C
C       DATA NPR /0/
C       IF NPR.LE. 30
C       THEN
C       NPR = NPR + 1
C         WRITE(6,2992) HHEADR(17),HHEADR(18),HHEADR(19)
C         PRINT 2000, NHIT,ZW1,ZW2,B1,A1,RMS,CHSQ
C         PRINT 2000, NDEG,SUM(1),SUM(2),SUM(3),SUM(4),SUM(5)
C         FOR IPHT=HPHT0,HPHT9,HLDHT
C         I0 = IPHT
C         I9 = IPHT - 1 + HLDHT
C         PRINT 2001,(WRK(I1),I1=I0,I9)
C2992 FORMAT('0MESSAGE FOR P.STEFFEN: ERROR IN ZRFIT; EVENT:',3I6)
C2000 FORMAT(1H ,I4,9E13.5)
C2001 FORMAT(1H ,3I4,4F8.2,5I6,5F8.2,2I2)
C         CFOR
C       CIF
C     CPROC
C
      END
