*DECK CPODRV SUBROUTINE CPODRV(IPCPO ,IPEDIT,IPDEPL,IPRINT,CURNAM,CTITRE, > NAMCPO,NGROUP,NMERGE,NBMICR,NIFISS,MXBURN, > NL ,NISCPO,NPROC ,ILEAKS,NXXXZ ,NEDMAC, > HVECT ,NSBS ,ILOCAL,ISOCPO,ISOTMP,IDIMIX, > NBIMRG,ICOMIX,VOLMER,ENERGY,TIME ,BURN , > WIRRAD,IBSTEP) * *----------------------------------------------------------------------- * *Purpose: * Recover cross section information located on directory CURNAM or on * directory family with prefix CURNAM. * *Copyright: * Copyright (C) 2007 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): G. Marleau * *Parameters: input * IPCPO pointer to the compo (L_COMPO signature). * IPEDIT pointer to edit information (L_EDIT signature). * IPDEPL pointer to depletion information (L_BURNUP signature). * IPRINT print parameter. Equal to zero for no print. * CURNAM name of the output directory (or prefix of output * directory in burnup cases). * CTITRE character*72 title. * NAMCPO character*8 name of the material mixture sub-directory. * NGROUP number of energy groups in output data. * NMERGE number of output regions. * NBMICR maximum number of isotopes. * NIFISS number of fissile isotopes. * MXBURN maximum number of output burnup sets. * NL number of Legendre orders (=1 for isotropic scattering). * NISCPO number of Compo isotopes treated. * NPROC number of microscopic xs to process. * ILEAKS leak option: 0 no leakage ; 1 homogeneous leakage ; * 2 heterogeneous leakage. * NXXXZ maximum dimension of ISO dependent vector = max(nbmicr,1). * NEDMAC number of edit xs. * HVECT name of edit xs. * NSBS number of sub-burnup step considered. * ILOCAL local parameter flag (0: global; 1:local). * ISOCPO Compo name of isotopes. * ISOTMP name of isotopes in EDIT. * IDIMIX isotopes identifier in each Compo material. * NBIMRG final number of isotope per region. * ICOMIX pointer to Compo isotope for region. * VOLMER merge volume. * ENERGY energy. * TIME time steps. * BURN burnup. * WIRRAD irradiation. * IBSTEP sub-burnup step considered. * *----------------------------------------------------------------------- * USE GANLIB IMPLICIT NONE *---- * SUBROUTINE ARGUMENTS *---- TYPE(C_PTR) IPCPO,IPEDIT,IPDEPL INTEGER IPRINT,NGROUP,NMERGE,CTITRE(18),NBMICR,NIFISS, > MXBURN,NL,NISCPO,NPROC ,ILEAKS,NXXXZ,NEDMAC, > NSBS ,ILOCAL,ISOCPO(3,NXXXZ),ISOTMP(3,NXXXZ), > IDIMIX(NMERGE,NXXXZ),NBIMRG(NMERGE), > ICOMIX(NMERGE,NXXXZ),IBSTEP(MXBURN) CHARACTER CURNAM*12,NAMCPO*8,HVECT(NEDMAC)*8 REAL VOLMER(NMERGE),ENERGY(NGROUP+1), > TIME(MXBURN),BURN(MXBURN),WIRRAD(MXBURN) *---- * ALLOCATABLE ARRAYS *---- INTEGER, ALLOCATABLE, DIMENSION(:) :: INDPRO,ITYPRO,NAMI REAL, ALLOCATABLE, DIMENSION(:) :: DENTMP,EMJMAC,VECT,XSREC,XSCAT, 1 DISFC,DENSI,EMJI REAL, ALLOCATABLE, DIMENSION(:,:,:) :: RVALOC DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: DENCPO,XSREM,SCREM DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: DXSMIC,DMJCPO DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:) :: DSCMIC,DXSMAC, 1 DISFAC DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:,:) :: DSCMAC *---- * LOCAL PARAMETERS *---- INTEGER IOUT,NSTATE,NDPROC,NPARAM REAL CUTOFF PARAMETER (IOUT=6,NSTATE=40,NDPROC=20,NPARAM=4, > CUTOFF=1.0E5) INTEGER NEFBRN,IBR,IBR2,IBURN,NDUM1,NDUM2,MAXDM, > IMRG,ISOC,ISOR,ITC,IDFLU, > ISTATE(NSTATE),IPARAM(NPARAM),MXISOS, > NBISO,NREAC,NVAR,NBMIX,NREG,NLOC CHARACTER NAMMIX*12,NAMBRN*12,NAMISO*12,NAMMAC*12 REAL DELTA(2),TMPDAY(3),DELERR(3) DOUBLE PRECISION DMJMAC INTEGER IFCDIS *---- * SCRATCH STORAGE ALLOCATION * DENTMP density of EDI isotopes. * EMJMAC fission energy for macroscopic data. * DENCPO density of Compo isotopes. * DMJCPO fission energy for macroscopic data. * INDPRO identifier for xs processing. * ITYPRO identifier for xs processed. * DXSMIC micro vector xs. * DSCMIC micro scattering matrix xs. * DXSMAC macro vector xs. * DSCMAC macro scattering matrix xs. * DISFAC discontinuity factors. * RVALOC local burnup and irradiation values. *---- ALLOCATE(INDPRO(NPROC),ITYPRO(NPROC)) ALLOCATE(DENTMP(NXXXZ),EMJMAC(NMERGE),RVALOC(2,NMERGE,MXBURN)) ALLOCATE(DENCPO(NXXXZ),DXSMIC(NGROUP,NPROC), > DSCMIC(NGROUP,NGROUP,NL),DXSMAC(NGROUP,NPROC,NMERGE), > DSCMAC(NGROUP,NGROUP,NL,NMERGE),DMJCPO(2,NXXXZ), > DISFAC(2,NGROUP,3)) *---- * GET GLOBAL BURNUP AND IRRADIATION *---- IFCDIS=1 NAMMAC='MACR ' IF(NSBS.EQ.0) THEN BURN(1)=0.0 WIRRAD(1)=0.0 NEFBRN=1 IBSTEP(NEFBRN)=0 ELSE DO 100 IBR=1,NSBS IBURN=IBSTEP(IBR) IF(IBURN.GT.0.AND. IBURN.LE.MXBURN) THEN WRITE(NAMBRN,'(8HDEPL-DAT,I4.4)') IBURN CALL LCMSIX(IPDEPL,NAMBRN,1) CALL LCMGET(IPDEPL,'BURNUP-IRRAD',DELTA) BURN(IBR)=DELTA(1) WIRRAD(IBR)=DELTA(2) TIME(IBR)=TIME(IBURN) CALL LCMSIX(IPDEPL,NAMBRN,2) ENDIF 100 CONTINUE NEFBRN=NSBS ENDIF *---- * GET LOCAL BURNUP AND IRRADIATION *---- IF((NSBS.EQ.0).OR.(ILOCAL.EQ.0).OR.(.NOT.C_ASSOCIATED(IPDEPL))) 1 THEN RVALOC(:2,:NMERGE,:NEFBRN)=0.0 ELSE NLOC=2 CALL LCMGET(IPDEPL,'STATE-VECTOR',ISTATE) IF(ISTATE(3).NE.MXBURN) CALL XABORT('CPODRV: INVALID STATE-VE' 1 //'CTOR.') NBISO=ISTATE(4) NREAC=ISTATE(6) NVAR=ISTATE(7) NBMIX=ISTATE(8) CALL LCMGET(IPEDIT,'STATE-VECTOR',ISTATE) NREG=ISTATE(17) DO 105 IBR=1,NSBS IBURN=IBSTEP(IBR) CALL COMGEN(IPDEPL,IPEDIT,NREG,NMERGE,IBURN,'FLUB',MXBURN, 1 NBMIX,NBISO,NREAC,NVAR,1,NLOC,RVALOC(1,1,IBR)) CALL COMGEN(IPDEPL,IPEDIT,NREG,NMERGE,IBURN,'IRRA',MXBURN, 1 NBMIX,NBISO,NREAC,NVAR,2,NLOC,RVALOC(1,1,IBR)) 105 CONTINUE ENDIF *---- * INITIALIZE INDPRO FOR MICROSCOPIC XS TO PROCESS *---- ALLOCATE(VECT(NEDMAC)) VECT(:NEDMAC)=0.0 CALL CPONED(NPROC ,0,NL-1,MAX(1,ILEAKS),NEDMAC,HVECT,VECT,INDPRO) INDPRO(6)=0 INDPRO(16)=0 ALLOCATE(XSREC(NGROUP*NPROC),XSCAT(NGROUP*NGROUP*NL)) *---- * LOOP OVER BURNUP STEPS *---- NDUM1=NMERGE*MAX(NIFISS,NGROUP) NDUM2=NGROUP*NGROUP MAXDM=MAX(NDUM1,NDUM2) ALLOCATE(DISFC(NGROUP)) ALLOCATE(XSREM(NGROUP*NPROC),SCREM(NGROUP*NGROUP*NL)) IDFLU=16 MXISOS=0 DO 110 IBR=1,NEFBRN WRITE(NAMBRN,'(A8,I4)') 'BURN ',IBR IBURN=IBSTEP(IBR) IF(IBURN.GT.0) WRITE(CURNAM(9:12),'(I4.4)') IBURN CALL LCMSIX(IPEDIT,CURNAM,1) IF(NISCPO.GT.0) CALL LCMGET(IPEDIT,'ISOTOPESDENS',DENTMP) IF(IPRINT.GE.10) WRITE(IOUT,6000) CURNAM CALL LCMSIX(IPEDIT,'MACROLIB',1) CALL LCMGET(IPEDIT,'TIMESTAMP',TMPDAY) DELERR(1)=CUTOFF*ABS(TMPDAY(1)-TIME(IBR)/8.64E-4) DELERR(2)=CUTOFF*ABS(TMPDAY(2)-BURN(IBR)) DELERR(3)=CUTOFF*ABS(TMPDAY(3)-WIRRAD(IBR)) IF( (DELERR(1).GT.TMPDAY(1)) .OR. > (DELERR(2).GT.TMPDAY(2)) .OR. > (DELERR(3).GT.TMPDAY(3)) ) THEN IF(TIME(IBR) .EQ. 0.0 .AND. > BURN(IBR) .EQ. 0.0 .AND. > WIRRAD(IBR) .EQ. 0.0) THEN WRITE(IOUT,7001) ELSE WRITE(IOUT,7000) > TMPDAY(1),TIME(IBR)/8.64E-4,DELERR(1)/CUTOFF, > TMPDAY(2),BURN(IBR),DELERR(2)/CUTOFF, > TMPDAY(3),WIRRAD(IBR) ,DELERR(3)/CUTOFF ENDIF TIME(IBR)=TMPDAY(1)*8.64E-4 BURN(IBR)=TMPDAY(2) WIRRAD(IBR)=TMPDAY(3) ENDIF *---- * READ MACROSCOPIC XS FOR ALL GROUP AND ALL REGIONS *---- CALL CPOMAR(IPEDIT,NGROUP,NMERGE,NL ,NIFISS,NEDMAC, > HVECT ,VECT ,NPROC ,ILEAKS,DXSMAC, > DSCMAC,EMJMAC,DISFC,IFCDIS,DISFAC) CALL LCMSIX(IPEDIT,'MACROLIB',2) DENCPO(:NISCPO)=0.0D0 DO 120 IMRG=1,NMERGE DMJMAC=DBLE(EMJMAC(IMRG)) WRITE(NAMMIX,'(A8,I4)') NAMCPO,IMRG CALL LCMSIX(IPCPO,NAMMIX,1) CALL LCMSIX(IPCPO,NAMBRN,1) IF(IPRINT.GE.10) WRITE(IOUT,6001) NAMMIX DMJCPO(:2,:NBMICR)=0.0D0 XSREM(:NGROUP*NPROC)=0.0D0 SCREM(:NGROUP*NGROUP*NL)=0.0D0 DO 130 ISOC=1,NBIMRG(IMRG) ISOR=ICOMIX(IMRG,ISOC) WRITE(NAMISO,'(3A4)') (ISOCPO(ITC,ISOR),ITC=1,3) IF(IPRINT.GE.10) WRITE(IOUT,6002) NAMISO *---- * CREATE AND SAVE XS FOR A CPO ISOTOPE IN CURRENT REGION *---- CALL LCMSIX(IPCPO,NAMISO,1) DXSMIC(:NGROUP,:NPROC)=0.0D0 DSCMIC(:NGROUP,:NGROUP,:NL)=0.0D0 CALL CPOMIC(IPCPO ,IPEDIT,IPRINT,NGROUP,NMERGE,NBMICR, > NL ,IMRG ,ISOR ,NPROC ,ISOTMP,IDIMIX, > INDPRO,ITYPRO,DENCPO,DENTMP,DXSMIC,DSCMIC, > DMJCPO,DXSMAC(1,IDFLU,IMRG)) CALL LCMSIX(IPCPO,NAMISO,2) *---- * REMOVE CONTRIBUTION OF CPO ISOTOPE FROM MACROSCOPIC. *---- IF(DENCPO(ISOR).GT.0.0D0) THEN CALL CPOREM(NGROUP,NL ,NPROC ,INDPRO,DENCPO(ISOR), > DXSMIC,DSCMIC,XSREM ,SCREM ) ENDIF DMJMAC=DMJMAC-DMJCPO(1,ISOR) 130 CONTINUE *---- * WRITE MACROSCOPIC XS FOR ALL GROUP IN THIS REGION REGIONS *---- CALL CPOMAW(IPCPO ,IPRINT,NGROUP,NL ,NPROC ,INDPRO, > ITYPRO,DXSMAC(1,1,IMRG),DSCMAC(1,1,1,IMRG), > XSREM,SCREM,DISFC,DMJMAC,IFCDIS,DISFAC) ALLOCATE(DENSI(NBIMRG(IMRG)+1),EMJI(NBIMRG(IMRG)+1)) DENSI(1)=1.0 EMJI=REAL(DMJMAC)*1.0E-18 DO 140 ISOC=1,NBIMRG(IMRG) ISOR=ICOMIX(IMRG,ISOC) DENSI(ISOC+1)=REAL(DENCPO(ISOR)) IF(DMJCPO(2,ISOR).GT.0.0D0) THEN EMJI(ISOC+1)=1.0E-18*REAL(DMJCPO(1,ISOR)/DMJCPO(2,ISOR)) ELSE EMJI(ISOC+1)=0.0 ENDIF 140 CONTINUE CALL LCMPUT(IPCPO,'ISOTOPESDENS',(NBIMRG(IMRG)+1),2,DENSI) CALL LCMPUT(IPCPO,'ISOTOPES-EFJ',(NBIMRG(IMRG)+1),2,EMJI) DEALLOCATE(EMJI,DENSI) CALL LCMSIX(IPCPO,NAMBRN,2) *---- * PUT REMAINING INFORMATION ON CPO FOR THIS MIXTURE *---- CALL LCMPUT(IPCPO,'TITLE',18,3,CTITRE) CALL LCMPUT(IPCPO,'VOLUME',1,2,VOLMER(IMRG)) CALL LCMPUT(IPCPO,'ENERGY',NGROUP+1,2,ENERGY) IF(IBR.EQ.NEFBRN) THEN IF(ILOCAL.EQ.1) THEN DO 145 IBR2=1,NEFBRN WIRRAD(IBR2)=RVALOC(1,IMRG,IBR2) BURN(IBR2)=RVALOC(2,IMRG,IBR2) 145 CONTINUE ENDIF IF(IPRINT.GT.1) THEN WRITE(IOUT,7002) IMRG,'IRRA',(WIRRAD(IBR2),IBR2=1,NEFBRN) WRITE(IOUT,7002) IMRG,'BURN',(BURN(IBR2),IBR2=1,NEFBRN) ENDIF CALL LCMPUT(IPCPO,'N/KB ',NEFBRN,2,WIRRAD) CALL LCMPUT(IPCPO,'BURNUP',NEFBRN,2,BURN) ALLOCATE(NAMI(3*(NBIMRG(IMRG)+1))) READ(NAMMAC,'(3A4)') (NAMI(ITC+1),ITC=0,2) ITC=3 DO 150 ISOC=1,NBIMRG(IMRG) ISOR=ICOMIX(IMRG,ISOC) NAMI(ITC+1)=ISOCPO(1,ISOR) NAMI(ITC+2)=ISOCPO(2,ISOR) NAMI(ITC+3)=ISOCPO(3,ISOR) ITC=ITC+3 150 CONTINUE CALL LCMPUT(IPCPO,'ISOTOPESNAME',3*(NBIMRG(IMRG)+1),3,NAMI) NAMI(:NBIMRG(IMRG)+1)=0 CALL LCMPUT(IPCPO,'JTAB',(NBIMRG(IMRG)+1),1,NAMI) DEALLOCATE(NAMI) IPARAM(:NPARAM)=0 IPARAM(1)=NGROUP IPARAM(2)=NBIMRG(IMRG)+1 IPARAM(3)=NL IPARAM(4)=NEFBRN MXISOS=MAX(MXISOS,NBIMRG(IMRG)+1) CALL LCMPUT(IPCPO,'PARAM',NPARAM,1,IPARAM) ENDIF CALL LCMSIX(IPCPO,NAMMIX,2) 120 CONTINUE CALL LCMSIX(IPEDIT,CURNAM,2) 110 CONTINUE ISTATE(:NSTATE)=0 ISTATE(1)=NMERGE ISTATE(2)=NGROUP ISTATE(3)=MXISOS ISTATE(4)=NL ISTATE(5)=NEFBRN ISTATE(6)=NPARAM ISTATE(7)=IFCDIS CALL LCMPUT(IPCPO,'STATE-VECTOR',NSTATE,1,ISTATE) DEALLOCATE(SCREM,XSREM,DISFC) IF(NISCPO.GT.0) DEALLOCATE(XSCAT,XSREC,VECT) *---- * SCRATCH STORAGE DEALLOCATION *---- DEALLOCATE(DISFAC,DMJCPO,DSCMAC,DXSMAC,DSCMIC,DXSMIC,DENCPO) DEALLOCATE(RVALOC,EMJMAC,DENTMP) DEALLOCATE(ITYPRO,INDPRO) RETURN *---- * PRINT FORMAT *---- 6000 FORMAT(' CPODRV: STEPPING UP ON DIRECTORY = ',A12) 6001 FORMAT(' CPODRV: CREATING MIXTURE = ',A12) 6002 FORMAT(' CPODRV: CREATING ISOTOPE = ',A12) *---- * WARNING FORMAT *---- 7000 FORMAT( > ' CPODRV: WARNING -> BURNUP AND EDIT DATA DIFFER',1P/ > ' TIME: EDIT=',E15.7,5X,' BURNUP=',E15.7,' DIFF=',E15.7/ > ' BURN: EDIT=',E15.7,5X,' BURNUP=',E15.7,' DIFF=',E15.7/ > ' WIRR: EDIT=',E15.7,5X,' BURNUP=',E15.7,' DIFF=',E15.7/ > ' USE EDIT DATA ') 7001 FORMAT( > ' CPODRV: WARNING -> 0 BURNUP STEP, USE EDIT DATA') 7002 FORMAT(/13H CPODRV: MIX=,I4,3X,A,1H=,1P,6E12.4/(25X,6E12.4)) END