[u/mrichter/AliRoot.git] / GEANT321 / neutron / xsecn2.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1995/10/24 10:22:00  cernlib
* Geant
*
*
#include "geant321/pilot.h"
*CMZ :  3.21/04 23/02/95  14.46.01  by  S.Giani
*-- Author :
      SUBROUTINE XSECN2(ICOM,IREC,IUNIT,IGAMS,LGAM,ELTOL,INABS,LNAB,
     + ITHRMS,LTHRM,IDICTS,LDICT,NTX,NTS,IGCBS,LGCB,AWR,Q,LR,QLR,
     + BUF,IBUF,LIM,LAST,INEL)
C       THIS ROUTINE READS THE REMAINDER OF INPUT I/O UNIT(s),
C       SELECTS THE ELEMENTS NEEDED FOR THE CALCULATIONS,
C       AND STORES THE CROSS SECTION DATA IN CORE
#include "geant321/minput.inc"
#include "geant321/mconst.inc"
#include "geant321/mmicab.inc"
      CHARACTER*4 MARK
      DIMENSION BUF(*),IBUF(*),ICOM(*),IGAMS(*),LGAM(*),INABS(*),
     +LNAB(*),ITHRMS(*),LTHRM(*),AWR(*),IDICTS(NNR,NNUC),ELTOL(*),
     +LDICT(NNR,NNUC),Q(NQ,NNUC),NTX(*),NTS(*),IGCBS(NGR,NNUC),
     +LGCB(NGR,NNUC),IREC(*),LR(NQ,NNUC),QLR(NQ,NNUC)
      DIMENSION INEL(*),IUNIT(*)
C       ASSIGN THE DEFAULT VALUES
      LEN=0
C       INITIALIZE THE COUNTERS FOR THE LOOP
C       NISR EQUALS THE NUMBER OF ISOTOPES READ
C       IRECNO EQUALS THE NEXT RECORD NUMBER TO BE READ ON INPUT
C  I/O UNIT (NUNIT)
C       LAST EQUALS THE LAST CORE POSITION USED IN THE CALLING
CROUTINE (INPUT1)
C       LST EQUALS THE LAST POSITION USED IN THE BUF ARRAY
C   (I.E. (BUF(LST) = D(LAST)))
      NISR=0
      IRECNO=1
      LST=0
C       PRINT OUT THE CROSS SECTION DIRECTORY IF CALLED FOR
   10 CONTINUE
C       START LOOP TO READ IN THE DATA ON INPUT I/O UNIT
      DO 370 II=1,NI
         IR   = IREC(II)
         IF(NUNIT.NE.IUNIT(II)) IRECNO = 1
         NUNIT= IUNIT(II)
         IF(NUNIT.LE.0) THEN
           WRITE(IOUT,'(/,'' XSECN2 : Wrong unit number '',I10)') NUNIT
           GOTO 370
         ENDIF
         IF(NISR.GE.NNUC)GO TO 370
         IF(IR.EQ.0)GO TO 370
C       LOOP TO LOCATE THE I CONTROL BLOCK RECORD (IR=IREC(II))
CZ x-section endmark = 'ENDE'
CZ file endmark ='ENDF'
         MARK = '   '
   20    IF(MARK.EQ.'ENDE') IRECNO = IRECNO + 1
         IF(MARK.EQ.'ENDF') GOTO 50
         IF(IR.EQ.IRECNO) GOTO 30
         READ(NUNIT,'(A)') MARK
         GO TO 20
C       CHECK TO DETERMINE THE ISOTOPE NUMBER FOR THE RANDOM WALK
   30    DO 40 I=1,NNUC
            IF(ICOM(I).EQ.II)GO TO 60
   40    CONTINUE
   50    WRITE(IOUT,10000)II
10000 FORMAT('0',10X,'ERROR IN ROUTINE XSECN2, II=',I6,/)
         GO TO 390
C       READ I CONTROL BLOCK RECORD OFF INPUT I/O UNIT (NUNIT) FOR
C       THE ELEMENT CORRESPONDING TO IREC(II) AND ICOM(I)
   60    IJK=I
         READ(NUNIT,'(I10,4G13.7,1I10,/,6I10)') IBUF(LST+1),(BUF(LST+
     +   IK),IK=2,5),(IBUF(LST+IJ),IJ=6,12)
         NISR=NISR+1
C       ASSIGN VALUES TO ARRAYS NEEDED FOR THE RANDOM WALK
         ISO=IJK
         NEL=INEL(II)
         AWR(ISO)=BUF(LST+2)
CZ store accuracy of xs
         ELTOL(ISO) = BUF(LST+4)
         IFLAGU=IBUF(LST+6)
         LGAM(ISO)=IBUF(LST+7)
         NTX(ISO)=IBUF(LST+8)
         NTS(ISO)=IBUF(LST+9)
         LTHRM(ISO)=IBUF(LST+11)
         LNAB(ISO)=IBUF(LST+12)
C       READ IN THE ISOTOPE DICTIONARY (IDICT ARRAY)
C       FROM INPUT I/O UNIT (NUNIT)
         READ(NUNIT,'((8I10))')(LDICT(J,ISO),J=1,NNR)
   70    CONTINUE
C       READ IN ENDF/B FILE3 CROSS SECTION DATA
C       READ IN ENDF/B FILE4 ANGULAR DISTRIBUTION DATA
C       READ IN ENDF/B FILE5 SECONDARY ENERGY DISTRIBUTION DATA
         DO 190 I2=1,NNR
            LZ=LDICT(I2,ISO)
            IF(LZ.EQ.0)GO TO 190
            LEN=LIM-LAST
            IF(LEN.LT.LZ)GO TO 380
            IDICTS(I2,ISO)=LAST+1-LMOX2
CZ changed in order to read ASCII input file
C I2 < 67  -> x-section data
C I2 < 123 -> angular distribution
C I2 < 134 -> secondary energy distribution
C I2 = 134 ->
            IF(I2.LT.67) THEN
               READ(NUNIT,'((6G13.7))')(BUF(LST+I),I=1,LZ)
            ELSE IF(I2.LT.123) THEN
C ------------------- I2 = 67 -----------------------------
               READ(NUNIT,'((8I10))') (IBUF(LST+I),I=1,2), (IBUF(LST+
     +         J+2),J=1,2*IBUF(LST+1))
               K = 2*IBUF(LST+1) + 2 + 1
               DO 80 J=1,IBUF(LST+2)
                  READ(NUNIT,'(G13.7,I10,/,(6G13.7))') BUF(LST+K),
     +            IBUF(LST+K+1), (BUF(LST+IK+K+1),IK=1,IBUF(LST+K+1)*2)
                  K = K + 2 + IBUF(LST+K+1)*2
   80          CONTINUE
            ELSE IF(I2.LT.134) THEN
C-------------------- I2 = 123 ----------------------------
               READ(NUNIT,'(2I10,G13.7,2I10,/,(8I10))') (IBUF(LST+I),
     +         I=1,2),BUF(LST+3),(IBUF(LST+J),J=4,5), (IBUF(LST+K+5),K=
     +         1,2*IBUF(LST+4))
               ID = 2*IBUF(LST+4) + 5
               LF = IBUF(LST+2)
               NP2 = 2*IBUF(LST+5)
               READ(NUNIT,'((6G13.7))') (BUF(LST+ID+I),I=1,NP2)
               ID = ID + NP2
               KEND = 1
               IF(LF.EQ.5.OR.LF.EQ.11) KEND = 2
               DO 100 K=1,KEND
                  READ(NUNIT,'((8I10))') (IBUF(LST+ID+I),I=1,2)
                  NR2 = 2*IBUF(LST+ID+1)
                  NE = IBUF(LST+ID+2)
                  ID = ID + 2
                  READ(NUNIT,'((8I10))') (IBUF(LST+ID+I),I=1,NR2)
                  ID = ID + NR2
                  IEND = NE
                  IF(LF.EQ.5.OR.LF.EQ.11) IEND = 1
                  IF(LF.EQ.7.OR.LF.EQ.9) IEND = 1
                  DO 90 I=1,IEND
                     IF(LF.EQ.1) THEN
                        READ(NUNIT,'(G13.7,2I10)') BUF(LST+ID+1),
     +                  (IBUF(LST+ID+J),J=2,3)
                        NR2 = 2*IBUF(LST+ID+2)
                        NP2 = 2*IBUF(LST+ID+3)
                        ID = ID + 3
                        READ(NUNIT,'((8I10))') (IBUF(LST+ID+J),J=1,
     +                  NR2)
                        ID = ID + NR2
                     ELSE
                        NP2 = 2*NE
                     ENDIF
                     READ(NUNIT,'((6G13.7))') (BUF(LST+ID+J),J=1,NP2)
                     ID = ID + NP2
   90             CONTINUE
  100          CONTINUE
            ELSE
C ------------------ I2 = 134 --------------------------------------
               READ(NUNIT,'(I10)') IBUF(LST+1)
               LNU = IBUF(LST+1)
               IF(LNU.NE.2) THEN
                  READ(NUNIT,'(I10,/,(6G13.7))') IBUF(LST+2), (BUF(LST
     +            +I+2),I=1,IBUF(LST+2))
               ELSE
                  READ(NUNIT,'((8I10))') (IBUF(LST+I),I=2,3)
                  NR2 = IBUF(LST+2)*2
                  READ(NUNIT,'((8I10))') (IBUF(LST+3+J),J=1,NR2)
                  NP2 = IBUF(LST+3)*2
                  READ(NUNIT,'((6G13.7))') (BUF(LST+3+NR2+J),J=1,NP2)
               ENDIF
            ENDIF
CZ end of change
            IF(I2.GT.66)GO TO 120
  110       CONTINUE
            GO TO 180
  120       IF(I2.GT.122)GO TO 150
  130       CONTINUE
            CALL ANGCDF(BUF(LST+1),BUF(LST+1),LZ)
  140       CONTINUE
            GO TO 180
  150       IF(I2.GT.133)GO TO 170
  160       CONTINUE
            GO TO 180
  170       CONTINUE
  180       CONTINUE
            LAST=LAST+LZ
            LST=LST+LZ
  190    CONTINUE
C       READ IN THE AVERAGE PHOTON PRODUCTION ARRAY
         LZ=LGAM(ISO)
         IF(LZ.EQ.0)GO TO 210
         LEN=LIM-LAST
         IF(LEN.LT.LZ)GO TO 380
         IGAMS(ISO)=LAST+1-LMOX2
         READ(NUNIT,'((6G13.7))')(BUF(LST+I),I=1,LZ)
  200    CONTINUE
         LAST=LAST+LZ
         LST=LST+LZ
  210    CONTINUE
C       READ IN THE TOTAL NEUTRON DISAPPERANCE ARRAY
         LZ=LNAB(ISO)
         IF(LZ.EQ.0)GO TO 230
         LEN=LIM-LAST
         IF(LEN.LT.LZ)GO TO 380
         INABS(ISO)=LAST+1-LMOX2
         READ(NUNIT,'((6G13.7))')(BUF(LST+I),I=1,LZ)
  220    CONTINUE
         LAST=LAST+LZ
         LST=LST+LZ
  230    CONTINUE
C       READ IN THE Q VALUE ARRAY
         READ(NUNIT,'((6G13.7))')(Q(I,ISO),I=1,NQ)
  240    CONTINUE
C       READ IN THE LR VALUE ARRAY
         READ(NUNIT,'((8I10))')(LR(I,ISO),I=1,NQ)
  250    CONTINUE
C       READ IN THE QLR VALUE ARRAY
         READ(NUNIT,'((6G13.7))')(QLR(I,ISO),I=1,NQ)
  260    CONTINUE
C       READ IN THE PHOTON DATA DICTIONARY (GCB ARRAY)
C       FROM INPUT I/O UNIT (NUNIT)
C       CURRENT STORAGE IS SET TO ACCOMODATE UP TO 30 INTERACTIONS
C       (I.E. (2*NTX(ISO)+2*NTS(ISO)).LE.NGR)
         L=2*NTX(ISO)+2*NTS(ISO)
         IF(L.EQ.0)GO TO 350
         L1=2*NTX(ISO)
         L2=L1+1
         READ(NUNIT,'((8I10))')(LGCB(J,ISO),J=1,L)
  270    CONTINUE
C       READ IN ENDF/B FILE12 PHOTON MULTIPLICATION DATA
C       READ IN ENDF/B FILE13 PHOTON CROSS SECTION DATA
         NNTX=NTX(ISO)
         DO 300 I2=1,NNTX
            LZ=LGCB(2*I2,ISO)
            IF(LZ.EQ.0)GO TO 300
            LEN=LIM-LAST
            IF(LEN.LT.LZ)GO TO 380
            IGCBS(2*I2-1,ISO)=LGCB(2*I2-1,ISO)
            IGCBS(2*I2,ISO)=LAST+1-LMOX2
CZ changed in order to read ASCII xsection file
            READ(NUNIT,'((8I10))') (IBUF(LST+I),I=1,2)
            READ(NUNIT,'((6G13.7))') (BUF(LST+J+2),J=1,IBUF(LST+2))
            ID = IBUF(LST+2) + 2 + LST
            DO 280 K = 1, IBUF(LST+1)
               READ(NUNIT,'(2(G13.7,I10))') BUF(ID+1),IBUF(ID+2),
     +         BUF(ID+3),IBUF(ID+4)
               ID = ID + 4
               READ(NUNIT,'((6G13.7))') (BUF(ID + J),J=1,IBUF(LST+2))
               ID = ID + IBUF(LST+2)
  280       CONTINUE
CZ end of change
  290       CONTINUE
            LAST=LAST+LZ
            LST=LST+LZ
  300    CONTINUE
C       READ IN ENDF/B FILE15 PHOTON SECONDARY ENERGY DISTRIBUTIONS
         NNTS=NTS(ISO)
         IF(NNTS.EQ.0)GO TO 350
         DO 340 I2=1,NNTS
            LZ=LGCB(L1+2*I2,ISO)
            IF(LZ.EQ.0)GO TO 340
            LEN=LIM-LAST
            IF(LEN.LT.LZ)GO TO 380
            IGCBS(L1+2*I2-1,ISO)=LGCB(L1+2*I2-1,ISO)
            IGCBS(L1+2*I2,ISO)=LAST+1-LMOX2
CZ changed in order to read ASCII xsection file
            READ(NUNIT,'(2I10,G13.7,2I10,/,(8I10))') (IBUF(LST+I),I=1,
     +      2),BUF(LST+3), (IBUF(LST+J),J=4,5), (IBUF(LST+K+5),K=1,2*
     +      IBUF(LST+4))
            ID = 2*IBUF(LST+4) + 5
            LF = IBUF(LST+2)
            NP2 = 2*IBUF(LST+5)
            READ(NUNIT,'((6G13.7))') (BUF(LST+ID+I),I=1,NP2)
            ID = ID + NP2
            KEND = 1
            IF(LF.EQ.5.OR.LF.EQ.11) KEND = 2
            DO 320 K=1,KEND
               READ(NUNIT,'((8I10))') (IBUF(LST+ID+I),I=1,2)
               NR2 = 2*IBUF(LST+ID+1)
               NE = IBUF(LST+ID+2)
               ID = ID + 2
               READ(NUNIT,'((8I10))') (IBUF(LST+ID+I),I=1,NR2)
               ID = ID + NR2
               IEND = NE
               IF(LF.EQ.5.OR.LF.EQ.11) IEND = 1
               IF(LF.EQ.7.OR.LF.EQ.9) IEND = 1
               DO 310 I=1,IEND
                  IF(LF.EQ.1) THEN
                     READ(NUNIT,'(G13.7,2I10)') BUF(LST+ID+1), (IBUF(L
     +               ST+ID+J),J=2,3)
                     NR2 = 2*IBUF(LST+ID+2)
                     NP2 = 2*IBUF(LST+ID+3)
                     ID = ID + 3
                     READ(NUNIT,'((8I10))') (IBUF(LST+ID+J),J=1,NR2)
                     ID = ID + NR2
                  ELSE
                     NP2 = 2*NE
                  ENDIF
                  READ(NUNIT,'((6G13.7))') (BUF(LST+ID+J),J=1,NP2)
                  ID = ID + NP2
  310          CONTINUE
  320       CONTINUE
CZ end of change
  330       CONTINUE
            LAST=LAST+LZ
            LST=LST+LZ
  340    CONTINUE
  350    CONTINUE
C       READ IN THE THERMAL CROSS SECTION DATA ARRAY
         LZ=LTHRM(ISO)
         IF(LZ.EQ.0)GO TO 360
         LEN=LIM-LAST
         IF(LEN.LT.LZ)GO TO 380
         ITHRMS(ISO)=LAST+1
         READ(NUNIT,'((6G13.7))')(BUF(LST+I),I=1,LZ)
         LAST=LAST+LZ
         LST=LST+LZ
  360    CONTINUE
  370 CONTINUE
      GO TO 400
  380 WRITE(IOUT,10100)LZ,LEN
10100 FORMAT('0','NOT ENOUGH SPACE TO READ IN RECORD',/,5X,
     +'LENGTH OF RECORD=',I10,/,5X,'SPACE AVAILABLE=',I10)
  390 PRINT '('' CALOR: ERROR in XSECN2 ====> STOP '')'
      STOP
  400 RETURN
      END
Commit	Line	Data
fe4da5cc	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. (2NTX(ISO)+2NTS(ISO)).LE.NGR)
223	L=2NTX(ISO)+2NTS(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(2I2-1,ISO)=LGCB(2I2-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+2I2-1,ISO)=LGCB(L1+2I2-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