From 7dfcc480ba1e19bd3232349fc733caef94034292 Mon Sep 17 00:00:00 2001 From: stainer_t Date: Mon, 8 Sep 2025 13:48:49 +0200 Subject: Initial commit from Polytechnique Montreal --- Trivac/src/KINRD1.f | 190 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 190 insertions(+) create mode 100755 Trivac/src/KINRD1.f (limited to 'Trivac/src/KINRD1.f') diff --git a/Trivac/src/KINRD1.f b/Trivac/src/KINRD1.f new file mode 100755 index 0000000..4251959 --- /dev/null +++ b/Trivac/src/KINRD1.f @@ -0,0 +1,190 @@ +*DECK KINRD1 + SUBROUTINE KINRD1(NEN,KEN,CMOD,NGR,NBM,NBFIS,NEL,NUN,NDG) +* +*----------------------------------------------------------------------- +* +*Purpose: +* Read and validate the module options from the input file. +* +*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; (6) 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. +* NEL total number of finite elements. +* NUN total number of unknowns per energy group. +* NDG number of delayed-neutron groups (=0 if not in macrolib). +* +*----------------------------------------------------------------------- +* + USE GANLIB +*---- +* SUBROUTINE ARGUMENTS +*---- + INTEGER NEN,NGR,NBM,NBFIS,NEL,NUN,NDG + TYPE(C_PTR) KEN(NEN) + CHARACTER CMOD*12 +*---- +* LOCAL VARIABLES +*---- + PARAMETER(NSTATE=40,IOS=6) + INTEGER ISTATE(NSTATE),MAT(NEL),IDLPC(NEL) + DOUBLE PRECISION DFLOT + CHARACTER TEXT*12 + LOGICAL LNUD,LCHD,LLAD,LPRIMA + REAL, DIMENSION(:), ALLOCATABLE :: DNF,PD + REAL, DIMENSION(:,:), ALLOCATABLE :: DNS +*---- +* READ THE INPUT DATA +*---- + IMPX=1 + LNUD=.FALSE. + LCHD=.FALSE. + LLAD=.FALSE. + INORM=0 + FNORM=1.0 + POWER=0.0 + IELEM=-1 + NLF=-1 + LPRIMA=.FALSE. + 10 CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT) + IF(ITYP.NE.3)CALL XABORT('@KINRD1: CHARACTER DATA EXPECTED(1).') + IF(TEXT.EQ.';')THEN + GOTO 60 + ELSEIF(TEXT.EQ.'EDIT') THEN + CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT) + IF(ITYP.NE.1)CALL XABORT('@KINRD1: INTEGER FOR EDIT EXPECTED.') + IMPX=MAX(0,NITMA) + IF(IMPX.GT.9)WRITE(IOS,1001) + ELSEIF(TEXT.EQ.'NGRP') THEN + CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT) + IF(ITYP.NE.1)CALL XABORT('@KINRD1: INTEGER FOR NGRP EXPECTED.') + IF(NGR.NE.NITMA)CALL XABORT('@KINRD1: INVALID INPUT FOR NGRP.') + ELSEIF(TEXT.EQ.'NDEL') THEN + CALL REDGET(ITYP,NDG,FLOT,TEXT,DFLOT) + IF(ITYP.NE.1)CALL XABORT('@KINRD1: INTEGER FOR NDEL EXPECTED.') + ELSEIF(TEXT.EQ.'BETA')THEN + LNUD=.TRUE. + ALLOCATE(DNF(NDG)) + DO 20 IDG=1,NDG + CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT) + IF(ITYP.NE.2)CALL XABORT('@KINRD1: REAL DATA EXPECTED(1).') + IF(FLOT.LE.0.)CALL XABORT('@KINRD1: INVALID BETA VALUE.') + DNF(IDG)=FLOT + 20 CONTINUE + ELSEIF(TEXT.EQ.'LAMBDA')THEN + LLAD=.TRUE. + ALLOCATE(PD(NDG)) + DO 30 IDG=1,NDG + CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT) + IF(ITYP.NE.2)CALL XABORT('@KINRD1: REAL DATA EXPECTED(2).') + IF(FLOT.LE.0.)CALL XABORT('@KINRD1: INVALID LAMBDA VALUE.') + PD(IDG)=FLOT + 30 CONTINUE + ELSEIF(TEXT.EQ.'CHID')THEN + LCHD=.TRUE. + ALLOCATE(DNS(NDG,NGR)) + DO 55 JGR=1,NGR + DO 50 IDG=1,NDG + CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT) + IF(ITYP.NE.2)CALL XABORT('@KINRD1: REAL DATA EXPECTED(3).') + DNS(IDG,JGR)=FLOT + 50 CONTINUE + 55 CONTINUE + ELSEIF(TEXT.EQ.'NORM')THEN + CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT) + IF(ITYP.EQ.2) THEN + INORM=1 + FNORM=FLOT + ELSE IF((ITYP.EQ.3).AND.(TEXT.EQ.'MAX')) THEN + INORM=2 + FNORM=0.0 + ELSE IF((ITYP.EQ.3).AND.(TEXT.EQ.'POWER-INI')) THEN + INORM=3 + FNORM=0.0 + CALL REDGET(ITYP,NITMA,POWER,TEXT,DFLOT) + IF(ITYP.NE.2)CALL XABORT('@KINRD1: REAL FOR POWER EXPECTED.') + IF(POWER.LT.0.)CALL XABORT('@KINRD1: INVALID POWER VALUE.') + ELSE + CALL XABORT('@KINRD1: ''MAX'', ''POWER-INI'' OR REAL DATA EX' + 1 //'PECTED') + ENDIF + ELSE + CALL XABORT('@KINRD1: INVALID KEYWORD '//TEXT//'.') + ENDIF + GO TO 10 + 60 IF(NEN.NE.5)CALL XABORT('@KINRD1: INVALID NUMBER' + 1 //' OF MODULE PARAMETERS.') + IF(IMPX.GT.9)WRITE(IOS,1002) +*---- +* RECOVER DELAYED NEUTRON DATA FROM MICROLIB +*---- + IF(.NOT.LNUD) THEN + ALLOCATE(DNF(NDG)) + CALL LCMLEN(KEN(2),'BETA-D',LEN,ITLCM) + IF(LEN.GT.0) CALL LCMGET(KEN(2),'BETA-D',DNF) + ENDIF + IF(.NOT.LLAD) THEN + ALLOCATE(PD(NDG)) + CALL LCMLEN(KEN(2),'LAMBDA-D',LEN,ITLCM) + IF(LEN.EQ.0)CALL XABORT('@KINRD1: MISSING DATA FOR THE PRECURS' + 1 //'OR DECAY CONSTANTS.') + CALL LCMGET(KEN(2),'LAMBDA-D',PD) + ENDIF + IF(.NOT.LCHD) ALLOCATE(DNS(NDG,NGR)) +*---- +* RECOVER THE INITIAL STATE +*---- + IF(IMPX.GT.0)WRITE(IOS,1003) + ISTATE(:NSTATE)=0 + CALL LCMGET(KEN(3),'STATE-VECTOR',ISTATE) + LL4=ISTATE(11) + NUP=LL4 + IF(CMOD.EQ.'BIVAC')THEN + IELEM=ISTATE(8) + NLF=ISTATE(14) + LPRIMA=(IELEM.LT.0) + ELSEIF(CMOD.EQ.'TRIVAC')THEN + IELEM=ISTATE(9) + ICHX=ISTATE(12) + NLF=ISTATE(30) + LPRIMA=(ICHX.EQ.1) + IF(ICHX.EQ.2) NUP=ISTATE(25) + ENDIF + IF(LPRIMA) THEN + CALL LCMGET(KEN(3),'MATCOD',MAT) + DO 70 K=1,NEL + IF(MAT(K).EQ.0) THEN + IDLPC(K)=0 + ELSE + NUP=NUP+1 + IDLPC(K)=NUP + ENDIF + 70 CONTINUE + ELSE + CALL LCMGET(KEN(3),'KEYFLX',IDLPC) + ENDIF + IF(IMPX.GT.0) WRITE(IOS,1004) NEL,NUN,NUP,CMOD + IF(LL4*NLF/2.GT.NUN) + 1 CALL XABORT('@KINRD1: INVALID NUMBER OF UNKNOWNS.') + CALL KINST1(NEN,KEN,CMOD,NGR,NBM,NBFIS,NDG,NEL,NUN,LL4,NUP,IDLPC, + 1 INORM,POWER,FNORM,DNF,DNS,PD,LNUD,LCHD,IMPX) + DEALLOCATE(DNS,PD,DNF) + RETURN +* + 1001 FORMAT(/1X,'KINRD1: READING DATA FROM INPUT FILE') + 1002 FORMAT(1X,'KINRD1: THE INPUT DATA HAVE BEEN READ.') + 1003 FORMAT(/1X,'RECOVERING THE INITIAL STEADY-STATE'/) + 1004 FORMAT(1X,'TOTAL NUMBER OF ELEMENTS',1X,I6/1X,'NU', + 1 'MBER OF FLUX UNKNOWNS PER ENERGY GROUP',1X,I6/1X, + 2 'NUMBER OF PRECURSOR UNKNOWNS PER DELAYED GROUP', + 3 1X,I6/1X,'USING TRACKING TYPE:',1X,A6) + END -- cgit v1.2.3