GEANT321/neutron/xsecn5.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:22:00  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.48  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE XSECN5(NTX,IGCBS,LGCB,IGCBS2,LGCB2,BUF,IBUF,D,LD,
  13      +LIM,LAST)
  14 C       THIS ROUTINE READS THE PHOTON PARTIAL DISTRIBUTIONS FOR EACH
  15 C       REACTION LISTED IN THE GCB ARRAYS AND SUMS THEM UP TO
  16 C       CREATE A TOTAL MULTIPLICITY * CROSS SECTION ARRAY FOR
  17 C       EACH REACTION AND STORES THIS CROSS SECTION DATA IN CORE
  18 #include "geant321/minput.inc"
  19 #include "geant321/mconst.inc"
  20 #include "geant321/mmicab.inc"
  21       DIMENSION NTX(NNUC),IGCBS(NGR,NNUC),LGCB(NGR,NNUC),
  22      +IGCBS2(NGR,NNUC),LGCB2(NGR,NNUC),BUF(*),IBUF(*),D(*),LD(*)
  23 C       ASSIGN THE DEFAULT VALUES
  24       LEN=0
  25 C       INITIALIZE THE COUNTERS FOR THE LOOP
  26 C       LAST EQUALS THE LAST CORE POSITION USED IN THE CALLING
  27 CROUTINE (INPUT1)
  28 C       LST EQUALS THE LAST POSITION USED IN THE BUF ARRAY
  29 C   (I.E. (BUF(LST) = D(LAST)))
  30       LST=0
  31       DO 70 I=1,NNUC
  32          NNTX=NTX(I)
  33          L=2*NNTX
  34          IF(L.EQ.0)GO TO 70
  35          DO 60 I2=1,NNTX
  36             LZ=LGCB(2*I2,I)
  37             IF(LZ.EQ.0)GO TO 60
  38             LEN=LIM-LAST
  39             IF(LEN.LT.LZ)GO TO 80
  40 C       EQUATE THE MT NUMBERS IN THE GCB AND GCB2 DICTIONARIES
  41             IGCBS2(2*I2-1,I)=IGCBS(2*I2-1,I)
  42             LGCB2(2*I2-1,I)=LGCB(2*I2-1,I)
  43 C       SET THE STARTING LOCATION FOR THE PHOTON TOTAL CROSS SECTION
  44             IGCBS2(2*I2,I)=LAST+1-LMOX4
  45 C       OBTAIN THE STARTING LOCATION OF THE PARTIAL DISTRIBUTIONS
  46             IST=IGCBS(2*I2,I)+LMOX2
  47             NK=LD(IST)
  48             NP=LD(IST+1)
  49             NP2=2*NP
  50             LGCB2(2*I2,I)=NP2
  51 C       ZERO OUT THE CORE AREA TO STORE THE TOTAL PHOTON
  52 C       MULTIPLICITY * CROSS SECTION ARRAYS
  53             DO 10 IP=1,NP2
  54                BUF(LST+IP)=0.0
  55    10       CONTINUE
  56 C       SET UP THE ENERGY BOUNDARIES FOR THE (E,XS) TABLE
  57             DO 20 J=1,NP
  58                BUF(LST+2*J-1)=D(IST+J+2-1)
  59    20       CONTINUE
  60             II=NP+2
  61             AWRI=D(IST+II+3-1)
  62 C       SUM THE PARTIAL DISTRIBUTIONS TO OBTAIN THE TOTAL
  63 C       MULTIPLICITY * CROSS SECTION ARRAY AND STORE IN THE
  64 C       ENERGY,CROSS SECTION TABLE
  65             DO 40 J=1,NK
  66                II=II+4
  67                DO 30 K=1,NP
  68                   BUF(LST+2*K)=BUF(LST+2*K)+D(IST+II+K-1)
  69    30          CONTINUE
  70                II=II+NP
  71    40       CONTINUE
  72    50       CONTINUE
  73 C       UPDATE CORE LOCATION POINTERS
  74             LAST=LAST+NP2
  75             LST=LST+NP2
  76    60    CONTINUE
  77    70 CONTINUE
  78       RETURN
  79    80 WRITE(IOUT,10000)LZ,LEN
  80 10000 FORMAT(' MICAP: NOT ENOUGH SPACE TO READ IN RECORD',/,5X,
  81      +'LENGTH OF RECORD=',I10,/,5X,'SPACE AVAILABLE=',I10)
  82       PRINT '('' CALOR: ERROR in XSECN5 ====> STOP '')'
  83       STOP
  84       END