GEANT321/neutron/isotpe.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:21:57  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/04 23/02/95  14.46.01  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE ISOTPE(D,LD,KM,RHO,IN,IDICTS,LDICT,E,TSIG,NMED,
  13      +                  IIN,IIM)
  14 C       THIS ROUTINE DETERMINES WHICH ISOTOPE HAS BEEN STRUCK
  15 C       IN MEDIA NMED
  16 #include "geant321/minput.inc"
  17 #include "geant321/mconst.inc"
  18 #include "geant321/mmicab.inc"
  19 C
  20       DIMENSION D(*),LD(*),KM(*),RHO(*),IN(*),IDICTS(NNR,NNUC),
  21      +          LDICT(NNR,NNUC)
  22       SAVE
  23 C
  24       R=FLTRNF(0)
  25       NOA=0
  26       SUM=0.
  27 #if defined(CERNLIB_MDEBUG)
  28       DO 10 K=1,NMIX
  29          IF(KM(K).NE.NMED)GO TO 10
  30 C       DETERMINE ISOTOPE NUMBER
  31          K1=IN(K)
  32          K2=K
  33 C       DETERMINE TOTAL CROSS SECTION FOR THIS ISOTOPE
  34          LS1=IDICTS(1,K1)+LMOX2
  35          L1=LDICT(1,K1)
  36          LEN=L1/2
  37          CALL TBSPLT(D(LS1),E,LEN,X)
  38          SUM=SUM+X*RHO(K)
  39          PRINT *,' ISOTPE: K=',K,' RHO=',RHO(K),' Sig=',X*RHO(K),
  40      +       ' SUM=',SUM,' TSIG=',TSIG,' R=',R
  41    10 CONTINUE
  42       SUM = 0.0
  43 #endif
  44    20 DO 30 K=1,NMIX
  45          IF(KM(K).NE.NMED)GO TO 30
  46 C       DETERMINE ISOTOPE NUMBER
  47          K1=IN(K)
  48          K2=K
  49 C       DETERMINE TOTAL CROSS SECTION FOR THIS ISOTOPE
  50          LS1=IDICTS(1,K1)+LMOX2
  51          L1=LDICT(1,K1)
  52          LEN=L1/2
  53          CALL TBSPLT(D(LS1),E,LEN,X)
  54          SUM=SUM+X*RHO(K)
  55 C       CHECK TO SEE IF THIS ISOTOPE WAS HIT
  56          IF(R.LE.SUM/TSIG)GO TO 40
  57    30 CONTINUE
  58 C       AN ISOTOPE WAS NOT CHOSEN, TRY AGAIN
  59       NOA=NOA+1
  60       IF(NOA.GT.5)GO TO 50
  61       SUM=0.0
  62       R=FLTRNF(0)
  63       GO TO 20
  64    40 IIN=K1
  65       IIM=K2
  66 #if defined(CERNLIB_MDEBUG)
  67       PRINT *,' Isotope chosen : K=',K
  68 #endif
  69       RETURN
  70    50 WRITE(IOUT,10000)NMED,TSIG
  71 10000 FORMAT(' MICAP: AN ISOTOPE WAS NOT CHOSEN IN 5 ATTEMPTS IN ',
  72      +'ROUTINE ISOTPE',/,3X,'MEDIUM=',I5,5X,'MACROSCOPIC XSEC=',
  73      +1PE12.4)
  74       WRITE(IOUT,10100)R,SUM,TSIG,X,E,RHO(K2),NMED,K1,K2
  75 10100 FORMAT('0',1X,1P6E12.4,3I10)
  76       WRITE(6,*) ' CALOR: ERROR in ISOTPE =====> STOP '
  77       STOP
  78       END