GEANT321/gphys/gfshdc.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:21:25  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.21  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GFSHDC(IELEM,Z)
  13 C.
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    *  Fetch Shell Decay Constants                                   *
  17 C.    *                                                                *
  18 C.    *    ==>CALLED BY : GPHXSI                                       *
  19 C.    *       AUTHOR    : J. Chwastowski                               *
  20 C.    *                                                                *
  21 C.    ******************************************************************
  22 C.
  23 #include "geant321/gcbank.inc"
  24 #include "geant321/gcjloc.inc"
  25 #include "geant321/gconsp.inc"
  26 #include "geant321/gcunit.inc"
  27       REAL ONEEV
  28       PARAMETER (ONEEV = 1.E-9)
  29       DIMENSION PRB(4),PRBR(92),ER(92),PRBNR(92),ENR(92)
  30       DIMENSION ESHL(24),NRAD(24),NONRAD(24)
  31       PARAMETER (NFNBIN = 17, NSHELL = 4)
  32 C
  33 C Push NZ JPFN banks which will contain constants for each Z
  34 C
  35       JPHXS = LQ(JPHOT-1)
  36 C
  37 C Get Z, the shell potentials and the decay modes
  38 C
  39       DO 10 I = 1,24
  40          ESHL(I) = 0.0
  41          NRAD(I) = 0
  42          NONRAD(I) = 0
  43    10 CONTINUE
  44       DO 20 I = 1,4
  45          PRB(I) = 0.0
  46    20 CONTINUE
  47       DO 30 I = 1,92
  48          PRBNR(I) = 0.0
  49          PRBNR(I) = 0.0
  50          ENR(I) = 0.0
  51          ER(I) = 0.0
  52    30 CONTINUE
  53       CALL GFSHLS(Z,ESHL,NSHLL)
  54       CALL GFRDT(Z,ESHL,NSHELL,NWR,NRAD,PRBR,ER)
  55       CALL GFNRDT(Z,ESHL,NSHELL,NWNR,NONRAD,PRBNR,ENR)
  56 C Calculate how many words are needed for the final state bank JPHFN
  57       NWORD = 0
  58       DO 40 J = 1,NSHELL
  59          IF(NRAD(J).GT.0) NWORD = NWORD+2*NRAD(J)+1
  60          IF(NONRAD(J).GT.0) NWORD = NWORD+2*NONRAD(J)+1
  61    40 CONTINUE
  62       NBOOK = NWORD+NFNBIN
  63       JPHFN = LQ(JPHXS-IELEM)
  64 C Push bank to store final state parameters
  65       CALL MZPUSH(IXCONS,JPHFN,0,NBOOK,'R')
  66       NUSED = 5*Q(JPHFN+1)+1
  67       JPHFN = JPHFN+NUSED
  68       Q(JPHFN+1) = NSHELL
  69 C Get probability of the shell radiative decay
  70       CALL GFSDPR(Z,NSHELL,PRB)
  71 C
  72 C Copy potentials and radiative decay probabilities
  73 C
  74       DO 50 J = 1,NSHELL
  75          IF(ESHL(J).GT.0.0) THEN
  76             Q(JPHFN+1+J) = ESHL(J)*ONEEV
  77             Q(JPHFN+1+J+NSHELL) = PRB(J)
  78          ELSE
  79 C if the shell potential is zero set it to -1
  80             Q(JPHFN+1+J) = -1.
  81             Q(JPHFN+1+J+NSHELL) = -1.
  82          ENDIF
  83    50 CONTINUE
  84 C
  85 C Now configurations of the final state
  86 C
  87       K = 18
  88       KR = 1
  89       KNR = 1
  90       IF(NWORD.GT.0) THEN
  91          Q(JPHFN+10) = 18+NUSED
  92          DO 100 J = 1,NSHELL
  93             IF(ESHL(J).GT.0.0) THEN
  94                IF(NRAD(J).GT.0) THEN
  95                   IF(J.GT.1) Q(JPHFN+9+J) = K+NUSED
  96                   Q(JPHFN+K) = NRAD(J)
  97                   K = K+1
  98                   KER = KR+NRAD(J)-1
  99                   DO 60 L = KR,KER
 100                      Q(JPHFN+K) = PRBR(L)
 101                      K = K+1
 102    60             CONTINUE
 103                   DO 70 L = KR,KER
 104                      Q(JPHFN+K) = ER(L)
 105                      K = K+1
 106    70             CONTINUE
 107                   KR = KR+NRAD(J)
 108                ENDIF
 109                IF(NONRAD(J).GT.0) THEN
 110                   Q(JPHFN+13+J) = K+NUSED
 111                   Q(JPHFN+K) = NONRAD(J)
 112                   K = K+1
 113                   KNER = KNR+NONRAD(J)-1
 114                   DO 80 L = KNR,KNER
 115                      Q(JPHFN+K) = PRBNR(L)
 116                      K = K+1
 117    80             CONTINUE
 118                   DO 90 L = KNR,KNER
 119                      Q(JPHFN+K) = ENR(L)
 120                      K = K+1
 121    90             CONTINUE
 122                   KNR = KNR+NONRAD(J)
 123                ENDIF
 124             ENDIF
 125   100    CONTINUE
 126       ELSE
 127 C You should never land here unless Z < 6
 128          IF(Z.GT.5.) THEN
 129 C               CALL MZDROP(IXCONS,JPHFN,'L')
 130             WRITE(CHMAIL,'(A25,I3)') ' GFSHDC. JPHFN Z > 5. Z = ',Z
 131             CALL GMAIL(0,0)
 132          ENDIF
 133       ENDIF
 134       END