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

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1995/10/24 10:21:57  cernlib
* Geant
*
*
#include "geant321/pilot.h"
*CMZ :  3.21/04 23/02/95  14.46.01  by  S.Giani
*-- Author :
      SUBROUTINE MOXSEC
C************************************************************
C
C  setup cross-section tables for MICAP
C
C  Called by: MORINI
C
C  INPUT: MICAP element IDs in KE  = LD(LFP11)
C         element densities in RHO = D (LFP12)
C
C  Author : C.Zeitnitz
C
C  See USER's GUIDE TO MICAP ORNL/TM-10340
C  for details and pointer description (MPOINT)
C
C************************************************************
#include "geant321/mmicap.inc"
#include "geant321/minput.inc"
#include "geant321/mpoint.inc"
#include "geant321/mconst.inc"
#include "geant321/cmagic.inc"
C
      CHARACTER*80 XSFILE
      CHARACTER*70 CCOMM
      CHARACTER*11 CGEANT
      CHARACTER*4  MARK
      CHARACTER*20 MATNAM
      INTEGER INEL(134)
      LOGICAL NOHED,XSTOP
C
C       CALCULATE THE NUMBER OF ELEMENTS (NNUC)
C       AND GENERATE THE ISOTOPE NUMBER ARRAY (IN(NMIX))
      NWTOT = 0
      DO 10 I=1,NMIX
         LD(LFP17+I-1)=0
         LD(LFP16+I-1)=0
   10 CONTINUE
C       INITIALIZE THE NUMBER OF ELEMENTS (NNUC)
      NNUC=0
      DO 30 I=1,NMIX
         IF(LD(LFP16+I-1).GT.0)GO TO 30
         NNUC=NNUC+1
         LD(LFP16+I-1)=NNUC
         DO 20 J=I+1,NMIX
            IF(LD(LFP11+I-1).NE.LD(LFP11+J-1))GO TO 20
            LD(LFP16+J-1)=NNUC
   20    CONTINUE
   30 CONTINUE
C get number of isoptopes from xsection file(s)
      LT = LTEMP
      NII = 0
   40 CONTINUE
        NUNIT = IQ(LT+NTUNIT)
        READ(NUNIT,'(I10)') NIS
        NII = NII + NIS
        IQ(LT+NTMPNI) = NIS
        LT = LQ(LT)
      IF(LT.GT.0) GOTO 40
C allocate needed memory for x-section
      NW = 2*NII+13*NNUC+2*NNR*NNUC+4*NGR*NNUC+3*NQ*NNUC+26*MEDIA + 2
      NI = NII
      NWTOT = NWTOT + NW
      CALL CHKZEB(NW,IXCONS)
      CALL MZBOOK(IXCONS,LMOX1,0,2,'MOX1',0,0,NW,0,-1)
C       SET UP THE B CONTROL BLOCK LOCATION NUMBER ARRAY ICOM(NNUC)
C LFP170 points to length of x-section data
      LFP170 = LMOX1 + 2
      LFP18=LFP170+NNUC
      LFP18A=LFP18+NII
      LFP19=LFP18A+NII
      LFP20=LFP19+NMIX
C       SET UP THE ARRAY (IREC(NII))
      CALL XSECN1(NII,D(LFP11),D(LFP16),D(LFP17),
     +                D(LFP18),D(LFP18A),D(LFP170),D(LFP19),
     +                D(LFP20),D(LFP20),INEL)
C check if all isotopes have been found in the x-section file(s)
      XSTOP = .FALSE.
      DO 50  I=1,NMIX
        IF(LD(LFP19+I-1).EQ.0) THEN
         WRITE(IOUT,10100)LD(LFP19+I-1)
10000    FORMAT(' MICAP: Could not find x-section of element ',I8)
         XSTOP = .TRUE.
        ENDIF
   50 CONTINUE
      IF(XSTOP) THEN
        PRINT '('' CALOR : Neutron x-section not found ===> STOP '')'
        STOP
      ENDIF
      LFP21=LFP20+NNUC
C store xs accuracy at LFP210 (used for thinning  in XSECN3)
      LFP210 = LFP21 + NNUC
      LFP22=LFP210+NNUC
      LFP23=LFP22+NNUC
      LFP24=LFP23+NNUC
      LFP25=LFP24+NNUC
      LFP26=LFP25+NNUC
      LFP27=LFP26+NNR*NNUC
      LFP28=LFP27+NNR*NNUC
      LFP29=LFP28+NNUC
      LFP30=LFP29+NNUC
      LFP31=LFP30+NGR*NNUC
      LFP32=LFP31+NGR*NNUC
      LFP33=LFP32+MEDIA
      LFP34=LFP33+MEDIA
      LFP35=LFP34+NNUC
      LFP36=LFP35+3*NQ*NNUC
C       CLEAR THE STORAGE LOCATIONS FOR THE DICTIONARIES, ETC.
      CALL CLEAR(D,LFP20,LFP36-1)
C       ESTABLISH THE RANDOM WALK STORAGE LOCATIONS
      LFP41=LFP36
      LFP42=LFP41+2*NNUC
      LFP45=LFP42+24*MEDIA
      LFP46=LFP45+NGR*NNUC
      NW = 0
      DO 60 INUC=1,NNUC
         NW = NW + LD(LFP170+INUC-1)
   60 CONTINUE
      NW = NW + 2
      NWTOT = NWTOT + NW
      CALL CHKZEB(NW,IXCONS)
      CALL MZBOOK(IXCONS,LMOX2,0,2,'MOX2',0,0,NW,0,-1)
      LFP43 = LMOX2 + 2
      LAST = LFP43 - 1
      MAXD = LMOX2 + NW
C       PLACE THE MICROSCOPIC CROSS SECTION DATA INTO THE CORE
      CALL XSECN2(D(LFP17),D(LFP18),D(LFP18A),
     +            D(LFP20),D(LFP21),D(LFP210),D(LFP22),D(LFP23),
     +            D(LFP24),D(LFP25),D(LFP26),D(LFP27),D(LFP28),
     +            D(LFP29),D(LFP30),D(LFP31),D(LFP34),D(LFP35),
     +            D(LFP35+NQ*NNUC),D(LFP35+2*NQ*NNUC),
     +            D(LFP43),D(LFP43),MAXD,LAST,INEL)
C determine length needed for macroscopic xs and mixing
      NW = 0
      DO 90  IM=1,MEDIA
         NM = 0
         LZ = 0
         DO 70 IN=1,NMIX
            IF(LD(LFP10+IN-1).NE.IM) GOTO 70
            NM = NM+1
            II = LD(LFP16+IN-1)
            LZ = MAX0(LD(LFP27+NNR*(II-1)),LZ)
C           LZ = MAX0(LDICT(1,II),LZ)
   70    CONTINUE
         IF(NM.GT.1) LZ = 4*LZ
         DO 80 J=1,NMIX
            IF(LD(LFP10+J-1).NE.IM) GOTO 80
            II = LD(LFP16+J-1)
   80    CONTINUE
         NW = NW + LZ
   90 CONTINUE
      NW = NW + 2
      NWTOT = NWTOT + NW
      CALL CHKZEB(NW,IXCONS)
      CALL MZBOOK(IXCONS,LMOX3,0,2,'MOX3',0,0,NW,0,-1)
      LAST = LMOX3 + 1
      LFP44=LAST+1
      MAXD = LMOX3+NW
C       SET, MIX AND THIN THE TOTAL CROSS SECTIONS
C       ACCORDING TO THE MIXING TABLE
      CALL XSECN3(D(LFP10),D(LFP11),D(LFP12),D(LFP16),D(LFP26),
     +            D(LFP27),D(LFP32),D(LFP33),D(LFP44),D(LFP44),
     +            D,MAXD,LAST)
C       ESTABLISH THE PHOTON TOTAL CROSS SECTION DATA DICTIONARY
C       STORAGE LOCATIONS
C determine number of words needed for photon production xs
      NW = 0
      DO 110 I=1,NNUC
         DO 100 J=1,LD(LFP28+I-1)
            LZ = LD(LFP31 + 2*J - 1 + NGR*(I-1))
C           LZ = LGCB(2*J,I)
            NW = NW + LZ
  100    CONTINUE
  110 CONTINUE
      NW = NW + 2*NGR*NNUC+2
      NWTOT = NWTOT + NW + 1
      CALL CHKZEB(NW,IXCONS)
      CALL MZBOOK(IXCONS,LMOX4,0,2,'MOX4',0,0,NW,0,-1)
      LMAG2 = LMOX4 + 1
      LD(LMAG2) = NMAGIC
      LFP45 = LMAG2 + 1
      LFP46 = LFP45 + NGR*NNUC
      LFP47 = LFP46 + NGR*NNUC
      LAST = LFP47 - 1
      MAXD = LMOX4 + NW
C       CLEAR THE STORAGE LOCATIONS FOR THE PHOTON DICTIONARIES
C       OF THE TOTAL PHOTON PRODUCTION CROSS SECTIONS
      CALL CLEAR(D,LFP45,LFP47-1)
C       SUM THE PHOTON PARTIAL DISTRIBUTIONS OF THE ENDF/B-V
C       FILE 12 AND FILE 13 DATA (BY MT NUMBER) AND PLACE THESE
C       MICROSCOPIC MULTIPLICITIES TIMES CROSS SECTIONS IN CORE
      CALL XSECN5(D(LFP28),D(LFP30),D(LFP31),D(LFP45),D(LFP46),
     +           D(LFP47),D(LFP47),D,D,MAXD,LAST)
C
C print out media to print unit IOUT
C      WRITE(IOUT,10000)
10100 FORMAT(23X,'MICAP Material Parameters',/,
     +       23X,'-------------------------',/)
      WRITE(IOUT,10200)
10200 FORMAT(8X,'GEANT Material Parameters',10X,
     +        6X,'MICAP Material Parameters',/,
     +       8X,25('-'),10X,6X,25('-'))
      WRITE(IOUT,10300)
10300 FORMAT(1X,'Material',16X,'No/Iso',4X,'A',5X,'Z',2X,'|',
     +        4X,'A',5X,'Z',3X,'Density',
     +        3X,'Coll.Len',/,44('-'),'+',33('-'))
      MFLAG = 0
      KMED  = 0
      NISO  = 1
      DO 130 I=0,NMIX-1
C get GEANT name of material
         MARK = '/   '
         IF(LD(LFP11+I)/1000.NE.LD(LFP13+I)) THEN
            MARK = '/  *'
            MFLAG=1
         ENDIF
         K1 = LD(LFP16+I)-1
         LS1 = LD(LFP26+NNR*K1)+LMOX2
         LEN = LD(LFP27+NNR*K1)/2
         EN = 1.E6
         CALL TBSPLT(D(LS1),EN,LEN,XSEC)
         XSEC = 1./XSEC/D(LFP12+I)
         IF(LD(LFP140+I).NE.0.) THEN
            WRITE(CGEANT,'(F6.1,I5)')  D(LFP140+I),LD(LFP13+I)
         ELSE
            WRITE(CGEANT,'(A11)')  '    -     -'
         ENDIF
         IF(KMED.NE.LD(LFP10+I)) THEN
          NISO = 1
          CALL GFMATE(LD(LGE2MO+LD(LFP10+I)),MATNAM,AA,ZZ,DENS,
     +       RADL,ABSL,UB,NW)
          NBLK = LNBLNK(MATNAM)
          DO 120 JC=NBLK+1,20
             WRITE(MATNAM(JC:JC),'(A1)') '.'
  120     CONTINUE
          WRITE(MARK(2:3),'(I2)') NISO
          WRITE(IOUT,10400) MATNAM,LD(LGE2MO+LD(LFP10+I)),MARK,
     +     CGEANT,
     +     D(LFP34+LD(LFP16+I)-1)*1.008665,
     +     LD(LFP11+I)/1000,D(LFP12+I),XSEC
          KMED = LD(LFP10+I)
         ELSE
          WRITE(MARK(2:3),'(I2)') NISO
          WRITE(IOUT,10500) LD(LGE2MO+LD(LFP10+I)),MARK,CGEANT,
     +     D(LFP34+LD(LFP16+I)-1)*1.008665,
     +     LD(LFP11+I)/1000,D(LFP12+I),XSEC
         ENDIF
10400    FORMAT(1X,A20,I6,A4,A11,'  |',F6.1,I5,1X,E11.4,1X,E9.3)
10500    FORMAT(1X,20X,I6,A4,A11,'  |',F6.1,I5,1X,E11.4,1X,E9.3)
         LD(LFP13+I) = LD(LFP11+I)/1000
         NISO = NISO + 1
  130 CONTINUE
      WRITE(IOUT,'(78(''-''),/,48X,''Density in (Atoms/barn/cm)'')')
      WRITE(IOUT,'(36X,
     +    ''Collision Length for 1 MeV neutron in (cm)'',/)')
      IF(MFLAG.EQ.1) WRITE(IOUT,'(/,
     + 15X,''*******************************************'',/,
     + 15X,''*               W A R N I N G             *'',/,
     + 15X,''*   Marked isotopes (*) not found in the  *'',/,
     + 15X,''*        cross-section file(s)            *'',/,
     + 15X,''*    Cross-sections of the isotope with   *'',/,
     + 15X,''*    the closest Z will be used instead   *'',/,
     + 15X,''*******************************************'',/)')
C which x-section files have been used?
      LT = LTEMP
      LCI = LCISO
      LC = 0
      NOHED=.TRUE.
  140 CONTINUE
C first check if x-section file has been used!
        NUNIT = IQ(LT+NTUNIT)
        DO 150 I=0,NMIX-1
           KISO = LD(LFP16+I)
           MISO = LD(LFP17+KISO-1)
           IF(NUNIT.EQ.LD(LFP18A+MISO-1)) GOTO 160
  150   CONTINUE
C unit never used !
        GOTO 190
  160   CONTINUE
C search for comments for selected isotopes
        NCOM = IQ(LCI+1)
        DO 180 J=1,NCOM
           K = (J-1)*81 + 2
           JZ = IQ(LCI+K)
           JA = IQ(LCI+K+1)
           CCOMM = ' '
           CALL UHTOC(IQ(LCI+K+2),4,CCOMM,70)
           DO 170 I=0,NMIX-1
              KISO = LD(LFP16+I)
              IA = NINT(D(LFP34+KISO-1)*1.008665)
              IZ = LD(LFP11+I)/1000
              MISO = LD(LFP17+KISO-1)
C print the comment, if the isotope is correct and has been read from
C the current x-section file
              IF(IA.EQ.JA .AND. IZ.EQ.JZ .AND.
     +           NUNIT.EQ.LD(LFP18A+MISO-1)) THEN
                IF(NOHED) THEN
                 WRITE(IOUT,'(/,23X,''COMMENTS ABOUT ISOTOPE DATA'')')
                 WRITE(IOUT,'(  23X,''---------------------------'',/)')
                 NOHED = .FALSE.
                ENDIF
                LC = LC + 1
                WRITE(IOUT,'(I4,'') '',A70)') LC,CCOMM
                GOTO 180
              ENDIF
  170      CONTINUE
  180   CONTINUE
  190   LT = LQ(LT)
        LCI = LQ(LCI)
      IF(LT.GT.0.AND.LCI.GT.0) GOTO 140
C print the x-section file names and comments
      WRITE(IOUT,'(/,20X,''USED NEUTRON CROSS-SECTION FILES'')')
      WRITE(IOUT,'(  20X,''--------------------------------'',/)')
      LT = LTEMP
  200 CONTINUE
C first check if x-section file has been used!
        NUNIT = IQ(LT+NTUNIT)
        DO 210 I=0,NMIX-1
           KISO = LD(LFP16+I)
           MISO = LD(LFP17+KISO-1)
           IF(NUNIT.EQ.LD(LFP18A+MISO-1)) GOTO 220
  210   CONTINUE
C unit never used !
        GOTO 230
  220   CONTINUE
C get file name of x-section file
        XSFILE = ' '
        COMMEN = ' '
        DATSTR = ' '
        CALL UHTOC(IQ(LT+NTNAME+1),4,XSFILE,IQ(LT+NTNAME))
        CALL UHTOC(IQ(LT+NTCOMM+1),4,COMMEN,IQ(LT+NTCOMM))
        CALL UHTOC(IQ(LT+NTDATS+1),4,DATSTR,IQ(LT+NTDATS))
        WRITE(IOUT,'('' File      : '',A66)') XSFILE
        WRITE(IOUT,'('' Generated : '',A24,/,
     +               '' Comment   : '',A66,/)') DATSTR,COMMEN
  230   LT = LQ(LT)
      IF(LT.GT.0) GOTO 200
      WRITE(IOUT,'(/,'' MICAP :'',I10,
     + '' words used in GCBANK for neutron x-section tables''/)') NWTOT
      RETURN
      END
Commit	Line	Data
fe4da5cc	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 MOXSEC
	13	C************************************************************
	14	C
	15	C setup cross-section tables for MICAP
	16	C
	17	C Called by: MORINI
	18	C
	19	C INPUT: MICAP element IDs in KE = LD(LFP11)
	20	C element densities in RHO = D (LFP12)
	21	C
	22	C Author : C.Zeitnitz
	23	C
	24	C See USER's GUIDE TO MICAP ORNL/TM-10340
	25	C for details and pointer description (MPOINT)
	26	C
	27	C************************************************************
	28	#include "geant321/mmicap.inc"
	29	#include "geant321/minput.inc"
	30	#include "geant321/mpoint.inc"
	31	#include "geant321/mconst.inc"
	32	#include "geant321/cmagic.inc"
	33	C
	34	CHARACTER*80 XSFILE
	35	CHARACTER*70 CCOMM
	36	CHARACTER*11 CGEANT
	37	CHARACTER*4 MARK
	38	CHARACTER*20 MATNAM
	39	INTEGER INEL(134)
	40	LOGICAL NOHED,XSTOP
	41	C
	42	C CALCULATE THE NUMBER OF ELEMENTS (NNUC)
	43	C AND GENERATE THE ISOTOPE NUMBER ARRAY (IN(NMIX))
	44	NWTOT = 0
	45	DO 10 I=1,NMIX
	46	LD(LFP17+I-1)=0
	47	LD(LFP16+I-1)=0
	48	10 CONTINUE
	49	C INITIALIZE THE NUMBER OF ELEMENTS (NNUC)
	50	NNUC=0
	51	DO 30 I=1,NMIX
	52	IF(LD(LFP16+I-1).GT.0)GO TO 30
	53	NNUC=NNUC+1
	54	LD(LFP16+I-1)=NNUC
	55	DO 20 J=I+1,NMIX
	56	IF(LD(LFP11+I-1).NE.LD(LFP11+J-1))GO TO 20
	57	LD(LFP16+J-1)=NNUC
	58	20 CONTINUE
	59	30 CONTINUE
	60	C get number of isoptopes from xsection file(s)
	61	LT = LTEMP
	62	NII = 0
	63	40 CONTINUE
	64	NUNIT = IQ(LT+NTUNIT)
65	READ(NUNIT,'(I10)') NIS
66	NII = NII + NIS
67	IQ(LT+NTMPNI) = NIS
68	LT = LQ(LT)
69	IF(LT.GT.0) GOTO 40
70	C allocate needed memory for x-section
71	NW = 2NII+13NNUC+2NNRNNUC+4NGRNNUC+3NQNNUC+26*MEDIA + 2
72	NI = NII
73	NWTOT = NWTOT + NW
74	CALL CHKZEB(NW,IXCONS)
75	CALL MZBOOK(IXCONS,LMOX1,0,2,'MOX1',0,0,NW,0,-1)
76	C SET UP THE B CONTROL BLOCK LOCATION NUMBER ARRAY ICOM(NNUC)
77	C LFP170 points to length of x-section data
78	LFP170 = LMOX1 + 2
79	LFP18=LFP170+NNUC
80	LFP18A=LFP18+NII
81	LFP19=LFP18A+NII
82	LFP20=LFP19+NMIX
83	C SET UP THE ARRAY (IREC(NII))
84	CALL XSECN1(NII,D(LFP11),D(LFP16),D(LFP17),
85	+ D(LFP18),D(LFP18A),D(LFP170),D(LFP19),
86	+ D(LFP20),D(LFP20),INEL)
87	C check if all isotopes have been found in the x-section file(s)
88	XSTOP = .FALSE.
89	DO 50 I=1,NMIX
90	IF(LD(LFP19+I-1).EQ.0) THEN
91	WRITE(IOUT,10100)LD(LFP19+I-1)
92	10000 FORMAT(' MICAP: Could not find x-section of element ',I8)
93	XSTOP = .TRUE.
94	ENDIF
95	50 CONTINUE
96	IF(XSTOP) THEN
97	PRINT '('' CALOR : Neutron x-section not found ===> STOP '')'
98	STOP
99	ENDIF
100	LFP21=LFP20+NNUC
101	C store xs accuracy at LFP210 (used for thinning in XSECN3)
102	LFP210 = LFP21 + NNUC
103	LFP22=LFP210+NNUC
104	LFP23=LFP22+NNUC
105	LFP24=LFP23+NNUC
106	LFP25=LFP24+NNUC
107	LFP26=LFP25+NNUC
108	LFP27=LFP26+NNR*NNUC
109	LFP28=LFP27+NNR*NNUC
110	LFP29=LFP28+NNUC
111	LFP30=LFP29+NNUC
112	LFP31=LFP30+NGR*NNUC
113	LFP32=LFP31+NGR*NNUC
114	LFP33=LFP32+MEDIA
115	LFP34=LFP33+MEDIA
116	LFP35=LFP34+NNUC
117	LFP36=LFP35+3NQNNUC
118	C CLEAR THE STORAGE LOCATIONS FOR THE DICTIONARIES, ETC.
119	CALL CLEAR(D,LFP20,LFP36-1)
120	C ESTABLISH THE RANDOM WALK STORAGE LOCATIONS
121	LFP41=LFP36
122	LFP42=LFP41+2*NNUC
123	LFP45=LFP42+24*MEDIA
124	LFP46=LFP45+NGR*NNUC
125	NW = 0
126	DO 60 INUC=1,NNUC
127	NW = NW + LD(LFP170+INUC-1)
128	60 CONTINUE
129	NW = NW + 2
130	NWTOT = NWTOT + NW
131	CALL CHKZEB(NW,IXCONS)
132	CALL MZBOOK(IXCONS,LMOX2,0,2,'MOX2',0,0,NW,0,-1)
133	LFP43 = LMOX2 + 2
134	LAST = LFP43 - 1
135	MAXD = LMOX2 + NW
136	C PLACE THE MICROSCOPIC CROSS SECTION DATA INTO THE CORE
137	CALL XSECN2(D(LFP17),D(LFP18),D(LFP18A),
138	+ D(LFP20),D(LFP21),D(LFP210),D(LFP22),D(LFP23),
139	+ D(LFP24),D(LFP25),D(LFP26),D(LFP27),D(LFP28),
140	+ D(LFP29),D(LFP30),D(LFP31),D(LFP34),D(LFP35),
141	+ D(LFP35+NQNNUC),D(LFP35+2NQ*NNUC),
142	+ D(LFP43),D(LFP43),MAXD,LAST,INEL)
143	C determine length needed for macroscopic xs and mixing
144	NW = 0
145	DO 90 IM=1,MEDIA
146	NM = 0
147	LZ = 0
148	DO 70 IN=1,NMIX
149	IF(LD(LFP10+IN-1).NE.IM) GOTO 70
150	NM = NM+1
151	II = LD(LFP16+IN-1)
152	LZ = MAX0(LD(LFP27+NNR*(II-1)),LZ)
153	C LZ = MAX0(LDICT(1,II),LZ)
154	70 CONTINUE
155	IF(NM.GT.1) LZ = 4*LZ
156	DO 80 J=1,NMIX
157	IF(LD(LFP10+J-1).NE.IM) GOTO 80
158	II = LD(LFP16+J-1)
159	80 CONTINUE
160	NW = NW + LZ
161	90 CONTINUE
162	NW = NW + 2
163	NWTOT = NWTOT + NW
164	CALL CHKZEB(NW,IXCONS)
165	CALL MZBOOK(IXCONS,LMOX3,0,2,'MOX3',0,0,NW,0,-1)
166	LAST = LMOX3 + 1
167	LFP44=LAST+1
168	MAXD = LMOX3+NW
169	C SET, MIX AND THIN THE TOTAL CROSS SECTIONS
170	C ACCORDING TO THE MIXING TABLE
171	CALL XSECN3(D(LFP10),D(LFP11),D(LFP12),D(LFP16),D(LFP26),
172	+ D(LFP27),D(LFP32),D(LFP33),D(LFP44),D(LFP44),
173	+ D,MAXD,LAST)
174	C ESTABLISH THE PHOTON TOTAL CROSS SECTION DATA DICTIONARY
175	C STORAGE LOCATIONS
176	C determine number of words needed for photon production xs
177	NW = 0
178	DO 110 I=1,NNUC
179	DO 100 J=1,LD(LFP28+I-1)
180	LZ = LD(LFP31 + 2J - 1 + NGR(I-1))
181	C LZ = LGCB(2*J,I)
182	NW = NW + LZ
183	100 CONTINUE
184	110 CONTINUE
185	NW = NW + 2NGRNNUC+2
186	NWTOT = NWTOT + NW + 1
187	CALL CHKZEB(NW,IXCONS)
188	CALL MZBOOK(IXCONS,LMOX4,0,2,'MOX4',0,0,NW,0,-1)
189	LMAG2 = LMOX4 + 1
190	LD(LMAG2) = NMAGIC
191	LFP45 = LMAG2 + 1
192	LFP46 = LFP45 + NGR*NNUC
193	LFP47 = LFP46 + NGR*NNUC
194	LAST = LFP47 - 1
195	MAXD = LMOX4 + NW
196	C CLEAR THE STORAGE LOCATIONS FOR THE PHOTON DICTIONARIES
197	C OF THE TOTAL PHOTON PRODUCTION CROSS SECTIONS
198	CALL CLEAR(D,LFP45,LFP47-1)
199	C SUM THE PHOTON PARTIAL DISTRIBUTIONS OF THE ENDF/B-V
200	C FILE 12 AND FILE 13 DATA (BY MT NUMBER) AND PLACE THESE
201	C MICROSCOPIC MULTIPLICITIES TIMES CROSS SECTIONS IN CORE
202	CALL XSECN5(D(LFP28),D(LFP30),D(LFP31),D(LFP45),D(LFP46),
203	+ D(LFP47),D(LFP47),D,D,MAXD,LAST)
204	C
205	C print out media to print unit IOUT
206	C WRITE(IOUT,10000)
207	10100 FORMAT(23X,'MICAP Material Parameters',/,
208	+ 23X,'-------------------------',/)
209	WRITE(IOUT,10200)
210	10200 FORMAT(8X,'GEANT Material Parameters',10X,
211	+ 6X,'MICAP Material Parameters',/,
212	+ 8X,25('-'),10X,6X,25('-'))
213	WRITE(IOUT,10300)
214	10300 FORMAT(1X,'Material',16X,'No/Iso',4X,'A',5X,'Z',2X,'\|',
215	+ 4X,'A',5X,'Z',3X,'Density',
216	+ 3X,'Coll.Len',/,44('-'),'+',33('-'))
217	MFLAG = 0
218	KMED = 0
219	NISO = 1
220	DO 130 I=0,NMIX-1
221	C get GEANT name of material
222	MARK = '/ '
223	IF(LD(LFP11+I)/1000.NE.LD(LFP13+I)) THEN
224	MARK = '/ *'
225	MFLAG=1
226	ENDIF
227	K1 = LD(LFP16+I)-1
228	LS1 = LD(LFP26+NNR*K1)+LMOX2
229	LEN = LD(LFP27+NNR*K1)/2
230	EN = 1.E6
231	CALL TBSPLT(D(LS1),EN,LEN,XSEC)
232	XSEC = 1./XSEC/D(LFP12+I)
233	IF(LD(LFP140+I).NE.0.) THEN
234	WRITE(CGEANT,'(F6.1,I5)') D(LFP140+I),LD(LFP13+I)
235	ELSE
236	WRITE(CGEANT,'(A11)') ' - -'
237	ENDIF
238	IF(KMED.NE.LD(LFP10+I)) THEN
239	NISO = 1
240	CALL GFMATE(LD(LGE2MO+LD(LFP10+I)),MATNAM,AA,ZZ,DENS,
241	+ RADL,ABSL,UB,NW)
242	NBLK = LNBLNK(MATNAM)
243	DO 120 JC=NBLK+1,20
244	WRITE(MATNAM(JC:JC),'(A1)') '.'
245	120 CONTINUE
246	WRITE(MARK(2:3),'(I2)') NISO
247	WRITE(IOUT,10400) MATNAM,LD(LGE2MO+LD(LFP10+I)),MARK,
248	+ CGEANT,
249	+ D(LFP34+LD(LFP16+I)-1)*1.008665,
250	+ LD(LFP11+I)/1000,D(LFP12+I),XSEC
251	KMED = LD(LFP10+I)
252	ELSE
253	WRITE(MARK(2:3),'(I2)') NISO
254	WRITE(IOUT,10500) LD(LGE2MO+LD(LFP10+I)),MARK,CGEANT,
255	+ D(LFP34+LD(LFP16+I)-1)*1.008665,
256	+ LD(LFP11+I)/1000,D(LFP12+I),XSEC
257	ENDIF
258	10400 FORMAT(1X,A20,I6,A4,A11,' \|',F6.1,I5,1X,E11.4,1X,E9.3)
259	10500 FORMAT(1X,20X,I6,A4,A11,' \|',F6.1,I5,1X,E11.4,1X,E9.3)
260	LD(LFP13+I) = LD(LFP11+I)/1000
261	NISO = NISO + 1
262	130 CONTINUE
263	WRITE(IOUT,'(78(''-''),/,48X,''Density in (Atoms/barn/cm)'')')
264	WRITE(IOUT,'(36X,
265	+ ''Collision Length for 1 MeV neutron in (cm)'',/)')
266	IF(MFLAG.EQ.1) WRITE(IOUT,'(/,
267	+ 15X,''*******************************************'',/,
268	+ 15X,''* W A R N I N G *'',/,
269	+ 15X,''* Marked isotopes () not found in the '',/,
270	+ 15X,''* cross-section file(s) *'',/,
271	+ 15X,''* Cross-sections of the isotope with *'',/,
272	+ 15X,''* the closest Z will be used instead *'',/,
273	+ 15X,''*******************************************'',/)')
274	C which x-section files have been used?
275	LT = LTEMP
276	LCI = LCISO
277	LC = 0
278	NOHED=.TRUE.
279	140 CONTINUE
280	C first check if x-section file has been used!
281	NUNIT = IQ(LT+NTUNIT)
282	DO 150 I=0,NMIX-1
283	KISO = LD(LFP16+I)
284	MISO = LD(LFP17+KISO-1)
285	IF(NUNIT.EQ.LD(LFP18A+MISO-1)) GOTO 160
286	150 CONTINUE
287	C unit never used !
288	GOTO 190
289	160 CONTINUE
290	C search for comments for selected isotopes
291	NCOM = IQ(LCI+1)
292	DO 180 J=1,NCOM
293	K = (J-1)*81 + 2
294	JZ = IQ(LCI+K)
295	JA = IQ(LCI+K+1)
296	CCOMM = ' '
297	CALL UHTOC(IQ(LCI+K+2),4,CCOMM,70)
298	DO 170 I=0,NMIX-1
299	KISO = LD(LFP16+I)
300	IA = NINT(D(LFP34+KISO-1)*1.008665)
301	IZ = LD(LFP11+I)/1000
302	MISO = LD(LFP17+KISO-1)
303	C print the comment, if the isotope is correct and has been read from
304	C the current x-section file
305	IF(IA.EQ.JA .AND. IZ.EQ.JZ .AND.
306	+ NUNIT.EQ.LD(LFP18A+MISO-1)) THEN
307	IF(NOHED) THEN
308	WRITE(IOUT,'(/,23X,''COMMENTS ABOUT ISOTOPE DATA'')')
309	WRITE(IOUT,'( 23X,''---------------------------'',/)')
310	NOHED = .FALSE.
311	ENDIF
312	LC = LC + 1
313	WRITE(IOUT,'(I4,'') '',A70)') LC,CCOMM
314	GOTO 180
315	ENDIF
316	170 CONTINUE
317	180 CONTINUE
318	190 LT = LQ(LT)
319	LCI = LQ(LCI)
320	IF(LT.GT.0.AND.LCI.GT.0) GOTO 140
321	C print the x-section file names and comments
322	WRITE(IOUT,'(/,20X,''USED NEUTRON CROSS-SECTION FILES'')')
323	WRITE(IOUT,'( 20X,''--------------------------------'',/)')
324	LT = LTEMP
325	200 CONTINUE
326	C first check if x-section file has been used!
327	NUNIT = IQ(LT+NTUNIT)
328	DO 210 I=0,NMIX-1
329	KISO = LD(LFP16+I)
330	MISO = LD(LFP17+KISO-1)
331	IF(NUNIT.EQ.LD(LFP18A+MISO-1)) GOTO 220
332	210 CONTINUE
333	C unit never used !
334	GOTO 230
335	220 CONTINUE
336	C get file name of x-section file
337	XSFILE = ' '
338	COMMEN = ' '
339	DATSTR = ' '
340	CALL UHTOC(IQ(LT+NTNAME+1),4,XSFILE,IQ(LT+NTNAME))
341	CALL UHTOC(IQ(LT+NTCOMM+1),4,COMMEN,IQ(LT+NTCOMM))
342	CALL UHTOC(IQ(LT+NTDATS+1),4,DATSTR,IQ(LT+NTDATS))
343	WRITE(IOUT,'('' File : '',A66)') XSFILE
344	WRITE(IOUT,'('' Generated : '',A24,/,
345	+ '' Comment : '',A66,/)') DATSTR,COMMEN
346	230 LT = LQ(LT)
347	IF(LT.GT.0) GOTO 200
348	WRITE(IOUT,'(/,'' MICAP :'',I10,
349	+ '' words used in GCBANK for neutron x-section tables''/)') NWTOT
350	RETURN
351	END