diff options
Diffstat (limited to 'Dragon/src/MCTLIB.f')
| -rw-r--r-- | Dragon/src/MCTLIB.f | 204 |
1 files changed, 204 insertions, 0 deletions
diff --git a/Dragon/src/MCTLIB.f b/Dragon/src/MCTLIB.f new file mode 100644 index 0000000..661c6f6 --- /dev/null +++ b/Dragon/src/MCTLIB.f @@ -0,0 +1,204 @@ +*DECK MCTLIB + SUBROUTINE MCTLIB(IPLIB,NMIX,NGRP,NL,NFM,NDEL,NED,NAMEAD,LN2N, + < XSTOT,XSS,XSSNN,XSNUSI,XSCHI,XSN2N,XSN3N,XSEDI) +* +*----------------------------------------------------------------------- +* +*Purpose: +* Recover macroscopic cross-section information from the macrolib. +* +*Copyright: +* Copyright (C) 2008 Ecole Polytechnique de Montreal +* This library is free software; you can redistribute it and/or +* modify it under the terms of the GNU Lesser General Public +* License as published by the Free Software Foundation; either +* version 2.1 of the License, or (at your option) any later version +* +*Author(s): B. Arsenault +* +*Parameters: input +* IPLIB pointer to the LIBRARY data structure. +* NMIX number of mixtures in the geometry. +* NGRP number of energy groups. +* NL number of Legendre orders required in the estimations +* (NL=1 or higher). +* NFM number of fissile isotopes. +* NDEL number of delayed precursor groups. +* NED number of extra edit vectors. +* NAMEAD names of these extra edits. +* LN2N N2N cross section recovery flag. +* +*Parameters: output +* XSTOT total macroscopic cross sections for each mixture and energy +* group. +* XSS total scattering cross sections for each mixture and energy +* group. +* XSSNN in-group and out-of-group macroscopic transfert cross sections +* for each mixture and energy group. +* XSNUSI the values of Nu time the fission cross sections for each +* isotope per mixture and energy group. +* XSCHI the values of fission spectrum per isotope per mixture for +* each energy group. +* XSN2N N2N macroscopic cross sections for each mixture and energy +* group. +* XSN3N N3N macroscopic cross sections for each mixture and energy +* group. +* XSEDI extra edit cross sections for each mixture and energy group. +* +*----------------------------------------------------------------------- +* + USE GANLIB + IMPLICIT NONE +*---- +* SUBROUTINE ARGUMENTS +*---- + TYPE(C_PTR) IPLIB + INTEGER NMIX,NGRP,NL,NFM,NDEL,NED,NAMEAD(2,NED) + LOGICAL LN2N + REAL XSTOT(NMIX,NGRP),XSS(NMIX,NGRP,NL),XSN2N(NMIX,NGRP), + < XSN3N(NMIX,NGRP),XSSNN(NMIX,NGRP,NGRP,NL), + < XSNUSI(NMIX,NFM,NGRP,1+NDEL),XSCHI(NMIX,NFM,NGRP,1+NDEL), + < XSEDI(NMIX,NGRP,NED) +*---- +* LOCAL VARIABLES +*---- + TYPE(C_PTR) JPMC,KPMC + INTEGER IGROUP,JGROUP,IMAT,IED,IPOS,IEN0,IENBR,ILONG,ITYLCM, + < IMAX,IL,IDEL + DOUBLE PRECISION SUM + CHARACTER TEXT12*12,CM*2 +*---- +* ALLOCATABLE ARRAYS +*---- + INTEGER, ALLOCATABLE, DIMENSION(:) :: IJJS00,NJJS00,IPOS00 + REAL, ALLOCATABLE, DIMENSION(:) :: SCAT +*---- +* ALLOCATE THE MEMORY THAT IS REQUIRED TO READ THE SCATTERING MATTRICES +*---- + ALLOCATE(IJJS00(NMIX),NJJS00(NMIX),IPOS00(NMIX)) +*---- +* PROCESS THE CROSS SECTIONS FOR EACH ENERGY GROUP +* THIS IS THE MAIN LOOP +*---- + XSSNN(:NMIX,:NGRP,:NGRP,:NL)=0.0 + JPMC = LCMGID(IPLIB,'GROUP') + DO IGROUP=1,NGRP + KPMC = LCMGIL(JPMC,IGROUP) +*---- +* READ THE TOTAL MACROSCOPIC CROSS SECTIONS +*---- + CALL LCMGET(KPMC,'NTOT0',XSTOT(1,IGROUP)) +*---- +* READ THE TOTAL SCATTERING CROSS SECTIONS AND MATRICES +*---- + DO IL=1,NL + WRITE(CM,'(I2.2)') IL-1 + CALL LCMGET(KPMC,'SIGS'//CM,XSS(1,IGROUP,IL)) + CALL LCMGET(KPMC,'IJJS'//CM,IJJS00) + CALL LCMGET(KPMC,'NJJS'//CM,NJJS00) + CALL LCMGET(KPMC,'IPOS'//CM,IPOS00) + IMAX=0 + DO IMAT=1,NMIX + IMAX=IMAX+NJJS00(IMAT) + ENDDO + ALLOCATE(SCAT(IMAX)) + CALL LCMGET(KPMC,'SCAT'//CM,SCAT) + DO IMAT=1,NMIX + IPOS=IPOS00(IMAT) + IEN0=IJJS00(IMAT) + IENBR=NJJS00(IMAT) + DO WHILE (IENBR.GE.1) + XSSNN(IMAT,IGROUP,IEN0,IL)=SCAT(IPOS) + IPOS=IPOS+1 + IENBR=IENBR-1 + IEN0=IEN0-1 + ENDDO + ENDDO + DEALLOCATE(SCAT) + ENDDO +*---- +* RECOVER THE N2N MACROSCOPIC CROSS SECTIONS +*---- + IF(LN2N) THEN + CALL LCMLEN(KPMC,'N2N',ILONG,ITYLCM) + IF(ILONG.GT.0) THEN + CALL LCMGET(KPMC,'N2N',XSN2N(1,IGROUP)) + ELSE + XSN2N(:NMIX,IGROUP)=0.0 + ENDIF + CALL LCMLEN(KPMC,'N3N',ILONG,ITYLCM) + IF(ILONG.GT.0) THEN + CALL LCMGET(KPMC,'N3N',XSN3N(1,IGROUP)) + ELSE + XSN3N(:NMIX,IGROUP)=0.0 + ENDIF + DO IMAT=1,NMIX + XSS(IMAT,IGROUP,1)=XSS(IMAT,IGROUP,1)-2.0*XSN2N(IMAT,IGROUP) + 1 -3.0*XSN3N(IMAT,IGROUP) + IF(XSS(IMAT,IGROUP,1).LT.0.0) CALL XABORT('MCTLIB: BUG1') + XSS(IMAT,IGROUP,1)=MIN(XSTOT(IMAT,IGROUP),XSS(IMAT,IGROUP,1)) + ENDDO + ELSE + XSN2N(:NMIX,IGROUP)=0.0 + XSN3N(:NMIX,IGROUP)=0.0 +* N2N CORRECTION IN UPPER ENERGY GROUPS + DO IMAT=1,NMIX + IF(XSS(IMAT,IGROUP,1).GT.XSTOT(IMAT,IGROUP)) THEN + XSN2N(IMAT,IGROUP)=XSS(IMAT,IGROUP,1)-XSTOT(IMAT,IGROUP) + XSS(IMAT,IGROUP,1)=2.0*XSTOT(IMAT,IGROUP)- + 1 XSS(IMAT,IGROUP,1) + ENDIF + IF(XSS(IMAT,IGROUP,1).LT.0.0) CALL XABORT('MCTLIB: BUG2') + ENDDO + ENDIF +*---- +* RECOVER FISSION INFORMATION +*---- + IF(NFM.GT.0) THEN + CALL LCMGET(KPMC,'NUSIGF',XSNUSI(1,1,IGROUP,1)) + CALL LCMGET(KPMC,'CHI',XSCHI(1,1,IGROUP,1)) + DO IDEL=1,NDEL + WRITE(TEXT12,'(6HNUSIGF,I2.2)') IDEL + CALL LCMGET(KPMC,TEXT12,XSNUSI(1,1,IGROUP,1+IDEL)) + WRITE(TEXT12,'(3HCHI,I2.2)') IDEL + CALL LCMGET(KPMC,TEXT12,XSCHI(1,1,IGROUP,1+IDEL)) + ENDDO + ENDIF +*---- +* RECOVER SPECIAL EDIT CROSS SECTIONS +*---- + DO IED=1,NED + WRITE(TEXT12,'(2A4)') NAMEAD(1,IED),NAMEAD(2,IED) + CALL LCMLEN(KPMC,TEXT12,ILONG,ITYLCM) + IF(ILONG.GT.0) THEN + CALL LCMGET(KPMC,TEXT12,XSEDI(1,IGROUP,IED)) + ELSE + XSEDI(:NMIX,IGROUP,IED)=0.0 + ENDIF + ENDDO + ENDDO +*---- +* RELEASE THE TEMPORARY MEMORY ALLOCATION +*---- + DEALLOCATE(IPOS00,NJJS00,IJJS00) +*---- +* SCATTERING MATRIX NORMALIZATION +*---- + DO IL=1,NL + DO IMAT=1,NMIX + DO IGROUP=1,NGRP + SUM=0.0D0 + DO JGROUP=1,NGRP + SUM=SUM+XSSNN(IMAT,JGROUP,IGROUP,IL) ! JGROUP <-- IGROUP + ENDDO + IF(SUM.NE.0.0) THEN + DO JGROUP=1,NGRP + XSSNN(IMAT,JGROUP,IGROUP,IL)=XSSNN(IMAT,JGROUP,IGROUP,IL) + 1 *XSS(IMAT,IGROUP,IL)/REAL(SUM) + ENDDO + ENDIF + ENDDO + ENDDO + ENDDO + RETURN + END |