GEANT321/fluka/sigint.F

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