SUBROUTINE FPTDIA
*-- Author : S.J. Maxfield
      SUBROUTINE FPTDIA
******========== ======*********************************************                                          
*  DIAGNOSTICS FOR PATTERN RECOGNITION IN FORWARD DRIFT CHAMBERS   *                                          
*  =========== === ======= =========== == ======= ===== ========   *                                          
*                                                                  *                                          
********************************************************************                                          
* BOS Commons...                                                                                              
*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,BOSMDL.                                                                                                 
C     ------BOSMDL                                                                                            
      LOGICAL       BEGJOB,ENDRUN,BEGRUN,REVENT,ENDJOB,OTHDAT           
      COMMON/BOSMDL/BEGJOB,ENDRUN,BEGRUN,REVENT,ENDJOB,OTHDAT,          
     +              LCCRUN,NCCRUN,NEVENT,                               
     +              IHA,IBS,IDB,IDATEL,LUP,ISN,JSN                      
      SAVE  /BOSMDL/                                                    
C     ------                                                                                                  
*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,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,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                                                                 
*                                                                                                             
*KEND.                                                                                                        
*     Diagnostic flag from FRCS BANK                                                                          
*KEEP,FDIFLG.                                                                                                 
      COMMON/LDIAG/IDIAG,IDIAG2,MAXPRT,IDOHIS,PMCUT                     
*KEND.                                                                                                        
*     Vertex...                                                                                               
*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...)                                       
*KEND.                                                                                                        
*     Radial geometry...                                                                                      
*     Planar geometry...                                                                                      
*     Radial hits...                                                                                          
*     Planar hits...                                                                                          
*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,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---                                                                                                          
*KEND.                                                                                                        
      DIMENSION ITRUT(36), JDIGS(36), IDX(36)                           
      DIMENSION ITRUTP(36), JDIGSP(36), IDXP(36)                        
      DIMENSION KFNDR(36), KFNDP(36)                                    
      DIMENSION ICOMPR(36), ICOMPP(36)                                  
*     Common for work bank indices...                                                                         
      COMMON /FRDIAC/IWFPUR,IWFRUX,IWFPUX                               
*------statement functions for table access--------------------------                                         
*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))                           
*KEND.                                                                                                        
*------------------------Begin --------------------------------------                                         
                                                                        
*     Short printout...                                                                                       
      IF(IDIAG2.GE.1) THEN                                              
       KFTUR=0                                                          
       IWFTUR  = NLINK('FTUR',0)
*      Check to see if any information...                                                                     
       IF( IWFTUR .NE. 0 ) THEN                                         
         KFTUR  = IW(IWFTUR+2)                                          
       ENDIF                                                            
       WRITE(6,'('' '','' Event'',I5,5X,I4,                             
     +           '' FTUR tracks reconstructed'')')NEVENT, KFTUR         
      ENDIF                                                             
      IF(IDIAG.EQ.0) RETURN                                             
*                                                                                                             
*     For all events, REAL and MONTE CARLO...                                                                 
      WRITE(6,'(/,                                                      
     +          70(''=''),/,                                            
     +            17X,''Diagnostics For Event:'',I5)') NEVENT           
      IF(IDIAG.GE.1)THEN                                                
         CALL FPFTUR
      ENDIF                                                             
      IF(IDIAG.GE.2)THEN                                                
         CALL FPFPUR
         CALL FPFRUX
         CALL FPFPUX
      ENDIF                                                             
      IF(IDIAG.GE.3) THEN                                               
          CALL FPFRRE
          CALL FPFRPE
          CALL FPFRLC
          CALL FPFRHC
          CALL FPFPLC
          CALL FPFPHC
      ENDIF                                                             
                                                                        
*---- real data diagnostics end here-------------------------                                                 
*                                                                                                             
      RETURN                                                            
      END                                                               
*