GEANT321/miface/gfmdis.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:21:53  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.47  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GFMDIS
  13 #include "geant321/gcflag.inc"
  14 #include "geant321/gcbank.inc"
  15 #include "geant321/gckine.inc"
  16 #include "geant321/gctrak.inc"
  17 #include "geant321/gcmate.inc"
  18 #include "geant321/gconsp.inc"
  19 #include "geant321/gcphys.inc"
  20 #include "geant321/gcjloc.inc"
  21 #include "geant321/dimpar.inc"
  22 #if !defined(CERNLIB_SINGLE)
  23 #include "geant321/comcont.inc"
  24 #endif
  25 #include "geant321/comcon.inc"
  26 #if !defined(CERNLIB_SINGLE)
  27 #include "geant321/partt.inc"
  28 #endif
  29 #include "geant321/part.inc"
  30 #include "geant321/gfkdis.inc"
  31       LOGICAL BTEST
  32 #if !defined(CERNLIB_SINGLE)
  33       DOUBLE PRECISION SII, ZLL, SIE, ZEL, ONE, PFLUKA
  34 #endif
  35       PARAMETER (ONE=1)
  36       DIMENSION IGTOFL(49),IFLTOG(39)
  37       DATA IGTOFL / 0, 0, 0, 0, 0, 0,23,13,14,12, 15,16, 8, 1, 2,19, 0,
  38      +17,21,22, 20, 34, 36, 38, 9,18, 31, 32, 33, 35, 37, 39, 17*0/
  39
  40       DATA IFLTOG /14,15, 3, 2, 4, 4, 1,13,25, 5, 6,10, 8, 9,11,12,18,
  41      +26,16,21, 19,20, 7, 7*0, 27, 28, 29, 22, 30, 23, 31, 24, 32/
  42       IGF=0
  43 *  Neutrons below 20 MeV kinetic energy passed to MICAP
  44       IF (IPART.EQ.13.AND.GEKIN.LE.0.02) THEN
  45          IF (IFINIT(7).EQ.0) CALL GMORIN
  46 * Check that the correct cross-section exists. K.L-P 16.11.93
  47 * BTEST checks if the 0th bit hase been set to 1 (see GMORIN)
  48          IF (BTEST(IQ(JMA),0))
  49      +  PRINT *,'*** MICAP: Cross sections for NMAT',NMAT,' not known'
  50          IGF=2
  51          SIG = SIGMOR(GEKIN*1.E+9,NMAT)
  52          IF( SIG .GT. 0.0) THEN
  53            SHADR = ZINTHA/SIG
  54          ELSE
  55            SHADR = BIG
  56          ENDIF
  57          GO TO 999
  58       ENDIF
  59 *
  60 *   FLUKA initialization
  61       IF (IFINIT(5) .EQ. 0) CALL FLINIT
  62 *   Computation of elastic (SIGEL) and inelastic (NIZLNW)
  63 *   cross-section for each element
  64       IJ = IGTOFL(IPART)
  65       ZINE  = BIG
  66       ZELA  = BIG
  67       IF(IJ.GT.0) THEN
  68          PFLUKA = SQRT(GEKIN*(GEKIN+2*AM(IJ)))
  69          JMA = LQ(JMATE-NMAT)
  70          NCOMP = ABS(Q(JMA+11))
  71          DENS = Q(JMA+8)
  72          JMIXT = LQ(JMA-5)
  73          IF ( NCOMP .LE. 1) THEN
  74             CALL NIZLNW(IJ,ONE*Z,ONE*A,ONE*GEKIN,PFLUKA, SII,ZLL)
  75             IF (ZLL.LT.BIG) THEN
  76                ZINE = ZLL/DENS
  77             END IF
  78          ELSE
  79             ZIN1 = 0.
  80             DO 10 K=1,NCOMP
  81                CALL NIZLNW(IJ,ONE*Q(JMIXT+NCOMP+K),
  82      +         ONE*Q(JMIXT+K),ONE*GEKIN,PFLUKA,SII,ZLL)
  83                IF (ZLL.GT.BIG) THEN
  84                   ZIN1 = 0.0 + ZIN1
  85                ELSE
  86                   ZIN1 = DENS*Q(JMIXT+2*NCOMP+K)/ZLL + ZIN1
  87                END IF
  88                CABINX(K) = ZIN1
  89    10       CONTINUE
  90             ANXNOR = ZIN1
  91             IF (ZIN1.GT.0.0) THEN
  92                ZINE = 1./ZIN1
  93             END IF
  94          END IF
  95          IF ( NCOMP .LE. 1) THEN
  96             CALL SIGEL (IJ,ONE*A,ONE*GEKIN,PFLUKA, SIE,ZEL)
  97             IF (ZEL.LT.BIG) THEN
  98                ZELA = ZEL/DENS
  99             END IF
 100
 101          ELSE
 102             ZEL1 = 0.
 103             DO 20 I=1,NCOMP
 104                CALL SIGEL (IJ,ONE*Q(JMIXT+I),ONE*GEKIN, PFLUKA,
 105      +         SIE,ZEL)
 106                IF (ZEL.LT.BIG) THEN
 107                   ZEL1 = DENS*Q(JMIXT+2*NCOMP+I)/ZEL + ZEL1
 108                END IF
 109                CABELX(I) = ZEL1
 110    20       CONTINUE
 111             ELXNOR = ZEL1
 112             IF (ZEL1.GT.0.0) THEN
 113                ZELA = 1./ZEL1
 114             END IF
 115          END IF
 116       ENDIF
 117       IF (ZINE.EQ.BIG) THEN
 118          SINE = 0.0
 119       ELSE
 120          SINE = 1./ZINE
 121       END IF
 122       IF (ZELA.EQ.BIG) THEN
 123          SELA = 0.0
 124       ELSE
 125          SELA = 1./ZELA
 126       END IF
 127       FSIG = SINE + SELA
 128       IF (FSIG .LE. 0) THEN
 129          SHADR = BIG
 130       ELSE
 131          SHADR = ZINTHA/FSIG
 132       END IF
 133   999 CONTINUE
 134       END