C---------------------------------------------------------------------- SUBROUTINE CLUSTER2 C---------------------------------------------------------------------- C- C- Purpose and Methods : IT WORKS AS CLUSTER BUT USING TWO PARTS OF THE C- CALORIMETER (LAYERS 1 - 4 AND LAYERS 5 - 8) INSTEAD OF THE 8 C- LAYERS . C- C- Created 25-FEB-1995 MIRKO BOEZIO C- Modified 30-MAR-1995 MIRKO BOEZIO . CORRECTED AN ERROR IN THE C- DEFINITION OF THE TWO PARTS , OTHERWISE IT WAS LAYERS 1 - 5 AND C- LAYERS 6 - 8 . C- C---------------------------------------------------------------------- INCLUDE 'INTEST.TXT' REAL QQQ(NCHA) C DO J = 1,2 DO N = 1,2 DO M = 1,NCHA CLUS2(N,J,M) = 0. ENDDO NCL2(N,J) = 0 ENDDO ENDDO C LPIANO = NPLA / 2 C DO N = 1,2 DO J = 1,2 DO M = 1,NCHA QQQ(M) = 0. DO L = 1,NPLA EN = DEXY(N,L,M) IF (EN.GT.EMIN.AND.J.EQ.1.AND.L.LE.LPIANO) THEN QQQ(M) = QQQ(M) + EN ENDIF IF (EN.GT.EMIN.AND.J.EQ.2.AND.L.GT.LPIANO) THEN QQQ(M) = QQQ(M) + EN ENDIF ENDDO ENDDO C IGIRO = 0. C 50 CONTINUE MAX = LVMAX(QQQ,NCHA) IF (QQQ(MAX).LT.EMIN) GO TO 100 MSTR = MAX 55 CONTINUE MSTR = MSTR + 1 IF (MSTR.GT.NCHA) GO TO 56 IF (QQQ(MSTR).GT.EMIN) GO TO 55 56 CONTINUE IB = MSTR - 1 C MSTR = MAX 65 CONTINUE MSTR = MSTR - 1 IF (MSTR.LT.1) GO TO 66 IF (QQQ(MSTR).GT.EMIN) GO TO 65 66 CONTINUE IA = MSTR + 1 C CALL BARIC(QQQ,IA,IB,BAR,ENE,IERR1) IGIRO = IGIRO + 1 IGI = IGIRO + NCHA / 2 CLUS2(N,J,IGIRO) = BAR CLUS2(N,J,IGI) = ENE C DO LL = IA,IB QQQ(LL) = 0. ENDDO GO TO 50 C 100 CONTINUE NCL2(N,J) = IGIRO ENDDO ENDDO C RETURN END