*DECK KINST1 SUBROUTINE KINST1(NEN,KEN,CMOD,NGR,NBM,NBFIS,NDG,NEL,NUN,LL4,NUP, 1 IDLPC,INORM,POWER,FNORM,DNF,DNS,PDC,LNUD,LCHD,IMPX) * *----------------------------------------------------------------------- * *Purpose: * Recover the initial steady-state solution. * *Copyright: * Copyright (C) 2008 Ecole Polytechnique de Montreal. * *Author(s): D. Sekki * *Parameters: input/output * NEN number of LCM objects used in the module. * KEN addresses of LCM objects: (1) L_KINET; (2) L_MACROLIB; * (3) L_TRACK; (4) L_SYSTEM; (5) L_FLUX. * CMOD name of the assembly door (BIVAC or TRIVAC). * NGR number of energy groups. * NBM number of material mixtures. * NBFIS number of fissile isotopes. * NDG number of delayed-neutron groups. * NEL total number of finite elements. * NUN total number of unknowns per energy group. * LL4 order of system matrices. * NUP total number of precursor unknowns per precursor group. * IDLPC position of averaged precursor values in unknown vector. * INORM type of flux normalization (=0: no normalization; =1: imposed * factor; =2: maximum flux; =3 initial power). * POWER initial power (MW). * FNORM normalization factor for the flux. * DNF delayed neutron fractions. * DNS delayed neutron spectrum (from input). * PDC precursor decay constants. * LNUD flag: =.true. if DNF provided from module input. * LCHD flag: =.true. if DNS provided from module input. * IMPX printing parameter (=0 for no print). * *----------------------------------------------------------------------- * USE GANLIB *---- * SUBROUTINE ARGUMENTS *---- TYPE(C_PTR) KEN(NEN) INTEGER NEN,NGR,NBM,NBFIS,NDG,NEL,NUN,LL4,NUP,IDLPC(NEL),INORM CHARACTER CMOD*12 REAL POWER,FNORM,DNS(NDG,NGR),PDC(NDG),DNF(NDG) LOGICAL LNUD,LCHD *---- * LOCAL VARIABLES *---- PARAMETER(NSTATE=40,IOS=6,ITR=0) INTEGER ISTATE(NSTATE),MAT(NEL),IDL(NEL) REAL VOL(NEL),PMAX(NDG,NBFIS) TYPE(C_PTR) JPFLX REAL, DIMENSION(:), ALLOCATABLE :: GAR,RM REAL, DIMENSION(:,:), ALLOCATABLE :: EVECT,OVR REAL, DIMENSION(:,:,:), ALLOCATABLE :: PC,CHI,SGF REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: SGD,CHD *---- * SCRATCH STORAGE ALLOCATION *---- ALLOCATE(EVECT(NUN,NGR),PC(NUP,NDG,NBFIS),SGD(NBM,NBFIS,NGR,NDG)) *---- * RECOVER THE TYPE OF ASSEMBLY *---- ISTATE(:NSTATE)=0 CALL LCMGET(KEN(4),'STATE-VECTOR',ISTATE) ITY=ISTATE(4) *---- * RECOVER THE INITIAL FLUX UNKNOWN VECTOR *---- CALL LCMGET(KEN(3),'MATCOD',MAT) CALL LCMGET(KEN(3),'VOLUME',VOL) CALL LCMGET(KEN(3),'KEYFLX',IDL) ISTATE(:NSTATE)=0 CALL LCMGET(KEN(3),'STATE-VECTOR',ISTATE) IGM=ISTATE(6) IF(IMPX.GT.1) WRITE(IOS,1001) NUN EVECT(:NUN,:NGR)=0.0 CALL LCMGET(KEN(5),'K-EFFECTIVE',FKEFF) JPFLX=LCMGID(KEN(5),'FLUX') DO 10 IGR=1,NGR CALL LCMGDL(JPFLX,IGR,EVECT(1,IGR)) 10 CONTINUE *---- * FIND THE MAXIMUM FLUX VALUE *---- FMAX=0.0 IDMX=0 DO 25 IGR=1,NGR DO 20 IEL=1,NEL IND=IDL(IEL) IF(IND.EQ.0) GO TO 20 IF(ABS(EVECT(IND,IGR)).GT.FMAX) THEN FMAX=EVECT(IND,IGR) IDMX=IEL IGMX=IGR ENDIF 20 CONTINUE 25 CONTINUE IF(IDMX.EQ.0) CALL XABORT('KINST1: UNABLE TO SET FMAX.') *---- * NORMALIZE THE FLUX *---- IF(INORM.EQ.2) THEN FNORM=1.0/FMAX ELSE IF(INORM.EQ.3) THEN CALL KINPOW(KEN(2),NGR,NBM,NUN,NEL,MAT,VOL,IDL,EVECT,POWTOT) IF(POWTOT.EQ.0.0) CALL XABORT('KINST1: H-FACTOR NOT DEFINED IN' 1 //' MACROLIB.') FNORM=POWER/POWTOT CALL LCMPUT(KEN(1),'POWER-INI',1,2,POWER) CALL LCMPUT(KEN(1),'E-POW',1,2,POWER) IF(IMPX.GT.0) WRITE(6,*) 'INITIAL REACTOR POWER (MW) =',POWER ENDIF DO 35 IGR=1,NGR DO 30 IND=1,NUN EVECT(IND,IGR)=EVECT(IND,IGR)*FNORM 30 CONTINUE 35 CONTINUE FMAX=FMAX*FNORM IF(IMPX.GE.5)THEN DO 40 IGR=1,NGR WRITE(IOS,1003) IGR,(EVECT(I,IGR),I=1,NUN) 40 CONTINUE ENDIF *---- * RECOVER CROSS SECTIONS *---- ALLOCATE(OVR(NBM,NGR),CHI(NBM,NBFIS,NGR),CHD(NBM,NBFIS,NGR,NDG), 1 SGF(NBM,NBFIS,NGR)) DT=1.0 CALL KINXSD(KEN(2),NGR,NBM,NBFIS,NDG,FKEFF,DT,DNF,DNS,LNUD,LCHD, 1 OVR,CHI,CHD,SGF,SGD) DEALLOCATE(SGF,CHD,CHI,OVR) *---- * INITIAL PRECURSOR UNKNOWN VECTOR *---- PC(:NUP,:NDG,:NBFIS)=0.0 IF(IMPX.GT.1)WRITE(IOS,1005) ALLOCATE(GAR(NUN)) DO 95 IFIS=1,NBFIS DO 90 IDG=1,NDG IF(CMOD.EQ.'BIVAC')THEN DO 55 IGR=1,NGR CALL KINBLM(KEN(3),NBM,NUP,SGD(1,IFIS,IGR,IDG),EVECT(1,IGR), 1 GAR) DO 50 IND=1,NUP PC(IND,IDG,IFIS)=PC(IND,IDG,IFIS)+GAR(IND) 50 CONTINUE 55 CONTINUE CALL MTLDLS('RM',KEN(3),KEN(4),LL4,1,PC(1,IDG,IFIS)) ELSEIF(CMOD.EQ.'TRIVAC')THEN DO 65 IGR=1,NGR CALL KINTLM(KEN(3),NBM,NUP,SGD(1,IFIS,IGR,IDG),EVECT(1,IGR), 1 GAR) DO 60 IND=1,NUP PC(IND,IDG,IFIS)=PC(IND,IDG,IFIS)+GAR(IND) 60 CONTINUE 65 CONTINUE CALL LCMLEN(KEN(4),'RM',ILONG,ITYLCM) IF(IMPX.GT.2) CALL LCMLIB(KEN(4)) ALLOCATE(RM(ILONG)) CALL LCMGET(KEN(4),'RM',RM) DO 70 IND=1,ILONG FACT=RM(IND) IF(FACT.EQ.0.0) CALL XABORT('KINST1: SINGULAR RM.') PC(IND,IDG,IFIS)=PC(IND,IDG,IFIS)/FACT 70 CONTINUE DEALLOCATE(RM) ENDIF DO 80 IND=1,NUP PC(IND,IDG,IFIS)=PC(IND,IDG,IFIS)/PDC(IDG) 80 CONTINUE IF(CMOD.EQ.'BIVAC')THEN CALL FLDBIV(KEN(3),NEL,NUP,PC(1,IDG,IFIS),MAT,VOL,IDLPC) ELSEIF(CMOD.EQ.'TRIVAC')THEN CALL FLDTRI(KEN(3),NEL,NUP,PC(1,IDG,IFIS),MAT,VOL,IDLPC) ENDIF 90 CONTINUE 95 CONTINUE DEALLOCATE(GAR) IF(IMPX.GT.5) THEN WRITE(IOS,1006) DO 105 IFIS=1,NBFIS DO 100 IDG=1,NDG WRITE(IOS,1007) IDG,IFIS,(PC(IND,IDG,IFIS),IND=1,LL4) 100 CONTINUE 105 CONTINUE ENDIF *---- * FIND THE PRECURSOR CORRESPONDING TO MAXIMUM FLUX *---- IND=IDLPC(IDMX) IF(IND.EQ.0) CALL XABORT('KINST1: UNABLE TO SET PMAX.') DO 115 IFIS=1,NBFIS DO 110 IDG=1,NDG PMAX(IDG,IFIS)=PC(IND,IDG,IFIS) 110 CONTINUE 115 CONTINUE IF(IMPX.GT.0) WRITE(IOS,1002) FMAX,IDMX,IGMX *---- * PRINT AVERAGED PRECURSOR VALUES *---- IF(IMPX.GT.1) THEN DO 130 IFIS=1,NBFIS WRITE(IOS,1008) IFIS,(IDG,IDG=1,NDG) DO 120 IEL=1,NEL IND=IDLPC(IEL) WRITE(IOS,1009) IEL,(PC(IND,IDG,IFIS),IDG=1,NDG) 120 CONTINUE WRITE(IOS,'(/)') 130 CONTINUE ENDIF *---- * L_KINET STATE-VECTOR *---- ISTATE(:NSTATE)=0 ISTATE(1)=ITR ISTATE(2)=NDG ISTATE(3)=NGR ISTATE(4)=IGM ISTATE(5)=NEL ISTATE(6)=NUN ISTATE(7)=LL4 ISTATE(8)=NUP ISTATE(9)=NBFIS ISTATE(10)=ITY ISTATE(13)=INORM CALL LCMPUT(KEN(1),'STATE-VECTOR',NSTATE,1,ISTATE) CALL LCMPUT(KEN(1),'E-IDLPC',NEL,1,IDLPC) CALL LCMPUT(KEN(1),'E-VECTOR',NUN*NGR,2,EVECT) CALL LCMPUT(KEN(1),'E-PREC',NUP*NDG*NBFIS,2,PC) CALL LCMPUT(KEN(1),'E-KEFF',1,2,FKEFF) CALL LCMPUT(KEN(1),'LAMBDA-D',NDG,2,PDC) IF(LNUD) CALL LCMPUT(KEN(1),'BETA-D',NDG,2,DNF) IF(LCHD) CALL LCMPUT(KEN(1),'CHI-D',NDG*NGR,2,DNS) CALL LCMPUT(KEN(1),'CTRL-FLUX',1,2,FMAX) CALL LCMPUT(KEN(1),'CTRL-PREC',NDG*NBFIS,2,PMAX) CALL LCMPUT(KEN(1),'CTRL-IDL',1,1,IDMX) CALL LCMPUT(KEN(1),'CTRL-IGR',1,1,IGMX) IF(IMPX.GT.2) CALL LCMLIB(KEN(1)) IF(IMPX.GE.1) WRITE (IOS,1010) IMPX,(ISTATE(I),I=1,10),ISTATE(13) *---- * SCRATCH STORAGE DEALLOCATION *---- DEALLOCATE(SGD,PC,EVECT) RETURN * 1001 FORMAT(1X,'RECOVERING THE INITIAL UNKNOWN VECTOR', 1 1X,'FOR FLUXES'/1X,'TOTAL NUMBER OF UNKNOWNS PE', 2 'R',1X,'ENERGY GROUP',1X,I6/) 1002 FORMAT(/1X,'CONTROLLING PARAMETERS:',2X,'MAX-VA', 1 'L',1X,1PE12.5,3X,'IDL #',I5.5,3X,'IGR #',I2.2/) 1003 FORMAT(/1X,'=> INITIAL UNKNOWN FLUX VECTOR CORR', 1 'ESPONDING TO THE GROUP #',I2.2//(1P,8E14.5,5X)) 1005 FORMAT(/1X,'COMPUTING THE INITIAL UNKNOWN VECTOR', 1 1X,'FOR PRECURSORS'/) 1006 FORMAT(/1X,'=> INITIAL PRECURSOR UNKNOWN VECTOR') 1007 FORMAT(/17H PRECURSOR GROUP=,I5,18H FISSILE ISOTOPE=,I5/ 1 (1P,8E14.5)) 1008 FORMAT(/52H KINST1: AVERAGED PRECURSOR VALUES (FISSILE ISOTOPE=, 1 I5,1H)/(9X,6I13,:)) 1009 FORMAT(1X,I6,2X,1P,6E13.5,:/(9X,6E13.5,:)) 1010 FORMAT(/8H OPTIONS/8H -------/ 1 7H IMPX ,I6,30H (0=NO PRINT/1=SHORT/2=MORE)/ 2 7H ITR ,I6,28H (CURRENT TIME SPEP INDEX)/ 3 7H NDG ,I6,39H (NUMBER OF PRECURSOR DELAYED GROUPS)/ 4 7H NGR ,I6,28H (NUMBER OF ENERGY GROUPS)/ 5 7H IGM ,I6,21H (TYPE OF GEOMETRY)/ 6 7H NEL ,I6,30H (NUMBER OF FINITE ELEMENTS)/ 7 7H NUN ,I6,46H (TOTAL NUMBER OF UNKNOWNS PER ENERGY GROUP)/ 8 7H LL4 ,I6,45H (NUMBER OF FLUX UNKNOWNS PER ENERGY GROUP)/ 9 7H NUP ,I6,47H (NUMBER OF PRECURSORS UNKNOWNS PER DELAYED G, 1 5HROUP)/ 2 7H NBFIS ,I6,31H (NUMBER OF FISSILE ISOTOPES)/ 3 7H ITY ,I6,28H (TYPE OF SYSTEM MATRICES)/ 4 7H INORM ,I6,47H (0=NO FLUX NORMALIZATION/1=FIXED/2=MAXIMUM/3, 5 7H=POWER)) END