diff options
Diffstat (limited to 'Dragon/src/CPODRV.f')
| -rw-r--r-- | Dragon/src/CPODRV.f | 366 |
1 files changed, 366 insertions, 0 deletions
diff --git a/Dragon/src/CPODRV.f b/Dragon/src/CPODRV.f new file mode 100644 index 0000000..ccf2ce2 --- /dev/null +++ b/Dragon/src/CPODRV.f @@ -0,0 +1,366 @@ +*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 |