/[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.4 - (show annotations) (download)
Thu Mar 9 15:55:30 2006 UTC (18 years, 9 months ago) by mocchiut
Branch: MAIN
Changes since 1.3: +4 -4 lines
Last ground software main release, the code is freezed only major bugs will be fixed

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

  ViewVC Help
Powered by ViewVC 1.1.23