/[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.15 - (hide annotations) (download)
Mon Apr 2 14:42:14 2007 UTC (17 years, 8 months ago) by mocchiut
Branch: MAIN
CVS Tags: v3r04, v3r05, v3r06, v3r03
Changes since 1.14: +3 -1 lines
qcore/ncore bug fixed

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

  ViewVC Help
Powered by ViewVC 1.1.23