GEANT321/fiface/fldist.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:19:53  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.45  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE FLDIST
  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 #if !defined(CERNLIB_SINGLE)
  32       DOUBLE PRECISION SII, ZLL, SIE, ZEL, ONE, PFLUKA
  33 #endif
  34       PARAMETER (ONE=1)
  35       DIMENSION IGTOFL(49),IFLTOG(39)
  36       DATA IGTOFL / 0, 0, 0, 0, 0, 0,23,13,14,12, 15,16, 8, 1, 2,19, 0,
  37      +17,21,22, 20, 34, 36, 38, 9,18, 31, 32, 33, 35, 37, 39, 17*0/
  38
  39       DATA IFLTOG /14,15, 3, 2, 4, 4, 1,13,25, 5, 6,10, 8, 9,11,12,18,
  40      +26,16,21, 19,20, 7, 7*0, 27, 28, 29, 22, 30, 23, 31, 24, 32/
  41       IGF=0
  42 *     IF (IPART.EQ.13.AND.GEKIN.LE.0.05) THEN
  43       IF (IPART.EQ.13.AND.GEKIN.LE.0.02) THEN
  44          IGF=1
  45          CALL GPGHEI
  46          SINE = 0.
  47          SELA = 0.
  48          FSIG = 0.
  49          GO TO 999
  50       ENDIF
  51       IF (IFINIT(5) .EQ. 0) CALL FLINIT
  52       IJ = IGTOFL(IPART)
  53       ZINE  = BIG
  54       ZELA  = BIG
  55       IF(IJ.GT.0) THEN
  56          PFLUKA = SQRT(GEKIN*(GEKIN+2*AM(IJ)))
  57          JMA = LQ(JMATE-NMAT)
  58          NCOMP = ABS(Q(JMA+11))
  59          DENS = Q(JMA+8)
  60          JMIXT = LQ(JMA-5)
  61          IF ( NCOMP .LE. 1) THEN
  62             CALL NIZLNW(IJ,ONE*Z,ONE*A,ONE*GEKIN,PFLUKA, SII,ZLL)
  63             IF (ZLL.LT.BIG) THEN
  64                ZINE = ZLL/DENS
  65             END IF
  66          ELSE
  67             ZIN1 = 0.
  68             DO 10 K=1,NCOMP
  69                CALL NIZLNW(IJ,ONE*Q(JMIXT+NCOMP+K),
  70      +         ONE*Q(JMIXT+K),ONE*GEKIN,PFLUKA,SII,ZLL)
  71                IF (ZLL.GT.BIG) THEN
  72                   ZIN1 = 0.0 + ZIN1
  73                ELSE
  74                   ZIN1 = DENS*Q(JMIXT+2*NCOMP+K)/ZLL + ZIN1
  75                END IF
  76                CABINX(K) = ZIN1
  77    10       CONTINUE
  78             ANXNOR = ZIN1
  79             IF (ZIN1.GT.0.0) THEN
  80                ZINE = 1./ZIN1
  81             END IF
  82          END IF
  83          IF ( NCOMP .LE. 1) THEN
  84             CALL SIGEL (IJ,ONE*A,ONE*GEKIN,PFLUKA, SIE,ZEL)
  85             IF (ZEL.LT.BIG) THEN
  86                ZELA = ZEL/DENS
  87             END IF
  88
  89          ELSE
  90             ZEL1 = 0.
  91             DO 20 I=1,NCOMP
  92                CALL SIGEL (IJ,ONE*Q(JMIXT+I),ONE*GEKIN, PFLUKA,
  93      +         SIE,ZEL)
  94                IF (ZEL.LT.BIG) THEN
  95                   ZEL1 = DENS*Q(JMIXT+2*NCOMP+I)/ZEL + ZEL1
  96                END IF
  97                CABELX(I) = ZEL1
  98    20       CONTINUE
  99             ELXNOR = ZEL1
 100             IF (ZEL1.GT.0.0) THEN
 101                ZELA = 1./ZEL1
 102             END IF
 103          END IF
 104       ENDIF
 105       IF (ZINE.EQ.BIG) THEN
 106          SINE = 0.0
 107       ELSE
 108          SINE = 1./ZINE
 109       END IF
 110       IF (ZELA.EQ.BIG) THEN
 111          SELA = 0.0
 112       ELSE
 113          SELA = 1./ZELA
 114       END IF
 115       FSIG = SINE + SELA
 116       IF (FSIG .LE. 0) THEN
 117          SHADR = BIG
 118       ELSE
 119          SHADR = ZINTHA/FSIG
 120       END IF
 121   999 CONTINUE
 122       END