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