GEANT321/neutron/xsecn2.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/04 23/02/95  14.46.01  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE XSECN2(ICOM,IREC,IUNIT,IGAMS,LGAM,ELTOL,INABS,LNAB,
  13      + ITHRMS,LTHRM,IDICTS,LDICT,NTX,NTS,IGCBS,LGCB,AWR,Q,LR,QLR,
  14      + BUF,IBUF,LIM,LAST,INEL)
  15 C       THIS ROUTINE READS THE REMAINDER OF INPUT I/O UNIT(s),
  16 C       SELECTS THE ELEMENTS NEEDED FOR THE CALCULATIONS,
  17 C       AND STORES THE CROSS SECTION DATA IN CORE
  18 #include "geant321/minput.inc"
  19 #include "geant321/mconst.inc"
  20 #include "geant321/mmicab.inc"
  21       CHARACTER*4 MARK
  22       DIMENSION BUF(*),IBUF(*),ICOM(*),IGAMS(*),LGAM(*),INABS(*),
  23      +LNAB(*),ITHRMS(*),LTHRM(*),AWR(*),IDICTS(NNR,NNUC),ELTOL(*),
  24      +LDICT(NNR,NNUC),Q(NQ,NNUC),NTX(*),NTS(*),IGCBS(NGR,NNUC),
  25      +LGCB(NGR,NNUC),IREC(*),LR(NQ,NNUC),QLR(NQ,NNUC)
  26       DIMENSION INEL(*),IUNIT(*)
  27 C       ASSIGN THE DEFAULT VALUES
  28       LEN=0
  29 C       INITIALIZE THE COUNTERS FOR THE LOOP
  30 C       NISR EQUALS THE NUMBER OF ISOTOPES READ
  31 C       IRECNO EQUALS THE NEXT RECORD NUMBER TO BE READ ON INPUT
  32 C  I/O UNIT (NUNIT)
  33 C       LAST EQUALS THE LAST CORE POSITION USED IN THE CALLING
  34 CROUTINE (INPUT1)
  35 C       LST EQUALS THE LAST POSITION USED IN THE BUF ARRAY
  36 C   (I.E. (BUF(LST) = D(LAST)))
  37       NISR=0
  38       IRECNO=1
  39       LST=0
  40 C       PRINT OUT THE CROSS SECTION DIRECTORY IF CALLED FOR
  41    10 CONTINUE
  42 C       START LOOP TO READ IN THE DATA ON INPUT I/O UNIT
  43       DO 370 II=1,NI
  44          IR   = IREC(II)
  45          IF(NUNIT.NE.IUNIT(II)) IRECNO = 1
  46          NUNIT= IUNIT(II)
  47          IF(NUNIT.LE.0) THEN
  48            WRITE(IOUT,'(/,'' XSECN2 : Wrong unit number '',I10)') NUNIT
  49            GOTO 370
  50          ENDIF
  51          IF(NISR.GE.NNUC)GO TO 370
  52          IF(IR.EQ.0)GO TO 370
  53 C       LOOP TO LOCATE THE I CONTROL BLOCK RECORD (IR=IREC(II))
  54 CZ x-section endmark = 'ENDE'
  55 CZ file endmark ='ENDF'
  56          MARK = '   '
  57    20    IF(MARK.EQ.'ENDE') IRECNO = IRECNO + 1
  58          IF(MARK.EQ.'ENDF') GOTO 50
  59          IF(IR.EQ.IRECNO) GOTO 30
  60          READ(NUNIT,'(A)') MARK
  61          GO TO 20
  62 C       CHECK TO DETERMINE THE ISOTOPE NUMBER FOR THE RANDOM WALK
  63    30    DO 40 I=1,NNUC
  64             IF(ICOM(I).EQ.II)GO TO 60
  65    40    CONTINUE
  66    50    WRITE(IOUT,10000)II
  67 10000 FORMAT('0',10X,'ERROR IN ROUTINE XSECN2, II=',I6,/)
  68          GO TO 390
  69 C       READ I CONTROL BLOCK RECORD OFF INPUT I/O UNIT (NUNIT) FOR
  70 C       THE ELEMENT CORRESPONDING TO IREC(II) AND ICOM(I)
  71    60    IJK=I
  72          READ(NUNIT,'(I10,4G13.7,1I10,/,6I10)') IBUF(LST+1),(BUF(LST+
  73      +   IK),IK=2,5),(IBUF(LST+IJ),IJ=6,12)
  74          NISR=NISR+1
  75 C       ASSIGN VALUES TO ARRAYS NEEDED FOR THE RANDOM WALK
  76          ISO=IJK
  77          NEL=INEL(II)
  78          AWR(ISO)=BUF(LST+2)
  79 CZ store accuracy of xs
  80          ELTOL(ISO) = BUF(LST+4)
  81          IFLAGU=IBUF(LST+6)
  82          LGAM(ISO)=IBUF(LST+7)
  83          NTX(ISO)=IBUF(LST+8)
  84          NTS(ISO)=IBUF(LST+9)
  85          LTHRM(ISO)=IBUF(LST+11)
  86          LNAB(ISO)=IBUF(LST+12)
  87 C       READ IN THE ISOTOPE DICTIONARY (IDICT ARRAY)
  88 C       FROM INPUT I/O UNIT (NUNIT)
  89          READ(NUNIT,'((8I10))')(LDICT(J,ISO),J=1,NNR)
  90    70    CONTINUE
  91 C       READ IN ENDF/B FILE3 CROSS SECTION DATA
  92 C       READ IN ENDF/B FILE4 ANGULAR DISTRIBUTION DATA
  93 C       READ IN ENDF/B FILE5 SECONDARY ENERGY DISTRIBUTION DATA
  94          DO 190 I2=1,NNR
  95             LZ=LDICT(I2,ISO)
  96             IF(LZ.EQ.0)GO TO 190
  97             LEN=LIM-LAST
  98             IF(LEN.LT.LZ)GO TO 380
  99             IDICTS(I2,ISO)=LAST+1-LMOX2
 100 CZ changed in order to read ASCII input file
 101 C I2 < 67  -> x-section data
 102 C I2 < 123 -> angular distribution
 103 C I2 < 134 -> secondary energy distribution
 104 C I2 = 134 ->
 105             IF(I2.LT.67) THEN
 106                READ(NUNIT,'((6G13.7))')(BUF(LST+I),I=1,LZ)
 107             ELSE IF(I2.LT.123) THEN
 108 C ------------------- I2 = 67 -----------------------------
 109                READ(NUNIT,'((8I10))') (IBUF(LST+I),I=1,2), (IBUF(LST+
 110      +         J+2),J=1,2*IBUF(LST+1))
 111                K = 2*IBUF(LST+1) + 2 + 1
 112                DO 80 J=1,IBUF(LST+2)
 113                   READ(NUNIT,'(G13.7,I10,/,(6G13.7))') BUF(LST+K),
 114      +            IBUF(LST+K+1), (BUF(LST+IK+K+1),IK=1,IBUF(LST+K+1)*2)
 115                   K = K + 2 + IBUF(LST+K+1)*2
 116    80          CONTINUE
 117             ELSE IF(I2.LT.134) THEN
 118 C-------------------- I2 = 123 ----------------------------
 119                READ(NUNIT,'(2I10,G13.7,2I10,/,(8I10))') (IBUF(LST+I),
 120      +         I=1,2),BUF(LST+3),(IBUF(LST+J),J=4,5), (IBUF(LST+K+5),K=
 121      +         1,2*IBUF(LST+4))
 122                ID = 2*IBUF(LST+4) + 5
 123                LF = IBUF(LST+2)
 124                NP2 = 2*IBUF(LST+5)
 125                READ(NUNIT,'((6G13.7))') (BUF(LST+ID+I),I=1,NP2)
 126                ID = ID + NP2
 127                KEND = 1
 128                IF(LF.EQ.5.OR.LF.EQ.11) KEND = 2
 129                DO 100 K=1,KEND
 130                   READ(NUNIT,'((8I10))') (IBUF(LST+ID+I),I=1,2)
 131                   NR2 = 2*IBUF(LST+ID+1)
 132                   NE = IBUF(LST+ID+2)
 133                   ID = ID + 2
 134                   READ(NUNIT,'((8I10))') (IBUF(LST+ID+I),I=1,NR2)
 135                   ID = ID + NR2
 136                   IEND = NE
 137                   IF(LF.EQ.5.OR.LF.EQ.11) IEND = 1
 138                   IF(LF.EQ.7.OR.LF.EQ.9) IEND = 1
 139                   DO 90 I=1,IEND
 140                      IF(LF.EQ.1) THEN
 141                         READ(NUNIT,'(G13.7,2I10)') BUF(LST+ID+1),
 142      +                  (IBUF(LST+ID+J),J=2,3)
 143                         NR2 = 2*IBUF(LST+ID+2)
 144                         NP2 = 2*IBUF(LST+ID+3)
 145                         ID = ID + 3
 146                         READ(NUNIT,'((8I10))') (IBUF(LST+ID+J),J=1,
 147      +                  NR2)
 148                         ID = ID + NR2
 149                      ELSE
 150                         NP2 = 2*NE
 151                      ENDIF
 152                      READ(NUNIT,'((6G13.7))') (BUF(LST+ID+J),J=1,NP2)
 153                      ID = ID + NP2
 154    90             CONTINUE
 155   100          CONTINUE
 156             ELSE
 157 C ------------------ I2 = 134 --------------------------------------
 158                READ(NUNIT,'(I10)') IBUF(LST+1)
 159                LNU = IBUF(LST+1)
 160                IF(LNU.NE.2) THEN
 161                   READ(NUNIT,'(I10,/,(6G13.7))') IBUF(LST+2), (BUF(LST
 162      +            +I+2),I=1,IBUF(LST+2))
 163                ELSE
 164                   READ(NUNIT,'((8I10))') (IBUF(LST+I),I=2,3)
 165                   NR2 = IBUF(LST+2)*2
 166                   READ(NUNIT,'((8I10))') (IBUF(LST+3+J),J=1,NR2)
 167                   NP2 = IBUF(LST+3)*2
 168                   READ(NUNIT,'((6G13.7))') (BUF(LST+3+NR2+J),J=1,NP2)
 169                ENDIF
 170             ENDIF
 171 CZ end of change
 172             IF(I2.GT.66)GO TO 120
 173   110       CONTINUE
 174             GO TO 180
 175   120       IF(I2.GT.122)GO TO 150
 176   130       CONTINUE
 177             CALL ANGCDF(BUF(LST+1),BUF(LST+1),LZ)
 178   140       CONTINUE
 179             GO TO 180
 180   150       IF(I2.GT.133)GO TO 170
 181   160       CONTINUE
 182             GO TO 180
 183   170       CONTINUE
 184   180       CONTINUE
 185             LAST=LAST+LZ
 186             LST=LST+LZ
 187   190    CONTINUE
 188 C       READ IN THE AVERAGE PHOTON PRODUCTION ARRAY
 189          LZ=LGAM(ISO)
 190          IF(LZ.EQ.0)GO TO 210
 191          LEN=LIM-LAST
 192          IF(LEN.LT.LZ)GO TO 380
 193          IGAMS(ISO)=LAST+1-LMOX2
 194          READ(NUNIT,'((6G13.7))')(BUF(LST+I),I=1,LZ)
 195   200    CONTINUE
 196          LAST=LAST+LZ
 197          LST=LST+LZ
 198   210    CONTINUE
 199 C       READ IN THE TOTAL NEUTRON DISAPPERANCE ARRAY
 200          LZ=LNAB(ISO)
 201          IF(LZ.EQ.0)GO TO 230
 202          LEN=LIM-LAST
 203          IF(LEN.LT.LZ)GO TO 380
 204          INABS(ISO)=LAST+1-LMOX2
 205          READ(NUNIT,'((6G13.7))')(BUF(LST+I),I=1,LZ)
 206   220    CONTINUE
 207          LAST=LAST+LZ
 208          LST=LST+LZ
 209   230    CONTINUE
 210 C       READ IN THE Q VALUE ARRAY
 211          READ(NUNIT,'((6G13.7))')(Q(I,ISO),I=1,NQ)
 212   240    CONTINUE
 213 C       READ IN THE LR VALUE ARRAY
 214          READ(NUNIT,'((8I10))')(LR(I,ISO),I=1,NQ)
 215   250    CONTINUE
 216 C       READ IN THE QLR VALUE ARRAY
 217          READ(NUNIT,'((6G13.7))')(QLR(I,ISO),I=1,NQ)
 218   260    CONTINUE
 219 C       READ IN THE PHOTON DATA DICTIONARY (GCB ARRAY)
 220 C       FROM INPUT I/O UNIT (NUNIT)
 221 C       CURRENT STORAGE IS SET TO ACCOMODATE UP TO 30 INTERACTIONS
 222 C       (I.E. (2*NTX(ISO)+2*NTS(ISO)).LE.NGR)
 223          L=2*NTX(ISO)+2*NTS(ISO)
 224          IF(L.EQ.0)GO TO 350
 225          L1=2*NTX(ISO)
 226          L2=L1+1
 227          READ(NUNIT,'((8I10))')(LGCB(J,ISO),J=1,L)
 228   270    CONTINUE
 229 C       READ IN ENDF/B FILE12 PHOTON MULTIPLICATION DATA
 230 C       READ IN ENDF/B FILE13 PHOTON CROSS SECTION DATA
 231          NNTX=NTX(ISO)
 232          DO 300 I2=1,NNTX
 233             LZ=LGCB(2*I2,ISO)
 234             IF(LZ.EQ.0)GO TO 300
 235             LEN=LIM-LAST
 236             IF(LEN.LT.LZ)GO TO 380
 237             IGCBS(2*I2-1,ISO)=LGCB(2*I2-1,ISO)
 238             IGCBS(2*I2,ISO)=LAST+1-LMOX2
 239 CZ changed in order to read ASCII xsection file
 240             READ(NUNIT,'((8I10))') (IBUF(LST+I),I=1,2)
 241             READ(NUNIT,'((6G13.7))') (BUF(LST+J+2),J=1,IBUF(LST+2))
 242             ID = IBUF(LST+2) + 2 + LST
 243             DO 280 K = 1, IBUF(LST+1)
 244                READ(NUNIT,'(2(G13.7,I10))') BUF(ID+1),IBUF(ID+2),
 245      +         BUF(ID+3),IBUF(ID+4)
 246                ID = ID + 4
 247                READ(NUNIT,'((6G13.7))') (BUF(ID + J),J=1,IBUF(LST+2))
 248                ID = ID + IBUF(LST+2)
 249   280       CONTINUE
 250 CZ end of change
 251   290       CONTINUE
 252             LAST=LAST+LZ
 253             LST=LST+LZ
 254   300    CONTINUE
 255 C       READ IN ENDF/B FILE15 PHOTON SECONDARY ENERGY DISTRIBUTIONS
 256          NNTS=NTS(ISO)
 257          IF(NNTS.EQ.0)GO TO 350
 258          DO 340 I2=1,NNTS
 259             LZ=LGCB(L1+2*I2,ISO)
 260             IF(LZ.EQ.0)GO TO 340
 261             LEN=LIM-LAST
 262             IF(LEN.LT.LZ)GO TO 380
 263             IGCBS(L1+2*I2-1,ISO)=LGCB(L1+2*I2-1,ISO)
 264             IGCBS(L1+2*I2,ISO)=LAST+1-LMOX2
 265 CZ changed in order to read ASCII xsection file
 266             READ(NUNIT,'(2I10,G13.7,2I10,/,(8I10))') (IBUF(LST+I),I=1,
 267      +      2),BUF(LST+3), (IBUF(LST+J),J=4,5), (IBUF(LST+K+5),K=1,2*
 268      +      IBUF(LST+4))
 269             ID = 2*IBUF(LST+4) + 5
 270             LF = IBUF(LST+2)
 271             NP2 = 2*IBUF(LST+5)
 272             READ(NUNIT,'((6G13.7))') (BUF(LST+ID+I),I=1,NP2)
 273             ID = ID + NP2
 274             KEND = 1
 275             IF(LF.EQ.5.OR.LF.EQ.11) KEND = 2
 276             DO 320 K=1,KEND
 277                READ(NUNIT,'((8I10))') (IBUF(LST+ID+I),I=1,2)
 278                NR2 = 2*IBUF(LST+ID+1)
 279                NE = IBUF(LST+ID+2)
 280                ID = ID + 2
 281                READ(NUNIT,'((8I10))') (IBUF(LST+ID+I),I=1,NR2)
 282                ID = ID + NR2
 283                IEND = NE
 284                IF(LF.EQ.5.OR.LF.EQ.11) IEND = 1
 285                IF(LF.EQ.7.OR.LF.EQ.9) IEND = 1
 286                DO 310 I=1,IEND
 287                   IF(LF.EQ.1) THEN
 288                      READ(NUNIT,'(G13.7,2I10)') BUF(LST+ID+1), (IBUF(L
 289      +               ST+ID+J),J=2,3)
 290                      NR2 = 2*IBUF(LST+ID+2)
 291                      NP2 = 2*IBUF(LST+ID+3)
 292                      ID = ID + 3
 293                      READ(NUNIT,'((8I10))') (IBUF(LST+ID+J),J=1,NR2)
 294                      ID = ID + NR2
 295                   ELSE
 296                      NP2 = 2*NE
 297                   ENDIF
 298                   READ(NUNIT,'((6G13.7))') (BUF(LST+ID+J),J=1,NP2)
 299                   ID = ID + NP2
 300   310          CONTINUE
 301   320       CONTINUE
 302 CZ end of change
 303   330       CONTINUE
 304             LAST=LAST+LZ
 305             LST=LST+LZ
 306   340    CONTINUE
 307   350    CONTINUE
 308 C       READ IN THE THERMAL CROSS SECTION DATA ARRAY
 309          LZ=LTHRM(ISO)
 310          IF(LZ.EQ.0)GO TO 360
 311          LEN=LIM-LAST
 312          IF(LEN.LT.LZ)GO TO 380
 313          ITHRMS(ISO)=LAST+1
 314          READ(NUNIT,'((6G13.7))')(BUF(LST+I),I=1,LZ)
 315          LAST=LAST+LZ
 316          LST=LST+LZ
 317   360    CONTINUE
 318   370 CONTINUE
 319       GO TO 400
 320   380 WRITE(IOUT,10100)LZ,LEN
 321 10100 FORMAT('0','NOT ENOUGH SPACE TO READ IN RECORD',/,5X,
 322      +'LENGTH OF RECORD=',I10,/,5X,'SPACE AVAILABLE=',I10)
 323   390 PRINT '('' CALOR: ERROR in XSECN2 ====> STOP '')'
 324       STOP
 325   400 RETURN
 326       END