summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHEBERT Alain <alain.hebert@polymtl.ca>2025-12-28 15:55:41 -0500
committerHEBERT Alain <alain.hebert@polymtl.ca>2025-12-28 15:55:41 -0500
commit754ef58dfd2880f95dd9765d035389f391917492 (patch)
treed7056a5fcb559893c91df8d7533fa5fdb03d8480
parentec64ba52445d2d06deba1216471ccf3d289c78a3 (diff)
parent744b40856a035580b786378cae13d453edd26689 (diff)
Merge branch '19-depreciate-use-of-version-4-and-5-0-draglibs' into 'main'
Resolve "Depreciate use of Version 4 and 5.0 Draglibs" See merge request dragon/5.1!40
-rw-r--r--Dragon/Makefile2
-rwxr-xr-xDragon/data/a2b_drglib_apolib99_endfb8r0_v5p1.access6
-rwxr-xr-xDragon/data/a2b_drglib_apolib99_jef2p2_v5p1.access6
-rwxr-xr-xDragon/data/a2b_drglib_apolib99_jeff4p0_v5p1.access6
-rwxr-xr-xDragon/data/a2b_drglib_endfb7r1_shem315_v5p1.access6
-rwxr-xr-xDragon/data/a2b_drglib_endfb8r1_ecco1962_light_v5p1.access6
-rwxr-xr-xDragon/data/a2b_drglib_endfb8r1_shem281_v5p1.access6
-rwxr-xr-xDragon/data/a2b_drglib_endfb8r1_shem295_v5p1.access6
-rwxr-xr-xDragon/data/a2b_drglib_endfb8r1_shem315_v5p1.access6
-rwxr-xr-xDragon/data/a2b_drglib_endfb8r1_shem361_v5p1.access6
-rwxr-xr-xDragon/data/a2b_drglib_endfb8r1_v5p1.access6
-rwxr-xr-xDragon/data/a2b_drglib_jef2p2_v5p1.access6
-rwxr-xr-xDragon/data/a2b_drglib_jeff4p0_v5p1.access6
-rwxr-xr-xDragon/data/a2b_drglib_shem281_jeff4p0_v5p1.access6
-rwxr-xr-xDragon/data/a2b_drglib_shem295_jef2p2_v5p1.access6
-rwxr-xr-xDragon/data/a2b_drglib_shem295_jeff3p1p1_v5p1.access6
-rwxr-xr-xDragon/data/a2b_drglib_shem295_jeff3p1p1_v5p1_kerma.access6
-rwxr-xr-xDragon/data/a2b_drglib_shem295_jeff4p0_v5p1.access6
-rwxr-xr-xDragon/data/a2b_drglib_shem315_jeff4p0_v5p1.access6
-rwxr-xr-xDragon/data/a2b_drglib_shem361_jeff4p0_v5p1.access6
-rw-r--r--Dragon/data/tapollo1_proc/TCA131.c2m2
-rw-r--r--Dragon/data/tapollo2_proc/TCA231.c2m2
-rw-r--r--Dragon/data/tapollo2_proc/TCA232.c2m2
-rw-r--r--Dragon/data/tapollo2_proc/TCA234.c2m2
-rw-r--r--Dragon/data/tapollo2_proc/TCA235.c2m2
-rw-r--r--Dragon/data/tapollo2_proc/TCA241.c2m2
-rw-r--r--Dragon/data/uo2_evo_xsm.x2m2
-rw-r--r--Dragon/src/BREANM.f15
-rw-r--r--Dragon/src/BREDRV.f53
-rw-r--r--Dragon/src/BREERA.f28
-rw-r--r--Dragon/src/BREERM.f26
-rw-r--r--Dragon/src/BREKOE.f15
-rw-r--r--Dragon/src/BRELLB.f14
-rw-r--r--Dragon/src/BREMAC.f50
-rw-r--r--Dragon/src/BRENEM.f15
-rw-r--r--Dragon/src/BRERT.f19
-rw-r--r--Dragon/src/CPOLGX.f34
-rw-r--r--Dragon/src/EDIACT.f13
-rw-r--r--Dragon/src/EDIDRV.f29
-rw-r--r--Dragon/src/EDIHFC.f196
-rw-r--r--Dragon/src/EDIMIC.f31
-rw-r--r--Dragon/src/EDIRES.f13
-rw-r--r--Dragon/src/EPCRMA.f2
-rw-r--r--Dragon/src/EPCRMS.f2
-rw-r--r--Dragon/src/EPCRMU.f6
-rw-r--r--Dragon/src/EVOBLD.f25
-rw-r--r--Dragon/src/EVODRV.f17
-rw-r--r--Dragon/src/EVOSIG.f19
-rw-r--r--Dragon/src/LIB.f31
-rw-r--r--Dragon/src/LIBA20.f47
-rw-r--r--Dragon/src/LIBA30.f59
-rw-r--r--Dragon/src/LIBADD.f87
-rw-r--r--Dragon/src/LIBAPL.f5
-rw-r--r--Dragon/src/LIBDEP.F55
-rw-r--r--Dragon/src/LIBDRA.f58
-rw-r--r--Dragon/src/LIBE3R.f22
-rw-r--r--Dragon/src/LIBEAQ.f254
-rw-r--r--Dragon/src/LIBEAR.f8
-rw-r--r--Dragon/src/LIBLIB.f6
-rw-r--r--Dragon/src/LIBLIC.F10
-rw-r--r--Dragon/src/LIBND1.f6
-rw-r--r--Dragon/src/LIBSUB.f10
-rw-r--r--Dragon/src/LIBWD4.f15
-rw-r--r--Dragon/src/LIBWE.f12
-rw-r--r--Dragon/src/LIBWIM.f9
-rw-r--r--Dragon/src/LIBXS2.f5
-rw-r--r--Dragon/src/LIBXS4.f73
-rw-r--r--Dragon/src/TRAXS.f1
-rw-r--r--Dragon/src/XDRLGS.f12
-rw-r--r--Dragon/src/XDRLXS.f17
-rw-r--r--Dragon/src/g2s_convert.f901
-rw-r--r--doc/IGE351/SectDmicrolib.tex23
72 files changed, 992 insertions, 586 deletions
diff --git a/Dragon/Makefile b/Dragon/Makefile
index 2a029cb..e8973d2 100644
--- a/Dragon/Makefile
+++ b/Dragon/Makefile
@@ -69,6 +69,8 @@ tests :
./rdragon -c $(fcompilerSuite) -p $(nomp) -q pincell_mco.x2m
./rdragon -c $(fcompilerSuite) -p $(nomp) -q pincell_sap.x2m
ifeq ($(apolib),1)
+ ./rdragon -c $(fcompilerSuite) -p $(nomp) -q tapollo1.x2m
+ ./rdragon -c $(fcompilerSuite) -p $(nomp) -q tapollo2.x2m
./rdragon -c $(fcompilerSuite) -p $(nomp) -q uo2_evo_xsm.x2m
./rdragon -c $(fcompilerSuite) -p $(nomp) -q uo2_evo_hdf.x2m
./rdragon -c $(fcompilerSuite) -p $(nomp) -q ASSBLY_CASEA_1level_apex_boron.x2m
diff --git a/Dragon/data/a2b_drglib_apolib99_endfb8r0_v5p1.access b/Dragon/data/a2b_drglib_apolib99_endfb8r0_v5p1.access
index 16f8428..693ea10 100755
--- a/Dragon/data/a2b_drglib_apolib99_endfb8r0_v5p1.access
+++ b/Dragon/data/a2b_drglib_apolib99_endfb8r0_v5p1.access
@@ -8,10 +8,10 @@ if [ $# = 0 ]
exit 1
fi
echo access a2b_drglib_apolib99_endfb7r1.access
-if [ -f "$1"/../Njoy2012/python/apolib99_endfb7r1/draglibapolib99_endfb7r1.gz ]
+if [ -f "$1"/../Njoy2016/python/apolib99_endfb7r1/draglibapolib99_endfb7r1.gz ]
then
echo 'gunzipping library'
- gunzip "$1"/../Njoy2012/python/apolib99_endfb7r1/draglibapolib99_endfb7r1.gz
+ gunzip "$1"/../Njoy2016/python/apolib99_endfb7r1/draglibapolib99_endfb7r1.gz
fi
-ln -s "$1"/../Njoy2012/python/apolib99_endfb7r1/draglibapolib99_endfb7r1 EXPORT
+ln -s "$1"/../Njoy2016/python/apolib99_endfb7r1/draglibapolib99_endfb7r1 EXPORT
ls -l
diff --git a/Dragon/data/a2b_drglib_apolib99_jef2p2_v5p1.access b/Dragon/data/a2b_drglib_apolib99_jef2p2_v5p1.access
index c4984c3..b63fe07 100755
--- a/Dragon/data/a2b_drglib_apolib99_jef2p2_v5p1.access
+++ b/Dragon/data/a2b_drglib_apolib99_jef2p2_v5p1.access
@@ -8,10 +8,10 @@ if [ $# = 0 ]
exit 1
fi
echo access a2b_drglib_apolib99_jef2p2_v5p1.access
-if [ -f "$1"/../Njoy2012/python/apolib99_Jef2.2_v5p1/draglibapolib99_Jef2.2_v5p1.gz ]
+if [ -f "$1"/../Njoy2016/python/apolib99_Jef2.2_v5p1/draglibapolib99_Jef2.2_v5p1.gz ]
then
echo 'gunzipping library'
- gunzip "$1"/../Njoy2012/python/apolib99_Jef2.2_v5p1/draglibapolib99_Jef2.2_v5p1.gz
+ gunzip "$1"/../Njoy2016/python/apolib99_Jef2.2_v5p1/draglibapolib99_Jef2.2_v5p1.gz
fi
-ln -s "$1"/../Njoy2012/python/apolib99_Jef2.2_v5p1/draglibapolib99_Jef2.2_v5p1 EXPORT
+ln -s "$1"/../Njoy2016/python/apolib99_Jef2.2_v5p1/draglibapolib99_Jef2.2_v5p1 EXPORT
ls -l
diff --git a/Dragon/data/a2b_drglib_apolib99_jeff4p0_v5p1.access b/Dragon/data/a2b_drglib_apolib99_jeff4p0_v5p1.access
index 87ac9b2..b24dab0 100755
--- a/Dragon/data/a2b_drglib_apolib99_jeff4p0_v5p1.access
+++ b/Dragon/data/a2b_drglib_apolib99_jeff4p0_v5p1.access
@@ -8,10 +8,10 @@ if [ $# = 0 ]
exit 1
fi
echo access a2b_drglib_apolib99_jeff4p0_v5p1.access
-if [ -f "$1"/../Njoy2012/python/apolib99_Jeff4.0_v5p1/draglibapolib99_Jeff4.0_v5p1.gz ]
+if [ -f "$1"/../Njoy2016/python/apolib99_Jeff4.0_v5p1/draglibapolib99_Jeff4.0_v5p1.gz ]
then
echo 'gunzipping library'
- gunzip "$1"/../Njoy2012/python/apolib99_Jeff4.0_v5p1/draglibapolib99_Jeff4.0_v5p1.gz
+ gunzip "$1"/../Njoy2016/python/apolib99_Jeff4.0_v5p1/draglibapolib99_Jeff4.0_v5p1.gz
fi
-ln -s "$1"/../Njoy2012/python/apolib99_Jeff4.0_v5p1/draglibapolib99_Jeff4.0_v5p1 EXPORT
+ln -s "$1"/../Njoy2016/python/apolib99_Jeff4.0_v5p1/draglibapolib99_Jeff4.0_v5p1 EXPORT
ls -l
diff --git a/Dragon/data/a2b_drglib_endfb7r1_shem315_v5p1.access b/Dragon/data/a2b_drglib_endfb7r1_shem315_v5p1.access
index 9af485a..d244c6f 100755
--- a/Dragon/data/a2b_drglib_endfb7r1_shem315_v5p1.access
+++ b/Dragon/data/a2b_drglib_endfb7r1_shem315_v5p1.access
@@ -8,10 +8,10 @@ if [ $# = 0 ]
exit 1
fi
echo access a2b_drglib_endfb7r1_shem315_v5p1.access
-if [ -f "$1"/../Njoy2012/python/shem315_endfb7r1_v5p1/draglibshem315_endfb7r1_v5p1.gz ]
+if [ -f "$1"/../Njoy2016/python/shem315_endfb7r1_v5p1/draglibshem315_endfb7r1_v5p1.gz ]
then
echo 'gunzipping library'
- gunzip "$1"/../Njoy2012/python/shem315_endfb7r1_v5p1/draglibshem315_endfb7r1_v5p1.gz
+ gunzip "$1"/../Njoy2016/python/shem315_endfb7r1_v5p1/draglibshem315_endfb7r1_v5p1.gz
fi
-ln -s "$1"/../Njoy2012/python/shem315_endfb7r1_v5p1/draglibshem315_endfb7r1_v5p1 EXPORT
+ln -s "$1"/../Njoy2016/python/shem315_endfb7r1_v5p1/draglibshem315_endfb7r1_v5p1 EXPORT
ls -l
diff --git a/Dragon/data/a2b_drglib_endfb8r1_ecco1962_light_v5p1.access b/Dragon/data/a2b_drglib_endfb8r1_ecco1962_light_v5p1.access
index f3f5a23..f30b72a 100755
--- a/Dragon/data/a2b_drglib_endfb8r1_ecco1962_light_v5p1.access
+++ b/Dragon/data/a2b_drglib_endfb8r1_ecco1962_light_v5p1.access
@@ -8,10 +8,10 @@ if [ $# = 0 ]
exit 1
fi
echo access a2b_drglib_endfb8r1_ecco1962_light_v5p1.access
-if [ -f "$1"/../Njoy2012/python/ecco1962_endfb8r1_light_v5p1/draglibecco1962_endfb8r1_light_v5p1.gz ]
+if [ -f "$1"/../Njoy2016/python/ecco1962_endfb8r1_light_v5p1/draglibecco1962_endfb8r1_light_v5p1.gz ]
then
echo 'gunzipping library'
- gunzip "$1"/../Njoy2012/python/ecco1962_endfb8r1_light_v5p1/draglibecco1962_endfb8r1_light_v5p1.gz
+ gunzip "$1"/../Njoy2016/python/ecco1962_endfb8r1_light_v5p1/draglibecco1962_endfb8r1_light_v5p1.gz
fi
-ln -s "$1"/../Njoy2012/python/ecco1962_endfb8r1_light_v5p1/draglibecco1962_endfb8r1_light_v5p1 EXPORT
+ln -s "$1"/../Njoy2016/python/ecco1962_endfb8r1_light_v5p1/draglibecco1962_endfb8r1_light_v5p1 EXPORT
ls -l
diff --git a/Dragon/data/a2b_drglib_endfb8r1_shem281_v5p1.access b/Dragon/data/a2b_drglib_endfb8r1_shem281_v5p1.access
index 506331e..20fb16a 100755
--- a/Dragon/data/a2b_drglib_endfb8r1_shem281_v5p1.access
+++ b/Dragon/data/a2b_drglib_endfb8r1_shem281_v5p1.access
@@ -8,10 +8,10 @@ if [ $# = 0 ]
exit 1
fi
echo access a2b_drglib_endfb8r1_v5p1_shem281.access
-if [ -f "$1"/../Njoy2012/python/shem281_endfb8r1_v5p1/draglibshem281_endfb8r1_v5p1.gz ]
+if [ -f "$1"/../Njoy2016/python/shem281_endfb8r1_v5p1/draglibshem281_endfb8r1_v5p1.gz ]
then
echo 'gunzipping library'
- gunzip "$1"/../Njoy2012/python/shem281_endfb8r1_v5p1/draglibshem281_endfb8r1_v5p1.gz
+ gunzip "$1"/../Njoy2016/python/shem281_endfb8r1_v5p1/draglibshem281_endfb8r1_v5p1.gz
fi
-ln -s "$1"/../Njoy2012/python/shem281_endfb8r1_v5p1/draglibshem281_endfb8r1_v5p1 EXPORT
+ln -s "$1"/../Njoy2016/python/shem281_endfb8r1_v5p1/draglibshem281_endfb8r1_v5p1 EXPORT
ls -l
diff --git a/Dragon/data/a2b_drglib_endfb8r1_shem295_v5p1.access b/Dragon/data/a2b_drglib_endfb8r1_shem295_v5p1.access
index 7a7d27b..94e7237 100755
--- a/Dragon/data/a2b_drglib_endfb8r1_shem295_v5p1.access
+++ b/Dragon/data/a2b_drglib_endfb8r1_shem295_v5p1.access
@@ -8,10 +8,10 @@ if [ $# = 0 ]
exit 1
fi
echo access a2b_drglib_endfb8r1_v5p1_shem295.access
-if [ -f "$1"/../Njoy2012/python/shem295_endfb8r1_v5p1/draglibshem295_endfb8r1_v5p1.gz ]
+if [ -f "$1"/../Njoy2016/python/shem295_endfb8r1_v5p1/draglibshem295_endfb8r1_v5p1.gz ]
then
echo 'gunzipping library'
- gunzip "$1"/../Njoy2012/python/shem295_endfb8r1_v5p1/draglibshem295_endfb8r1_v5p1.gz
+ gunzip "$1"/../Njoy2016/python/shem295_endfb8r1_v5p1/draglibshem295_endfb8r1_v5p1.gz
fi
-ln -s "$1"/../Njoy2012/python/shem295_endfb8r1_v5p1/draglibshem295_endfb8r1_v5p1 EXPORT
+ln -s "$1"/../Njoy2016/python/shem295_endfb8r1_v5p1/draglibshem295_endfb8r1_v5p1 EXPORT
ls -l
diff --git a/Dragon/data/a2b_drglib_endfb8r1_shem315_v5p1.access b/Dragon/data/a2b_drglib_endfb8r1_shem315_v5p1.access
index 711fada..e0aa683 100755
--- a/Dragon/data/a2b_drglib_endfb8r1_shem315_v5p1.access
+++ b/Dragon/data/a2b_drglib_endfb8r1_shem315_v5p1.access
@@ -8,10 +8,10 @@ if [ $# = 0 ]
exit 1
fi
echo access a2b_drglib_endfb8r1_v5p1_shem315.access
-if [ -f "$1"/../Njoy2012/python/shem315_endfb8r1_v5p1/draglibshem315_endfb8r1_v5p1.gz ]
+if [ -f "$1"/../Njoy2016/python/shem315_endfb8r1_v5p1/draglibshem315_endfb8r1_v5p1.gz ]
then
echo 'gunzipping library'
- gunzip "$1"/../Njoy2012/python/shem315_endfb8r1_v5p1/draglibshem315_endfb8r1_v5p1.gz
+ gunzip "$1"/../Njoy2016/python/shem315_endfb8r1_v5p1/draglibshem315_endfb8r1_v5p1.gz
fi
-ln -s "$1"/../Njoy2012/python/shem315_endfb8r1_v5p1/draglibshem315_endfb8r1_v5p1 EXPORT
+ln -s "$1"/../Njoy2016/python/shem315_endfb8r1_v5p1/draglibshem315_endfb8r1_v5p1 EXPORT
ls -l
diff --git a/Dragon/data/a2b_drglib_endfb8r1_shem361_v5p1.access b/Dragon/data/a2b_drglib_endfb8r1_shem361_v5p1.access
index 971d348..6904d17 100755
--- a/Dragon/data/a2b_drglib_endfb8r1_shem361_v5p1.access
+++ b/Dragon/data/a2b_drglib_endfb8r1_shem361_v5p1.access
@@ -8,10 +8,10 @@ if [ $# = 0 ]
exit 1
fi
echo access a2b_drglib_endfb8r1_v5p1_shem361.access
-if [ -f "$1"/../Njoy2012/python/shem361_endfb8r1_v5p1/draglibshem361_endfb8r1_v5p1.gz ]
+if [ -f "$1"/../Njoy2016/python/shem361_endfb8r1_v5p1/draglibshem361_endfb8r1_v5p1.gz ]
then
echo 'gunzipping library'
- gunzip "$1"/../Njoy2012/python/shem361_endfb8r1_v5p1/draglibshem361_endfb8r1_v5p1.gz
+ gunzip "$1"/../Njoy2016/python/shem361_endfb8r1_v5p1/draglibshem361_endfb8r1_v5p1.gz
fi
-ln -s "$1"/../Njoy2012/python/shem361_endfb8r1_v5p1/draglibshem361_endfb8r1_v5p1 EXPORT
+ln -s "$1"/../Njoy2016/python/shem361_endfb8r1_v5p1/draglibshem361_endfb8r1_v5p1 EXPORT
ls -l
diff --git a/Dragon/data/a2b_drglib_endfb8r1_v5p1.access b/Dragon/data/a2b_drglib_endfb8r1_v5p1.access
index 11d7cd3..bbb8961 100755
--- a/Dragon/data/a2b_drglib_endfb8r1_v5p1.access
+++ b/Dragon/data/a2b_drglib_endfb8r1_v5p1.access
@@ -8,10 +8,10 @@ if [ $# = 0 ]
exit 1
fi
echo access a2b_drglib_endfb8r1_v5p1.access
-if [ -f "$1"/../Njoy2012/python/endfb8r1_v5p1/draglibendfb8r1_v5p1.gz ]
+if [ -f "$1"/../Njoy2016/python/endfb8r1_v5p1/draglibendfb8r1_v5p1.gz ]
then
echo 'gunzipping library'
- gunzip "$1"/../Njoy2012/python/endfb8r1_v5p1/draglibendfb8r1_v5p1.gz
+ gunzip "$1"/../Njoy2016/python/endfb8r1_v5p1/draglibendfb8r1_v5p1.gz
fi
-ln -s "$1"/../Njoy2012/python/endfb8r1_v5p1/draglibendfb8r1_v5p1 EXPORT
+ln -s "$1"/../Njoy2016/python/endfb8r1_v5p1/draglibendfb8r1_v5p1 EXPORT
ls -l
diff --git a/Dragon/data/a2b_drglib_jef2p2_v5p1.access b/Dragon/data/a2b_drglib_jef2p2_v5p1.access
index b59177f..de3a91f 100755
--- a/Dragon/data/a2b_drglib_jef2p2_v5p1.access
+++ b/Dragon/data/a2b_drglib_jef2p2_v5p1.access
@@ -8,10 +8,10 @@ if [ $# = 0 ]
exit 1
fi
echo access a2b_drglib_jef2p2_v5p1.access
-if [ -f "$1"/../Njoy2012/python/Jef2.2_v5p1/draglibJef2.2_v5p1.gz ]
+if [ -f "$1"/../Njoy2016/python/Jef2.2_v5p1/draglibJef2.2_v5p1.gz ]
then
echo 'gunzipping library'
- gunzip "$1"/../Njoy2012/python/Jef2.2_v5p1/draglibJef2.2_v5p1.gz
+ gunzip "$1"/../Njoy2016/python/Jef2.2_v5p1/draglibJef2.2_v5p1.gz
fi
-ln -s "$1"/../Njoy2012/python/Jef2.2_v5p1/draglibJef2.2_v5p1 EXPORT
+ln -s "$1"/../Njoy2016/python/Jef2.2_v5p1/draglibJef2.2_v5p1 EXPORT
ls -l
diff --git a/Dragon/data/a2b_drglib_jeff4p0_v5p1.access b/Dragon/data/a2b_drglib_jeff4p0_v5p1.access
index 562f6fb..a7fb147 100755
--- a/Dragon/data/a2b_drglib_jeff4p0_v5p1.access
+++ b/Dragon/data/a2b_drglib_jeff4p0_v5p1.access
@@ -8,10 +8,10 @@ if [ $# = 0 ]
exit 1
fi
echo access a2b_drglib_jeff4p0_v5p1.access
-if [ -f "$1"/../Njoy2012/python/Jeff4.0_v5p1/draglibJeff4.0_v5p1.gz ]
+if [ -f "$1"/../Njoy2016/python/Jeff4.0_v5p1/draglibJeff4.0_v5p1.gz ]
then
echo 'gunzipping library'
- gunzip "$1"/../Njoy2012/python/Jeff4.0_v5p1/draglibJeff4.0_v5p1.gz
+ gunzip "$1"/../Njoy2016/python/Jeff4.0_v5p1/draglibJeff4.0_v5p1.gz
fi
-ln -s "$1"/../Njoy2012/python/Jeff4.0_v5p1/draglibJeff4.0_v5p1 EXPORT
+ln -s "$1"/../Njoy2016/python/Jeff4.0_v5p1/draglibJeff4.0_v5p1 EXPORT
ls -l
diff --git a/Dragon/data/a2b_drglib_shem281_jeff4p0_v5p1.access b/Dragon/data/a2b_drglib_shem281_jeff4p0_v5p1.access
index 815ee9a..38ac106 100755
--- a/Dragon/data/a2b_drglib_shem281_jeff4p0_v5p1.access
+++ b/Dragon/data/a2b_drglib_shem281_jeff4p0_v5p1.access
@@ -8,10 +8,10 @@ if [ $# = 0 ]
exit 1
fi
echo access a2b_drglib_shem281_jeff4p0_v5p1.access
-if [ -f "$1"/../Njoy2012/python/shem281_Jeff4.0_v5p1/draglibshem281_Jeff4.0_v5p1.gz ]
+if [ -f "$1"/../Njoy2016/python/shem281_Jeff4.0_v5p1/draglibshem281_Jeff4.0_v5p1.gz ]
then
echo 'gunzipping library'
- gunzip "$1"/../Njoy2012/python/shem281_Jeff4.0_v5p1/draglibshem281_Jeff4.0_v5p1.gz
+ gunzip "$1"/../Njoy2016/python/shem281_Jeff4.0_v5p1/draglibshem281_Jeff4.0_v5p1.gz
fi
-ln -s "$1"/../Njoy2012/python/shem281_Jeff4.0_v5p1/draglibshem281_Jeff4.0_v5p1 EXPORT
+ln -s "$1"/../Njoy2016/python/shem281_Jeff4.0_v5p1/draglibshem281_Jeff4.0_v5p1 EXPORT
ls -l
diff --git a/Dragon/data/a2b_drglib_shem295_jef2p2_v5p1.access b/Dragon/data/a2b_drglib_shem295_jef2p2_v5p1.access
index 2606233..1dc56d7 100755
--- a/Dragon/data/a2b_drglib_shem295_jef2p2_v5p1.access
+++ b/Dragon/data/a2b_drglib_shem295_jef2p2_v5p1.access
@@ -8,10 +8,10 @@ if [ $# = 0 ]
exit 1
fi
echo access a2b_drglib_shem295_jef2p2_v5p1.access
-if [ -f "$1"/../Njoy2012/python/shem295_Jef2.2_v5p1/draglibshem295_Jef2.2_v5p1.gz ]
+if [ -f "$1"/../Njoy2016/python/shem295_Jef2.2_v5p1/draglibshem295_Jef2.2_v5p1.gz ]
then
echo 'gunzipping library'
- gunzip "$1"/../Njoy2012/python/shem295_Jef2.2_v5p1/draglibshem295_Jef2.2_v5p1.gz
+ gunzip "$1"/../Njoy2016/python/shem295_Jef2.2_v5p1/draglibshem295_Jef2.2_v5p1.gz
fi
-ln -s "$1"/../Njoy2012/python/shem295_Jef2.2_v5p1/draglibshem295_Jef2.2_v5p1 EXPORT
+ln -s "$1"/../Njoy2016/python/shem295_Jef2.2_v5p1/draglibshem295_Jef2.2_v5p1 EXPORT
ls -l
diff --git a/Dragon/data/a2b_drglib_shem295_jeff3p1p1_v5p1.access b/Dragon/data/a2b_drglib_shem295_jeff3p1p1_v5p1.access
index a711b6e..2a20bb0 100755
--- a/Dragon/data/a2b_drglib_shem295_jeff3p1p1_v5p1.access
+++ b/Dragon/data/a2b_drglib_shem295_jeff3p1p1_v5p1.access
@@ -8,10 +8,10 @@ if [ $# = 0 ]
exit 1
fi
echo access a2b_drglib_shem295_jeff3p1p1_v5p1.access
-if [ -f "$1"/../Njoy2012/python/shem295_Jeff3.1.1_v5p1/draglibshem295_Jeff3.1.1_v5p1.gz ]
+if [ -f "$1"/../Njoy2016/python/shem295_Jeff3.1.1_v5p1/draglibshem295_Jeff3.1.1_v5p1.gz ]
then
echo 'gunzipping library'
- gunzip "$1"/../Njoy2012/python/shem295_Jeff3.1.1_v5p1/draglibshem295_Jeff3.1.1_v5p1.gz
+ gunzip "$1"/../Njoy2016/python/shem295_Jeff3.1.1_v5p1/draglibshem295_Jeff3.1.1_v5p1.gz
fi
-ln -s "$1"/../Njoy2012/python/shem295_Jeff3.1.1_v5p1/draglibshem295_Jeff3.1.1_v5p1 EXPORT
+ln -s "$1"/../Njoy2016/python/shem295_Jeff3.1.1_v5p1/draglibshem295_Jeff3.1.1_v5p1 EXPORT
ls -l
diff --git a/Dragon/data/a2b_drglib_shem295_jeff3p1p1_v5p1_kerma.access b/Dragon/data/a2b_drglib_shem295_jeff3p1p1_v5p1_kerma.access
index cdcc528..722e396 100755
--- a/Dragon/data/a2b_drglib_shem295_jeff3p1p1_v5p1_kerma.access
+++ b/Dragon/data/a2b_drglib_shem295_jeff3p1p1_v5p1_kerma.access
@@ -8,10 +8,10 @@ if [ $# = 0 ]
exit 1
fi
echo access a2b_drglib_shem295_jeff3p1p1_v5p1_kerma.access
-if [ -f "$1"/../Njoy2012/python/shem295_Jeff3.1.1_v5p1_kerma/draglibshem295_Jeff3.1.1_v5p1_kerma.gz ]
+if [ -f "$1"/../Njoy2016/python/shem295_Jeff3.1.1_v5p1_kerma/draglibshem295_Jeff3.1.1_v5p1_kerma.gz ]
then
echo 'gunzipping library'
- gunzip "$1"/../Njoy2012/python/shem295_Jeff3.1.1_v5p1_kerma/draglibshem295_Jeff3.1.1_v5p1_kerma.gz
+ gunzip "$1"/../Njoy2016/python/shem295_Jeff3.1.1_v5p1_kerma/draglibshem295_Jeff3.1.1_v5p1_kerma.gz
fi
-ln -s "$1"/../Njoy2012/python/shem295_Jeff3.1.1_v5p1_kerma/draglibshem295_Jeff3.1.1_v5p1_kerma EXPORT
+ln -s "$1"/../Njoy2016/python/shem295_Jeff3.1.1_v5p1_kerma/draglibshem295_Jeff3.1.1_v5p1_kerma EXPORT
ls -l
diff --git a/Dragon/data/a2b_drglib_shem295_jeff4p0_v5p1.access b/Dragon/data/a2b_drglib_shem295_jeff4p0_v5p1.access
index e65b421..f8973be 100755
--- a/Dragon/data/a2b_drglib_shem295_jeff4p0_v5p1.access
+++ b/Dragon/data/a2b_drglib_shem295_jeff4p0_v5p1.access
@@ -8,10 +8,10 @@ if [ $# = 0 ]
exit 1
fi
echo access a2b_drglib_shem295_jeff4p0_v5p1.access
-if [ -f "$1"/../Njoy2012/python/shem295_Jeff4.0_v5p1/draglibshem295_Jeff4.0_v5p1.gz ]
+if [ -f "$1"/../Njoy2016/python/shem295_Jeff4.0_v5p1/draglibshem295_Jeff4.0_v5p1.gz ]
then
echo 'gunzipping library'
- gunzip "$1"/../Njoy2012/python/shem295_Jeff4.0_v5p1/draglibshem295_Jeff4.0_v5p1.gz
+ gunzip "$1"/../Njoy2016/python/shem295_Jeff4.0_v5p1/draglibshem295_Jeff4.0_v5p1.gz
fi
-ln -s "$1"/../Njoy2012/python/shem295_Jeff4.0_v5p1/draglibshem295_Jeff4.0_v5p1 EXPORT
+ln -s "$1"/../Njoy2016/python/shem295_Jeff4.0_v5p1/draglibshem295_Jeff4.0_v5p1 EXPORT
ls -l
diff --git a/Dragon/data/a2b_drglib_shem315_jeff4p0_v5p1.access b/Dragon/data/a2b_drglib_shem315_jeff4p0_v5p1.access
index 23a3904..5991d04 100755
--- a/Dragon/data/a2b_drglib_shem315_jeff4p0_v5p1.access
+++ b/Dragon/data/a2b_drglib_shem315_jeff4p0_v5p1.access
@@ -8,10 +8,10 @@ if [ $# = 0 ]
exit 1
fi
echo access a2b_drglib_shem315_jeff4p0_v5p1.access
-if [ -f "$1"/../Njoy2012/python/shem315_Jeff4.0_v5p1/draglibshem315_Jeff4.0_v5p1.gz ]
+if [ -f "$1"/../Njoy2016/python/shem315_Jeff4.0_v5p1/draglibshem315_Jeff4.0_v5p1.gz ]
then
echo 'gunzipping library'
- gunzip "$1"/../Njoy2012/python/shem315_Jeff4.0_v5p1/draglibshem315_Jeff4.0_v5p1.gz
+ gunzip "$1"/../Njoy2016/python/shem315_Jeff4.0_v5p1/draglibshem315_Jeff4.0_v5p1.gz
fi
-ln -s "$1"/../Njoy2012/python/shem315_Jeff4.0_v5p1/draglibshem315_Jeff4.0_v5p1 EXPORT
+ln -s "$1"/../Njoy2016/python/shem315_Jeff4.0_v5p1/draglibshem315_Jeff4.0_v5p1 EXPORT
ls -l
diff --git a/Dragon/data/a2b_drglib_shem361_jeff4p0_v5p1.access b/Dragon/data/a2b_drglib_shem361_jeff4p0_v5p1.access
index b8955f7..8313949 100755
--- a/Dragon/data/a2b_drglib_shem361_jeff4p0_v5p1.access
+++ b/Dragon/data/a2b_drglib_shem361_jeff4p0_v5p1.access
@@ -8,10 +8,10 @@ if [ $# = 0 ]
exit 1
fi
echo access a2b_drglib_shem361_jeff4p0_v5p1.access
-if [ -f "$1"/../Njoy2012/python/shem361_Jeff4.0_v5p1/draglibshem361_Jeff4.0_v5p1.gz ]
+if [ -f "$1"/../Njoy2016/python/shem361_Jeff4.0_v5p1/draglibshem361_Jeff4.0_v5p1.gz ]
then
echo 'gunzipping library'
- gunzip "$1"/../Njoy2012/python/shem361_Jeff4.0_v5p1/draglibshem361_Jeff4.0_v5p1.gz
+ gunzip "$1"/../Njoy2016/python/shem361_Jeff4.0_v5p1/draglibshem361_Jeff4.0_v5p1.gz
fi
-ln -s "$1"/../Njoy2012/python/shem361_Jeff4.0_v5p1/draglibshem361_Jeff4.0_v5p1 EXPORT
+ln -s "$1"/../Njoy2016/python/shem361_Jeff4.0_v5p1/draglibshem361_Jeff4.0_v5p1 EXPORT
ls -l
diff --git a/Dragon/data/tapollo1_proc/TCA131.c2m b/Dragon/data/tapollo1_proc/TCA131.c2m
index e18a8b1..da8fbf4 100644
--- a/Dragon/data/tapollo1_proc/TCA131.c2m
+++ b/Dragon/data/tapollo1_proc/TCA131.c2m
@@ -385,7 +385,7 @@ WHILE evoend step2 NORM_FCT / < DO
EVALUATE istep := istep 1 + ;
ENDWHILE ;
-assertS FLUX :: 'K-INFINITY' 1 0.9192253 ;
+assertS FLUX :: 'K-INFINITY' 1 0.9195393 ;
BURNUP LIBRARY2 := EVO: BURNUP LIBRARY2 FLUX TRACK :: EDIT 2
SAVE <<evoend>> DAY POWR <<NORM_FCT>> (*MW/TONNE*) ;
diff --git a/Dragon/data/tapollo2_proc/TCA231.c2m b/Dragon/data/tapollo2_proc/TCA231.c2m
index 6ccbe54..4576c89 100644
--- a/Dragon/data/tapollo2_proc/TCA231.c2m
+++ b/Dragon/data/tapollo2_proc/TCA231.c2m
@@ -222,7 +222,7 @@ WHILE evoend step2 NORM_FCT2 / < DO
EVALUATE istep := istep 1 + ;
ENDWHILE ;
-assertS FLUX :: K-INFINITY 1 1.346755 ;
+assertS FLUX :: K-INFINITY 1 1.346952 ;
*
* CONCATENATION
*
diff --git a/Dragon/data/tapollo2_proc/TCA232.c2m b/Dragon/data/tapollo2_proc/TCA232.c2m
index 2b7e9ee..3c97ff6 100644
--- a/Dragon/data/tapollo2_proc/TCA232.c2m
+++ b/Dragon/data/tapollo2_proc/TCA232.c2m
@@ -64,6 +64,6 @@ TRACK2 := SYBILT: C3 ::
LIBRARY2 := USS: LIBRARY TRACK2 :: EDIT 1 TRAN PASS 2 ;
SYS := ASM: LIBRARY2 TRACK2 :: PIJ ;
FLUX := FLU: SYS LIBRARY2 TRACK2 :: TYPE K ;
-assertS FLUX :: K-EFFECTIVE 1 1.194064 ;
+assertS FLUX :: K-EFFECTIVE 1 1.194057 ;
ECHO "test TCA232 completed" ;
END: ;
diff --git a/Dragon/data/tapollo2_proc/TCA234.c2m b/Dragon/data/tapollo2_proc/TCA234.c2m
index 67b0618..70d500a 100644
--- a/Dragon/data/tapollo2_proc/TCA234.c2m
+++ b/Dragon/data/tapollo2_proc/TCA234.c2m
@@ -286,7 +286,7 @@ ENDWHILE ;
BURNUP LIBRARY2 := EVO: BURNUP LIBRARY2 TRACK FLUX :: EDIT 2
SAVE <<evoend>> DAY W/CC <<NORM_FCT1>> ;
-assertS FLUX :: K-INFINITY 1 1.197001 ;
+assertS FLUX :: K-INFINITY 1 1.197014 ;
SAPMIL := SAPOBJ :: STEP UP 'calc 3' STEP UP 'mili 4' ;
assertS SAPMIL :: RDATAX 4 9.442280 ;
diff --git a/Dragon/data/tapollo2_proc/TCA235.c2m b/Dragon/data/tapollo2_proc/TCA235.c2m
index dc4c6ae..d329753 100644
--- a/Dragon/data/tapollo2_proc/TCA235.c2m
+++ b/Dragon/data/tapollo2_proc/TCA235.c2m
@@ -301,7 +301,7 @@ ENDWHILE ;
BURNUP LIBRARY2 := EVO: BURNUP LIBRARY2 TRACK FLUX :: EDIT 2
SAVE <<evoend>> DAY W/CC <<NORM_FCT1>> ;
-assertS FLUX :: K-INFINITY 1 1.200448 ;
+assertS FLUX :: K-INFINITY 1 1.200459 ;
SAPMIL := SAPOBJ :: STEP UP 'calc 3' STEP UP 'mili 4' ;
UTL: SAPOBJ :: DIR ;
diff --git a/Dragon/data/tapollo2_proc/TCA241.c2m b/Dragon/data/tapollo2_proc/TCA241.c2m
index ce1825e..5e86156 100644
--- a/Dragon/data/tapollo2_proc/TCA241.c2m
+++ b/Dragon/data/tapollo2_proc/TCA241.c2m
@@ -89,7 +89,7 @@ SYS := ASM: LIBRARY TRACK TRACK_FIL ::
ARM EDIT 1 ;
FLUX := FLU: LIBRARY TRACK SYS TRACK_FIL ::
EDIT 1 TYPE K THER 5 5E-5 EXTE 100 1E-5 ;
-assertS FLUX :: 'K-EFFECTIVE' 1 1.050948 ;
+assertS FLUX :: 'K-EFFECTIVE' 1 1.050952 ;
EDIT := EDI: FLUX LIBRARY TRACK ASSMB ::
EDIT 2 COND 14 27 52 75 89 99
MERGE MIX 1 2 3 ;
diff --git a/Dragon/data/uo2_evo_xsm.x2m b/Dragon/data/uo2_evo_xsm.x2m
index fbe8026..9d8cd98 100644
--- a/Dragon/data/uo2_evo_xsm.x2m
+++ b/Dragon/data/uo2_evo_xsm.x2m
@@ -329,6 +329,6 @@ WHILE istep nstep <= DO
ENDWHILE ;
-assertS CALC :: K-INFINITY 1 1.002347 ;
+assertS CALC :: K-INFINITY 1 1.002470 ;
ECHO "test uo2_evo_xsm completed" ;
QUIT "LIST" .
diff --git a/Dragon/src/BREANM.f b/Dragon/src/BREANM.f
index 345268d..8a2b2c0 100644
--- a/Dragon/src/BREANM.f
+++ b/Dragon/src/BREANM.f
@@ -1,7 +1,7 @@
*DECK BREANM
- SUBROUTINE BREANM(IPMAC1,NG,LX1,NMIX1,IMIX,ICODE,ISPH,ZKEFF,B2,
- 1 ENER,XXX1,VOL1,FLX1,DC1,TOT1,CHI1,SIGF1,SCAT1,JXM,JXP,FHETXM,
- 2 FHETXP,ADF1,NGET,ADFREF,IPRINT)
+ SUBROUTINE BREANM(IPMAC1,NG,LX1,NMIX1,IMIX,ICODE,ISPH,IH,ZKEFF,
+ 1 B2,ENER,XXX1,VOL1,FLX1,DC1,TOT1,CHI1,SIGF1,SCAT1,HFACT1,JXM,JXP,
+ 2 FHETXM,FHETXP,ADF1,NGET,ADFREF,IPRINT)
*
*-----------------------------------------------------------------------
*
@@ -36,6 +36,7 @@
* CHI1 fission spectra.
* SIGF1 nu*fission cross sections.
* SCAT1 scattering P0 cross sections.
+* HFACT1 H-FACTOR values.
* JXM left boundary currents.
* JXP right boundary currents.
* FHETXM left boundary fluxes.
@@ -57,8 +58,8 @@
INTEGER NG,LX1,NMIX1,IMIX(LX1),ICODE(2),ISPH,NGET,IPRINT
REAL ZKEFF,B2,ENER(NG+1),XXX1(LX1+1),VOL1(NMIX1),FLX1(NMIX1,NG),
1 DC1(NMIX1,NG),TOT1(NMIX1,NG),CHI1(NMIX1,NG),SIGF1(NMIX1,NG),
- 2 SCAT1(NMIX1,NG,NG),JXM(NMIX1,NG),JXP(NMIX1,NG),FHETXM(NMIX1,NG),
- 3 FHETXP(NMIX1,NG),ADF1(NMIX1,NG),ADFREF(NG)
+ 2 SCAT1(NMIX1,NG,NG),HFACT1(NMIX1,NG),JXM(NMIX1,NG),JXP(NMIX1,NG),
+ 3 FHETXM(NMIX1,NG),FHETXP(NMIX1,NG),ADF1(NMIX1,NG),ADFREF(NG)
*----
* LOCAL VARIABLES
*----
@@ -227,6 +228,9 @@
DO JGR=1,NG
SCAT1(IBM,IGR,JGR)=SCAT1(IBM,IGR,JGR)/FDXM(IBM,JGR)
ENDDO
+ IF(IH.EQ.1) THEN
+ HFACT1(IBM,IGR)=HFACT1(IBM,IGR)/FDXM(IBM,IGR)
+ ENDIF
ENDDO
ENDDO
IF(ICODE(2).NE.0) THEN
@@ -332,6 +336,7 @@
CALL LCMPUT(KPMAC1,'NJJS00',NMIX1,1,NJJ)
CALL LCMPUT(KPMAC1,'IJJS00',NMIX1,1,IJJ)
CALL LCMPUT(KPMAC1,'IPOS00',NMIX1,1,IPOS)
+ IF(IH.EQ.1) CALL LCMPUT(KPMAC1,'H-FACTOR',NMIX1,2,HFACT1(:,IGR))
ENDDO
*----
* SCRATCH STORAGE DEALLOCATION
diff --git a/Dragon/src/BREDRV.f b/Dragon/src/BREDRV.f
index 3e9a12a..805edd9 100644
--- a/Dragon/src/BREDRV.f
+++ b/Dragon/src/BREDRV.f
@@ -77,8 +77,8 @@
1 ISTOP
REAL, ALLOCATABLE, DIMENSION(:) :: XXX,XXXS,XXX1,ENER,ZKEFF,B2
REAL, ALLOCATABLE, DIMENSION(:,:) :: VOL1
- REAL, ALLOCATABLE, DIMENSION(:,:,:) :: FLX1,DC1,CHI1,SIGF1,JXM,
- 1 JXP,ADF1
+ REAL, ALLOCATABLE, DIMENSION(:,:,:) :: FLX1,DC1,CHI1,SIGF1,HFACT1,
+ 1 JXM,JXP,ADF1
REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: TOT1,FHETXM,FHETXP
REAL, ALLOCATABLE, DIMENSION(:,:,:,:,:) :: SCAT1
TYPE(C_PTR), ALLOCATABLE, DIMENSION(:) :: IPMAC2
@@ -252,45 +252,46 @@
NL=NLF
ALLOCATE(VOL1(NMIX1,NC),FLX1(NMIX1,NG,NC),DC1(NMIX1,NG,NC),
1 TOT1(NMIX1,NG,NL,NC),CHI1(NMIX1,NG,NC),SIGF1(NMIX1,NG,NC),
- 2 SCAT1(NMIX1,NG,NG,NL,NC),JXM(NMIX1,NG,NC),JXP(NMIX1,NG,NC),
- 3 FHETXM(NMIX1,NG,NL,NC),FHETXP(NMIX1,NG,NL,NC),ADF1(NMIX1,NG,NC),
- 4 ZKEFF(NC),B2(NC))
+ 2 SCAT1(NMIX1,NG,NG,NL,NC),HFACT1(NMIX1,NG,NC),JXM(NMIX1,NG,NC),
+ 3 JXP(NMIX1,NG,NC),FHETXM(NMIX1,NG,NL,NC),FHETXP(NMIX1,NG,NL,NC),
+ 4 ADF1(NMIX1,NG,NC),ZKEFF(NC),B2(NC))
CALL BREMAC(NC,IPMAC2,NG,NL,LX1,NMIX1,NMIX2,IMIX,IMIX1,IGAP,
- 1 ILEAKS,IDF,IPRINT,ZKEFF,B2,VOL1,FLX1,DC1,TOT1,CHI1,SIGF1,SCAT1,
- 2 JXM,JXP,FHETXM,FHETXP,ADF1)
+ 1 ILEAKS,IDF,IPRINT,IH,ZKEFF,B2,VOL1,FLX1,DC1,TOT1,CHI1,SIGF1,
+ 2 SCAT1,HFACT1,JXM,JXP,FHETXM,FHETXP,ADF1)
*----
* SELECT A REFLECTOR MODEL
*----
IF(HMREFL.EQ."DF-NEM") THEN
IF(NC.NE.1) CALL XABORT('BREDRV: NC=1 EXPECTED.')
- CALL BRENEM(IPMAC1,NG,LX1,NMIX1,ITRIAL,IMIX,ICODE,ISPH,ZKEFF,
- 1 B2,ENER,VOL1,FLX1,DC1,TOT1,CHI1,SIGF1,SCAT1,JXM,JXP,FHETXM,
- 2 FHETXP,ADF1,NGET,ADFREF,IPRINT)
+ CALL BRENEM(IPMAC1,NG,LX1,NMIX1,ITRIAL,IMIX,ICODE,ISPH,IH,ZKEFF,
+ 1 B2,ENER,VOL1,FLX1,DC1,TOT1,CHI1,SIGF1,SCAT1,HFACT1,JXM,JXP,
+ 2 FHETXM,FHETXP,ADF1,NGET,ADFREF,IPRINT)
ELSE IF(HMREFL.EQ."DF-ANM") THEN
IF(NC.NE.1) CALL XABORT('BREDRV: NC=1 EXPECTED.')
- CALL BREANM(IPMAC1,NG,LX1,NMIX1,IMIX,ICODE,ISPH,ZKEFF,B2,ENER,
- 1 XXX1,VOL1,FLX1,DC1,TOT1,CHI1,SIGF1,SCAT1,JXM,JXP,FHETXM,FHETXP,
- 2 ADF1,NGET,ADFREF,IPRINT)
+ CALL BREANM(IPMAC1,NG,LX1,NMIX1,IMIX,ICODE,ISPH,IH,ZKEFF,B2,
+ 1 ENER,XXX1,VOL1,FLX1,DC1,TOT1,CHI1,SIGF1,SCAT1,HFACT1,JXM,JXP,
+ 2 FHETXM,FHETXP,ADF1,NGET,ADFREF,IPRINT)
ELSE IF(HMREFL.EQ."DF-RT") THEN
IF(NC.NE.1) CALL XABORT('BREDRV: NC=1 EXPECTED.')
- CALL BRERT(IPMAC1,IELEM,ICOL,NG,NL,LX1,NMIX1,IMIX,ICODE,ISPH,
+ CALL BRERT(IPMAC1,IELEM,ICOL,NG,NL,LX1,NMIX1,IMIX,ICODE,ISPH,IH,
1 IDIFF,ZKEFF,B2,ENER,XXX1,VOL1,FLX1,DC1,TOT1,CHI1,SIGF1,SCAT1,
- 2 JXM,JXP,FHETXM,FHETXP,ADF1,NGET,ADFREF,IPRINT)
+ 2 HFACT1,JXM,JXP,FHETXM,FHETXP,ADF1,NGET,ADFREF,IPRINT)
ELSE IF(HMREFL.EQ."ERM-NEM") THEN
- CALL BREERM(IPMAC1,NC,NG,NL,LX1,NMIX1,ITRIAL,IMIX,ICODE,ISPH,
- 1 ZKEFF,B2,ENER,VOL1,FLX1,DC1,TOT1,CHI1,SIGF1,SCAT1,JXM,JXP,
- 2 FHETXM,FHETXP,ADF1,NGET,ADFREF,IPRINT)
+ CALL BREERM(IPMAC1,NC,NG,NL,LX1,NMIX1,ITRIAL,IMIX,ICODE,ISPH,IH,
+ 1 ZKEFF,B2,ENER,VOL1,FLX1,DC1,TOT1,CHI1,SIGF1,SCAT1,HFACT1,JXM,
+ 2 JXP,FHETXM,FHETXP,ADF1,NGET,ADFREF,IPRINT)
ELSE IF(HMREFL.EQ."ERM-ANM") THEN
- CALL BREERA(IPMAC1,NC,NG,NL,LX1,NMIX1,IMIX,ICODE,ISPH,ZKEFF,B2,
- 1 ENER,XXX1,VOL1,FLX1,DC1,TOT1,CHI1,SIGF1,SCAT1,JXM,JXP,FHETXM,
- 2 FHETXP,ADF1,NGET,ADFREF,IPRINT)
+ CALL BREERA(IPMAC1,NC,NG,NL,LX1,NMIX1,IMIX,ICODE,ISPH,IH,ZKEFF,
+ 1 B2,ENER,XXX1,VOL1,FLX1,DC1,TOT1,CHI1,SIGF1,SCAT1,HFACT1,JXM,JXP,
+ 2 FHETXM,FHETXP,ADF1,NGET,ADFREF,IPRINT)
ELSE IF(HMREFL.EQ."LEFEBVRE-LEB") THEN
IF(NC.NE.2) CALL XABORT('BREDRV: NC=2 EXPECTED.')
- CALL BRELLB(IPMAC1,NC,NG,NL,NMIX1,ENER,JXM,FHETXM,IPRINT)
+ CALL BRELLB(IPMAC1,NC,NG,NL,NMIX1,IH,ENER,HFACT1,JXM,FHETXM,
+ 1 IPRINT)
ELSE IF(HMREFL.EQ."KOEBKE") THEN
IF(NC.NE.2) CALL XABORT('BREDRV: NC=2 EXPECTED.')
- CALL BREKOE(IPMAC1,NC,NG,NL,NMIX1,ISPH,B2,ENER,DC1,TOT1,SCAT1,
- 1 JXM,FHETXM,IPRINT)
+ CALL BREKOE(IPMAC1,NC,NG,NL,NMIX1,ISPH,IH,B2,ENER,DC1,TOT1,
+ 1 SCAT1,HFACT1,JXM,FHETXM,IPRINT)
ELSE
WRITE(HSMG,'(25H BREDRV: REFLECTOR MODEL ,A,12H IS UNKNOWN.)')
1 HMREFL
@@ -299,8 +300,8 @@
*----
* SCRATCH STORAGE DEALLOCATION
*----
- DEALLOCATE(IMIX,B2,ZKEFF,ADF1,FHETXP,FHETXM,JXP,JXM,SCAT1,SIGF1,
- 1 CHI1,TOT1,DC1,FLX1,VOL1)
+ DEALLOCATE(IMIX,B2,ZKEFF,ADF1,FHETXP,FHETXM,JXP,JXM,HFACT1,SCAT1,
+ 1 SIGF1,CHI1,TOT1,DC1,FLX1,VOL1)
DEALLOCATE(XXX1,XXXS,IMIXS,ENER,IHOM)
DEALLOCATE(IPMAC2)
RETURN
diff --git a/Dragon/src/BREERA.f b/Dragon/src/BREERA.f
index 336032f..0aedba7 100644
--- a/Dragon/src/BREERA.f
+++ b/Dragon/src/BREERA.f
@@ -1,7 +1,7 @@
*DECK BREERA
- SUBROUTINE BREERA(IPMAC1,NC,NG,NL,LX1,NMIX1,IMIX,ICODE,ISPH,ZKEFF,
- 1 B2,ENER,XXX1,VOL1,FLX1,DC1,TOT1,CHI1,SIGF1,SCAT1,JXM,JXP,FHETXM,
- 2 FHETXP,ADF1,NGET,ADFREF,IPRINT)
+ SUBROUTINE BREERA(IPMAC1,NC,NG,NL,LX1,NMIX1,IMIX,ICODE,ISPH,IH,
+ 1 ZKEFF,B2,ENER,XXX1,VOL1,FLX1,DC1,TOT1,CHI1,SIGF1,SCAT1,HFACT1,
+ 2 JXM,JXP,FHETXM,FHETXP,ADF1,NGET,ADFREF,IPRINT)
*
*-----------------------------------------------------------------------
*
@@ -28,6 +28,7 @@
* IMIX mix index of each node.
* ICODE physical albedo index on each side of the domain.
* ISPH SPH flag (=0: use discontinuity factors; =1: use SPH factors).
+* IH H-FACTOR flag (=0: not used; =1: recovered).
* ZKEFF effective multiplication factor.
* B2 buckling.
* ENER energy limits.
@@ -39,6 +40,7 @@
* CHI1 fission spectra.
* SIGF1 nu*fission cross sections.
* SCAT1 scattering P0 cross sections.
+* HFACT1 H-FACTOR values.
* JXM left boundary currents.
* JXP right boundary currents.
* FHETXM left boundary fluxes.
@@ -57,12 +59,13 @@
* SUBROUTINE ARGUMENTS
*----
TYPE(C_PTR) IPMAC1
- INTEGER NC,NG,NL,LX1,NMIX1,IMIX(LX1),ICODE(2),ISPH,NGET,IPRINT
+ INTEGER NC,NG,NL,LX1,NMIX1,IMIX(LX1),ICODE(2),ISPH,IH,NGET,IPRINT
REAL ZKEFF(NC),B2(NC),ENER(NG+1),XXX1(LX1+1),VOL1(NMIX1,NC),
1 FLX1(NMIX1,NG,NC),DC1(NMIX1,NG,NC),TOT1(NMIX1,NG,NL,NC),
2 CHI1(NMIX1,NG,NC),SIGF1(NMIX1,NG,NC),SCAT1(NMIX1,NG,NG,NL,NC),
- 3 JXM(NMIX1,NG,NC),JXP(NMIX1,NG,NC),FHETXM(NMIX1,NG,NL,NC),
- 4 FHETXP(NMIX1,NG,NL,NC),ADF1(NMIX1,NG,NC),ADFREF(NG)
+ 3 HFACT1(NMIX1,NG,NC),JXM(NMIX1,NG,NC),JXP(NMIX1,NG,NC),
+ 4 FHETXM(NMIX1,NG,NL,NC),FHETXP(NMIX1,NG,NL,NC),ADF1(NMIX1,NG,NC),
+ 5 ADFREF(NG)
*----
* LOCAL VARIABLES
*----
@@ -76,7 +79,7 @@
INTEGER, ALLOCATABLE, DIMENSION(:) :: IJJ,NJJ,IPOS
REAL, ALLOCATABLE, DIMENSION(:) :: WORK1D,WORK1,WORK2,WORK4,WORK5,
1 VOLTOT
- REAL, ALLOCATABLE, DIMENSION(:,:) :: FLX,DC,TOT,CHI,SIGF,
+ REAL, ALLOCATABLE, DIMENSION(:,:) :: FLX,DC,TOT,CHI,SIGF,HFACT,
1 ADF,AFACTOR,BETA,WORK3
REAL, ALLOCATABLE, DIMENSION(:,:,:) ::FDXM,FDXP,SCAT
REAL(KIND=8), ALLOCATABLE, DIMENSION(:) :: TAU,B,X
@@ -87,7 +90,8 @@
*----
ALLOCATE(WORK1(NG),WORK2(NG),WORK4(NG),WORK5(NG),VOLTOT(NMIX1),
1 FLX(NMIX1,NG),DC(NMIX1,NG),TOT(NMIX1,NG),CHI(NMIX1,NG),
- 1 SIGF(NMIX1,NG),ADF(NMIX1,NG),AFACTOR(NG,NG),BETA(NG,NG))
+ 1 SIGF(NMIX1,NG),HFACT(NMIX1,NG),ADF(NMIX1,NG),AFACTOR(NG,NG),
+ 2 BETA(NG,NG))
ALLOCATE(FDXM(NMIX1,NG,NG),FDXP(NMIX1,NG,NG),SCAT(NMIX1,NG,NG),
1 WORK3(NG,NG))
ALLOCATE(FHOMM(NC,NG,NMIX1),FHOMP(NC,NG,NMIX1),L(NG,2*NG,LX1),
@@ -102,6 +106,7 @@
CHI(:,:)=0.0
SIGF(:,:)=0.0
SCAT(:,:,:)=0.0
+ HFACT(:,:)=0.0
ADF(:,:)=0.0
FHOMM(:NC,:NG,:NMIX1)=0.0D0
FHOMP(:NC,:NG,:NMIX1)=0.0D0
@@ -117,6 +122,7 @@
DO JGR=1,NG
SCAT(IBM,IGR,JGR)=SCAT(IBM,IGR,JGR)+SCAT1(IBM,IGR,JGR,1,IC)
ENDDO
+ IF(IH.EQ.1) HFACT(IBM,IGR)=HFACT(IBM,IGR)+HFACT1(IBM,IGR,IC)
ADF(IBM,IGR)=ADF(IBM,IGR)+ADF1(IBM,IGR,IC)
ENDDO
ENDDO
@@ -128,6 +134,7 @@
CHI(:,:)=CHI(:,:)/REAL(NC)
SIGF(:,:)=SIGF(:,:)/REAL(NC)
SCAT(:,:,:)=SCAT(:,:,:)/REAL(NC)
+ IF(IH.EQ.1) HFACT(:,:)=HFACT(:,:)/REAL(NC)
ADF(:,:)=ADF(:,:)/REAL(NC)
*----
* LOOP OVER CASES
@@ -430,14 +437,15 @@
CALL LCMPUT(KPMAC1,'NJJS00',NMIX1,1,NJJ)
CALL LCMPUT(KPMAC1,'IJJS00',NMIX1,1,IJJ)
CALL LCMPUT(KPMAC1,'IPOS00',NMIX1,1,IPOS)
+ IF(IH.EQ.1) CALL LCMPUT(KPMAC1,'H-FACTOR',NMIX1,2,HFACT(:,IGR))
ENDDO
*----
* SCRATCH STORAGE DEALLOCATION
*----
DEALLOCATE(R,L,FHOMP,FHOMM)
DEALLOCATE(SCAT,FDXP,FDXM)
- DEALLOCATE(WORK3,BETA,AFACTOR,ADF,SIGF,CHI,TOT,DC,FLX,VOLTOT,
- 1 WORK5,WORK4,WORK2,WORK1)
+ DEALLOCATE(WORK3,BETA,AFACTOR,ADF,HFACT,SIGF,CHI,TOT,DC,FLX,
+ 1 VOLTOT,WORK5,WORK4,WORK2,WORK1)
RETURN
20 FORMAT(1X,A9,1P,10E12.4,/(10X,10E12.4))
END
diff --git a/Dragon/src/BREERM.f b/Dragon/src/BREERM.f
index b2d146b..1b59f86 100644
--- a/Dragon/src/BREERM.f
+++ b/Dragon/src/BREERM.f
@@ -1,7 +1,7 @@
*DECK BREERM
SUBROUTINE BREERM(IPMAC1,NC,NG,NL,LX1,NMIX1,ITRIAL,IMIX,ICODE,
- 1 ISPH,ZKEFF,B2,ENER,VOL1,FLX1,DC1,TOT1,CHI1,SIGF1,SCAT1,JXM,JXP,
- 2 FHETXM,FHETXP,ADF1,NGET,ADFREF,IPRINT)
+ 1 ISPH,IH,ZKEFF,B2,ENER,VOL1,FLX1,DC1,TOT1,CHI1,SIGF1,SCAT1,
+ 2 HFACT1,JXM,JXP,FHETXM,FHETXP,ADF1,NGET,ADFREF,IPRINT)
*
*-----------------------------------------------------------------------
*
@@ -30,6 +30,7 @@
* IMIX mix index of each node.
* ICODE physical albedo index on each side of the domain.
* ISPH SPH flag (=0: use discontinuity factors; =1: use SPH factors).
+* IH H-FACTOR flag (=0: not used; =1: recovered).
* ZKEFF effective multiplication factor.
* B2 buckling.
* ENER energy limits.
@@ -40,6 +41,7 @@
* CHI1 fission spectra.
* SIGF1 nu*fission cross sections.
* SCAT1 scattering P0 cross sections.
+* HFACT1 H-FACTOR values.
* JXM left boundary currents.
* JXP right boundary currents.
* FHETXM left boundary fluxes.
@@ -58,13 +60,13 @@
* SUBROUTINE ARGUMENTS
*----
TYPE(C_PTR) IPMAC1
- INTEGER NC,NG,NL,LX1,NMIX1,ITRIAL(NG),IMIX(LX1),ICODE(2),ISPH,
+ INTEGER NC,NG,NL,LX1,NMIX1,ITRIAL(NG),IMIX(LX1),ICODE(2),ISPH,IH,
1 NGET,IPRINT
REAL ZKEFF(NC),B2(NC),ENER(NG+1),VOL1(NMIX1,NC),FLX1(NMIX1,NG,NC),
1 DC1(NMIX1,NG,NC),TOT1(NMIX1,NG,NL,NC),CHI1(NMIX1,NG,NC),
- 2 SIGF1(NMIX1,NG,NC),SCAT1(NMIX1,NG,NG,NL,NC),JXM(NMIX1,NG,NC),
- 3 JXP(NMIX1,NG,NC),FHETXM(NMIX1,NG,NL,NC),FHETXP(NMIX1,NG,NL,NC),
- 4 ADF1(NMIX1,NG,NC),ADFREF(NG)
+ 2 SIGF1(NMIX1,NG,NC),SCAT1(NMIX1,NG,NG,NL,NC),HFACT1(NMIX1,NG,NC),
+ 3 JXM(NMIX1,NG,NC),JXP(NMIX1,NG,NC),FHETXM(NMIX1,NG,NL,NC),
+ 4 FHETXP(NMIX1,NG,NL,NC),ADF1(NMIX1,NG,NC),ADFREF(NG)
*----
* LOCAL VARIABLES
*----
@@ -80,7 +82,7 @@
INTEGER, ALLOCATABLE, DIMENSION(:) :: IJJ,NJJ,IPOS
REAL, ALLOCATABLE, DIMENSION(:) :: WORK,ETA,VOL
REAL, ALLOCATABLE, DIMENSION(:,:) :: AB,ALPHA,FLX,DC,TOT,CHI,SIGF,
- 1 ADF,AFACTOR,BETA
+ 1 HFACT,ADF,AFACTOR,BETA
REAL, ALLOCATABLE, DIMENSION(:,:,:) :: FDXM,FDXP,SCAT
REAL(KIND=8), ALLOCATABLE, DIMENSION(:) :: TAU,B,X
REAL(KIND=8), ALLOCATABLE, DIMENSION(:,:) :: WORK2
@@ -91,7 +93,8 @@
ALLOCATE(ETA(NG),ALPHA(5,NG),FDXM(NMIX1,NG,NG),FDXP(NMIX1,NG,NG),
1 AFACTOR(NG,NG),BETA(NG,NG),FHOMM(NC,NG,NMIX1),FHOMP(NC,NG,NMIX1))
ALLOCATE(VOL(NMIX1),FLX(NMIX1,NG),DC(NMIX1,NG),TOT(NMIX1,NG),
- 1 CHI(NMIX1,NG),SIGF(NMIX1,NG),SCAT(NMIX1,NG,NG),ADF(NMIX1,NG))
+ 1 CHI(NMIX1,NG),SIGF(NMIX1,NG),SCAT(NMIX1,NG,NG),HFACT(NMIX1,NG),
+ 2 ADF(NMIX1,NG))
*----
* AVERAGE THE OUTPUT NODAL MACROLIB
*----
@@ -102,6 +105,7 @@
CHI(:,:)=0.0
SIGF(:,:)=0.0
SCAT(:,:,:)=0.0
+ HFACT(:,:)=0.0
ADF(:,:)=0.0
DO IC=1,NC
DO IBM=1,NMIX1
@@ -115,6 +119,7 @@
DO JGR=1,NG
SCAT(IBM,IGR,JGR)=SCAT(IBM,IGR,JGR)+SCAT1(IBM,IGR,JGR,1,IC)
ENDDO
+ IF(IH.EQ.1) HFACT(IBM,IGR)=HFACT(IBM,IGR)+HFACT1(IBM,IGR,IC)
ADF(IBM,IGR)=ADF(IBM,IGR)+ADF1(IBM,IGR,IC)
ENDDO
ENDDO
@@ -126,6 +131,7 @@
CHI(:,:)=CHI(:,:)/REAL(NC)
SIGF(:,:)=SIGF(:,:)/REAL(NC)
SCAT(:,:,:)=SCAT(:,:,:)/REAL(NC)
+ IF(IH.EQ.1) HFACT(:,:)=HFACT(:,:)/REAL(NC)
ADF(:,:)=ADF(:,:)/REAL(NC)
*----
* LOOP OVER CASES
@@ -512,11 +518,13 @@
CALL LCMPUT(KPMAC1,'NJJS00',NMIX1,1,NJJ)
CALL LCMPUT(KPMAC1,'IJJS00',NMIX1,1,IJJ)
CALL LCMPUT(KPMAC1,'IPOS00',NMIX1,1,IPOS)
+ IF(IH.EQ.1) CALL LCMPUT(KPMAC1,'H-FACTOR',NMIX1,2,HFACT(:,IGR))
ENDDO
*----
* SCRATCH STORAGE DEALLOCATION
*----
- DEALLOCATE(WORK,IPOS,NJJ,IJJ,ADF,SCAT,SIGF,CHI,TOT,DC,FLX,VOL)
+ DEALLOCATE(WORK,IPOS,NJJ,IJJ,ADF,HFACT,SCAT,SIGF,CHI,TOT,DC,FLX,
+ 1 VOL)
DEALLOCATE(FHOMP,FHOMM,BETA,AFACTOR,FDXP,FDXM,ALPHA,ETA)
RETURN
20 FORMAT(1X,A9,1P,10E12.4,/(10X,10E12.4))
diff --git a/Dragon/src/BREKOE.f b/Dragon/src/BREKOE.f
index d98ca1f..855bec2 100644
--- a/Dragon/src/BREKOE.f
+++ b/Dragon/src/BREKOE.f
@@ -1,6 +1,6 @@
*DECK BREKOE
- SUBROUTINE BREKOE(IPMAC1,NC,NG,NL,NMIX1,ISPH,B2,ENER,DC1,TOT1,
- 1 SCAT1,JXM,FHETXM,IPRINT)
+ SUBROUTINE BREKOE(IPMAC1,NC,NG,NL,NMIX1,ISPH,IH,B2,ENER,DC1,TOT1,
+ 1 SCAT1,HFACT1,JXM,FHETXM,IPRINT)
*
*-----------------------------------------------------------------------
*
@@ -24,10 +24,12 @@
* scattering in LAB).
* NMIX1 number of mixtures in the nodal calculation.
* ISPH SPH flag (=0: use discontinuity factors; =1: use SPH factors).
+* IH H-FACTOR flag (=0: not used; =1: recovered).
* B2 buckling.
* ENER energy limits.
* TOT1 total cross sections.
* SCAT1 scattering P0 cross sections.
+* HFACT1 H-FACTOR values.
* JXM left boundary currents.
* FHETXM left boundary fluxes.
* IPRINT edition flag.
@@ -39,9 +41,10 @@
* SUBROUTINE ARGUMENTS
*----
TYPE(C_PTR) IPMAC1
- INTEGER NC,NG,NL,NMIX1,ISPH,IPRINT
+ INTEGER NC,NG,NL,NMIX1,ISPH,IH,IPRINT
REAL B2(NC),ENER(NG+1),DC1(NMIX1,NG,NC),TOT1(NMIX1,NG,NL,NC),
- 1 SCAT1(NMIX1,NG,NG,NL,NC),JXM(NMIX1,NG,NC),FHETXM(NMIX1,NG,NL,NC)
+ 1 SCAT1(NMIX1,NG,NG,NL,NC),HFACT1(NMIX1,NG,NC),JXM(NMIX1,NG,NC),
+ 2 FHETXM(NMIX1,NG,NL,NC)
*----
* LOCAL VARIABLES
*----
@@ -192,6 +195,10 @@
CALL LCMPUT(KPMAC1,'NJJS00',NMIX1,1,NJJ)
CALL LCMPUT(KPMAC1,'IJJS00',NMIX1,1,IJJ)
CALL LCMPUT(KPMAC1,'IPOS00',NMIX1,1,IPOS)
+ IF(IH.EQ.1) THEN
+ WORK(1)=0.5*(HFACT1(IBM,IGR,1)+HFACT1(IBM,IGR,2))
+ CALL LCMPUT(KPMAC1,'H-FACTOR',NMIX1,2,WORK)
+ ENDIF
ENDDO
*----
* SCRATCH STORAGE DEALLOCATION
diff --git a/Dragon/src/BRELLB.f b/Dragon/src/BRELLB.f
index 205a994..e8ebcd1 100644
--- a/Dragon/src/BRELLB.f
+++ b/Dragon/src/BRELLB.f
@@ -1,5 +1,6 @@
*DECK BRELLB
- SUBROUTINE BRELLB(IPMAC1,NC,NG,NL,NMIX1,ENER,JXM,FHETXM,IPRINT)
+ SUBROUTINE BRELLB(IPMAC1,NC,NG,NL,NMIX1,IH,ENER,HFACT1,JXM,
+ 1 FHETXM,IPRINT)
*
*-----------------------------------------------------------------------
*
@@ -22,7 +23,9 @@
* NL Legendre order of TOT1 and SCAT1 arrays (=1 for isotropic
* scattering in LAB).
* NMIX1 number of mixtures in the nodal calculation.
+* IH H-FACTOR flag (=0: not used; =1: recovered).
* ENER energy limits.
+* HFACT1 H-FACTOR values.
* JXM left boundary currents.
* FHETXM left boundary fluxes.
* IPRINT edition flag.
@@ -38,8 +41,9 @@
* SUBROUTINE ARGUMENTS
*----
TYPE(C_PTR) IPMAC1
- INTEGER NC,NG,NL,NMIX1,IPRINT
- REAL ENER(NG+1),JXM(NMIX1,NG,NC),FHETXM(NMIX1,NG,NL,NC)
+ INTEGER NC,NG,NL,NMIX1,IH,IPRINT
+ REAL ENER(NG+1),HFACT1(NMIX1,NG,NC),JXM(NMIX1,NG,NC),
+ 1 FHETXM(NMIX1,NG,NL,NC)
*----
* LOCAL VARIABLES
*----
@@ -145,6 +149,10 @@
CALL LCMPUT(KPMAC1,'NJJS00',NMIX1,1,NJJ)
CALL LCMPUT(KPMAC1,'IJJS00',NMIX1,1,IJJ)
CALL LCMPUT(KPMAC1,'IPOS00',NMIX1,1,IPOS)
+ IF(IH.EQ.1) THEN
+ WORK(1)=0.5*(HFACT1(IBM,IGR,1)+HFACT1(IBM,IGR,2))
+ CALL LCMPUT(KPMAC1,'H-FACTOR',NMIX1,2,WORK)
+ ENDIF
ENDDO
*----
* SCRATCH STORAGE DEALLOCATION
diff --git a/Dragon/src/BREMAC.f b/Dragon/src/BREMAC.f
index eaba3e9..d742354 100644
--- a/Dragon/src/BREMAC.f
+++ b/Dragon/src/BREMAC.f
@@ -1,7 +1,7 @@
*DECK BREMAC
SUBROUTINE BREMAC(NC,IPMAC2,NG,NL,LX1,NMIX1,NMIX2,IMIX,IMIX1,
- 1 IGAP,ILEAKS,IDF,IPRINT,ZKEFF,B2,VOL1,FLX1,DC1,TOT1,CHI1,SIGF1,
- 2 SCAT1,JXM,JXP,FHETXM,FHETXP,ADF1)
+ 1 IGAP,ILEAKS,IDF,IPRINT,IH,ZKEFF,B2,VOL1,FLX1,DC1,TOT1,CHI1,
+ 2 SIGF1,SCAT1,HFACT1,JXM,JXP,FHETXM,FHETXP,ADF1)
*
*-----------------------------------------------------------------------
*
@@ -36,6 +36,7 @@
* IPRINT print parameter
*
*Parameters: output
+* IH H-FACTOR flag (=0: not used; =1: recovered).
* ZKEFF effective multiplication factor.
* B2 buckling.
* VOL1 volumes.
@@ -45,6 +46,7 @@
* CHI1 fission spectra.
* SIGF1 nu*fission cross sections.
* SCAT1 scattering cross sections.
+* HFACT1 H-FACTOR values.
* JXM left boundary currents.
* JXP right boundary currents.
* FHETXM left boundary fluxes.
@@ -60,12 +62,12 @@
INTEGER NC
TYPE(C_PTR) IPMAC2(NC)
INTEGER NG,NL,LX1,NMIX1,NMIX2,IMIX(LX1),IMIX1(LX1),IGAP(LX1),
- 1 ILEAKS,IDF,IPRINT
+ 1 ILEAKS,IDF,IPRINT,IH
REAL ZKEFF(NC),B2(NC),VOL1(NMIX1,NC),FLX1(NMIX1,NG,NC),
1 DC1(NMIX1,NG,NC),TOT1(NMIX1,NG,NL,NC),CHI1(NMIX1,NG,NC),
- 2 SIGF1(NMIX1,NG,NC),SCAT1(NMIX1,NG,NG,NL,NC),JXM(NMIX1,NG,NC),
- 3 JXP(NMIX1,NG,NC),FHETXM(NMIX1,NG,NL,NC),FHETXP(NMIX1,NG,NL,NC),
- 4 ADF1(NMIX1,NG,NC)
+ 2 SIGF1(NMIX1,NG,NC),SCAT1(NMIX1,NG,NG,NL,NC),HFACT1(NMIX1,NG,NC),
+ 3 JXM(NMIX1,NG,NC),JXP(NMIX1,NG,NC),FHETXM(NMIX1,NG,NL,NC),
+ 4 FHETXP(NMIX1,NG,NL,NC),ADF1(NMIX1,NG,NC)
*----
* LOCAL VARIABLES
*----
@@ -77,7 +79,7 @@
*----
INTEGER, ALLOCATABLE, DIMENSION(:) :: IJJ,NJJ,IPOS,IMIX2
REAL, ALLOCATABLE, DIMENSION(:) :: VOL,WORK,SFIS,SFIS1
- REAL, ALLOCATABLE, DIMENSION(:,:) :: DC,CHI,SIGF
+ REAL, ALLOCATABLE, DIMENSION(:,:) :: DC,CHI,SIGF,HFACT
REAL, ALLOCATABLE, DIMENSION(:,:,:) :: FLX,TOT
REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: SCAT
DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: DCOU
@@ -86,7 +88,8 @@
*----
ALLOCATE(VOL(NMIX2),FLX(NMIX2,NG,NL),TOT(NMIX2,NG,NL),
1 DC(NMIX2,NG),CHI(NMIX2,NG),SIGF(NMIX2,NG),SCAT(NMIX2,NG,NG,NL),
- 2 IMIX2(NMIX2),SFIS(NMIX2),SFIS1(NMIX1),DCOU(NMIX2+1,NG))
+ 2 HFACT(NMIX2,NG),IMIX2(NMIX2),SFIS(NMIX2),SFIS1(NMIX1),
+ 3 DCOU(NMIX2+1,NG))
ALLOCATE(IJJ(NMIX2),NJJ(NMIX2),IPOS(NMIX2),WORK(NG*NMIX2))
*----
* SET IMIX2
@@ -111,11 +114,12 @@
CALL LCMGET(IPMAC2(IC),'K-EFFECTIVE',ZKEFF(IC))
B2(IC)=0.0
IF(ILEAKS.GT.0) THEN
- CALL LCMLEN(IPMAC2(IC),'B2 B1HOM',ILONG,ITYLCM)
- IF(ILONG.EQ.1) CALL LCMGET(IPMAC2(IC),'B2 B1HOM',B2(IC))
+ CALL LCMLEN(IPMAC2(IC),'B2 B1HOM',ILCMLN,ITYLCM)
+ IF(ILCMLN.EQ.1) CALL LCMGET(IPMAC2(IC),'B2 B1HOM',B2(IC))
ENDIF
JPMAC2=LCMGID(IPMAC2(IC),'GROUP')
SCAT(:,:,:,:)=0.0
+ IH=0
DO IGR=1,NG
KPMAC2=LCMGIL(JPMAC2,IGR)
CALL LCMGET(KPMAC2,'FLUX-INTG',FLX(1,IGR,1))
@@ -155,8 +159,8 @@
CALL LCMGET(KPMAC2,'NUSIGF',SIGF(1,IGR))
DO IL=1,NL
WRITE(CM,'(I2.2)') IL-1
- CALL LCMLEN(KPMAC2,'IJJS'//CM,ILONG,ITYLCM)
- IF(ILONG.EQ.0) CYCLE
+ CALL LCMLEN(KPMAC2,'IJJS'//CM,ILCMLN,ITYLCM)
+ IF(ILCMLN.EQ.0) CYCLE
CALL LCMGET(KPMAC2,'IJJS'//CM,IJJ)
CALL LCMGET(KPMAC2,'NJJS'//CM,NJJ)
CALL LCMGET(KPMAC2,'IPOS'//CM,IPOS)
@@ -169,6 +173,11 @@
ENDDO
ENDDO
ENDDO
+ CALL LCMLEN(KPMAC2,'H-FACTOR',ILCMLN,ITYLCM)
+ IF(ILCMLN.GT.0) THEN
+ IH=1
+ CALL LCMGET(KPMAC2,'H-FACTOR',HFACT(1,IGR))
+ ENDIF
DO IBM=1,NMIX2
FLX(IBM,IGR,:NL)=FLX(IBM,IGR,:NL)/VOL(IBM)
ENDDO
@@ -220,6 +229,7 @@
SIGF1(:,:,IC)=0.0
CHI1(:,:,IC)=0.0
SCAT1(:,:,:,:,IC)=0.0
+ HFACT1(:,:,IC)=0.0
DO IL=1,NL,2
FHETXM(:,:,IL,IC)=1.0
FHETXP(:,:,IL,IC)=1.0
@@ -278,6 +288,10 @@
1 VOL(IBM2)*FLX(IBM2,JGR,1)*SCAT(IBM2,IGR,JGR,IL)
ENDDO
ENDDO
+ IF(IH.EQ.1) THEN
+ HFACT1(IBM,IGR,IC)=HFACT1(IBM,IGR,IC)+VOL(IBM2)*
+ 1 FLX(IBM2,IGR,1)*HFACT(IBM2,IGR)
+ ENDIF
ENDDO
ENDDO
DO IBM=1,NMIX1
@@ -295,6 +309,9 @@
1 FLX1(IBM,JGR,IC)
ENDDO
ENDDO
+ IF(IH.EQ.1) THEN
+ HFACT1(IBM,IGR,IC)=HFACT1(IBM,IGR,IC)/FLX1(IBM,IGR,IC)
+ ENDIF
ENDDO
DO IGR=1,NG
FLX1(IBM,IGR,IC)=FLX1(IBM,IGR,IC)/VOL1(IBM,IC)
@@ -309,8 +326,8 @@
CALL LCMLEN(IPMAC2(IC),'HADF',NTYPE,ITYLCM)
IF(NTYPE/2.NE.1) CALL XABORT('BREMAC: NTYPE=1 EXPECTED.')
CALL LCMGTC(IPMAC2(IC),'HADF',8,HADF)
- CALL LCMLEN(IPMAC2(IC),HADF,ILONG,ITYLCM)
- IF(ILONG.NE.NMIX1*NG) CALL XABORT('BREMAC: ADF OVERFLOW.')
+ CALL LCMLEN(IPMAC2(IC),HADF,ILCMLN,ITYLCM)
+ IF(ILCMLN.NE.NMIX1*NG) CALL XABORT('BREMAC: ADF OVERFLOW.')
CALL LCMGET(IPMAC2(IC),HADF,ADF1(1,1,IC))
ENDIF
*----
@@ -332,6 +349,7 @@
WRITE(6,20) 'DC1',DC1(:,IGR,IC)
WRITE(6,20) 'CHI1',CHI1(:,IGR,IC)
WRITE(6,20) 'SIGF1',SIGF1(:,IGR,IC)
+ IF(IH.EQ.1) WRITE(6,20) 'H-FACTOR',HFACT1(:,IGR,IC)
DO JGR=1,NG
IF(IGR.EQ.JGR) THEN
WRITE(6,20) 'INSCAT1-P0',SCAT1(:,IGR,IGR,1,IC)
@@ -360,8 +378,8 @@
*----
* SCRATCH STORAGE DEALLOCATION
*----
- DEALLOCATE(WORK,IPOS,NJJ,IJJ,DCOU,SFIS1,SFIS,IMIX2,SCAT,SIGF,CHI,
- 1 DC,TOT,FLX,VOL)
+ DEALLOCATE(WORK,IPOS,NJJ,IJJ,DCOU,SFIS1,SFIS,IMIX2,HFACT,SCAT,
+ 1 SIGF,CHI,DC,TOT,FLX,VOL)
RETURN
*
10 FORMAT(1X,A12,10I13/(12X,10I13))
diff --git a/Dragon/src/BRENEM.f b/Dragon/src/BRENEM.f
index 862ea80..defd511 100644
--- a/Dragon/src/BRENEM.f
+++ b/Dragon/src/BRENEM.f
@@ -1,7 +1,7 @@
*DECK BRENEM
- SUBROUTINE BRENEM(IPMAC1,NG,LX1,NMIX1,ITRIAL,IMIX,ICODE,ISPH,
- 1 ZKEFF,B2,ENER,VOL1,FLX1,DC1,TOT1,CHI1,SIGF1,SCAT1,JXM,JXP,FHETXM,
- 2 FHETXP,ADF1,NGET,ADFREF,IPRINT)
+ SUBROUTINE BRENEM(IPMAC1,NG,LX1,NMIX1,ITRIAL,IMIX,ICODE,ISPH,IH,
+ 1 ZKEFF,B2,ENER,VOL1,FLX1,DC1,TOT1,CHI1,SIGF1,SCAT1,HFACT1,JXM,
+ 2 JXP,FHETXM,FHETXP,ADF1,NGET,ADFREF,IPRINT)
*
*-----------------------------------------------------------------------
*
@@ -37,6 +37,7 @@
* CHI1 fission spectra.
* SIGF1 nu*fission cross sections.
* SCAT1 scattering P0 cross sections.
+* HFACT1 H-FACTOR values.
* JXM left boundary currents.
* JXP right boundary currents.
* FHETXM left boundary fluxes.
@@ -59,8 +60,8 @@
1 IPRINT
REAL ZKEFF,B2,ENER(NG+1),VOL1(NMIX1),FLX1(NMIX1,NG),DC1(NMIX1,NG),
1 TOT1(NMIX1,NG),CHI1(NMIX1,NG),SIGF1(NMIX1,NG),
- 2 SCAT1(NMIX1,NG,NG),JXM(NMIX1,NG),JXP(NMIX1,NG),FHETXM(NMIX1,NG),
- 3 FHETXP(NMIX1,NG),ADF1(NMIX1,NG),ADFREF(NG)
+ 2 SCAT1(NMIX1,NG,NG),HFACT1(NMIX1,NG),JXM(NMIX1,NG),JXP(NMIX1,NG),
+ 3 FHETXM(NMIX1,NG),FHETXP(NMIX1,NG),ADF1(NMIX1,NG),ADFREF(NG)
*----
* LOCAL VARIABLES
*----
@@ -241,6 +242,9 @@
DO JGR=1,NG
SCAT1(IBM,IGR,JGR)=SCAT1(IBM,IGR,JGR)/FDXM(IBM,JGR)
ENDDO
+ IF(IH.EQ.1) THEN
+ HFACT1(IBM,IGR)=HFACT1(IBM,IGR)/FDXM(IBM,IGR)
+ ENDIF
ENDDO
ENDDO
IF(ICODE(2).NE.0) THEN
@@ -347,6 +351,7 @@
CALL LCMPUT(KPMAC1,'NJJS00',NMIX1,1,NJJ)
CALL LCMPUT(KPMAC1,'IJJS00',NMIX1,1,IJJ)
CALL LCMPUT(KPMAC1,'IPOS00',NMIX1,1,IPOS)
+ IF(IH.EQ.1) CALL LCMPUT(KPMAC1,'H-FACTOR',NMIX1,2,HFACT1(:,IGR))
ENDDO
*----
* SCRATCH STORAGE DEALLOCATION
diff --git a/Dragon/src/BRERT.f b/Dragon/src/BRERT.f
index 19afde9..91e2b8b 100644
--- a/Dragon/src/BRERT.f
+++ b/Dragon/src/BRERT.f
@@ -1,7 +1,7 @@
*DECK BRERT
SUBROUTINE BRERT(IPMAC1,IELEM,ICOL,NG,NL,LX1,NMIX1,IMIX,ICODE,
- 1 ISPH,IDIFF,ZKEFF,B2,ENER,XXX1,VOL1,FLX1,DC1,TOT1,CHI1,SIGF1,
- 2 SCAT1,JXM,JXP,FHETXM,FHETXP,ADF1,NGET,ADFREF,IMPX)
+ 1 ISPH,IH,IDIFF,ZKEFF,B2,ENER,XXX1,VOL1,FLX1,DC1,TOT1,CHI1,SIGF1,
+ 2 SCAT1,HFACT1,JXM,JXP,FHETXM,FHETXP,ADF1,NGET,ADFREF,IMPX)
*
*-----------------------------------------------------------------------
*
@@ -30,6 +30,7 @@
* IMIX mix index of each node.
* ICODE physical albedo index on each side of the domain.
* ISPH SPH flag (=0: use discontinuity factors; =1: use SPH factors).
+* IH H-FACTOR flag (=0: not used; =1: recovered).
* IDIFF PN calculation option (=0: diffusion theory; =1: SPN theory
* with 'NTOT1'; =2: SPN theory with 1/(3*D)).
* ZKEFF effective multiplication factor.
@@ -43,6 +44,7 @@
* CHI1 fission spectra.
* SIGF1 nu*fission cross sections.
* SCAT1 scattering P0 cross sections.
+* HFACT1 H-FACTOR values.
* JXM left boundary currents.
* JXP right boundary currents.
* FHETXM left boundary fluxes.
@@ -61,12 +63,13 @@
* SUBROUTINE ARGUMENTS
*----
TYPE(C_PTR) IPMAC1
- INTEGER IELEM,ICOL,NG,NL,LX1,NMIX1,IMIX(LX1),ICODE(2),ISPH,IDIFF,
- 1 NGET,IMPX
+ INTEGER IELEM,ICOL,NG,NL,LX1,NMIX1,IMIX(LX1),ICODE(2),ISPH,IH,
+ 1 IDIFF,NGET,IMPX
REAL ZKEFF,B2,ENER(NG+1),XXX1(LX1+1),VOL1(NMIX1),FLX1(NMIX1,NG),
1 DC1(NMIX1,NG),TOT1(NMIX1,NG,NL),CHI1(NMIX1,NG),SIGF1(NMIX1,NG),
- 2 SCAT1(NMIX1,NG,NG,NL),JXM(NMIX1,NG),JXP(NMIX1,NG),
- 3 FHETXM(NMIX1,NG,NL),FHETXP(NMIX1,NG,NL),ADF1(NMIX1,NG),ADFREF(NG)
+ 2 SCAT1(NMIX1,NG,NG,NL),HFACT1(NMIX1,NG),JXM(NMIX1,NG),
+ 3 JXP(NMIX1,NG),FHETXM(NMIX1,NG,NL),FHETXP(NMIX1,NG,NL),
+ 4 ADF1(NMIX1,NG),ADFREF(NG)
*----
* LOCAL VARIABLES
*----
@@ -298,6 +301,9 @@
SCAT1(IBM,IGR,JGR,IL)=SCAT1(IBM,IGR,JGR,IL)*FDXM(IBM,IGR)
ENDDO
ENDDO
+ IF(IH.EQ.1) THEN
+ HFACT1(IBM,IGR)=HFACT1(IBM,IGR)/FDXM(IBM,IGR)
+ ENDIF
ENDDO
ENDDO
IF(ICODE(2).NE.0) THEN
@@ -409,6 +415,7 @@
CALL LCMPUT(KPMAC1,'IJJS'//CM,NMIX1,1,IJJ)
CALL LCMPUT(KPMAC1,'IPOS'//CM,NMIX1,1,IPOS)
ENDDO
+ IF(IH.EQ.1) CALL LCMPUT(KPMAC1,'H-FACTOR',NMIX1,2,HFACT1(:,IGR))
ENDDO
*----
* SCRATCH STORAGE DEALLOCATION
diff --git a/Dragon/src/CPOLGX.f b/Dragon/src/CPOLGX.f
index ac5e44b..db9bf1e 100644
--- a/Dragon/src/CPOLGX.f
+++ b/Dragon/src/CPOLGX.f
@@ -47,7 +47,7 @@
* SUBROUTINE ARGUMENTS
*----
INTEGER NDPROC
- PARAMETER (NDPROC=20)
+ PARAMETER (NDPROC=21)
TYPE(C_PTR) IPLIB
INTEGER IGS,IPRINT,IORD,NGROUP,INDPRO(NDPROC),
> ITYPRO(NDPROC)
@@ -59,22 +59,24 @@
*----
INTEGER IOUT
PARAMETER (IOUT=6)
- CHARACTER NAMDXS(NDPROC)*6,NORD*6,TEXT6*6,TEXT12*12,NAMT*12
+ CHARACTER NAMDXS(NDPROC)*8,NORD*4,TEXT8*8,TEXT12*12,NAMT*12
INTEGER IODIV,LONG,ITYP,IXSR,IXSTN,IG,JG
SAVE NAMDXS
- DATA NAMDXS /'NTOT0 ','TRANC ','NUSIGF','NFTOT ','CHI ',
- > 'NU ','NG ','NHEAT ','N2N ','N3N ',
- > 'N4N ','NP ','NA ','GOLD ','ABS ',
- > 'NWT0 ','STRD ','STRD X','STRD Y','STRD Z'/
+ DATA NAMDXS /'NTOT0 ','TRANC ','NUSIGF ','NFTOT ',
+ > 'CHI ','NU ','NG ','NHEAT ',
+ > 'N2N ','N3N ','N4N ','NP ',
+ > 'NA ','GOLD ','ABS ','NWT0 ',
+ > 'STRD ','STRD X ','STRD Y ','STRD Z ',
+ > 'H-FACTOR'/
IODIV=0
IF(IORD.EQ.1) THEN
- NORD=' '
+ NORD=' '
IODIV=1
ELSE IF(IORD.EQ.2) THEN
- NORD=' LIN'
+ NORD=' LIN'
IODIV=2
ELSE IF(IORD.EQ.3) THEN
- NORD=' QUA'
+ NORD=' QUA'
IODIV=4
ENDIF
*----
@@ -106,8 +108,8 @@
*----
IF(IGS.EQ.1) THEN
DO 100 IXSR=1,NDPROC
- TEXT6=NAMDXS(IXSR)
- IF(IXSR.EQ.1) TEXT6='TOTAL'
+ TEXT8=NAMDXS(IXSR)
+ IF(IXSR.EQ.1) TEXT8='TOTAL'
IF(INDPRO(IXSR).EQ.1) THEN
IXSTN=MOD(ITYPRO(IXSR)/IODIV,2)
*----
@@ -124,7 +126,7 @@
110 CONTINUE
115 CONTINUE
IF((IXSTN.NE.0).OR.(IXSR.EQ.2)) THEN
- CALL LCMPUT(IPLIB,TEXT6//NORD,NGROUP,2,XSREC(1,IXSR))
+ CALL LCMPUT(IPLIB,TEXT8//NORD,NGROUP,2,XSREC(1,IXSR))
ENDIF
ENDIF
100 CONTINUE
@@ -136,8 +138,8 @@
*----
IF(IGS.EQ.-1) THEN
DO 200 IXSR=1,NDPROC
- TEXT6=NAMDXS(IXSR)
- IF(IXSR.EQ.1) TEXT6='NTOT0'
+ TEXT8=NAMDXS(IXSR)
+ IF(IXSR.EQ.1) TEXT8='NTOT0'
IF(INDPRO(IXSR).EQ.1) THEN
IXSTN=MOD(ITYPRO(IXSR)/IODIV,2)
*----
@@ -145,11 +147,11 @@
* INITIALIZE TO 0.0 IF IXSTN = 0
*----
IF(IXSTN.EQ.1) THEN
- CALL LCMLEN(IPLIB,TEXT6//NORD,LONG,ITYP)
+ CALL LCMLEN(IPLIB,TEXT8//NORD,LONG,ITYP)
IF(LONG .EQ. 0) THEN
XSREC(:NGROUP,IXSR)=0.0
ELSE
- CALL LCMGET(IPLIB,TEXT6//NORD,XSREC(1,IXSR))
+ CALL LCMGET(IPLIB,TEXT8//NORD,XSREC(1,IXSR))
ENDIF
ELSE
XSREC(:NGROUP,IXSR)=0.0
diff --git a/Dragon/src/EDIACT.f b/Dragon/src/EDIACT.f
index f45201a..4d824a6 100644
--- a/Dragon/src/EDIACT.f
+++ b/Dragon/src/EDIACT.f
@@ -2,7 +2,7 @@
SUBROUTINE EDIACT(IPEDIT,IPRINT,NGROUP,NGCOND,NREGIO,NMERGE,NL,
> NBISO,NED,VOLUME,MIX,IGCOND,IMERGE,FLUXES,
> ITRANC,ISONAM,IPISO,HVECT,CURNAM,NACTI,IACTI,
- > EMEVF2,EMEVG2)
+ > EMEVF2)
*
*-----------------------------------------------------------------------
*
@@ -43,7 +43,6 @@
* NACTI number of mixture with WIMS activation edit.
* IACTI mixtures with activation edits.
* EMEVF2 fission production energy.
-* EMEVG2 capture production energy.
*
*-----------------------------------------------------------------------
*
@@ -56,8 +55,7 @@
INTEGER IPRINT,NGROUP,NGCOND,NREGIO,NMERGE,NL,NBISO,NED,
> MIX(NBISO),IGCOND(NGCOND),IMERGE(NREGIO),ITRANC,
> ISONAM(3,NBISO),NACTI,IACTI(NACTI)
- REAL VOLUME(NREGIO),FLUXES(NREGIO,NGROUP),
- > EMEVF2(NBISO),EMEVG2(NBISO)
+ REAL VOLUME(NREGIO),FLUXES(NREGIO,NGROUP),EMEVF2(NBISO)
*----
* LOCAL VARIABLES
*----
@@ -65,7 +63,7 @@
TYPE(C_PTR) KPLIB
INTEGER IPAR(NSTATE)
CHARACTER CACTI*12,CM*2,HMAKE(100)*8,HNEW*12,TEXT12*12,HSMG*131
- LOGICAL LMEVF,LMEVG,LLCM
+ LOGICAL LMEVF,LLCM
DOUBLE PRECISION DVOL,DFLI,DTMP,QEN,ERR
INTEGER, ALLOCATABLE, DIMENSION(:) :: ISOMIX
INTEGER, ALLOCATABLE, DIMENSION(:,:) :: KCJJ,HNISO
@@ -162,10 +160,6 @@
CALL LCMLEN(KPLIB,'MEVF',LENGTH,ITYLCM)
IF(LENGTH.EQ.1) CALL LCMGET(KPLIB,'MEVF',EVF)
LMEVF=(LENGTH.EQ.1).OR.(EMEVF2(ISO).GT.0.0)
- IF(EMEVG2(ISO).GT.0.0) EVG=EMEVG2(ISO)
- CALL LCMLEN(KPLIB,'MEVG',LENGTH,ITYLCM)
- IF(LENGTH.EQ.1) CALL LCMGET(KPLIB,'MEVG',EVG)
- LMEVG=(LENGTH.EQ.1).OR.(EMEVG2(ISO).GT.0.0)
DO 111 IL=1,NL
WRITE (CM,'(I2.2)') IL-1
CALL LCMLEN(KPLIB,'SIGS'//CM,LENGTH,ITYLCM)
@@ -353,7 +347,6 @@
CALL LCMSIX(IPEDIT,HNEW,1)
CALL LCMPUT(IPEDIT,'AWR',1,2,AWR)
IF(LMEVF) CALL LCMPUT(IPEDIT,'MEVF',1,2,EVF)
- IF(LMEVG) CALL LCMPUT(IPEDIT,'MEVG',1,2,EVG)
DO 220 J=1,MAXH
IF(HMAKE(J).NE.' ') THEN
DO 221 IGCD=1,NGCOND
diff --git a/Dragon/src/EDIDRV.f b/Dragon/src/EDIDRV.f
index bc48d6f..1f39079 100644
--- a/Dragon/src/EDIDRV.f
+++ b/Dragon/src/EDIDRV.f
@@ -136,7 +136,7 @@
INTEGER, ALLOCATABLE, DIMENSION(:,:) :: FIPI,FIFP
INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: KEYANI
REAL, ALLOCATABLE, DIMENSION(:) :: WORKF,WORKA,VOLME,WLETY,WE,
- > COURI,TAUXT,SIGT,SIGS,SCATS,FLINT,SCATD,DEN,TN,EMEVF,EMEVG,RER,
+ > COURI,TAUXT,SIGT,SIGS,SCATS,FLINT,SCATD,DEN,TN,EMEVF,RER,
> DECAY,RRD,FIYI,ENERG,NAWR,NDEN,NTMP,NVOL,SNEJ,WORK1,WORK2
REAL, ALLOCATABLE, DIMENSION(:,:) :: ADF
REAL, ALLOCATABLE, DIMENSION(:,:,:) :: FLUXC,FADJC,FLUXES,AFLUXE,
@@ -517,9 +517,8 @@
*----
* EVALUATE H-FACTOR IF REQUIRED FOR THE EDITION MACROLIB
*----
- ALLOCATE(EMEVF(NBISO),EMEVG(NBISO))
+ ALLOCATE(EMEVF(NBISO))
EMEVF(:NBISO)=0.0
- EMEVG(:NBISO)=0.0
IF((NSAVES.GE.2).AND.(IHF.NE.0)) THEN
CALL LCMLEN(IPLIB,'DEPL-CHAIN',ILLCM,ITLCM)
IF(ILLCM.NE.0) THEN
@@ -534,10 +533,9 @@
CALL LCMGET(IPLIB,'DEPLETE-ENER',RER)
CALL LCMSIX(IPLIB,' ',2)
*
- CALL EDIHFC(IPEDIT,NGROUP,NGCOND,NREGIO,NMERGE,NBISO,NDEPL,
- > NREAC,MATCOD,VOLUME,INADPL,ISONA,ISONR,IPISO,
- > MIX,FLUXES(1,1,1),DEN,IGCOND,IMERGE,RER,EMEVF,
- > EMEVG,VOLME,IPRINT)
+ CALL EDIHFC(IPEDIT,NGROUP,NGCOND,NREGIO,NMERGE,NBISO,
+ > MATCOD,VOLUME,ISONA,IPISO,MIX,FLUXES(1,1,1),
+ > DEN,IGCOND,IMERGE,VOLME,IPRINT,EMEVF)
*
DEALLOCATE(RER,INADPL)
CALL LCMSIX(IPEDIT,' ',2)
@@ -605,8 +603,8 @@
> IPRINT,NGROUP,NGCOND,NBMIX,NREGIO,NMERGE,NDFI,
> NDFP,ILEAKS,ILUPS,NW,MATCOD,VOLUME,KEYFLX,CURNAM,
> IGCOND,IMERGE,FLUXES,AFLUXE,EIGENK,EIGINF,B2,DEN,
- > ITYPE,IDEPL,LSISO,EMEVF,EMEVG,DECAY,YIELD,FIPI,
- > FIFP,PYIELD,ITRANC,LISO,NMLEAK)
+ > ITYPE,IDEPL,LSISO,EMEVF,DECAY,YIELD,FIPI,FIFP,
+ > PYIELD,ITRANC,LISO,NMLEAK)
*----
* ISOTX FILE PROCESSING
*----
@@ -631,13 +629,10 @@
KPEDIT=JPISO(ISO)
CALL LCMGET(KPEDIT,'AWR',AWR)
EMEVF2=0.0
- EMEVG2=0.0
CALL LCMLEN(KPEDIT,'MEVF',ILENF,ITYLCM)
- CALL LCMLEN(KPEDIT,'MEVG',ILENG,ITYLCM)
IF(ILENF.EQ.1) CALL LCMGET(KPEDIT,'MEVF',EMEVF2)
- IF(ILENG.EQ.1) CALL LCMGET(KPEDIT,'MEVG',EMEVG2)
NAWR(ISO)=AWR
- SNEJ(ISO)=EMEVF2+EMEVG2
+ SNEJ(ISO)=EMEVF2
ENDDO
*
NBIXS=IXEDI
@@ -681,8 +676,7 @@
> NGROUP,NGCOND,NBMIX,NREGIO,NMERGE,NDFI,NDFP,ILEAKS,
> ILUPS,NW,MATCOD,VOLUME,KEYFLX,CURNAM,IGCOND,IMERGE,
> FLUXES,AFLUXE,EIGENK,EIGINF,B2,DEN,ITYPE,LSISO,EMEVF,
- > EMEVG,DECAY,YIELD,FIPI,FIFP,PYIELD,ITRANC,LISO,
- > NMLEAK)
+ > DECAY,YIELD,FIPI,FIFP,PYIELD,ITRANC,LISO,NMLEAK)
ENDIF
*----
* EDIT MICROSCOPIC ACTIVATION XS
@@ -690,7 +684,7 @@
IF(NACTI.GT.0) THEN
CALL EDIACT(IPEDIT,IPRINT,NGROUP,NGCOND,NREGIO,NMERGE,NL,NBISO,
> NED,VOLUME,MIX,IGCOND,IMERGE,FLUXES(1,1,1),ITRANC,
- > ISONA,IPISO,HVECT,CURNAM,NACTI,IACTI,EMEVF,EMEVG)
+ > ISONA,IPISO,HVECT,CURNAM,NACTI,IACTI,EMEVF)
ENDIF
*----
* STATISTICS AND DELTA SIGMAS
@@ -709,8 +703,7 @@
ENDIF
*
IF(ALLOCATED(PYIELD)) DEALLOCATE(PYIELD,YIELD,FIFP,FIPI)
- DEALLOCATE(DECAY)
- DEALLOCATE(EMEVG,EMEVF)
+ DEALLOCATE(DECAY,EMEVF)
DEALLOCATE(SCATS,SIGS,FADJC,FLUXC,TAUXT)
DEALLOCATE(WE,WLETY,VOLME)
IF(HSIGN.EQ.'L_LIBRARY') THEN
diff --git a/Dragon/src/EDIHFC.f b/Dragon/src/EDIHFC.f
index 7cdc561..46f53bd 100644
--- a/Dragon/src/EDIHFC.f
+++ b/Dragon/src/EDIHFC.f
@@ -1,14 +1,12 @@
*DECK EDIHFC
SUBROUTINE EDIHFC(IPEDIT,NGROUP,NGCOND,NREGIO,NMERGE,NBISO,
- > NDEPL,NREAC,MATCOD,VOLUME,INADPL,ISONAM,ISONRF,
- > IPISO,MIX,FLUXES,DEN,IGCOND,IMERGE,RER,EMEVF2,
- > EMEVG2,VOLME,IPRINT)
+ > MATCOD,VOLUME,ISONAM,IPISO,MIX,FLUXES,DEN,
+ > IGCOND,IMERGE,VOLME,IPRINT,EMEVF2)
*
*-----------------------------------------------------------------------
*
*Purpose:
-* Evaluate H-factors using information recovered from the reference
-* internal library and store them in the edition macrolib.
+* Recover H-factors and normalize the flux.
*
*Copyright:
* Copyright (C) 2002 Ecole Polytechnique de Montreal
@@ -26,26 +24,20 @@
* NREGIO number of regions.
* NMERGE number of merged regions.
* NBISO number of isotopes.
-* NDEPL number of depleting isotopes.
-* NREAC number of depletion reactions.
* MATCOD material per region.
* VOLUME volume of region.
-* INADPL name of depleting isotopes.
* ISONAM isotopes names.
-* ISONRF library name of isotopes.
* IPISO pointer array towards microlib isotopes.
* MIX mixture associated with isotopes.
* FLUXES multigroup fluxes.
* DEN isotope density.
* IGCOND limits of condensed groups.
* IMERGE index of merged region.
-* RER fission and capture production energy (MeV/reaction).
* VOLME merged volume.
* IPRINT print level.
*
*Parameters: output
-* EMEVF2 fission production energy by isotope.
-* EMEVG2 capture production energy by isotope.
+* EMEVF2 equivalent fission production energy by isotope.
*
*-----------------------------------------------------------------------
*
@@ -55,113 +47,77 @@
*----
TYPE(C_PTR) IPEDIT,IPISO(NBISO)
INTEGER IUNOUT
- INTEGER NGROUP,NGCOND,NREGIO,NMERGE,NBISO,NDEPL,NREAC,
- > MATCOD(NREGIO),INADPL(3,NDEPL),ISONAM(3,NBISO),
- > ISONRF(3,NBISO),MIX(NBISO),IGCOND(NGCOND),
+ INTEGER NGROUP,NGCOND,NREGIO,NMERGE,NBISO,MATCOD(NREGIO),
+ > ISONAM(3,NBISO),MIX(NBISO),IGCOND(NGCOND),
> IMERGE(NREGIO)
REAL VOLUME(NREGIO),FLUXES(NREGIO,NGROUP),DEN(NBISO),
- > RER(NREAC,NDEPL),EMEVF2(NBISO),EMEVG2(NBISO)
- REAL VOLME(NMERGE)
+ > EMEVF2(NBISO),VOLME(NMERGE)
INTEGER IPRINT
- DOUBLE PRECISION TOTPOW,POWF,POWC,POWT
- INTEGER, ALLOCATABLE, DIMENSION(:) :: INDX
+ DOUBLE PRECISION TOTPOW,POWF
REAL, ALLOCATABLE, DIMENSION(:) :: SIG,HFACT
- DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: FLXMER
- DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:) :: WORK
+ DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: FLXMER,WORK
*----
* LOCAL VARIABLES
*----
TYPE(C_PTR) JPEDIT,KPEDIT,KPLIB
PARAMETER (IUNOUT=6)
- INTEGER IGAR(3)
- CHARACTER HNISOR*12,TEXT12*12,HSMG*131
- LOGICAL L1,L2
- DOUBLE PRECISION GAR,CONV,XDRCST
+ CHARACTER HSMG*131
+ LOGICAL LH
+ DOUBLE PRECISION GAR,CONV,XDRCST,Z1,Z2
*----
* SCRATCH STORAGE ALLOCATION
* SIG fission/capture cross sections.
* HFACT H-factor in a macrogroup.
* FLXMER merged and condensed flux.
* WORK H-factors.
-* INDX depleting isotope index.
*----
- ALLOCATE(INDX(NBISO))
ALLOCATE(SIG(NGROUP),HFACT(NMERGE))
- ALLOCATE(FLXMER(NMERGE,NGCOND),WORK(NMERGE,NGCOND,3))
-*----
-* COMPUTE THE DEPLETING ISOTOPE INDEX
-*----
- DO 20 ISO=1,NBISO
- WRITE(HNISOR,'(3A4)') (ISONRF(I0,ISO),I0=1,3)
- I1=INDEX(HNISOR,'_')
- IF(I1.EQ.0) THEN
- TEXT12=HNISOR
- ELSE
- TEXT12=HNISOR(:I1-1)
- ENDIF
- READ(TEXT12,'(3A4)') (IGAR(I0),I0=1,3)
- DO 10 IDP=1,NDEPL
- L1=((ISONRF(1,ISO).EQ.INADPL(1,IDP)).AND.
- 1 (ISONRF(2,ISO).EQ.INADPL(2,IDP)).AND.
- 2 (ISONRF(3,ISO).EQ.INADPL(3,IDP)))
- L2=((IGAR(1).EQ.INADPL(1,IDP)).AND.
- 1 (IGAR(2).EQ.INADPL(2,IDP)).AND.
- 2 (IGAR(3).EQ.INADPL(3,IDP)))
- IF(L1.OR.L2) THEN
- INDX(ISO)=IDP
- GO TO 20
- ENDIF
- 10 CONTINUE
- INDX(ISO)=0
- 20 CONTINUE
+ ALLOCATE(FLXMER(NMERGE,NGCOND),WORK(NMERGE,NGCOND))
*----
* COMPUTE H-FACTOR
*----
CONV=1.0D6 ! convert MeV to eV
- IZFISS=0
FLXMER(:NMERGE,:NGCOND)=0.0D0
- WORK(:NMERGE,:NGCOND,:3)=0.0D0
+ WORK(:NMERGE,:NGCOND)=0.0D0
+ LH=.FALSE.
DO 160 ISO=1,NBISO
- IDPL=INDX(ISO)
- IF(IDPL.EQ.0) GO TO 160
KPLIB=IPISO(ISO) ! set ISO-th isotope
IF(.NOT.C_ASSOCIATED(KPLIB)) THEN
WRITE(HSMG,'(17HEDIHFC: ISOTOPE '',3A4,16H'' IS NOT AVAILAB,
> 19HLE IN THE MICROLIB.)') (ISONAM(I0,ISO),I0=1,3)
CALL XABORT(HSMG)
ENDIF
+ Z1=0.0D0
+ Z2=0.0D0
+ EMEVF2(ISO)=0.0
*----
* RECOVER H-FACTOR INFORMATION IF AVAILABLE
*----
CALL LCMLEN(KPLIB,'H-FACTOR',ILLCM,ITLCM)
- IF(ILLCM.EQ.NGROUP) THEN
- IZFISS=IZFISS+1
- CALL LCMGET(KPLIB,'H-FACTOR',SIG)
- DO 90 IREG=1,NREGIO
- IMR=IMERGE(IREG)
- IF((IMR.GT.0).AND.(MATCOD(IREG).EQ.MIX(ISO))) THEN
- IGRFIN=0
- DO 80 IGC=1,NGCOND
- IGRDEB=IGRFIN+1
- IGRFIN=IGCOND(IGC)
- GAR=0.0D0
- DO 70 IGR=IGRDEB,IGRFIN
- GAR=GAR+FLUXES(IREG,IGR)*DEN(ISO)*VOLUME(IREG)*
- > SIG(IGR)
- 70 CONTINUE
- WORK(IMR,IGC,1)=WORK(IMR,IGC,1)+GAR
- 80 CONTINUE
- ENDIF
- 90 CONTINUE
- GO TO 165
- ENDIF
+ IF(ILLCM.EQ.0) GO TO 160
+ LH=.TRUE.
+ CALL LCMGET(KPLIB,'H-FACTOR',SIG)
+ DO 90 IREG=1,NREGIO
+ IMR=IMERGE(IREG)
+ IF((IMR.GT.0).AND.(MATCOD(IREG).EQ.MIX(ISO))) THEN
+ IGRFIN=0
+ DO 80 IGC=1,NGCOND
+ IGRDEB=IGRFIN+1
+ IGRFIN=IGCOND(IGC)
+ GAR=0.0D0
+ DO 70 IGR=IGRDEB,IGRFIN
+ GAR=GAR+FLUXES(IREG,IGR)*DEN(ISO)*VOLUME(IREG)*SIG(IGR)
+ 70 CONTINUE
+ WORK(IMR,IGC)=WORK(IMR,IGC)+GAR
+ Z1=Z1+GAR
+ 80 CONTINUE
+ ENDIF
+ 90 CONTINUE
*----
* COMPUTE FISSION ENERGY
*----
CALL LCMLEN(KPLIB,'NFTOT',ILLCM,ITLCM)
IF(ILLCM.EQ.NGROUP) THEN
- IZFISS=IZFISS+1
- EMEVF2(ISO)=RER(2,IDPL)
CALL LCMGET(KPLIB,'NFTOT',SIG)
DO 120 IREG=1,NREGIO
IMR=IMERGE(IREG)
@@ -170,51 +126,23 @@
DO 110 IGC=1,NGCOND
IGRDEB=IGRFIN+1
IGRFIN=IGCOND(IGC)
- GAR=0.0D0
DO 100 IGR=IGRDEB,IGRFIN
- GAR=GAR+FLUXES(IREG,IGR)*DEN(ISO)*VOLUME(IREG)*
- > SIG(IGR)
+ Z2=Z2+FLUXES(IREG,IGR)*DEN(ISO)*VOLUME(IREG)*SIG(IGR)
100 CONTINUE
- WORK(IMR,IGC,1)=WORK(IMR,IGC,1)+GAR*RER(2,IDPL)*CONV
110 CONTINUE
ENDIF
120 CONTINUE
- ENDIF
-*----
-* COMPUTE CAPTURE ENERGY
-*----
- CALL LCMLEN(KPLIB,'NG',ILLCM,ITLCM)
- IF(ILLCM.EQ.NGROUP) THEN
- IZFISS=IZFISS+1
- EMEVG2(ISO)=RER(3,IDPL)
- CALL LCMGET(KPLIB,'NG',SIG)
- DO 150 IREG=1,NREGIO
- IMR=IMERGE(IREG)
- IF((IMR.GT.0).AND.(MATCOD(IREG).EQ.MIX(ISO))) THEN
- IGRFIN=0
- DO 140 IGC=1,NGCOND
- IGRDEB=IGRFIN+1
- IGRFIN=IGCOND(IGC)
- GAR=0.0D0
- DO 130 IGR=IGRDEB,IGRFIN
- GAR=GAR+FLUXES(IREG,IGR)*DEN(ISO)*VOLUME(IREG)*
- > SIG(IGR)
- 130 CONTINUE
- WORK(IMR,IGC,2)=WORK(IMR,IGC,2)+GAR*RER(3,IDPL)*CONV
- 140 CONTINUE
- ENDIF
- 150 CONTINUE
+ IF(Z2.NE.0.0) EMEVF2(ISO)=REAL(Z1/Z2)
ENDIF
160 CONTINUE
*----
* Normalize total power to 1 W
* Print fission, capture and total power density
*----
- 165 TOTPOW=0.0D0
+ TOTPOW=0.0D0
DO IGC=1,NGCOND
DO IMR=1,NMERGE
- WORK(IMR,IGC,3)=WORK(IMR,IGC,1)+WORK(IMR,IGC,2)
- TOTPOW=TOTPOW+WORK(IMR,IGC,3)*XDRCST('eV','J')
+ TOTPOW=TOTPOW+WORK(IMR,IGC)*XDRCST('eV','J')
ENDDO
ENDDO
IF(TOTPOW.GT.0.0D0) THEN
@@ -222,18 +150,12 @@
WRITE(IUNOUT,6000)
DO IMR=1,NMERGE
POWF=0.0D0
- POWC=0.0D0
- POWT=0.0D0
DO IGC=1,NGCOND
- POWF=POWF+WORK(IMR,IGC,1)
- POWC=POWC+WORK(IMR,IGC,2)
- POWT=POWT+WORK(IMR,IGC,3)
+ POWF=POWF+WORK(IMR,IGC)
ENDDO
IF(VOLME(IMR).NE.0.0) THEN
POWF=POWF/(TOTPOW*VOLME(IMR))
- POWC=POWC/(TOTPOW*VOLME(IMR))
- POWT=POWT/(TOTPOW*VOLME(IMR))
- WRITE(IUNOUT,6001) IMR,VOLME(IMR),POWF,POWC,POWT
+ WRITE(IUNOUT,6001) IMR,VOLME(IMR),POWF
ENDIF
ENDDO
ENDIF
@@ -241,7 +163,7 @@
*----
* COMPUTE THE HOMOGENIZED/CONDENSED FLUX
*----
- IF(IZFISS.NE.0) THEN
+ IF(LH) THEN
DO 190 IREG=1,NREGIO
IMR=IMERGE(IREG)
IF(IMR.GT.0) THEN
@@ -260,36 +182,34 @@
DO 210 IGC=1,NGCOND
DO 200 IMR=1,NMERGE
IF(FLXMER(IMR,IGC).GT.0.0) THEN
- WORK(IMR,IGC,3)=WORK(IMR,IGC,3)/FLXMER(IMR,IGC)
+ WORK(IMR,IGC)=WORK(IMR,IGC)/FLXMER(IMR,IGC)
ENDIF
200 CONTINUE
210 CONTINUE
- ENDIF
*----
* SAVE ON LCM
*----
- CALL LCMSIX(IPEDIT,'MACROLIB',1)
- JPEDIT=LCMLID(IPEDIT,'GROUP',NGCOND)
- DO 230 IGC=1,NGCOND
- DO 220 IMR=1,NMERGE
- HFACT(IMR)=REAL(WORK(IMR,IGC,3))
- 220 CONTINUE
- KPEDIT=LCMDIL(JPEDIT,IGC)
- CALL LCMPUT(KPEDIT,'H-FACTOR',NMERGE,2,HFACT)
- 230 CONTINUE
- CALL LCMSIX(IPEDIT,' ',2)
+ CALL LCMSIX(IPEDIT,'MACROLIB',1)
+ JPEDIT=LCMLID(IPEDIT,'GROUP',NGCOND)
+ DO 230 IGC=1,NGCOND
+ DO 220 IMR=1,NMERGE
+ HFACT(IMR)=REAL(WORK(IMR,IGC))
+ 220 CONTINUE
+ KPEDIT=LCMDIL(JPEDIT,IGC)
+ CALL LCMPUT(KPEDIT,'H-FACTOR',NMERGE,2,HFACT)
+ 230 CONTINUE
+ CALL LCMSIX(IPEDIT,' ',2)
+ ENDIF
*----
* SCRATCH STORAGE DEALLOCATION
*----
DEALLOCATE(WORK,FLXMER)
DEALLOCATE(HFACT,SIG)
- DEALLOCATE(INDX)
RETURN
*----
* FORMAT
*----
6000 FORMAT(/' EDIHFC: POWER DENSITY (W/cc) NORMALIZED TO 1 W TOTAL ',
- > 'POWER '/' REGION',6X,'VOLUME',7X,'FISSION',7X,'CAPTURE',9X,
- > 'TOTAL')
- 6001 FORMAT(1X,I4,1P,4E14.5)
+ > 'POWER '/' REGION',6X,'VOLUME',7X,'FISSION')
+ 6001 FORMAT(1X,I4,1P,2E14.5)
END
diff --git a/Dragon/src/EDIMIC.f b/Dragon/src/EDIMIC.f
index 025d1c4..e284110 100644
--- a/Dragon/src/EDIMIC.f
+++ b/Dragon/src/EDIMIC.f
@@ -3,8 +3,8 @@
1 NDEPL,ISONAM,ISONRF,IPISO,MIX,TN,NED,HVECT,NOUT,HVOUT,IPRINT,
2 NGROUP,NGCOND,NBMIX,NREGIO,NMERGE,NDFI,NDFP,ILEAKS,ILUPS,NW,
3 MATCOD,VOLUME,KEYFLX,CURNAM,IGCOND,IMERGE,FLUXES,AFLUXE,EIGENK,
- 4 EIGINF,B2,DEN,ITYPE,IEVOL,LSISO,EMEVF,EMEVG,DECAY,YIELD,FIPI,
- 5 FIFP,PYIELD,ITRANC,LISO,NMLEAK)
+ 4 EIGINF,B2,DEN,ITYPE,IEVOL,LSISO,EMEVF,DECAY,YIELD,FIPI,FIFP,
+ 5 PYIELD,ITRANC,LISO,NMLEAK)
*
*-----------------------------------------------------------------------
*
@@ -78,7 +78,6 @@
* 1 is used to force an isotope to be non-depleting.
* LSISO flag for isotopes saved.
* EMEVF fission production energy.
-* EMEVG capture production energy.
* DECAY radioactive decay constant.
* YIELD group-ordered condensed fission product yield.
* FIPI fissile isotope index assigned to each microlib isotope.
@@ -104,7 +103,7 @@
5 FIPI(NBISO,NMERGE),FIFP(NBISO,NMERGE),ITRANC,NMLEAK
REAL TN(NBISO),VOLUME(NREGIO),FLUXES(NREGIO,NGROUP,NW+1),
1 AFLUXE(NREGIO,NGROUP,NW+1),EIGENK,EIGINF,B2(4),
- 2 DEN(NBISO),EMEVF(NBISO),EMEVG(NBISO),DECAY(NBISO),
+ 2 DEN(NBISO),EMEVF(NBISO),DECAY(NBISO),
3 YIELD(NGCOND+1,NDFP,NMERGE),PYIELD(NDFI,NDFP,NMERGE)
CHARACTER HVECT(NED)*8,HVOUT(NOUT)*8,CURNAM*12
LOGICAL LISO
@@ -113,7 +112,7 @@
*----
PARAMETER (NSTATE=40,MAXESP=4)
TYPE(C_PTR) JPLIB,KPLIB,JPFLUX,JPEDIT,KPEDIT
- LOGICAL LOGIC,LSTRD,LAWR,LMEVF,LMEVG,LDECA,LWD,LONE
+ LOGICAL LOGIC,LSTRD,LAWR,LMEVF,LDECA,LWD,LONE
CHARACTER CM*2,HNEW*12,TEXT8*8,TEXT12*12,HSMG*131,HNAMIS*12
INTEGER IPAR(NSTATE),IESP2(MAXESP+1)
REAL B2T(3),EESP(MAXESP+1),EESP2(MAXESP+1)
@@ -385,7 +384,6 @@
LAWR=.FALSE.
LDECA=.FALSE.
LMEVF=.FALSE.
- LMEVG=.FALSE.
DO 145 IW=1,MIN(NW+1,10)
WRITE(HMAKE(IW),'(3HNWT,I1)') IW-1
IF(IADJ.EQ.1) WRITE(HMAKE(1+NW+IW),'(4HNWAT,I1)') IW-1
@@ -434,9 +432,6 @@
CALL LCMLEN(KPLIB,'MEVF',LENGTH,ITYLCM)
IF(LENGTH.EQ.1) CALL LCMGET(KPLIB,'MEVF',EMEVF(ISO))
LMEVF=(LENGTH.EQ.1).OR.(EMEVF(ISO).GT.0.0)
- CALL LCMLEN(KPLIB,'MEVG',LENGTH,ITYLCM)
- IF(LENGTH.EQ.1) CALL LCMGET(KPLIB,'MEVG',EMEVG(ISO))
- LMEVG=(LENGTH.EQ.1).OR.(EMEVG(ISO).GT.0.0)
CALL LCMLEN(KPLIB,'DECAY',LENGTH,ITYLCM)
IF(LENGTH.EQ.1) CALL LCMGET(KPLIB,'DECAY',DECAY(ISO))
LDECA=(LENGTH.EQ.1).OR.(DECAY(ISO).GT.0.0)
@@ -520,23 +515,6 @@
IF(LENGTH.GT.0) THEN
CALL LCMGET(KPLIB,'H-FACTOR',GAR(1,5+NED+NL+3*NW))
HMAKE(5+NED+NL+3*NW)='H-FACTOR'
- ELSE
- IF(LMEVF) THEN
- CALL LCMGET(KPLIB,'NFTOT',WORK)
- HMAKE(5+NED+NL+3*NW)='H-FACTOR'
- DO 190 IGR=1,NGROUP
- GAR(IGR,5+NED+NL+3*NW)=GAR(IGR,5+NED+NL+3*NW)+
- 1 WORK(IGR)*EMEVF(ISO)*REAL(CONV)
- 190 CONTINUE
- ENDIF
- IF(LMEVG) THEN
- CALL LCMGET(KPLIB,'NG',WORK)
- HMAKE(5+NED+NL+3*NW)='H-FACTOR'
- DO 195 IGR=1,NGROUP
- GAR(IGR,5+NED+NL+3*NW)=GAR(IGR,5+NED+NL+3*NW)+
- 1 WORK(IGR)*EMEVG(ISO)*REAL(CONV)
- 195 CONTINUE
- ENDIF
ENDIF
DO 200 IED=1,NED
IF(HVECT(IED).EQ.'H-FACTOR') GO TO 200
@@ -811,7 +789,6 @@
CALL LCMPTC(KPEDIT,'ALIAS',12,HNEW)
IF(LAWR) CALL LCMPUT(KPEDIT,'AWR',1,2,AWR)
IF(LMEVF) CALL LCMPUT(KPEDIT,'MEVF',1,2,EMEVF(ISO))
- IF(LMEVG) CALL LCMPUT(KPEDIT,'MEVG',1,2,EMEVG(ISO))
IF(LDECA) CALL LCMPUT(KPEDIT,'DECAY',1,2,DECAY(ISO))
DO 380 J=1,MAXH
IF(HMAKE(J).NE.' ') THEN
diff --git a/Dragon/src/EDIRES.f b/Dragon/src/EDIRES.f
index b49cf83..72eb11f 100644
--- a/Dragon/src/EDIRES.f
+++ b/Dragon/src/EDIRES.f
@@ -3,8 +3,8 @@
1 NDEPL,ISONAM,ISONRF,IPISO,MIX,TN,NED,HVECT,NOUT,HVOUT,IPRINT,
2 NGROUP,NGCOND,NBMIX,NREGIO,NMERGE,NDFI,NDFP,ILEAKS,ILUPS,NW,
3 MATCOD,VOLUME,KEYFLX,CURNAM,IGCOND,IMERGE,FLUXES,AFLUXE,EIGENK,
- 4 EIGINF,B2,DEN,ITYPE,LSISO,EMEVF,EMEVG,DECAY,YIELD,FIPI,FIFP,
- 5 PYIELD,ITRANC,LISO,NMLEAK)
+ 4 EIGINF,B2,DEN,ITYPE,LSISO,EMEVF,DECAY,YIELD,FIPI,FIFP,PYIELD,
+ 5 ITRANC,LISO,NMLEAK)
*
*-----------------------------------------------------------------------
*
@@ -76,7 +76,6 @@
* ITYPE type of each isotope.
* LSISO flag for isotopes saved.
* EMEVF fission production energy.
-* EMEVG capture production energy.
* DECAY radioactive decay constant.
* YIELD group-ordered condensed fission product yield.
* FIPI fissile isotope index assigned to each microlib isotope.
@@ -100,8 +99,8 @@
3 IGCOND(NGCOND),IMERGE(NREGIO),ITYPE(NBISO),LSISO(NBISO),
4 FIPI(NBISO,NMERGE),FIFP(NBISO,NMERGE),ITRANC,NMLEAK
REAL TN(NBISO),VOLUME(NREGIO),FLUXES(NREGIO,NGROUP,NW+1),
- 1 EIGENK,EIGINF,B2(4),DEN(NBISO),EMEVF(NBISO),EMEVG(NBISO),
- 2 DECAY(NBISO),YIELD(NGCOND+1,NDFP,NMERGE),PYIELD(NDFI,NDFP,NMERGE)
+ 1 EIGENK,EIGINF,B2(4),DEN(NBISO),EMEVF(NBISO),DECAY(NBISO),
+ 2 YIELD(NGCOND+1,NDFP,NMERGE),PYIELD(NDFI,NDFP,NMERGE)
CHARACTER HVECT(NED)*8,HVOUT(NOUT)*8,CURNAM*12
LOGICAL LISO
*----
@@ -172,8 +171,8 @@
1 ISONAM,ISONRF,IPISO,MIX,TN,NED,HVECT,NOUT,HVOUT,IPRIN2,NGROUP,
2 NGCOND,NBMIX,NREGIO,NMERGE,0,0,ILEAKS,ILUPS,NW,MATCOD,VOLUME,
3 KEYFLX,TEXT12,IGCOND,IMERGE,FLUXES,AFLUXE,EIGENK,EIGINF,B2,DEN,
- 4 ITYPE,IEVOL2,LSIS2,EMEVF,EMEVG,DECAY,YIELD,FIPI,FIFP,PYIELD,
- 5 ITRANC,LISO,NMLEAK)
+ 4 ITYPE,IEVOL2,LSIS2,EMEVF,DECAY,YIELD,FIPI,FIFP,PYIELD,ITRANC,
+ 5 LISO,NMLEAK)
*
CALL LCMSIX(IPEDIT,CURNAM,1)
CALL LCMGET(IPEDIT,'STATE-VECTOR',IPAR)
diff --git a/Dragon/src/EPCRMA.f b/Dragon/src/EPCRMA.f
index 933683e..9dbcffe 100644
--- a/Dragon/src/EPCRMA.f
+++ b/Dragon/src/EPCRMA.f
@@ -53,7 +53,7 @@
TYPE(C_PTR) IPMIC
INTEGER IPRINT,NGR,NXS,NCV,NMIXT,NIFISS,IMIX,ISOF,ITOTL,
> ISCAT
- CHARACTER*6 NAMDXS(NXS)
+ CHARACTER*8 NAMDXS(NXS)
REAL DENSI
INTEGER ICOV(NGR,NXS)
REAL COV(NCV,NXS)
diff --git a/Dragon/src/EPCRMS.f b/Dragon/src/EPCRMS.f
index 5d8c72f..a2c06ff 100644
--- a/Dragon/src/EPCRMS.f
+++ b/Dragon/src/EPCRMS.f
@@ -37,7 +37,7 @@
*----
TYPE(C_PTR) IPMIC
INTEGER IPRINT,NGR,NXS,NMIXT,NIFISS
- CHARACTER*6 NAMDXS(NXS)
+ CHARACTER*8 NAMDXS(NXS)
REAL XSMAC(NGR,NXS,NMIXT,NIFISS)
*----
* Local parameters
diff --git a/Dragon/src/EPCRMU.f b/Dragon/src/EPCRMU.f
index 7021bee..910eab9 100644
--- a/Dragon/src/EPCRMU.f
+++ b/Dragon/src/EPCRMU.f
@@ -48,7 +48,7 @@
TYPE(C_PTR) IPEPC,IPMIC
INTEGER IPRINT,NGR,NIS,NXS,NCV,
> NBISO,NMIXT,NIFISS,ITOTL,ISCAT
- CHARACTER*6 NAMDXS(NXS)
+ CHARACTER*8 NAMDXS(NXS)
INTEGER NAMISO(3,NIS),NISOU(3,NBISO),ISOMIX(NBISO),
> IDVF(2,NIS),IDMF(2,NBISO)
*----
@@ -126,11 +126,11 @@
*----
* Get covariance matrices
*----
- RECNAM='INDX'//NAMDXS(IXS)//' '
+ RECNAM='INDX'//NAMDXS(IXS)
CALL LCMLEN(IPEPC,RECNAM,ILCMLN,ILCMTY)
IF(ILCMLN .EQ. NGR) THEN
CALL LCMGET(IPEPC,RECNAM,ICOV(1,IXS))
- RECNAM=NAMDXS(IXS)//' '
+ RECNAM=NAMDXS(IXS)//' '
CALL LCMGET(IPEPC,RECNAM,COV(1,IXS))
*----
* Generate random numbers from normal distribution
diff --git a/Dragon/src/EVOBLD.f b/Dragon/src/EVOBLD.f
index 46ab32c..3803d63 100644
--- a/Dragon/src/EVOBLD.f
+++ b/Dragon/src/EVOBLD.f
@@ -1,8 +1,8 @@
*DECK EVOBLD
SUBROUTINE EVOBLD(IMPX,INR,IGLOB,NBMIX,NBISO,NCOMB,ISONAM,IPISO,
1 YDPL,VX,MILVO,JM,NVAR,NDFP,NSUPS,NREAC,NPAR,NFISS,XT,EPS1,EPS2,
- 2 EXPMAX,H1,ITYPE,IDIRAC,FIT,DELTA,ENERG,KPAR,BPAR,YIELD,IDR,RER,
- 3 RRD,AWR,FUELDN,SIG,VPH,VPHV,MIXPWR,VTOTD,IEVOLB,KFISS,KPF)
+ 2 EXPMAX,H1,ITYPE,IDIRAC,FIT,DELTA,ENERG,KPAR,BPAR,YIELD,IDR,RRD,
+ 3 AWR,FUELDN,SIG,VPH,VPHV,MIXPWR,VTOTD,IEVOLB,KFISS,KPF)
*
*-----------------------------------------------------------------------
*
@@ -76,9 +76,6 @@
* BPAR branching ratio for neutron induced reactions.
* YIELD mixture-dependent fission yields.
* IDR identifier for each depleting reaction.
-* RER energy (Mev) per reaction. If RER(3,J)=0., the fission energy
-* includes radiative capture energy. Neutrino energy is
-* never included.
* RRD sum of radioactive decay constants in 10**-8/s.
* AWR mass of the nuclides in unit of neutron mass.
* FUELDN fuel initial density and mass.
@@ -117,8 +114,8 @@
4 KPF(NDFP,NBMIX)
REAL YDPL(NVAR+1,2,NCOMB),VX(NBMIX),XT(2),EPS1,EPS2,EXPMAX,H1,FIT,
1 DELTA(3),ENERG(NBMIX),BPAR(NPAR,NVAR),YIELD(NFISS,NDFP,NBMIX),
- 2 RER(NREAC,NVAR+NSUPS),RRD(NVAR+NSUPS),AWR(NVAR),FUELDN(3),
- 3 SIG(NVAR+1,NREAC+1,NBMIX,2),VPH(2),VPHV(NBMIX,2)
+ 2 RRD(NVAR+NSUPS),AWR(NVAR),FUELDN(3),SIG(NVAR+1,NREAC+1,NBMIX,2),
+ 3 VPH(2),VPHV(NBMIX,2)
DOUBLE PRECISION VTOTD
*----
* LOCAL VARIABLES
@@ -126,20 +123,12 @@
TYPE(C_PTR) KPLIB
CHARACTER TEXT8*8,HSMG*131
DOUBLE PRECISION GAR,GARD,XDRCST,EVJ,FITD,PHI2
- LOGICAL LCOOL,LSIMPL
+ LOGICAL LCOOL
INTEGER, ALLOCATABLE, DIMENSION(:) :: MU1,IMA,LP,CHAIN
*----
* SCRATCH STORAGE ALLOCATION
*----
ALLOCATE(MU1(NVAR+1),IMA(NVAR+1),LP(NVAR))
-*----
-* CHECK IF ONLY THE HEAVY ISOTOPES ARE PRODUCING ENERGY. IN THIS CASE,
-* SOME SIMPLIFICATIONS ARE POSSIBLE
-*----
- LSIMPL=.TRUE.
- DO 10 IS=1,NVAR
- LSIMPL=LSIMPL.AND.(RER(3,IS).EQ.0.0)
- 10 CONTINUE
*
EVJ=XDRCST('eV','J')*1.0E22
LCOOL=(INR.EQ.0)
@@ -186,8 +175,8 @@
CALL XABORT(HSMG)
ENDIF
CALL LCMLEN(KPLIB,'H-FACTOR',LENGT,ITYLCM)
- IF(((LENGT.GT.0).OR.(RER(3,IS).NE.0.0).OR.
- 1 (AWR(IS).GT.210.0)).AND.(LP(IS).EQ.0)) THEN
+ IF(((LENGT.GT.0).OR.(AWR(IS).GT.210.0)).AND.(LP(IS).EQ.0))
+ 1 THEN
NVAR2=NVAR2+1
LP(IS)=NVAR2
ENDIF
diff --git a/Dragon/src/EVODRV.f b/Dragon/src/EVODRV.f
index cb9b40c..cd8b69f 100644
--- a/Dragon/src/EVODRV.f
+++ b/Dragon/src/EVODRV.f
@@ -113,8 +113,7 @@
INTEGER INDREC,IMPX,NBISO,NGROUP,NBMIX,ISONAM(3,NBISO),
1 ISONRF(3,NBISO),MIX(NBISO),IEVOL(NBISO),ISTYP(NBISO),NDEPL,
2 NSUPS,NREAC,NCOMB,ITYPE,INR,IEXTR,IGLOB,ISAT,IDIRAC,ITIXS,
- 3 IFLMAC,IYLMIX,ISAVE,ISET,IDEPL,IPICK,MIXBRN(NBMIX),
- 4 MIXPWR(NBMIX)
+ 3 IFLMAC,IYLMIX,ISAVE,ISET,IDEPL,IPICK,MIXBRN(NBMIX),MIXPWR(NBMIX)
REAL DEN(NBISO),VX(NBMIX),EPS1,EPS2,EXPMAX,H1,FIT,XTI,XTF,
1 XT(2),FLUMIX(NGROUP,NBMIX)
LOGICAL LMACRO
@@ -136,7 +135,7 @@
1 NDFP2,HREAC,IPIFI,IZAE
INTEGER, ALLOCATABLE, DIMENSION(:,:) :: JM,INADPL,IEVOLB,KFISS,
1 KPAR,IDR,KPF
- REAL, ALLOCATABLE, DIMENSION(:) :: ENERG,RRD,AWR,PYIELD,TIMES
+ REAL, ALLOCATABLE, DIMENSION(:) :: ENERG,RERD,RRD,AWR,PYIELD,TIMES
REAL, ALLOCATABLE, DIMENSION(:,:) :: BPAR,RER,VPHV
REAL, ALLOCATABLE, DIMENSION(:,:,:) :: YDPL,YIELD,YIELD2
REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: SIG
@@ -191,7 +190,7 @@
NBESP=MAX(1,IDIM(10))
ALLOCATE(KPAR(NDEPL,NPAR),HREAC(2*NREAC),IDR(NREAC,NDEPL))
ALLOCATE(BPAR(NDEPL,NPAR),YIELD2(NBESP,NFISS,NDFP),
- 1 RER(NREAC,NDEPL),RRD(NDEPL))
+ 1 RER(NREAC,NDEPL),RERD(NDEPL),RRD(NDEPL))
CALL LCMGET(IPLIB,'ISOTOPESDEPL',INADPL)
IF(IMPX.GT.1) THEN
WRITE(IUNOUT,'(/38HEVODRV: DEPLETING ISOTOPES FROM CHAIN:)')
@@ -207,6 +206,8 @@
CALL LCMGET(IPLIB,'CHARGEWEIGHT',IZAE)
IF(NFISS*NDFP.GT.0) CALL LCMGET(IPLIB,'FISSIONYIELD',YIELD2)
CALL LCMSIX(IPLIB,' ',2)
+ RERD(:NDEPL)=RER(1,:NDEPL)
+ DEALLOCATE(RER)
*----
* SET THE LCM MICROLIB ISOTOPEWISE DIRECTORIES.
*----
@@ -572,7 +573,7 @@
*----
CALL EVOSIG(IMPX,INR,IGLOB,NGROUP,NBMIX,NBISO,NCOMB,ISONAM,
1 IPISO,DEN,FLUMIX,VX,MILVO,JM,NVAR,NSUPS,NREAC,HREAC,IDR,
- 2 RER,RRD,FIT,AWR,IZAE,FUELDN,NXSPER,DELTAT(1,IP),MIXPWR,PFACT,
+ 2 RERD,RRD,FIT,AWR,IZAE,FUELDN,NXSPER,DELTAT(1,IP),MIXPWR,PFACT,
3 SIG(1,1,1,IP),VPHV(1,IP))
NLENGT=(NVAR+1)*(NREAC+1)*NBMIX
CALL LCMPUT(IPDEPL,'MICRO-RATES',NLENGT,2,SIG(1,1,1,IP))
@@ -627,7 +628,7 @@
*----
CALL EVOSIG(IMPX,INR,IGLOB,NGROUP,NBMIX,NBISO,NCOMB,ISONAM,
1 IPISO,DEN,FLUMIX,VX,MILVO,JM,NVAR,NSUPS,NREAC,HREAC,IDR,
- 2 RER,RRD,FIT,AWR,IZAE,FUELDN,NXSPER,DELTAT(1,IP),MIXPWR,PFACT,
+ 2 RERD,RRD,FIT,AWR,IZAE,FUELDN,NXSPER,DELTAT(1,IP),MIXPWR,PFACT,
3 SIG(1,1,1,IP),VPHV(1,IP))
NLENGT=(NVAR+1)*(NREAC+1)*NBMIX
CALL LCMPUT(IPDEPL,'MICRO-RATES',NLENGT,2,SIG(1,1,1,IP))
@@ -801,7 +802,7 @@
*----
CALL EVOBLD(IMPX,INR2,IGLOB,NBMIX,NBISO,NCOMB,ISONAM,IPISO,
1 YDPL,VX,MILVO,JM,NVAR,NDFP,NSUPS,NREAC,NPAR,NFISS,XT,EPS1,EPS2,
- 2 EXPMAX,H1,ITYPE,IDIRAC,FIT,DELTA,ENERG,KPAR,BPAR,YIELD,IDR,RER,
+ 2 EXPMAX,H1,ITYPE,IDIRAC,FIT,DELTA,ENERG,KPAR,BPAR,YIELD,IDR,
3 RRD,AWR,FUELDN,SIG(1,1,1,1),VPH,VPHV(1,1),MIXPWR,VTOTD,IEVOLB,
4 KFISS,KPF)
*----
@@ -868,7 +869,7 @@
* RELEASE THE ALLOCATED MEMORY
*----
DEALLOCATE(IDR,HREAC,KPAR)
- DEALLOCATE(RRD,RER,YIELD,BPAR)
+ DEALLOCATE(RRD,RERD,YIELD,BPAR)
DEALLOCATE(KPF,KFISS)
*----
* USE THE RESULT OF A DEPLETION CALCULATION IN THE FOLLOWING RUN
diff --git a/Dragon/src/EVOSIG.f b/Dragon/src/EVOSIG.f
index a9c282e..e10e503 100644
--- a/Dragon/src/EVOSIG.f
+++ b/Dragon/src/EVOSIG.f
@@ -49,9 +49,7 @@
* HREAC(1)='DECAY'; HREAC(2)='NFTOT';
* HREAC(3)='NG' ; HREAC(4)='N2N'; etc.
* IDR identifier for each depleting reaction.
-* RER energy (Mev) per reaction. If RER(3,J)=0., the fission energy
-* is including radiative capture energy. Neutrino energy is
-* never included.
+* RER decay energy (Mev).
* RRD sum of radioactive decay constants in 10**-8/s.
* FIT flux normalization factor:
* n/cm**2/s if INR=1;
@@ -86,7 +84,7 @@
1 MILVO(NCOMB),JM(NBMIX,NVAR+NSUPS),NVAR,NSUPS,NREAC,
2 HREAC(2,NREAC),IDR(NREAC,NVAR+NSUPS),IZAE(NVAR+NSUPS),NXSPER,
3 MIXPWR(NBMIX)
- REAL DEN(NBISO),VX(NBMIX),RER(NREAC,NVAR+NSUPS),RRD(NVAR+NSUPS),
+ REAL DEN(NBISO),VX(NBMIX),RER(NVAR+NSUPS),RRD(NVAR+NSUPS),
1 FIT,AWR(NVAR+NSUPS),FUELDN(3),DELTAT(2),PFACT,VPHV(NBMIX),
2 SIG(NVAR+1,NREAC+1,NBMIX),FLUMIX(NGROUP,NBMIX)
*----
@@ -94,7 +92,7 @@
*----
PARAMETER(IOUT=6,MAXREA=20)
TYPE(C_PTR) KPLIB,KPLIB5
- CHARACTER HSMG*131,NAMDXS(MAXREA)*6
+ CHARACTER HSMG*131,NAMDXS(MAXREA)*8
DOUBLE PRECISION GAR,GAR1,GAR2,GARD,XDRCST,EVJ,FITD,PHI,FNORM,VPH
INTEGER IPRLOC
LOGICAL LKERMA
@@ -152,7 +150,7 @@
IS=NVAR+1
FACT=DEN(K)*VX(IBM)
ENDIF
- SIG(IS,NREAC+1,IBM)=SIG(IS,NREAC+1,IBM)+FACT*RER(1,IST)*RRD(IST)
+ SIG(IS,NREAC+1,IBM)=SIG(IS,NREAC+1,IBM)+FACT*RER(IST)*RRD(IST)
IF(INR.EQ.0) GO TO 210
*----
* RECOVER KERMA FACTORS, IF AVAILABLE
@@ -213,7 +211,7 @@
IF((IREAC.EQ.2).AND.(MOD(IDR(2,IST),100).EQ.5)) GO TO 120
IF(IMPX.GT.90) CALL LCMLIB(KPLIB)
IF(IMPX.GT.3) THEN
- WRITE(HSMG,'(17HEVOSIG: REACTION ,A6,18H IS MISSING FOR IS,
+ WRITE(HSMG,'(17HEVOSIG: REACTION ,A8,18H IS MISSING FOR IS,
1 7HOTOPE '',3A4,2H''.)') NAMDXS(IREAC-1),(ISONAM(I0,K),I0=1,3)
WRITE(IOUT,'(1X,A)') HSMG
ENDIF
@@ -224,13 +222,6 @@
130 CONTINUE
SIG(IS,IREAC-1,IBM)=SIG(IS,IREAC-1,IBM)+1.0E-3*FACT*REAL(GAR)*
1 DELTAT(IXSPER)
- ! if(LKERMA), add energy from lumped isotopes not present in the
- ! microlib. Otherwise, add energy for all isotopes.
- IF(IGLOB.NE.-1) THEN
- ! Lumped energy is not included with EDEPMODE=0.
- SIG(IS,NREAC,IBM)=SIG(IS,NREAC,IBM)+1.0E-3*FACT*RER(IREAC,IST)*
- 1 REAL(GAR)*DELTAT(IXSPER)
- ENDIF
140 CONTINUE
150 CONTINUE
210 CONTINUE
diff --git a/Dragon/src/LIB.f b/Dragon/src/LIB.f
index d8a8b5b..5a453f6 100644
--- a/Dragon/src/LIB.f
+++ b/Dragon/src/LIB.f
@@ -59,12 +59,12 @@
* LOCAL PARAMETERS
*----
CHARACTER TEXT12*12,HSIGN*12,HVECT(MAXED)*8,HADD*8,NAMLCM*12,
- > NAMMY*12
+ > NAMMY*12,HHLIB*8,CFILNA*64
INTEGER ISTATE(NSTATE),IPRINT,NBISOX,NBMIXX,MAXMIX,INDREC,
> NBISO,NGRO,NGT,NGF,NGFR,NL,ITRANC,ITIME,NLIB,NIDEPL,
> NCOMB,NEDMAC,NBMIX,NRES,MAXISM,ILCMLN,ILCMTY,IED,
> JED,KED,IDP,IBSTEP,MAXISO,NDEPL,NEDMA0,ITPROC,ISOADD,
- > NADDXS,IPROB,IPROC,IMAC,NDEL,NFISS,IPRECI,STERN,
+ > NADDXS,IPROB,IPROC,IMAC,NDEL,NFISS,IPRECI,NEL,STERN,
> STERNR
REAL TMPDAY(3),DELT,TIMBRN,SVDEPS
INTEGER IKSTEP
@@ -373,7 +373,32 @@
IF(ITYPLU .NE. 1) CALL XABORT(NAMSBR//
> ': INTEGER VALUE EXPECTED FOR CALENDF ACCURACY')
ELSE IF(CARLIR(1:4) .EQ. 'DEPL') THEN
- CALL LIBDEP(IPLIB,IPRINT,NIDEPL)
+ CFILNA='**UNKNOWN**'
+ NEL=0
+ CALL REDGET(ITYPLU,NEL,REALIR,CARLIR,DBLLIR)
+ IF(ITYPLU.EQ.1) THEN
+ CFILNA=' '
+ ELSE IF((ITYPLU.EQ.3).AND.(CARLIR.EQ.'LIB:')) THEN
+ CALL REDGET(ITYPLU,INTLIR,REALIR,HHLIB,DBLLIR)
+ IF(ITYPLU.NE.3) THEN
+ CALL XABORT('LIB: CHARACTER LIBRARY NAME REQUIRED.')
+ ELSE IF((HHLIB.NE.'DRAGON ').AND.(HHLIB.NE.'WIMSAECL').AND.
+ > (HHLIB.NE.'WIMSD4 ').AND.(HHLIB.NE.'WIMSE ').AND.
+ > (HHLIB.NE.'APLIB2 ').AND.(HHLIB.NE.'APLIB3 ').AND.
+ > (HHLIB.NE.'NDAS ').AND.(HHLIB.NE.'APXSM ') ) THEN
+ WRITE(HSMG,'(27HLIB: INVALID EVOL LIB TYPE ,A8)') HHLIB
+ CALL XABORT(HSMG)
+ ENDIF
+ CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
+ IF((ITYPLU.NE.3).OR.(CARLIR.NE.'FIL:'))
+ > CALL XABORT('LIB: FIL: EXPECTED.')
+ CFILNA=' '
+ CALL REDGET(ITYPLU,INTLIR,REALIR,CFILNA,DBLLIR)
+ IF(ITYPLU.NE.3) CALL XABORT('LIB: CHARACTER DATA EXPECTED.')
+ ELSE
+ CALL XABORT('LIB: INVALID KEY WORD AFTER DEPL.')
+ ENDIF
+ CALL LIBDEP(IPLIB,HHLIB,CFILNA,NEL,IPRINT,NIDEPL)
ELSE IF(CARLIR.EQ.'ADED') THEN
CALL REDGET(ITYPLU,NEDMA0,REALIR,CARLIR,DBLLIR)
IF(ITYPLU .NE. 1) CALL XABORT(NAMSBR//
diff --git a/Dragon/src/LIBA20.f b/Dragon/src/LIBA20.f
index 73b65fc..0b2a2c1 100644
--- a/Dragon/src/LIBA20.f
+++ b/Dragon/src/LIBA20.f
@@ -74,7 +74,7 @@
1 TYPSEG*8,HNAMIS*12,HNISOR*12,HNISSS*12,HSMG*131,TEXT2*2,
2 TEXT12*12
LOGICAL LPFIX,LTRAN,LGPROB,LGTDIF,LGTTRA,LN2N,LPTHOM,L104,LABS,
- 1 LDIF,LFIS,LPWD,LPED
+ 1 LDIF,LFIS,LPWD,LPED,LH
INTEGER ZFISS,FGTD,FGHOMO,FGRESO,FAGG,FDGG,WGAL,FAG
DOUBLE PRECISION UU,XDRCST
INTEGER ITHOMO(MAXHOM),ITEXT(20),ISFICH(3),IPAR(3)
@@ -92,10 +92,11 @@
*----
INTEGER, ALLOCATABLE, DIMENSION(:) :: ITYPRO,NFS,KDS,LGS,NOM,NOMS,
1 NOMOB,VINTE,ITCARO,ITC104,ITS104,ITITLE,IZSECT,ISECTT,IFDG,IIAD,
- 2 IDEPL
+ 2 IDEPL,IPR2
INTEGER, ALLOCATABLE, DIMENSION(:,:) :: IPR
REAL, ALLOCATABLE, DIMENSION(:) :: ENERG,DELTA,SECT,XSTOT,TAUX,
- 1 DELTF,SIGTF,SIGAF,ENER,AMASS,TEMP,TEMPS,SEQHO,SQRTE,PWD,PED
+ 1 DELTF,SIGTF,SIGAF,ENER,AMASS,TEMP,TEMPS,SEQHO,SQRTE,PWD,PED,QQNG,
+ 2 QQF,HFACT
REAL, ALLOCATABLE, DIMENSION(:,:) :: SIGS
REAL, ALLOCATABLE, DIMENSION(:,:,:) :: SCAT
LOGICAL, ALLOCATABLE, DIMENSION(:) :: LGTRE
@@ -106,7 +107,7 @@
*----
* SCRATCH STORAGE ALLOCATION
*----
- ALLOCATE(IPR(7+2*(NL-1),NBISO),ITYPRO(NL),NFS(NGRO))
+ ALLOCATE(IPR(7+2*(NL-1),NBISO),IPR2(NBISO),ITYPRO(NL),NFS(NGRO))
ALLOCATE(ENERG(NGRO+1),DELTA(NGRO),SECT(NGRO),SIGS(NGRO,NL),
1 SCAT(NGRO,NGRO,NL),XSTOT(NGRO))
*
@@ -317,7 +318,8 @@
IF(IMPX.GT.1) WRITE(IOUT,820) NISOT,NISOTS,NSEGM
CALL LIBA27(NAMFIL,NBISO,NISOT,NSEGM,NL,ISONRF,ISHINA,MASKI,
1 NOM,NOMOB,IPR)
- DEALLOCATE(NOM)
+ IPR2(:NBISO)=IPR(1,:NBISO)
+ !DEALLOCATE(NOM)
IF(NISOTS.GT.0) DEALLOCATE(NOMS)
CALL KDRCPU(TK2)
TKT(1)=TK2-TK1
@@ -1304,13 +1306,46 @@
600 CONTINUE
ENDIF
CALL LCMPUT(KPLIB,'NG',NGRO,2,SECT)
+
+ CALL LCMLEN(KPLIB,'H-FACTOR',LENGT,ITYLCM)
+ IF(LENGT.NE.0) CALL LCMDEL(KPLIB,'H-FACTOR')
ENDIF
610 CONTINUE
*----
+* PROCESS H-FACTOR INFORMATION
+*----
+ ALLOCATE(QQNG(NISOT),QQF(NISOT))
+ CALL LIBEAQ(NAMFIL,NISOT,IMPX,QQNG,QQF)
+ DO 620 IMX=1,NBISO
+ IF(MASKI(IMX)) THEN
+ KPLIB=IPISO(IMX) ! set IMX-th isotope
+ ISO=IPR2(IMX)
+ ALLOCATE(HFACT(NGRO))
+ HFACT(:NGRO)=0.0
+* NG ENERGY.
+ VALUE=QQNG(ISO)
+ IF(VALUE.NE.0.0) THEN
+ CALL LCMGET(KPLIB,'NG',SECT)
+ HFACT(:NGRO)=HFACT(:NGRO)+SECT(:NGRO)*VALUE*1.0E6
+ LH=.TRUE.
+ ENDIF
+* FISSION ENERGIES.
+ VALUE=QQF(ISO)
+ IF(VALUE.NE.0.0) THEN
+ CALL LCMGET(KPLIB,'NFTOT',SECT)
+ HFACT(:NGRO)=HFACT(:NGRO)+SECT(:NGRO)*VALUE*1.0E6
+ LH=.TRUE.
+ ENDIF
+ IF(LH) CALL LCMPUT(KPLIB,'H-FACTOR',NGRO,2,HFACT)
+ DEALLOCATE(HFACT)
+ ENDIF
+ 620 CONTINUE
+ DEALLOCATE(QQF,QQNG)
+*----
* SCRATCH STORAGE DEALLOCATION
*----
DEALLOCATE(XSTOT,SCAT,SIGS,SECT,DELTA,ENERG)
- DEALLOCATE(NFS,ITYPRO,IPR)
+ DEALLOCATE(NFS,ITYPRO,IPR2,IPR)
RETURN
*
800 FORMAT(/43H LIBA20: PROCESSING APOLIB-2 LIBRARY NAME: ,A12,1H.)
diff --git a/Dragon/src/LIBA30.f b/Dragon/src/LIBA30.f
index 8f5043f..f90461c 100644
--- a/Dragon/src/LIBA30.f
+++ b/Dragon/src/LIBA30.f
@@ -65,7 +65,7 @@
TYPE(C_PTR) KPLIB
CHARACTER RECNAM*80,RECNA2*80,TEXT80*80,HNAMIS*12,HNISOR*12,
1 HSMG*131,TEXT12*12,CFILNA1*64,CFILNA2*64
- LOGICAL L104,LSIGS,LABSO,LFISS,LDIF
+ LOGICAL L104,LSIGS,LABSO,LFISS,LDIF,LH
INTEGER RANK,TYPE,NBYTE,DIMSR(5)
DOUBLE PRECISION XDRCST,DSUM
REAL TKT(5)
@@ -75,7 +75,7 @@
INTEGER, ALLOCATABLE, DIMENSION(:) :: ITYPRO,ORANIS,ENRANG,
1 FSTTMP,TMPMON,ADDTMP,ITEMPA,ISPAOF,IAFAG,IFAGR,FLXADD
INTEGER, ALLOCATABLE, DIMENSION(:,:) :: IPR
- REAL, ALLOCATABLE, DIMENSION(:) :: ENERG,DELTA,SECT,XSTOT,TAUX,
+ REAL, ALLOCATABLE, DIMENSION(:) :: ENERG,DELTA,SECT,HFACT,TAUX,
1 AMASS,TEMP,TEMPM,XS,WGTFLX,BGXS,ABSOXS,DIFFXS,FISSXS,DK104
REAL, ALLOCATABLE, DIMENSION(:,:) :: SIGS
REAL, ALLOCATABLE, DIMENSION(:,:,:) :: SCAT
@@ -84,7 +84,7 @@
* SCRATCH STORAGE ALLOCATION
*----
ALLOCATE(IPR(2,NBISO),ITYPRO(NL))
- ALLOCATE(SECT(NGRO),SIGS(NGRO,NL),SCAT(NGRO,NGRO,NL),XSTOT(NGRO))
+ ALLOCATE(SECT(NGRO),SIGS(NGRO,NL),SCAT(NGRO,NGRO,NL),HFACT(NGRO))
*
ANEUT=REAL(XDRCST('Neutron mass','amu'))
NGF=NGRO+1
@@ -419,7 +419,7 @@
LABSO=.TRUE.
LDIF=.TRUE.
CALL KDRCPU(TK1)
- DO 600 IMX=1,NBISO
+ DO 570 IMX=1,NBISO
KISEG=IPR(2,IMX)
IF(KISEG.GT.0) THEN
WRITE(HNISOR,'(3A4)') (ISONRF(I0,IMX),I0=1,3)
@@ -482,27 +482,66 @@
ENDDO
DEALLOCATE(TAUX,DK104,FISSXS,DIFFXS,ABSOXS,BGXS,TEMP)
ENDIF
- 600 CONTINUE
+ 570 CONTINUE
CALL KDRCPU(TK2)
TKT(3)=TK2-TK1
*----
+* PROCESS H-FACTOR INFORMATION
+*----
+ CALL KDRCPU(TK1)
+ DO 580 IMX=1,NBISO
+ IF(MASKI(IMX)) THEN
+ KPLIB=IPISO(IMX) ! set IMX-th isotope
+ CALL LCMLEN(KPLIB,'H-FACTOR',ILENG,ITYLCM)
+ IF(ILENG.NE.0) CALL LCMDEL(KPLIB,'H-FACTOR')
+ HFACT(:NGRO)=0.0
+ WRITE(HNISOR,'(3A4)') (ISONRF(I0,IMX),I0=1,3)
+ WRITE(RECNAM,'(10HIsotopeXS/,A,8H/Energy/)') TRIM(HNISOR)
+ IF(hdf5_group_exists(IPAP1,TRIM(RECNAM))) THEN
+ LH=.FALSE.
+ VALUE=0.0
+ IF(hdf5_group_exists(IPAP1,TRIM(RECNAM)//'/FISS')) THEN
+ WRITE(RECNA2,'(A,16HFISS/EnergyValue)') TRIM(RECNAM)
+ CALL hdf5_read_data(IPAP1,TRIM(RECNA2),VALUE)
+ IF(VALUE.NE.0.0) THEN
+ CALL LCMGET(KPLIB,'NFTOT',SECT)
+ HFACT(:NGRO)=HFACT(:NGRO)+SECT(:NGRO)*VALUE*1.0E6
+ LH=.TRUE.
+ ENDIF
+ ENDIF
+ IF(hdf5_group_exists(IPAP1,TRIM(RECNAM)//'/MT-102')) THEN
+ WRITE(RECNA2,'(A,18HMT-102/EnergyValue)') TRIM(RECNAM)
+ CALL hdf5_read_data(IPAP1,TRIM(RECNA2),VALUE)
+ IF(VALUE.NE.0.0) THEN
+ CALL LCMGET(KPLIB,'NG',SECT)
+ HFACT(:NGRO)=HFACT(:NGRO)+SECT(:NGRO)*VALUE*1.0E6
+ LH=.TRUE.
+ ENDIF
+ ENDIF
+ IF(LH) CALL LCMPUT(KPLIB,'H-FACTOR',NGRO,2,HFACT)
+ ENDIF
+ ENDIF
+ 580 CONTINUE
+ CALL KDRCPU(TK2)
+ TKT(2)=TKT(2)+TK2-TK1
+*----
* CHECK IF ALL REACTIONS HAVE BEEN PROCESSED.
*----
- DO 575 IMX=1,NBISO
- DO 570 I=1,2
+ DO 600 IMX=1,NBISO
+ DO 590 I=1,2
IF(IPR(I,IMX).NE.0) THEN
WRITE(HSMG,950) I,(ISONAM(I0,IMX),I0=1,3)
CALL XABORT(HSMG)
ENDIF
- 570 CONTINUE
- 575 CONTINUE
+ 590 CONTINUE
+ 600 CONTINUE
IF(IMPX.GT.2) WRITE(IOUT,940) (TKT(I),I=1,3)
*----
* SCRATCH STORAGE DEALLOCATION
*----
IF(NBFLX.GT.0) DEALLOCATE(WGTFLX,FLXADD)
DEALLOCATE(DELTA,ENERG)
- DEALLOCATE(XSTOT,SCAT,SIGS,SECT)
+ DEALLOCATE(HFACT,SCAT,SIGS,SECT)
DEALLOCATE(ITYPRO,IPR)
RETURN
*
diff --git a/Dragon/src/LIBADD.f b/Dragon/src/LIBADD.f
index b7262c5..ba6829b 100644
--- a/Dragon/src/LIBADD.f
+++ b/Dragon/src/LIBADD.f
@@ -1,12 +1,12 @@
*DECK LIBADD
- SUBROUTINE LIBADD (IPLIB,NBISO,MASKI,IMPX,NGRO,NL,ITRANC,ISONAM,
- 1 IPISO,NIR,GIR)
+ SUBROUTINE LIBADD (IPLIB,NBISO,MASKI,IMPX,NGRO,NL,ITRANC,NDEPL,
+ 1 ISONAM,ISONRF,IPISO,NIR,GIR)
*
*-----------------------------------------------------------------------
*
*Purpose:
-* Add transport correction and Goldstein-Cohen data to a /microlib/
-* directory.
+* Add transport correction, Goldstein-Cohen and H-FACTOR data to a
+* /microlib/ directory.
*
*Copyright:
* Copyright (C) 2002 Ecole Polytechnique de Montreal
@@ -30,7 +30,9 @@
* ITRANC transport correction option (=0: no correction; =1: Apollo-
* type; =2: recover TRANC record; =3: Wims-type; =4: leakage
* correction alone).
+* NDEPL number of depleting isotopes.
* ISONAM alias name of each isotope.
+* ISONRF library reference name of each isotope.
* IPISO pointer array towards microlib isotopes.
* NIR group index with an imposed IR slowing-down model (=0 for no
* IR model).
@@ -44,20 +46,24 @@
* SUBROUTINE ARGUMENTS
*----
TYPE(C_PTR) IPLIB,IPISO(NBISO)
- INTEGER NBISO,IMPX,NGRO,NL,ITRANC,ISONAM(3,NBISO),NIR(NBISO)
+ INTEGER NBISO,IMPX,NGRO,NL,ITRANC,NDEPL,ISONAM(3,NBISO),
+ 1 ISONRF(3,NBISO),NIR(NBISO)
LOGICAL MASKI(NBISO)
REAL GIR(NBISO)
*----
* LOCAL VARIABLES
*----
- PARAMETER (IOUT=6)
+ PARAMETER (IOUT=6,NSTATE=40)
+ INTEGER ISTATE(NSTATE)
TYPE(C_PTR) JPLIB,KPLIB
- CHARACTER TEXT12*12,HSMG*131
+ CHARACTER HSONAM*12,HSONRF*12,HSMG*131
*----
* ALLOCATABLE ARRAYS
*----
REAL, ALLOCATABLE, DIMENSION(:) :: WORK,WR2,DELTA
- REAL, ALLOCATABLE, DIMENSION(:,:) :: SCAT
+ REAL, ALLOCATABLE, DIMENSION(:,:) :: SCAT,RER
+ CHARACTER(LEN=8), ALLOCATABLE, DIMENSION(:) :: HREAC
+ CHARACTER(LEN=12), ALLOCATABLE, DIMENSION(:) :: HGAR
*----
* SCRATCH STORAGE ALLOCATION
*----
@@ -75,10 +81,32 @@
DO 15 IGR=1,NGRO
DELTA(IGR)=LOG(DELTA(IGR)/DELTA(IGR+1))
15 CONTINUE
+*----
+* RECOVER DEPLETION DATA.
+*----
+ NREAC=0
+ IF(NDEPL.NE.0) THEN
+ CALL LCMLEN(IPLIB,'DEPL-CHAIN',LENGTH,ITYLCM)
+ IF(LENGTH.EQ.0) THEN
+ CALL LCMLIB(IPLIB)
+ CALL XABORT('LIBADD: MISSING DEPL-CHAIN DATA.')
+ ENDIF
+ CALL LCMSIX(IPLIB,'DEPL-CHAIN',1)
+ CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
+ IF(ISTATE(1).NE.NDEPL) CALL XABORT('LIBADD: INVALID NUMBER OF '
+ 1 //'DEPLETING ISOTOPES.')
+ NREAC=ISTATE(8)
+ ALLOCATE(HGAR(NDEPL),RER(NREAC,NDEPL),HREAC(NREAC))
+ CALL LCMGTC(IPLIB,'ISOTOPESDEPL',12,NDEPL,HGAR)
+ CALL LCMGET(IPLIB,'DEPLETE-ENER',RER)
+ CALL LCMGTC(IPLIB,'DEPLETE-IDEN',8,NREAC,HREAC)
+ CALL LCMSIX(IPLIB,' ',2)
+ ENDIF
*
DO 110 ISO=1,NBISO
IF(MASKI(ISO)) THEN
- WRITE(TEXT12,'(3A4)') ISONAM(1,ISO),ISONAM(2,ISO),ISONAM(3,ISO)
+ WRITE(HSONAM,'(3A4)') (ISONAM(I,ISO),I=1,3)
+ WRITE(HSONRF,'(3A4)') (ISONRF(I,ISO),I=1,3)
KPLIB=IPISO(ISO) ! set ISO-th isotope
IF(.NOT.C_ASSOCIATED(KPLIB)) GO TO 110
CALL LCMLEN(KPLIB,'NTOT0',ILENG,ITYLCM)
@@ -86,7 +114,7 @@
JPLIB=LCMGID(IPLIB,'ISOTOPESLIST')
CALL LCMLIB(JPLIB)
WRITE(HSMG,'(17H LIBADD: ISOTOPE ,A12,6H (ISO=,I6,
- 1 17H) IS NOT DEFINED.)') TEXT12,ISO
+ 1 17H) IS NOT DEFINED.)') HSONAM,ISO
CALL XABORT(HSMG)
ENDIF
*
@@ -101,13 +129,13 @@
CALL LCMPUT(KPLIB,'NGOLD',NGRO,2,WORK)
IF(IMPX.GT.1) THEN
IF(GIR(ISO).EQ.-998.0) THEN
- WRITE(IOUT,210) TEXT12,'PT',NIR(ISO)
+ WRITE(IOUT,210) HSONAM,'PT',NIR(ISO)
ELSE IF(GIR(ISO).EQ.-999.0) THEN
- WRITE(IOUT,210) TEXT12,'PTSL',NIR(ISO)
+ WRITE(IOUT,210) HSONAM,'PTSL',NIR(ISO)
ELSE IF(GIR(ISO).EQ.-1000.0) THEN
- WRITE(IOUT,210) TEXT12,'PTMC',NIR(ISO)
+ WRITE(IOUT,210) HSONAM,'PTMC',NIR(ISO)
ELSE
- WRITE(IOUT,200) TEXT12,GIR(ISO),NIR(ISO)
+ WRITE(IOUT,200) HSONAM,GIR(ISO),NIR(ISO)
ENDIF
ENDIF
ENDIF
@@ -135,7 +163,7 @@
CALL LCMLEN(KPLIB,'SCAT-SAVED',ILENG,ITYLCM)
IF(ILENG.EQ.0) THEN
WRITE(HSMG,'(37H LIBADD: NO SCAT-SAVED RECORD FOR ISO,
- 1 5HTOPE ,A12,1H.)') TEXT12
+ 1 5HTOPE ,A12,1H.)') HSONAM
CALL XABORT(HSMG)
ENDIF
CALL XDRLGS(KPLIB,-1,0,1,1,1,NGRO,WR2,SCAT,ITY)
@@ -165,11 +193,40 @@
* CORRECTIONS.
CALL LCMPUT(KPLIB,'TRANC',NGRO,2,WORK)
ENDIF
+*
+* ADD OR CORRECT H-FACTOR INFORMATION IN THE MICROLIB.
+ IF(NDEPL.NE.0) THEN
+ JDEPL=0
+ DO IDEPL=1,NDEPL
+ JDEPL=IDEPL
+ IF(HSONRF.EQ.HGAR(IDEPL)) GO TO 80
+ ENDDO
+ CYCLE
+ 80 WORK(:NGRO)=0.0
+ CALL LCMLEN(KPLIB,'H-FACTOR',LENGTH,ITYLCM)
+ IF(LENGTH.NE.0) CALL LCMGET(KPLIB,'H-FACTOR',WORK)
+ DO IREA=2,NREAC
+ CALL LCMLEN(KPLIB,HREAC(IREA),LENGTH,ITYLCM)
+ IF(LENGTH.EQ.0) CYCLE
+ IF(LENGTH.GT.NGRO) CALL XABORT('LIBADD: WR2 OVERFLOW.')
+ WR2(:NGRO)=0.0
+ CALL LCMGET(KPLIB,HREAC(IREA),WR2)
+ DO IG=1,LENGTH
+ WORK(IG)=WORK(IG)+RER(IREA,JDEPL)*WR2(IG)*1.0E6
+ ENDDO
+ ENDDO ! IREA
+ CALL LCMPUT(KPLIB,'H-FACTOR',NGRO,2,WORK)
+ IF(IMPX.GT.1) THEN
+ WRITE(IOUT,'(42H LIBADD: ADD H-FACTOR INFORMATION TO ISOTO,
+ 1 3HPE ,A,1H.)') TRIM(HSONRF)
+ ENDIF
+ ENDIF
ENDIF
110 CONTINUE
*----
* SCRATCH STORAGE DEALLOCATION
*----
+ IF(NDEPL.NE.0) DEALLOCATE(HREAC,RER,HGAR)
DEALLOCATE(DELTA,SCAT,WR2,WORK)
RETURN
*
diff --git a/Dragon/src/LIBAPL.f b/Dragon/src/LIBAPL.f
index 24efbcb..aa4367c 100644
--- a/Dragon/src/LIBAPL.f
+++ b/Dragon/src/LIBAPL.f
@@ -899,6 +899,11 @@
SIGA(I)=SIGA(I)+SIGS(I,1)
730 CONTINUE
CALL LCMPUT(KPLIB,'NTOT0',NGRO,2,SIGA)
+*----
+* VOID H-FACTOR
+*----
+ CALL LCMLEN(KPLIB,'H-FACTOR',LENGT,ITYLCM)
+ IF(LENGT.NE.0) CALL LCMDEL(KPLIB,'H-FACTOR')
GO TO 50
*----
* CHECK IF ALL NBISO ISOTOPES HAVE BEEN PROCESSED.
diff --git a/Dragon/src/LIBDEP.F b/Dragon/src/LIBDEP.F
index e1b539a..94ed383 100644
--- a/Dragon/src/LIBDEP.F
+++ b/Dragon/src/LIBDEP.F
@@ -1,5 +1,5 @@
*DECK LIBDEP
- SUBROUTINE LIBDEP(IPLIB,IMPX,NDEPL)
+ SUBROUTINE LIBDEP(IPLIB,HHLIB,CFILNA,NEL,IMPX,NDEPL)
*
*-----------------------------------------------------------------------
*
@@ -18,6 +18,9 @@
*Parameters: input
* IPLIB pointer to the internal microscopic cross section library
* (L_LIBRARY signature).
+* HHLIB library file type.
+* CFILNA library file name.
+* NEL user-defined number of depleting isotopes if CFILNA=' '.
* IMPX print flag.
*
*Parameters: output
@@ -34,19 +37,18 @@
* SUBROUTINE ARGUMENTS
*----
TYPE(C_PTR) IPLIB
- INTEGER IMPX,NDEPL
+ INTEGER IMPX,NDEPL,NEL
+ CHARACTER HHLIB*8,CFILNA*64
*----
* LOCAL PARAMETERS
*----
TYPE(C_PTR) IPDRL
- INTEGER IOUT,NSTATE,MAXR,INDIC,NEL,IEVOT,NITMA,NDFI,
- > NDFP,NHEAVY,NLIGHT,NOTHER,NSTABL,NREAC,NPAR,
- > ITEXT4,I,J,ISTA,ILONG,ITYLCM,NBESP
- REAL FLOTT
+ INTEGER IOUT,NSTATE,MAXR,IEVOT,NDFI,NDFP,NHEAVY,NLIGHT,
+ > NOTHER,NSTABL,NREAC,NPAR,ITEXT4,I,J,ISTA,ILONG,
+ > ITYLCM,NBESP
PARAMETER (IOUT=6,NSTATE=40,MAXR=12)
- DOUBLE PRECISION DBLINP
- CHARACTER NMDEPL(MAXR)*8,TEXT4*4,HSMG*131,CFILNA*64,
- > HHLIB*8,TEXT12*12,NAMLCM*12,NAMMY*12
+ CHARACTER NMDEPL(MAXR)*8,TEXT4*4,HSMG*131,TEXT12*12,
+ > NAMLCM*12,NAMMY*12,HVERS*12
LOGICAL EMPTY,LCM,LEXIST
INTEGER ISTATE(NSTATE)
#if defined(HDF5_LIB)
@@ -71,28 +73,11 @@
*----
* READ INFORMATION AVAILABLE ON INPUT
*----
- CALL REDGET(INDIC,NEL,FLOTT,TEXT4,DBLINP)
IEVOT=-99
NBESP=1
- IF(INDIC.EQ.1) THEN
- IEVOT=0
- ELSE IF((INDIC.EQ.3).AND.(TEXT4.EQ.'LIB:')) THEN
- CALL REDGET(INDIC,NITMA,FLOTT,HHLIB,DBLINP)
- IF(INDIC.NE.3) THEN
- CALL XABORT('LIBDEP: CHARACTER LIBRARY NAME REQUIRED.')
- ELSE IF((HHLIB.NE.'DRAGON ') .AND. (HHLIB.NE.'WIMSAECL') .AND.
- > (HHLIB.NE.'WIMSD4 ') .AND. (HHLIB.NE.'WIMSE ') .AND.
- > (HHLIB.NE.'APLIB2 ') .AND. (HHLIB.NE.'APLIB3 ') .AND.
- > (HHLIB.NE.'NDAS ') .AND. (HHLIB.NE.'APXSM ') ) THEN
- WRITE(HSMG,'(30HLIBDEP: INVALID EVOL LIB TYPE ,A8)') HHLIB
- CALL XABORT(HSMG)
- ENDIF
- CALL REDGET(INDIC,NITMA,FLOTT,TEXT4,DBLINP)
- IF((INDIC.NE.3).OR.(TEXT4.NE.'FIL:'))
- > CALL XABORT('LIBDEP: FIL: EXPECTED.')
- CFILNA=' '
- CALL REDGET(INDIC,NITMA,FLOTT,CFILNA,DBLINP)
- IF(INDIC.NE.3) CALL XABORT('LIBDEP: CHARACTER DATA EXPECTED.')
+ IF(CFILNA.EQ.' ') THEN
+ IEVOT=0
+ ELSE
IF(HHLIB.EQ.'DRAGON') THEN
TEXT12=CFILNA(:12)
CALL LCMINF(IPLIB,NAMLCM,NAMMY,EMPTY,ILONG,LCM)
@@ -106,6 +91,15 @@
CALL XABORT(HSMG)
ENDIF
CALL LCMOP(IPDRL,TEXT12,2,2,0)
+ HVERS='**UNKNOWN**'
+ CALL LCMLEN(IPDRL,'VERSION',ILONG,ITYLCM)
+ IF(ILONG.NE.0) CALL LCMGTC(IPDRL,'VERSION',12,HVERS)
+ IF(IMPX.GT.0) WRITE (IOUT,6010) TRIM(TEXT12),TRIM(HVERS)
+ IF(HVERS.EQ.'RELEASE_2003') THEN
+ HSMG='LIBDEP: ***WARNING*** RELEASE_2003 DRAGLIBS ARE DE'
+ > //'PRECIATED.'
+ WRITE(IOUT,'(1X,A)') HSMG
+ ENDIF
ENDIF
CALL LCMLEN(IPDRL,'DEPL-CHAIN',ILONG,ITYLCM)
IF(ILONG.EQ.0) THEN
@@ -184,8 +178,6 @@
CALL XABORT('LIBDEP: THE HDF5 API IS NOT AVAILABLE(1).')
#endif /* defined(HDF5_LIB) */
ENDIF
- ELSE
- CALL XABORT('LIBDEP: INVALID KEY WORD.')
ENDIF
IF(IEVOT.EQ.0.OR.IEVOT.GT.1) THEN
*----
@@ -310,4 +302,5 @@
> ' NPAR ',I6,' (MAXIMUM NUMBER OF PARENT REACTIONS)'/
> ' NBESP ',I6,' (NUMBER OF ENERGY-DEPENDENT FISSION YIELD MAT',
> 'RICES)'/)
+ 6010 FORMAT(/33H PROCESSING DRAGON LIBRARY NAMED ,A,9H VERSION ,A,1H.)
END
diff --git a/Dragon/src/LIBDRA.f b/Dragon/src/LIBDRA.f
index 51438a9..e846822 100644
--- a/Dragon/src/LIBDRA.f
+++ b/Dragon/src/LIBDRA.f
@@ -63,7 +63,7 @@
*----
* LOCAL VARIABLES
*----
- CHARACTER CD*4,HSMG*131,HTITLE*80,HNISOR*12,HNAMIS*12,HNUSIG*12,
+ CHARACTER CD*4,HSMG*131,HVERS*12,HNISOR*12,HNAMIS*12,HNUSIG*12,
1 HCHI*12
PARAMETER (IOUT=6,MAXTMP=50,NOTX=3)
TYPE(C_PTR) KPLIB
@@ -74,13 +74,14 @@
*----
* ALLOCATABLE ARRAYS
*----
- INTEGER, ALLOCATABLE, DIMENSION(:) :: NFS,ITYPRO,ITITLE
+ INTEGER, ALLOCATABLE, DIMENSION(:) :: NFS,ITYPRO
REAL, ALLOCATABLE, DIMENSION(:) :: AWR,DELTA,TOTAL,GOLD,ZNPHI,
1 ENER,BIN,EBIN,SIGS2,SCAT2,TOTAL2,SIGF2,CHI2,SADD2,GOLD2,BIN2,
2 ZNPHI2,CHI4G2
REAL, ALLOCATABLE, DIMENSION(:,:) :: SIGS,SIGF,CHI,SADD,CHI4G
REAL, ALLOCATABLE, DIMENSION(:,:,:) :: SCAT
LOGICAL, ALLOCATABLE, DIMENSION(:) :: LSCAT,LADD
+ CHARACTER(LEN=80), ALLOCATABLE, DIMENSION(:) :: HTITLE
*----
* SCRATCH STORAGE ALLOCATION
*----
@@ -95,20 +96,24 @@
NGF=NGRO+1
NGFR=0
NDEL=0
- IF(IMPX.GT.0) WRITE (IOUT,900) NAMFIL
+ HVERS='**UNKNOWN**'
+ CALL LCMLEN(IPDRL,'VERSION',LENGT,ITYLCM)
+ IF(LENGT.NE.0) CALL LCMGTC(IPDRL,'VERSION',12,HVERS)
+ IF(IMPX.GT.0) WRITE (IOUT,900) TRIM(NAMFIL),TRIM(HVERS)
+ IF(HVERS.EQ.'RELEASE_2003') THEN
+ WRITE(IOUT,'(46H LIBDRA: ***WARNING*** RELEASE_2003 DRAGLIBS A,
+ 1 15HRE DEPRECIATED.)')
+ ENDIF
CALL LCMLEN(IPDRL,'README',LENGT,ITYLCM)
IF((IMPX.GT.0).AND.(LENGT.GT.0)) THEN
- ALLOCATE(ITITLE(LENGT))
- CALL LCMGET(IPDRL,'README',ITITLE)
+ LENGT=(LENGT-1)/20+1
+ ALLOCATE(HTITLE(LENGT))
+ CALL LCMGTC(IPDRL,'README',80,LENGT,HTITLE)
WRITE (IOUT,940)
- I2=0
- DO 10 J=0,LENGT/20
- I1=I2+1
- I2=MIN(I1+19,LENGT)
- WRITE (HTITLE,'(20A4)') (ITITLE(I),I=I1,I2)
- WRITE (IOUT,'(1X,A80)') HTITLE
+ DO 10 J=1,LENGT
+ WRITE (IOUT,'(1X,A80)') HTITLE(J)
10 CONTINUE
- DEALLOCATE(ITITLE)
+ DEALLOCATE(HTITLE)
WRITE (IOUT,'(40H LIBDRA: NUMBER OF ISOTOPES IN MICROLIB=,I6)')
1 NBISO
ENDIF
@@ -157,18 +162,15 @@
CALL LCMGET(IPDRL,'AWR',AWR(IMX))
CALL LCMLEN(IPDRL,'README',LTITLE,ITYLCM)
IF(LTITLE.GT.0) THEN
- ALLOCATE(ITITLE(LTITLE))
- CALL LCMGET(IPDRL,'README',ITITLE)
- IF(IMPX.GT.0) THEN
- WRITE (IOUT,930)
- I2=0
- DO 20 J=0,LTITLE/20
- I1=I2+1
- I2=MIN(I1+19,LTITLE)
- WRITE (HTITLE,'(20A4)') (ITITLE(I),I=I1,I2)
- WRITE (IOUT,'(1X,A80)') HTITLE
- 20 CONTINUE
- ENDIF
+ LTITLE=(LTITLE-1)/20+1
+ ALLOCATE(HTITLE(LTITLE))
+ CALL LCMGTC(IPDRL,'README',80,LTITLE,HTITLE)
+ IF(IMPX.GT.0) THEN
+ WRITE (IOUT,930)
+ DO 20 J=1,LTITLE
+ WRITE (IOUT,'(1X,A80)') HTITLE(J)
+ 20 CONTINUE
+ ENDIF
ENDIF
*----
* RECOVER BIN TYPE INFORMATION (IF AVAILABLE).
@@ -326,8 +328,8 @@
CALL LCMPTC(KPLIB,'ALIAS',12,HNAMIS)
CALL LCMPUT(KPLIB,'AWR',1,2,AWR(IMX))
IF(LTITLE.GT.0) THEN
- CALL LCMPUT(KPLIB,'README',LTITLE,3,ITITLE)
- DEALLOCATE(ITITLE)
+ CALL LCMPTC(KPLIB,'README',80,LTITLE,HTITLE)
+ DEALLOCATE(HTITLE)
ENDIF
DO 220 IG=1,NGRO
IF(TOTAL(IG).LT.0.0) THEN
@@ -371,6 +373,8 @@
260 CONTINUE
ENDIF
CALL XDRLGS(KPLIB,1,0,0,NL-1,1,NGRO,SIGS,SCAT,ITYPRO)
+ CALL LCMLEN(KPLIB,'H-FACTOR',LENGT,ITYLCM)
+ IF(LENGT.NE.0) CALL LCMDEL(KPLIB,'H-FACTOR')
DO 340 IED=1,NED
IF(LADD(IED).AND.(HVECT(IED)(:3).NE.'CHI')
1 .AND.(HVECT(IED)(:2).NE.'NU')
@@ -407,7 +411,7 @@
DEALLOCATE(ITYPRO,NFS)
RETURN
*
- 900 FORMAT(/33H PROCESSING DRAGON LIBRARY NAMED ,A12,1H.)
+ 900 FORMAT(/33H PROCESSING DRAGON LIBRARY NAMED ,A,9H VERSION ,A,1H.)
910 FORMAT(26HLIBDRA: MATERIAL/ISOTOPE ',A12,5H' = ',A12,9H' IS MISS,
1 25HING ON DRAGON FILE NAMED ,A12,10H (ISOTOPE=,I10,2H).)
920 FORMAT(/30H PROCESSING ISOTOPE/MATERIAL ',A12,11H' (HNISOR=',A12,
diff --git a/Dragon/src/LIBE3R.f b/Dragon/src/LIBE3R.f
index c644c52..045db16 100644
--- a/Dragon/src/LIBE3R.f
+++ b/Dragon/src/LIBE3R.f
@@ -51,7 +51,7 @@
DOUBLE PRECISION SUM
PARAMETER (IOUT=6,MAXR2=12)
PARAMETER (KDECAY=1,KFISSP=2,KCAPTU=3,KN2N=4,KN3N=5,KN4N=6)
- CHARACTER RECNAM*80,RECNAM2*80,HSMG*131,NMDEPA(MAXR2)*6
+ CHARACTER RECNAM*80,HSMG*131,NMDEPA(MAXR2)*6
*----
* ALLOCATABLE ARRAYS
*----
@@ -141,6 +141,7 @@
* MAIN LOOP OVER ISOTOPES
*----
NDFP2=0
+ BPAX(:NBESP,:NEL+MAXR,:NEL)=0.0
DO ISO=1,NISOT
ITZEA(ISO)=IZ(ISO)*10000+IA(ISO)*10
II=LEN(TRIM(NAMES(ISO)))
@@ -171,22 +172,8 @@
ENDDO
DEALLOCATE(LIST)
ENDIF
- WRITE(RECNAM,'(10HIsotopeXS/,A,8H/Energy/)') TRIM(NAMES(ISO))
- IF(hdf5_group_exists(IPAP1,TRIM(RECNAM))) THEN
- IF(KPAX(NEL+KFISSP,ISO).EQ.1) THEN
- WRITE(RECNAM2,'(A,16HFISS/EnergyValue)') TRIM(RECNAM)
- CALL hdf5_read_data(IPAP1,TRIM(RECNAM2),VALUE)
- BPAX(:,NEL+KFISSP,ISO)=VALUE
- ENDIF
- IF(KPAX(NEL+KCAPTU,ISO).EQ.1) THEN
- WRITE(RECNAM2,'(A,18HMT-102/EnergyValue)') TRIM(RECNAM)
- CALL hdf5_read_data(IPAP1,TRIM(RECNAM2),VALUE)
- BPAX(:,NEL+KCAPTU,ISO)=VALUE
- ENDIF
- ENDIF
IF(IMPX.GT.2) THEN
- WRITE(IOUT,100) NAMES(ISO),BPAX(1,NEL+KDECAY,ISO),
- 1 BPAX(1,NEL+KFISSP,ISO),BPAX(1,NEL+KCAPTU,ISO)
+ WRITE(IOUT,100) NAMES(ISO),BPAX(1,NEL+KDECAY,ISO)
WRITE(IOUT,110) (NMDEPA(I),KPAX(NEL+I,ISO),I=1,MAXR)
ENDIF
*----
@@ -291,8 +278,7 @@
RETURN
*
100 FORMAT(/44H LIBE3R: DECAY AND BURNOUT DATA FOR ISOTOPE=,A/
- 1 5X,6HDECAY=,1P,E12.5,7H E-8 /S,16H FISSION ENERGY=,E12.5,4H MEV,
- 1 16H CAPTURE ENERGY=,E12.5,4H MEV)
+ 1 5X,6HDECAY=,1P,E12.5,7H E-8 /S)
110 FORMAT(5X,12(A6,2H= ,I1,2X))
120 FORMAT(5X,14HPARENT NAMES: ,12A8/(19X,12A8))
END
diff --git a/Dragon/src/LIBEAQ.f b/Dragon/src/LIBEAQ.f
new file mode 100644
index 0000000..b969108
--- /dev/null
+++ b/Dragon/src/LIBEAQ.f
@@ -0,0 +1,254 @@
+*DECK LIBEAQ
+ SUBROUTINE LIBEAQ(CFILNA,NEL,IMPX,QQNG,QQF)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Recover Q and pseudo-Q values from an APOLIB2 file.
+*
+*Copyright:
+* Copyright (C) 2025 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version.
+*
+*Author(s): A. Hebert
+*
+*Parameters: input
+* CFILNA APOLIB-2 file name.
+* NEL number of isotopes on library.
+* IMPX print flag.
+*
+*Parameters: output
+* QQNG radiative capture Q value.
+* QQF fission pseudo Q value.
+*
+*-----------------------------------------------------------------------
+*
+ USE GANLIB
+*----
+* SUBROUTINE ARGUMENTS
+*----
+ CHARACTER CFILNA*(*)
+ INTEGER NEL,IMPX
+ REAL QQNG(NEL),QQF(NEL)
+*----
+* LOCAL VARIABLES
+*----
+ EXTERNAL LIBA21
+ INTEGER ISFICH(3),NITCA(5)
+ PARAMETER (IOUT=6)
+ CHARACTER TEXT20*20,NOMOBJ*20,TEXT12*12,TEXT16*16,TYPOBJ*8,
+ > TYPSEG*8,HNISOR*20,HSMG*131
+ LOGICAL LPHEAD,LPCONS,LPFIX
+*----
+* SCRATCH STORAGE ALLOCATION
+*----
+ INTEGER, ALLOCATABLE, DIMENSION(:) :: VINTE,NOMOB,KDS,LGS,ITCARO,
+ 1 NOM
+ TYPE(C_PTR) ICHDIM_PTR,ICHTYP_PTR,ICHDKL_PTR,TSEGM_PTR
+ INTEGER, POINTER, DIMENSION(:) :: ICHDIM,ICHTYP,ICHDKL,ITSEGM
+ REAL, POINTER, DIMENSION(:) :: RTSEGM
+*
+ INTEGER TKCARO(31)
+ SAVE TKCARO
+ DATA TKCARO /
+ & 0, 1, 2, 3, 4, 5, 6, 30, 7, -8,
+ & 9, -10, 11, -12, 13, -14, 15, 16, -17, 18,
+ & -19, 20, -21, 22, 23, -24, 25, -26, 27, -28,
+ & 29 /
+*----
+* OPEN AND PROBE THE APOLIB-2 FILE.
+*----
+ CALL AEXTPA(CFILNA,ISFICH)
+ IADRES=ISFICH(1)
+ NBOBJ=ISFICH(2)
+ LBLOC=ISFICH(3)
+ IUNIT=KDROPN(CFILNA,2,4,LBLOC)
+ IF(IUNIT.LE.0) THEN
+ TEXT12=CFILNA
+ CALL XABORT('LIBEAQ: APOLLO-2 LIBRARY '//TEXT12//' CANNOT B'//
+ 1 'E OPENED')
+ ENDIF
+*----
+* INDEX THE APOLIB-2 FILE.
+*----
+ ALLOCATE(VINTE(2*NBOBJ))
+ CALL AEXDIR(IUNIT,LBLOC,VINTE,IADRES,2*NBOBJ)
+ IDKNO=1-TKCARO(14)
+ IDKTY=1-TKCARO(21)
+ IDKDS=1-TKCARO(10)
+ IDKTS=1-TKCARO(23)
+ IDKNS=TKCARO(2)+1
+ IDKLS=TKCARO(8)
+*
+ NSEGM=0
+ NMGY=0
+ NISOT=0
+ ALLOCATE(NOMOB(5*(NBOBJ-3)),KDS(NBOBJ-3),LGS(NBOBJ-3))
+ LPHEAD=.FALSE.
+ LPCONS=.FALSE.
+ DO 80 IOBJ=3,NBOBJ
+ IDKOBJ=VINTE(2*IOBJ-1)
+ LGSEG=VINTE(2*IOBJ)+1
+ ALLOCATE(ITCARO(LGSEG))
+ CALL AEXDIR(IUNIT,LBLOC,ITCARO,IDKOBJ,LGSEG)
+ IDK=ITCARO(IDKNO)
+ CALL AEXCPC(IDK,20,ITCARO(1),NOMOBJ)
+ IDK=ITCARO(IDKTY)
+ CALL AEXCPC(IDK,8,ITCARO(1),TYPOBJ)
+ JDKDS=ITCARO(IDKDS)
+ JDKTS=ITCARO(IDKTS)
+ NS=ITCARO(IDKNS)
+ IF(TYPOBJ.EQ.'APOLIB') THEN
+ DO 70 IS=1,NS
+ IDK=JDKTS+8*(IS-1)
+ CALL AEXCPC(IDK,8,ITCARO(1),TYPSEG)
+ LTESTS=ITCARO(IDKLS+IS)
+ IF(LTESTS.LE.0) GO TO 70
+ JDKS=ITCARO(JDKDS+IS)
+ CALL AEXTRT(LIBA21,TYPSEG,NBRTYP,ICHDIM_PTR,ICHTYP_PTR,
+ 1 ICHDKL_PTR)
+ CALL C_F_POINTER(ICHDIM_PTR,ICHDIM,(/ NBRTYP /))
+ CALL C_F_POINTER(ICHTYP_PTR,ICHTYP,(/ NBRTYP /))
+ CALL C_F_POINTER(ICHDKL_PTR,ICHDKL,(/ NBRTYP /))
+ TSEGM_PTR=LCMARA(LTESTS+1)
+ CALL C_F_POINTER(TSEGM_PTR,ITSEGM,(/ LTESTS+1 /))
+ CALL C_F_POINTER(TSEGM_PTR,RTSEGM,(/ LTESTS+1 /))
+ CALL AEXDIR(IUNIT,LBLOC,ITSEGM,JDKS,LTESTS+1)
+ IF(TYPSEG.EQ.'PHEAD') THEN
+ LPHEAD=.TRUE.
+ CALL AEXGNV(3,ITSEGM,ICHDIM,ICHTYP,
+ 1 ICHDKL,IDK,NV)
+ IF(NV.EQ.0) THEN
+ TEXT12=CFILNA
+ CALL XABORT('LIBEAQ: NO ISOTOPES PRESENT ON APOLIB-2 '//
+ 1 'FILE NAMED: '//TEXT12)
+ ENDIF
+ NISOT=NV/20
+ IF(NISOT.NE.NEL) CALL XABORT('LIBEAQ: INVALID NEL.')
+ ALLOCATE(NOM(5*NISOT))
+ DO 20 ISO=1,NISOT
+ ISO2=(ISO-1)*5+1
+ CALL AEXCPC(0,20,ITSEGM(IDK+ISO2-1),HNISOR)
+ CALL LCMCAR(HNISOR,.TRUE.,NOM(ISO2))
+ 20 CONTINUE
+ ENDIF
+ CALL LCMDRD(TSEGM_PTR)
+ CALL LCMDRD(ICHDIM_PTR)
+ CALL LCMDRD(ICHTYP_PTR)
+ CALL LCMDRD(ICHDKL_PTR)
+ 70 CONTINUE
+ ELSE IF(TYPOBJ.EQ.'APOLIBE') THEN
+ NSEGM=NSEGM+1
+ ISO2=(NSEGM-1)*5+1
+ CALL LCMCAR(NOMOBJ,.TRUE.,NOMOB(ISO2))
+ KDS(NSEGM)=IDKOBJ
+ LGS(NSEGM)=LGSEG
+ ELSE
+ CALL XABORT('LIBEAQ: WEIRD SEGMENT TYPE: '//TYPOBJ//' (1).')
+ ENDIF
+ DEALLOCATE(ITCARO)
+ 80 CONTINUE
+ IF(.NOT.LPHEAD) CALL XABORT('LIBEAQ: PHEAD SEGMENT NOT FOUND.')
+ DEALLOCATE(VINTE)
+*----
+* SET THE CORRESPONDANCE BETWEEN THE APOLIB AND THE LIST OF ISOTOPES.
+*----
+ IF(IMPX.GT.2) WRITE(IOUT,'(/16H LIBEAQ: ISOTOPE,12X,4HQ-NG,9X,
+ 1 9HQ-FISSION)')
+ KISEG2=0
+ DO 260 ISO=1,NISOT
+ ISO2=(ISO-1)*5+1
+ CALL LCMCAR(TEXT16,.FALSE.,NOM(ISO2))
+ TEXT20='ISOTOP'//TEXT16(:14)
+ CALL LCMCAR(TEXT20,.TRUE.,NITCA(1))
+ DO 90 ISEG=1,NSEGM
+ ISEG2=(ISEG-1)*5+1
+ IF(NITCA(1).EQ.NOMOB(ISEG2)) THEN
+ IF(NITCA(2).EQ.NOMOB(ISEG2+1)) THEN
+ IF(NITCA(3).EQ.NOMOB(ISEG2+2)) THEN
+ IF(NITCA(4).EQ.NOMOB(ISEG2+3)) THEN
+ IF(NITCA(5).EQ.NOMOB(ISEG2+4)) THEN
+ KISEG2=ISEG
+ GO TO 120
+ ENDIF
+ ENDIF
+ ENDIF
+ ENDIF
+ ENDIF
+ 90 CONTINUE
+ WRITE (HSMG,500) HNISOR,CFILNA
+ CALL XABORT(HSMG)
+*----
+* ACTIVATION OF CORRESPONDING 'ISOTOP'//NAME SEGMENT.
+*----
+ 120 IDKOBJ=KDS(KISEG2)
+ LGSEG=LGS(KISEG2)
+ ALLOCATE(ITCARO(LGSEG))
+ CALL AEXDIR(IUNIT,LBLOC,ITCARO,IDKOBJ,LGSEG)
+ IDK=ITCARO(IDKNO)
+ CALL AEXCPC(IDK,20,ITCARO(1),NOMOBJ)
+ IDK=ITCARO(IDKTY)
+ CALL AEXCPC(IDK,8,ITCARO(1),TYPOBJ)
+ JDKDS=ITCARO(IDKDS)
+ JDKTS=ITCARO(IDKTS)
+ NS=ITCARO(IDKNS)
+*----
+* RECOVER THE INFINITE DILUTION CROSS SECTION NUMEROTATION.
+*----
+ LPFIX=.FALSE.
+ DO 160 IS=1,NS
+ IDK=JDKTS+8*(IS-1)
+ CALL AEXCPC(IDK,8,ITCARO(1),TYPSEG)
+ LTESTS=ITCARO(IDKLS+IS)
+ IF(LTESTS.LE.0) GO TO 160
+ JDKS=ITCARO(JDKDS+IS)
+ CALL AEXTRT(LIBA21,TYPSEG,NBRTYP,ICHDIM_PTR,ICHTYP_PTR,ICHDKL_PTR)
+ CALL C_F_POINTER(ICHDIM_PTR,ICHDIM,(/ NBRTYP /))
+ CALL C_F_POINTER(ICHTYP_PTR,ICHTYP,(/ NBRTYP /))
+ CALL C_F_POINTER(ICHDKL_PTR,ICHDKL,(/ NBRTYP /))
+ TSEGM_PTR=LCMARA(LTESTS+1)
+ CALL C_F_POINTER(TSEGM_PTR,ITSEGM,(/ LTESTS+1 /))
+ CALL C_F_POINTER(TSEGM_PTR,RTSEGM,(/ LTESTS+1 /))
+ CALL AEXDIR(IUNIT,LBLOC,ITSEGM,JDKS,LTESTS+1)
+*----
+* RECOVER Q VALUES.
+*----
+ IF(TYPSEG.EQ.'PFIX') THEN
+ LPFIX=.TRUE.
+* NG ENERGY.
+ CALL AEXGNV(11,ITSEGM,ICHDIM,ICHTYP,ICHDKL,IDK,NV)
+ IF(NV.NE.0) THEN
+ IF(RTSEGM(IDK).NE.0.0) QQNG(ISO)=RTSEGM(IDK)
+ ENDIF
+* FISSION ENERGIES.
+ CALL AEXGNV(20,ITSEGM,ICHDIM,ICHTYP,ICHDKL,IDK,NMGEF)
+ IF(NMGEF.NE.0) THEN
+ IF(RTSEGM(IDK+NMGEF-1).NE.0.0) QQF(ISO)=RTSEGM(IDK+NMGEF-1)
+ ENDIF
+ ENDIF
+ CALL LCMDRD(TSEGM_PTR)
+ CALL LCMDRD(ICHDIM_PTR)
+ CALL LCMDRD(ICHTYP_PTR)
+ CALL LCMDRD(ICHDKL_PTR)
+ 160 CONTINUE
+ IF(.NOT.LPFIX) CALL XABORT('LIBEAQ: NO PFIX SEGMENT.')
+ DEALLOCATE(ITCARO)
+ IF(IMPX.GT.2) WRITE(IOUT,'(9X,A16,1P,2E13.4)') TEXT16,
+ 1 QQNG(ISO),QQF(ISO)
+ 260 CONTINUE
+*
+ DEALLOCATE(LGS,KDS,NOMOB,NOM)
+ IERR=KDRCLS(IUNIT,1)
+ IF(IERR.LT.0) THEN
+ TEXT12=CFILNA
+ CALL XABORT('LIBEAQ: APOLLO-2 LIBRARY '//TEXT12//' CANNOT B'//
+ 1 'E CLOSED')
+ ENDIF
+ RETURN
+*
+ 500 FORMAT(26HLIBEAQ: MATERIAL/ISOTOPE ',A20,20H' IS MISSING ON APOL,
+ > 15HIB-2 FILE NAME ,A12,1H.)
+ END
diff --git a/Dragon/src/LIBEAR.f b/Dragon/src/LIBEAR.f
index 8b7746c..1bc1d67 100644
--- a/Dragon/src/LIBEAR.f
+++ b/Dragon/src/LIBEAR.f
@@ -30,7 +30,7 @@
* atomic number z*10000 (digits) + mass number a*10 +
* energy state (0 = ground state, 1 = first state, etc.).
* KPAX complete reaction type matrix.
-* BPAX complete branching ratio matrix.
+* BPAX complete branching ratio matrix. Q values are not recovered.
*
*-----------------------------------------------------------------------
*
@@ -50,7 +50,9 @@
CHARACTER CFILNA*(*),NMDEPL(MAXR)*8
INTEGER MAXR,NEL,ITNAM(3,NEL),ITZEA(NEL),KPAX(NEL+MAXR,NEL)
REAL BPAX(NEL+MAXR,NEL)
-*
+*----
+* LOCAL VARIABLES
+*----
EXTERNAL LIBA21
INTEGER ISFICH(3),NITCA(5)
PARAMETER (IOUT=6)
@@ -288,7 +290,6 @@
IF(NV.NE.0) THEN
IF(RTSEGM(IDK).NE.0.0) THEN
KPAX(NEL+3,ISO)=1
- BPAX(NEL+3,ISO)=RTSEGM(IDK)
ENDIF
ENDIF
* AVAILABLE CROSS SECTION TYPES.
@@ -305,7 +306,6 @@
IF(NMGEF.NE.0) THEN
IF(RTSEGM(IDK+NMGEF-1).NE.0.0) THEN
KPAX(NEL+2,ISO)=1
- BPAX(NEL+2,ISO)=RTSEGM(IDK+NMGEF-1)
ENDIF
ENDIF
* RADIOACTIVE DECAY CONSTANTS.
diff --git a/Dragon/src/LIBLIB.f b/Dragon/src/LIBLIB.f
index 53abc67..59712d2 100644
--- a/Dragon/src/LIBLIB.f
+++ b/Dragon/src/LIBLIB.f
@@ -45,7 +45,7 @@
*----
TYPE(C_PTR) JPLIB,KPLIB
INTEGER IPAR(NSTATE),NGRO,NL,ITRANC,ITIME,NLIB,NGF,IGRMAX,NED,
- > NDEL,IPROC,ILENG,ITYLCM,IVOID,NBESP,ISOT,NPART,IOF
+ > NDEL,IPROC,ILENG,ITYLCM,IVOID,NBESP,ISOT,NPART,NDEPL,IOF
CHARACTER HVECT(MAXED)*8,TEXT4*4,NAMLBT*8,TEXT12*12
*----
* ALLOCATABLE ARRAYS
@@ -59,6 +59,7 @@
*----
* RECOVER INFORMATION FROM THE /MICROLIB/ DIRECTORY.
*----
+
CALL LCMGET(IPLIB,'STATE-VECTOR',IPAR)
IF(NBISO.NE.IPAR(2)) CALL XABORT('LIBLIB: INCONSISTENT LIBRARY.')
NGRO=IPAR(3)
@@ -68,6 +69,7 @@
NLIB=IPAR(8)
NGF=IPAR(9)
IGRMAX=IPAR(10)
+ NDEPL=IPAR(11)
NED=IPAR(13)
IF(NED.GT.MAXED) CALL XABORT('LIBLIB: MAXED OVERFLOW.')
NBESP=IPAR(16)
@@ -151,7 +153,7 @@
*----
CALL LIBLIC (IPLIB,NBISO,MASKI,IMPX,NGRO,NL,ITRANC,ITIME,NLIB,
1 NED,HVECT,ISONA,ISONR,IPISO,ISHIN,TMPIS,IHLIB,ILLIB,NAME,NTFG,
- 2 LSHI,SN,SB,NIR,GIR,NGF,IGRMAX,NDEL,NBESP,NPART,IPROC)
+ 2 LSHI,SN,SB,NIR,GIR,NGF,IGRMAX,NDEL,NBESP,NPART,IPROC,NDEPL)
*----
* RESET ISOTOPE ALIAS.
*----
diff --git a/Dragon/src/LIBLIC.F b/Dragon/src/LIBLIC.F
index a669c9d..8079f3a 100644
--- a/Dragon/src/LIBLIC.F
+++ b/Dragon/src/LIBLIC.F
@@ -1,7 +1,8 @@
*DECK LIBLIC
SUBROUTINE LIBLIC (IPLIB,NBISO,MASKI,IMPX,NGRO,NL,ITRANC,ITIME,
1 NLIB,NED,HVECT,ISONAM,ISONRF,IPISO,ISHINA,TMPISO,IHLIB,ILLIB,
- 2 INAME,NTFG,LSHI,SN,SB,NIR,GIR,NGF,IGRMAX,NDEL,NBESP,NPART,IPROC)
+ 2 INAME,NTFG,LSHI,SN,SB,NIR,GIR,NGF,IGRMAX,NDEL,NBESP,NPART,IPROC,
+ 3 NDEPL)
*
*-----------------------------------------------------------------------
*
@@ -63,6 +64,7 @@
* NBESP number of energy-dependent fission spectra.
* NPART number of particles.
* IPROC type of library processing.
+* NDEPL number of depleting isotopes.
*
*-----------------------------------------------------------------------
*
@@ -76,7 +78,7 @@
*----
TYPE(C_PTR) IPLIB,IPISO(NBISO)
INTEGER NBISO,IMPX,NGRO,NL,ITRANC,ITIME,NLIB,NED,NGF,IGRMAX,NDEL,
- > NBESP,NPART,IPROC,ISONAM(3,NBISO),ISONRF(3,NBISO),
+ > NBESP,NPART,IPROC,NDEPL,ISONAM(3,NBISO),ISONRF(3,NBISO),
> ISHINA(3,NBISO),IHLIB(2,NBISO,4),ILLIB(NBISO),INAME(16,NLIB),
> NTFG(NBISO),LSHI(NBISO),NIR(NBISO)
LOGICAL MASKI(NBISO)
@@ -238,8 +240,8 @@
ENDIF
*
* COMPUTE THE TRANSPORT XS AND ADD COMPLEMENTARY INFORMATION.
- CALL LIBADD(IPLIB,NBIS,MASKI(IND1),IMPX,NGRO,NL,ITRANC,
- 1 ISONAM(1,IND1),IPISO(IND1),NIR(IND1),GIR(IND1))
+ CALL LIBADD(IPLIB,NBIS,MASKI(IND1),IMPX,NGRO,NL,ITRANC,NDEPL,
+ 1 ISONAM(1,IND1),ISONRF(1,IND1),IPISO(IND1),NIR(IND1),GIR(IND1))
ENDIF
*
IND1=IND1+NBIS
diff --git a/Dragon/src/LIBND1.f b/Dragon/src/LIBND1.f
index 7827a6a..e99a274 100644
--- a/Dragon/src/LIBND1.f
+++ b/Dragon/src/LIBND1.f
@@ -67,7 +67,7 @@
TYPE(C_PTR) KPLIB
INTEGER I,I0,IERR,HEADER(16),NISOLB,NGFIS,NGTHER,MAXTMP,MAXDIL,
1 MAXTDN,MAXPN,NF,NP1,IND,IHEAD(200),NBTEM,NBDIL,ISOID,IG,IG1,NL2,
- 2 IJ,IM,IMX,IOF,J,ITYPRO(2)
+ 2 IJ,IM,IMX,IOF,J,ITYPRO(2),LENGT,ITYLCM
REAL RHEAD(200),WW,SUM
DOUBLE PRECISION XDRCST,ANEUT
CHARACTER TEXT8*8,HSMG*131,HNAMIS*12,HNISOR*12
@@ -258,6 +258,10 @@
GAR1(NGF+1:NGRO,7)=0.0
CALL LCMPUT(KPLIB,'N2N',NGRO,2,GAR1(1,7))
*
+* H-FACTOR
+ CALL LCMLEN(KPLIB,'H-FACTOR',LENGT,ITYLCM)
+ IF(LENGT.NE.0) CALL LCMDEL(KPLIB,'H-FACTOR')
+*
* P0 differential scattering XS
CALL XSDISO(7002,5015,IND,LOAD,IERR)
GAR1(:NGRO,5)=0.0
diff --git a/Dragon/src/LIBSUB.f b/Dragon/src/LIBSUB.f
index 63095de..12adc45 100644
--- a/Dragon/src/LIBSUB.f
+++ b/Dragon/src/LIBSUB.f
@@ -129,6 +129,7 @@
*----
CALL LCMGET(IPLIB,'STATE-VECTOR',IPAR)
NL=IPAR(4)
+ NDEPL=IPAR(11)
NED=IPAR(13)
NDEL=IPAR(19)
IF(NED.GT.0) THEN
@@ -185,6 +186,15 @@
* FIND THE DILUTION VALUES.
NDIL=0
CALL LCMOP(IPTMP,'*TEMPORARY*',0,1,0)
+ IF(NDEPL.GT.0) THEN
+ CALL LCMLEN(IPLIB,'DEPL-CHAIN',ILENG,ITYLCM)
+ IF(ILENG.EQ.0)CALL XABORT('LIBSUB: MISSING DEPL-CHAIN DATA.')
+ CALL LCMSIX(IPLIB,'DEPL-CHAIN',1)
+ CALL LCMSIX(IPTMP,'DEPL-CHAIN',1)
+ CALL LCMEQU(IPLIB,IPTMP)
+ CALL LCMSIX(IPTMP,' ',2)
+ CALL LCMSIX(IPLIB,' ',2)
+ ENDIF
WRITE(HNISOR,'(3A4)') (ISONRF(I0,ISOT),I0=1,3)
WRITE(NAMLBT,'(2A4)') IHLIB(1,ISOT,1),IHLIB(2,ISOT,1)
ALLOCATE(INAME(16*NLIB))
diff --git a/Dragon/src/LIBWD4.f b/Dragon/src/LIBWD4.f
index 4262efa..e65ff05 100644
--- a/Dragon/src/LIBWD4.f
+++ b/Dragon/src/LIBWD4.f
@@ -49,10 +49,10 @@
*----
TYPE(C_PTR) IPLIB,IPISO(NBISO)
INTEGER NDPROC
- PARAMETER (NDPROC=10)
+ PARAMETER (NDPROC=11)
INTEGER IPRINT,NGROUP,NBISO,NL,ISONAM(3,NBISO),ISONRF(3,NBISO),
> ISHINA(3,NBISO),NGF,NGFR
- CHARACTER NAMFIL*8,NAMDXS(NDPROC)*6
+ CHARACTER NAMFIL*8,NAMDXS(NDPROC)*8
LOGICAL MASKI(NBISO)
REAL TN(NBISO),SN(NGROUP,NBISO),SB(NGROUP,NBISO)
*----
@@ -116,12 +116,11 @@
*----
* DATA
*----
- SAVE NBATOM,NAMDXS
- DATA NBATOM
- > /1,2,16,12/
- DATA NAMDXS
- > /'NTOT0 ','TRANC ','NUSIGF','NFTOT ','CHI ',
- > 'NU ','NG ','N2N ','NGOLD ','NWT0 '/
+ SAVE NBATOM,NAMDXS
+ DATA NBATOM /1,2,16,12/
+ DATA NAMDXS /'NTOT0 ','TRANC ','NUSIGF ','NFTOT ',
+ > 'CHI ','NU ','NG ','N2N ',
+ > 'NGOLD ','NWT0 ','H-FACTOR'/
*----
* SCRATCH STORAGE ALLOCATION
* ITYPRO cross section processed
diff --git a/Dragon/src/LIBWE.f b/Dragon/src/LIBWE.f
index b37f331..a68f198 100644
--- a/Dragon/src/LIBWE.f
+++ b/Dragon/src/LIBWE.f
@@ -49,10 +49,10 @@
*----
TYPE(C_PTR) IPLIB,IPISO(NBISO)
INTEGER NDPROC
- PARAMETER (NDPROC=10)
+ PARAMETER (NDPROC=11)
INTEGER IPRINT,NGROUP,NBISO,NL,ISONAM(3,NBISO),ISONRF(3,NBISO),
> ISHINA(3,NBISO),NGF,NGFR
- CHARACTER NAMFIL*8,NAMDXS(NDPROC)*6
+ CHARACTER NAMFIL*8,NAMDXS(NDPROC)*8
LOGICAL MASKI(NBISO)
REAL TN(NBISO),SN(NGROUP,NBISO),SB(NGROUP,NBISO)
*----
@@ -115,10 +115,10 @@
*----
* DATA
*----
- SAVE NAMDXS
- DATA NAMDXS
- > /'NTOT0 ','TRANC ','NUSIGF','NFTOT ','CHI ',
- > 'NU ','NG ','N2N ','NGOLD ','NWT0 '/
+ SAVE NAMDXS
+ DATA NAMDXS /'NTOT0 ','TRANC ','NUSIGF ','NFTOT ',
+ > 'CHI ','NU ','NG ','N2N ',
+ > 'NGOLD ','NWT0 ','H-FACTOR'/
*----
* SCRATCH STORAGE ALLOCATION
* ITYPRO cross section processed
diff --git a/Dragon/src/LIBWIM.f b/Dragon/src/LIBWIM.f
index b70c13d..a6ff486 100644
--- a/Dragon/src/LIBWIM.f
+++ b/Dragon/src/LIBWIM.f
@@ -47,7 +47,7 @@
* SUBROUTINE ARGUMENTS
*----
INTEGER NDPROC
- PARAMETER (NDPROC=10)
+ PARAMETER (NDPROC=11)
TYPE(C_PTR) IPLIB,IPISO(NBISO)
INTEGER IPRINT,NGROUP,NBISO,NL,ISONAM(3,NBISO),ISONRF(3,NBISO),
> ISHINA(3,NBISO),NGF,NGFR
@@ -67,7 +67,7 @@
*----
* LOCAL VARIABLES
*----
- CHARACTER NAMDXS(NDPROC)*6,HNAMIS*12,HNISOR*12,HSHIR*8,
+ CHARACTER NAMDXS(NDPROC)*8,HNAMIS*12,HNISOR*12,HSHIR*8,
> README*96,FMT*6
INTEGER IHGAR(24),IP1,NPROC,IUNIT,KDROPN,II,NEL,NGR,NGTHER,
> MXSCT,NGX,IG,ILOCX,ILOCY,ILOCS,NRDT,JSO,ITC,IDRES,IEL,
@@ -133,8 +133,9 @@
* DATA
*----
SAVE NAMDXS
- DATA NAMDXS /'NTOT0 ','TRANC ','NUSIGF','NFTOT ','CHI ',
- > 'NU ','NG ','N2N ','NGOLD ','NWT0 '/
+ DATA NAMDXS /'NTOT0 ','TRANC ','NUSIGF ','NFTOT ',
+ > 'CHI ','NU ','NG ','N2N ',
+ > 'NGOLD ','NWT0 ','H-FACTOR'/
*----
* SCRATCH STORAGE ALLOCATION
* ITYPRO cross section processed
diff --git a/Dragon/src/LIBXS2.f b/Dragon/src/LIBXS2.f
index 2fdd82c..403f1ed 100644
--- a/Dragon/src/LIBXS2.f
+++ b/Dragon/src/LIBXS2.f
@@ -53,7 +53,6 @@
PARAMETER (IOUT=6)
CHARACTER TEXT20*20,TEXT12*12,HNISOR*20,HITNAM*20,HSMG*131
DOUBLE PRECISION DBLINP
- REAL E458(9)
*----
* SCRATCH STORAGE ALLOCATION
*----
@@ -115,19 +114,15 @@
CALL LCMLEN(IPAP,'EGAMM',NV,ITYLCM)
IF(NV.NE.0) THEN
KPAX(NEL+3,ISO)=1
- CALL LCMGET(IPAP,'EGAMM',BPAX(NEL+3,ISO))
ENDIF
* FISSION ENERGIES.
CALL LCMLEN(IPAP,'EF',NV,ITYLCM)
IF(NV.NE.0) THEN
KPAX(NEL+2,ISO)=1
- CALL LCMGET(IPAP,'EF',BPAX(NEL+2,ISO))
ENDIF
CALL LCMLEN(IPAP,'ENER_458',NV,ITYLCM)
IF(NV.NE.0) THEN
KPAX(NEL+2,ISO)=1
- CALL LCMGET(IPAP,'ENER_458',E458)
- BPAX(NEL+2,ISO)=E458(8)
ENDIF
* RADIOACTIVE DECAY CONSTANTS.
CALL LCMLEN(IPAP,'LAMBD0',NCHANN,ITYLCM)
diff --git a/Dragon/src/LIBXS4.f b/Dragon/src/LIBXS4.f
index 6debb37..459809d 100644
--- a/Dragon/src/LIBXS4.f
+++ b/Dragon/src/LIBXS4.f
@@ -68,20 +68,20 @@
CHARACTER TEXT20*20,TEXT80*80,HNAMIS*12,HNISOR*12,HNISSS*12,
1 HSMG*131,TEXT2*2,TEXT12*12
LOGICAL LTRAN,LGPROB,LGTDIF,LGTTRA,LN2N,L104,LABS,LDIF,
- 1 LFIS,LPWD,LPED
+ 1 LFIS,LPWD,LPED,LH
INTEGER ZFISS,FGTD,FGHOMO,FGRESO,FAGG,FDGG,WGAL,FAG
DOUBLE PRECISION UU,XDRCST
INTEGER ITHOMO(MAXHOM),ITEXT(20)
- REAL TKT(5)
+ REAL TKT(5),E458(9)
*----
* ALLOCATABLE ARRAYS
*----
INTEGER, ALLOCATABLE, DIMENSION(:) :: ITYPRO,NFS,NOM,NOMS,ISECTT,
- 1 IFDG,IIAD,IDEPL
+ 1 IFDG,IIAD,IDEPL,IPR2
INTEGER, ALLOCATABLE, DIMENSION(:,:) :: IPR
REAL, ALLOCATABLE, DIMENSION(:) :: ENERG,DELTA,SECT,XSTOT,TAUX,
1 DELTF,SIGTF,SIGAF,SIGFF,ENER,AMASS,TEMP,TEMPS,SEQHO,PWD,PED,DKA,
- 2 DKD,DKF,DK104
+ 2 DKD,DKF,DK104,HFACT
REAL, ALLOCATABLE, DIMENSION(:,:) :: SIGS,CHID
REAL, ALLOCATABLE, DIMENSION(:,:,:) :: SCAT
LOGICAL, ALLOCATABLE, DIMENSION(:) :: LGTRE
@@ -89,7 +89,7 @@
*----
* SCRATCH STORAGE ALLOCATION
*----
- ALLOCATE(IPR(2,NBISO),ITYPRO(NL),NFS(NGRO))
+ ALLOCATE(IPR(2,NBISO),IPR2(NBISO),ITYPRO(NL),NFS(NGRO))
ALLOCATE(ENERG(NGRO+1),DELTA(NGRO),SECT(NGRO),SIGS(NGRO,NL),
1 SCAT(NGRO,NGRO,NL),XSTOT(NGRO))
*
@@ -180,6 +180,7 @@
WRITE (HSMG,780) HNISOR,NAMFIL
CALL XABORT(HSMG)
20 IPR(1,IMX)=KISO
+ IPR2(IMX)=KISO
*
IF((NISOTS.GT.0).AND.(HNISSS.NE.' ')) THEN
KISO=0
@@ -199,8 +200,8 @@
ENDIF
ENDIF
50 CONTINUE
- DEALLOCATE(NOM)
IF(NISOTS.GT.0) DEALLOCATE(NOMS)
+ DEALLOCATE(NOM)
CALL KDRCPU(TK2)
TKT(1)=TK2-TK1
*----
@@ -877,7 +878,6 @@
ENDIF
CALL LCMSIX(IPAP,' ',2) ! QFIXS
560 CONTINUE
- CALL LCMCL(IPAP,1)
*----
* CHECK IF ALL REACTIONS HAVE BEEN PROCESSED.
*----
@@ -891,11 +891,15 @@
575 CONTINUE
IF(IMPX.GT.2) WRITE(IOUT,940) (TKT(I),I=1,5)
*----
-* ADD NG CROSS SECTIONS.
+* LOOP OVER ISOTOPES
*----
+ CALL LCMSIX(IPAP,'QFIX',1)
DO 610 IMX=1,NBISO
IF(MASKI(IMX)) THEN
KPLIB=IPISO(IMX) ! set IMX-th isotope
+*----
+* PROCESS NG INFORMATION
+*----
CALL LCMGET(KPLIB,'NTOT0',SECT)
CALL LCMLEN(KPLIB,'SIGS00',LENGT,ITYLCM)
IF(LENGT.EQ.NGRO) THEN
@@ -919,14 +923,65 @@
600 CONTINUE
ENDIF
CALL LCMPUT(KPLIB,'NG',NGRO,2,SECT)
+*----
+* PROCESS H-FACTOR INFORMATION
+*----
+ CALL LCMLEN(KPLIB,'H-FACTOR',LENGT,ITYLCM)
+ IF(LENGT.NE.0) CALL LCMDEL(KPLIB,'H-FACTOR')
+ ISO=IPR2(IMX)
+ IF(ISO.EQ.0) CYCLE
+ WRITE(TEXT12,'(4HISOT,I8.8)') ISO
+ CALL LCMSIX(IPAP,TEXT12,1)
+ CALL LCMSIX(IPAP,'ISOTOP',1)
+ LH=.FALSE.
+ VALUE=0.0
+ ALLOCATE(HFACT(NGRO))
+ HFACT(:NGRO)=0.0
+* NG ENERGY.
+ CALL LCMLEN(IPAP,'EGAMM',NV,ITYLCM)
+ IF(NV.NE.0) THEN
+ CALL LCMGET(IPAP,'EGAMM',VALUE)
+ IF(VALUE.NE.0.0) THEN
+ CALL LCMGET(KPLIB,'NG',SECT)
+ HFACT(:NGRO)=HFACT(:NGRO)+SECT(:NGRO)*VALUE*1.0E6
+ LH=.TRUE.
+ ENDIF
+ ENDIF
+* FISSION ENERGIES.
+ CALL LCMLEN(IPAP,'EF',NV,ITYLCM)
+ IF(NV.NE.0) THEN
+ CALL LCMGET(IPAP,'EF',VALUE)
+ IF(VALUE.NE.0.0) THEN
+ CALL LCMGET(KPLIB,'NFTOT',SECT)
+ HFACT(:NGRO)=HFACT(:NGRO)+SECT(:NGRO)*VALUE*1.0E6
+ LH=.TRUE.
+ GO TO 605
+ ENDIF
+ ENDIF
+ CALL LCMLEN(IPAP,'ENER_458',NV,ITYLCM)
+ IF(NV.NE.0) THEN
+ CALL LCMGET(IPAP,'ENER_458',E458)
+ VALUE=E458(8)
+ IF(VALUE.NE.0.0) THEN
+ CALL LCMGET(KPLIB,'NFTOT',SECT)
+ HFACT(:NGRO)=HFACT(:NGRO)+SECT(:NGRO)*VALUE*1.0E6
+ LH=.TRUE.
+ ENDIF
+ ENDIF
+ 605 IF(LH) CALL LCMPUT(KPLIB,'H-FACTOR',NGRO,2,HFACT)
+ DEALLOCATE(HFACT)
+ CALL LCMSIX(IPAP,' ',2) ! ISOTOP
+ CALL LCMSIX(IPAP,' ',2) ! TEXT12
ENDIF
610 CONTINUE
+ CALL LCMSIX(IPAP,' ',2) ! QFIX
+ CALL LCMCL(IPAP,1)
*----
* SCRATCH STORAGE DEALLOCATION
*----
DEALLOCATE(AMASS)
DEALLOCATE(XSTOT,SCAT,SIGS,SECT,DELTA,ENERG)
- DEALLOCATE(NFS,ITYPRO,IPR)
+ DEALLOCATE(NFS,ITYPRO,IPR2,IPR)
RETURN
*
780 FORMAT(26HLIBXS4: MATERIAL/ISOTOPE ',A12,20H' IS MISSING ON APOL,
diff --git a/Dragon/src/TRAXS.f b/Dragon/src/TRAXS.f
index 7a077ca..3588589 100644
--- a/Dragon/src/TRAXS.f
+++ b/Dragon/src/TRAXS.f
@@ -54,7 +54,6 @@
DO ICOPY=1,NCOPY1
TEXT12=TCOPY1(ICOPY)
CALL LCMLEN(IPMAC2,TEXT12,ILONG,ITYLCM)
- print *,'TRAXS: transpose=',TEXT12,' ILONG=',ILONG
IF(ILONG.GT.0) THEN
CALL LCMGET(IPMAC2,TEXT12,GAR1)
ALLOCATE(XIOF(ILONG))
diff --git a/Dragon/src/XDRLGS.f b/Dragon/src/XDRLGS.f
index e91b8f6..cb21321 100644
--- a/Dragon/src/XDRLGS.f
+++ b/Dragon/src/XDRLGS.f
@@ -66,7 +66,7 @@
INTEGER NPROC,IGAR(MAXGAR),IODIV,LONG,ITYP,LONG2,ILEG,
> IXSR,IXSTN,IG,JG,NXSCMP,IGTO,IGMIN,IGMAX,IGFROM
CHARACTER*12 NAMXS
- CHARACTER NAMLEG*2,NORD*6,HCM(0:10)*2
+ CHARACTER NAMLEG*2,NORD*4,HCM(0:10)*2
INTEGER, ALLOCATABLE, DIMENSION(:) :: NJJ,IJJ
REAL, ALLOCATABLE, DIMENSION(:) :: XSSCMP
DATA HCM /'00','01','02','03','04','05','06','07','08',
@@ -78,13 +78,13 @@
*
IODIV=0
IF(IORD.EQ.1) THEN
- NORD=' '
+ NORD=' '
IODIV=1
ELSE IF(IORD.EQ.2) THEN
- NORD=' LIN'
+ NORD=' LIN'
IODIV=2
ELSE IF(IORD.EQ.3) THEN
- NORD=' QUA'
+ NORD=' QUA'
IODIV=4
ENDIF
NPROC=MAXLEG-MINLEG+1
@@ -265,14 +265,14 @@
IXSR=IXSR+1
IXSTN=MOD(ITYPRO(ILEG)/IODIV,2)
IF(IXSTN.NE.0) THEN
- WRITE(NAMXS,'(A4,I2.2,A6)') 'SIGS',ILEG-1,NORD
+ WRITE(NAMXS,'(A4,I2.2,2X,A4)') 'SIGS',ILEG-1,NORD
WRITE(IOUT,6000) NAMXS
WRITE(IOUT,6010) (XSREC(IG,IXSR),IG=1,NGROUP)
*----
* SCAT(IGTO,IGFROM) REPRESENT SCATTERING CROSS SECTION
* FROM GROUP "IGFROM" TO GROUP "IGTO"
*----
- WRITE(NAMXS,'(A4,I2.2,A6)') 'SCAT',ILEG-1,NORD
+ WRITE(NAMXS,'(A4,I2.2,2X,A4)') 'SCAT',ILEG-1,NORD
WRITE(IOUT,6000) NAMXS
DO IGFROM=1,NGROUP
WRITE(IOUT,6001) IGFROM
diff --git a/Dragon/src/XDRLXS.f b/Dragon/src/XDRLXS.f
index d49a89f..08e416a 100644
--- a/Dragon/src/XDRLXS.f
+++ b/Dragon/src/XDRLXS.f
@@ -43,23 +43,20 @@
TYPE(C_PTR) IPLIB
INTEGER IGS,IPRINT,NPROC,IORD,NGROUP
REAL XSREC(NGROUP,NPROC)
- CHARACTER NAMDXS(NPROC)*6,NORD*6
+ CHARACTER NAMDXS(NPROC)*8,NORD*4
*----
* LOCAL VARIABLES
*----
INTEGER IOUT
PARAMETER (IOUT=6)
- INTEGER IODIV,IXSR,IG,JG,ILENG,ITYLCM
+ INTEGER IXSR,IG,JG,ILENG,ITYLCM
*
IF(IORD.EQ.1) THEN
- NORD=' '
- IODIV=1
+ NORD=' '
ELSE IF(IORD.EQ.2) THEN
- NORD=' LIN'
- IODIV=2
+ NORD=' LIN'
ELSE IF(IORD.EQ.3) THEN
- NORD=' QUA'
- IODIV=4
+ NORD=' QUA'
ENDIF
IF(NPROC.LE.0) THEN
CALL XABORT('XDRLXS: ZERO OR NEGATIVE VALUE OF NPROC')
@@ -69,11 +66,13 @@
*----
* SAVE LOCAL DEFAULT XS IF REQUIRED
*----
-*
+! CALL LCMLEN(IPLIB,'H-FACTOR',ILENG,ITYLCM)
+! IF(ILENG.NE.0) CALL LCMDEL(IPLIB,'H-FACTOR')
DO 100 IXSR=1,NPROC
*----
* FIND IF XS NOT ALL 0.0
*----
+ IF(NAMDXS(IXSR).EQ.'H-FACTOR') GO TO 115
DO 110 IG=1,NGROUP
IF(XSREC(IG,IXSR).NE.0.0) GO TO 115
110 CONTINUE
diff --git a/Dragon/src/g2s_convert.f90 b/Dragon/src/g2s_convert.f90
index 1f28bb0..10e4e11 100644
--- a/Dragon/src/g2s_convert.f90
+++ b/Dragon/src/g2s_convert.f90
@@ -377,7 +377,6 @@ subroutine g2s_convert(impx,ipAl,ipZa,ipSal)
read(ipAl,'(10i7)',end=100) (idummy, i=1,nbNode)
read(ipAl,'(a12)') text12
if (text12 == ' ') read(ipAl,'(a12)') text12
- print *,'read=',text12
if (text12 /= ' Fin:') call XABORT('g2s_convert: keyword Fin: expected.')
!
! set nbfold
diff --git a/doc/IGE351/SectDmicrolib.tex b/doc/IGE351/SectDmicrolib.tex
index 433c7b6..8ae7dd5 100644
--- a/doc/IGE351/SectDmicrolib.tex
+++ b/doc/IGE351/SectDmicrolib.tex
@@ -460,9 +460,7 @@ The following records and sub-directories will be found on the first level of a
{$K_{r,i}^{\rm d}$ is the list of identifier for the depletion of an isotope.}
\RealEnr
{DEPLETE-ENER}{$M_{\mathrm{R}}\times N_{\mathrm{depl}}$}{Mev}
- {$R_{r,i}^{\rm d}$ is the energy produced with each depletion reaction $r$ of the father isotope. If {\tt H-FACTOR}
- information is available for an isotope $i$, $R_{r,i}^{\rm d}$ contains only decay energy contributions of lumped isotopes
- produced by reaction $r$.}
+ {$R_{r,i}^{\rm d}$ is the energy produced by each depletion reaction $r$ of the father isotope. $r=1$ corresponds to radioactive decay}
\RealEnr
{DEPLETE-DECA}{$N_{\mathrm{depl}}$}{$10^{-8}$ s$^{-1}\ $}
{Radioactive decay constants.}
@@ -481,6 +479,13 @@ The following records and sub-directories will be found on the first level of a
{$E_{k}^{\rm fiss}$ are the energy limits of fission yield macrogroups.}
\end{DescriptionEnregistrement}
+In all cases, the first component $R_{1,:}^{\rm d}$ contains the decay energy of the isotopes present in the burnup chain. The remaining components $r>1$ of the {\tt DEPLETE-ENER} record have different meaning, depending of the object containing the record:
+\begin{description}
+\item[{\tt RELEASE\_2003} draglib:] The {\tt DEPLETE-ENER} components with $r>1$ contains $Q_x$ values for the isotopes present in the burnup chain. It may include corrections for lumped isotopes not explicitely represented in the burnup chain.
+\item[{\tt RELEASE\_2025} draglib:] The {\tt DEPLETE-ENER} components with $r>1$ contains only corrections for lumped isotopes not explicitely represented in the burnup chain.
+\item[microlib:] The {\tt DEPLETE-ENER} components with $r>1$ are set to zero.
+\end{description}
+
An isotope $\mathsf{NISO}_{i}$ defined in \Sect{microlibdirmain} is considered
to be part of the depletion chain only if one can find a value of $1 \le j \le N_{\rm depl}$
such that $\mathsf{NISO}_{i}= \mathsf{NISOD}_{j}$.
@@ -928,9 +933,6 @@ Table~\ref{tabl:tabiso3}.
\begin{DescriptionEnregistrement}{Depletion-related information}{7.5cm}
\label{tabl:tabiso3}
\OptRealEnr
- {MEVG\blank{8}}{$1$}{$N_d \ge 1$}{MeV}
- {Energy in MeV produced by radiative capture. $N_d$ is defined in \Sect{microlibdir}.}
-\OptRealEnr
{MEVF\blank{8}}{$1$}{$N_d \ge 1$}{MeV}
{Energy in MeV produced by fission.}
\OptRealEnr
@@ -1066,7 +1068,14 @@ section directory may be:
\vskip 0.2cm
-We can also use this isotopic directory to store time dependent cross sections in the form of a power series expansion:
+The {\tt H-FACTOR} record has different meaning, depending of the object containing it:
+\begin{description}
+\item[{\tt RELEASE\_2003} draglib:] No {\tt H-FACTOR} record.
+\item[{\tt RELEASE\_2025} draglib:] The {\tt H-FACTOR} record contains $\sum_x Q_x \sigma_x$ or kerma values directly computed by NJOY for this specific isotope.
+\item[microlib:] The {\tt H-FACTOR} record contains $\sum_x Q_x \sigma_x$ or kerma values for this specific isotope. It may include corrections for lumped isotopes not explicitely represented in the associated burnup chain.
+\end{description}
+
+This isotopic directory can also be used to store time dependent cross sections in the form of a power series expansion:
\begin{equation}
v_{k}^{g}(t)=\sum_{i=0}^{I} v_{k,i}^{g} t^{i}
\label{eq:TimeSerie}