SUBROUTINE FTJN23
*-- Author : I.O. Skillicorn
      SUBROUTINE FTJN23(CF,IU,LLL,LL,RPC,RPS,PH,CH,        ZI)
**: FTJN23 40000 IS. New linking code.                                                                        
**----------------------------------------------------------------------                                      
**: FTJN23 40000 SM. Fix selection of best link.                                                              
**----------------------------------------------------------------------                                      
C     JOIN       MODULES                                                                                      
C     AUTHOR    I.O.SKILLICORN                                                                                
C     21/5/91  REDUCE SIZE                                                                                    
C       JOIN MODULES 2 AND 3                                                                                  
C                                                                                                             
C                                                                                                             
C                                                                                                             
*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/PARA/PA1,PA2,PA3,ZA1,ZA2,ZA3                               
*                                                                                                             
*     LOCAL ARRAYS...                                                                                         
      DIMENSION CF(MAXTR3,3),IU(MAXTR3,3),LL(MAXTRK,2)                  
      DIMENSION RPC(MAXTRK),RPS(MAXTRK)                                 
      DIMENSION PH(MAXTRK),CH(MAXTRK),CX(3)                             
C     DIMENSION IP(36),SD(36),IPP(36,MAXTRK),SDD(36,MAXTRK)                                                   
      DIMENSION IP(36),SD(36)                                           
      DIMENSION ZI(MAXTRK)                                              
      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)                                                
*                                                                                                             
      ZM12 = 0.5*(ZP(IZM1) + ZP(IZM2))                                  
      ZM23 = 0.5*(ZP(IZM2) + ZP(IZM3))                                  
      ZM13 = 0.5*(ZP(IZM1) + ZP(IZM3))                                  
      Z1=ZP(06)                                                         
      Z2=ZP(18)                                                         
      Z3=ZP(30)                                                         
*                                                                                                             
C     TO JOIN TWO  MODULES                                                                                    
C     STANDARD DEVIATIONS ** 2                                                                                
      PI2=6.2831853                                                     
                                                                        
                                                                        
C     CUTS CHANGED FOR FAST FILTER - SECOND LINE FOR FAST FILTER                                              
C     SELECT TRACKS STR LINE PHI-Z ONLY                                                                       
C     IE THOSE FROM Z-AXIS                                                                                    
                                                                        
                                                                        
C     REPLACEMENT VALUES H1SIM  ****************************                                                  
      CHT   = CHT23                                                     
      PCUT  = PCT23                                                     
      PSCUT = PSC23                                                     
      RCUT  = RCT23                                                     
C                                                                                                             
C                                                                                                             
*************************NEW CUTS******94 DATA**************                                                  
*     CHT   = 100.0                                                                                           
*     RCUT=20.                                                                                                
*     PCUT=0.04                                                                                               
*     PSCUT=0.002                                                                                             
************************************************************                                                  
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     IU SET IN  FTJN3                                                                                        
C     *******************************                                                                         
      DO 10 I=1,N2                                                      
      IF(CHSQ(I,2).GT.1000.)GOTO10                                      
      IF(ICHK.EQ.1.AND.IU(I,2).EQ.1)GOTO10                              
      DO 20 J=1,N3                                                      
                                                                        
      IF(CHSQ(J,3).GT.1000.)GOTO20                                      
      IF(ICHK.EQ.1.AND.IU(J,3).EQ.1)GOTO20                              
      RTEST=(RFIT(I,2)-RFIT(J,3)*Z2/Z3)                                 
      IF(ABS(RTEST).GT.RCUT)GOTO20                                      
                                                                        
C     REFIT PHI-Z WITH R-VALUES OF SEGMENTS                                                                   
C     FILL POINTS/DRIFT SIGN                                                                                  
C     RECALCULATE PHI-Z SLOPE AND INTERCEPT                                                                   
      DO 200 KK=13,36                                                   
      IF(KK.LE.24)THEN                                                  
      IP(KK)=IRPT(KK-12,I,2)                                            
      SD(KK)=SDRFT(KK-12,I,2)                                           
      ELSE                                                              
      IP(KK)=IRPT(KK-24,J,3)                                            
      SD(KK)=SDRFT(KK-24,J,3)                                           
      ENDIF                                                             
 200  CONTINUE                                                          
      L=0                                                               
      DO 210 KK=13,36                                                   
      IF(IP(KK).EQ.0)GOTO210                                            
      JJ=IP(KK)                                                         
      L=L+1                                                             
      IF(KK.LE.24)IMM(L)=1                                              
      IF(KK.GT.24)IMM(L)=2                                              
C     R : ASSUMES LINEAR TO VERTEX                                                                            
      RR=(RFIT(I,2)+RFIT(J,3))/(Z2+Z3)*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.1)THEN                                              
      IC=IC+1                                                           
      XXX(IC)=XX(KK)                                                    
      YYY(IC)=YY(KK)                                                    
      WWT(IC)=WT(KK)                                                    
      ENDIF                                                             
 230  CONTINUE                                                          
      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.2)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                                                                       
      PP1=PS1*ZM23+PZ1                                                  
      PP2=PS2*ZM23+PZ2                                                  
      IF(ABS(PS1-PS2).LT.PSCUT)CALL SHS(2001,0,PP1-PP2)                 
*                                                                                                             
      IF(ABS(PP1-PP2).GT.PCUT)GOTO20                                    
      IF(ABS(PS1-PS2).GT.PSCUT)GOTO20                                   
*                                                                                                             
                                                                        
      CALL FTCHKH(PCOS, PHZ, PSIN, RI, 0, I, J, CHI)
      IF(CHI.GT.CHT)GOTO50                                              
                                                                        
                                                                        
                                                                        
                                                                        
C     GOOD LINK                                                                                               
      LLL=LLL+1                                                         
C******************************************12/10/88********************                                       
      IF(LLL.GT.MAXTRK)LLL=MAXTRK                                       
      LL(LLL,1)=I                                                       
      LL(LLL,2)=J                                                       
C      LL(LLL,3)=K                                                                                            
      RPC(LLL)=PCOS                                                     
      RPS(LLL)=PSIN                                                     
      PH(LLL)=PHZ                                                       
      CH(LLL)=CHI                                                       
      ZI(LLL)=RI                                                        
                                                                        
 50   CONTINUE                                                          
 20   CONTINUE                                                          
 10   CONTINUE                                                          
                                                                        
      DO 100 LOOP=1,LLL                                                 
      CHB=100000.                                                       
      KB=0                                                              
C     SELECT BEST                                                                                             
      DO 110 K=1,LLL                                                    
      IF(CH(K).LT.0.0)GOTO 110                                          
      IF(LL(K,1).EQ.0)GOTO110                                           
      IF(CH(K).LT.CHB)THEN                                              
      CHB=CH(K)                                                         
      KB=K                                                              
      ENDIF                                                             
 110  CONTINUE                                                          
      IF(KB.EQ.0)GOTO199                                                
C     COMPARE BEST WITH REMAINDER                                                                             
      DO 120 K=1,LLL                                                    
      IF(K.EQ.KB)GOTO120                                                
      IF(LL(K,1).EQ.0)GOTO120                                           
      IF(LL(K,1).EQ.LL(KB,1))GOTO130                                    
      IF(LL(K,2).EQ.LL(KB,2))GOTO130                                    
CCCCC IF(LL(K,3).EQ.LL(KB,3))GOTO130                                                                          
      GOTO 120                                                          
C     REMOVE LINK                                                                                             
 130  LL(K,1)=0                                                         
      LL(K,2)=0                                                         
 120  CONTINUE                                                          
C     COMPARE FINISHED , MARK BEST SEGMENT USED                                                               
      CH(KB)=-CH(KB)                                                    
 100  CONTINUE                                                          
C     RESET CHI WHEN COMPARE FINISHED                                                                         
 199  DO 140 LOOP=1,LLL                                                 
      IF(CH(LOOP).LT.0.0)CH(LOOP)=-CH(LOOP)                             
 140  CONTINUE                                                          
C                                                                                                             
C                                                                                                             
C                                                                                                             
C     SET USED FLAGS                                                                                          
      NLLL=0                                                            
      DO 300 I=1,LLL                                                    
      IF(LL(I,1)*LL(I,2).EQ.0)GOTO300                                   
      IU(LL(I,1),2)=1                                                   
      IU(LL(I,2),3)=1                                                   
      NLLL=NLLL+1                                                       
CCCCCC      IU(LL(I,3),3)=1                                                                                   
      CALL SHS(2040,0,6.)                                                                              
      CALL SHS(2040,0,10.)                                                                             
      CALL SHS(2047,0,CH(I))                                                                           
                                                                        
*------------------------------------------                                                                   
C     PRINT1000,LL(I,1),LL(I,2),LL(I,3)                                                                       
 1000 FORMAT('  T1,T2,T3 ',5I3)                                         
*------------------------------------------                                                                   
                                                                        
 300  CONTINUE                                                          
                                                                        
      IF(NLLL.NE.0)CALL SHS(2043,0,FLOAT(LLL)/FLOAT(NLLL))              
      RETURN                                                            
C                                                                                                             
      END                                                               
*                                                                                                             
*                                                                                                             
*                                                                                                             
* NEW CODE 11/7/94                                                                                            
*                                                                                                             
*                                                                                                             
*   LINK THREE RADIAL MODULES                                                                                 
*