*-- Author : S.J. Maxfield
SUBROUTINE FPFPUR
*-----------------------------------------------------------*
* Print output banks from Forward Pattern recognition *
* in readable form. Pointering Bank FPUR *
*-----------------------------------------------------------*
*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,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.
COMMON /FPF6WW/ INDFRD
*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.
* pointer list...
NBN = 0
IND = NLINK('FPUR',NBN)
IF (IND .EQ. 0) THEN
WRITE(6,*) ' FPFPUR>> FPUR Bank not found in event ',NEVENT
RETURN
ENDIF
INDFRD=0
CALL BKTOW(IW,'FPUR',NBN,IW,INDFRD,*900)
NROW = IW(INDFRD+2)
WRITE(6,'('' '')')
WRITE(6,'(/,10X,'' ------ FPUR BANK: Event'',I10,
+ 3X,I4,'' tracks------'')')
+ NEVENT,NROW
WRITE(6, '('' Track NHITFR FRUX NHITFP FPUX'')')
DO 4 J= 1,NROW
WRITE(6,'( 5(1X,I6) )')
+ J ,(IBTAB(INDFRD,K,J ), K=1,4)
4 CONTINUE
CALL WDROP(IW,INDFRD)
RETURN
* Error condition...
900 CONTINUE
WRITE(6,*) ' FPFPUR >> Error in Work Bank Creation'
RETURN
END
*