summaryrefslogtreecommitdiff
path: root/Dragon/src/EVO.f
diff options
context:
space:
mode:
Diffstat (limited to 'Dragon/src/EVO.f')
-rw-r--r--Dragon/src/EVO.f422
1 files changed, 422 insertions, 0 deletions
diff --git a/Dragon/src/EVO.f b/Dragon/src/EVO.f
new file mode 100644
index 0000000..341dd63
--- /dev/null
+++ b/Dragon/src/EVO.f
@@ -0,0 +1,422 @@
+*DECK EVO
+ SUBROUTINE EVO(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Driver for an isotopic depletion calculation.
+*
+*Copyright:
+* Copyright (C) 2002 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): A. Hebert
+*
+*Parameters: input/output
+* NENTRY number of LCM objects or files used by the operator.
+* HENTRY name of each LCM object or file:
+* HENTRY(1): creation or modification type(L_BURNUP);
+* HENTRY(2): modification type(L_LIBRARY);
+* HENTRY(3): read-only type(L_TRACK);
+* HENTRY(4): optional read-only type(L_FLUX)
+* or
+* HENTRY(1): creation or modification type(L_BURNUP);
+* HENTRY(2): creation type(L_LIBRARY);
+* HENTRY(3): read-only type(L_LIBRARY);
+* HENTRY(4): read-only type(L_TRACK);
+* HENTRY(5): optional read-only type(L_FLUX).
+* IENTRY type of each LCM object or file:
+* =1 LCM memory object; =2 XSM file; =3 sequential binary file;
+* =4 sequential ascii file.
+* JENTRY access of each LCM object or file:
+* =0 the LCM object or file is created;
+* =1 the LCM object or file is open for modifications;
+* =2 the LCM object or file is open in read-only mode.
+* KENTRY LCM object address or file unit number.
+*
+*-----------------------------------------------------------------------
+*
+ USE GANLIB
+*----
+* SUBROUTINE ARGUMENTS
+*----
+ INTEGER NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
+ TYPE(C_PTR) KENTRY(NENTRY)
+ CHARACTER HENTRY(NENTRY)*12
+*----
+* LOCAL VARIABLES
+*----
+ PARAMETER (NSTATE=40)
+ CHARACTER HSMG*131,TEXT12*12,CDOOR*12,HSIGN*12
+ INTEGER IPAR(NSTATE),IGP(NSTATE)
+ INTEGER ITYPE,ITIXS,IFLMAC,IYLMIX,IEXTR,IGLOB,ISAT,IDIRAC,ISAVE,
+ 1 ISET,INR
+ REAL RPAR(5),XT(5)
+ LOGICAL LOG,LMACRO
+ TYPE(C_PTR) IPLIB,IPFLUX,JPFLUX,IPDEPL,IPTRK,IPPOW,IPMACR,JPMACR,
+ 1 KPMACR
+ INTEGER, ALLOCATABLE, DIMENSION(:) :: JMIX,MIXBRN,MIXPWR,IEVOL,
+ 1 ISTYP,ISONA,ISONR,MAT,IDL
+ REAL, ALLOCATABLE, DIMENSION(:) :: JDEN,TIMES,VX,FLMIX,VOL,FUNKN,
+ 1 FLUXE
+ INTEGER, ALLOCATABLE, DIMENSION(:,:) :: FMIX
+ REAL, ALLOCATABLE, DIMENSION(:,:) :: VMAP
+ REAL, ALLOCATABLE, DIMENSION(:,:,:) :: FMAP
+*----
+* PARAMETER VALIDATION
+*----
+ IF(NENTRY.LE.1) CALL XABORT('EVO: TWO PARAMETERS EXPECTED.')
+ IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2)) CALL XABORT('EVO: LCM O'
+ 1 //'BJECT EXPECTED AT FIRST LHS.')
+ IF(JENTRY(1).EQ.2) CALL XABORT('EVO: BURNUP HISTORY STORAGE IN CR'
+ 1 //'EATION OR MODIFICATION MODE EXPECTED.')
+ IPDEPL=KENTRY(1)
+ IF((IENTRY(2).NE.1).AND.(IENTRY(2).NE.2)) CALL XABORT('EVO: LCM O'
+ 1 //'BJECT EXPECTED AT SECOND LHS.')
+ IENT=1
+ IF(JENTRY(2).EQ.0) THEN
+* INTERNAL LIBRARY CREATION. COPY THE FIRST RHS ON THIS LHS.
+ IF(NENTRY.LE.3) CALL XABORT('EVO: FOUR PARAMETERS EXPECTED.')
+ IF((JENTRY(3).NE.2).OR.((IENTRY(3).NE.1).AND.
+ 1 (IENTRY(3).NE.2))) CALL XABORT('EVO: LCM OBJECT IN READ-ONLY '
+ 2 //'MODE EXPECTED AT FIRST RHS.')
+ CALL LCMEQU(KENTRY(3),KENTRY(2))
+ IENT=4
+ ELSE IF(JENTRY(2).EQ.1) THEN
+* INTERNAL LIBRARY MODIFICATION.
+ IENT=3
+ ELSE
+ CALL XABORT('EVO: INTERNAL LIBRARY IN CREATE OR MODIFICATION M'
+ 1 //'ODE EXPECTED.')
+ ENDIF
+ IPLIB=KENTRY(2)
+ TEXT12=HENTRY(2)
+ CALL LCMPTC(IPDEPL,'LINK.LIB',12,TEXT12)
+*----
+* RECOVER IPTRK AND IPFLUX POINTERS
+*----
+ IPFLUX=C_NULL_PTR
+ IPTRK=C_NULL_PTR
+ IPPOW=C_NULL_PTR
+ DO 10 I=IENT,NENTRY
+ IF((JENTRY(I).EQ.2).AND.((IENTRY(I).EQ.1).OR.(IENTRY(I).EQ.2)))
+ 1 THEN
+ CALL LCMGTC(KENTRY(I),'SIGNATURE',12,HSIGN)
+ IF(HSIGN.EQ.'L_FLUX') THEN
+ IPFLUX=KENTRY(I)
+ ELSE IF(HSIGN.EQ.'L_TRACK') THEN
+ IPTRK=KENTRY(I)
+ ELSE IF(HSIGN.EQ.'L_POWER') THEN
+ IPPOW=KENTRY(I)
+ ELSE
+ WRITE(HSMG,'(35HEVO: UNEXPECTED SIGNATURE AT RHS ('',A12,
+ 1 3H'').)') HSIGN
+ CALL XABORT(HSMG)
+ ENDIF
+ ELSE
+ CALL XABORT('EVO: LCM OBJECT IN READ-ONLY MODE EXPECTED AT '
+ 1 //'RHS.')
+ ENDIF
+ 10 CONTINUE
+ IF((C_ASSOCIATED(IPFLUX)).AND.(.NOT.C_ASSOCIATED(IPTRK))) THEN
+ CALL XABORT('EVO: UNABLE TO FIND A POINTER TO A L_TRACK OBJEC'
+ 1 //'T.')
+ ENDIF
+*----
+* RECOVER GENERAL INTERNAL LIBRARY INFORMATION
+*----
+ CALL LCMGTC(IPLIB,'SIGNATURE',12,HSIGN)
+ IF(HSIGN.NE.'L_LIBRARY') THEN
+ TEXT12=HENTRY(2)
+ CALL XABORT('EVO: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
+ 1 '. L_LIBRARY EXPECTED.')
+ ENDIF
+ CALL LCMGET(IPLIB,'STATE-VECTOR',IPAR)
+ NBMIX=IPAR(1)
+ NBISO=IPAR(2)
+ NGRO=IPAR(3)
+ NDEPL=IPAR(11)
+ NCOMB=IPAR(12)
+ LMACRO=(IPAR(17).GE.0).AND.(IPAR(18).EQ.1)
+ NDFI=IPAR(20)
+ CALL LCMLEN(IPLIB,'DEPL-CHAIN',ILONG,ITYLCM)
+ IF(ILONG.EQ.0) THEN
+ WRITE(HSMG,'(47HEVO: NO DEPL-CHAIN DIRECTORY IN MICROLIB NAMED ,
+ 1 A,2H .)') TRIM(HENTRY(2))
+ CALL XABORT(HSMG)
+ ENDIF
+ CALL LCMSIX(IPLIB,'DEPL-CHAIN',1)
+ CALL LCMGET(IPLIB,'STATE-VECTOR',IPAR)
+ IF(IPAR(1).NE.NDEPL) THEN
+ WRITE(HSMG,'(43HEVO: INVALID NUMBER OF DEPLETING ISOTOPES (,
+ 1 14HON DEPL-CHAIN=,I6,13H ON MICROLIB=,I6,2H).)') IPAR(1),
+ 1 NDEPL
+ CALL XABORT(HSMG)
+ ENDIF
+ NSUPS=IPAR(7)
+ NREAC=IPAR(8)
+ CALL LCMSIX(IPLIB,' ',2)
+ ALLOCATE(JMIX(NBISO),IEVOL(NBISO),ISTYP(NBISO),MIXBRN(NBMIX),
+ 1 MIXPWR(NBMIX),ISONA(3*NBISO),ISONR(3*NBISO))
+ ALLOCATE(JDEN(NBISO))
+ CALL LCMGET(IPLIB,'ISOTOPESMIX',JMIX)
+ CALL LCMGET(IPLIB,'ISOTOPESDENS',JDEN)
+ CALL LCMGET(IPLIB,'ISOTOPESTODO',IEVOL)
+ CALL LCMGET(IPLIB,'ISOTOPESTYPE',ISTYP)
+*----
+* RECOVER LOCAL ISOTOPES NAMES
+*----
+ CALL LCMGET(IPLIB,'ISOTOPESUSED',ISONA)
+ CALL LCMGET(IPLIB,'ISOTOPERNAME',ISONR)
+*----
+* READ THE INPUT DATA
+*----
+* DEFAULT OPTIONS:
+ IMPX=1
+ IDEPL=0
+ INR=-1
+ XT(4)=0.0
+ IF(JENTRY(1).EQ.0) THEN
+ INDREC=1
+ RPAR(1)=1.0E-5
+ RPAR(2)=1.0E-4
+ RPAR(3)=80.0
+ RPAR(4)=1.0E-4
+ RPAR(5)=0.0
+ ITYPE=2
+ IEXTR=1
+ IGLOB=0
+ ISAT=0
+ IDIRAC=0
+ ITIXS=0
+ IFLMAC=0
+ IYLMIX=0
+ HSIGN='L_BURNUP'
+ CALL LCMPTC(IPDEPL,'SIGNATURE',12,HSIGN)
+ CALL LCMPUT(IPDEPL,'ISOTOPESMIX',NBISO,1,JMIX)
+ CALL LCMPUT(IPDEPL,'ISOTOPESUSED',3*NBISO,3,ISONA)
+ MIXBRN(:NBMIX)=1
+ MIXPWR(:NBMIX)=1
+ CALL LCMPUT(IPDEPL,'MIXTURESBurn',NBMIX,1,MIXBRN)
+ CALL LCMPUT(IPDEPL,'MIXTURESPowr',NBMIX,1,MIXPWR)
+ ELSE IF(JENTRY(1).EQ.1) THEN
+ CALL LCMGTC(IPDEPL,'SIGNATURE',12,HSIGN)
+ IF(HSIGN.NE.'L_BURNUP') THEN
+ TEXT12=HENTRY(1)
+ CALL XABORT('LIB: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
+ 1 '. L_BURNUP EXPECTED.')
+ ENDIF
+ INDREC=2
+ CALL LCMGET(IPDEPL,'STATE-VECTOR',IPAR)
+ ITYPE=IPAR(1)
+ NTIME=IPAR(3)
+ IEXTR=IPAR(9)
+ IGLOB=IPAR(10)
+ ISAT=IPAR(11)
+ IDIRAC=IPAR(12)
+ ITIXS=IPAR(13)
+ IFLMAC=IPAR(14)
+ IYLMIX=IPAR(15)
+ IF(IPAR(4).NE.NBISO) CALL XABORT('EVO: INVALID NUMBER OF ISOTO'
+ 1 //'PES.')
+ CALL LCMGET(IPDEPL,'EVOLUTION-R',RPAR)
+ IF(NTIME.GT.0) THEN
+ ALLOCATE(TIMES(NTIME+2))
+ CALL LCMGET(IPDEPL,'DEPL-TIMES',TIMES)
+ XT(4)=TIMES(NTIME)
+ DEALLOCATE(TIMES)
+ ENDIF
+ CALL LCMLEN(IPDEPL,'MIXTURESBurn',ILONG,ITYLCM)
+ IF(ILONG.EQ.NBMIX) THEN
+ CALL LCMGET(IPDEPL,'MIXTURESBurn',MIXBRN)
+ CALL LCMGET(IPDEPL,'MIXTURESPowr',MIXPWR)
+ ELSE
+ MIXBRN(:NBMIX)=1
+ MIXPWR(:NBMIX)=1
+ ENDIF
+ CALL LCMLEN(IPDEPL,'ISOTOPESUSED',ILONG,ITYLCM)
+ IF(ILONG.NE.3*NBISO) CALL XABORT('EVO: INCONSISTENT RECORD IS'
+ 1 //'OTOPESUSED.')
+ ENDIF
+*----
+* READ INPUT OPTIONS
+*----
+ IF(NBMIX.EQ.0) CALL XABORT('EVO: NBMIX NOT YET DEFINED.')
+ CALL EVOGET(IMPX,ITYPE,ITIXS,IEXTR,IGLOB,ISAT,IDIRAC,ISAVE,ISET,
+ > INR,IDEPL,IFLMAC,IYLMIX,RPAR,XT,NBMIX,IPICK,MIXBRN,MIXPWR)
+*
+ XTI=XT(3)
+ XTF=XT(5)
+ EPS1=RPAR(1)
+ EPS2=RPAR(2)
+ EXPMAX=RPAR(3)
+ H1=RPAR(4)
+ FIT=RPAR(5)
+ LOG=(ISAVE.GE.0).OR.(IDEPL.GT.0)
+ IF(LOG.AND.(INR.EQ.-1)) CALL XABORT('EVO: TYPE OF DEPLETION NO'//
+ 1 'T DEFINED.')
+ IF(NDEPL.EQ.0) CALL XABORT('EVO: NO DEPLETING ISOTOPES.')
+ IF(NCOMB.EQ.0) CALL XABORT('EVO: NO DEPLETING MIXTURES.')
+ IF((IYLMIX.EQ.1).AND.(NDFI.EQ.0)) CALL XABORT('EVO: NO ISOTOPI'//
+ 1 'C FISSION YIELD DATA (PYIELD) AVAILABLE.')
+*----
+* RECOVER MIXTURE VOLUMES AND AVERAGE NEUTRON FLUXES
+*----
+ ALLOCATE(VX(NBMIX),FLMIX(NBMIX*NGRO))
+ IF(IFLMAC.EQ.0) THEN
+* RECOVER GENERAL TRACKING INFORMATION
+ IF(.NOT.C_ASSOCIATED(IPTRK)) THEN
+ CALL XABORT('EVO: L_TRACK OBJECT NOT DEFINED.')
+ ENDIF
+ CALL LCMGET(IPTRK,'STATE-VECTOR',IGP)
+ NREG=IGP(1)
+ IF(IGP(4).GT.NBMIX) THEN
+ WRITE(HSMG,'(42HEVO: THE NUMBER OF MIXTURES IN THE TRACKIN,
+ 1 3HG (,I5,46H) IS GREATER THAN THE NUMBER OF MIXTURES IN TH,
+ 2 20HE INTERNAL LIBRARY (,I5,2H).)') IGP(4),NBMIX
+ CALL XABORT(HSMG)
+ ENDIF
+ IF(NREG.EQ.0) CALL XABORT('EVO: NREG = 0')
+ CALL LCMGTC(IPTRK,'TRACK-TYPE',12,CDOOR)
+ IF(CDOOR.EQ.'MCCG') THEN
+ CALL LCMLEN(IPTRK,'KEYFLX',LKFL,ITYLCM)
+ NFUNL=LKFL/NREG
+ ELSE
+ NFUNL=1
+ ENDIF
+ ALLOCATE(MAT(NREG),VOL(NREG),IDL(NREG*NFUNL))
+ CALL LCMGET(IPTRK,'MATCOD',MAT)
+ CALL LCMGET(IPTRK,'VOLUME',VOL)
+ CALL LCMGET(IPTRK,'KEYFLX',IDL)
+*
+* RECOVER MIXTURE VOLUMES FROM L_TRACK
+ VX(:NBMIX)=0.0
+ FLMIX(:NBMIX*NGRO)=0.0
+ DO 20 I=1,NREG
+ IBM=MAT(I)
+ IF(IBM.GT.0) VX(IBM)=VX(IBM)+VOL(I)
+ 20 CONTINUE
+ IF(C_ASSOCIATED(IPFLUX)) THEN
+* RECOVER MIXTURE FLUXES FROM L_FLUX
+ ALLOCATE(FLUXE(NREG*NGRO))
+ JPFLUX=LCMGID(IPFLUX,'FLUX')
+ CALL LCMLEL(JPFLUX,1,ILONG,ITYLCM)
+ ALLOCATE(FUNKN(ILONG))
+ DO 35 IGR=1,NGRO
+ CALL LCMGDL(JPFLUX,IGR,FUNKN)
+ DO 30 I=1,NREG
+ KEYFLX=IDL(I)
+ FLUXE((IGR-1)*NREG+I)=FUNKN(KEYFLX)
+ 30 CONTINUE
+ 35 CONTINUE
+ DEALLOCATE(FUNKN)
+ DO 55 IBM=1,NBMIX
+ DO 50 IGR=1,NGRO
+ FLXMIX=0.0
+ DO 40 I=1,NREG
+ IF(MAT(I).EQ.IBM) THEN
+ VOLTMP=VOL(I)
+ FLXMIX=FLXMIX+FLUXE((IGR-1)*NREG+I)*VOLTMP
+ ENDIF
+ 40 CONTINUE
+ VOLTMP=VX(IBM)
+ IF(VOLTMP.NE.0.0) THEN
+ FLMIX((IBM-1)*NGRO+IGR)=FLXMIX/VOLTMP
+ ENDIF
+ 50 CONTINUE
+ 55 CONTINUE
+ DEALLOCATE(FLUXE)
+ ENDIF
+ DEALLOCATE(IDL,VOL,MAT)
+ ELSE IF(IFLMAC.EQ.1) THEN
+* RECOVER MIXTURE VOLUMES AND FLUXES FROM L_MACROLIB
+ CALL LCMLEN(IPLIB,'MACROLIB',ILONG,ITYLCM)
+ IF(ILONG.EQ.0) CALL XABORT('EVO: NO MACROLIB IN MICROLIB.')
+ IPMACR=LCMGID(IPLIB,'MACROLIB')
+ CALL LCMGET(IPMACR,'STATE-VECTOR',IPAR)
+ IF(IPAR(1).NE.NGRO) CALL XABORT('EVO: INVALID NGRO.')
+ IF(IPAR(2).NE.NBMIX) CALL XABORT('EVO: INVALID NBMIX.')
+ CALL LCMGET(IPMACR,'VOLUME',VX)
+ ALLOCATE(FUNKN(NBMIX))
+ JPMACR=LCMGID(IPMACR,'GROUP')
+ DO 61 IGR=1,NGRO
+ KPMACR=LCMGIL(JPMACR,IGR)
+ CALL LCMGET(KPMACR,'FLUX-INTG',FUNKN)
+ DO 60 IBM=1,NBMIX
+ FLMIX((IBM-1)*NGRO+IGR)=FUNKN(IBM)/VX(IBM)
+ 60 CONTINUE
+ 61 CONTINUE
+ DEALLOCATE(FUNKN)
+ ELSE IF(IFLMAC.EQ.2) THEN
+* RECOVER MIXTURE VOLUMES AND FLUXES FROM L_POWER
+ IF(.NOT.C_ASSOCIATED(IPPOW)) THEN
+ CALL XABORT('EVO: L_POWER OBJECT NOT DEFINED.')
+ ENDIF
+ CALL LCMGET(IPPOW,'STATE-VECTOR',IGP)
+ NCH=IGP(6)
+ NB=IGP(7)
+ IGEO=IGP(8)
+ IF((IGEO.NE.7).AND.(IGEO.NE.9))CALL XABORT('EVO: INVALID GEOM'
+ 1 //'ETRY IN FUEL MAP : ONLY 3-D CARTESIAN OR 3-D HEXAGONAL GEO'
+ 2 //'METRIES AVAILABLE')
+ IF(IGP(1).NE.NGRO)CALL XABORT('EVO: INVALID NUMBER OF ENERGY '
+ 1 //'GROUPS IN L_POWER AND MICROLIB.')
+ ALLOCATE(FMIX(NCH,NB),VMAP(NCH,NB),FMAP(NCH,NB,NGRO))
+ CALL LCMGET(IPPOW,'FLMIX',FMIX)
+ CALL LCMGET(IPPOW,'VOLU-BUND',VMAP)
+ CALL LCMGET(IPPOW,'FLUX-BUND',FMAP)
+ NTOT=0
+ DO 67 JB=1,NB
+ DO 66 ICH=1,NCH
+ IF(FMIX(ICH,JB).EQ.0) GO TO 70
+ NTOT=NTOT+1
+ IF(NTOT.GT.NBMIX) CALL XABORT('EVO: NBMIX OVERFLOW.')
+ VX(NTOT)=VMAP(ICH,JB)
+ DO 65 IGR=1,NGRO
+ FLMIX((NTOT-1)*NGRO+IGR)=FMAP(ICH,JB,IGR)
+ 65 CONTINUE
+ 66 CONTINUE
+ 67 CONTINUE
+ 70 CONTINUE
+ IF(NTOT.NE.NBMIX) CALL XABORT('EVO: ALGORITHM FAILURE.')
+ DEALLOCATE(FMAP,VMAP,FMIX)
+ ELSE
+ CALL XABORT('EVO: INVALID VALUE OF IFLMAC.')
+ ENDIF
+*----
+* COMPUTE EXISTING FLUX NORMALIZATION FACTOR (KEEP OPTION)
+*----
+ IF(INR.EQ.4) THEN
+ VPH=0.0
+ VTOT=0.0
+ DO 80 IBM=1,NBMIX
+ IF(MIXPWR(IBM).EQ.1) THEN
+ VTOT=VTOT+VX(IBM)
+ DO 75 IGR=1,NGRO
+ VPH=VPH+VX(IBM)*FLMIX(NGRO*(IBM-1)+IGR)
+ 75 CONTINUE
+ ENDIF
+ 80 CONTINUE
+ FIT=VPH/VTOT
+ INR=1
+ ENDIF
+*----
+* PERFORM DEPLETION CALCULATION
+*----
+ CALL EVODRV(IPDEPL,IPLIB,INDREC,IMPX,NBISO,NGRO,NBMIX,ISONA,
+ 1 ISONR,JMIX,JDEN,IEVOL,ISTYP,VX,NDEPL,NSUPS,NREAC,NCOMB,EPS1,
+ 2 EPS2,EXPMAX,H1,ITYPE,INR,IEXTR,IGLOB,ISAT,IDIRAC,ITIXS,IFLMAC,
+ 3 IYLMIX,FIT,ISAVE,ISET,IDEPL,XTI,XTF,XT,LMACRO,FLMIX,IPICK,
+ 4 MIXBRN,MIXPWR)
+ CALL LCMPUT(IPLIB,'ISOTOPESDENS',NBISO,2,JDEN)
+*----
+* RELEASE GENERAL INTERNAL LIBRARY INFORMATION
+*----
+ DEALLOCATE(FLMIX,VX)
+ DEALLOCATE(JDEN)
+ DEALLOCATE(ISONR,ISONA,MIXPWR,MIXBRN,ISTYP,IEVOL,JMIX)
+ RETURN
+ END
generated by cgit v1.2.3 (git 2.46.0) at 2026-02-16 13:24:21 +0000