summaryrefslogtreecommitdiff
path: root/Trivac/src/KINST1.f
diff options
context:
space:
mode:
Diffstat (limited to 'Trivac/src/KINST1.f')
-rwxr-xr-xTrivac/src/KINST1.f283
1 files changed, 283 insertions, 0 deletions
diff --git a/Trivac/src/KINST1.f b/Trivac/src/KINST1.f
new file mode 100755
index 0000000..fb3f68e
--- /dev/null
+++ b/Trivac/src/KINST1.f
@@ -0,0 +1,283 @@
+*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
generated by cgit v1.2.3 (git 2.46.0) at 2026-02-16 23:13:53 +0000