GEANT321/fluka/rchanv.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:19:58  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.44  by  S.Giani
  11 *-- Author :
  12 *$ CREATE RCHANV.FOR
  13 *COPY RCHANV
  14 *
  15 *=== rchanv ===========================================================*
  16 *
  17       SUBROUTINE RCHANV
  18
  19 #include "geant321/dblprc.inc"
  20 #include "geant321/dimpar.inc"
  21 #include "geant321/iounit.inc"
  22 *
  23 #include "geant321/hadflg.inc"
  24 #include "geant321/reac.inc"
  25 #include "geant321/redver.inc"
  26 #include "geant321/split.inc"
  27 *
  28       COMMON / FKABLT / AM   (110), GA   (110), TAU  (110), ICH   (110),
  29      &                  IBAR (110), K1   (110), K2   (110)
  30 *  Note: 296 are the total number of energy at which data are tabulated
  31 *        (of course for the 17 reactions considered, depending on the
  32 *         reaction there could be different numbers of tabulated
  33 *         energies)
  34 *        268 is the number of possible exit channels
  35 *        Umo (ieii(ire)+ie) is the cms energy corresponding to the ieth
  36 *        energy at which data are tabulated for the reaction ire
  37 *        Plabf (ieii(ire)+ie) is the corresponding lab momentum
  38 *        Siin  (ieii(ire)+ie) is the cross section
  39       DIMENSION HWT(460)
  40       DIMENSION HWK(40)
  41       DIMENSION SI(5184)
  42       EQUIVALENCE (WK(1),SI(1))
  43 C*** WEIGHTS FOR THE SAMPLING PROCEDURE (ADDED ONE TO EACH OTHER IN
  44 C*** CORRESP. CHANNELS) SPECIFIC FOR NUCRIN ONLY
  45 C*** CALCULATION OF THRESHOLD ENERGY OF THE REACTION CHANNELS
  46 C
  47       IREG=16
  48 *  +-------------------------------------------------------------------*
  49 *  |  Loop on the possible reactions (pi+ p, .... )
  50       DO 222 IRE=1,IREG
  51 *  |  Initial index for the exit channel sigmas/weights for reaction IRE
  52 *  |  (wk(ire+1)-wk(ire+iee), weights at the various energies for the
  53 *  |  first channel, wk(ire+(ik-1)*iee+ie), weight of the ikth channel
  54 *  |  at ieth energy)
  55          IWKO=IRII(IRE)
  56 *  |  Number of energy tabulations for reaction ire
  57          IEE=IEII(IRE+1)-IEII(IRE)
  58 *  |  Number of exit channels of reaction ire
  59          IKE=IKII(IRE+1)-IKII(IRE)
  60 *  |  Index for the initial energy tabulation for reaction ire (this is
  61 *  |  for index 1!!, ieii is for index 0)
  62          IEO=IEII(IRE)+1
  63 *  |  Index for the initial exit channel of the reaction ire
  64 *  |  (the initial channel is IIKI + 1)
  65          IIKI=IKII(IRE)
  66 *  |  +----------------------------------------------------------------*
  67 *  |  |  This loop checks the threshold (expressed in invariant mass)
  68 *  |  |  for the several reaction channels:
  69 *  |  |  Channels resulting in two exit particles/resonances are
  70 *  |  |  checked for Thresh >= m(1) + m(2)
  71 *  |  |  Channels resulting in only one resonance are checked for
  72 *  |  |  Thresh >= Min_j (m_j(1)+m_j(2)+m_j(3)), where the minimum
  73 *  |  |  is carried out looping over all possible decay channels j
  74 *  |  |  and now also looking for the mass of the resonance
  75 *  |  |  less 5 x width
  76          DO 226 IK=1,IKE
  77             INRK1 = NRK(1,IIKI+IK)
  78             INRK2 = NRK(2,IIKI+IK)
  79             AM111 = AM (INRK1)
  80 *  |  |  +-------------------------------------------------------------*
  81 *  |  |  |  Two particles/resonances exit channels
  82             IF ( INRK2 .GT. 0 ) THEN
  83                AM222 = AM (INRK2)
  84                THRESH (IIKI+IK) = AM111 + AM222
  85 *  |  |  |
  86 *  |  |  +-------------------------------------------------------------*
  87 *  |  |  |  One resonance exit channel
  88             ELSE
  89                IF ( GA (INRK1) .GT. ANGLGB ) THEN
  90                   AM111 = AM111 - 5.D+00 * GA (INRK1)
  91                ELSE
  92                   AM111 = 0.D+00
  93                END IF
  94                INRKK = K1(INRK1)
  95                AMSS  = 5.D+00
  96                INRKO = K2(INRK1)
  97 *  |  |  |  +----------------------------------------------------------*
  98 *  |  |  |  |  Loop over the decay channels
  99                DO 228 INKK=INRKK,INRKO
 100                   INZK1=NZK(INKK,1)
 101                   INZK2=NZK(INKK,2)
 102                   INZK3=NZK(INKK,3)
 103                   AMS = AM(INZK1)+AM(INZK2)-2.D+00*(GA(INZK1)+GA(INZK2))
 104                   IF (INZK3 .GT. 0)  AMS =AMS+AM(INZK3)-2.D+00*GA(INZK3)
 105                   IF (AMSS  .GT.AMS) AMSS=AMS
 106   228          CONTINUE
 107 *  |  |  |  |
 108 *  |  |  |  +----------------------------------------------------------*
 109                AMS = MAX (AMSS,AM111)
 110                IF ( AMS .LT. UMO(IEO) ) AMS = UMO (IEO)
 111                THRESH (IIKI+IK) = AMS
 112             END IF
 113 *  |  |  |
 114 *  |  |  +-------------------------------------------------------------*
 115   226    CONTINUE
 116 *  |  |
 117 *  |  +----------------------------------------------------------------*
 118          SINORC = 1.D+00
 119 *  |  +----------------------------------------------------------------*
 120 *  |  |  Loop on the energy tabulations
 121          DO 221 IE=1,IEE
 122             SIS=ANGLGB/10.D+00
 123             PLASQ = PLABF (IEO+IE-1)**2
 124             UMOSQ = ( SQRT ( AM (INNURE(1,1,IRE))**2 + PLASQ )
 125      &            + AM (INNURE(2,1,IRE)) )**2 - PLASQ
 126             IF ( INNURE (1,2,IRE) .GT. 0 )
 127      &         UMOSQ = MAX ( UMOSQ, ( SQRT ( AM (INNURE(1,2,IRE))**2
 128      &               + PLASQ ) + AM (INNURE(2,2,IRE)) )**2 - PLASQ )
 129 *  |  |  +-------------------------------------------------------------*
 130 *  |  |  |  Loop on the exit channels
 131             DO 223 IK=1,IKE
 132 *  |  |  |  IWK index of the sigma (weight) of the IKth exit channel of
 133 *  |  |  |  reaction IRE at energy IE
 134                IWK=IWKO+IEE*(IK-1)+IE
 135 *  |  |  |  NRK (i,iiki+ik), i=1,2 are the two resonances produced by
 136 *  |  |  |  the exit channel ik of the reaction ire: 0 means no second
 137 *  |  |  |  resonance
 138 *  |  |  |  +----------------------------------------------------------*
 139 *  |  |  |  |  Check that cross section is 0 below the computed
 140 *  |  |  |  |  threshold
 141                IF ( UMOSQ .GE. THRESH (IIKI+IK)**2 ) THEN
 142                   SIS=SIS+SI(IWK)*SINORC
 143 *  |  |  |  |
 144 *  |  |  |  +----------------------------------------------------------*
 145 *  |  |  |  |
 146                ELSE
 147                   SI(IWK)=0.D+00
 148                END IF
 149 *  |  |  |  |
 150 *  |  |  |  +----------------------------------------------------------*
 151   223       CONTINUE
 152 *  |  |  |
 153 *  |  |  +-------------------------------------------------------------*
 154             SIIN(IEO+IE-1)=SIS
 155             SIO=0.D+00
 156 *  |  |  +-------------------------------------------------------------*
 157 *  |  |  |
 158             IF (SIS.LE.ANGLGB) THEN
 159                SIS=1.D+00
 160                SIO=1.D+00
 161             END IF
 162 *  |  |  |
 163 *  |  |  +-------------------------------------------------------------*
 164 *  |  |  +-------------------------------------------------------------*
 165 *  |  |  |
 166             DO 224 IK=1,IKE
 167                IWK=IWKO+IEE*(IK-1)+IE
 168                SIO=SIO+SI(IWK)/SIS*SINORC
 169                HWK(IK)=SIO
 170   224       CONTINUE
 171 *  |  |  |
 172 *  |  |  +-------------------------------------------------------------*
 173 *  |  |  +-------------------------------------------------------------*
 174 *  |  |  |
 175             DO 225 IK=1,IKE
 176                IWK=IWKO+IEE*(IK-1)+IE
 177                WK(IWK)=HWK(IK)
 178   225       CONTINUE
 179 *  |  |  |
 180 *  |  |  +-------------------------------------------------------------*
 181   221    CONTINUE
 182 *  |  |
 183 *  |  +----------------------------------------------------------------*
 184   222 CONTINUE
 185 *  |
 186 *  +-------------------------------------------------------------------*
 187 *  +-------------------------------------------------------------------*
 188 *  |
 189       DO 3 J=1,460
 190          HWT(J)=0.D+00
 191     3 CONTINUE
 192 *  |
 193 *  +-------------------------------------------------------------------*
 194 *  +-------------------------------------------------------------------*
 195 *  |
 196       DO 1 I=1,110
 197          IK1=K1(I)
 198          IK2=K2(I)
 199          HV=0.D+00
 200          DO 2 J=IK1,IK2
 201             HV=HV+WT(J)
 202             HWT(J)=HV
 203             JI=J
 204     2    CONTINUE
 205          IF (ABS(HV-1.D0).GT.1.D-4)WRITE(LUNOUT,101)
 206   101    FORMAT(44H ERROR IN HWT BECAUSE OF FALSE USE OF RCHANW)
 207     1 CONTINUE
 208 *  |
 209 *  +-------------------------------------------------------------------*
 210 *  +-------------------------------------------------------------------*
 211 *  |
 212       DO 4 J=1,460
 213          WT(J)=HWT(J)
 214     4 CONTINUE
 215 *  |
 216 *  +-------------------------------------------------------------------*
 217 * Set a flag for hadrin that elastic collisions must be reduced
 218 * because they will occur inside nuclei
 219       IELFLG = -1
 220       ICXFLG = -1
 221       RETURN
 222       END