*-- Author :    I. O. Skillicorn      16/11/92
      SUBROUTINE FPPJ23
**: FPPJ23 40000 IS. New linking code.                                                                        
**----------------------------------------------------------------------                                      
**: FPPJ23 30907 RP. Farm changes.                                                                            
**----------------------------------------------------------------------                                      
C     JOIN 2 PLANAR MODULES  - 2+3                                                                            
*    PLANAR GEOMETRY                                                                                          
*                                                                                                             
*    RADIAL GEOMETRY                                                                                          
*KEEP,FPJPAR.                                                                                                 
*KEND.                                                                                                        
*     RRCUT=10.0                                                                                              
*     X2=SPAR(3,J,2)*Z2+SPAR(4,J,2)                                                                           
*     Y2=SPAR(1,J,2)*Z2+SPAR(2,J,2)                                                                           
*     X3=SPAR(3,K,3)*Z3+SPAR(4,K,3)                                                                           
*     Y3=SPAR(1,K,3)*Z3+SPAR(2,K,3)                                                                           
      CALL SHS(902,0,RR)                                                                               
CSB      IF(L.EQ.1)II=I                                                                                       
C     FIT PHI-Z                                                                                               
      CALL FTLFTW(XX,YY,WP,IC,0,2,PS,PI,D1,D2,D3,D4)
C     FIT R-Z                                                                                                 
      CALL FTLFTW(XX,ZZ,WPP,IC,0,2,RS,RI,D1,D2,D3,D4)
*     DIFF=YY(JJ)-PS*XX(JJ)-PI                                                                                
*     PRINT1002,JJ,(YY(JJ)-PS*XX(JJ)-PI)**2*WP(JJ)**2,YY(JJ),DIFF                                             
      CALL FPCHI(2,3,J,K,CHID)
      CALL SHS(520,0,CHIP)                                                                             
      CALL SHS(573,0,CHID)                                                                             
*     Remove Links with poor Chisq...  18/11/93                                                               
*                                                                                                             
C     MOMENTUM FROM ANGLE CHANGE                                                                              
*     T1=ATAN2(SPAR(1,J,2),SPAR(3,J,2))                                                                       
*     IF(T1.LT.0.)T1=T1+PI2                                                                                   
*     T2=ATAN2(SPAR(1,K,3),SPAR(3,K,3))                                                                       
*     IF(T2.LT.0.)T2=T2+PI2                                                                                   
*     TANT=(SQRT(X3**2+Y3**2)-SQRT(X2**2+Y2**2))/(Z3-Z2)                                                      
*     SL=SQRT((X2-X3)**2+(Y2-Y3)**2)                                                                          
*     THET=ATAN(TANT)                                                                                         
*     DIFF=T2-T1                                                                                              
*     IF(DIFF.LT.-3.14)DIFF=DIFF+PI2                                                                          
*     IF(DIFF.GT.3.14)DIFF=DIFF-PI2                                                                           
*     PP=1000.                                                                                                
*     IF(DIFF.NE.0.0)PP=-0.0002998*12.*SL/(DIFF*SIN(THET))                                                    
*     PPP(LINK)=PP                                                                                            
C     CALL SHS(580,0,1./PP)                                                                                   
C     CALL SHS(581,0,1./PP)                                                                                   
C     CALL SHS(582,0,PP)                                                                                      
*     II=LINK                                                                                                 
*     PRINT 1001,II,LNK(1,II),LNK(2,II),LNK(3,II),CHIL(II)                                                    
C     NEW COMPARE SECTION                                                                                     
C     SELECT BEST                                                                                             
*      IF(LNK(1,K).EQ.0)GOTO 510                                                                              
*      WRITE(*,*)' K ,CHI  ',K,CH(K),LNK(1,K),LNK(2,K),LNK(3,K)                                               
*      WRITE(*,*)' KB,CHIB ',KB,CHB                                                                           
C     COMPARE BEST WITH REMAINDER                                                                             
*      IF(LNK(1,K).EQ.0)GOTO520                                                                               
*      IF(LNK(1,K).EQ.LNK(1,KB))GOTO530                                                                       
C     REMOVE LINK                                                                                             
*      WRITE(*,*)' REMOVE ',K                                                                                 
C     COMPARE FINISHED , MARK BEST SEGMENT USED                                                               
C     RESET CHI WHEN COMPARE FINISHED                                                                         
C                                                                                                             
C                                                                                                             
C                                                                                                             
C     SET USED FLAG                                                                                           
C     IUS(LNK(1,I),1)=1                                                                                       
C     L1=LNK(1,I)                                                                                             
C     PRINT 1000,I,(IPT(III,L2,2),III=1,12)                                                                   
C    1,(IPT(III,L3,3),III=1,12)                                                                               
C    1,CHIL(I),PPP(I)                                                                                         
C     IPP(KK,NPP)=IPT(KK,L1,1)                                                                                
      CALL SHS(577,0,PROD )                                                                            
      CALL SHS(550,0,6.001)                                                                            
      CALL SHS(550,0,10.001)                                                                           
*