From 8884fb9e3f1657b2b5e0c5b4e8e4a3af5adfbe68 Mon Sep 17 00:00:00 2001 From: Adam Nelson Date: Tue, 10 Dec 2013 05:58:11 -0500 Subject: [PATCH 1/3] Added changes to allow for the entire list of zaids to be checked. --- src/ace.F90 | 30 +++++++----- src/ace_header.F90 | 113 +++++++++++++++++++++++---------------------- src/output.F90 | 66 ++++++++++++++------------ 3 files changed, 112 insertions(+), 97 deletions(-) diff --git a/src/ace.F90 b/src/ace.F90 index d54aa83c28..d5fa012d36 100644 --- a/src/ace.F90 +++ b/src/ace.F90 @@ -115,9 +115,9 @@ contains ! search through the list of nuclides for one which has a matching zaid sab => sab_tables(mat % i_sab_tables(k)) - ! Loop through nuclides and find match + ! Loop through nuclides and find match FIND_NUCLIDE: do j = 1, mat % n_nuclides - if (nuclides(mat % nuclide(j)) % zaid == sab % zaid) then + if (any(sab % zaid == nuclides(mat % nuclide(j)) % zaid)) then mat % i_sab_nuclides(k) = j exit FIND_NUCLIDE end if @@ -161,16 +161,16 @@ contains mat % i_sab_tables(m) = temp_table end do SORT_SAB end if - + ! Deallocate temporary arrays for names of nuclides and S(a,b) tables if (allocated(mat % names)) deallocate(mat % names) if (allocated(mat % sab_names)) deallocate(mat % sab_names) end do MATERIAL_LOOP2 - + ! Avoid some valgrind leak errors call already_read % clear() - + end subroutine read_xs !=============================================================================== @@ -253,7 +253,7 @@ contains end if ! Read more header and NXS and JXS - read(UNIT=in, FMT=100) comment, mat, & + read(UNIT=in, FMT=100) comment, mat, & (zaids(i), awrs(i), i=1,16), NXS, JXS 100 format(A70,A10/4(I7,F11.0)/4(I7,F11.0)/4(I7,F11.0)/4(I7,F11.0)/& ,8I9/8I9/8I9/8I9/8I9/8I9) @@ -277,7 +277,7 @@ contains ACCESS='direct', RECL=record_length) ! Read all header information - read(UNIT=in, REC=location) name, awr, kT, date_, & + read(UNIT=in, REC=location) name, awr, kT, date_, & comment, mat, (zaids(i), awrs(i), i=1,16), NXS, JXS ! determine table length @@ -333,7 +333,15 @@ contains sab % name = name sab % awr = awr sab % kT = kT - sab % zaid = zaids(1) + ! Find sab % n_zaid + do i = 1, 16 + if (zaids(i) == 0) then + sab % n_zaid = i - 1 + exit + end if + end do + allocate(sab % zaid(sab % n_zaid)) + sab % zaid = zaids(1: sab % n_zaid) call read_thermal_data(sab) end select @@ -406,7 +414,7 @@ contains integer :: LNU ! type of nu data (polynomial or tabular) integer :: NC ! number of polynomial coefficients integer :: NR ! number of interpolation regions - integer :: NE ! number of energies + integer :: NE ! number of energies integer :: NPCR ! number of delayed neutron precursor groups integer :: LED ! location of energy distribution locators integer :: LDIS ! location of all energy distributions @@ -809,7 +817,7 @@ contains LED = JXS(10) - ! Loop over all reactions + ! Loop over all reactions do i = 1, NXS(5) rxn => nuc % reactions(i+1) ! skip over elastic scattering rxn % has_energy_dist = .true. @@ -840,7 +848,7 @@ contains integer :: LDIS ! location of all energy distributions integer :: LNW ! location of next energy distribution if multiple - integer :: LAW ! secondary energy distribution law + integer :: LAW ! secondary energy distribution law integer :: NR ! number of interpolation regions integer :: NE ! number of incoming energies integer :: IDAT ! location of first energy distribution for given MT diff --git a/src/ace_header.F90 b/src/ace_header.F90 index 5e2f39a007..26fbf4cbca 100644 --- a/src/ace_header.F90 +++ b/src/ace_header.F90 @@ -16,7 +16,7 @@ module ace_header integer, allocatable :: type(:) ! type of distribution integer, allocatable :: location(:) ! location of each table real(8), allocatable :: data(:) ! angular distribution data - + ! Type-Bound procedures contains procedure :: clear => distangle_clear ! Deallocates DistAngle @@ -35,7 +35,7 @@ module ace_header ! For reactions that may have multiple energy distributions such as (n.2n), ! this pointer allows multiple laws to be stored type(DistEnergy), pointer :: next => null() - + ! Type-Bound procedures contains procedure :: clear => distenergy_clear ! Deallocates DistEnergy @@ -57,7 +57,7 @@ module ace_header logical :: has_energy_dist ! Energy distribution present? type(DistAngle) :: adist ! Secondary angular distribution type(DistEnergy), pointer :: edist => null() ! Secondary energy distribution - + ! Type-Bound procedures contains procedure :: clear => reaction_clear ! Deallocates Reaction @@ -76,7 +76,7 @@ module ace_header logical :: multiply_smooth ! multiply by smooth cross section? real(8), allocatable :: energy(:) ! incident energies real(8), allocatable :: prob(:,:,:) ! actual probabibility tables - + ! Type-Bound procedures contains procedure :: clear => urrdata_clear ! Deallocates UrrData @@ -137,7 +137,7 @@ module ace_header ! Reactions integer :: n_reaction ! # of reactions type(Reaction), pointer :: reactions(:) => null() - + ! Type-Bound procedures contains procedure :: clear => nuclide_clear ! Deallocates Nuclide @@ -147,12 +147,13 @@ module ace_header ! SALPHABETA contains S(a,b) data for thermal neutron scattering, typically off ! of light isotopes such as water, graphite, Be, etc !=============================================================================== - + type SAlphaBeta - character(10) :: name ! name of table, e.g. lwtr.10t - integer :: zaid ! Z and A identifier, e.g. 6012 for Carbon-12 - real(8) :: awr ! weight of nucleus in neutron masses - real(8) :: kT ! temperature in MeV (k*T) + character(10) :: name ! name of table, e.g. lwtr.10t + real(8) :: awr ! weight of nucleus in neutron masses + real(8) :: kT ! temperature in MeV (k*T) + integer :: n_zaid ! Number of valid zaids + integer, allocatable :: zaid(:) ! List of valid Z and A identifiers, e.g. 6012 ! threshold for S(a,b) treatment (usually ~4 eV) real(8) :: threshold_inelastic @@ -164,7 +165,7 @@ module ace_header integer :: n_inelastic_mu ! # of outgoing angles for inelastic integer :: secondary_mode ! secondary mode (equal/skewed) real(8), allocatable :: inelastic_e_in(:) - real(8), allocatable :: inelastic_sigma(:) + real(8), allocatable :: inelastic_sigma(:) real(8), allocatable :: inelastic_e_out(:,:) real(8), allocatable :: inelastic_mu(:,:,:) @@ -240,125 +241,125 @@ module ace_header !=============================================================================== ! DISTANGLE_CLEAR resets and deallocates data in Reaction. -!=============================================================================== - +!=============================================================================== + subroutine distangle_clear(this) - + class(DistAngle), intent(inout) :: this ! The DistAngle object to clear - + if (allocated(this % energy)) & deallocate(this % energy, this % type, this % location, this % data) - - end subroutine distangle_clear + + end subroutine distangle_clear !=============================================================================== ! DISTENERGY_CLEAR resets and deallocates data in DistEnergy. -!=============================================================================== - +!=============================================================================== + recursive subroutine distenergy_clear(this) - + class(DistEnergy), intent(inout) :: this ! The DistEnergy object to clear - + ! Clear p_valid call this % p_valid % clear() - + if (allocated(this % data)) & deallocate(this % data) - + if (associated(this % next)) then ! recursively clear this item call this % next % clear() deallocate(this % next) end if - + end subroutine distenergy_clear - + !=============================================================================== ! REACTION_CLEAR resets and deallocates data in Reaction. -!=============================================================================== - +!=============================================================================== + subroutine reaction_clear(this) - + class(Reaction), intent(inout) :: this ! The Reaction object to clear - + if (allocated(this % sigma)) & deallocate(this % sigma) - + if (associated(this % edist)) then call this % edist % clear() deallocate(this % edist) end if - + call this % adist % clear() - - end subroutine reaction_clear - + + end subroutine reaction_clear + !=============================================================================== ! URRDATA_CLEAR resets and deallocates data in Reaction. -!=============================================================================== - +!=============================================================================== + subroutine urrdata_clear(this) - + class(UrrData), intent(inout) :: this ! The UrrData object to clear - + if (allocated(this % energy)) & deallocate(this % energy, this % prob) - - end subroutine urrdata_clear + + end subroutine urrdata_clear !=============================================================================== ! NUCLIDE_CLEAR resets and deallocates data in Nuclide. -!=============================================================================== - +!=============================================================================== + subroutine nuclide_clear(this) - + class(Nuclide), intent(inout) :: this ! The Nuclide object to clear - + integer :: i ! Loop counter - + if (allocated(this % grid_index)) & deallocate(this % grid_index) - + if (allocated(this % energy)) & deallocate(this % total, this % elastic, this % fission, & this % nu_fission, this % absorption) if (allocated(this % heating)) & deallocate(this % heating) - + if (allocated(this % index_fission)) & deallocate(this % index_fission) - + if (allocated(this % nu_t_data)) & deallocate(this % nu_t_data) - + if (allocated(this % nu_p_data)) & deallocate(this % nu_p_data) - + if (allocated(this % nu_d_data)) & deallocate(this % nu_d_data) - + if (allocated(this % nu_d_precursor_data)) & deallocate(this % nu_d_precursor_data) - + if (associated(this % nu_d_edist)) then do i = 1, size(this % nu_d_edist) call this % nu_d_edist(i) % clear() end do deallocate(this % nu_d_edist) end if - + if (associated(this % urr_data)) then call this % urr_data % clear() deallocate(this % urr_data) end if - + if (associated(this % reactions)) then do i = 1, size(this % reactions) call this % reactions(i) % clear() end do deallocate(this % reactions) end if - - end subroutine nuclide_clear + + end subroutine nuclide_clear end module ace_header diff --git a/src/output.F90 b/src/output.F90 index c60b96bf26..e4fcfecef5 100644 --- a/src/output.F90 +++ b/src/output.F90 @@ -126,7 +126,7 @@ contains ! print header based on level select case (header_level) case (1) - write(UNIT=unit_, FMT='(/3(1X,A/))') repeat('=', 75), & + write(UNIT=unit_, FMT='(/3(1X,A/))') repeat('=', 75), & repeat('=', n) // '> ' // trim(line) // ' <' // & repeat('=', m), repeat('=', 75) case (2) @@ -180,7 +180,7 @@ contains end subroutine print_usage !=============================================================================== -! WRITE_MESSAGE displays an informational message to the log file and the +! WRITE_MESSAGE displays an informational message to the log file and the ! standard output stream. !=============================================================================== @@ -215,7 +215,7 @@ contains ! Determine last space in current line last_space = index(message(i_start+1:i_start+line_wrap), & ' ', BACK=.true.) - if (last_space == 0) then + if (last_space == 0) then i_end = min(length + 1, i_start+line_wrap) - 1 write(ou, fmt='(1X,A)') message(i_start+1:i_end) else @@ -1030,6 +1030,7 @@ contains integer :: size_sab ! memory used by S(a,b) table integer :: unit_ ! unit to write to + integer :: i ! Loop counter for parsing through sab % zaid ! set default unit for writing information if (present(unit)) then @@ -1040,7 +1041,12 @@ contains ! Basic S(a,b) table information write(unit_,*) 'S(a,b) Table ' // trim(sab % name) - write(unit_,*) ' zaid = ' // trim(to_str(sab % zaid)) + write(unit_,'(A)',advance="no") ' zaids = ' + do i = 1, sab % n_zaid - 1 + ! This could use some fancy handling for if the line becomes too long + write(unit_,'(A)',advance="no") trim(to_str(sab % zaid(sab % n_zaid))) // ', ' + end do + write(unit_,*) trim(to_str(sab % zaid(sab % n_zaid))) write(unit_,*) ' awr = ' // trim(to_str(sab % awr)) write(unit_,*) ' kT = ' // trim(to_str(sab % kT)) @@ -1242,7 +1248,7 @@ contains end select end if write(UNIT=ou, FMT=*) - + write(UNIT=ou, FMT='(2X,A9,3X)', ADVANCE='NO') "=========" write(UNIT=ou, FMT='(A8,3X)', ADVANCE='NO') "========" if (entropy_on) write(UNIT=ou, FMT='(A8,3X)', ADVANCE='NO') "========" @@ -1272,7 +1278,7 @@ contains if (entropy_on) write(UNIT=OUTPUT_UNIT, FMT='(3X, F8.5)', ADVANCE='NO') & entropy(overall_gen) - if (overall_gen - n_inactive*gen_per_batch > 1) then + if (overall_gen - n_inactive*gen_per_batch > 1) then write(UNIT=OUTPUT_UNIT, FMT='(3X, F8.5," +/-",F8.5)', ADVANCE='NO') & keff, keff_std end if @@ -1300,7 +1306,7 @@ contains entropy(current_batch*gen_per_batch) ! write out accumulated k-effective if after first active batch - if (overall_gen - n_inactive*gen_per_batch > 1) then + if (overall_gen - n_inactive*gen_per_batch > 1) then write(UNIT=OUTPUT_UNIT, FMT='(3X, F8.5," +/-",F8.5)', ADVANCE='NO') & keff, keff_std else @@ -1310,7 +1316,7 @@ contains ! write out cmfd keff if it is active and other display info if (cmfd_on) then write(UNIT=OUTPUT_UNIT, FMT='(3X, F8.5)', ADVANCE='NO') & - cmfd % k_cmfd(current_batch) + cmfd % k_cmfd(current_batch) select case(trim(cmfd_display)) case('entropy') write(UNIT=OUTPUT_UNIT, FMT='(3X, F8.5)', ADVANCE='NO') & @@ -1349,7 +1355,7 @@ contains ! Plot id write(ou,100) "Plot ID:", trim(to_str(pl % id)) - + ! Plot type if (pl % type == PLOT_TYPE_SLICE) then write(ou,100) "Plot Type:", "Slice" @@ -1387,7 +1393,7 @@ contains trim(to_str(pl % pixels(2))) else if (pl % type == PLOT_TYPE_VOXEL) then write(ou,100) "Voxels:", trim(to_str(pl % pixels(1))) // " " // & - trim(to_str(pl % pixels(2))) // " " // trim(to_str(pl % pixels(3))) + trim(to_str(pl % pixels(2))) // " " // trim(to_str(pl % pixels(3))) end if write(ou,*) @@ -1539,7 +1545,7 @@ contains write(ou,100) 'Cell ID','No. Overlap Checks' - do i = 1, n_cells + do i = 1, n_cells write(ou,101) cells(i) % id, overlap_check_cnt(i) if (overlap_check_cnt(i) < 10) num_sparse = num_sparse + 1 end do @@ -1573,7 +1579,7 @@ contains integer :: k ! loop index for scoring bins integer :: n ! loop index for nuclides integer :: l ! loop index for user scores - integer :: type ! type of tally filter + integer :: type ! type of tally filter integer :: indent ! number of spaces to preceed output integer :: filter_index ! index in results array for filters integer :: score_index ! scoring bin index @@ -1749,13 +1755,13 @@ contains score_name = 'P' // trim(to_str(t % scatt_order(k))) // & ' Scattering Moment' end if - write(UNIT=UNIT_TALLY, FMT='(1X,2A,1X,A,"+/- ",A)') & + write(UNIT=UNIT_TALLY, FMT='(1X,2A,1X,A,"+/- ",A)') & repeat(" ", indent), score_name, & to_str(t % results(score_index,filter_index) % sum), & trim(to_str(t % results(score_index,filter_index) % sum_sq)) else if (t % score_bins(k) == SCORE_SCATTER_PN) then score_name = "Scattering Rate" - write(UNIT=UNIT_TALLY, FMT='(1X,2A,1X,A,"+/- ",A)') & + write(UNIT=UNIT_TALLY, FMT='(1X,2A,1X,A,"+/- ",A)') & repeat(" ", indent), score_name, & to_str(t % results(score_index,filter_index) % sum), & trim(to_str(t % results(score_index,filter_index) % sum_sq)) @@ -1763,7 +1769,7 @@ contains score_index = score_index + 1 score_name = 'P' // trim(to_str(n_order)) // & ' Scattering Moment' - write(UNIT=UNIT_TALLY, FMT='(1X,2A,1X,A,"+/- ",A)') & + write(UNIT=UNIT_TALLY, FMT='(1X,2A,1X,A,"+/- ",A)') & repeat(" ", indent), score_name, & to_str(t % results(score_index,filter_index) % sum), & trim(to_str(t % results(score_index,filter_index) % sum_sq)) @@ -1775,7 +1781,7 @@ contains else score_name = score_names(abs(t % score_bins(k))) end if - write(UNIT=UNIT_TALLY, FMT='(1X,2A,1X,A,"+/- ",A)') & + write(UNIT=UNIT_TALLY, FMT='(1X,2A,1X,A,"+/- ",A)') & repeat(" ", indent), score_name, & to_str(t % results(score_index,filter_index) % sum), & trim(to_str(t % results(score_index,filter_index) % sum_sq)) @@ -1813,8 +1819,8 @@ contains integer :: i_filter_ein ! index for incoming energy filter integer :: i_filter_surf ! index for surface filter integer :: n ! number of incoming energy bins - integer :: len1 ! length of string - integer :: len2 ! length of string + integer :: len1 ! length of string + integer :: len2 ! length of string integer :: filter_index ! index in results array for filters logical :: print_ebin ! should incoming energy bin be displayed? character(MAX_LINE_LEN) :: string @@ -1864,14 +1870,14 @@ contains mesh_indices_to_bin(m, (/ i-1, j, k /) + 1, .true.) matching_bins(i_filter_surf) = IN_RIGHT filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 - write(UNIT=UNIT_TALLY, FMT='(5X,A,T35,A,"+/- ",A)') & + write(UNIT=UNIT_TALLY, FMT='(5X,A,T35,A,"+/- ",A)') & "Outgoing Current to Left", & to_str(t % results(1,filter_index) % sum), & trim(to_str(t % results(1,filter_index) % sum_sq)) matching_bins(i_filter_surf) = OUT_RIGHT filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 - write(UNIT=UNIT_TALLY, FMT='(5X,A,T35,A,"+/- ",A)') & + write(UNIT=UNIT_TALLY, FMT='(5X,A,T35,A,"+/- ",A)') & "Incoming Current from Left", & to_str(t % results(1,filter_index) % sum), & trim(to_str(t % results(1,filter_index) % sum_sq)) @@ -1881,14 +1887,14 @@ contains mesh_indices_to_bin(m, (/ i, j, k /) + 1, .true.) matching_bins(i_filter_surf) = IN_RIGHT filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 - write(UNIT=UNIT_TALLY, FMT='(5X,A,T35,A,"+/- ",A)') & + write(UNIT=UNIT_TALLY, FMT='(5X,A,T35,A,"+/- ",A)') & "Incoming Current from Right", & to_str(t % results(1,filter_index) % sum), & trim(to_str(t % results(1,filter_index) % sum_sq)) matching_bins(i_filter_surf) = OUT_RIGHT filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 - write(UNIT=UNIT_TALLY, FMT='(5X,A,T35,A,"+/- ",A)') & + write(UNIT=UNIT_TALLY, FMT='(5X,A,T35,A,"+/- ",A)') & "Outgoing Current to Right", & to_str(t % results(1,filter_index) % sum), & trim(to_str(t % results(1,filter_index) % sum_sq)) @@ -1898,14 +1904,14 @@ contains mesh_indices_to_bin(m, (/ i, j-1, k /) + 1, .true.) matching_bins(i_filter_surf) = IN_FRONT filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 - write(UNIT=UNIT_TALLY, FMT='(5X,A,T35,A,"+/- ",A)') & + write(UNIT=UNIT_TALLY, FMT='(5X,A,T35,A,"+/- ",A)') & "Outgoing Current to Back", & to_str(t % results(1,filter_index) % sum), & trim(to_str(t % results(1,filter_index) % sum_sq)) matching_bins(i_filter_surf) = OUT_FRONT filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 - write(UNIT=UNIT_TALLY, FMT='(5X,A,T35,A,"+/- ",A)') & + write(UNIT=UNIT_TALLY, FMT='(5X,A,T35,A,"+/- ",A)') & "Incoming Current from Back", & to_str(t % results(1,filter_index) % sum), & trim(to_str(t % results(1,filter_index) % sum_sq)) @@ -1915,14 +1921,14 @@ contains mesh_indices_to_bin(m, (/ i, j, k /) + 1, .true.) matching_bins(i_filter_surf) = IN_FRONT filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 - write(UNIT=UNIT_TALLY, FMT='(5X,A,T35,A,"+/- ",A)') & + write(UNIT=UNIT_TALLY, FMT='(5X,A,T35,A,"+/- ",A)') & "Incoming Current from Front", & to_str(t % results(1,filter_index) % sum), & trim(to_str(t % results(1,filter_index) % sum_sq)) matching_bins(i_filter_surf) = OUT_FRONT filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 - write(UNIT=UNIT_TALLY, FMT='(5X,A,T35,A,"+/- ",A)') & + write(UNIT=UNIT_TALLY, FMT='(5X,A,T35,A,"+/- ",A)') & "Outgoing Current to Front", & to_str(t % results(1,filter_index) % sum), & trim(to_str(t % results(1,filter_index) % sum_sq)) @@ -1932,14 +1938,14 @@ contains mesh_indices_to_bin(m, (/ i, j, k-1 /) + 1, .true.) matching_bins(i_filter_surf) = IN_TOP filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 - write(UNIT=UNIT_TALLY, FMT='(5X,A,T35,A,"+/- ",A)') & + write(UNIT=UNIT_TALLY, FMT='(5X,A,T35,A,"+/- ",A)') & "Outgoing Current to Bottom", & to_str(t % results(1,filter_index) % sum), & trim(to_str(t % results(1,filter_index) % sum_sq)) matching_bins(i_filter_surf) = OUT_TOP filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 - write(UNIT=UNIT_TALLY, FMT='(5X,A,T35,A,"+/- ",A)') & + write(UNIT=UNIT_TALLY, FMT='(5X,A,T35,A,"+/- ",A)') & "Incoming Current from Bottom", & to_str(t % results(1,filter_index) % sum), & trim(to_str(t % results(1,filter_index) % sum_sq)) @@ -1949,14 +1955,14 @@ contains mesh_indices_to_bin(m, (/ i, j, k /) + 1, .true.) matching_bins(i_filter_surf) = IN_TOP filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 - write(UNIT=UNIT_TALLY, FMT='(5X,A,T35,A,"+/- ",A)') & + write(UNIT=UNIT_TALLY, FMT='(5X,A,T35,A,"+/- ",A)') & "Incoming Current from Top", & to_str(t % results(1,filter_index) % sum), & trim(to_str(t % results(1,filter_index) % sum_sq)) matching_bins(i_filter_surf) = OUT_TOP filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 - write(UNIT=UNIT_TALLY, FMT='(5X,A,T35,A,"+/- ",A)') & + write(UNIT=UNIT_TALLY, FMT='(5X,A,T35,A,"+/- ",A)') & "Outgoing Current to Top", & to_str(t % results(1,filter_index) % sum), & trim(to_str(t % results(1,filter_index) % sum_sq)) From b6395729a4ba6e33b321fd08635d8f73baeb307f Mon Sep 17 00:00:00 2001 From: Adam Nelson Date: Tue, 10 Dec 2013 11:51:40 -0500 Subject: [PATCH 2/3] Added better printing of the new zaid list for cross_sections.out; now it will go to a new line before hitting the 80-char limit. --- src/output.F90 | 35 +++++++++++++++++++++++++++-------- 1 file changed, 27 insertions(+), 8 deletions(-) diff --git a/src/output.F90 b/src/output.F90 index e4fcfecef5..1507aa4cd5 100644 --- a/src/output.F90 +++ b/src/output.F90 @@ -1028,9 +1028,10 @@ contains type(SAlphaBeta), pointer :: sab integer, optional :: unit - integer :: size_sab ! memory used by S(a,b) table - integer :: unit_ ! unit to write to - integer :: i ! Loop counter for parsing through sab % zaid + integer :: size_sab ! memory used by S(a,b) table + integer :: unit_ ! unit to write to + integer :: i ! Loop counter for parsing through sab % zaid + integer :: char_count ! Counter for the number of characters on a line ! set default unit for writing information if (present(unit)) then @@ -1041,12 +1042,30 @@ contains ! Basic S(a,b) table information write(unit_,*) 'S(a,b) Table ' // trim(sab % name) - write(unit_,'(A)',advance="no") ' zaids = ' - do i = 1, sab % n_zaid - 1 - ! This could use some fancy handling for if the line becomes too long - write(unit_,'(A)',advance="no") trim(to_str(sab % zaid(sab % n_zaid))) // ', ' + write(unit_,'(A)',advance="no") ' zaids = ' + ! Initialize the counter based on the above string + char_count = 11 + do i = 1, sab % n_zaid + ! Deal with a line thats too long + if (char_count >= 73) then ! 73 = 80 - (5 ZAID chars + 1 space + 1 comma) + ! End the line + write(unit_,*) "" + ! Add 11 leading blanks + write(unit_,'(A)', advance="no") " " + ! reset the counter to 11 + char_count = 11 + end if + if (i < sab % n_zaid) then + ! Include a comma + write(unit_,'(A)',advance="no") trim(to_str(sab % zaid(i))) // ", " + char_count = char_count + len(trim(to_str(sab % zaid(i)))) + 2 + else + ! Don't include a comma, since we are all done + write(unit_,'(A)',advance="no") trim(to_str(sab % zaid(i))) + end if + end do - write(unit_,*) trim(to_str(sab % zaid(sab % n_zaid))) + write(unit_,*) "" ! Move to next line write(unit_,*) ' awr = ' // trim(to_str(sab % awr)) write(unit_,*) ' kT = ' // trim(to_str(sab % kT)) From ca4ec3b3cd1e2dd6d1a07e461b2f5ef504262fc3 Mon Sep 17 00:00:00 2001 From: Adam Nelson Date: Wed, 11 Dec 2013 09:47:49 -0500 Subject: [PATCH 3/3] Added ZrH as the top reflector of the test_salphabeta_multiple test in order to include an S(a,b) library which can be applied to multiple problems in our test suite. --- tests/test_salphabeta_multiple/geometry.xml | 6 ++++-- tests/test_salphabeta_multiple/materials.xml | 18 +++++++++++++++++- .../test_salphabeta_multiple/results_true.dat | 2 +- 3 files changed, 22 insertions(+), 4 deletions(-) diff --git a/tests/test_salphabeta_multiple/geometry.xml b/tests/test_salphabeta_multiple/geometry.xml index 2d427d8cb3..63f69f7438 100644 --- a/tests/test_salphabeta_multiple/geometry.xml +++ b/tests/test_salphabeta_multiple/geometry.xml @@ -44,9 +44,11 @@ - + - + + + diff --git a/tests/test_salphabeta_multiple/materials.xml b/tests/test_salphabeta_multiple/materials.xml index 97ff56c05f..6e975bde97 100644 --- a/tests/test_salphabeta_multiple/materials.xml +++ b/tests/test_salphabeta_multiple/materials.xml @@ -1,7 +1,8 @@ - + 70c @@ -111,4 +112,19 @@ + + + + + + + + + + + + + + + diff --git a/tests/test_salphabeta_multiple/results_true.dat b/tests/test_salphabeta_multiple/results_true.dat index f26a309aae..bbd61cdb53 100644 --- a/tests/test_salphabeta_multiple/results_true.dat +++ b/tests/test_salphabeta_multiple/results_true.dat @@ -1,2 +1,2 @@ k-combined: -1.013747E+00 3.067630E-02 +9.761880E-01 9.170415E-03