SUBROUTINE FRPCHK
*-- Author :    Stephen J. Maxfield   18/06/92
      SUBROUTINE FRPCHK
      PARAMETER(TWOPI=6.2831853)                                        
      PARAMETER(PWED=0.13089969)                                        
      DIMENSION ITS(3)                                                  
*KEEP,BCS.                                                                                                    
      INTEGER      NHROW,NHCOL,NHLEN                                    
      PARAMETER   (NHROW = 2, NHCOL = 1, NHLEN=2)                       
      INTEGER      NBOSIW                                               
      PARAMETER   (NBOSIW=1000000)                                      
      INTEGER      IW(NBOSIW)                                           
      REAL         RW(NBOSIW)                                           
      COMMON /BCS/ IW                                                   
      EQUIVALENCE (RW(1),IW(1))                                         
      SAVE   /BCS/                                                      
*KEEP,H1EVDT.                                                                                                 
      COMMON /H1EVDT/ KEVENT,IDATA,MONTE,LCONF                          
      INTEGER KEVENT,IDATA,LCONF                                        
      LOGICAL MONTE                                                     
*                                                                                                             
*  IDATA  type of information (HEAD bank word 6) :                                                            
*                                                                                                             
*                       0 - real data H1                                                                      
*                       1 - MC data H1SIM                                                                     
*                       2 - real data CERN tests                                                              
*                       3 - MC data ARCET                                                                     
*                                                                                                             
*  MONTE = .TRUE.   if IDATA=1                                                                                
*  KEVENT = event processed counter for H1REC                                                                 
*                                                                                                             
*KEEP,STFUNCT.                                                                                                
*     index of element before row number IROW                                                                 
      INDR(IND,IROW)=IND+2+IW(IND+1)*(IROW-1)                           
*     index of L'th element  of row number IROW                                                               
      INDCR(IND,L,IROW)=INDR(IND,IROW) + L                              
*     L'th integer element of the IROW'th row of bank with index IND                                          
      IBTAB(IND,L,IROW)=IW(INDCR(IND,L,IROW))                           
*     L'th real element of the IROW'th row of bank with index IND                                             
      RBTAB(IND,L,IROW)=RW(INDCR(IND,L,IROW))                           
*KEEP,FTFUNCT.                                                                                                
*     Statement functions for RADIAL Chamber data access.                                                     
*     Using Channel Number J                                                                                  
                                                                        
*     Module, Wedge-pair and Z-plane numbers...                                                               
      IRMOD(J) = J/288                                                  
      IRWDP(J) = (J-IRMOD(J)*288)/12                                    
      IRZPL(J) =  J-IRMOD(J)*288-IRWDP(J)*12                            
*     Statement function for obtaining WEDGE numbers(0-47) of                                                 
*     wires at plus and minus ends of Cell numbers                                                            
      IRWPL(J) = (IRWDP(J)/2)*4 + (MOD(IRWDP(J),2))                     
      IRWMI(J) = MOD(IRWPL(J) + 34,48)                                  
*     Statement function for obtaining IOS wire number (1-36)                                                 
      IRIOSW(J) = IRMOD(J)*12 + IRZPL(J) + 1                            
                                                                        
*     Statement functions for PLANAR Chamber data access.                                                     
*     Using Channel Number J                                                                                  
                                                                        
*     Module, orientation, W-cell and Z-plane numbers...                                                      
      IPMOD(J)  = J/384                                                 
      IPORI(J)  = (J-IPMOD(J)*384)/128                                  
      IPWCL(J)  = (J-IPMOD(J)*384-IPORI(J)*128)/4                       
      IPZPL(J)  = (J-IPMOD(J)*384-IPORI(J)*128-IPWCL(J)*4)              
                                                                        
*     IPSMD in range 0:8 Planar module number.                                                                
      IPSMD(J)  = IPMOD(J)*3 + IPORI(J)                                 
*                                                                                                             
*     IOS wire number (runs from 0 to 36)                                                                     
      IPIOSW(J) = IPSMD(J)*4 + IPZPL(J) + 1                             
                                                                        
* SB plane numbers (1-72) from cell number                                                                    
      IPSBW(J) = 24*IPMOD(J) + 4*IPORI(J) + IPZPL(J) + 1                
      IRSBW(J) = 24*IRMOD(J)              + IRZPL(J) + 13               
                                                                        
* Module, orientation, wire and (typical) cell number from plane                                              
* number in the range 1-72 (planars, radials and combined)                                                    
      IPMSB(J)  = (J - 1)/24                                            
      IPOSB(J)  = (J - 24*IPMSB(J) - 1)/4                               
      IPZSB(J)  = J - 24*IPMSB(J) - 4*IPOSB(J) - 1                      
      IPCLSB(J) = 384*IPMSB(J) + 128*IPOSB(J) + IPZSB(J)                
                                                                        
      IRMSB(J)  = (J - 1)/24                                            
      IRZSB(J)  = J - 24*IRMSB(J) - 13                                  
      IRCLSB(J) = 288*IRMSB(J) + IRZSB(J)                               
                                                                        
      IRADSB(J) = (J - 24*((J-1)/24) - 1)/12                            
      ICELSB(J) = IRADSB(J)*IRCLSB(J) + (1 - IRADSB(J))*IPCLSB(J)       
*KEND.                                                                                                        
* Radial segment bank...                                                                                      
      IFRSG = NLINK('FRSG',0)
      IF(IFRSG .EQ. 0)RETURN                                            
* Planar segment bank...                                                                                      
      IFPSG = NLINK('FPSG',0)
      IF(IFPSG .EQ. 0)RETURN                                            
* Radial hit bank...                                                                                          
      IFRLC = NLINK('FRLC',0)
      IF(IFRLC .EQ. 0)RETURN                                            
      NRLC = IW(IFRLC+2)                                                
      IF(NRLC .EQ. 0) RETURN                                            
*     Locate FRG1 bank...                                                                                     
      IFRG1 = NLINK('FRG1',0)
      IF(IFRG1 .EQ. 0)RETURN                                            
                                                                        
      NRSEG = IW(IFRSG+2)                                               
      NPSEG = IW(IFPSG+2)                                               
                                                                        
                                                                        
*     Loop over the planar segments...                                                                        
      DO 3  JSEG = 1, NPSEG                                             
       IMODP= IBTAB(IFPSG,8,JSEG)                                       
       IMSK = IBTAB(IFPSG,9,JSEG)                                       
       IF(IMSK.EQ.0) THEN                                               
                                                                        
         XPSGI = RBTAB(IFPSG, 1,JSEG)                                   
         YPSGI = RBTAB(IFPSG, 2,JSEG)                                   
         ZPSGI = RBTAB(IFPSG, 3,JSEG)                                   
                                                                        
         XPSGO = RBTAB(IFPSG, 4,JSEG)                                   
         YPSGO = RBTAB(IFPSG, 5,JSEG)                                   
         ZPSGO = RBTAB(IFPSG, 6,JSEG)                                   
                                                                        
         DZG   = (ZPSGO - ZPSGI)                                        
         XSLPG = (XPSGO - XPSGI) / DZG                                  
         YSLPG = (YPSGO - YPSGI) / DZG                                  
*        look for nearest radial segment...search in 'nearby' radials                                         
*        only.                                                                                                
         IF(IMODP.EQ.0) THEN                                            
          ITS(1)=-1                                                     
          ITS(2)= 0                                                     
          ITS(3)= 1                                                     
         ELSEIF(IMODP.EQ.1) THEN                                        
          ITS(1)=0                                                      
          ITS(2)=1                                                      
          ITS(3)=2                                                      
         ELSEIF(IMODP.EQ.2) THEN                                        
          ITS(1)=1                                                      
          ITS(2)=2                                                      
          ITS(3)=0                                                      
         ENDIF                                                          
                                                                        
*        Now loop over the radial segments. Look for closest in Phi.                                          
         DO 1 K=1,3                                                     
                                                                        
         KMIN = -1                                                      
         PMIN = 100000.                                                 
         DO 4  KSEG = 1, NRSEG                                          
          IMOD = IBTAB(IFRSG, 8,KSEG)                                   
          IF(IMOD.NE.ITS(K)) GOTO 4                                     
                                                                        
          XRSGI = RBTAB(IFRSG, 1,KSEG)                                  
          YRSGI = RBTAB(IFRSG, 2,KSEG)                                  
          ZRSGI = RBTAB(IFRSG, 3,KSEG)                                  
                                                                        
          XRSGO = RBTAB(IFRSG, 4,KSEG)                                  
          YRSGO = RBTAB(IFRSG, 5,KSEG)                                  
          ZRSGO = RBTAB(IFRSG, 6,KSEG)                                  
          ZTEST = 0.5*(ZRSGO + ZRSGI)                                   
          XTEST = 0.5*(XRSGO + XRSGI)                                   
          YTEST = 0.5*(YRSGO + YRSGI)                                   
          PTEST = ATAN2(YTEST,XTEST)                                    
          IF(PTEST.LT.0)PTEST=PTEST+TWOPI                               
                                                                        
*         Planar prediction...                                                                                
          XG   = XPSGI + (ZTEST-ZPSGI) * XSLPG                          
          YG   = YPSGI + (ZTEST-ZPSGI) * YSLPG                          
          PG   = ATAN2(YG,XG)                                           
          IF(PG.LT.0)PG=PG+TWOPI                                        
          DELP = ABS(PTEST-PG)                                          
          IF(DELP.GT.(TWOPI/2.0))DELP = TWOPI-DELP                      
          IF(DELP.LT.PMIN) THEN                                         
           PMIN=DELP                                                    
           KMIN=KSEG                                                    
          ENDIF                                                         
 4       CONTINUE                                                       
                                                                        
*        Now look at the rad seg which was closest in Phi...                                                  
         IF(KMIN.GT.0.AND.PMIN.LT.PWED) THEN                            
          DO 5 KDP = 1,  12                                             
            KDS     = IBTAB(IFRSG,10+KDP,KMIN)                          
            KD      = IABS(KDS)                                         
            IF(KD .GT. 0) THEN                                          
             ICLNUM = IBTAB(IFRLC, 1, KD)                               
             DDD    = RBTAB(IFRLC, 2, KD)                               
             RADIUS = RBTAB(IFRLC, 4, KD)                               
             ISGNW  = IBTAB(IFRLC, 6, KD)                               
             ISG    = MOD(ISGNW, 2)                                     
             PHIW   =  RBTAB(IFRG1,2+3*ISG,ICLNUM+1)                    
             STAGGR =  RBTAB(IFRG1,3+3*ISG,ICLNUM+1)                    
             ZZ     =  RBTAB(IFRG1,4+3*ISG,ICLNUM+1)                    
             IF(KDS.GT.0) THEN                                          
               DRIFT = DDD - STAGGR                                     
               DRFSGN = 1.0                                             
             ELSE                                                       
               DRIFT = -DDD - STAGGR                                    
               DRFSGN =-1.0                                             
             ENDIF                                                      
                                                                        
             RR =   RADIUS + FLOREN(RADIUS,ABS(DRIFT),DRFSGN)
             RR   = SQRT(DRIFT**2 + RR**2)                              
                                                                        
*            Planar prediction...                                                                             
             XG   = XPSGI + (ZZ-ZPSGI) * XSLPG                          
             YG   = YPSGI + (ZZ-ZPSGI) * YSLPG                          
             RP   = SQRT(XG**2 + YG**2)                                 
*            Predicted drift...                                                                               
             DPRED   = YG*COS(PHIW) - XG*SIN(PHIW)                      
                                                                        
             DELD = DRIFT - DPRED                                       
             DELR = RR - RP                                             
                                                                        
             CALL SHS(300,0,DELR)                                                                      
             CALL SHD(301,0,RP,DELR)                                                                   
             CALL SHD(302,0,RP,RR)                                                                     
             CALL SHS(310,0,DELD)                                                                      
             CALL SHD(311,0,DPRED,DRIFT)                                                               
                                                                        
             IF(DPRED.LT.0.0) THEN                                      
              CALL SHS(316,0,DELD)                                                                     
             ELSE                                                       
              CALL SHS(317,0,DELD)                                                                     
             ENDIF                                                      
                                                                        
*            long projection...                                                                               
             IF(K.GT.1) THEN                                            
               CALL SHS(303,0,DELR)                                                                    
               CALL SHD(304,0,RP,DELR)                                                                 
               CALL SHD(305,0,RP,RR)                                                                   
               CALL SHS(312,0,DELD)                                                                    
               CALL SHD(313,0,DPRED,DRIFT)                                                             
             ELSE                                                       
*            short projection...                                                                              
               CALL SHS(306,0,DELR)                                                                    
               CALL SHD(307,0,RP,DELR)                                                                 
               CALL SHD(308,0,RP,RR)                                                                   
               CALL SHS(314,0,DELD)                                                                    
               CALL SHD(315,0,DPRED,DRIFT)                                                             
             ENDIF                                                      
            ENDIF                                                       
 5         CONTINUE                                                     
          ENDIF                                                         
                                                                        
 1        CONTINUE                                                      
                                                                        
       ENDIF                                                            
 3    CONTINUE                                                          
                                                                        
      RETURN                                                            
      END                                                               
*                                                                                                             
C   22/07/92 207221019  MEMBER NAME  FPREZI   (FTREC)    M  FVS