/[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.5 - (hide annotations) (download)
Mon Mar 20 10:12:14 2006 UTC (18 years, 8 months ago) by mocchiut
Branch: MAIN
CVS Tags: v4r04, HEAD
Changes since 1.4: +2 -2 lines
Error in x/y plane distance in the core routine fixed

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 mocchiut 1.2 PIANO(I) = PIANO(I-1) - 8.09
93 mocchiut 1.1 ELSE
94 mocchiut 1.2 PIANO(I) = PIANO(I-1) - 10.09
95 mocchiut 1.1 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 mocchiut 1.4 c print *,'trigty = ',trigty
144     C
145 mocchiut 1.1 DO I = 1,22
146     DO J = 1,96
147 mocchiut 1.4 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 mocchiut 1.1 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 mocchiut 1.5 DISTX = PIANO(I) - 5.81
220 mocchiut 1.1 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 mocchiut 1.5 DISTX = PIANO(I) - 5.81 + ZALIG ! Z ALIGNEMENT FACTOR
266 mocchiut 1.1 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