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

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

Parent Directory Parent Directory | Revision Log Revision Log


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

1 mocchiut 1.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