C C---------------------------------------------------------------------- SUBROUTINE CLUSTER4 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) COMMON / SHIFT / SHIFT SAVE / SHIFT / C DO J = 1,4 DO N = 1,2 DO M = 1,NCHA CLUS4(N,J,M) = 0. ENDDO NCL4(N,J) = 0 ENDDO ENDDO C LPIANO = NPLA / 2 C DO N = 1,2 DO J = 1,4 DO M = 1,NCHA QQQ(M) = 0. DO L = 1,NPLA NLK = (M - 1) * NPLA + L EN = DEXY(N,L,M) IF (EN.GT.EMIN.AND.J.EQ.1.AND.L.LE.(LPIANO-6)) THEN QQQ(M) = QQQ(M) + EN ENDIF IF (EN.GT.EMIN.AND.J.EQ.2.AND.L.GT.(LPIANO-6).AND.L.LE. + LPIANO) THEN QQQ(M) = QQQ(M) + EN ENDIF IF (EN.GT.EMIN.AND.J.EQ.3.AND.L.GT.LPIANO.AND.L.LE. + (LPIANO+6)) THEN QQQ(M) = QQQ(M) + EN ENDIF IF (EN.GT.EMIN.AND.J.EQ.4.AND.L.GT.(LPIANO+6)) 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 NN = 0 c IF (M.EQ.2) NN = 1 c IF (MOD(I,2).EQ.NN) THEN IF (MOD(J,2).EQ.NN) THEN IF (REVERSE.EQ.0) THEN SHIFT = -0.5 ELSE SHIFT = +0.5 ENDIF ELSE IF (REVERSE.EQ.0) THEN SHIFT = +0.5 ELSE SHIFT = -0.5 ENDIF ENDIF CALL BARIC(QQQ,IA,IB,BAR,ENE,IERR1) IGIRO = IGIRO + 1 IGI = IGIRO + NCHA / 2 CLUS4(N,J,IGIRO) = BAR CLUS4(N,J,IGI) = ENE C DO LL = IA,IB QQQ(LL) = 0. ENDDO GO TO 50 C 100 CONTINUE NCL4(N,J) = IGIRO ENDDO ENDDO C RETURN END