GEANT321/miface/gmplxs.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:21:53  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.47  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GMPLXS(D,LD,IGAMS,LGAM,INABS,LNAB,ITHRMS,LTHRM,
  13      + IDICTS,LDICT,NTX,NTS,IGCBS,LGCB,AWR,Q,NSEI,NAEI,NMT2,NMT4,
  14      + NMT16,NMT17,NMT18,NMT22,NMT23,NMT24,NMT28,NMT51,NMT91,
  15      + NMT102,NMT103,NMT104,NMT105,NMT106,NMT107,NMT108,NMT109,
  16      + NMT111,NMT112,NMT113,NMT114,IGCBS2,LGCB2,KZ,LR,QLR,
  17      + IIN,IIM,ID,SIGNN)
  18 C   This routine is a copy of COLISN, used to compute
  19 C   the cross-section of low-energy neutrons processes.
  20 C   The calling sequence is as the one is COLISN plus
  21 C   the ID number of the process and the output value SIGNN
  22 C                            Kati Lassila-Perini 3.12.94
  23 C
  24 #include "geant321/minput.inc"
  25 #include "geant321/mconst.inc"
  26 #include "geant321/mnutrn.inc"
  27 #include "geant321/mapoll.inc"
  28 #include "geant321/mcross.inc"
  29 #include "geant321/mmass.inc"
  30 #include "geant321/mupsca.inc"
  31 #include "geant321/mpstor.inc"
  32 #include "geant321/mmicab.inc"
  33       DIMENSION D(*),LD(*),IGAMS(*),LGAM(*),INABS(*),LNAB(*),
  34      + ITHRMS(*),LTHRM(*),IDICTS(NNR,NNUC),LDICT(NNR,NNUC),NTX(*),
  35      + NTS(*),IGCBS(NGR,NNUC),LGCB(NGR,NNUC),AWR(*),Q(NQ,NNUC),
  36      + NSEI(*),NAEI(*),NMT2(*),NMT4(*),NMT16(1),NMT17(*),NMT18(*),
  37      + NMT22(*),NMT23(*),NMT24(*),NMT28(*),NMT51(*),NMT91(*),
  38      + NMT102(*),NMT103(*),NMT104(*),NMT105(*),NMT106(*),NMT107(*),
  39      + NMT108(*),NMT109(*),NMT111(*),NMT112(*),NMT113(*),NMT114(*),
  40      + IGCBS2(NGR,NNUC),LGCB2(NGR,NNUC),KZ(*),LR(NQ,NNUC),QLR(NQ,NNUC),
  41      + FM(MAXNEU)
  42 C
  43 C
  44       CALL GTMED(NMED,MED)
  45       SIGNN = 0.
  46 C
  47       IF (ID.EQ.99) THEN
  48 C
  49 C       DETERMINE THE TOTAL NEUTRON DISAPPEARANCE (MT-102 TO MT-114
  50 C       AND MT-18)
  51          L1=LNAB(IIN)
  52          IF(L1.EQ.0) THEN
  53             SIGNN = 0.
  54          ELSE
  55             LS1=INABS(IIN)+LMOX2
  56             LEN=L1/2
  57             CALL TBSPLT(D(LS1),E,LEN,SIGNN)
  58          ENDIF
  59       ELSE
  60 C
  61          L1=LDICT(ID,IIN)
  62          IF(L1.EQ.0) THEN
  63             SIGNN = 0.
  64          ELSE
  65             LS1=IDICTS(ID,IIN)+LMOX2
  66             LEN=L1/2
  67             CALL TBSPLT(D(LS1),E,LEN,SIGNN)
  68 C
  69             IF(ID.EQ.10) THEN
  70 C       THE TREATMENT OF THE FISSION REACTION ASSUMES THE FISSION
  71 C       CROSS SECTION IS STORED AS NUBAR*SIGF
  72                L1=LDICT(134,IIN)
  73                IF(L1.EQ.0)THEN
  74                   SIGNN = 0.0
  75                ELSE
  76                   LS1=IDICTS(134,IIN)+LMOX2
  77                   LEN=L1
  78                   CALL GETNU(D(LS1),LD(LS1),EOLD,LEN,XNU)
  79                   SIGNN=SIGNN/XNU
  80                ENDIF
  81             ENDIF
  82          ENDIF
  83       ENDIF
  84 C
  85       END