1 |
SUBROUTINE CLUSTER |
2 |
C---------------------------------------------------------------------- |
3 |
C- |
4 |
C- Purpose and Methods : IT FINDS THE NUMBER OF |
5 |
C- CLUSTERS PER LAYER AND PER VIEW AND THE POSITION |
6 |
C- OF THE CENTRE OF GRAVITY OF THE DETECTED ENERGY . |
7 |
C- IN THE MATRIX CLUS 2xNPLAxNCHA WE HAVE THE |
8 |
C- CENTRES IN THE FIRST NCHA/2 ELEMENTS ORDERED FROM |
9 |
C- THE HIGHEST IN ENERGY TO THE LOWEST . THE SECOND |
10 |
C- NCHA/2 ELEMENTS ARE THE DETECTED ENERGIES IN |
11 |
C- THESE CLUSTERS . |
12 |
C- IN THE MATRIX NCL 2xNPLA WE HAVE THE NUMBER OF |
13 |
C- CLUSTERS PER LAYER . |
14 |
C- |
15 |
C- Inputs : |
16 |
C- Outputs : |
17 |
C- Controls: |
18 |
C- |
19 |
C- Created 3-FEB-1994 MIRKO BOEZIO |
20 |
C- Modified 21-FEB-2003 MIRKO BOEZIO . INTRODUCED |
21 |
C- THE SHIFT IN THE SILICON DETECTORS PLACEMENT |
22 |
C- FOR THE CALL TO MILLIM IN BARIC . |
23 |
C- |
24 |
C----------------------------------------------------- |
25 |
INCLUDE 'INTEST.TXT' |
26 |
REAL QQQ(NCHA) |
27 |
INTEGER I |
28 |
|
29 |
COMMON /SHIFT/ SHIFT |
30 |
SAVE /SHIFT/ |
31 |
C |
32 |
I = 0 |
33 |
DO J = 1,NPLA |
34 |
DO N = 1,2 |
35 |
DO M = 1,NCHA |
36 |
CLUS(N,J,M) = 0. |
37 |
ENDDO |
38 |
NCL(N,J) = 0 |
39 |
ENDDO |
40 |
ENDDO |
41 |
C |
42 |
DO N = 1,2 |
43 |
DO J = 1,NPLA |
44 |
DO M = 1,NCHA |
45 |
QQQ(M) = 0. |
46 |
IF (DEXY(N,J,M).GT.EMIN) THEN |
47 |
QQQ(M) = DEXY(N,J,M) |
48 |
ENDIF |
49 |
ENDDO |
50 |
C |
51 |
IGIRO = 0. |
52 |
C |
53 |
50 CONTINUE |
54 |
C |
55 |
C THE FIRST CLUSTER FOR THE LAYER J IS THAT WITH THE |
56 |
C HIGHEST DETECTED ENERGY . |
57 |
C |
58 |
MAX = LVMAX(QQQ,NCHA) |
59 |
IF (QQQ(MAX).LT.EMIN) GO TO 100 |
60 |
MSTR = MAX |
61 |
55 CONTINUE |
62 |
MSTR = MSTR + 1 |
63 |
IF (MSTR.GT.NCHA) GO TO 56 |
64 |
IF (QQQ(MSTR).GT.EMIN) GO TO 55 |
65 |
56 CONTINUE |
66 |
IB = MSTR - 1 |
67 |
C |
68 |
MSTR = MAX |
69 |
65 CONTINUE |
70 |
MSTR = MSTR - 1 |
71 |
IF (MSTR.LT.1) GO TO 66 |
72 |
IF (QQQ(MSTR).GT.EMIN) GO TO 65 |
73 |
66 CONTINUE |
74 |
IA = MSTR + 1 |
75 |
C |
76 |
NN = 0 |
77 |
IF (M.EQ.2) NN = 1 |
78 |
IF (MOD(I,2).EQ.NN) THEN |
79 |
SHIFT = +0.5 |
80 |
ELSE |
81 |
SHIFT = -0.5 |
82 |
ENDIF |
83 |
CALL BARIC(QQQ,IA,IB,BAR,ENE,IERR1) |
84 |
IGIRO = IGIRO + 1 |
85 |
IGI = IGIRO + NCHA / 2 |
86 |
CLUS(N,J,IGIRO) = BAR |
87 |
CLUS(N,J,IGI) = ENE |
88 |
C |
89 |
DO LL = IA,IB |
90 |
QQQ(LL) = 0. |
91 |
ENDDO |
92 |
GO TO 50 |
93 |
C |
94 |
100 CONTINUE |
95 |
NCL(N,J) = IGIRO |
96 |
ENDDO |
97 |
ENDDO |
98 |
C |
99 |
RETURN |
100 |
END |
101 |
|
102 |
C |
103 |
C------------------------------------------------------ |
104 |
SUBROUTINE BARIC(Q,INF,ISUP,BAR,EPLA4,INDEX) |
105 |
C------------------------------------------------------ |
106 |
INCLUDE 'INTEST.TXT' |
107 |
REAL Q(NCHA) |
108 |
REAL BAR |
109 |
|
110 |
COMMON /SHIFT/ SHIFT |
111 |
SAVE /SHIFT / |
112 |
|
113 |
CM = 0. |
114 |
EPLA4 = 0. |
115 |
DO LL = INF,ISUP |
116 |
ENN = Q(LL) |
117 |
IF (ENN.GT.EMIN) THEN |
118 |
C |
119 |
CALL MILLIM(LL,RMM) |
120 |
CM = CM + RMM * ENN |
121 |
EPLA4 = EPLA4 + ENN |
122 |
ENDIF |
123 |
ENDDO |
124 |
IF (EPLA4.EQ.0) GO TO 300 |
125 |
BAR = CM / EPLA4 |
126 |
GOTO 400 |
127 |
C |
128 |
300 INDEX = 0 |
129 |
GOTO 500 |
130 |
C |
131 |
400 INDEX = 1 |
132 |
C |
133 |
500 CONTINUE |
134 |
RETURN |
135 |
END |
136 |
C |
137 |
C---------------------------------------------------------------------- |
138 |
SUBROUTINE CLUSTER2 |
139 |
C---------------------------------------------------------------------- |
140 |
C- |
141 |
C- Purpose and Methods : IT WORKS AS CLUSTER BUT USING TWO PARTS OF THE |
142 |
C- CALORIMETER (LAYERS 1 - 4 AND LAYERS 5 - 8) INSTEAD OF THE 8 |
143 |
C- LAYERS . |
144 |
C- |
145 |
C- Created 25-FEB-1995 MIRKO BOEZIO |
146 |
C- Modified 30-MAR-1995 MIRKO BOEZIO . CORRECTED AN ERROR IN THE |
147 |
C- DEFINITION OF THE TWO PARTS , OTHERWISE IT WAS LAYERS 1 - 5 AND |
148 |
C- LAYERS 6 - 8 . |
149 |
C- |
150 |
C---------------------------------------------------------------------- |
151 |
INCLUDE 'INTEST.TXT' |
152 |
REAL QQQ(NCHA) |
153 |
|
154 |
C |
155 |
DO J = 1,2 |
156 |
DO N = 1,2 |
157 |
DO M = 1,NCHA |
158 |
CLUS2(N,J,M) = 0. |
159 |
ENDDO |
160 |
NCL2(N,J) = 0 |
161 |
ENDDO |
162 |
ENDDO |
163 |
C |
164 |
LPIANO = NPLA / 2 |
165 |
C |
166 |
DO N = 1,2 |
167 |
DO J = 1,2 |
168 |
DO M = 1,NCHA |
169 |
QQQ(M) = 0. |
170 |
DO L = 1,NPLA |
171 |
EN = DEXY(N,L,M) |
172 |
IF (EN.GT.EMIN.AND.J.EQ.1.AND.L.LE.LPIANO) THEN |
173 |
QQQ(M) = QQQ(M) + EN |
174 |
ENDIF |
175 |
IF (EN.GT.EMIN.AND.J.EQ.2.AND.L.GT.LPIANO) THEN |
176 |
QQQ(M) = QQQ(M) + EN |
177 |
ENDIF |
178 |
ENDDO |
179 |
ENDDO |
180 |
C |
181 |
IGIRO = 0. |
182 |
C |
183 |
50 CONTINUE |
184 |
MAX = LVMAX(QQQ,NCHA) |
185 |
IF (QQQ(MAX).LT.EMIN) GO TO 100 |
186 |
MSTR = MAX |
187 |
55 CONTINUE |
188 |
MSTR = MSTR + 1 |
189 |
IF (MSTR.GT.NCHA) GO TO 56 |
190 |
IF (QQQ(MSTR).GT.EMIN) GO TO 55 |
191 |
56 CONTINUE |
192 |
IB = MSTR - 1 |
193 |
C |
194 |
MSTR = MAX |
195 |
65 CONTINUE |
196 |
MSTR = MSTR - 1 |
197 |
IF (MSTR.LT.1) GO TO 66 |
198 |
IF (QQQ(MSTR).GT.EMIN) GO TO 65 |
199 |
66 CONTINUE |
200 |
IA = MSTR + 1 |
201 |
C |
202 |
CALL BARIC(QQQ,IA,IB,BAR,ENE,IERR1) |
203 |
IGIRO = IGIRO + 1 |
204 |
IGI = IGIRO + NCHA / 2 |
205 |
CLUS2(N,J,IGIRO) = BAR |
206 |
CLUS2(N,J,IGI) = ENE |
207 |
C |
208 |
DO LL = IA,IB |
209 |
QQQ(LL) = 0. |
210 |
ENDDO |
211 |
GO TO 50 |
212 |
C |
213 |
100 CONTINUE |
214 |
NCL2(N,J) = IGIRO |
215 |
ENDDO |
216 |
ENDDO |
217 |
C |
218 |
RETURN |
219 |
END |
220 |
|