GEANT321/neutron/moxsec.F

   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 = 2*NII+13*NNUC+2*NNR*NNUC+4*NGR*NNUC+3*NQ*NNUC+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+3*NQ*NNUC
 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+NQ*NNUC),D(LFP35+2*NQ*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 + 2*J - 1 + NGR*(I-1))
 181 C           LZ = LGCB(2*J,I)
 182             NW = NW + LZ
 183   100    CONTINUE
 184   110 CONTINUE
 185       NW = NW + 2*NGR*NNUC+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