GEANT321/fluka/fksigi.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:20:06  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 *=== sigint ===========================================================*
  13 *
  14       SUBROUTINE FKSIGI (IRE ,PLAB,N,IE ,AMT ,AMN,ECM ,SI ,ITAR)
  15
  16 #include "geant321/dblprc.inc"
  17 #include "geant321/dimpar.inc"
  18 #include "geant321/iounit.inc"
  19 *
  20 #include "geant321/reac.inc"
  21 #include "geant321/redver.inc"
  22 *
  23 **** *,IEII,IKII,NURE
  24       COMMON / FKABLT / AM   (110), GA   (110), TAU  (110), ICH   (110),
  25      &                  IBAR (110), K1   (110), K2   (110)
  26 *
  27       IE=IEFUN(PLAB,IRE)
  28       IF (IE.LE.IEII(IRE)) IE=IE+1
  29       AMT=AM(ITAR)
  30       AMN=AM(N)
  31       AMN2=AMN*AMN
  32       AMT2=AMT*AMT
  33       ECM=SQRT(AMN2+AMT2+2.D0*AMT*SQRT(AMN2+PLAB**2))
  34 C*** INTERPOLATION PREPARATION
  35       ECMO=UMO(IE)
  36       ECM1=UMO(IE-1)
  37       DECM=ECMO-ECM1
  38       DEC=ECMO-ECM
  39       IIKI=IKII(IRE)+1
  40       EKLIM=-THRESH(IIKI)
  41       WOK=SIIN(IE)
  42       WDK=WOK-SIIN(IE-1)
  43       IF (ECM.GT.ECMO) WDK=0.D0
  44 C*** INTERPOLATION IN CHANNEL WEIGHTS
  45       IELIM=IEFUN(EKLIM,IRE)
  46       DELIM=UMO(IELIM)+EKLIM
  47      *+1.D-16
  48       DETE=(ECM-(ECMO-EKLIM)*.5D0)*2.D0
  49       IF (DELIM*DELIM-DETE*DETE) 112,112,113
  50   113 DECC=DELIM
  51       GO TO 114
  52   112 DECC=DECM
  53   114 CONTINUE
  54       WKK=WOK-WDK*DEC/(DECC+1.D-9)
  55       IF (WKK.LT.0.D0) WKK=0.D0
  56       SI=WKK+1.D-12
  57       IF (-EKLIM.GT.ECM) SI=1.D-14
  58       RETURN
  59       END