*-- Author :    I. O. Skillicorn      16/11/92
      SUBROUTINE FPPJ13
*     call fpphit                                                                                             
**: FPPJ13 40000 IS. New linking code.                                                                        
**----------------------------------------------------------------------                                      
**: FPPJ13 30907 RP. Farm changes.                                                                            
**----------------------------------------------------------------------                                      
C     JOIN 2 PLANAR MODULES  - 1+3                                                                            
*    PLANAR GEOMETRY                                                                                          
*                                                                                                             
*    RADIAL GEOMETRY                                                                                          
*KEEP,FPJPAR.                                                                                                 
*KEND.                                                                                                        
*     RRCUT=10.0                                                                                              
*     X1=SPAR(3,I,1)*Z1+SPAR(4,I,1)                                                                           
*     Y1=SPAR(1,I,1)*Z1+SPAR(2,I,1)                                                                           
*     X3=SPAR(3,K,3)*Z3+SPAR(4,K,3)                                                                           
*     Y3=SPAR(1,K,3)*Z3+SPAR(2,K,3)                                                                           
      CALL SHS(903,0,RR)                                                                               
C      IF(L.EQ.2)II=J                                                                                         
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(1,3,I,K,CHID)
      CALL SHS(530,0,CHIP)                                                                             
      CALL SHS(574,0,CHID)                                                                             
*     Remove Links with poor Chisq...  18/11/93                                                               
*                                                                                                             
*      WRITE(*,*)' I,K,LINK,CHIP,CHID ',I,K,LINK,CHIP,CHID                                                    
C     MOMENTUM FROM ANGLE CHANGE                                                                              
*     T1=ATAN2(SPAR(1,I,1),SPAR(3,I,1))                                                                       
*     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(X1**2+Y1**2))/(Z3-Z1)                                                      
*     SL=SQRT((X1-X3)**2+(Y1-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(590,0,1./PP)                                                                                   
C     CALL SHS(591,0,1./PP)                                                                                   
C     CALL SHS(592,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(2,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(2,K).EQ.0)GOTO520                                                                                
*     IF(LNK(2,K).EQ.LNK(2,KB))GOTO530                                                                        
C     REMOVE LINK                                                                                             
*      WRITE(*,*)' REMOVE ',K                                                                                 
C     COMPARE FINISHED , MARK BEST SEGMENT USED                                                               
C     RESET CHI WHEN COMPARE FINISHED                                                                         
C                                                                                                             
C                                                                                                             
C     SET USED FLAG                                                                                           
C     IUS(LNK(2,I),2)=1                                                                                       
C     L2=LNK(2,I)                                                                                             
C     PRINT 1000,I,(IPT(III,L1,1),III=1,12)                                                                   
C    1,(IPT(III,L3,3),III=1,12)                                                                               
C    1,CHIL(I),PPP(I)                                                                                         
C     IPP(KK+12,NPP)=IPT(KK,L2,2)                                                                             
      CALL SHS(578,0,PROD )                                                                            
      CALL SHS(550,0,8.001)                                                                            
      CALL SHS(550,0,10.001)                                                                           
*