*-- Author : Girish D. Patel 07/12/93
SUBROUTINE FCHKQP
**********************************************************************
* *
* Fill histograms from hits in COMMON/H1WORK/, entered by FILLQP *
* *
* JVM 22/7/92 *
**********************************************************************
*KEEP,FMOWRK.
PARAMETER (MAXHIT=20)
LOGICAL LNEWR
LOGICAL LNEWP
COMMON/H1WORK/
* planar hit data...
+ TT(0:287,4,MAXHIT), NHIT(0:287,4),
+ QQ(0:287,4,MAXHIT), QQW(4) , LNEWP,
* radial hit data...
+ TTR(0:431,4,MAXHIT), NHITR(0:431,4),
+ QQR(0:431,4,MAXHIT), QQWR(4) , LNEWR,
+ RR(0:431,4,MAXHIT)
*KEND.
LOGICAL LFREE
DIMENSION LFREE(4,MAXHIT)
DIMENSION MWR(4)
*KEEP,FMOHIS.
INTEGER IHS(28)
COMMON/FMOHIS/ IHS
*KEND.
* check that COMMON/NEWP/ has some data ..
IF( LNEWP )THEN
LNEWP = .FALSE.
ELSE
RETURN
ENDIF
* cycle through the cells ...
DO 9000 NC=0,287
NSMOD = NC/96
NSLAY = NC/32
CHITS = FLOAT( NHIT(NC,1)+NHIT(NC,2)+NHIT(NC,3)+NHIT(NC,4) )
CALL HF1(2,CHITS,1.)
CALL SHS (IHS(2),0,CHITS) !SGI
* analyse existing hits in cell NC, if there are any
DO 100 J=1,4
IF( NHIT(NC,J).GT.1 )THEN ! look for periodic noise
DO 111 JHT=2,NHIT(NC,J)
TDIF = ABS( TT(NC,J,JHT)-TT(NC,J,JHT-1) )
CALL SHD (IHS(4),0,TDIF,0.) !SGI
CALL SHD (IHS(4),0,TDIF,FLOAT(NSMOD+1)) !SGI
111 CONTINUE
ENDIF
100 CONTINUE
*
* complete set of hits available here
MULTI = NHIT(NC,1)*NHIT(NC,2)*NHIT(NC,3)*NHIT(NC,4)
MULT2 = NHIT(NC,1)*NHIT(NC,3)*NHIT(NC,4)
MULT3 = NHIT(NC,1)*NHIT(NC,2)*NHIT(NC,4)
IF( MULTI.EQ.1 )THEN ! loop through combinations ?
* set flag "LFREE" to flag Qs which have not yet been plotted in
* hist ID=22 .....
DO 2 JWR=1,4
DO 2 JWH=1,MAXHIT
2 LFREE(JWR,JWH) = .TRUE.
DO 200 J1=1,NHIT(NC,1)
MWR(1) = J1
DO 200 J2=1,NHIT(NC,2)
MWR(2) = J2
DO 200 J3=1,NHIT(NC,3)
MWR(3) = J3
DO 200 J4=1,NHIT(NC,4)
MWR(4) = J4
CHK1 = (TT(NC,2,J2)-TT(NC,1,J1))-(TT(NC,4,J4)-TT(NC,3,J3))
CHK2 = (TT(NC,2,J2)-TT(NC,1,J1))+(TT(NC,4,J4)-TT(NC,3,J3))
X1 = 0.75*(TT(NC,2,J2)-TT(NC,3,J3))
& - 0.25*(TT(NC,1,J1)-TT(NC,4,J4))
IF( MULTI.EQ.1 )THEN
X2 = TT(NC,3,J3) - 0.33333*TT(NC,1,J1) - 0.66667*TT(NC,4,J4)
X3 = TT(NC,2,J2) - 0.33333*TT(NC,4,J4) - 0.66667*TT(NC,1,J1)
CALL SHD (IHS( 8),0,X2,13.5) !SGI
CALL SHD (IHS( 8),0,X2,FLOAT(NSMOD+1)+13.5) !SGI
CALL SHD (IHS( 8),0,X2,FLOAT(NSLAY+4)+13.5) !SGI
CALL SHD (IHS( 8),0,X3,13.5) !SGI
CALL SHD (IHS( 8),0,X3,FLOAT(NSMOD+1)+13.5) !SGI
CALL SHD (IHS( 8),0,X3,FLOAT(NSLAY+4)+13.5) !SGI
ENDIF
IF( ABS(CHK1).LE.100.0 .AND. ABS(CHK2).GT.24.0 )THEN
CALL SHD (IHS( 8),0,X1,0.5) !SGI
CALL SHD (IHS( 8),0,X1,FLOAT(NSMOD+1)+0.5) !SGI
CALL SHD (IHS( 8),0,X1,FLOAT(NSLAY+4)+0.5) !SGI
QQW(1) = QQ(NC,1,J1)
QQW(2) = QQ(NC,2,J2)
QQW(3) = QQ(NC,3,J3)
QQW(4) = QQ(NC,4,J4)
DO 6666 J=1,4
IF( LFREE(J,MWR(J)) )THEN
LFREE(J,MWR(J)) = .FALSE.
QLOG = ALOG(QQW(J))
CALL SHD (IHS( 7),0,QLOG,0.) !SGI
CALL SHD (IHS( 7),0,QLOG,FLOAT(NSMOD+1)) !SGI
ENDIF
6666 CONTINUE
ENDIF
200 CONTINUE
ELSE IF(MULTI.EQ.0 .AND. MULT2.EQ.1 ) THEN
X2 = TT(NC,3,1) - 0.33333*TT(NC,1,1) - 0.66667*TT(NC,4,1)
CALL SHD (IHS( 8),0,X2,26.5) !SGI
CALL SHD (IHS( 8),0,X2,FLOAT(NSMOD+1)+26.5) !SGI
CALL SHD (IHS( 8),0,X2,FLOAT(NSLAY+4)+26.5) !SGI
ELSE IF(MULTI.EQ.0 .AND. MULT3.EQ.1 ) THEN
X3 = TT(NC,2,1) - 0.33333*TT(NC,4,1) - 0.66667*TT(NC,1,1)
CALL SHD (IHS( 8),0,X3,26.5) !SGI
CALL SHD (IHS( 8),0,X3,FLOAT(NSMOD+1)+26.5) !SGI
CALL SHD (IHS( 8),0,X3,FLOAT(NSLAY+4)+26.5) !SGI
ENDIF
101 CONTINUE
9000 CONTINUE ! cycle on cells
* zero arrays ready for next event
NW2 = 1152
NW3 = NW2*MAXHIT
CALL VZERO( TT(0,1,1),NW3 )
CALL VZERO( QQ(0,1,1),NW3 )
CALL VZERO( NHIT(0,1),NW2 )
RETURN
END
*