*-- Author : Girish D. Patel 02/02/94
SUBROUTINE FTRMON(NRUN)
DIMENSION RP(5,5),AVEC(13),IDS(13),XSTAT(4),YSTAT(4),BINS(37)
DIMENSION PVEC(10),RVEC(15),BMASK(64)
LOGICAL R0,R1,R2,P0,P1,P2,BTEST
DATA IDS /4,5,6,75,76,79,81,87,88,89,90,80,82/
DO 10 I = 1 , 13
CALL SAREA('FTREC',0)
CALL GHSTAT('HS',IDS(I),0,NENT,SUMW,RNEFF,XSTAT,YSTAT)
CALL HPEAK('HS',IDS(I),0,NP,RP)
AVEC(1) = FLOAT(NP)
IF(NP.GE.1 .AND. I.LE.11) THEN
AVEC(2) = RP(1,1)
AVEC(3) = RP(2,1)
AVEC(4) = RP(3,1)
AVEC(5) = RP(4,1)
AVEC(6) = RP(5,1)
AVEC(7) = XSTAT(3)
AVEC(8) = XSTAT(4)
ELSEIF(NP.EQ.2 .AND. I.GT.7) THEN
IF(RP(1,1) .LT. 0.0) THEN
J1 = 1
J2 = 2
ELSE
J1 = 2
J2 = 1
ENDIF
AVEC(2) = RP(1,J1)
AVEC(3) = RP(2,J1)
AVEC(4) = RP(3,J1)
AVEC(5) = RP(4,J1)
AVEC(6) = RP(5,J1)
AVEC(7) = RP(1,J2)
AVEC(8) = RP(2,J2)
AVEC(9) = RP(3,J2)
AVEC(10) = RP(4,J2)
AVEC(11) = RP(5,J2)
AVEC(12) = XSTAT(3)
AVEC(13) = XSTAT(4)
ELSE
AVEC(2) = 0.
AVEC(3) = 0.
AVEC(4) = 0.
AVEC(5) = 0.
AVEC(6) = 0.
AVEC(7) = 0.
AVEC(8) = 0.
AVEC(9) = 0.
AVEC(10) = 0.
AVEC(11) = 0.
AVEC(12) = XSTAT(3)
AVEC(13) = XSTAT(4)
ENDIF
CALL SAREA('FTRMON',0)
CALL SVEC(IDS(I),0,AVEC)
10 CONTINUE
CALL SAREA('FTREC',0)
AVEC(1) = FLOAT(NRUN)
CALL GHSTAT('HS', 1,0,NENT,SUMW,RNEFF,XSTAT,YSTAT)
AVEC(2) = XSTAT(3)
CALL GHSTAT('HS', 2,0,NENT,SUMW,RNEFF,XSTAT,YSTAT)
CALL GDATA('HS', 2,0,NR,BINS,37)
AVEC(3) = XSTAT(3)*FLOAT(NENT)/(FLOAT(NENT) - BINS(1))
CALL GHSTAT('HS', 3,0,NENT,SUMW,RNEFF,XSTAT,YSTAT)
CALL GDATA('HS', 3,0,NR,BINS,37)
AVEC(4) = XSTAT(3)*FLOAT(NENT)/(FLOAT(NENT) - BINS(1))
CALL GHSTAT('HS',15,0,NENT,SUMW,RNEFF,XSTAT,YSTAT)
AVEC(5) = XSTAT(3)
CALL GHSTAT('HS',16,0,NENT,SUMW,RNEFF,XSTAT,YSTAT)
AVEC(6) = XSTAT(3)
CALL GDATA('HS',17,0,NR,BINS,37)
NSEG0 = BINS(10) +BINS(11) +BINS(12) +BINS(13)
PVEC(2) = (BINS(10)*9+BINS(11)*10+BINS(12)*11+BINS(13)*12)/NSEG0
NSEG1 = BINS(22) +BINS(23) +BINS(24) +BINS(25)
PVEC(3) = (BINS(22)*9+BINS(23)*10+BINS(24)*11+BINS(25)*12)/NSEG1
NSEG2 = BINS(34) +BINS(35) +BINS(36) +BINS(37)
PVEC(4) = (BINS(34)*9+BINS(35)*10+BINS(36)*11+BINS(37)*12)/NSEG2
PVEC(1) = NSEG0 + NSEG1 + NSEG2
PVEC(5) = BINS(10) +BINS(22) +BINS(34)
PVEC(6) = BINS(11) +BINS(23) +BINS(35)
PVEC(7) = BINS(12) +BINS(24) +BINS(36)
PVEC(8) = BINS(13) +BINS(25) +BINS(37)
CALL GDATA('HS',18,0,NR,BINS,37)
NSEG0 = BINS(5)+BINS(6)+BINS(7)+BINS(8)+BINS(9)
& +BINS(10)+BINS(11)+BINS(12)+BINS(13)
RVEC(2) = (BINS(5)*4+BINS(6)*5+BINS(7)*6+BINS(8)*7+BINS(9)*8
& +BINS(10)*9+BINS(11)*10+BINS(12)*11+BINS(13)*12)/NSEG0
NSEG1 = BINS(17)+BINS(18)+BINS(19)+BINS(20)+BINS(21)
& +BINS(22)+BINS(23)+BINS(24)+BINS(25)
RVEC(3) = (BINS(17)*4+BINS(18)*5+BINS(19)*6+BINS(20)*7+BINS(21)*8
& +BINS(22)*9+BINS(23)*10+BINS(24)*11+BINS(25)*12)/NSEG1
NSEG2 = BINS(29)+BINS(30)+BINS(31)+BINS(32)+BINS(33)
& +BINS(34)+BINS(35)+BINS(36)+BINS(37)
RVEC(4) = (BINS(29)*4+BINS(30)*5+BINS(31)*6+BINS(32)*7+BINS(33)*8
& +BINS(34)*9+BINS(35)*10+BINS(36)*11+BINS(37)*12)/NSEG2
RVEC(1) = NSEG0 + NSEG1 + NSEG2
RVEC(5) = BINS( 5)+BINS(17)+BINS(29)
RVEC(6) = BINS( 6)+BINS(18)+BINS(30)
RVEC(7) = BINS( 7)+BINS(19)+BINS(31)
RVEC(8) = BINS( 8)+BINS(20)+BINS(32)
RVEC(9) = BINS( 9)+BINS(21)+BINS(33)
RVEC(10)= BINS(10)+BINS(22)+BINS(34)
RVEC(11)= BINS(11)+BINS(23)+BINS(35)
RVEC(12)= BINS(12)+BINS(24)+BINS(36)
RVEC(13)= BINS(13)+BINS(25)+BINS(37)
CALL SAREA('FTRMON',0)
CALL SVEC(1,0,AVEC)
CALL SVEC(100,0,PVEC)
CALL SVEC(101,0,RVEC)
CALL SAREA('FTREC',0)
CALL GDATA('HS',19,0,NR,BMASK,64)
P0P1 = 0.
P0R0P1 = 0.
R0P1 = 0.
P0R1 = 0.
P0R0R1 = 0.
P0P1R1 = 0.
P0P2 = 0.
P0R0P2 = 0.
P0P1P2 = 0.
P0R1P2 = 0.
P0R2 = 0.
P0R0R2 = 0.
P0P1R2 = 0.
P0R1R2 = 0.
P0P2R2 = 0.
R0R1 = 0.
R0P1R1 = 0.
R0P2 = 0.
R0P1P2 = 0.
R0R1P2 = 0.
R0R2 = 0.
R0P1R2 = 0.
R0R1R2 = 0.
R0P2R2 = 0.
P1P2 = 0.
P1R1P2 = 0.
P1R2 = 0.
P1R1R2 = 0.
P1P2R2 = 0.
R1R2 = 0.
R1P2R2 = 0.
R1P2 = 0.
DO 15 I = 0, 63
R0 = BTEST(I,0)
R1 = BTEST(I,1)
R2 = BTEST(I,2)
P0 = BTEST(I,3)
P1 = BTEST(I,4)
P2 = BTEST(I,5)
IF(P0 .AND. P1) P0P1 = P0P1 + BMASK(I+1)
IF(P0 .AND. P1 .AND. R0) P0R0P1 = P0R0P1 + BMASK(I+1)
IF(R0 .AND. P1) R0P1 = R0P1 + BMASK(I+1)
IF(P0 .AND. R1) P0R1 = P0R1 + BMASK(I+1)
IF(P0 .AND. R1 .AND. R0) P0R0R1 = P0R0R1 + BMASK(I+1)
IF(P0 .AND. R1 .AND. P1) P0P1R1 = P0P1R1 + BMASK(I+1)
IF(P0 .AND. P2) P0P2 = P0P2 + BMASK(I+1)
IF(P0 .AND. P2 .AND. R0) P0R0P2 = P0R0P2 + BMASK(I+1)
IF(P0 .AND. P2 .AND. P1) P0P1P2 = P0P1P2 + BMASK(I+1)
IF(P0 .AND. P2 .AND. R1) P0R1P2 = P0R1P2 + BMASK(I+1)
IF(P0 .AND. R2) P0R2 = P0R2 + BMASK(I+1)
IF(P0 .AND. R2 .AND. R0) P0R0R2 = P0R0R2 + BMASK(I+1)
IF(P0 .AND. R2 .AND. P1) P0P1R2 = P0P1R2 + BMASK(I+1)
IF(P0 .AND. R2 .AND. R1) P0R1R2 = P0R1R2 + BMASK(I+1)
IF(P0 .AND. R2 .AND. P2) P0P2R2 = P0P2R2 + BMASK(I+1)
IF(R0 .AND. R1) R0R1 = R0R1 + BMASK(I+1)
IF(R0 .AND. R1 .AND. P1) R0P1R1 = R0P1R1 + BMASK(I+1)
IF(R0 .AND. P2) R0P2 = R0P2 + BMASK(I+1)
IF(R0 .AND. P2 .AND. P1) R0P1P2 = R0P1P2 + BMASK(I+1)
IF(R0 .AND. P2 .AND. R1) R0R1P2 = R0R1P2 + BMASK(I+1)
IF(R0 .AND. R2) R0R2 = R0R2 + BMASK(I+1)
IF(R0 .AND. R2 .AND. P1) R0P1R2 = R0P1R2 + BMASK(I+1)
IF(R0 .AND. R2 .AND. R1) R0R1R2 = R0R1R2 + BMASK(I+1)
IF(R0 .AND. R2 .AND. P2) R0P2R2 = R0P2R2 + BMASK(I+1)
IF(P1 .AND. P2) P1P2 = P1P2 + BMASK(I+1)
IF(P1 .AND. P2 .AND. R1) P1R1P2 = P1R1P2 + BMASK(I+1)
IF(P1 .AND. R2) P1R2 = P1R2 + BMASK(I+1)
IF(P1 .AND. R2 .AND. R1) P1R1R2 = P1R1R2 + BMASK(I+1)
IF(P1 .AND. R2 .AND. P2) P1P2R2 = P1P2R2 + BMASK(I+1)
IF(R1 .AND. R2) R1R2 = R1R2 + BMASK(I+1)
IF(R1 .AND. R2 .AND. P2) R1P2R2 = R1P2R2 + BMASK(I+1)
IF(R1 .AND. P2) R1P2 = R1P2 + BMASK(I+1)
15 CONTINUE
AVEC(1) = P0R0P1/R0P1
AVEC(2) = (P0R0P1/P0P1 + P0R0R1/P0R1 + P0R0P2/P0P2 +
& P0R0R2/P0R2)/4.0
AVEC(3) = (P0P1R1/P0R1 + P0P1P2/P0P2 + P0P1R2/P0R2 +
& R0P1R1/R0R1 + R0P1P2/R0P2 + R0P1R2/R0R2)/6.0
AVEC(4) = (P0R1P2/P0P2 + P0R1R2/P0R2 + R0R1P2/R0P2 +
& R0R1R2/R0R2 + P1R1P2/P1P2 + P1R1R2/P1R2)/6.0
AVEC(5) = (P0P2R2/P0R2 + R0P2R2/R0R2 + P1P2R2/P1R2 +
& R1P2R2/R1R2)/4.0
AVEC(6) = R1P2R2/R1P2
CALL SAREA('FTRMON',0)
CALL SVEC(19,0,AVEC)
DO 30 I = 200, 203
CALL SAREA('FTREC',1)
CALL GHSTAT('HS',I,0,NENT,SUMW,RNEFF,XSTAT,YSTAT)
RVEC(1) = XSTAT(3)
CALL GDATA('HS',I,0,NR,BINS,20)
DO 20 J = 5, 13
RVEC(J-3) = BINS(J)
20 CONTINUE
CALL SAREA('FTRMON',0)
CALL SVEC(I,0,RVEC)
30 CONTINUE
DO 60 I = 320, 323
CALL SAREA('FTREC',1)
CALL GHSTAT('HS',I,0,NENT,SUMW,RNEFF,XSTAT,YSTAT)
PVEC(1) = XSTAT(3)
CALL GDATA('HS',I,0,NR,BINS,20)
DO 50 J = 10, 13
PVEC(J-8) = BINS(J)
50 CONTINUE
CALL SAREA('FTRMON',0)
CALL SVEC(I,0,PVEC)
60 CONTINUE
DO 70 ID = 2016, 2017
CALL SAREA('FTREC',1)
CALL GHSTAT('HS',ID,0,NENT,SUMW,RNEFF,XSTAT,YSTAT)
CALL HPEAK('HS',ID,0,NP,RP)
AVEC(1) = FLOAT(NP)
AVEC(7) = XSTAT(3)
AVEC(8) = XSTAT(4)
IF(NP.GE.1) THEN
AVEC(2) = RP(1,1)
AVEC(3) = RP(2,1)
AVEC(4) = RP(3,1)
AVEC(5) = RP(4,1)
AVEC(6) = RP(5,1)
ELSE
AVEC(2) = 0.
AVEC(3) = 0.
AVEC(4) = 0.
AVEC(5) = 0.
AVEC(6) = 0.
ENDIF
CALL SAREA('FTRMON',0)
CALL SVEC(ID,0,AVEC)
70 CONTINUE
DO 80 ID = 907, 908
CALL SAREA('FTREC',2)
CALL GHSTAT('HS',ID,0,NENT,SUMW,RNEFF,XSTAT,YSTAT)
CALL HPEAK('HS',ID,0,NP,RP)
AVEC(1) = FLOAT(NP)
AVEC(7) = XSTAT(3)
AVEC(8) = XSTAT(4)
IF(NP.GE.1) THEN
AVEC(2) = RP(1,1)
AVEC(3) = RP(2,1)
AVEC(4) = RP(3,1)
AVEC(5) = RP(4,1)
AVEC(6) = RP(5,1)
ELSE
AVEC(2) = 0.
AVEC(3) = 0.
AVEC(4) = 0.
AVEC(5) = 0.
AVEC(6) = 0.
ENDIF
CALL SAREA('FTRMON',0)
CALL SVEC(ID,0,AVEC)
80 CONTINUE
DO 90 ID = 650, 657
CALL SAREA('FTREC',1)
CALL GHSTAT('HS',ID,0,NENT,SUMW,RNEFF,XSTAT,YSTAT)
CALL HPEAK('HS',ID,0,NP,RP)
AVEC(1) = FLOAT(NP)
AVEC(7) = XSTAT(3)
AVEC(8) = XSTAT(4)
IF(NP.GE.1) THEN
AVEC(2) = RP(1,1)
AVEC(3) = RP(2,1)
AVEC(4) = RP(3,1)
AVEC(5) = RP(4,1)
AVEC(6) = RP(5,1)
ELSE
AVEC(2) = 0.
AVEC(3) = 0.
AVEC(4) = 0.
AVEC(5) = 0.
AVEC(6) = 0.
ENDIF
CALL SAREA('FTRMON',0)
CALL SVEC(ID,0,AVEC)
90 CONTINUE
RETURN
END
*