CaloDoubleShower/src/dubsc.for

      SUBROUTINE DUBSC(INDIC,QQQ)
C----------------------------------------------------------------------
C-
C-   Purpose and Methods : 
C-
C-   Inputs  : 
C-   Outputs : 
C-   Controls: 
C-
C-   Created  30-MAR-1995   MIRKO BOEZIO
C-
C----------------------------------------------------------------------
      IMPLICIT NONE

      INCLUDE 'INTEST.TXT'

      REAL QQQ
      REAL RIL(NCHA/2)
      REAL DBNCL(4)
      REAL DBCLUS(4,NCHA)
      REAL RR, RRR, DAD
      INTEGER I, J, K, M, L, LL, LK
      INTEGER ITL, LPIANO
      INTEGER INDIC, NGIR, ISTOP
      INTEGER LVMAX
C
      REAL BAR(2,NPLAV)
      INTEGER IBAR(2,NPLAV)
C
      COMMON / ANGOLO / BAR, IBAR
      SAVE / ANGOLO /
C
C     Begin!
C     
      LPIANO = NPLA / 2 
C     
      DO K = 1,NCHA/2
         RIL(K) = 0.
      ENDDO
C     
      DO J = 1,4
         DO K = 1,NCHA
            DBCLUS(J,K) = CLUS4(1,J,K)
         ENDDO
         DBNCL(J) = NCL4(1,J)
      ENDDO
C     
      QQQ = 0.
      INDIC = 0
      NGIR = 0
      
      M = 1
C     
      DO 5 J = 1,2
C     
         DO I = 1,NGIR
            RIL(I) = 0.
         ENDDO
C     
C     
         IF (J.EQ.1) ITL = (LPIANO-6 + 1) / 2
         IF (J.EQ.2) ITL = (LPIANO + LPIANO-6 + 1) / 2
         
         DAD = BAR(M,ITL) 
C     
         NGIR = NCL4(M,J)
         IF (NGIR.EQ.0) GO TO 5
         DO L = 1,NGIR
            RR = ABS(DAD - CLUS4(M,J,L))
            IF (RR.LE.15) THEN
               DBNCL(J) = DBNCL(J) - 1
               DBCLUS(J,L) = 0.
               DBCLUS(J,L+NCHA/2) = 0.
            ENDIF
         ENDDO
C     
 5    CONTINUE
C     
      NGIR = NCL4(M,1)
      DO I = 1,NCHA/2
         RIL(I) = 0.
      ENDDO
      IF (NGIR.GE.1) THEN
         DO LL = 1,NGIR
            IF (DBCLUS(1,LL).GT.0) RIL(LL) = DBCLUS(1,LL+NCHA/2)
         ENDDO
c 7    ENDIF
      ENDIF
      LK = LVMAX(RIL,NCHA/2)
      QQQ = QQQ + DBCLUS(1,LK+NCHA/2)
      RRR = DBCLUS(1,LK)
C     
      NGIR = NCL4(M,2)
      IF (NGIR.GE.1) THEN
         DO LL = 1,NGIR
            RR = ABS(RRR - DBCLUS(2,LL))
            IF (RR.LE.20) THEN
               QQQ = QQQ + DBCLUS(2,LL+NCHA/2)
            ENDIF
         ENDDO
      ENDIF
C     
      ISTOP = 0
C     
      IF (QQQ.GT.30.AND.ISTOP.EQ.0) INDIC = 1
C     
C     
c 400  CONTINUE
      CONTINUE
      
C----------------------------------------------------------------------
c999  RETURN
      RETURN
      END
      
1	SUBROUTINE DUBSC(INDIC,QQQ)
2	C----------------------------------------------------------------------
3	C-
4	C- Purpose and Methods :
5	C-
6	C- Inputs :
7	C- Outputs :
8	C- Controls:
9	C-
10	C- Created 30-MAR-1995 MIRKO BOEZIO
11	C-
12	C----------------------------------------------------------------------
13	IMPLICIT NONE
14
15	INCLUDE 'INTEST.TXT'
16
17	REAL QQQ
18	REAL RIL(NCHA/2)
19	REAL DBNCL(4)
20	REAL DBCLUS(4,NCHA)
21	REAL RR, RRR, DAD
22	INTEGER I, J, K, M, L, LL, LK
23	INTEGER ITL, LPIANO
24	INTEGER INDIC, NGIR, ISTOP
25	INTEGER LVMAX
26	C
27	REAL BAR(2,NPLAV)
28	INTEGER IBAR(2,NPLAV)
29	C
30	COMMON / ANGOLO / BAR, IBAR
31	SAVE / ANGOLO /
32	C
33	C Begin!
34	C
35	LPIANO = NPLA / 2
36	C
37	DO K = 1,NCHA/2
38	RIL(K) = 0.
39	ENDDO
40	C
41	DO J = 1,4
42	DO K = 1,NCHA
43	DBCLUS(J,K) = CLUS4(1,J,K)
44	ENDDO
45	DBNCL(J) = NCL4(1,J)
46	ENDDO
47	C
48	QQQ = 0.
49	INDIC = 0
50	NGIR = 0
51
52	M = 1
53	C
54	DO 5 J = 1,2
55	C
56	DO I = 1,NGIR
57	RIL(I) = 0.
58	ENDDO
59	C
60	C
61	IF (J.EQ.1) ITL = (LPIANO-6 + 1) / 2
62	IF (J.EQ.2) ITL = (LPIANO + LPIANO-6 + 1) / 2
63
64	DAD = BAR(M,ITL)
65	C
66	NGIR = NCL4(M,J)
67	IF (NGIR.EQ.0) GO TO 5
68	DO L = 1,NGIR
69	RR = ABS(DAD - CLUS4(M,J,L))
70	IF (RR.LE.15) THEN
71	DBNCL(J) = DBNCL(J) - 1
72	DBCLUS(J,L) = 0.
73	DBCLUS(J,L+NCHA/2) = 0.
74	ENDIF
75	ENDDO
76	C
77	5 CONTINUE
78	C
79	NGIR = NCL4(M,1)
80	DO I = 1,NCHA/2
81	RIL(I) = 0.
82	ENDDO
83	IF (NGIR.GE.1) THEN
84	DO LL = 1,NGIR
85	IF (DBCLUS(1,LL).GT.0) RIL(LL) = DBCLUS(1,LL+NCHA/2)
86	ENDDO
87	c 7 ENDIF
88	ENDIF
89	LK = LVMAX(RIL,NCHA/2)
90	QQQ = QQQ + DBCLUS(1,LK+NCHA/2)
91	RRR = DBCLUS(1,LK)
92	C
93	NGIR = NCL4(M,2)
94	IF (NGIR.GE.1) THEN
95	DO LL = 1,NGIR
96	RR = ABS(RRR - DBCLUS(2,LL))
97	IF (RR.LE.20) THEN
98	QQQ = QQQ + DBCLUS(2,LL+NCHA/2)
99	ENDIF
100	ENDDO
101	ENDIF
102	C
103	ISTOP = 0
104	C
105	IF (QQQ.GT.30.AND.ISTOP.EQ.0) INDIC = 1
106	C
107	C
108	c 400 CONTINUE
109	CONTINUE
110
111	C----------------------------------------------------------------------
112	c999 RETURN
113	RETURN
114	END
115