/[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.8 - (hide annotations) (download)
Mon Jan 22 09:17:01 2007 UTC (17 years, 10 months ago) by mocchiut
Branch: MAIN
Changes since 1.7: +27 -11 lines
Calorimeter selftrigger extensions upgrade

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     IF (NPCFIT(M).GE.2) THEN
257     IF (M.EQ.1) THEN
258     VARCFIT(1) = CHI2X
259     IMPX = 10. * ( AX + 12.1 )
260     TANX = BX
261     ELSE
262     VARCFIT(2) = CHI2Y
263     IMPY = 10. * ( AY + 12.2 )
264     TANY = BY
265     ENDIF
266     C
267     DO I = 1,NPLA
268     NN = 0
269 mocchiut 1.6 C????? IF (M.EQ.2) NN = 1
270 mocchiut 1.1 IF (MOD(I,2).EQ.NN) THEN
271     SHIFT = +0.5
272     ELSE
273     SHIFT = -0.5
274     ENDIF
275     C
276     IF (M.EQ.1) THEN
277     DISTX = PIANO(I) - 5.81
278     Y(I) = DISTX * TANX + CX
279     BAR(M,I) = Y(I)
280     CBAR(M,I) = Y(I)
281     IF (I.EQ.22) MX=ABS(Y(1)-Y(22))/ABS(ZIN(1)-ZIN(22))
282     C
283     ELSE
284     DISTY = PIANO(I)
285     YY(I) = DISTY * TANY + CY
286     BAR(M,I) = YY(I)
287     CBAR(M,I) = YY(I)
288     IF (I.EQ.22) MY=ABS(Y(1)-Y(22))/ABS(ZIN(1)-ZIN(22))
289     C
290     ENDIF
291     CALL LASTRISCIA(BAR(M,I),IBAR(M,I))
292     cibar(M,I) = ibar(m,i)
293 mocchiut 1.8 IF (ibar(m,i).EQ.-1) THEN
294     CHTRACK = CHTRACK + 1
295     ELSE
296     IWPL(M) = IWPL(M) + 1
297     ENDIF
298 mocchiut 1.1 ENDDO
299     ENDIF
300     C
301     ENDDO
302     C
303     ENDIF
304 mocchiut 1.8 C
305     IF (TRIGTY.GE.2.AND.HZN.NE.0) THEN
306     IF (GOOD2.EQ.1) THEN
307     PRINT *,' CALORIMETER - WARNING F77: unknown request'
308     GOOD2 = 1
309     GOTO 50
310     ENDIF
311     IF ( NPCFIT(1).EQ.0.OR.NPCFIT(2).EQ.0 ) THEN
312     GOOD2 = 1
313     GOTO 50
314     ENDIF
315     ENDIF
316 mocchiut 1.1 C
317     6996 CONTINUE
318     C
319     DX0L = 0.
320     C
321     C IF THE TRACK IS OUTSIDE THE CALORIMETER GO OUT, IF NOT CALCULATE DX0L
322     C
323 mocchiut 1.7 IF (CHTRACK.EQ.44) THEN ! CHTRACK is the number of planes not touched by the track
324 mocchiut 1.1 GOOD2 = 0
325 mocchiut 1.3 c PRINT *,' CALORIMETER - WARNING F77: track outside calorimeter'
326 mocchiut 1.1 GOTO 50
327     ELSE
328     IF ( IWPL(1).LE.IWPL(2) ) THEN
329     IWPLU = IWPL(1)
330     ELSE
331     IWPLU = IWPL(2)
332     ENDIF
333     C
334     DX0L = IWPLU * SQRT((BAR(2,1)-(2.66*MY+BAR(2,1)))**2
335     & + (BAR(1,1)-(2.66*MX+BAR(1,1)))**2 + 2.66**2) /
336     & 3.6
337     C
338     ENDIF
339     C
340     C
341     C RIG IS RIGIDITY AS DETERMINED BY THE TRACKER
342     C OR by CALORIMETER IF IN SELFTRIGGER MODE
343     C
344     IF (GOOD2.EQ.1) THEN
345     GTR = 1
346     IF (TRKCHI2.LT.0) GTR = 2
347     IF ( AL_PP(GTR,5).NE.0. ) THEN
348     RIG = 1./(AL_PP(GTR,5))
349     ELSE
350     GOOD2 = 0
351     PRINT *,' CALORIMETER - WARNING F77: track with R = 0'
352     GOTO 50
353     ENDIF
354     ENDIF
355 mocchiut 1.7 IF (TRIGTY.GE.2.AND.HZN.EQ.0.AND.GOOD2.EQ.0) THEN
356 mocchiut 1.1 RIG = ELEN ! SELFTRIGGER RIGIDITY
357     IF ( RIG.EQ.0. ) THEN
358 mocchiut 1.8 GOOD2 = 1
359 mocchiut 1.1 PRINT *,' CALORIMETER - WARNING F77: ST track with R = 0'
360     GOTO 50
361     ENDIF
362     ENDIF
363     C
364 mocchiut 1.7 IF (GOOD2.EQ.0.AND.(TRIGTY.LT.2.OR.HZN.EQ.1)) THEN
365     RIG = RIGINPUT
366     ENDIF
367     C
368 mocchiut 1.1 RNSS = 0.
369     QTOTT = 0.
370     C
371     PPLANEMAX = 1.01*(LOG(ABS(RIG)/0.0081)-1.)
372     C
373     IPLANE = INT(ANINT(PPLANEMAX)) + 5
374     C
375     IF (IPLANE.GT.NPLA) IPLANE=NPLA
376     IF (IPLANE.LT.1) IPLANE = 1
377     C
378     C CALCULATE QLOW AND NLOW
379     C
380     DO J = IPLANE,NPLA
381     DO I = 1,NCHA
382     IF (DEXY(1,J,I).GE.EMIN) THEN
383     NLOW = NLOW + 1
384     QLOW = QLOW + DEXY(1,J,I)
385     ENDIF
386     IF (DEXY(2,J,I).GE.EMIN) THEN
387     NLOW = NLOW + 1
388     QLOW = QLOW + DEXY(2,J,I)
389     ENDIF
390     ENDDO
391     ENDDO
392     C
393     C CALCULATE QCORE AND NCORE
394     C
395     C
396     C 8 STRIPS ARE 2.88 cm , A MOLIERE RADIUS IS ABOUT 0.7 cm .
397     C
398     DO J = 1,IPLANE
399     NNX = IBAR(1,J)
400     IF (NNX.NE.-1) THEN
401     IF (NNX.LT.9) NNX = 9
402     IF (NNX.GT.88) NNX = 88
403     INFX = NNX - 8
404     ISUPX = NNX + 8
405     DO I = INFX,ISUPX
406     IF (DEXY(1,J,I).GE.EMIN) THEN
407     RNSS = RNSS + 1
408     QTOTT = QTOTT + DEXY(1,J,I)
409     ENDIF
410     ENDDO
411     ENDIF
412     C
413     NNY = IBAR(2,J)
414     IF (NNY.NE.-1) THEN
415     IF (NNY.LT.9) NNY = 9
416     IF (NNY.GT.88) NNY = 88
417     INFY = NNY - 8
418     ISUPY = NNY + 8
419     DO I = INFY,ISUPY
420     IF (DEXY(2,J,I).GE.EMIN) THEN
421     RNSS = RNSS + 1
422     QTOTT = QTOTT + DEXY(2,J,I)
423     ENDIF
424     ENDDO
425     ENDIF
426     NCORE = RNSS * FLOAT(J) + NCORE
427     QCORE = QTOTT * FLOAT(J) + QCORE
428     ENDDO
429     C
430     C CALCULATE NOINT
431     C
432     CALL NOINTER(NIN)
433     NOINT = FLOAT(NIN)
434     C
435     C
436     C QCYL = DETECTED ENERGY AND NCYL = NUMBER OF HIT STRIPS IN A CYLINDER oF
437     C RADIUS 8.5 STRIPS WITH AXIS DEFINED BY THE DIRECTION OF THE INCOMING
438     C PARTICLE .
439     C
440     C 8 STRIPS ARE 2.88 cm , A MOLIERE RADIUS IS ABOUT 0.7 cm .
441     C
442     DO J = 1,NPLA
443     NNX = IBAR(1,J)
444     IF (NNX.NE.-1) THEN
445     IF (NNX.LT.9) NNX = 9
446     IF (NNX.GT.88) NNX = 88
447     INFX = NNX - 8
448     ISUPX = NNX + 8
449     DO I = INFX,ISUPX
450     IF (DEXY(1,J,I).LT.EMIN) GO TO 710
451     NCYL = NCYL + 1
452     QCYL = QCYL + DEXY(1,J,I)
453     710 ENDDO
454     ENDIF
455     NNY = IBAR(2,J)
456     IF (NNY.NE.-1) THEN
457     IF (NNY.LT.9) NNY = 9
458     IF (NNY.GT.88) NNY = 88
459     INFY = NNY - 8
460     ISUPY = NNY + 8
461     DO I=INFY,ISUPY
462     IF (DEXY(2,J,I).LT.EMIN) GO TO 810
463     NCYL = NCYL + 1
464     QCYL = QCYL + DEXY(2,J,I)
465     810 ENDDO
466     ENDIF
467     C
468     C QTR = DETECTED ENERGY AND NTR = NUMBER OF HIT STRIPS IN A CYLINDER oF
469     C RADIUS 4.5 STRIPS WITH AXIS DEFINED BY THE DIRECTION OF THE INCOMING
470     C PARTICLE .
471     C
472     NNX = IBAR(1,J)
473     IF (NNX.NE.-1) THEN
474     IF (NNX.LT.5) NNX = 5
475     IF (NNX.GT.92) NNX = 92
476     INFX = NNX - 4
477     ISUPX = NNX + 4
478     DO I = INFX,ISUPX
479     IF (DEXY(1,J,I).GT.EMIN) THEN
480     NTR = NTR + 1
481     QTR = QTR + DEXY(1,J,I)
482     ENDIF
483     ENDDO
484     ENDIF
485     C
486     NNY = IBAR(2,J)
487     IF (NNY.NE.-1) THEN
488     IF (NNY.LT.5) NNY = 5
489     IF (NNY.GT.92) NNY = 92
490     INFY = NNY - 4
491     ISUPY = NNY + 4
492     DO I = INFY, ISUPY
493     IF (DEXY(2,J,I).GT.EMIN) THEN
494     NTR = NTR + 1
495     QTR = QTR + DEXY(2,J,I)
496     ENDIF
497     ENDDO
498     ENDIF
499     ENDDO
500     C
501     C CALCULATE QTRACK
502     C
503     CALL LATERALE(QTRACK,RQT)
504    
505     C
506     C CALCULATE NPRESH AND QPRESH
507     C
508     DO I = 1,4
509     NNX = IBAR(1,I)
510     IF (NNX.NE.-1) THEN
511     IF (NNX.LT.3) NNX = 3
512     IF (NNX.GT.94) NNX = 94
513     INFX = NNX - 2
514     ISUPX = NNX + 2
515     DO J = INFX,ISUPX
516     IF (DEXY(1,I,J).GE.EMIN) THEN
517     NPRESH = NPRESH + 1
518     QPRESH = QPRESH + DEXY(1,I,J)
519     ENDIF
520     ENDDO
521     ENDIF
522     C
523     NNY = IBAR(2,I)
524     IF (NNY.NE.-1) THEN
525     IF (NNY.LT.3) NNY = 3
526     IF (NNY.GT.94) NNY = 94
527     INFY = NNY - 2
528     ISUPY = NNY + 2
529     DO J = INFY,ISUPY
530     IF (DEXY(2,I,J).GE.EMIN) THEN
531     NPRESH = NPRESH + 1
532     QPRESH = QPRESH + DEXY(2,I,J)
533     ENDIF
534     ENDDO
535     ENDIF
536     ENDDO
537     C
538     C CALCULATE DXTRACK, DYTRACK, QTRACKX AND QTRACKY
539     C
540     ICONTROL5 = 0
541     CALL NSHOWER(ICONTROL5,DXTRACK,DYTRACK,QTRACKX,QTRACKY)
542     C
543     C CALCULATE QPRE AND NPRE
544     C
545     DO J = 1,3
546     NNX = IBAR(1,J)
547     IF (NNX.NE.-1) THEN
548     IF (NNX.LT.9) NNX = 9
549     IF (NNX.GT.88) NNX = 88
550     INFX = NNX - 8
551     ISUPX = NNX + 8
552     DO I = INFX,ISUPX
553     IF (DEXY(1,J,I).GE.EMIN) THEN
554     NPRE = NPRE + 1
555     QPRE = QPRE + DEXY(1,J,I)
556     ENDIF
557     ENDDO
558     ENDIF
559     C
560     NNY = IBAR(2,J)
561     IF (NNY.NE.-1) THEN
562     IF (NNY.LT.9) NNY = 9
563     IF (NNY.GT.88) NNY = 88
564     INFY = NNY - 8
565     ISUPY = NNY + 8
566     DO I=INFY,ISUPY
567     IF (DEXY(2,J,I).GE.EMIN) THEN
568     NPRE = NPRE + 1
569     QPRE = QPRE + DEXY(2,J,I)
570     ENDIF
571     ENDDO
572     ENDIF
573     ENDDO
574     C
575     C CALCULATE NLAST AND QLAST
576     C
577     DO J = NPLA-4,NPLA
578     NNX = IBAR(1,J)
579     IF (NNX.NE.-1) THEN
580 mocchiut 1.2 IF (NNX.LT.5) NNX = 5
581     IF (NNX.GT.92) NNX = 92
582     c IF (NNX.LT.9) NNX = 9
583     c IF (NNX.GT.88) NNX = 88
584     INFX = NNX - 4
585     ISUPX = NNX + 4
586     c INFX = NNX - 8
587     c ISUPX = NNX + 8
588 mocchiut 1.1 DO I = INFX,ISUPX
589     IF (DEXY(1,J,I).GE.EMIN) THEN
590     NLAST = NLAST + 1
591     QLAST = QLAST + DEXY(1,J,I)
592     ENDIF
593     ENDDO
594     ENDIF
595     C
596     NNY = IBAR(2,J)
597     IF (NNY.NE.-1) THEN
598 mocchiut 1.2 IF (NNY.LT.5) NNY = 5
599     IF (NNY.GT.92) NNY = 92
600     c IF (NNY.LT.9) NNY = 9
601     c IF (NNY.GT.88) NNY = 88
602     INFY = NNY - 4
603     ISUPY = NNY + 4
604     c INFY = NNY - 8
605     c ISUPY = NNY + 8
606 mocchiut 1.1 DO I=INFY,ISUPY
607     IF (DEXY(2,J,I).GE.EMIN) THEN
608     NLAST = NLAST + 1
609     QLAST = QLAST + DEXY(2,J,I)
610     ENDIF
611     ENDDO
612     ENDIF
613     ENDDO
614     C
615     EINF = EMIN
616 mocchiut 1.8 ESUP = 150.
617     C
618     IF (TRIGTY.GE.2.AND.HZN.NE.0) THEN
619     EINF = 50.
620     ESUP = 1500.
621     ENDIF
622 mocchiut 1.1 C
623     C CALCULATE PLANETOT AND QMEAN
624     C
625     DO M = 1,2
626     RPIANO(M) = 0.
627     NTOT(M) = 0
628     ENDDO
629     NPIANI = 5
630     QMEAN = 0.
631     INDEX = 0
632     CALL ELIO(RPIANO,NPIANI,QMEAN,NTOT,INDEX)
633     PLANETOT = RPIANO(1) + RPIANO(2)
634     C
635     50 CONTINUE
636     C
637     RETURN
638     END
639    
640    

  ViewVC Help
Powered by ViewVC 1.1.23