GEANT321/peanut/pfnclv.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/09/30 14:25:47  ravndal
   6 * Windows NT related modifications
   7 *
   8 * Revision 1.1.1.1  1995/10/24 10:22:02  cernlib
   9 * Geant
  10 *
  11 *
  12 #include "geant321/pilot.h"
  13 *CMZ :  3.21/02 29/03/94  15.41.46  by  S.Giani
  14 *-- Author :
  15 *$ CREATE PFNCLV.FOR
  16 *COPY PFNCLV
  17 *
  18 *=== pfnclv ===========================================================*
  19 *
  20       FUNCTION PFNCLV ( INC, LINNEW )
  21
  22 #include "geant321/dblprc.inc"
  23 #include "geant321/dimpar.inc"
  24 #include "geant321/iounit.inc"
  25 *
  26 *----------------------------------------------------------------------*
  27 *----------------------------------------------------------------------*
  28 *
  29 #include "geant321/eva0.inc"
  30 #include "geant321/nucdat.inc"
  31 #include "geant321/nucgeo.inc"
  32 #include "geant321/nuclev.inc"
  33 *
  34       LOGICAL LINNEW, LOCSEL
  35       DIMENSION RADSCB (2), DEFPAI (2), DEFSHE (2), NMSHLL (2)
  36       REAL RNDM(1)
  37       SAVE RADSCB, DEFPAI, DEFSHE, NMSHLL, NLEVEL, LOCSEL
  38       DATA LOCSEL / .FALSE. /
  39 *
  40 *======================================================================*
  41 *======================================================================*
  42 *
  43       I = INC
  44       IF ( ABS (RIMPCT) .GT. RUSNUC (I) ) THEN
  45          PFNCLV = - AINFNT
  46          RETURN
  47       END IF
  48       IF ( LINNEW ) THEN
  49          EKFCHC = EKFIMP
  50       ELSE
  51          EKFCHC = EKFIM2
  52       END IF
  53       EKCENT = EKFCEN (I) - EKFCHC
  54       EKCENT = EKFCEN (I) - EKFCHC
  55       EKCENT = MAX ( EKCENT, ZERZER )
  56       JMIN = INT ( NAVNUC (I) * ( SQRT ( EKCENT * ( EKCENT + 2.D+00
  57      &     * AMNUCL (I) ) ) / PFRCEN (I) )**3 ) + 1
  58       JMAX = NAVNUC (I)
  59       PROBTT = JMAX - JMIN + 1
  60       CALL GRNDM(RNDM,1)
  61       RNDJTA = RNDM (1) * PROBTT
  62       JMAX   = MIN ( INT (RNDJTA) + JMIN, JMAX )
  63       CUMMAX = CUMRAD (JMAX,I)
  64       IF ( LINNEW ) THEN
  65          NPRNUC = 1
  66          IF ( JUSNUC (JMAX,I) .EQ. INUCLV ) THEN
  67             P_FNCLV = - AINFNT
  68             PFNCLV = P_FNCLV
  69             RETURN
  70          ELSE IF ( JUSNUC (JMAX,I) .EQ. -INUCLV ) THEN
  71             CALL GRNDM(RNDM,1)
  72             IF ( RNDM (1) .LT. 0.5D+00 ) THEN
  73                P_FNCLV = - AINFNT
  74                PFNCLV = P_FNCLV
  75                RETURN
  76             END IF
  77             DEFPAI (I) = 0.D+00
  78          ELSE
  79             IF ( JUSNUC (JMAX,I) .NE. -1 ) THEN
  80                DEFPAI (I) = PAENUC ( NTANUC (I), I )
  81             ELSE
  82                DEFPAI (I) = 0.D+00
  83             END IF
  84          END IF
  85          PFCHCK = PFRIMP
  86          PCJMAX = PFRCEN (I) * RMASS (JMAX) / RMASS (NAVNUC(I))
  87          EKCJMX = SQRT ( PCJMAX**2 + AMNUSQ (I) ) - AMNUCL (I)
  88          EKFERM = EKFCHC + EKCJMX - EKFCEN (I)
  89          P_FNCLV = SQRT ( EKFERM * ( EKFERM + 2.D+00 * AMNUCL (I) ) )
  90          IO = 2 - I/2
  91          DEFPAI (IO) = 0.D+00
  92          DEFSHE (IO) = DEFMAG (IO)
  93       ELSE
  94          NPRNUC = NPRNUC + 1
  95          IF ( JUSNUC (JMAX,I) .EQ. INUCLV ) THEN
  96             P_FNCLV = - AINFNT
  97             PFNCLV = P_FNCLV
  98             RETURN
  99          ELSE IF ( I .EQ. IPRNUC (1) .AND. JMAX .EQ. JPRNUC (1) ) THEN
 100             IF ( JUSNUC (JMAX,I) .EQ. -INUCLV .OR. JUSNUC (JMAX,I) .EQ.
 101      &         -1 ) THEN
 102                P_FNCLV = - AINFNT
 103                PFNCLV = P_FNCLV
 104                RETURN
 105             END IF
 106          ELSE IF ( JUSNUC (JMAX,I) .EQ. -INUCLV ) THEN
 107             CALL GRNDM(RNDM,1)
 108             IF ( RNDM (1) .LT. 0.5D+00 ) THEN
 109                P_FNCLV = - AINFNT
 110                PFNCLV = P_FNCLV
 111                RETURN
 112             END IF
 113          ELSE
 114             IF ( JUSNUC (JMAX,I) .NE. -1 ) DEFPAI (I) = DEFPAI (I)
 115      &                                     + PAENUC ( NTANUC (I), I )
 116          END IF
 117          PFCHCK = PFRIM2
 118          PCJMAX = PFRCEN (I) * RMASS (JMAX) / RMASS (NAVNUC(I))
 119          EKCJMX = SQRT ( PCJMAX**2 + AMNUSQ (I) ) - AMNUCL (I)
 120          EKFER2 = EKFCHC + EKCJMX - EKFCEN (I)
 121          P_FNCLV = SQRT ( EKFER2 * ( EKFER2 + 2.D+00 * AMNUCL (I) ) )
 122       END IF
 123       PFNCLV = MIN ( P_FNCLV, PFCHCK )
 124       IF ( JMAX .EQ. NAVNUC (I) ) THEN
 125          RADSCB (NPRNUC) = NLSNUC (I) / ( CUMMAX - CUMRAD (JMAX-1,I) )
 126          NLEVEL = NLSNUC (I)
 127          JNUCLN = 2 * ( JMAX - 1 ) + NLEVEL
 128       ELSE
 129          RADSCB (NPRNUC) = 2.D+00 / ( CUMMAX - CUMRAD (JMAX-1,I) )
 130          NLEVEL = 2
 131          JNUCLN = 2 * JMAX
 132       END IF
 133       IPRNUC (NPRNUC) = I
 134       JPRNUC (NPRNUC) = JMAX
 135       DO 3000 MG = MAGNUC (I), 2
 136          IF ( MAGNUM (MG-1) .LT. JNUCLN ) GO TO 4000
 137  3000 CONTINUE
 138       MG = 1
 139  4000 CONTINUE
 140       NMSHLL (NPRNUC) = MG
 141       IF ( MGSNUC (MG,I) .EQ. 0 .AND. NTANUC (I) .NE. MAGNUM (MG) ) THEN
 142          DEFSHE (I) = SHENUC ( MAGNUM (MG) + 1, I )
 143      &              - SHENUC ( MAGNUM (MG), I ) + PAENUC (MAGNUM(MG),I)
 144      &              + DEFMAG (I)
 145       ELSE
 146          DEFSHE (I) = DEFMAG (I)
 147       END IF
 148       IF ( NUSCIN .EQ. 0 ) THEN
 149          DEFNUC (1) = MAX ( DEFSHE (1), ZERZER )
 150          DEFNUC (2) = MAX ( DEFSHE (2), ZERZER )
 151       ELSE
 152          DEFNUC (1) = MAX ( DEFPAI (1) + DEFRMI (1), DEFSHE (1), ZERZER)
 153          DEFNUC (2) = MAX ( DEFPAI (2) + DEFRMI (2), DEFSHE (2), ZERZER)
 154       END IF
 155       RETURN
 156 *
 157 *----------------------------------------------------------------------*
 158 *----------------------------------------------------------------------*
 159 *
 160       ENTRY NCLVFX
 161       NCLVFX = PIPIPI
 162       DO 5000 N=1,NPRNUC
 163          I = IPRNUC (N)
 164          J = JPRNUC (N)
 165          IF ( MOD (MGSNUC(NMSHLL(N),I),2) .EQ. 0 )
 166      &      MGSNUC (NMSHLL(N),I) = MGSNUC (NMSHLL(N),I) + 1
 167          IF ( JUSNUC (J,I) .EQ. -INUCLV .OR. JUSNUC (J,I) .EQ. -1 ) THEN
 168             JUSNUC (J,I) = INUCLV
 169             IF ( J .GE. JMXNUC (I) ) THEN
 170                JMXNUC (I) = JMXNUC (I) - NLEVEL
 171                RUSNUC (I) = RADSCB (N)**0.3333333333333333D+00
 172             END IF
 173          ELSE
 174             JUSNUC (J,I) = -INUCLV
 175          END IF
 176          NUSNUC (I) = NUSNUC (I) + 1
 177  5000 CONTINUE
 178       RETURN
 179 *=== End of function pfnclv ===========================================*
 180       END