diff options
Diffstat (limited to 'Donjon/src/CRETAB.f')
| -rw-r--r-- | Donjon/src/CRETAB.f | 128 |
1 files changed, 128 insertions, 0 deletions
diff --git a/Donjon/src/CRETAB.f b/Donjon/src/CRETAB.f new file mode 100644 index 0000000..87fd42c --- /dev/null +++ b/Donjon/src/CRETAB.f @@ -0,0 +1,128 @@ +*DECK CRETAB + SUBROUTINE CRETAB(IPCPO,NISO,NGRP,NL,IMPX,HISO,NBURN,ITY,CONC, + 1 ILEAK,ZTOTAL,ZZNUG,ZNUGF,ZCHI,ZOVERV,ZDIFFX,ZDIFFY,ZDIFFZ,ZH, + 3 ZSCAT,ZFLUX,UPS) +* +*----------------------------------------------------------------------- +* +*Purpose: +* Create burnup dependent table with the extracted isotope. +* +*Copyright: +* Copyright (C) 2007 Ecole Polytechnique de Montreal. +* +*Author(s): +* A. Hebert +* +*Parameters: input +* IPCPO pointer to l_compo information. +* NISO 1+number of extracted isotopes. +* NGRP number of energy groups. +* NL number of legendre orders (=1 for isotropic scattering). +* IMPX print parameter (=0 for no print). +* HISO hollerith name information for extracted isotopes. +* NBURN number of tabulated burnup steps +* ITY =0: do not process the isotope; =1: use number density +* stored in conc(i); =2: use number density stored in compo. +* CONC user defined number density. +* +*Parameters: output +* ILEAK diffusion coefficient flag (=1: isotropic; =2: anisotropic). +* ZTOTAL burnup dependent total macroscopic x-sections +* ZZNUG burnup dependent nu*fission macroscopic x-sections. +* ZNUGF burnup dependent fission macroscopic x-sections. +* ZCHI burnup dependent fission spectrum. +* ZOVERV burnup dependent reciprocal neutron velocities. +* ZDIFFX burnup dependent x-directed diffusion coefficients. +* ZDIFFY burnup dependent y-directed diffusion coefficients. +* ZDIFFZ burnup dependent z-directed diffusion coefficients. +* ZH burnup dependent h-factors (kappa*fission macroscopic +* x-sections). +* ZSCAT burnup dependent scattering macroscopic x-sections. +* ZFLUX burnup dependent integrated flux. +* +*Parameters: scratch +* TOTAL total macroscopic x-sections. +* ZNUG nu*fission macroscopic x-sections. +* SNUGF fission macroscopic x-sections. +* CHI fission spectrum. +* OVERV reciprocal neutron velocities. +* DIFFX x-directed diffusion coefficients. +* DIFFY y-directed diffusion coefficients. +* DIFFZ z-directed diffusion coefficients. +* H h-factors (kappa*fission macroscopic x-sections). +* SCAT scattering macroscopic x-sections. +* FLUX integrated flux. +* DENSIT isotopic number densities. +* +*----------------------------------------------------------------------- +* + USE GANLIB +*---- +* SUBROUTINE ARGUMENTS +*---- + TYPE(C_PTR) IPCPO + INTEGER NISO,NGRP,NL,IMPX,NBURN,HISO(3*NISO),ITY(NISO),ILEAK + REAL CONC(NISO),ZTOTAL(NBURN,NGRP),ZZNUG(NBURN,NGRP), + 1 ZCHI(NBURN,NGRP),ZOVERV(NBURN,NGRP),ZDIFFX(NBURN,NGRP), + 2 ZDIFFY(NBURN,NGRP),ZDIFFZ(NBURN,NGRP),ZH(NBURN,NGRP), + 3 ZSCAT(NBURN,NL,NGRP,NGRP),ZNUGF(NBURN,NGRP),ZFLUX(NBURN,NGRP) + LOGICAL UPS +*---- +* LOCAL VARIABLES +*---- + CHARACTER TEXT12*12 + REAL, ALLOCATABLE, DIMENSION(:) :: TOTAL,ZNUG,CHI,OVERV,DIFFX, + 1 DIFFY,DIFFZ,H,SNUGF,FLUX,DENSIT + REAL, ALLOCATABLE, DIMENSION(:,:,:) :: SCAT +*---- +* SCRATCH STORAGE ALLOCATION +*---- + ALLOCATE(TOTAL(NGRP),ZNUG(NGRP),CHI(NGRP),OVERV(NGRP),DIFFX(NGRP), + 1 DIFFY(NGRP),DIFFZ(NGRP),H(NGRP),SCAT(NL,NGRP,NGRP),SNUGF(NGRP), + 2 FLUX(NGRP),DENSIT(NISO)) +*---- +* RECOVER MACROSCOPIC X-SECTION INFO FROM BURNUP DIRECTORIES +*---- + DO 20 IBURN=1,NBURN + WRITE(TEXT12,'(4HBURN,4X,I4)') IBURN + CALL LCMSIX(IPCPO,TEXT12,1) + CALL LCMGET(IPCPO,'ISOTOPESDENS',DENSIT) + IF(DENSIT(1).NE.1.)CALL XABORT('@CRETAB: DENSIT(1).NE.1.') + DO I=2,NISO + IF(ITY(I).EQ.0)THEN + DENSIT(I)=0. + ELSEIF(ITY(I).EQ.1)THEN + DENSIT(I)=CONC(I) + ELSEIF(ITY(I).NE.2)THEN + CALL XABORT('@CRETAB: INVALID VALUE OF ITY.') + ENDIF + ENDDO + CALL CREMAC(IPCPO,NISO,NGRP,NL,IMPX,HISO,DENSIT,ILEAK,TOTAL, + 1 ZNUG,SNUGF,CHI,OVERV,DIFFX,DIFFY,DIFFZ,H,SCAT,FLUX,UPS) + CALL LCMSIX(IPCPO,' ',2) + DO 21 JGR=1,NGRP + ZTOTAL(IBURN,JGR)=TOTAL(JGR) + ZZNUG(IBURN,JGR)=ZNUG(JGR) + ZNUGF(IBURN,JGR)=SNUGF(JGR) + ZCHI(IBURN,JGR)=CHI(JGR) + ZOVERV(IBURN,JGR)=OVERV(JGR) + ZDIFFX(IBURN,JGR)=DIFFX(JGR) + ZDIFFY(IBURN,JGR)=DIFFY(JGR) + ZDIFFZ(IBURN,JGR)=DIFFZ(JGR) + ZH(IBURN,JGR)=H(JGR) + ZFLUX(IBURN,JGR)=FLUX(JGR) + DO 22 IGR=1,NGRP + DO 23 IL=1,NL + ZSCAT(IBURN,IL,IGR,JGR)=SCAT(IL,IGR,JGR) + 23 CONTINUE + 22 CONTINUE + 21 CONTINUE + 20 CONTINUE +*---- +* SCRATCH STORAGE DEALLOCATION +*---- + DEALLOCATE(DENSIT,FLUX,SNUGF,SCAT,H,DIFFZ,DIFFY,DIFFX,OVERV,CHI, + 1 ZNUG,TOTAL) + RETURN + END |