This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / 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