GEANT321/gstrag/giasho.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1999/05/18 15:55:20  fca
   6 * AliRoot sources
   7 *
   8 * Revision 1.1.1.1  1995/10/24 10:21:37  cernlib
   9 * Geant
  10 *
  11 *
  12 #include "geant321/pilot.h"
  13 #if defined(CERNLIB_ASHO)
  14 *CMZ :  3.21/02 29/03/94  15.41.25  by  S.Giani
  15 *-- Author :
  16       SUBROUTINE GIASHO
  17 #include "geant321/gcbank.inc"
  18 #include "geant321/gcmate.inc"
  19       DIMENSION E0ELM(100),NSELM(100)
  20       DIMENSION ZSELM(7,100),ESELM(7,100)
  21       DATA E0ELM /
  22      + 0.0204,0.0385,3*0.,0.0738,0.0978,0.1157,0.1248,0.1338,
  23      + 3*0.,0.1745,0.1791,2*0.,0.1816,12*0.,0.3018,0.2806,
  24      + 0.2906,2*0.,0.3408,12*0.,0.4823,4*0.,0.5088,46*0. /
  25       DATA NSELM /
  26      + 1,1,3*0,2,2,2,2,2,3*0,3,3,2*0,3,12*0,4,4,4,2*0,4,12*0,
  27      + 5,4*0,5,46*0/
  28       DATA ZSELM /
  29      + 1.,0.,0.,0.,0.,0.,0.,2.,0.,0.,0.,0.,0.,0.,21*0.,
  30      + 4.,2.,0.,0.,0.,0.,0.,5.,2.,0.,0.,0.,0.,0.,
  31      + 6.,2.,0.,0.,0.,0.,0.,7.,2.,0.,0.,0.,0.,0.,
  32      + 8.,2.,0.,0.,0.,0.,0.,21*0.,
  33      + 4.,8.,2.,0.,0.,0.,0.,5.,8.,2.,0.,0.,0.,0.,14*0.,
  34      + 8.,8.,2.,0.,0.,0.,0.,84*0.,
  35      + 3.,18.,8.,2.,0.,0.,0.,4.,18.,8.,2.,0.,0.,0.,
  36      + 5.,18.,8.,2.,0.,0.,0.,14*0.,
  37      + 8.,18.,8.,2.,0.,0.,0.,84*0.,
  38      + 5.,18.,16.,8.,2.,0.,0.,28*0.,
  39      + 8.,18.,18.,8.,2.,0.,0.,322*0./
  40 *23456789_123456789_123456789_123456789_123456789_123456789_123456789_12
  41       DATA ESELM / 0.01360,0.,0.,0.,0.,0.,0.,0.02459,0.,0.,0.,0.,0.,0.,
  42      +21*0., 0.01367,0.288,0.,0.,0.,0.,0.,0.01662,0.4030,0.,0.,0.,0.,
  43      +0., 0.01742,0.5380,0.,0.,0.,0.,0.,0.02174,0.6940,0.,0.,0.,0.,0.,
  44      +0.02643,0.8701,0.,0.,0.,0.,0.,21*0., .01047,.1147,1.844,0.,0.,0.,
  45      +0.,.01247,.1467,2.148,0.,0.,0.,0., 14*0.,0.01845,0.2666,3.206,0.,
  46      +0.,0.,0.,84*0., 0.00899,0.04480,1.169,10.37,0.,0.,0., 0.01063,
  47      +0.06190,1.274,11.11,0.,0.,0., 0.01291,0.07953,1.384,11.87,0.,0.,
  48      +0.,14*0., 0.01676,0.1412,1.750,14.33,0.,0.,0.,84*0., 0.00720,
  49      +0.04012,0.5682,3.908,27.93,0.,0.,28*0., 0.01466,0.1006,0.8097,
  50      +5.030,34.570,0.,0.,322*0./
  51 *
  52 *-----------------------------------------------------------------------
  53 *
  54       DIMENSION ZSMED(50),ESMED(50)
  55 C-----------------------------------------------------------------------
  56 C
  57       JMA   = LQ(JMATE-NMAT)
  58       JMIXT = LQ(JMA-5)
  59       NCOMP = ABS(Q(JMA+11))
  60       AMED = 0.
  61       ZMED = 0.
  62       E0CAL = 0.   !Sum of Z(i)*log(I(i))
  63       E0MED = 0.
  64       NSMED = 0
  65
  66       DO 20 I = 1,NCOMP
  67          IF(NCOMP.GT.1) THEN
  68             IZ = Q(JMIXT+NCOMP+I)+0.5
  69             WEIGHT = Q(JMIXT+2*NCOMP+I)/Q(JMIXT+I)
  70             E0MED = E0MED + Q(JMIXT+NCOMP+I)*WEIGHT*LOG(E0ELM(IZ))
  71             ZMED = ZMED + Q(JMIXT+NCOMP+I)*WEIGHT
  72             AMED = AMED + Q(JMIXT+I)*WEIGHT
  73          ELSE
  74             IZ = Z+0.5
  75             E0MED = E0ELM(IZ)
  76             ZMED = Z
  77             AMED = A
  78          ENDIF
  79          DO 10 J = 1,NSELM(IZ)
  80             NSMED = NSMED + 1
  81             IF(NCOMP.GT.1) THEN
  82                ZSMED(NSMED) = ZSELM(J,IZ)*WEIGHT
  83             ELSE
  84                ZSMED(NSMED) = ZSELM(J,IZ)
  85             ENDIF
  86             ESMED(NSMED) = ESELM(J,IZ)
  87             E0CAL = E0CAL + ZSMED(NSMED)*LOG(ESELM(J,IZ))
  88    10    CONTINUE
  89    20 CONTINUE
  90       IF (NCOMP.GT.1) E0MED = EXP(E0MED/ZMED)
  91       E0CAL = EXP(E0CAL/ZMED)
  92       ALFA = E0MED/E0CAL
  93 C-----------------------------------------------------------------------
  94 C      The following sets ZSMED and ESMED in the order of increase
  95 C      of ESMED.
  96 C-----------------------------------------------------------------------
  97       DO 40 I = 1,NSMED - 1
  98          IMIN = I
  99          EMIN = ESMED(I)
 100          DO 30 J = I + 1,NSMED
 101             IF (EMIN.LE.ESMED(J)) GOTO 30
 102             EMIN = ESMED(J)
 103             IMIN = J
 104    30    CONTINUE
 105          IF (I.EQ.IMIN) GOTO 40
 106          X = ESMED(I)
 107          Y = ZSMED(I)
 108          ESMED(I) = ESMED(IMIN)
 109          ZSMED(I) = ZSMED(IMIN)
 110          ESMED(IMIN) = X
 111          ZSMED(IMIN) = Y
 112    40 CONTINUE
 113 C-----------------------------------------------------------------------
 114 C      The following combines the first smallest oscillators whose
 115 C      integer relative potentials are equal to 1.
 116 C-----------------------------------------------------------------------
 117       ZMIN = 0.
 118       EMIN = 0.
 119       IMIN = 1
 120       DO 50 I = 1,NSMED
 121          J = ESMED(I)/ESMED(1) + 0.5
 122          IF (J.GT.1) GOTO 60
 123          ZMIN = ZMIN + ZSMED(I)
 124          EMIN = EMIN + ZSMED(I)*LOG(ESMED(I))
 125          IMIN = I
 126    50 CONTINUE
 127    60 ESMED(1) = EXP(EMIN/ZMIN)
 128       ZSMED(1)        = ZMIN
 129       DO 70 I = IMIN + 1,NSMED
 130          ZSMED(I - IMIN + 1) = ZSMED(I)
 131          ESMED(I - IMIN + 1) = ESMED(I)
 132    70 CONTINUE
 133       NSMED = NSMED - IMIN + 1
 134       JASHO = LQ(JMA-20)
 135 *
 136 * *** Store parameters of ASHO in material bank 20
 137       Q(JASHO+1) = NSMED
 138       Q(JASHO+2) = ZMED
 139       Q(JASHO+3) = AMED
 140       Q(JASHO+4) = ALFA
 141       Q(JASHO+5) = E0MED
 142       DO 80 KMED=1,NSMED
 143          Q(JASHO+5+KMED) = ZSMED(KMED)
 144          Q(JASHO+5+NSMED+KMED) = ESMED(KMED)
 145    80 CONTINUE
 146       NLEFT = 2*NSMED - 100
 147       CALL MZPUSH(IXCONS,JASHO,0,NLEFT,'I')
 148       END
 149 #else
 150       SUBROUTINE GIASHO_DUMMY
 151       END
 152 #endif