From e97aed325c45f5c79d64befd32e25cf1cbb0d15a Mon Sep 17 00:00:00 2001 From: Adam Nelson Date: Sun, 11 Sep 2016 05:43:45 -0400 Subject: [PATCH] bug fixes --- src/hdf5_interface.F90 | 13 +++++---- src/input_xml.F90 | 2 +- src/mgxs_header.F90 | 60 ++++++++++++++++++++++-------------------- src/nuclide_header.F90 | 4 +-- src/sab_header.F90 | 4 +-- 5 files changed, 42 insertions(+), 41 deletions(-) diff --git a/src/hdf5_interface.F90 b/src/hdf5_interface.F90 index 0eafd49b3c..7e4f16f261 100644 --- a/src/hdf5_interface.F90 +++ b/src/hdf5_interface.F90 @@ -218,12 +218,11 @@ contains subroutine get_groups(object_id, names) integer(HID_T), intent(in) :: object_id - character(len=255), allocatable, intent(out) :: names(:) + character(len=150), allocatable, intent(out) :: names(:) integer :: n_members, i, group_count, type integer :: hdf5_err - character(len=255) :: name - + character(len=150) :: name ! Get number of members in this location call h5gn_members_f(object_id, './', n_members, hdf5_err) @@ -302,11 +301,11 @@ contains subroutine get_datasets(object_id, names) integer(HID_T), intent(in) :: object_id - character(len=255), allocatable, intent(out) :: names(:) + character(len=150), allocatable, intent(out) :: names(:) integer :: n_members, i, dset_count, type integer :: hdf5_err - character(len=255) :: name + character(len=150) :: name ! Get number of members in this location @@ -342,14 +341,14 @@ contains integer(HID_T), intent(in) :: group_id integer(SIZE_T), optional, intent(in) :: name_len_ - character(len=255) :: name ! name of group + character(len=150) :: name ! name of group integer(SIZE_T) :: name_len, name_file_len integer :: hdf5_err ! HDF5 error code if (present(name_len_)) then name_len = name_len_ else - name_len = 255 + name_len = 150 end if call h5iget_name_f(group_id, name, name_len, name_file_len, hdf5_err) diff --git a/src/input_xml.F90 b/src/input_xml.F90 index d755f21682..1820350aaa 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -4640,7 +4640,7 @@ contains logical :: file_exists ! does mgxs.h5 exist? integer(HID_T) :: file_id real(8), allocatable :: rev_energy_bins(:) - character(len=255), allocatable :: names(:) + character(len=MAX_WORD_LEN), allocatable :: names(:) ! Check if mgxs.h5 exists inquire(FILE=path_cross_sections, EXIST=file_exists) diff --git a/src/mgxs_header.F90 b/src/mgxs_header.F90 index 04fab444a7..46c4bcb503 100644 --- a/src/mgxs_header.F90 +++ b/src/mgxs_header.F90 @@ -6,7 +6,7 @@ module mgxs_header use hdf5, only: HID_T, HSIZE_T, SIZE_T use algorithm, only: find, sort - use constants, only: MAX_FILE_LEN, ZERO, ONE, TWO, PI + use constants, only: MAX_WORD_LEN, ZERO, ONE, TWO, PI use error, only: fatal_error use hdf5_interface use material_header, only: material @@ -49,9 +49,9 @@ module mgxs_header !=============================================================================== type, abstract :: Mgxs - character(len=104) :: name ! name of dataset, e.g. 92235.03c - real(8) :: awr ! Atomic Weight Ratio - real(8), allocatable :: kTs(:) ! temperature in MeV (k*T) + character(len=MAX_WORD_LEN) :: name ! name of dataset, e.g. UO2 + real(8) :: awr ! Atomic Weight Ratio + real(8), allocatable :: kTs(:) ! temperature in MeV (k*T) ! Fission information logical :: fissionable ! mgxs object is fissionable? @@ -213,7 +213,7 @@ module mgxs_header integer(SIZE_T) :: name_len integer(HID_T) :: kT_group - character(MAX_FILE_LEN), allocatable :: dset_names(:) + character(MAX_WORD_LEN), allocatable :: dset_names(:) real(8), allocatable :: temps_available(:) ! temperatures available real(8) :: temp_desired real(8) :: temp_actual @@ -506,6 +506,13 @@ module mgxs_header call fatal_error("'scatter matrix' must be provided") call read_dataset(temp_arr, scatt_grp, "scatter matrix") + ! Compare the number of orders given with the maximum order of the + ! problem. Strip off the supefluous orders if needed. + if (this % scatter_type == ANGLE_LEGENDRE) then + order = min(order_dim - 1, max_order) + order_dim = order + 1 + end if + ! Convert temp_arr to a jagged array ((gin) % data(l, gout)) for passing ! to ScattData allocate(input_scatt(groups)) @@ -522,13 +529,6 @@ module mgxs_header deallocate(temp_arr) ! Finally convert the legendre to tabular if needed - ! Compare the number of orders given with the maximum order of the - ! problem. Strip off the supefluous orders if needed. - if (this % scatter_type == ANGLE_LEGENDRE) then - order = min(order_dim - 1, max_order) - order_dim = order + 1 - end if - allocate(scatt_coeffs(groups)) if (this % scatter_type == ANGLE_LEGENDRE .and. & legendre_to_tabular) then @@ -573,7 +573,8 @@ module mgxs_header ! Sticking with current representation do gin = 1, groups allocate(scatt_coeffs(gin) % data(order_dim, gmin(gin):gmax(gin))) - scatt_coeffs(gin) % data(:, :) = input_scatt(gin) % data(:, :) + scatt_coeffs(gin) % data(:, :) = & + input_scatt(gin) % data(1:order_dim, :) end do end if deallocate(input_scatt) @@ -670,6 +671,7 @@ module mgxs_header character(MAX_LINE_LEN) :: temp_str integer(HID_T) :: xsdata_grp, scatt_grp + integer, allocatable :: int_arr(:) real(8), allocatable :: temp_arr(:), temp_4d(:, :, :, :) real(8) :: dmu, mu, norm integer :: order, order_dim, gin, gout, l, imu @@ -821,20 +823,20 @@ module mgxs_header scatt_grp = open_group(xsdata_grp, 'scatter data') ! First get the outgoing group boundary indices if (check_dataset(scatt_grp, "g_min")) then - allocate(temp_arr(groups * this % n_azi * this % n_pol)) - call read_dataset(temp_arr, scatt_grp, "g_min") + allocate(int_arr(groups * this % n_azi * this % n_pol)) + call read_dataset(int_arr, scatt_grp, "g_min") allocate(gmin(groups, this % n_azi, this % n_pol)) - gmin = reshape(temp_arr, (/groups, this % n_azi, this % n_pol/)) - deallocate(temp_arr) + gmin = reshape(int_arr, (/groups, this % n_azi, this % n_pol/)) + deallocate(int_arr) else call fatal_error("'g_min' for the scatter matrix must be provided") end if if (check_dataset(scatt_grp, "g_max")) then - allocate(temp_arr(groups * this % n_azi * this % n_pol)) - call read_dataset(temp_arr, scatt_grp, "g_max") + allocate(int_arr(groups * this % n_azi * this % n_pol)) + call read_dataset(int_arr, scatt_grp, "g_max") allocate(gmax(groups, this % n_azi, this % n_pol)) - gmax = reshape(temp_arr, (/groups, this % n_azi, this % n_pol/)) - deallocate(temp_arr) + gmax = reshape(int_arr, (/groups, this % n_azi, this % n_pol/)) + deallocate(int_arr) else call fatal_error("'g_max' for the scatter matrix must be provided") end if @@ -856,6 +858,13 @@ module mgxs_header call fatal_error("'scatter matrix' must be provided") call read_dataset(temp_arr, scatt_grp, "scatter matrix") + ! Compare the number of orders given with the maximum order of the + ! problem. Strip off the superfluous orders if needed. + if (this % scatter_type == ANGLE_LEGENDRE) then + order = min(order_dim - 1, max_order) + order_dim = order + 1 + end if + ! Convert temp_arr to a jagged array ((gin) % data(l, gout)) for passing ! to ScattData allocate(input_scatt(groups, this % n_azi, this % n_pol)) @@ -878,13 +887,6 @@ module mgxs_header deallocate(temp_arr) ! Finally convert the legendre to tabular if needed - ! Compare the number of orders given with the maximum order of the - ! problem. Strip off the superfluous orders if needed. - if (this % scatter_type == ANGLE_LEGENDRE) then - order = min(order_dim - 1, max_order) - order_dim = order + 1 - end if - allocate(scatt_coeffs(groups, this % n_azi, this % n_pol)) if (this % scatter_type == ANGLE_LEGENDRE .and. & legendre_to_tabular) then @@ -941,7 +943,7 @@ module mgxs_header allocate(scatt_coeffs(gin, iazi, ipol) % data(order_dim, & gmin(gin, iazi, ipol):gmax(gin, iazi, ipol))) scatt_coeffs(gin, iazi, ipol) % data(:, :) = & - input_scatt(gin, iazi, ipol) % data(:, :) + input_scatt(gin, iazi, ipol) % data(1:order_dim, :) end do end do end do diff --git a/src/nuclide_header.F90 b/src/nuclide_header.F90 index 07b8a99b7b..f5365fc043 100644 --- a/src/nuclide_header.F90 +++ b/src/nuclide_header.F90 @@ -207,8 +207,8 @@ module nuclide_header integer(HSIZE_T) :: j integer(HSIZE_T) :: dims(1) character(MAX_WORD_LEN) :: temp_str - character(MAX_FILE_LEN), allocatable :: dset_names(:) - character(MAX_FILE_LEN), allocatable :: grp_names(:) + character(MAX_WORD_LEN), allocatable :: dset_names(:) + character(MAX_WORD_LEN), allocatable :: grp_names(:) real(8), allocatable :: temps_available(:) ! temperatures available real(8) :: temp_desired real(8) :: temp_actual diff --git a/src/sab_header.F90 b/src/sab_header.F90 index 5f49fdc42b..8eaff01678 100644 --- a/src/sab_header.F90 +++ b/src/sab_header.F90 @@ -66,7 +66,7 @@ module sab_header end type SabData type SAlphaBeta - character(100) :: name ! name of table, e.g. lwtr.10t + character(150) :: name ! name of table, e.g. lwtr.10t real(8) :: awr ! weight of nucleus in neutron masses real(8), allocatable :: kTs(:) ! temperatures in MeV (k*T) character(10), allocatable :: nuclides(:) ! List of valid nuclides @@ -104,7 +104,7 @@ contains type(CorrelatedAngleEnergy) :: correlated_dist character(MAX_WORD_LEN) :: temp_str - character(MAX_FILE_LEN), allocatable :: dset_names(:) + character(MAX_WORD_LEN), allocatable :: dset_names(:) real(8), allocatable :: temps_available(:) ! temperatures available real(8) :: temp_desired real(8) :: temp_actual