GEANT321/fluka/shptot.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:20:04  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 *$ CREATE SHPTOT.FOR
  13 *COPY SHPTOT
  14 *
  15 *=== shptot ===========================================================*
  16 *
  17       FUNCTION SHPTOT(IT,PO)
  18
  19 #include "geant321/dblprc.inc"
  20 #include "geant321/dimpar.inc"
  21 #include "geant321/iounit.inc"
  22 C********************************************************************
  23 C   LAST CHANGE 25.11 -86 BY PERTTI AARNIO
  24 C
  25 C
  26 C   TOTAL HADRON-PROTON CROSS SECTIONS
  27 C   PLAB.GE.10 GEV
  28 C
  29 C********************************************************************
  30 #include "geant321/paprop.inc"
  31       REAL RNDM(1)
  32 C
  33       F1=1.D0
  34       ITT=IT
  35       AMIT2=AM(ITT)**2
  36       UMO2=AMIT2 + AM(1)**2 + 2.D0*AM(1)*(PO+0.5D0*AMIT2/PO)
  37       UMO=SQRT(UMO2)
  38 C
  39       A4=0.D0
  40       A5=0.D0
  41       A6=0.D0
  42 C
  43       GO TO
  44      * (1,1,50,50,50,50,50,2,2,50,50,5,3,3,4,4,8,8,5,8,8,8,50,6,7,
  45      *  1,1,1,1,1,1,1,1,1,1,1,1,1,1), ITT
  46 C
  47  1    CONTINUE
  48       A1=38.4D0
  49       A2=0.46D0
  50       A3=125.D0
  51       IF(ITT.EQ.1) GOTO 100
  52       A5=84.1D0
  53       A6=0.43D0
  54       GOTO 100
  55 C
  56  2    CONTINUE
  57       A1=38.5D0
  58       A2=0.46D0
  59       A3=125.D0
  60       A4=15.D0
  61       IF(ITT.EQ.8) GOTO 100
  62       A5=77.43D0
  63       A6=0.40D0
  64       GOTO 100
  65 C
  66  3    CONTINUE
  67       IF(UMO.LT.47.D0) GOTO 31
  68       F1=0.6667D0
  69       ITT=1
  70       GOTO 1
  71  31   CONTINUE
  72       A1=24.D0
  73       A2=0.60D0
  74       A3=160.D0
  75 *   Very very crude patch for the pion- elastic xsec problem
  76 *     IF(ITT.EQ.13) GOTO 100
  77       IF(ITT.EQ.13.OR.ITT.EQ.14) GOTO 100
  78       A5=7.9D0
  79       A6=0.54D0
  80       GOTO 100
  81 C
  82  4    CONTINUE
  83       IF(UMO.LT.110.D0) GOTO 41
  84       F1=0.6667D0
  85       ITT=1
  86       GOTO 1
  87  41   CONTINUE
  88       A1=20.3D0
  89       A2=0.59D0
  90       A3=140.D0
  91       IF(ITT.EQ.15) GOTO 100
  92       A5=30.13D0
  93       A6=0.42D0
  94       GOTO 100
  95 C
  96  5    CONTINUE
  97       ITT=15
  98       CALL GRNDM(RNDM,1)
  99       IF(RNDM(1).LT.0.5D0) ITT=16
 100       GOTO 4
 101 C
 102  6    CONTINUE
 103 C***
 104 C   K-ZERO:  SET EQUAL TO K-/PROTON
 105 C            (SHOULD BE K-/NEUTRON)
 106 C***
 107       ITT=16
 108       GOTO 4
 109 C
 110  7    CONTINUE
 111 C***
 112 C   K-ZERO BAR:  SET EQUAL TO K+/PROTON
 113 C                (SHOULD BE K+/NEUTRON)
 114 C***
 115       ITT=15
 116       GOTO 4
 117 C
 118  8    CONTINUE
 119 C***
 120 C   SIGMA +/-/0  AND  LAMBDA/LAMBDA BAR:  SET EQUAL TO P-P
 121 C***
 122       ITT=1
 123       GOTO 1
 124 C
 125  50   CONTINUE
 126 C***
 127 C   LEPTONS AND PI0
 128 C***
 129       SHPTOT=1.D-10
 130       RETURN
 131 C
 132  100  CONTINUE
 133 C
 134       SHPTOT=A1+A2*(LOG(UMO2/A3))**2+A4/UMO2+A5*UMO2**A6
 135       SHPTOT=F1*SHPTOT
 136       RETURN
 137       END