SUBROUTINE FPSPC
*-- Author :    I. O. Skillicorn   24/04/95
      SUBROUTINE FPSPC
*                                                                                                             
*     SELECT SINGLE  PLANAR SEGMENTS IN 1ST MODULE                                                            
*     THAT DO NOT PROJECT INTO FIRST RADIAL MODULE                                                            
*                                                                                                             
*     Fit parameters are in H1WORK:                                                                           
*     RPCOSG(K) = Slope of Phi-z fit                                                                          
*     RPSING(K) = Slope of R-z fit                                                                            
*     PHZG(K)   = Intercept of Phi-z fit (at z=0)                                                             
*     ZIG(K)    = Intercept of R-z fit (at z=0)                                                               
*     Errors are in FTRERR:                                                                                   
*     COMMON /FTRERR/ DSLPHI, DPHZER, COVP, DSLPR, DRZER, COVR                                                
*     Dxxxx = sigma (not squared) of parameter xxxx                                                           
*     COVP  = covariance of Phi-z fit parameters                                                              
*     COVR  = covariance of R  -z fit parameters                                                              
                                                                        
*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,FRH3FT.                                                                                                 
*     Common for RETRAC results (SJM)                                                                         
      COMMON/FRH3FT/ IRN(36,MAXTRK),SDN(36,MAXTRK),                     
     +              IRP(36,MAXTRK),SDP(36,MAXTRK),                      
     +              IG2,IGTTRK(MAXTRK),                                 
     +              CHISQ(MAXTRK),NUMDF(MAXTRK),                        
     +              FITX(MAXTRK),FITY(MAXTRK),FITZ(MAXTRK),             
     +              FITTH(MAXTRK),FITPH(MAXTRK),                        
     +              FITCU(MAXTRK),FTCOV(15,MAXTRK)                      
*KEEP,FPPRAM.                                                                                                 
C                                                                                                             
C---  MAXSEG is maximum number of segments per supermodule                                                    
C---  MAXCON is maximum number of amibiguous segments associatable with                                       
C---         one segment                                                                                      
C---  LIMSTO is maximum number of 2 cluster planes intersections to be                                        
C---         stored per supermodule                                                                           
C---  MSEGLM is maximum number of clusters that can be found before                                           
C---         connectivity considered                                                                          
C---  MAXCLU is maximum number of clusters that can be found after                                            
C---         forming non-connected set    MUST BE 50 IF RUN WITH OLD RCW                                      
C---         (cluster = 3/4 digits found in a straight line in one                                            
C---          4-wire orientation)                                                                             
C                                                                                                             
      PARAMETER (MAXSEG = 200)                                          
      PARAMETER (MAXCON = 100)                                          
      PARAMETER (LIMSTO = 5000)                                         
      PARAMETER (MSEGLM = 150)                                          
      PARAMETER (MAXCLU = 50)                                           
C---                                                                                                          
*KEEP,FPLSEG.                                                                                                 
C---                                                                                                          
      COMMON /FPLSEG / PW(12,MAXSEG,3)   , PWC(12,MAXSEG,3)     ,       
     1                 PRCHI(MAXSEG,3)   , NFSEG(3)             ,       
     2                 XYDXY(4,MAXSEG,3) , EXYDXY(4,4,MAXSEG,3) ,       
     3                 ZSEG(2,MAXSEG,3)  ,                              
     4                 ASEGIN(MAXSEG,3)  , ISEGIN(5,MAXSEG,3)   ,       
     5                 MASKSG(MAXSEG,3)  , IDGISG(12,MAXSEG,3)          
C---                                                                                                          
*KEEP,FPTFLG.                                                                                                 
      COMMON/FPTFLG/IPLAR, NIT, IREZ, LUNFP, NPLMAX                     
*KEEP,FPTPAR.                                                                                                 
      COMMON/FPTPAR/PCUT1, PCUT2, PCUT3, CXP, CYP,                      
     +              DRPCT1, DRPCT2, DRPCT3,                             
     +              DRCUT1, DRCUT2, DRCUT3                              
*KEEP,FDIFLG.                                                                                                 
      COMMON/LDIAG/IDIAG,IDIAG2,MAXPRT,IDOHIS,PMCUT                     
*KEND.                                                                                                        
                                                                        
*     Common for track parameter errors...                                                                    
      COMMON /FTRERR/ DSLPHI, DPHZER, COVP, DSLPR, DRZER, COVR          
                                                                        
                                                                        
      COMMON/FTPPBK/NPP,IPP(36,100),CHPP(100),LP(3,100)                 
      COMMON/FTPPBS/SPP(36,100)                                         
      COMMON/FPPFIT/PSSS(100),PISS(100),RSSS(100),RISS(100)             
      COMMON/FPLNK/KTIP(3,50),LPP(3,100)                                
      COMMON/FTRRBK/IRR(36,MAXTRK),SRR(36,MAXTRK),LRR(3,MAXTRK)         
*     Common for segment numbers...                                                                           
      COMMON /FPSEGN/ ISG(3,MAXTRK)                                     
      COMMON /FPSEG1/ ISGG(3,MAXTRK)                                    
      COMMON /FPSEG2/ ISGP(3,MAXTRK),IUZP(MAXSEG,3),IUZR(MAXTRK,3)      
      COMMON /FPSEG3/ ISGR(3,MAXSEG)                                    
                                                                        
      COMMON/FKLOC/KLOC(100)                                            
      COMMON/FEVSAT/IEVSAT                                              
      common/fcnset/ipuze(maxhts,numwpl)                                
                                                                        
                                                                        
*     Local arrays...                                                                                         
      DIMENSION IUSEDP(MAXTRK,36), IUSEG( MAXSEG, 3)                    
      DIMENSION RSEG(4),PSEG(4)                                         
      DIMENSION XX(20),YY(20)                                           
      PARAMETER(PI2=6.2831853)                                          
      DATA ISTART/0/                                                    
C                                                                                                             
C                                                                                                             
C---   LOOP OVER SUPERMODULES - FOR RADIALS                                                                   
C                                                                                                             
C      MOD 20/1/93  TO PICK UP SINGLE SEMENTS IN ALL MODULES                                                  
C                                                                                                             
                                                                        
      DO 20 ISMP=1,3                                                    
      DO 15 IP = 1,NFSEG(ISMP)                                          
C                                                                                                             
C---  search only unused segments                                                                             
C                                                                                                             
      IF(IUZP(IP,ISMP).NE.0)GOTO15                                      
C                                                                                                             
C---  search only the disconnected set                                                                        
C                                                                                                             
      IF( MASKSG(IP,ISMP) .NE. 0 )GO TO 15                              
                                                                        
c     check if points have been used                                    
      do 25 i=1,12                                                      
      iosp=idgisg(i,ip,ismp)                                            
      if(iosp.eq.0)goto25                                               
      ipu=iabs(iosp)                                                    
      ipl=I+(ismp-1)*12                                                 
      if(ipuze(ipu,ipl).eq.1)goto15                                     
 25   continue                                                          
C                                                                                                             
C                                                                                                             
C---  Extract planar segment and covariance matrix                                                            
C                                                                                                             
C     STR LINES THROUGH PLANARS IN PHI-Z  R-Z                                                                 
C     DISTANCES IN MM HERE FOR RCWH                                                                           
      DO 30 I = 1,4                                                     
C---                                                                                                          
      PSEG(I) = XYDXY(I,IP,ISMP)                                        
C---                                                                                                          
   30 CONTINUE                                                          
C---                                                                                                          
      Z1MM=ZPP(1+12*(ISMP-1))*10.                                       
      Z2MM=ZPP(12+12*(ISMP-1))*10.                                      
      X1=PSEG(1)+Z1MM*PSEG(3)                                           
      Y1=PSEG(2)+Z1MM*PSEG(4)                                           
      X2=PSEG(1)+Z2MM*PSEG(3)                                           
      Y2=PSEG(2)+Z2MM*PSEG(4)                                           
      R1=SQRT(X1**2+Y1**2)                                              
      R2=SQRT(X2**2+Y2**2)                                              
      P1=ATAN2(Y1,X1)                                                   
      P1=AMOD(P1,PI2)                                                   
      IF(P1.LT.0.)P1=P1+PI2                                             
      P2=ATAN2(Y2,X2)                                                   
      P2=AMOD(P2,PI2)                                                   
      IF(P2.LT.0.)P2=P2+PI2                                             
      DP=P1-P2                                                          
      IF(DP.GT.6.0)DP=DP-PI2                                            
      IF(DP.LT.-6.0)DP=DP+PI2                                           
      RSS      =(R1-R2)/(Z1MM-Z2MM)                                     
      RIS      =(R1-RSS*Z1MM)                                           
C     TEST IF EXTRAPOLATED PLANAR SEGMENT SHOULD HIT RADIAL                                                   
CTEMP R160=RSS*1600. +RIS                                                                                     
CTEMP IF(R160.LT.800.)GOTO15                                                                                  
C                                                                                                             
                                                                        
                                                                        
      NPP=NPP+1                                                         
      IF(NPP.GT.100) THEN                                               
        NPP = 100                                                       
        IEVSAT = 1                                                      
      ENDIF                                                             
      KLOC(NPP) = 6                                                     
      CALL SHS(716,0,11.01)                                                                            
                                                                        
C     BACK TO CMS                                                                                             
      RSSS(NPP)=(R1-R2)/(Z1MM-Z2MM)                                     
      RISS(NPP)=(R1-RSSS(NPP)*Z1MM)/10.                                 
      PSSS(NPP)=     DP*10./(Z1MM-Z2MM)                                 
      PISS(NPP)=(P1-PSSS(NPP)*Z1MM/10.)                                 
      LPP(1   ,NPP)=0                                                   
      LPP(2   ,NPP)=0                                                   
      LPP(3   ,NPP)=0                                                   
      LPP(ISMP,NPP)=IP                                                  
      LRR(1,NPP)=0                                                      
      LRR(2,NPP)=0                                                      
      LRR(3,NPP)=0                                                      
      DO 36 II=1,36                                                     
      IRR(II,NPP)=0                                                     
      IPP(II,NPP)=0                                                     
 36   CONTINUE                                                          
      DO 35 II=1,12                                                     
      IOSP=IDGISG(II,IP,ISMP)                                           
      IPP(II+(ISMP-1)*12,NPP)=IABS(IOSP)                                
      SPP(II+(ISMP-1)*12,NPP)=SIGN(1.0,FLOAT(IOSP))                     
 35   CONTINUE                                                          
                                                                        
   15 CONTINUE                                                          
   20 CONTINUE                                                          
      RETURN                                                            
      END