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

Annotation of /calo/ground/LEVEL2/src/crcalol2.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: MAIN
Branch point for: LEVEL2
Initial revision

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