6 |
INCLUDE 'INTEST.TXT' |
INCLUDE 'INTEST.TXT' |
7 |
C |
C |
8 |
DOUBLE PRECISION al_p(5), |
DOUBLE PRECISION al_p(5), |
9 |
& xout(npla),yout(npla),zin(npla) |
& xout(nplav),yout(nplav),zin(nplav) |
10 |
C |
C |
11 |
REAL PIANO(22), VARFIT(2) |
REAL PIANO(NPLAV), VARFIT(2) |
12 |
REAL TX, TY, SHIFT |
REAL TX, TY, SHIFT |
13 |
REAL BAR(2,NPLA), DISTY |
REAL BAR(2,NPLAV), DISTY |
14 |
REAL DISTX, Y(NPLA), YY(NPLA) |
REAL DISTX, Y(NPLAV), YY(NPLAV) |
15 |
REAL RIG, PPLANEMAX, RMASS |
REAL RIG, PPLANEMAX, RMASS |
16 |
REAL RNSS, QTOTT, RQT, MX, MY |
REAL RNSS, QTOTT, RQT, MX, MY |
17 |
REAL CHECK, ENER, CX, CY |
REAL CHECK, ENER, CX, CY |
26 |
INTEGER INDEX, NTOT(2), NPIANI, GTR |
INTEGER INDEX, NTOT(2), NPIANI, GTR |
27 |
INTEGER j, m, i, IWPL(2), timpx, timpy, T, nn |
INTEGER j, m, i, IWPL(2), timpx, timpy, T, nn |
28 |
INTEGER IPLANE, NNX, NNY, INFX, INFY, ISUPX, ISUPY |
INTEGER IPLANE, NNX, NNY, INFX, INFY, ISUPX, ISUPY |
29 |
INTEGER IBAR(2,NPLA), NPFIT(2), CHTRACK,IWPLU |
INTEGER IBAR(2,NPLAV), NPFIT(2), CHTRACK,IWPLU |
30 |
INTEGER Iquest(100), ICONTROL5, nin, IFAIL |
INTEGER Iquest(100), ICONTROL5, nin, IFAIL |
31 |
C |
C |
32 |
PARAMETER (X01PL=0.74) |
PARAMETER (X01PL=0.74) |
55 |
COMMON / CH / CHECK |
COMMON / CH / CHECK |
56 |
SAVE / CH / |
SAVE / CH / |
57 |
C |
C |
58 |
COMMON / CALOFIT / VARFIT, NPFIT |
COMMON / CALOFIT / VARFIT, NPFIT, IWPL,CHTRACK |
59 |
SAVE / CALOFIT / |
SAVE / CALOFIT / |
60 |
C |
C |
61 |
COMMON / pawcd / hmemor |
COMMON / pawcd / hmemor |
66 |
C |
C |
67 |
C Begin ! |
C Begin ! |
68 |
C |
C |
69 |
|
c print *,' sono qui' |
70 |
CALOL2TR = 0; |
CALOL2TR = 0; |
71 |
NCORE = 0. |
NCORE = 0. |
72 |
QCORE = 0. |
QCORE = 0. |
90 |
NLAST = 0. |
NLAST = 0. |
91 |
PLANETOT = 0. |
PLANETOT = 0. |
92 |
QMEAN = 0. |
QMEAN = 0. |
93 |
SELFTRIGGER = 0 |
C SELFTRIGGER = 0 |
|
CALL VZERO(VARCFIT,2) |
|
|
CALL VZERO(NPCFIT,2) |
|
|
CALL VZERO(TBAR,2*NPLA) |
|
|
CALL VZERO(TIBAR,2*NPLA) |
|
|
CALL VZERO(BAR,2*NPLA) |
|
|
CALL VZERO(IBAR,2*NPLA) |
|
|
CALL VZERO(IBAR,2*NPLA) |
|
|
CALL VZERO(Y,NPLA) |
|
|
CALL VZERO(YY,NPLA) |
|
|
CALL VZERO(XOUT,NPLA) |
|
|
CALL VZERO(YOUT,NPLA) |
|
94 |
C |
C |
95 |
C BEGIN WITH THE FISRT TRACK IF WE HAVE A TRACK FROM TRACKER |
C BEGIN WITH THE FIRST TRACK IF WE HAVE A TRACK FROM TRACKER |
96 |
C |
C |
97 |
T = 1 |
T = 1 |
98 |
C |
C |
103 |
CHTRACK = 0 |
CHTRACK = 0 |
104 |
C |
C |
105 |
CALL VZERO(IWPL,2) |
CALL VZERO(IWPL,2) |
106 |
CALL VZERO(BAR,2*NPLA) |
CALL VZERO(BAR,2*NPLAV) |
107 |
CALL VZERO(IBAR,2*NPLA) |
CALL VZERO(IBAR,2*NPLAV) |
108 |
CALL VZERO(TBAR,2*NPLA) |
CALL VZERO(TBAR,2*NPLAV) |
109 |
CALL VZERO(TIBAR,2*NPLA) |
CALL VZERO(TIBAR,2*NPLAV) |
110 |
|
CALL VZERO(Y,NPLAV) |
111 |
|
CALL VZERO(YY,NPLAV) |
112 |
|
CALL VZERO(XOUT,NPLAV) |
113 |
|
CALL VZERO(YOUT,NPLAV) |
114 |
do m = 1, 5 |
do m = 1, 5 |
115 |
al_p(m) = al_pp(t,m) |
al_p(m) = al_pp(t,m) |
116 |
|
c print *,' al_p(',m,') = ',al_p(m) |
117 |
enddo |
enddo |
118 |
if (al_p(5).eq.0.) THEN |
if (al_p(5).eq.0.) THEN |
119 |
PRINT *,' CALORIMETER - WARNING F77: track with R = 0, discarded' |
PRINT *,' CALORIMETER - WARNING F77: track with R = 0, discarded' |
126 |
YOUT(I) = 0. |
YOUT(I) = 0. |
127 |
IF (MOD(M,2).EQ.0) THEN |
IF (MOD(M,2).EQ.0) THEN |
128 |
DISTX = PIANO(I) + ZALIG |
DISTX = PIANO(I) + ZALIG |
129 |
|
c print *,'T Y PLANE I= ',I,' Z = ',DISTX |
130 |
ELSE |
ELSE |
131 |
DISTX = PIANO(I) - 5.81 + ZALIG |
DISTX = PIANO(I) - 5.81 + ZALIG |
132 |
|
c print *,'T X PLANE I= ',I,' Z = ',DISTX |
133 |
ENDIF |
ENDIF |
134 |
ZIN(I) = distx / 10. |
ZIN(I) = distx / 10. |
135 |
|
c print *,' ZIN(',I,') = ',ZIN(I) |
136 |
TBAR(M,I) = 0. |
TBAR(M,I) = 0. |
137 |
TIBAR(M,I) = 0 |
TIBAR(M,I) = 0 |
138 |
enddo |
enddo |
140 |
call DOTRACK(NPLA,ZIN,XOUT,YOUT,AL_P,IFAIL) |
call DOTRACK(NPLA,ZIN,XOUT,YOUT,AL_P,IFAIL) |
141 |
if(IFAIL.ne.0)then |
if(IFAIL.ne.0)then |
142 |
GOOD2 = 0 |
GOOD2 = 0 |
143 |
print *,' CALORIMETER - WARNING F77: tracking failed ' |
c print *,' CALORIMETER - WARNING F77: tracking failed ' |
144 |
goto 969 |
goto 969 |
145 |
endif |
endif |
146 |
TX = TAN(ASIN(AL_P(3))) * COS(AL_P(4)) |
TX = TAN(ASIN(AL_P(3))) * COS(AL_P(4)) |
147 |
TY = TAN(ASIN(AL_P(3))) * SIN(AL_P(4)) |
TY = TAN(ASIN(AL_P(3))) * SIN(AL_P(4)) |
148 |
DO I = 1, NPLA |
DO I = 1, NPLA |
149 |
NN = 0 |
NN = 0 |
150 |
IF (M.EQ.2) NN = 1 |
c IF (M.EQ.2) NN = 1 |
151 |
IF (MOD(I,2).EQ.NN) THEN |
IF (MOD(I,2).EQ.NN) THEN |
152 |
SHIFT = +0.5 |
IF (REVERSE.EQ.0) THEN |
153 |
|
SHIFT = -0.5 |
154 |
|
ELSE |
155 |
|
SHIFT = +0.5 |
156 |
|
ENDIF |
157 |
ELSE |
ELSE |
158 |
SHIFT = -0.5 |
IF (REVERSE.EQ.0) THEN |
159 |
|
SHIFT = +0.5 |
160 |
|
ELSE |
161 |
|
SHIFT = -0.5 |
162 |
|
ENDIF |
163 |
ENDIF |
ENDIF |
164 |
C |
C |
165 |
C CHECK IF XOUT OR YOUT ARE NaN |
C CHECK IF XOUT OR YOUT ARE NaN |
166 |
C |
C |
167 |
IF (XOUT(I).NE.XOUT(I).OR.YOUT(I).NE.YOUT(I)) THEN |
IF (XOUT(I).NE.XOUT(I).OR.YOUT(I).NE.YOUT(I)) THEN |
168 |
print *, |
c print *, |
169 |
& ' CALORIMETER - WARNING F77: tracking error (NaN values)' |
c & ' CALORIMETER - WARNING F77: tracking error (NaN values)' |
170 |
GOOD2 = 0 |
GOOD2 = 0 |
171 |
GOTO 969 |
GOTO 969 |
172 |
ENDIF |
ENDIF |
173 |
C |
C |
174 |
CX = XOUT(I)*10. + XALIG |
CX = XOUT(I)*10. + XALIG |
175 |
CY = -YOUT(I)*10. + YALIG |
CY = YOUT(I)*10. + YALIG |
176 |
C |
C |
177 |
IF (I.EQ.1) THEN |
IF (I.EQ.1) THEN |
178 |
TIMPX = CX |
TIMPX = CX |
182 |
Y(I) = CX |
Y(I) = CX |
183 |
BAR(M,I) = Y(I) |
BAR(M,I) = Y(I) |
184 |
TBAR(M,I) = (Y(I) - XALIG)/10. |
TBAR(M,I) = (Y(I) - XALIG)/10. |
185 |
IF (I.EQ.22) MX=ABS(Y(1)-Y(22))/ABS(ZIN(1)-ZIN(22)) |
IF (I.EQ.NPLA) MX=ABS(Y(1)-Y(NPLA))/ |
186 |
|
& ABS(ZIN(1)-ZIN(NPLA)) |
187 |
ELSE |
ELSE |
188 |
YY(I) = CY |
YY(I) = CY |
189 |
BAR(M,I) = YY(I) |
BAR(M,I) = YY(I) |
190 |
TBAR(M,I) = (YALIG - YY(I))/10. |
TBAR(M,I) = (-YALIG + YY(I))/10. |
191 |
IF (I.EQ.22) MY=ABS(Y(1)-Y(22))/ABS(ZIN(1)-ZIN(22)) |
IF (I.EQ.NPLA) MY=ABS(Y(1)-Y(NPLA))/ |
192 |
|
& ABS(ZIN(1)-ZIN(NPLA)) |
193 |
ENDIF |
ENDIF |
194 |
CALL LASTRISCIA(BAR(M,I),IBAR(M,I)) |
CALL LASTRISCIA(BAR(M,I),IBAR(M,I)) |
195 |
tibar(M,I) = ibar(m,i) |
tibar(M,I) = ibar(m,i) |
243 |
C |
C |
244 |
C WE MUST PROCESS A SELFTRIGGER EVENT |
C WE MUST PROCESS A SELFTRIGGER EVENT |
245 |
C |
C |
246 |
IF (TRIGTY.GE.2) THEN |
IF (TRIGTY.GE.2.AND.HZN.EQ.0) THEN |
247 |
C |
C |
248 |
C CALL SELFTRIGGER SUBROUTINE |
C CALL SELFTRIGGER SUBROUTINE |
249 |
C |
C |
250 |
|
CALL VZERO(IWPL,2) |
251 |
|
CALL VZERO(VARCFIT,2) |
252 |
|
CALL VZERO(NPCFIT,2) |
253 |
|
CALL VZERO(TBAR,2*NPLAV) |
254 |
|
CALL VZERO(TIBAR,2*NPLAV) |
255 |
|
CALL VZERO(BAR,2*NPLAV) |
256 |
|
CALL VZERO(IBAR,2*NPLAV) |
257 |
|
CALL VZERO(Y,NPLAV) |
258 |
|
CALL VZERO(YY,NPLAV) |
259 |
|
CALL VZERO(XOUT,NPLAV) |
260 |
|
CALL VZERO(YOUT,NPLAV) |
261 |
|
C |
262 |
CALL SELFTRIG() |
CALL SELFTRIG() |
263 |
ELEN = PARZEN3 |
ELEN = PARZEN3 |
264 |
SELEN = ABS(ELEN) * (11.98*1E-2 + 7.6 * EXP(-5736/ABS(ELEN))) |
SELEN = ABS(ELEN) * (11.98*1E-2 + 7.6 * EXP(-5736/ABS(ELEN))) |
268 |
C |
C |
269 |
DO M = 1,2 |
DO M = 1,2 |
270 |
C |
C |
271 |
|
c print *,' ax ',ax,' ay ',ay |
272 |
|
c print *,' bx ',bx,' by ',by |
273 |
IF (NPCFIT(M).GE.2) THEN |
IF (NPCFIT(M).GE.2) THEN |
274 |
IF (M.EQ.1) THEN |
IF (M.EQ.1) THEN |
275 |
VARCFIT(1) = CHI2X |
VARCFIT(1) = CHI2X |
276 |
IMPX = 10. * ( AX + 12.1 ) |
IMPX = AX + BX * (ZALIG/10.) ! PAMELA REF |
277 |
TANX = BX |
TANX = BX |
278 |
ELSE |
ELSE |
279 |
VARCFIT(2) = CHI2Y |
VARCFIT(2) = CHI2Y |
280 |
IMPY = 10. * ( AY + 12.2 ) |
IMPY = AY + BY * (ZALIG/10.) ! PAMELA REF |
281 |
TANY = BY |
TANY = BY |
282 |
ENDIF |
ENDIF |
283 |
C |
C |
284 |
DO I = 1,NPLA |
DO I = 1,NPLA |
285 |
NN = 0 |
NN = 0 |
286 |
IF (M.EQ.2) NN = 1 |
c IF (M.EQ.2) NN = 1 |
287 |
IF (MOD(I,2).EQ.NN) THEN |
IF (MOD(I,2).EQ.NN) THEN |
288 |
SHIFT = +0.5 |
IF (REVERSE.EQ.0) THEN |
289 |
|
SHIFT = -0.5 |
290 |
|
ELSE |
291 |
|
SHIFT = +0.5 |
292 |
|
ENDIF |
293 |
ELSE |
ELSE |
294 |
SHIFT = -0.5 |
IF (REVERSE.EQ.0) THEN |
295 |
|
SHIFT = +0.5 |
296 |
|
ELSE |
297 |
|
SHIFT = -0.5 |
298 |
|
ENDIF |
299 |
ENDIF |
ENDIF |
300 |
C |
C |
301 |
IF (M.EQ.1) THEN |
IF (M.EQ.1) THEN |
302 |
DISTX = PIANO(I) - 5.81 |
DISTX = PIANO(I) - 5.81 |
303 |
Y(I) = DISTX * TANX + CX |
Y(I) = (DISTX * TANX) + IMPX*10. !- XALIG |
304 |
BAR(M,I) = Y(I) |
c CBAR(M,I) = Y(I) |
305 |
CBAR(M,I) = Y(I) |
BAR(M,I) = Y(I) + XALIG |
306 |
IF (I.EQ.22) MX=ABS(Y(1)-Y(22))/ABS(ZIN(1)-ZIN(22)) |
CBAR(M,I) = Y(I) / 10. |
307 |
|
IF (I.EQ.NPLA) MX=ABS(Y(1)-Y(NPLA))/ |
308 |
|
& ABS(ZIN(1)-ZIN(NPLA)) |
309 |
C |
C |
310 |
ELSE |
ELSE |
311 |
DISTY = PIANO(I) |
DISTY = PIANO(I) |
312 |
YY(I) = DISTY * TANY + CY |
YY(I) = (DISTY * TANY) + IMPY*10. !- YALIG |
313 |
BAR(M,I) = YY(I) |
c print *,' I ',i,' YY ',YY(I) |
314 |
CBAR(M,I) = YY(I) |
c CBAR(M,I) = YY(I) |
315 |
IF (I.EQ.22) MY=ABS(Y(1)-Y(22))/ABS(ZIN(1)-ZIN(22)) |
BAR(M,I) = YY(I) + YALIG |
316 |
|
CBAR(M,I) = YY(I) / 10. |
317 |
|
IF (I.EQ.NPLA) MY=ABS(Y(1)-Y(NPLA))/ |
318 |
|
& ABS(ZIN(1)-ZIN(NPLA)) |
319 |
C |
C |
320 |
ENDIF |
ENDIF |
321 |
CALL LASTRISCIA(BAR(M,I),IBAR(M,I)) |
CALL LASTRISCIA(BAR(M,I),IBAR(M,I)) |
322 |
cibar(M,I) = ibar(m,i) |
cibar(M,I) = ibar(m,i) |
323 |
|
IF (ibar(m,i).EQ.-1) THEN |
324 |
|
CHTRACK = CHTRACK + 1 |
325 |
|
ELSE |
326 |
|
IWPL(M) = IWPL(M) + 1 |
327 |
|
ENDIF |
328 |
ENDDO |
ENDDO |
329 |
ENDIF |
ENDIF |
330 |
C |
C |
331 |
ENDDO |
ENDDO |
332 |
C |
C |
333 |
ELSE |
ENDIF |
334 |
IF (GOOD2.EQ.0) THEN |
C |
335 |
|
IF (TRIGTY.GE.2.AND.HZN.NE.0) THEN |
336 |
|
IF (GOOD2.EQ.1) THEN |
337 |
PRINT *,' CALORIMETER - WARNING F77: unknown request' |
PRINT *,' CALORIMETER - WARNING F77: unknown request' |
338 |
GOOD2 = 1 |
GOOD2 = 1 |
339 |
GOTO 50 |
GOTO 50 |
340 |
ENDIF |
ENDIF |
341 |
|
IF ( NPCFIT(1).EQ.0.OR.NPCFIT(2).EQ.0 ) THEN |
342 |
|
GOOD2 = 1 |
343 |
|
GOTO 50 |
344 |
|
ENDIF |
345 |
ENDIF |
ENDIF |
346 |
C |
C |
347 |
6996 CONTINUE |
6996 CONTINUE |
350 |
C |
C |
351 |
C IF THE TRACK IS OUTSIDE THE CALORIMETER GO OUT, IF NOT CALCULATE DX0L |
C IF THE TRACK IS OUTSIDE THE CALORIMETER GO OUT, IF NOT CALCULATE DX0L |
352 |
C |
C |
353 |
IF (CHTRACK.EQ.44) THEN |
IF (CHTRACK.EQ.44) THEN ! CHTRACK is the number of planes not touched by the track |
354 |
GOOD2 = 0 |
GOOD2 = 0 |
355 |
PRINT *,' CALORIMETER - WARNING F77: track outside calorimeter' |
c PRINT *,' CALORIMETER - WARNING F77: track outside calorimeter' |
356 |
GOTO 50 |
GOTO 50 |
357 |
ELSE |
ELSE |
358 |
IF ( IWPL(1).LE.IWPL(2) ) THEN |
IF ( IWPL(1).LE.IWPL(2) ) THEN |
365 |
& + (BAR(1,1)-(2.66*MX+BAR(1,1)))**2 + 2.66**2) / |
& + (BAR(1,1)-(2.66*MX+BAR(1,1)))**2 + 2.66**2) / |
366 |
& 3.6 |
& 3.6 |
367 |
C |
C |
|
C DX0L = X01PL * SQRT( (IWPL(1) * SQRT(1 + MX*MX))**2 + |
|
|
C & (IWPL(2) * SQRT(1 + MY*MY))**2 )/2. |
|
368 |
ENDIF |
ENDIF |
369 |
C |
C |
370 |
C |
C |
382 |
GOTO 50 |
GOTO 50 |
383 |
ENDIF |
ENDIF |
384 |
ENDIF |
ENDIF |
385 |
IF (TRIGTY.GE.2.AND.GOOD2.EQ.0) THEN |
IF (TRIGTY.GE.2.AND.HZN.EQ.0.AND.GOOD2.EQ.0) THEN |
386 |
RIG = ELEN ! SELFTRIGGER RIGIDITY |
RIG = ELEN ! SELFTRIGGER RIGIDITY |
387 |
IF ( RIG.EQ.0. ) THEN |
IF ( RIG.EQ.0. ) THEN |
388 |
GOOD2 = 0 |
GOOD2 = 1 |
389 |
PRINT *,' CALORIMETER - WARNING F77: ST track with R = 0' |
PRINT *,' CALORIMETER - WARNING F77: ST track with R = 0' |
390 |
GOTO 50 |
GOTO 50 |
391 |
ENDIF |
ENDIF |
392 |
ENDIF |
ENDIF |
393 |
C |
C |
394 |
|
IF (GOOD2.EQ.0.AND.(TRIGTY.LT.2.OR.HZN.EQ.1)) THEN |
395 |
|
RIG = RIGINPUT |
396 |
|
ENDIF |
397 |
|
C |
398 |
RNSS = 0. |
RNSS = 0. |
399 |
QTOTT = 0. |
QTOTT = 0. |
400 |
C |
C |
401 |
PPLANEMAX = 1.01*(LOG(ABS(RIG)/0.0081)-1.) |
PPLANEMAX = 1.01*(LOG(ABS(RIG)/0.0081)-1.) / 0.74 |
402 |
C |
C |
403 |
IPLANE = INT(ANINT(PPLANEMAX)) + 5 |
IPLANE = INT(ANINT(PPLANEMAX)) + 5 |
404 |
C |
C |
405 |
IF (IPLANE.GT.NPLA) IPLANE=NPLA |
IF (IPLANE.GT.NPLA) IPLANE=NPLA |
406 |
IF (IPLANE.LT.1) IPLANE = 1 |
IF (IPLANE.LT.1) IPLANE = 1 |
407 |
|
c print *,' calcolo...' |
408 |
C |
C |
409 |
C CALCULATE QLOW AND NLOW |
C CALCULATE QLOW AND NLOW |
410 |
C |
C |
428 |
C |
C |
429 |
DO J = 1,IPLANE |
DO J = 1,IPLANE |
430 |
NNX = IBAR(1,J) |
NNX = IBAR(1,J) |
431 |
|
RNSS = 0. ! BACO!! |
432 |
|
QTOTT = 0. ! BACO!! |
433 |
IF (NNX.NE.-1) THEN |
IF (NNX.NE.-1) THEN |
434 |
IF (NNX.LT.9) NNX = 9 |
IF (NNX.LT.9) NNX = 9 |
435 |
IF (NNX.GT.88) NNX = 88 |
IF (NNX.GT.88) NNX = 88 |
610 |
DO J = NPLA-4,NPLA |
DO J = NPLA-4,NPLA |
611 |
NNX = IBAR(1,J) |
NNX = IBAR(1,J) |
612 |
IF (NNX.NE.-1) THEN |
IF (NNX.NE.-1) THEN |
613 |
IF (NNX.LT.9) NNX = 9 |
IF (NNX.LT.5) NNX = 5 |
614 |
IF (NNX.GT.88) NNX = 88 |
IF (NNX.GT.92) NNX = 92 |
615 |
INFX = NNX - 8 |
c IF (NNX.LT.9) NNX = 9 |
616 |
ISUPX = NNX + 8 |
c IF (NNX.GT.88) NNX = 88 |
617 |
|
INFX = NNX - 4 |
618 |
|
ISUPX = NNX + 4 |
619 |
|
c INFX = NNX - 8 |
620 |
|
c ISUPX = NNX + 8 |
621 |
DO I = INFX,ISUPX |
DO I = INFX,ISUPX |
622 |
IF (DEXY(1,J,I).GE.EMIN) THEN |
IF (DEXY(1,J,I).GE.EMIN) THEN |
623 |
NLAST = NLAST + 1 |
NLAST = NLAST + 1 |
628 |
C |
C |
629 |
NNY = IBAR(2,J) |
NNY = IBAR(2,J) |
630 |
IF (NNY.NE.-1) THEN |
IF (NNY.NE.-1) THEN |
631 |
IF (NNY.LT.9) NNY = 9 |
IF (NNY.LT.5) NNY = 5 |
632 |
IF (NNY.GT.88) NNY = 88 |
IF (NNY.GT.92) NNY = 92 |
633 |
INFY = NNY - 8 |
c IF (NNY.LT.9) NNY = 9 |
634 |
ISUPY = NNY + 8 |
c IF (NNY.GT.88) NNY = 88 |
635 |
|
INFY = NNY - 4 |
636 |
|
ISUPY = NNY + 4 |
637 |
|
c INFY = NNY - 8 |
638 |
|
c ISUPY = NNY + 8 |
639 |
DO I=INFY,ISUPY |
DO I=INFY,ISUPY |
640 |
IF (DEXY(2,J,I).GE.EMIN) THEN |
IF (DEXY(2,J,I).GE.EMIN) THEN |
641 |
NLAST = NLAST + 1 |
NLAST = NLAST + 1 |
645 |
ENDIF |
ENDIF |
646 |
ENDDO |
ENDDO |
647 |
C |
C |
|
EINF = EMIN |
|
|
ESUP = 50. |
|
648 |
C |
C |
649 |
C CALCULATE PLANETOT AND QMEAN |
C CALCULATE PLANETOT AND QMEAN |
650 |
C |
C |
655 |
NPIANI = 5 |
NPIANI = 5 |
656 |
QMEAN = 0. |
QMEAN = 0. |
657 |
INDEX = 0 |
INDEX = 0 |
658 |
CALL ELIO(RPIANO,NPIANI,QMEAN,NTOT,INDEX) |
C |
659 |
PLANETOT = RPIANO(1) + RPIANO(2) |
IF (TRIGTY.GE.2.AND.HZN.NE.0) THEN |
660 |
|
EINF = 50. |
661 |
|
ESUP = 15000. |
662 |
|
CALL NUCLEI(RPIANO,NPIANI,QMEAN,NTOT,INDEX) |
663 |
|
PLANETOT = RPIANO(1) + RPIANO(2) |
664 |
|
ELSE |
665 |
|
EINF = EMIN |
666 |
|
ESUP = 15000. |
667 |
|
CALL ELIO(RPIANO,NPIANI,QMEAN,NTOT,INDEX) |
668 |
|
PLANETOT = RPIANO(1) + RPIANO(2) |
669 |
|
ENDIF |
670 |
C |
C |
671 |
50 CONTINUE |
50 CONTINUE |
672 |
C |
C |
673 |
|
c print *,' esco' |
674 |
RETURN |
RETURN |
675 |
END |
END |
676 |
|
|