/[PAMELA software]/DarthVader/CalorimeterLevel2/src/calol2tr.for
ViewVC logotype

Annotation of /DarthVader/CalorimeterLevel2/src/calol2tr.for

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (hide annotations) (download)
Tue May 30 14:57:59 2006 UTC (18 years, 6 months ago) by mocchiut
Branch: MAIN
Changes since 1.1: +16 -8 lines
Small change in the calculation of qlast and nlast variables

1 mocchiut 1.1 *****************************************************************************
2     INTEGER FUNCTION CALOL2TR()
3     c
4     IMPLICIT NONE
5     C
6     INCLUDE 'INTEST.TXT'
7     C
8     DOUBLE PRECISION al_p(5),
9     & xout(npla),yout(npla),zin(npla)
10     C
11     REAL PIANO(22), VARFIT(2)
12     REAL TX, TY, SHIFT
13     REAL BAR(2,NPLA), DISTY
14     REAL DISTX, Y(NPLA), YY(NPLA)
15     REAL RIG, PPLANEMAX, RMASS
16     REAL RNSS, QTOTT, RQT, MX, MY
17     REAL CHECK, ENER, CX, CY
18     REAL EINF, ESUP, RPIANO(2)
19     REAL hmemor(9000000), X01PL
20     C
21     REAL ax,bx,eax,ebx,chi2x
22     REAL ay,by,eay,eby,chi2y
23     REAL parzen3, TMISD
24     INTEGER Nfitx,Nfity
25     C
26     INTEGER INDEX, NTOT(2), NPIANI, GTR
27     INTEGER j, m, i, IWPL(2), timpx, timpy, T, nn
28     INTEGER IPLANE, NNX, NNY, INFX, INFY, ISUPX, ISUPY
29     INTEGER IBAR(2,NPLA), NPFIT(2), CHTRACK,IWPLU
30     INTEGER Iquest(100), ICONTROL5, nin, IFAIL
31     C
32     PARAMETER (X01PL=0.74)
33     C
34    
35     C
36     COMMON / slftrig / tmisd,ax,bx,eax,ebx,chi2x,Nfitx,ay,by,eay,eby,
37     & chi2y,Nfity,parzen3
38     SAVE / slftrig /
39     C
40     COMMON / TAGLIOEN / EINF, ESUP, ENER(2)
41     SAVE / TAGLIOEN /
42     C
43     COMMON / SHIFT / SHIFT
44     SAVE / SHIFT /
45     C
46     COMMON / ANGOLO / BAR, IBAR
47     SAVE / ANGOLO /
48     C
49     COMMON / WHERE / CX, CY, PIANO
50     SAVE / WHERE /
51     C
52     COMMON / GENERAL / RIG, RMASS
53     SAVE / GENERAL /
54     C
55     COMMON / CH / CHECK
56     SAVE / CH /
57     C
58     COMMON / CALOFIT / VARFIT, NPFIT
59     SAVE / CALOFIT /
60     C
61     COMMON / pawcd / hmemor
62     save / pawcd /
63     C
64     Common / QUESTd / Iquest
65     save / questd /
66     C
67     C Begin !
68     C
69     CALOL2TR = 0;
70     NCORE = 0.
71     QCORE = 0.
72     NOINT = 0.
73     QCYL = 0.
74     NCYL = 0.
75     QLOW = 0.
76     NLOW = 0.
77     QTR = 0.
78     NTR = 0.
79     QLAST = 0.
80     QTRACK = 0.
81     QPRESH = 0.
82     NPRESH = 0.
83     QTRACKX = 0.
84     QTRACKY = 0.
85     DXTRACK = 0.
86     DYTRACK = 0.
87     QPRE = 0.
88     NPRE = 0.
89     NLAST = 0.
90     PLANETOT = 0.
91     QMEAN = 0.
92     SELFTRIGGER = 0
93     CALL VZERO(VARCFIT,2)
94     CALL VZERO(NPCFIT,2)
95     CALL VZERO(TBAR,2*NPLA)
96     CALL VZERO(TIBAR,2*NPLA)
97     CALL VZERO(BAR,2*NPLA)
98     CALL VZERO(IBAR,2*NPLA)
99     CALL VZERO(IBAR,2*NPLA)
100     CALL VZERO(Y,NPLA)
101     CALL VZERO(YY,NPLA)
102     CALL VZERO(XOUT,NPLA)
103     CALL VZERO(YOUT,NPLA)
104     C
105     C BEGIN WITH THE FISRT TRACK IF WE HAVE A TRACK FROM TRACKER
106     C
107     T = 1
108     C
109     10 CONTINUE
110     C
111     IF (GOOD2.EQ.1) THEN
112     C
113     CHTRACK = 0
114     C
115     CALL VZERO(IWPL,2)
116     CALL VZERO(BAR,2*NPLA)
117     CALL VZERO(IBAR,2*NPLA)
118     CALL VZERO(TBAR,2*NPLA)
119     CALL VZERO(TIBAR,2*NPLA)
120     do m = 1, 5
121     al_p(m) = al_pp(t,m)
122     enddo
123     if (al_p(5).eq.0.) THEN
124     PRINT *,' CALORIMETER - WARNING F77: track with R = 0, discarded'
125     GOOD2 = 0
126     GOTO 969
127     ENDIF
128     DO M = 1,2
129     DO I = 1,NPLA
130     XOUT(I) = 0.
131     YOUT(I) = 0.
132     IF (MOD(M,2).EQ.0) THEN
133     DISTX = PIANO(I) + ZALIG
134     ELSE
135     DISTX = PIANO(I) - 5.81 + ZALIG
136     ENDIF
137     ZIN(I) = distx / 10.
138     TBAR(M,I) = 0.
139     TIBAR(M,I) = 0
140     enddo
141     IFAIL = 0
142     call DOTRACK(NPLA,ZIN,XOUT,YOUT,AL_P,IFAIL)
143     if(IFAIL.ne.0)then
144     GOOD2 = 0
145     print *,' CALORIMETER - WARNING F77: tracking failed '
146     goto 969
147     endif
148     TX = TAN(ASIN(AL_P(3))) * COS(AL_P(4))
149     TY = TAN(ASIN(AL_P(3))) * SIN(AL_P(4))
150     DO I = 1, NPLA
151     NN = 0
152     IF (M.EQ.2) NN = 1
153     IF (MOD(I,2).EQ.NN) THEN
154     SHIFT = +0.5
155     ELSE
156     SHIFT = -0.5
157     ENDIF
158     C
159     C CHECK IF XOUT OR YOUT ARE NaN
160     C
161     IF (XOUT(I).NE.XOUT(I).OR.YOUT(I).NE.YOUT(I)) THEN
162     print *,
163     & ' CALORIMETER - WARNING F77: tracking error (NaN values)'
164     GOOD2 = 0
165     GOTO 969
166     ENDIF
167     C
168     CX = XOUT(I)*10. + XALIG
169     CY = -YOUT(I)*10. + YALIG
170     C
171     IF (I.EQ.1) THEN
172     TIMPX = CX
173     TIMPY = CY
174     ENDIF
175     IF (M.EQ.1) THEN
176     Y(I) = CX
177     BAR(M,I) = Y(I)
178     TBAR(M,I) = (Y(I) - XALIG)/10.
179     IF (I.EQ.22) MX=ABS(Y(1)-Y(22))/ABS(ZIN(1)-ZIN(22))
180     ELSE
181     YY(I) = CY
182     BAR(M,I) = YY(I)
183     TBAR(M,I) = (YALIG - YY(I))/10.
184     IF (I.EQ.22) MY=ABS(Y(1)-Y(22))/ABS(ZIN(1)-ZIN(22))
185     ENDIF
186     CALL LASTRISCIA(BAR(M,I),IBAR(M,I))
187     tibar(M,I) = ibar(m,i)
188     IF (ibar(m,i).EQ.-1) THEN
189     CHTRACK = CHTRACK + 1
190     ELSE
191     IWPL(M) = IWPL(M) + 1
192     ENDIF
193     ENDDO
194     ENDDO
195     969 continue
196     cC
197     cC IF WE HAVE A GOOD CALORIMETER FIT DOES IT MATCH WITH TRACKER FIT?
198     cC
199     c IF (GOOD2.EQ.1.AND.NPFIT(2).GT.15.AND.VARFIT(2).LT.1000
200     c & .AND.TRKCHI2.EQ.1) THEN
201     c IF (ABS(TBAR(2,1)-CBAR(2,1))<40.) THEN
202     cC
203     cC GOOD, THE TWO TRACKS COINCIDE
204     cC
205     c IF (T.EQ.2) TRKCHI2 = 2
206     c GOTO 6996
207     c ELSE
208     cC
209     cC IT IS NOT A GOOD FIT BUT WE HAVE AN IMAGE AND IT IS THE FIRST TRACK
210     cC
211     c IF (T.EQ.1) THEN
212     c T = 2
213     c GOTO 10
214     c ENDIF
215     c IF (T.EQ.2) THEN
216     c TRKCHI2 = -1
217     c T = 1
218     c GOTO 10
219     c ENDIF
220     c ENDIF
221     c ENDIF
222     C
223     IF (GOOD2.EQ.0) THEN
224     c IF (T.EQ.1.AND.TRKCHI2.EQ.1) THEN
225     c GOOD2 = 1
226     c T = 2
227     c GOTO 10
228     c ENDIF
229     GOTO 50
230     ENDIF
231     C
232     GOTO 6996
233     C
234     ENDIF
235     C
236     C WE MUST PROCESS A SELFTRIGGER EVENT
237     C
238     IF (TRIGTY.GE.2) THEN
239     C
240     C CALL SELFTRIGGER SUBROUTINE
241     C
242     CALL SELFTRIG()
243     ELEN = PARZEN3
244     SELEN = ABS(ELEN) * (11.98*1E-2 + 7.6 * EXP(-5736/ABS(ELEN)))
245     C
246     NPCFIT(1) = NFITX
247     NPCFIT(2) = NFITY
248     C
249     DO M = 1,2
250     C
251     IF (NPCFIT(M).GE.2) THEN
252     IF (M.EQ.1) THEN
253     VARCFIT(1) = CHI2X
254     IMPX = 10. * ( AX + 12.1 )
255     TANX = BX
256     ELSE
257     VARCFIT(2) = CHI2Y
258     IMPY = 10. * ( AY + 12.2 )
259     TANY = BY
260     ENDIF
261     C
262     DO I = 1,NPLA
263     NN = 0
264     IF (M.EQ.2) NN = 1
265     IF (MOD(I,2).EQ.NN) THEN
266     SHIFT = +0.5
267     ELSE
268     SHIFT = -0.5
269     ENDIF
270     C
271     IF (M.EQ.1) THEN
272     DISTX = PIANO(I) - 5.81
273     Y(I) = DISTX * TANX + CX
274     BAR(M,I) = Y(I)
275     CBAR(M,I) = Y(I)
276     IF (I.EQ.22) MX=ABS(Y(1)-Y(22))/ABS(ZIN(1)-ZIN(22))
277     C
278     ELSE
279     DISTY = PIANO(I)
280     YY(I) = DISTY * TANY + CY
281     BAR(M,I) = YY(I)
282     CBAR(M,I) = YY(I)
283     IF (I.EQ.22) MY=ABS(Y(1)-Y(22))/ABS(ZIN(1)-ZIN(22))
284     C
285     ENDIF
286     CALL LASTRISCIA(BAR(M,I),IBAR(M,I))
287     cibar(M,I) = ibar(m,i)
288     ENDDO
289     ENDIF
290     C
291     ENDDO
292     C
293     ELSE
294     IF (GOOD2.EQ.0) THEN
295     PRINT *,' CALORIMETER - WARNING F77: unknown request'
296     GOOD2 = 1
297     GOTO 50
298     ENDIF
299     ENDIF
300     C
301     6996 CONTINUE
302     C
303     DX0L = 0.
304     C
305     C IF THE TRACK IS OUTSIDE THE CALORIMETER GO OUT, IF NOT CALCULATE DX0L
306     C
307     IF (CHTRACK.EQ.44) THEN
308     GOOD2 = 0
309     PRINT *,' CALORIMETER - WARNING F77: track outside calorimeter'
310     GOTO 50
311     ELSE
312     IF ( IWPL(1).LE.IWPL(2) ) THEN
313     IWPLU = IWPL(1)
314     ELSE
315     IWPLU = IWPL(2)
316     ENDIF
317     C
318     DX0L = IWPLU * SQRT((BAR(2,1)-(2.66*MY+BAR(2,1)))**2
319     & + (BAR(1,1)-(2.66*MX+BAR(1,1)))**2 + 2.66**2) /
320     & 3.6
321     C
322     C DX0L = X01PL * SQRT( (IWPL(1) * SQRT(1 + MX*MX))**2 +
323     C & (IWPL(2) * SQRT(1 + MY*MY))**2 )/2.
324     ENDIF
325     C
326     C
327     C RIG IS RIGIDITY AS DETERMINED BY THE TRACKER
328     C OR by CALORIMETER IF IN SELFTRIGGER MODE
329     C
330     IF (GOOD2.EQ.1) THEN
331     GTR = 1
332     IF (TRKCHI2.LT.0) GTR = 2
333     IF ( AL_PP(GTR,5).NE.0. ) THEN
334     RIG = 1./(AL_PP(GTR,5))
335     ELSE
336     GOOD2 = 0
337     PRINT *,' CALORIMETER - WARNING F77: track with R = 0'
338     GOTO 50
339     ENDIF
340     ENDIF
341     IF (TRIGTY.GE.2.AND.GOOD2.EQ.0) THEN
342     RIG = ELEN ! SELFTRIGGER RIGIDITY
343     IF ( RIG.EQ.0. ) THEN
344     GOOD2 = 0
345     PRINT *,' CALORIMETER - WARNING F77: ST track with R = 0'
346     GOTO 50
347     ENDIF
348     ENDIF
349     C
350     RNSS = 0.
351     QTOTT = 0.
352     C
353     PPLANEMAX = 1.01*(LOG(ABS(RIG)/0.0081)-1.)
354     C
355     IPLANE = INT(ANINT(PPLANEMAX)) + 5
356     C
357     IF (IPLANE.GT.NPLA) IPLANE=NPLA
358     IF (IPLANE.LT.1) IPLANE = 1
359     C
360     C CALCULATE QLOW AND NLOW
361     C
362     DO J = IPLANE,NPLA
363     DO I = 1,NCHA
364     IF (DEXY(1,J,I).GE.EMIN) THEN
365     NLOW = NLOW + 1
366     QLOW = QLOW + DEXY(1,J,I)
367     ENDIF
368     IF (DEXY(2,J,I).GE.EMIN) THEN
369     NLOW = NLOW + 1
370     QLOW = QLOW + DEXY(2,J,I)
371     ENDIF
372     ENDDO
373     ENDDO
374     C
375     C CALCULATE QCORE AND NCORE
376     C
377     C
378     C 8 STRIPS ARE 2.88 cm , A MOLIERE RADIUS IS ABOUT 0.7 cm .
379     C
380     DO J = 1,IPLANE
381     NNX = IBAR(1,J)
382     IF (NNX.NE.-1) THEN
383     IF (NNX.LT.9) NNX = 9
384     IF (NNX.GT.88) NNX = 88
385     INFX = NNX - 8
386     ISUPX = NNX + 8
387     DO I = INFX,ISUPX
388     IF (DEXY(1,J,I).GE.EMIN) THEN
389     RNSS = RNSS + 1
390     QTOTT = QTOTT + DEXY(1,J,I)
391     ENDIF
392     ENDDO
393     ENDIF
394     C
395     NNY = IBAR(2,J)
396     IF (NNY.NE.-1) THEN
397     IF (NNY.LT.9) NNY = 9
398     IF (NNY.GT.88) NNY = 88
399     INFY = NNY - 8
400     ISUPY = NNY + 8
401     DO I = INFY,ISUPY
402     IF (DEXY(2,J,I).GE.EMIN) THEN
403     RNSS = RNSS + 1
404     QTOTT = QTOTT + DEXY(2,J,I)
405     ENDIF
406     ENDDO
407     ENDIF
408     NCORE = RNSS * FLOAT(J) + NCORE
409     QCORE = QTOTT * FLOAT(J) + QCORE
410     ENDDO
411     C
412     C CALCULATE NOINT
413     C
414     CALL NOINTER(NIN)
415     NOINT = FLOAT(NIN)
416     C
417     C
418     C QCYL = DETECTED ENERGY AND NCYL = NUMBER OF HIT STRIPS IN A CYLINDER oF
419     C RADIUS 8.5 STRIPS WITH AXIS DEFINED BY THE DIRECTION OF THE INCOMING
420     C PARTICLE .
421     C
422     C 8 STRIPS ARE 2.88 cm , A MOLIERE RADIUS IS ABOUT 0.7 cm .
423     C
424     DO J = 1,NPLA
425     NNX = IBAR(1,J)
426     IF (NNX.NE.-1) THEN
427     IF (NNX.LT.9) NNX = 9
428     IF (NNX.GT.88) NNX = 88
429     INFX = NNX - 8
430     ISUPX = NNX + 8
431     DO I = INFX,ISUPX
432     IF (DEXY(1,J,I).LT.EMIN) GO TO 710
433     NCYL = NCYL + 1
434     QCYL = QCYL + DEXY(1,J,I)
435     710 ENDDO
436     ENDIF
437     NNY = IBAR(2,J)
438     IF (NNY.NE.-1) THEN
439     IF (NNY.LT.9) NNY = 9
440     IF (NNY.GT.88) NNY = 88
441     INFY = NNY - 8
442     ISUPY = NNY + 8
443     DO I=INFY,ISUPY
444     IF (DEXY(2,J,I).LT.EMIN) GO TO 810
445     NCYL = NCYL + 1
446     QCYL = QCYL + DEXY(2,J,I)
447     810 ENDDO
448     ENDIF
449     C
450     C QTR = DETECTED ENERGY AND NTR = NUMBER OF HIT STRIPS IN A CYLINDER oF
451     C RADIUS 4.5 STRIPS WITH AXIS DEFINED BY THE DIRECTION OF THE INCOMING
452     C PARTICLE .
453     C
454     NNX = IBAR(1,J)
455     IF (NNX.NE.-1) THEN
456     IF (NNX.LT.5) NNX = 5
457     IF (NNX.GT.92) NNX = 92
458     INFX = NNX - 4
459     ISUPX = NNX + 4
460     DO I = INFX,ISUPX
461     IF (DEXY(1,J,I).GT.EMIN) THEN
462     NTR = NTR + 1
463     QTR = QTR + DEXY(1,J,I)
464     ENDIF
465     ENDDO
466     ENDIF
467     C
468     NNY = IBAR(2,J)
469     IF (NNY.NE.-1) THEN
470     IF (NNY.LT.5) NNY = 5
471     IF (NNY.GT.92) NNY = 92
472     INFY = NNY - 4
473     ISUPY = NNY + 4
474     DO I = INFY, ISUPY
475     IF (DEXY(2,J,I).GT.EMIN) THEN
476     NTR = NTR + 1
477     QTR = QTR + DEXY(2,J,I)
478     ENDIF
479     ENDDO
480     ENDIF
481     ENDDO
482     C
483     C CALCULATE QTRACK
484     C
485     CALL LATERALE(QTRACK,RQT)
486    
487     C
488     C CALCULATE NPRESH AND QPRESH
489     C
490     DO I = 1,4
491     NNX = IBAR(1,I)
492     IF (NNX.NE.-1) THEN
493     IF (NNX.LT.3) NNX = 3
494     IF (NNX.GT.94) NNX = 94
495     INFX = NNX - 2
496     ISUPX = NNX + 2
497     DO J = INFX,ISUPX
498     IF (DEXY(1,I,J).GE.EMIN) THEN
499     NPRESH = NPRESH + 1
500     QPRESH = QPRESH + DEXY(1,I,J)
501     ENDIF
502     ENDDO
503     ENDIF
504     C
505     NNY = IBAR(2,I)
506     IF (NNY.NE.-1) THEN
507     IF (NNY.LT.3) NNY = 3
508     IF (NNY.GT.94) NNY = 94
509     INFY = NNY - 2
510     ISUPY = NNY + 2
511     DO J = INFY,ISUPY
512     IF (DEXY(2,I,J).GE.EMIN) THEN
513     NPRESH = NPRESH + 1
514     QPRESH = QPRESH + DEXY(2,I,J)
515     ENDIF
516     ENDDO
517     ENDIF
518     ENDDO
519     C
520     C CALCULATE DXTRACK, DYTRACK, QTRACKX AND QTRACKY
521     C
522     ICONTROL5 = 0
523     CALL NSHOWER(ICONTROL5,DXTRACK,DYTRACK,QTRACKX,QTRACKY)
524     C
525     C CALCULATE QPRE AND NPRE
526     C
527     DO J = 1,3
528     NNX = IBAR(1,J)
529     IF (NNX.NE.-1) THEN
530     IF (NNX.LT.9) NNX = 9
531     IF (NNX.GT.88) NNX = 88
532     INFX = NNX - 8
533     ISUPX = NNX + 8
534     DO I = INFX,ISUPX
535     IF (DEXY(1,J,I).GE.EMIN) THEN
536     NPRE = NPRE + 1
537     QPRE = QPRE + DEXY(1,J,I)
538     ENDIF
539     ENDDO
540     ENDIF
541     C
542     NNY = IBAR(2,J)
543     IF (NNY.NE.-1) THEN
544     IF (NNY.LT.9) NNY = 9
545     IF (NNY.GT.88) NNY = 88
546     INFY = NNY - 8
547     ISUPY = NNY + 8
548     DO I=INFY,ISUPY
549     IF (DEXY(2,J,I).GE.EMIN) THEN
550     NPRE = NPRE + 1
551     QPRE = QPRE + DEXY(2,J,I)
552     ENDIF
553     ENDDO
554     ENDIF
555     ENDDO
556     C
557     C CALCULATE NLAST AND QLAST
558     C
559     DO J = NPLA-4,NPLA
560     NNX = IBAR(1,J)
561     IF (NNX.NE.-1) THEN
562 mocchiut 1.2 IF (NNX.LT.5) NNX = 5
563     IF (NNX.GT.92) NNX = 92
564     c IF (NNX.LT.9) NNX = 9
565     c IF (NNX.GT.88) NNX = 88
566     INFX = NNX - 4
567     ISUPX = NNX + 4
568     c INFX = NNX - 8
569     c ISUPX = NNX + 8
570 mocchiut 1.1 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     ENDIF
577     C
578     NNY = IBAR(2,J)
579     IF (NNY.NE.-1) THEN
580 mocchiut 1.2 IF (NNY.LT.5) NNY = 5
581     IF (NNY.GT.92) NNY = 92
582     c IF (NNY.LT.9) NNY = 9
583     c IF (NNY.GT.88) NNY = 88
584     INFY = NNY - 4
585     ISUPY = NNY + 4
586     c INFY = NNY - 8
587     c ISUPY = NNY + 8
588 mocchiut 1.1 DO I=INFY,ISUPY
589     IF (DEXY(2,J,I).GE.EMIN) THEN
590     NLAST = NLAST + 1
591     QLAST = QLAST + DEXY(2,J,I)
592     ENDIF
593     ENDDO
594     ENDIF
595     ENDDO
596     C
597     EINF = EMIN
598     ESUP = 50.
599     C
600     C CALCULATE PLANETOT AND QMEAN
601     C
602     DO M = 1,2
603     RPIANO(M) = 0.
604     NTOT(M) = 0
605     ENDDO
606     NPIANI = 5
607     QMEAN = 0.
608     INDEX = 0
609     CALL ELIO(RPIANO,NPIANI,QMEAN,NTOT,INDEX)
610     PLANETOT = RPIANO(1) + RPIANO(2)
611     C
612     50 CONTINUE
613     C
614     RETURN
615     END
616    
617    

  ViewVC Help
Powered by ViewVC 1.1.23