GEANT321/peanut/sigfer.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:22:04  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.46  by  S.Giani
  11 *-- Author :
  12 *$ CREATE SIGFER.FOR
  13 *COPY SIGFER
  14 *
  15 *=== sigfer ===========================================================*
  16 *
  17       SUBROUTINE SIGFER ( KP, EKIN, POO, LFERMI )
  18
  19 #include "geant321/dblprc.inc"
  20 #include "geant321/dimpar.inc"
  21 #include "geant321/iounit.inc"
  22 *
  23 *----------------------------------------------------------------------*
  24 *----------------------------------------------------------------------*
  25 *
  26 #include "geant321/nucdat.inc"
  27 #include "geant321/nucgeo.inc"
  28 #include "geant321/paprop.inc"
  29       LOGICAL LFERMI
  30 *
  31       IF ( LFERMI ) THEN
  32          EKEWLL = EKIN   + VPRBIM
  33          EEMAX  = EKEWLL + EKFBIM + AMNUCL (ITNCMX) + AM (KP)
  34          PPRWLL = SQRT ( EKEWLL * ( EKEWLL + 2.D+00 * AM (KP) ) )
  35          IF ( PFRBIM .LT. PPRWLL ) THEN
  36             PPMAX  = PPRWLL + PFRBIM
  37             PPMIN  = PPRWLL - PFRBIM
  38             UMO2   = ( EEMAX + PPMAX ) * ( EEMAX - PPMAX )
  39             EKEMIN = 0.5D+00 * ( UMO2 - AM (KP)**2 - AMNUSQ (ITNCMX) )
  40      &             / AMNUCL (ITNCMX) - AM (KP)
  41             EKEMIN = MIN ( EKIN, EKEMIN )
  42             TMPEKI = 0.1666D+00 * EKIN
  43             EKEMIN = MAX ( EKEMIN, TMPEKI )
  44          ELSE
  45             EKEMIN = MAX ( 0.005D+00, 0.1666D+00 * EKIN )
  46             PPMIN  = 0.D+00
  47          END IF
  48          PPRMIN = SQRT ( EKEMIN * ( EKEMIN + 2.D+00 * AM (KP) ) )
  49          UMO2   = ( EEMAX + PPMIN ) * ( EEMAX - PPMIN  )
  50          EKEMAX =  0.5D+00 * ( UMO2 - AM (KP)**2 - AMNUSQ (ITNCMX) )
  51      &          / AMNUCL (ITNCMX) - AM (KP)
  52          PPRMAX = SQRT ( EKEMAX * ( EKEMAX + 2.D+00 * AM (KP) ) )
  53       ELSE
  54          EKEMIN = EKIN
  55          PPRMIN = POO
  56          EKEMAX = EKIN
  57          PPRMAX = POO
  58       END IF
  59 *
  60   50  CONTINUE
  61       GO TO (  100,  200,  300,  400,  500,  600,  700,  800,  900,
  62      &        1000, 1100, 1200, 1300, 1400, 1500, 1600, 1700, 1800,
  63      &        1900, 2000, 2100, 2200, 2300, 2400, 2500, 2600, 2700,
  64      &        2800, 2900, 3000, 3100, 3200, 3300, 3400, 3500, 3600,
  65      &        3700, 3800, 3900 ), KP
  66       STOP 'GEO-KP'
  67   100 CONTINUE
  68          IF ( EKEMIN .LE. 0.700D+00 ) THEN
  69             BETAPR = PPRMIN / ( EKEMIN + AM (KP) )
  70             IF ( EKEMIN .LE. 0.04D+00 ) THEN
  71                SIGMAN = 3.D+03 * PI / ( 1.206D+03 * EKEMIN + ( -1.86D+00
  72      &                + 0.09415D+03 * EKEMIN + 0.0001306D+06 * EKEMIN**2
  73      &                )**2 ) + 1.D+03 * PI / ( 1.206D+03 * EKEMIN
  74      &                + ( 0.4223D+00 + 0.13D+03 * EKEMIN )**2 )
  75                IF ( EKEMIN .LT. 0.02D+00 ) THEN
  76                   SIGMAP = 0.3333333333333333D+00 * SIGMAN
  77                ELSE
  78                   SIGMAP = 10.63D+00 / BETAPR**2 - 29.92D+00 / BETAPR
  79      &                   + 42.9D+00
  80                END IF
  81             ELSE
  82                SIGMAN = 34.10D+00 / BETAPR**2 - 82.2D+00 / BETAPR
  83      &                + 82.2D+00
  84                SIGMAP = 10.63D+00 / BETAPR**2 - 29.92D+00 / BETAPR
  85      &                + 42.9D+00
  86             END IF
  87          ELSE
  88             STOP 'Sigfer: EKE'
  89          END IF
  90       GO TO 4000
  91   200 CONTINUE
  92       GO TO 4000
  93   300 CONTINUE
  94       GO TO 4000
  95   400 CONTINUE
  96       GO TO 4000
  97   500 CONTINUE
  98       GO TO 4000
  99   600 CONTINUE
 100       GO TO 4000
 101   700 CONTINUE
 102          SIGMAN = 0.D+00
 103          SIGMAP = 0.D+00
 104       GO TO 4000
 105   800 CONTINUE
 106          IF ( EKEMIN .LE. 0.700D+00 ) THEN
 107             BETAPR = PPRMIN / ( EKEMIN + AM (KP) )
 108             IF ( EKEMIN .LE. 0.04D+00 ) THEN
 109                SIGMAP = 3.D+03 * PI / ( 1.206D+03 * EKEMIN + ( -1.86D+00
 110      &                + 0.09415D+03 * EKEMIN + 0.0001306D+06 * EKEMIN**2
 111      &                )**2 ) + 1.D+03 * PI / ( 1.206D+03 * EKEMIN
 112      &                + ( 0.4223D+00 + 0.13D+03 * EKEMIN )**2 )
 113                IF ( EKEMIN .LT. 0.02D+00 ) THEN
 114                   SIGMAN = 0.3333333333333333D+00 * SIGMAP
 115                ELSE
 116                   SIGMAN = 10.63D+00 / BETAPR**2 - 29.92D+00 / BETAPR
 117      &                   + 42.9D+00
 118                END IF
 119             ELSE
 120                SIGMAP = 34.10D+00 / BETAPR**2 - 82.2D+00 / BETAPR
 121      &                + 82.2D+00
 122                SIGMAN = 10.63D+00 / BETAPR**2 - 29.92D+00 / BETAPR
 123      &                + 42.9D+00
 124             END IF
 125          ELSE
 126             STOP 'Sigfer: EKE'
 127          END IF
 128       GO TO 4000
 129   900 CONTINUE
 130       GO TO 4000
 131  1000 CONTINUE
 132       GO TO 4000
 133  1100 CONTINUE
 134       GO TO 4000
 135  1200 CONTINUE
 136       GO TO 4000
 137  1300 CONTINUE
 138       GO TO 4000
 139  1400 CONTINUE
 140       GO TO 4000
 141  1500 CONTINUE
 142       GO TO 4000
 143  1600 CONTINUE
 144       GO TO 4000
 145  1700 CONTINUE
 146       GO TO 4000
 147  1800 CONTINUE
 148       GO TO 4000
 149  1900 CONTINUE
 150       GO TO 4000
 151  2000 CONTINUE
 152       GO TO 4000
 153  2100 CONTINUE
 154       GO TO 4000
 155  2200 CONTINUE
 156       GO TO 4000
 157  2300 CONTINUE
 158       GO TO 4000
 159  2400 CONTINUE
 160       GO TO 4000
 161  2500 CONTINUE
 162       GO TO 4000
 163  2600 CONTINUE
 164       GO TO 4000
 165  2700 CONTINUE
 166       GO TO 4000
 167  2800 CONTINUE
 168       GO TO 4000
 169  2900 CONTINUE
 170       GO TO 4000
 171  3000 CONTINUE
 172       GO TO 4000
 173  3100 CONTINUE
 174       GO TO 4000
 175  3200 CONTINUE
 176       GO TO 4000
 177  3300 CONTINUE
 178       GO TO 4000
 179  3400 CONTINUE
 180       GO TO 4000
 181  3500 CONTINUE
 182       GO TO 4000
 183  3600 CONTINUE
 184       GO TO 4000
 185  3700 CONTINUE
 186       GO TO 4000
 187  3800 CONTINUE
 188       GO TO 4000
 189  3900 CONTINUE
 190       GO TO 4000
 191  4000 CONTINUE
 192       SIGMAP = 0.1D+00 * SIGMAP
 193       SIGMAN = 0.1D+00 * SIGMAN
 194       RETURN
 195 *=== End of subroutine sigfer =========================================*
 196       END