*-- Author : Girish D. Patel 07/12/93
SUBROUTINE FCHKQR
**********************************************************************
* *
* Fill histograms from hits in COMMON/H1WORK/, entered by FILLQR *
* *
* JVM 22/7/92 *
**********************************************************************
*KEEP,FMOBIN.
PARAMETER( NBINR=40 )
*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),TTW(4),RRW(4)
*KEEP,FMOHIS.
INTEGER IHS(28)
COMMON/FMOHIS/ IHS
*KEND.
* check that COMMON/H1WORK/ has some data ..
IF( LNEWR )THEN
LNEWR = .FALSE.
ELSE
RETURN
ENDIF
* cycle through the cells ...
DO 9000 NC=0,431
NSMOD = NC/144
NLAY = NC/48
CHITS = FLOAT(NHITR(NC,1)+NHITR(NC,2)+NHITR(NC,3)+NHITR(NC,4))
CALL SHS (IHS(12),0,CHITS) !SGI
* analyse existing hits in cell NC, if there are any
DO 100 J=1,4
IF( NHITR(NC,J).GT.1 )THEN ! look for periodic noise
DO 111 JHT=2,NHITR(NC,J)
TDIF = ABS( TTR(NC,J,JHT)-TTR(NC,J,JHT-1) )
CALL SHD (IHS(19),0,TDIF,0.) !SGI
CALL SHD (IHS(19),0,TDIF,FLOAT(NSMOD+1)) !SGI
111 CONTINUE
ENDIF
100 CONTINUE
*
* complete set of hits available here
MULTI = NHITR(NC,1)*NHITR(NC,2)*NHITR(NC,3)*NHITR(NC,4)
MULT2 = NHITR(NC,1)*NHITR(NC,3)*NHITR(NC,4)
MULT3 = NHITR(NC,1)*NHITR(NC,2)*NHITR(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=68 ...
DO 2 JWR=1,4
DO 2 JWH=1,MAXHIT
2 LFREE(JWR,JWH) = .TRUE.
DO 200 J1=1,NHITR(NC,1)
MWR(1) = J1
DO 200 J2=1,NHITR(NC,2)
MWR(2) = J2
DO 200 J3=1,NHITR(NC,3)
MWR(3) = J3
DO 200 J4=1,NHITR(NC,4)
MWR(4) = J4
CHK1 = (TTR(NC,2,J2)-TTR(NC,1,J1))-(TTR(NC,4,J4)-TTR(NC,3,J3))
CHK2 = (TTR(NC,2,J2)-TTR(NC,1,J1))+(TTR(NC,4,J4)-TTR(NC,3,J3))
X1 = 0.75*(TTR(NC,2,J2)-TTR(NC,3,J3))
& - 0.25*(TTR(NC,1,J1)-TTR(NC,4,J4))
IF( MULTI.EQ.1 )THEN
X2 = TTR(NC,3,J3)-0.33333*TTR(NC,1,J1)-0.66667*TTR(NC,4,J4)
X3 = TTR(NC,2,J2)-0.33333*TTR(NC,4,J4)-0.66667*TTR(NC,1,J1)
CALL SHD (IHS(23),0,X2,13.5) !SGI
CALL SHD (IHS(23),0,X2,FLOAT(NSMOD+1)+13.5) !SGI
CALL SHD (IHS(23),0,X2,FLOAT(NLAY+4)+13.5) !SGI
CALL SHD (IHS(23),0,X3,13.5) !SGI
CALL SHD (IHS(23),0,X3,FLOAT(NSMOD+1)+13.5) !SGI
CALL SHD (IHS(23),0,X3,FLOAT(NLAY+4)+13.5) !SGI
ENDIF
IF( ABS(CHK1).LE.100.0 .AND. ABS(CHK2).GT.24.0 )THEN
CALL SHD (IHS(23),0,X1,0.5) !SGI
CALL SHD (IHS(23),0,X1,FLOAT(NSMOD+1)+0.5) !SGI
CALL SHD (IHS(23),0,X1,FLOAT(NLAY+4)+0.5) !SGI
* RAD = (RR(NC,2,J1)+RR(NC,1,J2)+RR(NC,4,J3)+RR(NC,3,J4))/4.0
QQWR(1) = QQR(NC,1,J1)
QQWR(2) = QQR(NC,2,J2)
QQWR(3) = QQR(NC,3,J3)
QQWR(4) = QQR(NC,4,J4)
* TTW(1) = TTR(NC,1,J1)
* TTW(2) = TTR(NC,2,J2)
* TTW(3) = TTR(NC,3,J3)
* TTW(4) = TTR(NC,4,J4)
* RRW(1) = RR(NC,1,J1)
* RRW(2) = RR(NC,2,J2)
* RRW(3) = RR(NC,3,J3)
* RRW(4) = RR(NC,4,J4)
* SRZ = -0.3*RRW(1) - 0.1*RRW(2) + 0.1*RRW(3) + 0.3*RRW(4)
* CRZ = RRW(1) + 0.5*RRW(2) - 0.5*RRW(4)
DO 6666 J=1,4
IF( LFREE(J,MWR(J)) )THEN
LFREE(J,MWR(J)) = .FALSE.
CALL SHD (IHS(22),0,QQWR(J),0.) !SGI
CALL SHD (IHS(22),0,QQWR(J),FLOAT(NSMOD+1)) !SGI
ENDIF
* RPRED = SRZ*FLOAT(J) + CRZ
* IF(RPRED.LT.80.0) THEN
* YRPRED = RPRED*FLOAT(NBINR)/80.0
* IRPRED = YRPRED
* IF(X1.GT.0.0) THEN
* CALL SHDW(IHS(17),0,TTW(J)-60.,YRPRED,-1.) !SGI
* CALL SHDW(IHS(17),0,TTW(J)+60.,YRPRED,+1.) !SGI
* ELSE
* CALL SHDW(IHS(18),0,TTW(J)-60.,YRPRED,-1.) !SGI
* CALL SHDW(IHS(18),0,TTW(J)+60.,YRPRED,+1.) !SGI
* ENDIF
* ENDIF
* IF(RAD.LT.80.0.AND.ABS(X1).GT.8.0.AND.ABS(X1).LT.32.0) THEN
* ENDIF
6666 CONTINUE
ENDIF
200 CONTINUE
ELSE IF(MULTI.EQ.0 .AND. MULT2.EQ.1 ) THEN
X2 = TTR(NC,3,1) - 0.33333*TTR(NC,1,1) - 0.66667*TTR(NC,4,1)
CALL SHD (IHS(23),0,X2,26.5) !SGI
CALL SHD (IHS(23),0,X2,FLOAT(NSMOD+1)+26.5) !SGI
CALL SHD (IHS(23),0,X2,FLOAT(NLAY+4)+26.5) !SGI
ELSE IF(MULTI.EQ.0 .AND. MULT3.EQ.1 ) THEN
X3 = TTR(NC,2,1) - 0.33333*TTR(NC,4,1) - 0.66667*TTR(NC,1,1)
CALL SHD (IHS(23),0,X3,26.5) !SGI
CALL SHD (IHS(23),0,X3,FLOAT(NSMOD+1)+26.5) !SGI
CALL SHD (IHS(23),0,X3,FLOAT(NLAY+4)+26.5) !SGI
ENDIF
101 CONTINUE
9000 CONTINUE ! cycle on cells
* zero arrays ready for next event
NW2 = 2128
NW3 = NW2*MAXHIT
CALL VZERO( TTR(0,1,1),NW3 )
CALL VZERO( QQR(0,1,1),NW3 )
CALL VZERO( NHITR(0,1),NW2 )
RETURN
END
*