*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