--- /dev/null
+*
+* $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
git://git.uio.no / u / mrichter / AliRoot.git / blobdiff