/[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.13 - (hide annotations) (download)
Sat Jan 27 06:22:19 2007 UTC (17 years, 10 months ago) by mocchiut
Branch: MAIN
CVS Tags: v3r00
Changes since 1.12: +8 -6 lines
Added DB reconnection routine called in between detector software

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.6 C????? 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.6 C????? 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     PPLANEMAX = 1.01*(LOG(ABS(RIG)/0.0081)-1.)
376     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     IF (NNX.NE.-1) THEN
405     IF (NNX.LT.9) NNX = 9
406     IF (NNX.GT.88) NNX = 88
407     INFX = NNX - 8
408     ISUPX = NNX + 8
409     DO I = INFX,ISUPX
410     IF (DEXY(1,J,I).GE.EMIN) THEN
411     RNSS = RNSS + 1
412     QTOTT = QTOTT + DEXY(1,J,I)
413     ENDIF
414     ENDDO
415     ENDIF
416     C
417     NNY = IBAR(2,J)
418     IF (NNY.NE.-1) THEN
419     IF (NNY.LT.9) NNY = 9
420     IF (NNY.GT.88) NNY = 88
421     INFY = NNY - 8
422     ISUPY = NNY + 8
423     DO I = INFY,ISUPY
424     IF (DEXY(2,J,I).GE.EMIN) THEN
425     RNSS = RNSS + 1
426     QTOTT = QTOTT + DEXY(2,J,I)
427     ENDIF
428     ENDDO
429     ENDIF
430     NCORE = RNSS * FLOAT(J) + NCORE
431     QCORE = QTOTT * FLOAT(J) + QCORE
432     ENDDO
433     C
434     C CALCULATE NOINT
435     C
436     CALL NOINTER(NIN)
437     NOINT = FLOAT(NIN)
438     C
439     C
440     C QCYL = DETECTED ENERGY AND NCYL = NUMBER OF HIT STRIPS IN A CYLINDER oF
441     C RADIUS 8.5 STRIPS WITH AXIS DEFINED BY THE DIRECTION OF THE INCOMING
442     C PARTICLE .
443     C
444     C 8 STRIPS ARE 2.88 cm , A MOLIERE RADIUS IS ABOUT 0.7 cm .
445     C
446     DO J = 1,NPLA
447     NNX = IBAR(1,J)
448     IF (NNX.NE.-1) THEN
449     IF (NNX.LT.9) NNX = 9
450     IF (NNX.GT.88) NNX = 88
451     INFX = NNX - 8
452     ISUPX = NNX + 8
453     DO I = INFX,ISUPX
454     IF (DEXY(1,J,I).LT.EMIN) GO TO 710
455     NCYL = NCYL + 1
456     QCYL = QCYL + DEXY(1,J,I)
457     710 ENDDO
458     ENDIF
459     NNY = IBAR(2,J)
460     IF (NNY.NE.-1) THEN
461     IF (NNY.LT.9) NNY = 9
462     IF (NNY.GT.88) NNY = 88
463     INFY = NNY - 8
464     ISUPY = NNY + 8
465     DO I=INFY,ISUPY
466     IF (DEXY(2,J,I).LT.EMIN) GO TO 810
467     NCYL = NCYL + 1
468     QCYL = QCYL + DEXY(2,J,I)
469     810 ENDDO
470     ENDIF
471     C
472     C QTR = DETECTED ENERGY AND NTR = NUMBER OF HIT STRIPS IN A CYLINDER oF
473     C RADIUS 4.5 STRIPS WITH AXIS DEFINED BY THE DIRECTION OF THE INCOMING
474     C PARTICLE .
475     C
476     NNX = IBAR(1,J)
477     IF (NNX.NE.-1) THEN
478     IF (NNX.LT.5) NNX = 5
479     IF (NNX.GT.92) NNX = 92
480     INFX = NNX - 4
481     ISUPX = NNX + 4
482     DO I = INFX,ISUPX
483     IF (DEXY(1,J,I).GT.EMIN) THEN
484     NTR = NTR + 1
485     QTR = QTR + DEXY(1,J,I)
486     ENDIF
487     ENDDO
488     ENDIF
489     C
490     NNY = IBAR(2,J)
491     IF (NNY.NE.-1) THEN
492     IF (NNY.LT.5) NNY = 5
493     IF (NNY.GT.92) NNY = 92
494     INFY = NNY - 4
495     ISUPY = NNY + 4
496     DO I = INFY, ISUPY
497     IF (DEXY(2,J,I).GT.EMIN) THEN
498     NTR = NTR + 1
499     QTR = QTR + DEXY(2,J,I)
500     ENDIF
501     ENDDO
502     ENDIF
503     ENDDO
504     C
505     C CALCULATE QTRACK
506     C
507     CALL LATERALE(QTRACK,RQT)
508    
509     C
510     C CALCULATE NPRESH AND QPRESH
511     C
512     DO I = 1,4
513     NNX = IBAR(1,I)
514     IF (NNX.NE.-1) THEN
515     IF (NNX.LT.3) NNX = 3
516     IF (NNX.GT.94) NNX = 94
517     INFX = NNX - 2
518     ISUPX = NNX + 2
519     DO J = INFX,ISUPX
520     IF (DEXY(1,I,J).GE.EMIN) THEN
521     NPRESH = NPRESH + 1
522     QPRESH = QPRESH + DEXY(1,I,J)
523     ENDIF
524     ENDDO
525     ENDIF
526     C
527     NNY = IBAR(2,I)
528     IF (NNY.NE.-1) THEN
529     IF (NNY.LT.3) NNY = 3
530     IF (NNY.GT.94) NNY = 94
531     INFY = NNY - 2
532     ISUPY = NNY + 2
533     DO J = INFY,ISUPY
534     IF (DEXY(2,I,J).GE.EMIN) THEN
535     NPRESH = NPRESH + 1
536     QPRESH = QPRESH + DEXY(2,I,J)
537     ENDIF
538     ENDDO
539     ENDIF
540     ENDDO
541     C
542     C CALCULATE DXTRACK, DYTRACK, QTRACKX AND QTRACKY
543     C
544     ICONTROL5 = 0
545     CALL NSHOWER(ICONTROL5,DXTRACK,DYTRACK,QTRACKX,QTRACKY)
546     C
547     C CALCULATE QPRE AND NPRE
548     C
549     DO J = 1,3
550     NNX = IBAR(1,J)
551     IF (NNX.NE.-1) THEN
552     IF (NNX.LT.9) NNX = 9
553     IF (NNX.GT.88) NNX = 88
554     INFX = NNX - 8
555     ISUPX = NNX + 8
556     DO I = INFX,ISUPX
557     IF (DEXY(1,J,I).GE.EMIN) THEN
558     NPRE = NPRE + 1
559     QPRE = QPRE + DEXY(1,J,I)
560     ENDIF
561     ENDDO
562     ENDIF
563     C
564     NNY = IBAR(2,J)
565     IF (NNY.NE.-1) THEN
566     IF (NNY.LT.9) NNY = 9
567     IF (NNY.GT.88) NNY = 88
568     INFY = NNY - 8
569     ISUPY = NNY + 8
570     DO I=INFY,ISUPY
571     IF (DEXY(2,J,I).GE.EMIN) THEN
572     NPRE = NPRE + 1
573     QPRE = QPRE + DEXY(2,J,I)
574     ENDIF
575     ENDDO
576     ENDIF
577     ENDDO
578     C
579     C CALCULATE NLAST AND QLAST
580     C
581     DO J = NPLA-4,NPLA
582     NNX = IBAR(1,J)
583     IF (NNX.NE.-1) THEN
584 mocchiut 1.2 IF (NNX.LT.5) NNX = 5
585     IF (NNX.GT.92) NNX = 92
586     c IF (NNX.LT.9) NNX = 9
587     c IF (NNX.GT.88) NNX = 88
588     INFX = NNX - 4
589     ISUPX = NNX + 4
590     c INFX = NNX - 8
591     c ISUPX = NNX + 8
592 mocchiut 1.1 DO I = INFX,ISUPX
593     IF (DEXY(1,J,I).GE.EMIN) THEN
594     NLAST = NLAST + 1
595     QLAST = QLAST + DEXY(1,J,I)
596     ENDIF
597     ENDDO
598     ENDIF
599     C
600     NNY = IBAR(2,J)
601     IF (NNY.NE.-1) THEN
602 mocchiut 1.2 IF (NNY.LT.5) NNY = 5
603     IF (NNY.GT.92) NNY = 92
604     c IF (NNY.LT.9) NNY = 9
605     c IF (NNY.GT.88) NNY = 88
606     INFY = NNY - 4
607     ISUPY = NNY + 4
608     c INFY = NNY - 8
609     c ISUPY = NNY + 8
610 mocchiut 1.1 DO I=INFY,ISUPY
611     IF (DEXY(2,J,I).GE.EMIN) THEN
612     NLAST = NLAST + 1
613     QLAST = QLAST + DEXY(2,J,I)
614     ENDIF
615     ENDDO
616     ENDIF
617     ENDDO
618     C
619     C
620     C CALCULATE PLANETOT AND QMEAN
621     C
622     DO M = 1,2
623     RPIANO(M) = 0.
624     NTOT(M) = 0
625     ENDDO
626     NPIANI = 5
627     QMEAN = 0.
628     INDEX = 0
629 mocchiut 1.12 C
630     IF (TRIGTY.GE.2.AND.HZN.NE.0) THEN
631     EINF = 50.
632     ESUP = 15000.
633     CALL NUCLEI(RPIANO,NPIANI,QMEAN,NTOT,INDEX)
634     PLANETOT = RPIANO(1) + RPIANO(2)
635     ELSE
636     EINF = EMIN
637     ESUP = 15000.
638     CALL ELIO(RPIANO,NPIANI,QMEAN,NTOT,INDEX)
639     PLANETOT = RPIANO(1) + RPIANO(2)
640     ENDIF
641 mocchiut 1.1 C
642     50 CONTINUE
643     C
644     RETURN
645     END
646    
647    

  ViewVC Help
Powered by ViewVC 1.1.23