*DECK FLPDRV SUBROUTINE FLPDRV(IPPOW,IPNFX,IPFLX,IPKIN,IPTRK,IPMTX,IPMAP, 1 IPMAC,PTOT,LNEW,LMAP,JMOD,LFLX,LPOW,LRAT,IMPX,FSTH,LFSTH,LFLU, 2 LBUN,LNRM) * *----------------------------------------------------------------------- * *Purpose: * Driver for the powers and fluxes computations. * *Copyright: * Copyright (C) 2007 Ecole Polytechnique de Montreal. * *Author(s): * D. Sekki, M. Guyot * *Parameters: input/output * IPPOW pointer to power information. * IPNFX pointer to normalized flux information. * IPFLX pointer to flux information. * IPKIN pointer to kinetics information. * IPTRK pointer to tracking information. * IPMTX pointer to matex information. * IPMAP pointer to fuel-map information. * IPMAC pointer to macrolib information. * PTOT given total reactor power in mega-watts. * LNEW new total power flag (=.true. for new computation). * LMAP fuel-map printing on file flag (=.true. for print). * JMOD modification index for L_MAP object. * LFLX flux printing on file flag (=.true. for print). * LPOW power printing on file flag (=.true. for print). * LRAT flux-ratio printing on file flag (=.true. for print). * IMPX printing on screen index (=0 for no print). * FSTH thermal to fission power ratio * LFSTH =.true if the thermal fission ratio is specified * LFLU =.true. if an output flux is to be created * LBUN =.true. if the output flux is a flux per bundle * LNRM =.true. if the output flux is a flux per mesh-splitted element * *----------------------------------------------------------------------- * USE GANLIB *---- * SUBROUTINE ARGUMENTS *---- TYPE(C_PTR) IPPOW,IPNFX,IPFLX,IPKIN,IPTRK,IPMTX,IPMAP,IPMAC INTEGER JMOD,IMPX LOGICAL LNEW,LMAP,LFLX,LPOW,LRAT,LFSTH,LFLU,LBUN,LNRM REAL PTOT,FSTH *---- * LOCAL VARIABLES *---- PARAMETER(NSTATE=40) INTEGER ISTATE(NSTATE),IGR,NUN,NGRP,IGEO DOUBLE PRECISION ZNRM,VTOT,POWR CHARACTER HSIGN*12 TYPE(C_PTR) JPMAC,KPMAC,MPFLUX INTEGER, ALLOCATABLE, DIMENSION(:) :: MAT,IDL,FMIX REAL, ALLOCATABLE, DIMENSION(:) :: HFC,VECT,FLUX,VOL,FXYZ,RAT, 1 PXYZ,VMAP,FMAP,POWC,POWB,VECNR *---- * CHECK THE TYPE OF FLUX SELECTED FOR OUTPUT *---- IF(LFLU)THEN IF(LNRM.AND.LBUN) CALL XABORT('@FLPDRV: KEYWORD NORM AND BUND ' 1 //'BOTH SELECTED.') IF((.NOT.LNRM).AND.(.NOT.LBUN)) THEN LNRM=.TRUE. WRITE(6,*) 'FLPDRV: default option for L_FLUX object is NORM.' ENDIF ENDIF *---- * RECOVER INFORMATION *---- ISTATE(:NSTATE)=0 IF(C_ASSOCIATED(IPFLX)) THEN * L_FLUX object CALL LCMGET(IPFLX,'STATE-VECTOR',ISTATE) NGRP=ISTATE(1) NUN=ISTATE(2) CALL LCMGET(IPFLX,'K-EFFECTIVE',FKEFF) ELSE IF(C_ASSOCIATED(IPKIN)) THEN * L_KINET object CALL LCMGET(IPKIN,'STATE-VECTOR',ISTATE) NGRP=ISTATE(3) NUN=ISTATE(6) CALL LCMGET(IPKIN,'E-KEFF',FKEFF) CALL LCMGET(IPKIN,'E-POW',PTOT) ENDIF ISTATE(:NSTATE)=0 CALL LCMGET(IPTRK,'STATE-VECTOR',ISTATE) NEL=ISTATE(1) IF(ISTATE(2).NE.NUN) CALL XABORT('@FLPDRV: INCOMPATIBLE L_TRACK ' 1 //'AND L_FLUX/L_KINET OBJECTS') LX=ISTATE(14) LY=ISTATE(15) LZ=ISTATE(16) *---- * RECOVER H-FACTOR *---- ISTATE(:NSTATE)=0 IF(C_ASSOCIATED(IPMAC))THEN CALL LCMGET(IPMAC,'STATE-VECTOR',ISTATE) IF(ISTATE(1).NE.NGRP)CALL XABORT('@FLPDRV: INVALID NUM' 1 //'BER OF ENERGY GROUPS IN MACROLIB.') NMIX=ISTATE(2) ALLOCATE(HFC(NMIX*NGRP)) JPMAC=LCMGID(IPMAC,'GROUP') DO JGR=1,NGRP KPMAC=LCMGIL(JPMAC,JGR) CALL LCMLEN(KPMAC,'H-FACTOR',LENGT,ITYP) IF(LENGT.NE.NMIX)CALL XABORT('@FLPDRV: UNABLE TO FIND' 1 //' H-FACTOR BLOCK DATA IN THE MACROLIB.') CALL LCMGET(KPMAC,'H-FACTOR',HFC((JGR-1)*NMIX+1)) ENDDO ELSEIF(C_ASSOCIATED(IPMTX))THEN CALL LCMGET(IPMTX,'STATE-VECTOR',ISTATE) IF(ISTATE(1).NE.NGRP)CALL XABORT('@FLPDRV: INVALID NUM' 1 //'BER OF ENERGY GROUPS IN MATEX.') NMIX=ISTATE(2) ALLOCATE(HFC(NMIX*NGRP)) HFC(:NMIX*NGRP)=0.0 CALL LCMGET(IPMTX,'H-FACTOR',HFC) ENDIF *---- * RECOVER FUELMAP AND MATEX INFORMATION *---- IF(C_ASSOCIATED(IPMAP).AND.C_ASSOCIATED(IPMTX))THEN CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE) NB=ISTATE(1) NCH=ISTATE(2) IGEO=ISTATE(12) IF((IGEO.NE.7).AND.(IGEO.NE.9))CALL XABORT('@FLPDRV: INVALID' 1 //' GEOMETRY IN FUEL MAP : ONLY 3-D CARTESIAN OR 3-D HEXAGO' 2 //'NAL GEOMETRIES AVAILABLE') IF(ISTATE(4).NE.NGRP)CALL XABORT('@FLPDRV: INVALID NUM' 1 //'BER OF ENERGY GROUPS IN FUEL MAP OR FLUX.') ISTATE(:NSTATE)=0 CALL LCMGET(IPMTX,'STATE-VECTOR',ISTATE) NMIX=ISTATE(2) NTOT=ISTATE(5) IF(ISTATE(6).NE.IGEO)CALL XABORT('@FLPDRV: GEOMETRIES IN' 1 //' MATEX AND FUEL MAP ARE DIFFERENT') IF(ISTATE(7).NE.NEL)CALL XABORT('@FLPDRV: INVALID TOTAL' 1 //' NUMBER OF REGIONS IN FUEL MAP OR TRACK.') ENDIF *---- * FLUX NORMALIZATION *---- ALLOCATE(VECT(NUN*NGRP),FLUX(NEL*NGRP),MAT(NEL),VOL(NEL),IDL(NEL)) IF(LNEW)THEN * NEW TOTAL REACTOR POWER CALL LCMLEN(IPPOW,'NORM',LENGT,ITYP) IF(LENGT.EQ.0)CALL XABORT('@FLPDRV: UNABLE TO F' 1 //'IND FLUX NORMALIZATION FACTOR IN L_POWER.') CALL LCMGET(IPPOW,'NORM',ZNRM) CALL FLPTOT(IPFLX,IPKIN,IPTRK,NMIX,NGRP,NEL,NUN,VECT,FLUX,MAT, 1 VOL,IDL,HFC,POWR,ZNRM,IMPX) ELSE * GIVEN TOTAL REACTOR POWER POWR=DBLE(PTOT*10**6) IF(PTOT.EQ.0.0)CALL XABORT('@FLPDRV: PTOT IS NOT DEFINED') CALL FLPNRM(IPFLX,IPKIN,IPTRK,NMIX,NGRP,NEL,NUN,VECT,FLUX,MAT, 1 VOL,IDL,HFC,POWR,ZNRM,IMPX) CALL LCMPUT(IPPOW,'NORM',1,4,ZNRM) ENDIF DEALLOCATE(IDL) CALL LCMPUT(IPPOW,'FLUX',NEL*NGRP,2,FLUX) POWR=POWR/(10**6) CALL LCMPUT(IPPOW,'PTOT',1,4,POWR) *---- * WHOLE REACTOR *---- ALLOCATE(FXYZ(NEL*NGRP),RAT(NEL*(NGRP-1))) * FLUX DISTRIBUTION IF(IGEO.EQ.7) THEN CALL FLPFLX(NGRP,NEL,LX,LY,LZ,MAT,VOL,FLUX,FXYZ,RAT,VTOT,IMPX, 1 LFLX,LRAT) ELSEIF(IGEO.EQ.9) THEN CALL FLPHFX(NGRP,NEL,LX,LZ,MAT,VOL,FLUX,FXYZ,RAT,VTOT,IMPX, 1 LFLX,LRAT) ENDIF CALL LCMPUT(IPPOW,'VTOT',1,4,VTOT) CALL LCMPUT(IPPOW,'FLUX-DISTR',NEL*NGRP,2,FXYZ) IF(NGRP.GT.1) CALL LCMPUT(IPPOW,'FLUX-RATIO',NEL*(NGRP-1),2,RAT) DEALLOCATE(RAT,FXYZ) * POWER DISTRIBUTION ALLOCATE(PXYZ(NEL)) IF(IGEO.EQ.7) THEN CALL FLPOWR(NMIX,NGRP,NEL,LX,LY,LZ,MAT,VOL,FLUX,HFC,PXYZ,VTOT, 1 IMPX,LPOW) ELSEIF(IGEO.EQ.9) THEN CALL FLPHPW(NMIX,NGRP,NEL,LX,LZ,MAT,VOL,FLUX,HFC,PXYZ,VTOT, 1 IMPX,LPOW) ENDIF CALL LCMPUT(IPPOW,'POWER-DISTR',NEL,2,PXYZ) DEALLOCATE(PXYZ) CALL LCMPUT(IPPOW,'K-EFFECTIVE',1,2,FKEFF) *---- * FUEL-MAP *---- IF((C_ASSOCIATED(IPMAP)).AND.(C_ASSOCIATED(IPMTX))) THEN ALLOCATE(FMIX(NCH*NB),VMAP(NCH*NB),FMAP(NCH*NB*NGRP)) CALL LCMGET(IPMAP,'FLMIX',FMIX) * COMPUTE FLUXES CALL FLPFLB(IPMTX,NTOT,NGRP,NEL,NCH,NB,FLUX,VOL,FMIX,VMAP,FMAP, 1 IMPX,LMAP) ALLOCATE(POWC(NCH),POWB(NCH*NB)) * COMPUTE POWERS CALL FLPOWB(IPPOW,IPMAP,IPMTX,NMIX,NTOT,NGRP,NCH,NB,NEL,MAT, 1 VOL,HFC,FLUX,POWB,POWC,IMPX,POWR,FSTH,LFSTH,FMIX,FMAP,IGEO) CALL LCMPUT(IPPOW,'POWER-CHAN',NCH,2,POWC) CALL LCMPUT(IPPOW,'POWER-BUND',NCH*NB,2,POWB) CALL LCMPUT(IPPOW,'FLUX',NEL*NGRP,2,FLUX) CALL LCMPUT(IPPOW,'VOLU-BUND',NCH*NB,2,VMAP) CALL LCMPUT(IPPOW,'FLUX-BUND',NCH*NB*NGRP,2,FMAP) CALL LCMPUT(IPPOW,'FLMIX',NCH*NB,1,FMIX) IF(JMOD.GE.1) THEN CALL LCMPUT(IPMAP,'TOT-PW',1,2,PTOT) CALL LCMPUT(IPMAP,'BUND-PW',NCH*NB,2,POWB) CALL LCMPUT(IPMAP,'FLUX-AV',NCH*NB*NGRP,2,FMAP) IF(JMOD.EQ.2) THEN CALL LCMPUT(IPMAP,'BUND-PW-INI',NCH*NB,2,POWB) ENDIF PTOT=0.0 DO I=1,NCH*NB PTOT=PTOT+POWB(I) ENDDO PTOT=PTOT/1.0E3 CALL LCMPUT(IPMAP,'REACTOR-PW',1,2,PTOT) ENDIF DEALLOCATE(POWB,POWC) ENDIF DEALLOCATE(VOL,MAT,FLUX,HFC) IF(LFLU) THEN *---- * STATE-VECTOR FOR L_FLUX OBJECT *---- IF(LNRM) THEN ISTATE(:NSTATE)=0 IF(C_ASSOCIATED(IPFLX)) THEN CALL LCMGET(IPFLX,'STATE-VECTOR',ISTATE) ELSE IF(C_ASSOCIATED(IPKIN)) THEN ISTATE(1)=NGRP ISTATE(2)=NUN ENDIF CALL LCMPUT(IPNFX,'STATE-VECTOR',NSTATE,1,ISTATE) HSIGN='L_FLUX' CALL LCMPTC(IPNFX,'SIGNATURE',12,HSIGN) ALLOCATE(VECNR(NUN*NGRP)) DO 10 I=1,NUN*NGRP VECNR(I)=VECT(I)*REAL(ZNRM) 10 CONTINUE MPFLUX=LCMLID(IPNFX,'FLUX',NGRP) DO 20 IGR=1,NGRP IOFSET=(IGR-1)*NUN CALL LCMPDL(MPFLUX,IGR,NUN,2,VECNR(IOFSET+1)) 20 CONTINUE DEALLOCATE(VECNR) ELSE MPFLUX=LCMLID(IPNFX,'FLUX',NGRP) DO 30 IGR=1,NGRP IOFSET=(IGR-1)*NB*NCH CALL LCMPDL(MPFLUX,IGR,NB*NCH,2,FMAP(IOFSET+1)) 30 CONTINUE ENDIF ENDIF IF(C_ASSOCIATED(IPMAP)) DEALLOCATE(VMAP,FMAP,FMIX) DEALLOCATE(VECT) *---- * STATE-VECTOR FOR L_FLUX OBJECT *---- IF(LFLU) THEN ISTATE(:NSTATE)=0 IF(C_ASSOCIATED(IPFLX)) THEN CALL LCMGET(IPFLX,'STATE-VECTOR',ISTATE) ELSE IF(C_ASSOCIATED(IPKIN)) THEN ISTATE(1)=NGRP ISTATE(2)=NUN ENDIF IF(LBUN) ISTATE(2)=NB*NCH CALL LCMPUT(IPNFX,'STATE-VECTOR',NSTATE,1,ISTATE) HSIGN='L_FLUX' CALL LCMPTC(IPNFX,'SIGNATURE',12,HSIGN) ENDIF *---- * STATE-VECTOR FOR L_POWER OBJECT *---- ISTATE(:NSTATE)=0 ISTATE(1)=NGRP ISTATE(2)=NEL ISTATE(3)=LX ISTATE(4)=LY ISTATE(5)=LZ ISTATE(6)=NCH ISTATE(7)=NB ISTATE(8)=IGEO CALL LCMPUT(IPPOW,'STATE-VECTOR',NSTATE,1,ISTATE) HSIGN='L_POWER' CALL LCMPTC(IPPOW,'SIGNATURE',12,HSIGN) IF(IMPX.GT.1)CALL LCMLIB(IPPOW) RETURN END