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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1.1.1 - (show annotations) (download) (vendor branch)
Mon Dec 5 16:13:54 2005 UTC (19 years ago) by mocchiut
Branch: LEVEL2
CVS Tags: v4r00, start
Changes since 1.1: +0 -0 lines
Imported sources

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.42
93 ELSE
94 PIANO(I) = PIANO(I-1) - 9.76
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

  ViewVC Help
Powered by ViewVC 1.1.23