SUBROUTINE FTJN3
*-- Author : I.O. Skillicorn
      SUBROUTINE FTJN3(CF,IU,LLL,LL,RPC,RPS,PH,CH,        ZI)
**: FTJN3 40000 IS.  New linking code.                                                                        
**----------------------------------------------------------------------                                      
**: FTJN3 40000 .SM. Fix selection of best link.                                                              
**----------------------------------------------------------------------                                      
C     JOIN THREE MODULES                                                                                      
C     AUTHOR    I.O.SKILLICORN                                                                                
C     21/5/91  REDUCE SIZE                                                                                    
*KEEP,FRDIMS.                                                                                                 
      PARAMETER (MAXHTS=200)                                            
      PARAMETER (NUMWPL=36)                                             
      PARAMETER (MAXTRK=200)                                            
      PARAMETER (MXTTRK=900)                                            
      PARAMETER (MAXTR3=200)                                            
      PARAMETER (MAXHPW=2)                                              
      PARAMETER (MAXDIG=2000)                                           
      PARAMETER (NUMRWR=1727)                                           
      PARAMETER (NUMPWR=1151)                                           
*KEEP,FH1WORK.                                                                                                
       COMMON/FGMIOS/                                                   
*    Planar geometry                                                                                          
     + ZPP(140),C(140),S(140),ITYPE(140),WZERO(140),WSPACE,             
*                                                                                                             
*    Radial geometry                                                                                          
     + ZP(36),PHW(36),WS(36)                                            
*                                                                                                             
       COMMON/H1WORK/                                                   
*    Radial data...                                                                                           
     + WW(MAXHTS,36),DRI(MAXHTS,36),RM(MAXHTS,36),                      
     + NDP(36),  NW(MAXHTS,36), DWS(MAXHTS,36),                         
*                                                                                                             
*    Planar Data                                                                                              
     + NDPW(NUMWPL),DW(MAXHTS,NUMWPL),                                  
     + DRIW(MAXHTS,NUMWPL),NDW(MAXHTS,NUMWPL),                          
     + WWP(MAXHTS,NUMWPL),                                              
     + IPHOLE(MAXHTS,NUMWPL),                                           
*                                                                                                             
*    Pointers into DIGI bank for IOS labelled hits                                                            
     +  IPFRRE(MAXHTS,36),IPFRPE(MAXHTS,36),NFRRE,NFRPE,                
     +  IRPIOS(MAXDIG,2), IPPIOS(MAXDIG,2),                             
*                                                                                                             
*    Track segment data                                                                                       
     + NTRAKS(3),IRPT(12,MAXTRK,3),SDRFT(12,MAXTRK,3),                  
*                                                                                                             
*    Fit data                                                                                                 
     + PCOSL(MAXTRK,3),PSINL(MAXTRK,3),PHZL(MAXTRK,3),                  
     + DPCOSL(MAXTRK,3),DPSINL(MAXTRK,3),                               
     + DPHZL(MAXTRK,3),CHSQ(MAXTRK,3),RZI(MAXTRK,3),                    
     + RPCOSG(MAXTRK),RPSING(MAXTRK),                                   
     + PHZG(MAXTRK),CC(3,MAXTRK),ZIG(MAXTRK),                           
     + IRADG(36,MAXTRK),PHIG(36,MAXTRK),                                
     + IG,SDRADG(36,MAXTRK),                                            
     + R1,Z1,RFIT(MAXTRK,3),                                            
     + CHG(MAXTRK),                                                     
     + PPA(MAXTRK,3),  ZZA(MAXTRK,3),                                   
     + GPA(MAXTRK,3),GZA(MAXTRK,3)                                      
*                                                                                                             
*                                                                                                             
*KEEP,FPTVTX.                                                                                                 
      COMMON/VERTVV/ZV ,XVV,YVV                                         
**the common/VERTEX/ becomes /VERTVV/ (in analogy to /VERTFF/) on the                                         
** 17/6/91, since it is in conflict with the VERTEX module (g.bernardi)                                       
** (note that all these common names should start by F in this deck...)                                       
*KEEP,FJNPAR.                                                                                                 
      COMMON/FJNPAR/                                                    
     +      CHT3, CHT12, CHT23, CHT13,                                  
     +      PCT3, PCT12, PCT23, PCT13,                                  
     +      PSC3, PSC12, PSC23, PSC13,                                  
     +      RCT3, RCT12, RCT23, RCT13                                   
*KEND.                                                                                                        
*                                                                                                             
      COMMON/FVFLAG/IVERTX                                              
      COMMON/PARA/PA1,PA2,PA3,ZA1,ZA2,ZA3                               
*                                                                                                             
*     LOCAL ARRAYS...                                                                                         
      DIMENSION CF(MAXTR3,3),IU(MAXTR3,3),LL(MAXTR3,3)                  
      DIMENSION RPC(MAXTR3),RPS(MAXTR3)                                 
      DIMENSION PH(MAXTR3),CH(MAXTR3),CX(3)                             
C     DIMENSION IP(36),SD(36),IPP(36,MAXTR3),SDD(36,MAXTR3)                                                   
      DIMENSION IP(36),SD(36)                                           
      DIMENSION ZI(MAXTR3)                                              
      DIMENSION XX(36),YY(36),ZZ(36),WT(36),IMM(36)                     
      DIMENSION XXX(36),YYY(36),ZZZ(36),WWT(36)                         
                                                                        
C     'Centre' points of radial modules                                                                       
      PARAMETER(IZM1=6)                                                 
      PARAMETER(IZM2=18)                                                
      PARAMETER(IZM3=30)                                                
      DATA ISTART/0/                                                    
      IF(ISTART.EQ.0)THEN                                               
      ISTART=1                                                          
      CALL STEXT(2016,4,' PHI CONT - M12 R12 PSCUT ALL')                                               
      CALL BHS(2016,0,40,-.10,.10)                                                                     
      CALL STEXT(2017,4,' PHI CONT - M23 R23 PSCUT 3M AFTER M12 SEL ')                                 
      CALL BHS(2017,0,40,-.10,.10)                                                                     
      ENDIF                                                             
*                                                                                                             
      ZM12 = 0.5*(ZP(IZM1) + ZP(IZM2))                                  
      ZM23 = 0.5*(ZP(IZM2) + ZP(IZM3))                                  
      ZM13 = 0.5*(ZP(IZM1) + ZP(IZM3))                                  
*                                                                                                             
C     TO JOIN THREE MODULES                                                                                   
      PI2=6.2831853                                                     
                                                                        
      CONS=-2./(12.*0.0002998)                                          
                                                                        
                                                                        
      CHT   = CHT3                                                      
      PCUT  = PCT3                                                      
      PSCUT = PSC3                                                      
      RCUT  = RCT3                                                      
                                                                        
*************************NEW CUTS******94 DATA**************                                                  
*     RCUT=20.                                                                                                
*     PCUT=0.04                                                                                               
*     PSCUT=0.002                                                                                             
*     CHT=100                                                                                                 
************************************************************                                                  
      Z1=ZP(IZM1)                                                       
      Z2=ZP(IZM2)                                                       
      Z3=ZP(IZM3)                                                       
                                                                        
C                                                                                                             
C                                                                                                             
C                                                                                                             
      LLL=0                                                             
      ZVV=ZV                                                            
      N1=NTRAKS(1)                                                      
      N2=NTRAKS(2)                                                      
      N3=NTRAKS(3)                                                      
C     =0 USE MANY TIMES  =1  USE ONCE                                                                         
      ICHK=1                                                            
C     *******************************                                                                         
      DO 10 I=1,N1                                                      
C     CYCLE LINE SEGMENTS M0                                                                                  
      IF(CHSQ(I,1).GT.1000.)GOTO10                                      
      IF(ICHK.EQ.1.AND.IU(I,1).EQ.1)GOTO10                              
      DO 20 J=1,N2                                                      
C     CYCLE LINE SEGMENTS M1                                                                                  
      IF(CHSQ(J,2).GT.1000.)GOTO20                                      
      IF(ICHK.EQ.1.AND.IU(J,2).EQ.1)GOTO20                              
      RTEST=(RFIT(I,1)-RFIT(J,2)*Z1/Z2)                                 
C     CHECK LINE SEGMENTS POINT TO Z-AXIS                                                                     
      IF(ABS(RTEST).GT.RCUT)GOTO20                                      
C     FILL POINTS/DRIFT SIGN                                                                                  
C     REFIT PHI-Z WITH R-VALUES OF SEGMENTS                                                                   
C     RECALCULATE PHI-Z SLOPE AND INTERCEPT                                                                   
      DO 100 KK=1,24                                                    
      IF(KK.LE.12)THEN                                                  
      IP(KK)=IRPT(KK,I,1)                                               
      SD(KK)=SDRFT(KK,I,1)                                              
      ELSE                                                              
      IP(KK)=IRPT(KK-12,J,2)                                            
      SD(KK)=SDRFT(KK-12,J,2)                                           
      ENDIF                                                             
 100  CONTINUE                                                          
      L=0                                                               
      DO 110 KK=1,24                                                    
      IF(IP(KK).EQ.0)GOTO110                                            
      JJ=IP(KK)                                                         
      L=L+1                                                             
      IF(KK.LE.12)IMM(L)=1                                              
      IF(KK.GT.12)IMM(L)=2                                              
C     R : ASSUMES LINEAR TO VERTEX                                                                            
      RRS=(RFIT(I,1)+RFIT(J,2))/(Z1+Z2)                                 
      RR=RRS*ZP(KK)                                                     
      XX(L)=ZP(KK)                                                      
      YY(L)=ATAN((DRI(JJ,KK)*SD(KK)+DWS(JJ,KK))/RR) +WW(JJ,KK)          
      IF(YY(L).LT.0.0)YY(L)=YY(L)+PI2                                   
      WT(L)=1.0                                                         
 110  CONTINUE                                                          
C     PHI CONTINUOUS                                                                                          
      IF(L .GT. 1)THEN                                                  
      DO120 JJ=2,L                                                      
      DP = YY(JJ)-YY(JJ-1)                                              
      IF(DP.GT.0.) THEN                                                 
      IF(ABS(DP).GT.ABS(DP-PI2))YY(JJ)=YY(JJ)-PI2                       
      ELSE                                                              
      IF(ABS(DP).GT.ABS(DP+PI2))YY(JJ)=YY(JJ)+PI2                       
      ENDIF                                                             
 120  CONTINUE                                                          
      ENDIF                                                             
      IC=0                                                              
      DO 130 KK=1,L                                                     
      IF(IMM(KK).EQ.1)THEN                                              
      IC=IC+1                                                           
      XXX(IC)=XX(KK)                                                    
      YYY(IC)=YY(KK)                                                    
      WWT(IC)=WT(KK)                                                    
      ENDIF                                                             
 130  CONTINUE                                                          
C     FIT LINESEG IN M0                                                                                       
      CALL FTLFTW(XXX,YYY,WWT,IC,0,2,PS1,PZ1,D1,D2,D3,COV)
      IC=0                                                              
      DO 140 KK=1,L                                                     
      IF(IMM(KK).EQ.2)THEN                                              
      IC=IC+1                                                           
      XXX(IC)=XX(KK)                                                    
      YYY(IC)=YY(KK)                                                    
      WWT(IC)=WT(KK)                                                    
      ENDIF                                                             
 140  CONTINUE                                                          
C     FIT LINESEG IN M1                                                                                       
      CALL FTLFTW(XXX,YYY,WWT,IC,0,2,PS2,PZ2,D1,D2,D3,COV)
C     CHECK RECALCULATED PHI CONTINUOUS AT MID-PLANE                                                          
      PP1=PS1*ZM12+PZ1                                                  
      PP2=PS2*ZM12+PZ2                                                  
      IF(ABS(PS1-PS2).LT.PSCUT)CALL SHS(2016,0,PP1-PP2)                 
                                                                        
                                                                        
                                                                        
*     CHECK PHI CONTINUOUS                                                                                    
*     CHECK PHI' SIMILAR FOR EACH SEGMENT                                                                     
      IF(ABS(PP1-PP2).GT.PCUT)GOTO20                                    
      IF(ABS(PS1-PS2).GT.PSCUT)GOTO20                                   
C     HERE HAVE 0-1 LINK . CYCLE LINKS IN M2                                                                  
      DO 50 K=1,N3                                                      
      IF(CHSQ(K,3).GT.1000.)GOTO50                                      
      IF(ICHK.EQ.1.AND.IU(K,3).EQ.1)GOTO50                              
C     CHECK 1-2 POINTS TO Z AXIS IN R                                                                         
      RTEST=(RFIT(J,2)-RFIT(K,3)*Z2/Z3)                                 
      IF(ABS(RTEST).GT.RCUT)GOTO50                                      
                                                                        
C     FILL POINTS/DRIFT SIGN                                                                                  
C     REFIT PHI-Z WITH R-VALUES OF SEGMENTS                                                                   
C     RECALCULATE PHI-Z SLOPE AND INTERCEPT                                                                   
      DO 200 KK=1,36                                                    
      IF(KK.LE.12)THEN                                                  
      IP(KK)=IRPT(KK,I,1)                                               
      SD(KK)=SDRFT(KK,I,1)                                              
      ENDIF                                                             
      IF(KK.GE.13.AND.KK.LE.24)THEN                                     
      IP(KK)=IRPT(KK-12,J,2)                                            
      SD(KK)=SDRFT(KK-12,J,2)                                           
      ENDIF                                                             
      IF(KK.GE.25)THEN                                                  
      IP(KK)=IRPT(KK-24,K,3)                                            
      SD(KK)=SDRFT(KK-24,K,3)                                           
      ENDIF                                                             
 200  CONTINUE                                                          
      L=0                                                               
      DO 210 KK=1,36                                                    
      IF(IP(KK).EQ.0)GOTO210                                            
      JJ=IP(KK)                                                         
      L=L+1                                                             
      IF(KK.LE.12)IMM(L)=1                                              
      IF(KK.GE.13.AND.KK.LT.25)IMM(L)=2                                 
      IF(KK.GT.24)IMM(L)=3                                              
C     R : ASSUMES LINEAR TO VERTEX                                                                            
      RRS=(RFIT(J,2)+RFIT(K,3))/(Z2+Z3)                                 
      RR=RRS*ZP(KK)                                                     
      XX(L)=ZP(KK)                                                      
      YY(L)=ATAN((DRI(JJ,KK)*SD(KK)+DWS(JJ,KK))/RR) +WW(JJ,KK)          
      IF(YY(L).LT.0.0)YY(L)=YY(L)+PI2                                   
      WT(L)=1.0                                                         
 210  CONTINUE                                                          
C     PHI CONTINUOUS                                                                                          
      IF(L .GT. 1)THEN                                                  
      DO220 JJ=2,L                                                      
      DP = YY(JJ)-YY(JJ-1)                                              
      IF(DP.GT.0.) THEN                                                 
      IF(ABS(DP).GT.ABS(DP-PI2))YY(JJ)=YY(JJ)-PI2                       
      ELSE                                                              
      IF(ABS(DP).GT.ABS(DP+PI2))YY(JJ)=YY(JJ)+PI2                       
      ENDIF                                                             
 220  CONTINUE                                                          
      ENDIF                                                             
      IC=0                                                              
      DO 230 KK=1,L                                                     
      IF(IMM(KK).EQ.2)THEN                                              
      IC=IC+1                                                           
      XXX(IC)=XX(KK)                                                    
      YYY(IC)=YY(KK)                                                    
      WWT(IC)=WT(KK)                                                    
      ENDIF                                                             
 230  CONTINUE                                                          
C     REFIT M1 M2 WITH COMMON R                                                                               
      CALL FTLFTW(XXX,YYY,WWT,IC,0,2,PS1,PZ1,D1,D2,D3,COV)
      IC=0                                                              
      DO 240 KK=1,L                                                     
      IF(IMM(KK).EQ.3)THEN                                              
      IC=IC+1                                                           
      XXX(IC)=XX(KK)                                                    
      YYY(IC)=YY(KK)                                                    
      WWT(IC)=WT(KK)                                                    
      ENDIF                                                             
 240  CONTINUE                                                          
      CALL FTLFTW(XXX,YYY,WWT,IC,0,2,PS2,PZ2,D1,D2,D3,COV)
C     CHECK RECALCULATED PHI CONTINUOUS M2 M3                                                                 
      PP1=PS1*ZM23+PZ1                                                  
      PP2=PS2*ZM23+PZ2                                                  
      IF(ABS(PS1-PS2).LT.PSCUT)CALL SHS(2017,0,PP1-PP2)                 
C     CHECK M1, M2 CONTINUOUS AT MID PLANE                                                                    
C     CHECK PHI' SIMILAR                                                                                      
      IF(ABS(PP1-PP2).GT.PCUT)GOTO50                                    
      IF(ABS(PS1-PS2).GT.PSCUT)GOTO50                                   
C     THREE MODULES LINK WITHIN TOLERANCE                                                                     
C     CHECK STRAIGHT LINE IN PHI-Z                                                                            
C     R-Z FROM THREE MODULES                                                                                  
      L=0                                                               
      DO 310 KK=1,36                                                    
      IF(IP(KK).EQ.0)GOTO310                                            
      JJ=IP(KK)                                                         
      L=L+1                                                             
      IF(KK.LE.12)IMM(L)=1                                              
      IF(KK.GE.13.AND.KK.LT.25)IMM(L)=2                                 
      IF(KK.GT.24)IMM(L)=3                                              
C     R : ASSUMES LINEAR TO VERTEX                                                                            
      RRS=(RFIT(I,1)+RFIT(J,2)+RFIT(K,3))/(Z1+Z2+Z3)                    
      RR=RRS*ZP(KK)                                                     
      XX(L)=ZP(KK)                                                      
      YY(L)=ATAN((DRI(JJ,KK)*SD(KK)+DWS(JJ,KK))/RR) +WW(JJ,KK)          
      IF(YY(L).LT.0.0)YY(L)=YY(L)+PI2                                   
      WT(L)=1.0                                                         
 310  CONTINUE                                                          
C     PHI CONTINUOUS                                                                                          
      IF(L .GT. 1)THEN                                                  
      DO320 JJ=2,L                                                      
      DP = YY(JJ)-YY(JJ-1)                                              
      IF(DP.GT.0.) THEN                                                 
      IF(ABS(DP).GT.ABS(DP-PI2))YY(JJ)=YY(JJ)-PI2                       
      ELSE                                                              
      IF(ABS(DP).GT.ABS(DP+PI2))YY(JJ)=YY(JJ)+PI2                       
      ENDIF                                                             
 320  CONTINUE                                                          
      ENDIF                                                             
      IC=0                                                              
      DO 330 KK=1,L                                                     
      IF(IMM(KK).EQ.2)THEN                                              
      IC=IC+1                                                           
      XXX(IC)=XX(KK)                                                    
      YYY(IC)=YY(KK)                                                    
      WWT(IC)=WT(KK)                                                    
      ENDIF                                                             
 330  CONTINUE                                                          
      CALL FTLFTW(XXX,YYY,WWT,IC,0,2,PS2,PZ2,D1,D2,D3,COV)
      IC=0                                                              
      DO 340 KK=1,L                                                     
      IF(IMM(KK).EQ.3)THEN                                              
      IC=IC+1                                                           
      XXX(IC)=XX(KK)                                                    
      YYY(IC)=YY(KK)                                                    
      WWT(IC)=WT(KK)                                                    
      ENDIF                                                             
 340  CONTINUE                                                          
      CALL FTLFTW(XXX,YYY,WWT,IC,0,2,PS3,PZ3,D1,D2,D3,COV)
      IC=0                                                              
      DO 250 KK=1,L                                                     
      IF(IMM(KK).EQ.1)THEN                                              
      IC=IC+1                                                           
      XXX(IC)=XX(KK)                                                    
      YYY(IC)=YY(KK)                                                    
      WWT(IC)=WT(KK)                                                    
      ENDIF                                                             
 250  CONTINUE                                                          
      CALL FTLFTW(XXX,YYY,WWT,IC,0,2,PS1,PZ1,D1,D2,D3,COV)
C     COMPARE PHI VALUES AT  MODULE CENTRE                                                                    
      P1=PS1*Z1+PZ1                                                     
      P2=PS2*Z2+PZ2                                                     
      P3=PS3*Z3+PZ3                                                     
C     NO CUT ON THIS PARAMETER                                                                                
C     GOOD LINK:  GET CHI , BEST TRACK PARAMETERS                                                             
      CALL FTCHKH(PCOS,PHZ,PSIN,RI,I,J,K,CHI)
C     LOOSE CUT ON CHI.                                                                                       
C     USE CHI TO SELECT BEST CANDIDATE IF AMBIGUITIES                                                         
      IF(CHI.GT.CHT)GOTO50                                              
C                                                                                                             
      LLL=LLL+1                                                         
C******************************************12/10/88********************                                       
      IF(LLL.GT.MAXTR3)LLL=MAXTR3                                       
      LL(LLL,1)=I                                                       
      LL(LLL,2)=J                                                       
      LL(LLL,3)=K                                                       
      RPC(LLL)=PCOS                                                     
      RPS(LLL)=PSIN                                                     
      PH(LLL)=PHZ                                                       
      CH(LLL)=CHI                                                       
      ZI(LLL)=RI                                                        
      PPA(LLL,1)=PA1                                                    
      PPA(LLL,2)=PA2                                                    
      PPA(LLL,3)=PA3                                                    
      ZZA(LLL,1)=ZA1                                                    
      ZZA(LLL,2)=ZA2                                                    
      ZZA(LLL,3)=ZA3                                                    
                                                                        
 50   CONTINUE                                                          
 20   CONTINUE                                                          
 10   CONTINUE                                                          
C     NEW COMPARE SECTION                                                                                     
C     NEW COMPARE SECTION                                                                                     
C     NEW COMPARE SECTION                                                                                     
C     NEW COMPARE SECTION                                                                                     
      DO 400 LOOP=1,LLL                                                 
      CHB=100000.                                                       
      KB=0                                                              
C     SELECT BEST                                                                                             
      DO 410 K=1,LLL                                                    
      IF(CH(K).LT.0.0)GOTO 410                                          
      IF(LL(K,1).EQ.0)GOTO410                                           
C     WRITE(*,*)' K ,CHI  ',K,CH(K),LL(K,1),LL(K,2),LL(K,3)                                                   
      IF(CH(K).LT.CHB)THEN                                              
      CHB=CH(K)                                                         
      KB=K                                                              
      ENDIF                                                             
 410  CONTINUE                                                          
C     WRITE(*,*)' KB,CHIB ',KB,CHB                                                                            
      IF(KB.EQ.0)GOTO499                                                
C     COMPARE BEST WITH REMAINDER                                                                             
      DO 420 K=1,LLL                                                    
      IF(K.EQ.KB)GOTO420                                                
      IF(LL(K,1).EQ.0)GOTO420                                           
      IF(LL(K,1).EQ.LL(KB,1))GOTO430                                    
      IF(LL(K,2).EQ.LL(KB,2))GOTO430                                    
      IF(LL(K,3).EQ.LL(KB,3))GOTO430                                    
      GOTO 420                                                          
C     REMOVE LINK                                                                                             
 430  LL(K,1)=0                                                         
      LL(K,2)=0                                                         
C     WRITE(*,*)' REMOVE ',K                                                                                  
 420  CONTINUE                                                          
C     COMPARE FINISHED , MARK BEST SEGMENT USED                                                               
      CH(KB)=-CH(KB)                                                    
 400  CONTINUE                                                          
C     RESET CHI WHEN COMPARE FINISHED                                                                         
 499  DO 440 LOOP=1,LLL                                                 
      IF(CH(LOOP).LT.0.0)CH(LOOP)=-CH(LOOP)                             
 440  CONTINUE                                                          
C                                                                                                             
C                                                                                                             
C                                                                                                             
C     SET USED FLAGS                                                                                          
      NLLL=0                                                            
      DO 500 I=1,LLL                                                    
      IF(LL(I,1)*LL(I,2).EQ.0)GOTO500                                   
      NLLL=NLLL+1                                                       
      IU(LL(I,1),1)=1                                                   
      IU(LL(I,2),2)=1                                                   
      IU(LL(I,3),3)=1                                                   
*------------------------------------------                                                                   
C     PRINT1000,LL(I,1),LL(I,2),LL(I,3)                                                                       
 1000 FORMAT('  T1,T2,T3 ',5I3)                                         
*------------------------------------------                                                                   
                                                                        
 500  CONTINUE                                                          
      RETURN                                                            
      END                                                               
*