Initial commit from Polytechnique Montreal

1 files changed, 190 insertions, 0 deletions

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