GEANT321/gcons/gsmixt.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:20:17  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.19  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GSMIXT(IMAT,NAMATE,A,Z,DENS,NLMAT,WMAT)
  13 C.
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    *       Defines mixture OR COMPOUND IMAT as composed by          *
  17 C.    *       THE BASIC NLMAT materials defined by arrays A,Z and WMAT *
  18 C.    *                                                                *
  19 C.    *       If NLMAT.GT.0 then WMAT contains the PROPORTION BY       *
  20 C.    *       WEIGTHS OF EACH BASIC MATERIAL IN THE MIXTURE.           *
  21 C.    *                                                                *
  22 C.    *       If NLMAT.LT.0 then WMAT contains the number of atoms     *
  23 C.    *       of a given kind into the molecule of the COMPOUND        *
  24 C.    *       In this case, WMAT in output is changed to relative      *
  25 C.    *       weigths.                                                 *
  26 C.    *                                                                *
  27 C.    *       nb : the radiation length is computed according          *
  28 C.    *            the EGS manual slac-210 uc-32 June-78               *
  29 C.    *                           formula  2-6-8 (37)                  *
  30 C.    *                                                                *
  31 C.    *    ==>Called by : <USER>, UGEOM                                *
  32 C.    *       Authors    R.Brun, M.Maire  *********                    *
  33 C.    *                                                                *
  34 C.    ******************************************************************
  35 C.
  36 #include "geant321/gcbank.inc"
  37 #include "geant321/gcnum.inc"
  38 #include "geant321/gcunit.inc"
  39 #include "geant321/gcmzfo.inc"
  40       DIMENSION WMAT(1),A(1),Z(1)
  41       CHARACTER*(*) NAMATE
  42       CHARACTER*20 NAME
  43       DATA ALR2AV , AL183 / 1.39621E-03  ,  5.20948 /
  44 C.
  45 C.    ------------------------------------------------------------------
  46 C.
  47       IF (IMAT.LE.0)GO TO 99
  48       IF(JMATE.LE.0)THEN
  49          CALL MZBOOK(IXCONS,JMATE,JMATE,1,'MATE',NMATE,NMATE,0,3,0)
  50          IQ(JMATE-5)=0
  51       ENDIF
  52       IF(IMAT.GT.NMATE)THEN
  53          CALL MZPUSH(IXCONS,JMATE,IMAT-NMATE,0,'I')
  54          NMATE=IMAT
  55          JMA1=0
  56       ELSE
  57          JMA1=LQ(JMATE-IMAT)
  58          IF(JMA1.GT.0) THEN
  59             WRITE(CHMAIL,10000)
  60             CALL GMAIL(1,0)
  61             CALL GPMATE(IMAT)
  62             CALL MZDROP(IXCONS,LQ(JMATE-IMAT),' ')
  63          ENDIF
  64       ENDIF
  65       CALL MZBOOK(IXCONS,JMA,JMATE,-IMAT,'MATE',20,20,11,IOMATE,0)
  66 C
  67       NAME=NAMATE
  68       NCH=LNBLNK(NAME)
  69       IF(NCH.GT.0)THEN
  70          IF(NAME(NCH:NCH).EQ.'$')NAME(NCH:NCH)=' '
  71       ENDIF
  72       CALL UCTOH(NAME,IQ(JMA+1),4,20)
  73 C
  74 C             Store mixture parameters
  75 C             and parameter for Pair/Brems and
  76 C             Photoelectric routines
  77 C
  78       NLM    = IABS(NLMAT)
  79       IF (NLM.LE.0)GO TO 90
  80       CALL MZBOOK(IXCONS,JMIXT,JMA,-5,'MAMI',2,2,4*NLM,3,0)
  81       CALL MZBOOK(IXCONS,JMI1,JMIXT,-1,'MAM1',0,0,10,3,0)
  82       JMA = LQ(JMATE- IMAT)
  83       IQ(JMIXT-5)=IMAT
  84       IQ(JMI1-5)=IMAT
  85 C
  86 C             Compute proportion by weigths in the compound
  87 C
  88       IF(NLMAT.LT.0) THEN
  89          AMOL   = 0.
  90          ZMOL   = 0.
  91          DO 10 I= 1,NLM
  92          AMOL   = AMOL + WMAT(I)*A(I)
  93          ZMOL   = ZMOL + WMAT(I)*Z(I)
  94    10    CONTINUE
  95          DO 20 I= 1,NLM
  96          WMAT(I)= WMAT(I)*A(I) / AMOL
  97    20    CONTINUE
  98       ENDIF
  99 C
 100 C             Compute effective mixture parameters
 101 C
 102       AEFF   = 0.
 103       ZEFF   = 0.
 104       RADINV = 0.
 105       DO 40 I = 1,NLM
 106          AEFF   = AEFF + WMAT(I)*A(I)
 107          ZEFF   = ZEFF + WMAT(I)*Z(I)
 108          ZC     = Z(I)
 109          ALZ    = LOG(ZC)/3.
 110          XINV   = ZC*(ZC+GXSI(ZC))*(AL183-ALZ-GFCOUL(ZC))/A(I)
 111          RADINV = RADINV + WMAT(I)*XINV
 112          Q(JMIXT+3*NLM+I)=XINV
 113          Q(JMIXT + 2* NLM + I) = WMAT(I)
 114          Q(JMIXT + NLM + I) = Z(I)
 115          Q(JMIXT + I) = A(I)
 116    40 CONTINUE
 117       RADINV = ALR2AV * DENS * RADINV
 118       RADEFF = 1. / RADINV
 119       CALL GHMIX(A,WMAT,NLM,AHEFF)
 120       ABSEFF=10000.*AHEFF/(6.022*DENS*GHSIGM(5.,8,AHEFF))
 121 C
 122       Q(JMA + 6) = AEFF
 123       Q(JMA + 7) = ZEFF
 124       Q(JMA + 8) = DENS
 125       Q(JMA + 9) = RADEFF
 126       Q(JMA + 10) = ABSEFF
 127       Q(JMA + 11) = NLM
 128       Q(JMI1 + 1) = AHEFF
 129       IF(NLMAT.GT.0)THEN
 130          Q(JMI1 + 2) = AEFF
 131          Q(JMI1 + 3) = ZEFF
 132       ELSE
 133          Q(JMI1 + 2) = AMOL
 134          Q(JMI1 + 3) = ZMOL
 135       ENDIF
 136 C
 137       IF(JMA1.GT.0) THEN
 138          CALL GPMATE(-IMAT)
 139       ENDIF
 140 C
 141       GO TO 99
 142 C
 143   90  CHMAIL=' ***** GSMIXT ERROR. MIXTURE WITH NO COMPONENTS'
 144       CALL GMAIL(0,0)
 145 C
 146   99  RETURN
 147 10000 FORMAT(' *** GSMIXT ***: Warning, material redefinition:')
 148       END