*-- Author :    I. O. Skillicorn      16/11/92
      SUBROUTINE FPPJ12
*     call fpphit                                                                                             
**: FPPJ12.......IS. Small bug fixed.                                                                         
**----------------------------------------------------------------------                                      
**: FPPJ12 40000 IS. New linking code.                                                                        
**----------------------------------------------------------------------                                      
**: FPPJ12 30907 RP. Farm changes.                                                                            
**----------------------------------------------------------------------                                      
C     JOIN 2 PLANAR MODULES  - 1+2                                                                            
*    PLANAR GEOMETRY                                                                                          
*                                                                                                             
*    RADIAL GEOMETRY                                                                                          
*KEEP,FPJPAR.                                                                                                 
*KEND.                                                                                                        
*     RRCUT=10.0                                                                                              
      CALL SHS(901,0,RR)                                                                               
CSB      IF(L.EQ.3)II=K                                                                                       
C     FIT IN PHI-Z                                                                                            
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)
C     PRINT1002,JJ,(YY(JJ)-PS*XX(JJ)-PI)**2*WP(JJ)**2,YY(JJ),DIFF                                             
      CALL FPCHI(1,2,I,J,CHID)
      CALL SHS(510,0,CHIP)                                                                             
      CALL SHS(572,0,CHID)                                                                             
*     Remove Links with poor Chisq...  18/11/93                                                               
*                                                                                                             
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,J,2),SPAR(3,J,2))                                                                       
*     IF(T2.LT.0.)T2=T2+PI2                                                                                   
*     TANT=(SQRT(X2**2+Y2**2)-SQRT(X1**2+Y1**2))/(Z2-Z1)                                                      
*     SL=SQRT((X2-X1)**2+(Y2-Y1)**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(570,0,1./PP)                                                                                   
C     CALL SHS(571,0,1./PP)                                                                                   
C     CALL SHS(572,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(3,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(3,K).EQ.0)GOTO520                                                                               
*      IF(LNK(3,K).EQ.LNK(3,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(3,I),3)=1                                                                                       
C     L3=LNK(3,I)                                                                                             
C     PRINT 1000,I,(IPT(III,L1,1),III=1,12)                                                                   
C    1,(IPT(III,L2,2),III=1,12)                                                                               
C    1,CHIL(I),PPP(I)                                                                                         
C     IPP(KK+24,NPP)=IPT(KK,L3,3)                                                                             
      CALL SHS(576,0,PROD )                                                                            
      CALL SHS(550,0,4.001)                                                                            
      CALL SHS(550,0,10.001)                                                                           
*