1 |
***************************************************************************** |
2 |
INTEGER FUNCTION CRCALOL2() |
3 |
c |
4 |
IMPLICIT NONE |
5 |
C |
6 |
INCLUDE 'INTEST.TXT' |
7 |
C |
8 |
integer ICONTROL5 |
9 |
INTEGER j, m, ii, nn |
10 |
INTEGER i |
11 |
INTEGER IPLANE, NNX, NNY, INFX, INFY, ISUPX, ISUPY |
12 |
INTEGER IBAR(2,NPLA) |
13 |
integer ifail |
14 |
INTEGER nin |
15 |
INTEGER good2 |
16 |
c LOGICAL good2 |
17 |
c REAL hsh |
18 |
double precision al_pp(2,5), al_p(5) |
19 |
& , xout(npla),yout(npla),zin(npla) |
20 |
REAL PIANO(22) |
21 |
C |
22 |
REAL TX, TY |
23 |
REAL timpx, timpy |
24 |
REAL TG(2) |
25 |
REAL SHIFT |
26 |
REAL BAR(2,NPLA) |
27 |
REAL DISTX, DISTY, Y(NPLA), YY(NPLA) |
28 |
REAL CX, CY |
29 |
REAL RIG, PLANEMAX, RMASS |
30 |
REAL RNSS, QTOTT, RQT |
31 |
REAL CHECK |
32 |
REAL ENER |
33 |
c |
34 |
integer INDEX, NTOT(2), NPIANI,gtr,t |
35 |
integer trkchi2 |
36 |
c |
37 |
REAL EINF, ESUP, RPIANO(2) |
38 |
|
39 |
COMMON/TAGLIOEN/EINF,ESUP,ENER(2) |
40 |
SAVE /TAGLIOEN/ |
41 |
C |
42 |
REAL estrip(2,22,96), ispaw |
43 |
c real ab |
44 |
C parameter(AB=25.) |
45 |
c parameter(AB=260.) |
46 |
real zalig, xalig, yalig |
47 |
C |
48 |
COMMON /SHIFT/ SHIFT |
49 |
SAVE / SHIFT / |
50 |
C |
51 |
COMMON/ANGOLO/BAR,IBAR |
52 |
SAVE / ANGOLO / |
53 |
C |
54 |
COMMON/WHERE/CX,CY,PIANO |
55 |
SAVE / WHERE / |
56 |
C |
57 |
COMMON/GENERAL/RIG,RMASS |
58 |
SAVE / GENERAL / |
59 |
|
60 |
COMMON / CH / CHECK |
61 |
SAVE / CH / |
62 |
C |
63 |
COMMON / clevel1 / al_pp,estrip, ispaw,good2, |
64 |
& trkchi2, xalig, yalig, zalig |
65 |
SAVE / clevel1 / |
66 |
|
67 |
REAL VARFIT(2) |
68 |
INTEGER NPFIT(2) |
69 |
COMMON/CALOFIT/VARFIT,NPFIT |
70 |
SAVE/CALOFIT/ |
71 |
|
72 |
REAL hmemor(9000000) |
73 |
integer Iquest(100) |
74 |
COMMON /pawcd/hmemor |
75 |
save /pawcd/ |
76 |
C |
77 |
Common /QUESTd/ Iquest |
78 |
save /questd/ |
79 |
|
80 |
C |
81 |
C Begin ! |
82 |
C |
83 |
CRCALOL2 = 0; |
84 |
RMASS = 0.938 |
85 |
C |
86 |
C IF (.not.GOOD2.OR..not.GCRC) goto 9696 |
87 |
c print *,' good2 ',good2,' al_p(5) ',AL_P(5) |
88 |
C |
89 |
PIANO(1) = 0. |
90 |
DO I = 2, 22 |
91 |
IF ( MOD(I,2).EQ.0 ) THEN |
92 |
PIANO(I) = PIANO(I-1) - 8.09 |
93 |
ELSE |
94 |
PIANO(I) = PIANO(I-1) - 10.09 |
95 |
ENDIF |
96 |
ENDDO |
97 |
C |
98 |
CALL VZERO(DEXY,2*LENSEV) |
99 |
CALL VZERO(BAR,2*NPLA) |
100 |
CALL VZERO(IBAR,2*NPLA) |
101 |
CALL VZERO(TBAR,2*NPLA) |
102 |
CALL VZERO(TIBAR,2*NPLA) |
103 |
CALL VZERO(CBAR,2*NPLA) |
104 |
CALL VZERO(CIBAR,2*NPLA) |
105 |
CALL VZERO(QQ,4) |
106 |
CALL VZERO(Y,NPLA) |
107 |
CALL VZERO(YY,NPLA) |
108 |
CALL VZERO(XOUT,NPLA) |
109 |
CALL VZERO(YOUT,NPLA) |
110 |
QLOW = 0. |
111 |
NLOW = 0. |
112 |
NCORE = 0. |
113 |
QCORE = 0. |
114 |
NSTRIP = 0. |
115 |
QTOT = 0. |
116 |
NX22 = 0. |
117 |
QX22 = 0. |
118 |
NINT = 0. |
119 |
QCYL = 0. |
120 |
NCYL = 0. |
121 |
QTR = 0. |
122 |
NTR = 0. |
123 |
QLAST = 0. |
124 |
QTRACK = 0. |
125 |
QMAX = 0. |
126 |
QPRESH = 0. |
127 |
NPRESH = 0. |
128 |
QMAX = 0. |
129 |
QTRACKX = 0. |
130 |
QTRACKY = 0. |
131 |
DXTRACK = 0. |
132 |
DYTRACK = 0. |
133 |
QPRE = 0. |
134 |
NPRE = 0. |
135 |
NLAST = 0. |
136 |
GTR = 0 |
137 |
C |
138 |
IF (GOOD2.EQ.0.AND.TRIGTY.NE.2) goto 9696 |
139 |
C |
140 |
DISTX = 0. |
141 |
DISTY = 0. |
142 |
C |
143 |
DO I = 1,22 |
144 |
DO J = 1,96 |
145 |
IF ( MOD(I,2).NE.0 ) THEN |
146 |
IF ( ESTRIP(2,I,J).GT.EMIN ) THEN |
147 |
DEXY(2,I,J) = ESTRIP(2,I,J) |
148 |
NSTRIP = NSTRIP + 1. |
149 |
QTOT = QTOT + ESTRIP(2,I,J) |
150 |
IF (I.LT.11) QQ(1) = QQ(1) + ESTRIP(2,I,J) |
151 |
ENDIF |
152 |
IF ( ESTRIP(1,I,J).GT.EMIN ) THEN |
153 |
DEXY(1,I,J) = ESTRIP(1,I,J) |
154 |
NSTRIP = NSTRIP + 1. |
155 |
QTOT = QTOT + ESTRIP(1,I,J) |
156 |
if (i.lt.11) QQ(2) = QQ(2) + ESTRIP(1,I,J) |
157 |
ENDIF |
158 |
ENDIF |
159 |
IF ( MOD(I,2).EQ.0 ) THEN |
160 |
IF (ESTRIP(2,I,J).GT.EMIN) THEN |
161 |
DEXY(2,I,J) = ESTRIP(2,I,J) |
162 |
NSTRIP = NSTRIP + 1. |
163 |
QTOT = QTOT + ESTRIP(2,I,J) |
164 |
if (i.lt.11) QQ(3) = QQ(3) + ESTRIP(2,I,J) |
165 |
ENDIF |
166 |
IF (ESTRIP(1,I,J).GT.EMIN) THEN |
167 |
DEXY(1,I,J) = ESTRIP(1,I,J) |
168 |
NSTRIP = NSTRIP + 1. |
169 |
QTOT = QTOT + ESTRIP(1,I,J) |
170 |
IF (I.EQ.22) THEN |
171 |
NX22 = NX22 + 1. |
172 |
QX22 = QX22 + ESTRIP(1,I,J) |
173 |
ENDIF |
174 |
IF (I.LT.11) QQ(4) = QQ(4) + ESTRIP(1,I,J) |
175 |
ENDIF |
176 |
ENDIF |
177 |
ENDDO |
178 |
ENDDO |
179 |
C |
180 |
C determine variables only if we have a good track |
181 |
C |
182 |
if (good2.eq.1.or.trigty.eq.2) then |
183 |
CALL CLUSTER |
184 |
CALL DIRECTION(TG) |
185 |
THEX = TG(1) |
186 |
THEY = TG(2) |
187 |
varcfit(1) = varfit(1) |
188 |
varcfit(2) = varfit(2) |
189 |
npcfit(1) = npfit(1) |
190 |
npcfit(2) = npfit(2) |
191 |
IMPX = CX |
192 |
IMPY = CY |
193 |
SHIFT = -0.5 |
194 |
CALL LASTRISCIA(CX,II) |
195 |
SHIFT = +0.5 |
196 |
CALL LASTRISCIA(CY,II) |
197 |
TANX = TG(1) |
198 |
TANY = TG(2) |
199 |
C |
200 |
DO M = 1,2 |
201 |
DO I = 1,NPLA |
202 |
NN = 0 |
203 |
IF (M.EQ.2) NN = 1 |
204 |
IF (MOD(I,2).EQ.NN) THEN |
205 |
SHIFT = +0.5 |
206 |
ELSE |
207 |
SHIFT = -0.5 |
208 |
ENDIF |
209 |
C |
210 |
c IF (MOD(M,2).EQ.0) THEN |
211 |
c ELSE |
212 |
c ENDIF |
213 |
C |
214 |
IF (M.EQ.1) THEN |
215 |
DISTX = PIANO(I) - 5.1 |
216 |
Y(I) = DISTX * TG(1) + CX |
217 |
BAR(M,I) = Y(I) |
218 |
CBAR(M,I) = Y(I) |
219 |
c print *,' cbar ',m,i,cbar(m,i) |
220 |
C |
221 |
ELSE |
222 |
DISTY = PIANO(I) |
223 |
YY(I) = DISTY * TG(2) + CY |
224 |
BAR(M,I) = YY(I) |
225 |
CBAR(M,I) = YY(I) |
226 |
c print *,'cy ',cy,' disty ',disty,' tg ', |
227 |
c & tg(2),' cbar ',m,i,cbar(m,i) |
228 |
C |
229 |
ENDIF |
230 |
CALL LASTRISCIA(BAR(M,I),IBAR(M,I)) |
231 |
c CBAR(M,I) = bar(m,i) |
232 |
cibar(M,I) = ibar(m,i) |
233 |
ENDDO |
234 |
ENDDO |
235 |
C |
236 |
if (trigty.eq.2) goto 6996 |
237 |
C |
238 |
do t = 1,2 |
239 |
CALL VZERO(BAR,2*NPLA) |
240 |
CALL VZERO(IBAR,2*NPLA) |
241 |
CALL VZERO(TBAR,2*NPLA) |
242 |
CALL VZERO(TIBAR,2*NPLA) |
243 |
do m = 1, 5 |
244 |
al_p(m) = al_pp(t,m) |
245 |
enddo |
246 |
if (al_p(5).eq.0.) goto 9696 |
247 |
DO M = 1,2 |
248 |
DO I = 1,NPLA |
249 |
C if (M.eq.1) then |
250 |
C hsh = 1.3 |
251 |
C else |
252 |
C hsh = -1.3 |
253 |
C endif |
254 |
C DISTX = -PIANO * (I - 1.) - AB +HSH -235. ! Z ALIGNEMENT FACTORS |
255 |
C |
256 |
XOUT(I) = 0. |
257 |
YOUT(I) = 0. |
258 |
IF (MOD(M,2).EQ.0) THEN |
259 |
DISTX = PIANO(I) + ZALIG ! Z ALIGNEMENT FACTOR |
260 |
ELSE |
261 |
DISTX = PIANO(I) - 5.1 + ZALIG ! Z ALIGNEMENT FACTOR |
262 |
C |
263 |
ENDIF |
264 |
ZIN(I) = distx / 10. |
265 |
c print *,' zin ',i,' ',zin(i) |
266 |
C |
267 |
TBAR(M,I) = 0. |
268 |
TIBAR(M,I) = 0 |
269 |
C |
270 |
enddo |
271 |
IFAIL = 0 |
272 |
c print *,' al ',al_p(1),al_p(2),al_p(3),al_p(4),al_p(5) |
273 |
call TRACK(NPLA,ZIN,XOUT,YOUT,AL_P,IFAIL) |
274 |
if(IFAIL.ne.0)then |
275 |
good2 = 0 |
276 |
good = 0 |
277 |
print *,' Tracking error (ifail not zero)!!!' |
278 |
c goto 6996 |
279 |
if (t.eq.2) goto 9696 |
280 |
goto 969 |
281 |
endif |
282 |
TX = TAN(ASIN(AL_P(3))) * COS(AL_P(4)) |
283 |
TY = TAN(ASIN(AL_P(3))) * SIN(AL_P(4)) |
284 |
DO I = 1, NPLA |
285 |
NN = 0 |
286 |
IF (M.EQ.2) NN = 1 |
287 |
IF (MOD(I,2).EQ.NN) THEN |
288 |
SHIFT = +0.5 |
289 |
ELSE |
290 |
SHIFT = -0.5 |
291 |
ENDIF |
292 |
C |
293 |
C CHECK IF XOUT OR YOUT ARE NaN |
294 |
C |
295 |
IF (XOUT(I).NE.XOUT(I).OR.YOUT(I).NE.YOUT(I)) THEN |
296 |
print *,' Tracking error (NaN values)!!!' |
297 |
GOOD2 = 0 |
298 |
GOOD = 0 |
299 |
if (t.eq.2) goto 9696 |
300 |
goto 969 |
301 |
ENDIF |
302 |
CX = XOUT(I)*10. + XALIG !+ 120.4 ! X ALIGNEMENT FACTOR |
303 |
CY = -YOUT(I)*10. + YALIG ! 118.6 ! Y ALIGNEMENT FACTOR |
304 |
c |
305 |
IF (I.EQ.1) THEN |
306 |
TIMPX = CX |
307 |
TIMPY = CY |
308 |
ENDIF |
309 |
IF (M.EQ.1) THEN |
310 |
Y(I) = CX |
311 |
BAR(M,I) = Y(I) |
312 |
TBAR(M,I) = Y(I) |
313 |
c print *,'tbar ',m,i,' ',tbar(m,i),' cx ',cx,' xout ' |
314 |
c & ,xout(i) |
315 |
ELSE |
316 |
YY(I) = CY |
317 |
BAR(M,I) = YY(I) |
318 |
TBAR(M,I) = YY(I) |
319 |
c print *,'tbar ',m,i,' ',tbar(m,i),' cy ',cy,' yout ' |
320 |
c & ,yout(i) |
321 |
ENDIF |
322 |
CALL LASTRISCIA(BAR(M,I),IBAR(M,I)) |
323 |
tibar(M,I) = ibar(m,i) |
324 |
ENDDO |
325 |
ENDDO |
326 |
969 continue |
327 |
if (npfit(2).gt.15.and.varfit(2).lt.1000) then |
328 |
if ( abs(tbar(2,1)-tbar(2,2))<40.) then |
329 |
GTR = t |
330 |
goto 6996 |
331 |
else |
332 |
if ( t.eq.2 ) goto 9696 |
333 |
endif |
334 |
else |
335 |
if (t.eq.trkchi2) goto 6996 |
336 |
if (t.eq.2) goto 9696 |
337 |
endif |
338 |
enddo |
339 |
ELSE |
340 |
GOTO 9696 |
341 |
endif |
342 |
6996 CONTINUE |
343 |
C |
344 |
C RIG IS RIGIDITY AS DETERMINED BY THE TRACKER |
345 |
C OR by CALORIMETER IF IN SELFTRIGGER MODE |
346 |
C |
347 |
if (trigty.ne.2) then |
348 |
IF ( AL_PP(GTR,5).NE.0 ) THEN |
349 |
RIG = 1./(AL_PP(GTR,5)) |
350 |
ELSE |
351 |
RIG = 1000. |
352 |
ENDIF |
353 |
else |
354 |
RIG = 1000. |
355 |
endif |
356 |
C |
357 |
RNSS = 0. |
358 |
QTOTT = 0. |
359 |
PLANEMAX = 1.01*(LOG(ABS(RIG)/0.0081)-1.) |
360 |
IPLANE = INT(ANINT(PLANEMAX)) + 5 |
361 |
IF (IPLANE.GT.NPLA) IPLANE=NPLA |
362 |
DO J = 1,IPLANE |
363 |
NNX = IBAR(1,J) |
364 |
NNY = IBAR(2,J) |
365 |
IF (NNX.LT.9) NNX = 9 |
366 |
IF (NNY.LT.9) NNY = 9 |
367 |
IF (NNX.GT.88) NNX = 88 |
368 |
IF (NNY.GT.88) NNY = 88 |
369 |
INFX = NNX - 8 |
370 |
INFY = NNY - 8 |
371 |
C |
372 |
C 8 STRIPS ARE 2.88 cm , A MOLIERE RADIUS IS ABOUT 0.7 cm . |
373 |
C |
374 |
ISUPX = NNX + 8 |
375 |
ISUPY = NNY + 8 |
376 |
DO I = INFX,ISUPX |
377 |
IF (DEXY(1,J,I).GE.EMIN) THEN |
378 |
RNSS = RNSS + 1 |
379 |
QTOTT = QTOTT + DEXY(1,J,I) |
380 |
ENDIF |
381 |
ENDDO |
382 |
DO I = INFY,ISUPY |
383 |
IF (DEXY(2,J,I).GE.EMIN) THEN |
384 |
RNSS = RNSS + 1 |
385 |
QTOTT = QTOTT + DEXY(2,J,I) |
386 |
ENDIF |
387 |
ENDDO |
388 |
NCORE = RNSS * FLOAT(J) + NCORE |
389 |
QCORE = QTOTT * FLOAT(J) + QCORE |
390 |
ENDDO |
391 |
C |
392 |
QTOTT = 0. |
393 |
RNSS = 0. |
394 |
DO J = IPLANE,NPLA |
395 |
DO I = 1,NCHA |
396 |
IF (DEXY(1,J,I).GE.EMIN) THEN |
397 |
RNSS = RNSS + 1 |
398 |
QTOTT = QTOTT + DEXY(1,J,I) |
399 |
ENDIF |
400 |
IF (DEXY(2,J,I).GE.EMIN) THEN |
401 |
RNSS = RNSS + 1 |
402 |
QTOTT = QTOTT + DEXY(2,J,I) |
403 |
ENDIF |
404 |
ENDDO |
405 |
ENDDO |
406 |
QLOW = QTOTT |
407 |
NLOW = RNSS |
408 |
C |
409 |
CALL NOINT(NIN) ! if NINT=1 not interacting particle |
410 |
NINT = FLOAT(NIN) |
411 |
C |
412 |
C |
413 |
C QCYL = DETECTED ENERGY AND NCYL = NUMBER OF HIT STRIPS IN A CYLINDER oF |
414 |
C RADIUS 8.5 STRIPS WITH AXIS DEFINED BY THE DIRECTION OF THE INCOMING |
415 |
C PARTICLE . |
416 |
C |
417 |
DO J = 1,NPLA |
418 |
C |
419 |
NNX = IBAR(1,J) |
420 |
NNY = IBAR(2,J) |
421 |
IF (NNX.LT.9) NNX = 9 |
422 |
IF (NNY.LT.9) NNY = 9 |
423 |
IF (NNX.GT.88) NNX = 88 |
424 |
IF (NNY.GT.88) NNY = 88 |
425 |
INFX = NNX - 8 |
426 |
INFY = NNY - 8 |
427 |
C |
428 |
C 8 STRIPS ARE 2.88 cm , A MOLIERE RADIUS IS ABOUT 0.7 cm . |
429 |
C |
430 |
ISUPX = NNX + 8 |
431 |
ISUPY = NNY + 8 |
432 |
DO I = INFX,ISUPX |
433 |
IF (DEXY(1,J,I).LT.EMIN) GO TO 710 |
434 |
NCYL = NCYL + 1 |
435 |
QCYL = QCYL + DEXY(1,J,I) |
436 |
710 ENDDO |
437 |
DO I=INFY,ISUPY |
438 |
IF (DEXY(2,J,I).LT.EMIN) GO TO 810 |
439 |
NCYL = NCYL + 1 |
440 |
QCYL = QCYL + DEXY(2,J,I) |
441 |
810 ENDDO |
442 |
ENDDO |
443 |
C |
444 |
C QTR = DETECTED ENERGY AND NTR = NUMBER OF HIT STRIPS IN A CYLINDER oF |
445 |
C RADIUS 4.5 STRIPS WITH AXIS DEFINED BY THE DIRECTION OF THE INCOMING |
446 |
C PARTICLE . |
447 |
C |
448 |
DO I = 1,NPLA |
449 |
C |
450 |
NNX = IBAR(1,I) |
451 |
NNY = IBAR(2,I) |
452 |
IF (NNX.LT.5) NNX = 5 |
453 |
IF (NNY.LT.5) NNY = 5 |
454 |
IF (NNX.GT.92) NNX = 92 |
455 |
IF (NNY.GT.92) NNY = 92 |
456 |
INFX = NNX - 4 |
457 |
INFY = NNY - 4 |
458 |
C |
459 |
C 8 STRIPS ARE 2.88 cm , A MOLIERE RADIUS IS ABOUT 0.7 cm . |
460 |
C |
461 |
ISUPX = NNX + 4 |
462 |
ISUPY = NNY + 4 |
463 |
DO J = INFX,ISUPX |
464 |
IF (DEXY(1,I,J).GT.EMIN) THEN |
465 |
NTR = NTR + 1 |
466 |
QTR = QTR + DEXY(1,I,J) |
467 |
ENDIF |
468 |
ENDDO |
469 |
DO J = INFY,ISUPY |
470 |
IF (DEXY(2,I,J).GT.EMIN) THEN |
471 |
NTR = NTR + 1 |
472 |
QTR = QTR + DEXY(2,I,J) |
473 |
ENDIF |
474 |
ENDDO |
475 |
ENDDO |
476 |
C |
477 |
CALL LATERALE(QTRACK,RQT) |
478 |
C |
479 |
DO M = 1,2 |
480 |
DO I = 1,NPLA |
481 |
DO J = 1,NCHA |
482 |
IF (DEXY(M,I,J).GT.QMAX) QMAX = DEXY(M,I,J) |
483 |
ENDDO |
484 |
ENDDO |
485 |
ENDDO |
486 |
C |
487 |
|
488 |
DO I = 1,4 |
489 |
C |
490 |
NNX = IBAR(1,I) |
491 |
NNY = IBAR(2,I) |
492 |
IF (NNX.LT.3) NNX = 3 |
493 |
IF (NNY.LT.3) NNY = 3 |
494 |
IF (NNX.GT.94) NNX = 94 |
495 |
IF (NNY.GT.94) NNY = 94 |
496 |
INFX = NNX - 2 |
497 |
INFY = NNY - 2 |
498 |
C |
499 |
C 8 STRIPS ARE 2.88 cm , A MOLIERE RADIUS IS ABOUT 0.7 cm . |
500 |
C |
501 |
ISUPX = NNX + 2 |
502 |
ISUPY = NNY + 2 |
503 |
DO J = INFX,ISUPX |
504 |
IF (DEXY(1,I,J).GE.EMIN) THEN |
505 |
NPRESH = NPRESH + 1 |
506 |
QPRESH = QPRESH + DEXY(1,I,J) |
507 |
ENDIF |
508 |
ENDDO |
509 |
DO J = INFY,ISUPY |
510 |
IF (DEXY(2,I,J).GE.EMIN) THEN |
511 |
NPRESH = NPRESH + 1 |
512 |
QPRESH = QPRESH + DEXY(2,I,J) |
513 |
ENDIF |
514 |
ENDDO |
515 |
ENDDO |
516 |
C |
517 |
DO M = 1,2 |
518 |
DO I = 1,NPLA |
519 |
DO J = 1,NCHA |
520 |
IF (DEXY(M,I,J).GT.QMAX) QMAX = DEXY(M,I,J) |
521 |
ENDDO |
522 |
ENDDO |
523 |
ENDDO |
524 |
C |
525 |
ICONTROL5 = 0 |
526 |
CALL NSHOWER(ICONTROL5,DXTRACK,DYTRACK,QTRACKX,QTRACKY) |
527 |
C |
528 |
DO J = 1,3 |
529 |
C |
530 |
NNX = IBAR(1,J) |
531 |
NNY = IBAR(2,J) |
532 |
IF (NNX.LT.9) NNX = 9 |
533 |
IF (NNY.LT.9) NNY = 9 |
534 |
IF (NNX.GT.88) NNX = 88 |
535 |
IF (NNY.GT.88) NNY = 88 |
536 |
INFX = NNX - 8 |
537 |
INFY = NNY - 8 |
538 |
ISUPX = NNX + 8 |
539 |
ISUPY = NNY + 8 |
540 |
DO I = INFX,ISUPX |
541 |
IF (DEXY(1,J,I).GE.EMIN) THEN |
542 |
NPRE = NPRE + 1 |
543 |
QPRE = QPRE + DEXY(1,J,I) |
544 |
ENDIF |
545 |
ENDDO |
546 |
DO I=INFY,ISUPY |
547 |
IF (DEXY(2,J,I).GE.EMIN) THEN |
548 |
NPRE = NPRE + 1 |
549 |
QPRE = QPRE + DEXY(2,J,I) |
550 |
ENDIF |
551 |
ENDDO |
552 |
ENDDO |
553 |
C |
554 |
DO J = NPLA-4,NPLA |
555 |
C |
556 |
NNX = IBAR(1,J) |
557 |
NNY = IBAR(2,J) |
558 |
IF (NNX.LT.9) NNX = 9 |
559 |
IF (NNY.LT.9) NNY = 9 |
560 |
IF (NNX.GT.88) NNX = 88 |
561 |
IF (NNY.GT.88) NNY = 88 |
562 |
INFX = NNX - 8 |
563 |
INFY = NNY - 8 |
564 |
ISUPX = NNX + 8 |
565 |
ISUPY = NNY + 8 |
566 |
DO I = INFX,ISUPX |
567 |
IF (DEXY(1,J,I).GE.EMIN) THEN |
568 |
NLAST = NLAST + 1 |
569 |
QLAST = QLAST + DEXY(1,J,I) |
570 |
ENDIF |
571 |
ENDDO |
572 |
DO I=INFY,ISUPY |
573 |
IF (DEXY(2,J,I).GE.EMIN) THEN |
574 |
NLAST = NLAST + 1 |
575 |
QLAST = QLAST + DEXY(2,J,I) |
576 |
ENDIF |
577 |
ENDDO |
578 |
ENDDO |
579 |
C |
580 |
EINF = EMIN |
581 |
ESUP = 50. |
582 |
C |
583 |
DO M = 1,2 |
584 |
RPIANO(M) = 0. |
585 |
NTOT(M) = 0 |
586 |
ENDDO |
587 |
NPIANI = 5 |
588 |
QMEAN = 0. |
589 |
INDEX = 0 |
590 |
CALL ELIO(RPIANO,NPIANI,QMEAN,NTOT,INDEX) |
591 |
PLANETOT = RPIANO(1) + RPIANO(2) |
592 |
C |
593 |
C |
594 |
C |
595 |
c print *,'prima hfnt ' |
596 |
c print *,' trigty ',trigty |
597 |
c print *,' qtot ',qtot |
598 |
c print *,' nstrip ',nstrip |
599 |
c print *,' ncore ',ncore |
600 |
c print *,' qcore ',qcore |
601 |
c print *,' impx ',impx |
602 |
c print *,' impy ',impy |
603 |
c print *,' tany ',tany |
604 |
c print *,' tanx ',tanx |
605 |
c print *,' nint ',nint |
606 |
c print *,' ncyl ',ncyl |
607 |
c print *,' qcyl ',qcyl |
608 |
c print *,' qtrack ',qtrack |
609 |
c print *,' qmax ',qmax |
610 |
c print *,' qx22 ',qx22 |
611 |
c print *,' nx22 ',nx22 |
612 |
c print *,' qq(1) ',qq(1) |
613 |
c print *,' qq(1) ',qq(2) |
614 |
c print *,' qq(1) ',qq(3) |
615 |
c print *,' qq(1) ',qq(4) |
616 |
c print *,' qtrackx ',qtrackx |
617 |
c print *,' qtrackx ',qtracky |
618 |
c print *,' dxtrack ',dxtrack |
619 |
c print *,' dxtrack ',dytrack |
620 |
c print *,' qlast ',qlast |
621 |
c print *,' nlast ',nlast |
622 |
c print *,' qpre ',qpre |
623 |
c print *,' npre ',npre |
624 |
c print *,' qpresh ',qpresh |
625 |
c print *,' npresh ',npresh |
626 |
c print *,' qlow ',qlow |
627 |
c print *,' nlow ',nlow |
628 |
c print *,' qtr ',qtr |
629 |
c print *,' ntr ',ntr |
630 |
c print *,' planetot ',planetot |
631 |
c print *,' qmean ',qmean |
632 |
c do i = 1, 2 |
633 |
c do j = 1, 22 |
634 |
c print *,' cibar ',i,j,cibar(i,j) |
635 |
c print *,' tibar ',i,j,tibar(i,j) |
636 |
c print *,' cbar ',i,j,cbar(i,j) |
637 |
c print *,' tbar ',i,j,tbar(i,j) |
638 |
c enddo |
639 |
c enddo |
640 |
|
641 |
9696 CONTINUE |
642 |
C |
643 |
IF (ispaw.eq.1.) call hfnt(1) |
644 |
c print *,'dopo hfnt ' |
645 |
C |
646 |
|
647 |
45 continue |
648 |
|
649 |
50 continue |
650 |
|
651 |
return |
652 |
END |
653 |
|
654 |
|
655 |
C |
656 |
C--------------------------------------------------------------------- |
657 |
SUBROUTINE LATERALE(RQT1,RQT2) |
658 |
C--------------------------------------------------------------------- |
659 |
C RQT1 (IT WILL BE CALLED QTRACK IN THE N-TUPLE) IS THE SUM OF THE DETECTED |
660 |
C ENERGY IN THE STRIP ALONG THE TRACK AND THE TWO CLOSEST STRIPS . FOR ALL THE |
661 |
C LAYERS . RQT2 (IS NOT USED IN THE N-TUPLA) IS THE TOTAL ENERGY MINUS RQT1 . |
662 |
C |
663 |
INCLUDE 'INTEST.TXT' |
664 |
REAL RQT1 |
665 |
INTEGER A,B |
666 |
REAL BAR(2,NPLA) |
667 |
REAL Q(0:NPLA) |
668 |
INTEGER IBAR(2,NPLA) |
669 |
COMMON/ANGOLO/BAR,IBAR |
670 |
|
671 |
RQT2=0. |
672 |
|
673 |
INPIA = 1 |
674 |
C |
675 |
QQQ=0 |
676 |
MAX=0 |
677 |
Q(MAX)=0 |
678 |
C |
679 |
DO I = INPIA,NPLA |
680 |
A = IBAR(1,I) |
681 |
B = IBAR(2,I) |
682 |
IF (A.LE.2) A = 3 |
683 |
IF (B.LE.2) B = 3 |
684 |
IF (A.GE.(NCHA-1)) A = NCHA - 2 |
685 |
IF (B.GE.(NCHA-1)) B = NCHA - 2 |
686 |
|
687 |
DO J = A-1,A+1 |
688 |
IF (DEXY(1,I,J).GE.EMIN) RQT1 = RQT1 + DEXY(1,I,J) |
689 |
600 ENDDO |
690 |
C |
691 |
DO J = B-1,B+1 |
692 |
IF (DEXY(2,I,J).GE.EMIN) RQT1 = RQT1 + DEXY(2,I,J) |
693 |
ENDDO |
694 |
C |
695 |
DO J=1,A-2 |
696 |
PXY = DEXY(1,I,J) |
697 |
IF (PXY.GE.EMIN) RQT2 = RQT2 + PXY |
698 |
650 ENDDO |
699 |
C |
700 |
DO J=A+2,NCHA |
701 |
PXY = DEXY(1,I,J) |
702 |
IF (PXY.GE.EMIN) RQT2 = RQT2 + PXY |
703 |
700 ENDDO |
704 |
C |
705 |
DO J=1,B-2 |
706 |
PXY = DEXY(2,I,J) |
707 |
IF (PXY.GE.EMIN) RQT2 = RQT2 + PXY |
708 |
750 ENDDO |
709 |
C |
710 |
DO J=B+2,NCHA |
711 |
PXY = DEXY(2,I,J) |
712 |
IF (PXY.GE.EMIN) RQT2 = RQT2 + PXY |
713 |
800 ENDDO |
714 |
C |
715 |
ENDDO |
716 |
C |
717 |
C |
718 |
400 RETURN |
719 |
END |
720 |
|
721 |
|