This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / GEANT321 / peanut / nclvst.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.4  1996/11/13 13:08:05  ravndal
6 * Paramter ZERO at least real
7 *
8 * Revision 1.3  1996/05/03 09:46:12  cernlib
9 * Replace 0.0 in MAX() by ZERO to get the proper type;
10 * add parameter statement for ZERO
11 *
12 * Revision 1.2  1996/04/26 12:20:30  ravndal
13 * neg. SQRT protection
14 *
15 * Revision 1.1.1.1  1995/10/24 10:22:01  cernlib
16 * Geant
17 *
18 *
19 #include "geant321/pilot.h"
20 *CMZ :  3.21/02 29/03/94  15.41.46  by  S.Giani
21 *-- Author :
22 *$ CREATE NCLVST.FOR
23 *COPY NCLVST
24 *
25 *=== nclvst ===========================================================*
26 *
27       SUBROUTINE NCLVST ( NA, NZ )
28  
29 #include "geant321/dblprc.inc"
30 #include "geant321/dimpar.inc"
31 #include "geant321/iounit.inc"
32 *
33        PARAMETER (ZERO=0.)
34 *----------------------------------------------------------------------*
35 *----------------------------------------------------------------------*
36 *
37 #include "geant321/nucdat.inc"
38 #include "geant321/nucgeo.inc"
39 #include "geant321/nuclev.inc"
40 *
41       NTAPRO = NZ
42       NTANEU = NA - NZ
43       NAVPRO = MOD (NTAPRO,2)
44       NLSPRO = 2 - NAVPRO
45       NAVPRO = NTAPRO / 2 + NAVPRO
46       NAVNEU = MOD (NTANEU,2)
47       NLSNEU = 2 - NAVNEU
48       NAVNEU = NTANEU / 2 + NAVNEU
49       PROFAC = 2.D+00
50 *
51       CUMRAD (0,1) = 0.D+00
52       CUMRAD (0,2) = 0.D+00
53       DO 2000 INC = 1,2
54          DDNAV = NAVNUC(INC)
55          DO 1000 JNC = 1, NAVNUC (INC)
56             DDJNC = JNC
57             PCEJNC = PFRCEN (INC) * ( DDJNC / DDNAV
58      &             )**0.3333333333333333D+00
59             EKCJNC = SQRT ( PCEJNC**2 + AMNUSQ (INC) ) - AMNUCL (INC)
60             EKFJNC = EKFCEN (INC) - EKCJNC
61             PFRJNC = SQRT ( 
62      &      MAX( EKFJNC * ( EKFJNC + 2.D+00 * AMNUCL (INC) ), ZERO) )
63             RHOJNC = RHOCEN * ( PFRJNC / PFRCEN (INC) )**3
64             RADJNC = FRADNC (RHOJNC)
65             IF ( JNC .LT. NAVNUC (INC) ) THEN
66                CUMRAD (JNC,INC) = CUMRAD (JNC-1,INC) + PROFAC
67      &                          / RADJNC**3
68             ELSE
69                CUMRAD (JNC,INC) = CUMRAD (JNC-1,INC) + NLSNUC (INC)
70      &                          / RADJNC**3
71             END IF
72             IF ( RADJNC .LE. RADIU0 ) THEN
73                NCONUC (INC) = JNC
74             ELSE IF ( RADJNC .LE. RADIU1 ) THEN
75                NSKNUC (INC) = JNC
76             ELSE
77                NHANUC (INC) = JNC
78             END IF
79  1000    CONTINUE
80          DO 1500 K = 1,8
81             IF ( NTANUC (INC) .LE. MAGNUM (K) ) THEN
82                MAGNUC (INC) = K
83                GO TO 2000
84             END IF
85  1500    CONTINUE
86  2000 CONTINUE
87       RETURN
88 *=== End of subroutine nclvst =========================================*
89       END