/[PAMELA software]/calo/ground/LEVEL2/src/cluster.for
ViewVC logotype

Contents of /calo/ground/LEVEL2/src/cluster.for

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (show annotations) (download)
Mon Dec 5 16:13:54 2005 UTC (19 years ago) by mocchiut
Branch point for: LEVEL2, MAIN
Initial revision

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

  ViewVC Help
Powered by ViewVC 1.1.23