From 22808785cf963ab21456e7c2765460839d017d22 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Tue, 24 Sep 2013 14:04:27 -0400 Subject: [PATCH 01/95] added new cmfd solver that doesnt require Petsc --- src/DEPENDENCIES | 8 + src/cmfd_execute.F90 | 5 + src/cmfd_solver.F90 | 489 ++++++++++++++++++++++++++++++++ src/input_xml.F90 | 8 +- src/matrix_header.F90 | 69 ++++- src/utils/build_dependencies.py | 2 +- src/vector_header.F90 | 25 ++ 7 files changed, 594 insertions(+), 12 deletions(-) create mode 100644 src/cmfd_solver.F90 diff --git a/src/DEPENDENCIES b/src/DEPENDENCIES index eeb538fc16..dfbfe5920f 100644 --- a/src/DEPENDENCIES +++ b/src/DEPENDENCIES @@ -24,6 +24,7 @@ cmfd_data.o: tally_header.o cmfd_execute.o: cmfd_data.o cmfd_execute.o: cmfd_jfnk_solver.o cmfd_execute.o: cmfd_power_solver.o +cmfd_execute.o: cmfd_solver.o cmfd_execute.o: constants.o cmfd_execute.o: error.o cmfd_execute.o: global.o @@ -76,6 +77,13 @@ cmfd_slepc_solver.o: cmfd_prod_operator.o cmfd_slepc_solver.o: constants.o cmfd_slepc_solver.o: global.o +cmfd_solver.o: cmfd_loss_operator.o +cmfd_solver.o: cmfd_prod_operator.o +cmfd_solver.o: constants.o +cmfd_solver.o: global.o +cmfd_solver.o: matrix_header.o +cmfd_solver.o: vector_header.o + cross_section.o: ace_header.o cross_section.o: constants.o cross_section.o: error.o diff --git a/src/cmfd_execute.F90 b/src/cmfd_execute.F90 index 17c8157f41..83257a870d 100644 --- a/src/cmfd_execute.F90 +++ b/src/cmfd_execute.F90 @@ -22,6 +22,7 @@ contains use cmfd_data, only: set_up_cmfd use cmfd_power_solver, only: cmfd_power_execute use cmfd_jfnk_solver, only: cmfd_jfnk_execute + use cmfd_solver, only: cmfd_solver_execute use error, only: warning, fatal_error ! CMFD single processor on master @@ -37,6 +38,7 @@ contains call process_cmfd_options() ! Call solver +#ifdef PETSC if (trim(cmfd_solver_type) == 'power') then call cmfd_power_execute() elseif (trim(cmfd_solver_type) == 'jfnk') then @@ -45,6 +47,9 @@ contains message = 'solver type became invalid after input processing' call fatal_error() end if +#else + call cmfd_solver_execute() +#endif ! Save k-effective cmfd % k_cmfd(current_batch) = cmfd % keff diff --git a/src/cmfd_solver.F90 b/src/cmfd_solver.F90 new file mode 100644 index 0000000000..f8ee244017 --- /dev/null +++ b/src/cmfd_solver.F90 @@ -0,0 +1,489 @@ +module cmfd_solver + +! This module contains routines to execute the power iteration solver + + use cmfd_loss_operator, only: init_loss_matrix, build_loss_matrix + use cmfd_prod_operator, only: init_prod_matrix, build_prod_matrix + use matrix_header, only: Matrix + use vector_header, only: Vector + + implicit none + private + public :: cmfd_solver_execute + + logical :: iconv ! did the problem converged + real(8) :: k_n ! new k-eigenvalue + real(8) :: k_o ! old k-eigenvalue + real(8) :: ktol = 1.e-8_8 ! tolerance on keff + real(8) :: stol = 1.e-8_8 ! tolerance on source + real(8) :: norm_n ! current norm of source vector + real(8) :: norm_o ! old norm of source vector + real(8) :: kerr ! error in keff + real(8) :: serr ! error in source + logical :: adjoint_calc ! run an adjoint calculation + type(Matrix) :: loss ! cmfd loss matrix + type(Matrix) :: prod ! cmfd prod matrix + type(Vector) :: phi_n ! new flux vector + type(Vector) :: phi_o ! old flux vector + type(Vector) :: s_n ! new source vector + type(Vector) :: s_o ! old flux vector + type(Vector) :: serr_v ! error in source + +contains + +!=============================================================================== +! CMFD_SOLVER_EXECUTE sets up and runs power iteration solver for CMFD +!=============================================================================== + + subroutine cmfd_solver_execute(k_tol, s_tol, adjoint) + + use global, only: cmfd_adjoint_type, time_cmfdbuild, time_cmfdsolve + + real(8), optional :: k_tol ! tolerance on keff + real(8), optional :: s_tol ! tolerance on source + logical, optional :: adjoint ! adjoint calc + + logical :: physical_adjoint = .false. + + ! Set tolerances if present + if (present(k_tol)) ktol = k_tol + if (present(s_tol)) stol = s_tol + + ! Check for adjoint execution + adjoint_calc = .false. + if (present(adjoint)) adjoint_calc = adjoint + + ! Check for physical adjoint + if (adjoint_calc .and. trim(cmfd_adjoint_type) == 'physical') & + physical_adjoint = .true. + + ! Start timer for build + call time_cmfdbuild % start() + + ! Initialize matrices and vectors + call init_data(physical_adjoint) + + ! Check for mathematical adjoint calculation + if (adjoint_calc .and. trim(cmfd_adjoint_type) == 'math') & + call compute_adjoint() + + ! Stop timer for build + call time_cmfdbuild % stop() + + ! Begin power iteration + call time_cmfdsolve % start() + call execute_power_iter() + call time_cmfdsolve % stop() + + ! Extract results + call extract_results() + + ! Deallocate data + call finalize() + + end subroutine cmfd_solver_execute + +!=============================================================================== +! INIT_DATA allocates matrices and vectors for CMFD solution +!=============================================================================== + + subroutine init_data(adjoint) + + use constants, only: ONE, ZERO + use global, only: cmfd_write_matrices + + logical :: adjoint + + integer :: n ! problem size + real(8) :: guess ! initial guess + + ! Set up matrices + call init_loss_matrix(loss) + call init_prod_matrix(prod) + + ! Get problem size + n = loss % n + + ! Set up flux vectors + call phi_n % create(n) + call phi_o % create(n) + + ! Set up source vectors + call s_n % create(n) + call s_o % create(n) + call serr_v % create(n) + + ! Set initial guess + guess = ONE + phi_n % val = guess + phi_o % val = guess + k_n = guess + k_o = guess + + ! Fill in loss matrix + call build_loss_matrix(loss, adjoint=adjoint) + + ! Fill in production matrix + call build_prod_matrix(prod, adjoint=adjoint) + + ! Setup petsc for everything + call loss % assemble() + call prod % assemble() + call loss % write('loss.dat') + call prod % write('prod.dat') + + ! Set norms to 0 + norm_n = ZERO + norm_o = ZERO + + end subroutine init_data + +!=============================================================================== +! COMPUTE_ADJOINT computes a mathematical adjoint of CMFD problem +!=============================================================================== + + subroutine compute_adjoint() + + use global, only: cmfd_write_matrices + + ! Transpose matrices + call loss % transpose() + call prod % transpose() + + ! Write out matrix in binary file (debugging) + if (cmfd_write_matrices) then + call loss % write_petsc_binary('adj_lossmat.bin') + call prod % write_petsc_binary('adj_prodmat.bin') + end if + + end subroutine compute_adjoint + +!=============================================================================== +! EXECUTE_POWER_ITER is the main power iteration routine +! for the cmfd calculation +!=============================================================================== + + subroutine execute_power_iter() + + integer :: i ! iteration counter + + ! Reset convergence flag + iconv = .false. + + ! Begin power iteration + do i = 1, 10000 + + ! Compute source vector + call prod % vector_multiply(phi_o, s_o) + + ! Normalize source vector + s_o % val = s_o % val / k_o + + ! Compute new flux vector + call cmfd_linsolver(s_o, phi_n) + + ! Compute new source vector + call prod % vector_multiply(phi_n, s_n) + + ! Compute new k-eigenvalue + k_n = sum(s_n % val) / sum(s_o % val) + + ! Renormalize the old source + s_o % val = s_o % val * k_o + + ! Check convergence + call convergence(i) + + ! Break loop if converged + if (iconv) exit + + ! Record old values + phi_o % val = phi_n % val + k_o = k_n + norm_o = norm_n + + end do + + end subroutine execute_power_iter + +!=============================================================================== +! CONVERGENCE checks the convergence of the CMFD problem +!=============================================================================== + + subroutine convergence(iter) + + use constants, only: ONE, TINY_BIT + use global, only: cmfd_power_monitor, master + use, intrinsic :: ISO_FORTRAN_ENV + + integer :: iter ! iteration number + + ! Reset convergence flag + iconv = .false. + + ! Calculate error in keff + kerr = abs(k_o - k_n)/k_n + + ! Calculate max error in source + where (s_n % val > TINY_BIT) + serr_v % val = ((s_n % val - s_o % val)/s_n % val)**2 + end where + serr = sqrt(ONE/dble(s_n % n) * sum(serr_v % val)) + + ! Check for convergence + if(kerr < ktol .and. serr < stol) iconv = .true. + + ! Save the L2 norm of the source + norm_n = serr + + ! Print out to user + if (cmfd_power_monitor .and. master) then + write(OUTPUT_UNIT,FMT='(I0,":",T10,"k-eff: ",F0.8,T30,"k-error: ", & + &1PE12.5,T55, "src-error: ",1PE12.5)') iter, k_n, kerr, serr + end if + + end subroutine convergence + +!=============================================================================== +! CMFD_LINSOLVER solves the CMFD linear system +!=============================================================================== + + subroutine cmfd_linsolver(b, x) + + use constants, only: ONE, ZERO + use global, only: cmfd + + type(Vector) :: b ! right hand side vector + type(Vector) :: x ! unknown vector + + integer :: i ! loop counter for x + integer :: j ! loop counter for y + integer :: k ! loop counter for z + integer :: n ! total size of vector + integer :: nx ! maximum dimension in x direction + integer :: ny ! maximum dimension in y direction + integer :: nz ! maximum dimension in z direction + integer :: ng ! number of energy groups + integer :: matidx ! matrix index of row + integer :: d1idx ! index of row "1" diagonal + integer :: d2idx ! index of row "2" diagonal + integer :: igs ! Gauss-Seidel iteration counter + integer :: irb ! Red/Black iteration switch + integer :: icol ! iteration counter over columns + logical :: found ! did we find col + real(8) :: m11 ! block diagonal component 1,1 + real(8) :: m12 ! block diagonal component 1,2 + real(8) :: m21 ! block diagonal component 2,1 + real(8) :: m22 ! block diagonal component 2,2 + real(8) :: dm ! determinant of block diagonal + real(8) :: d11 ! inverse component 1,1 + real(8) :: d12 ! inverse component 1,2 + real(8) :: d21 ! inverse component 2,1 + real(8) :: d22 ! inverse component 2,2 + real(8) :: tmp1 ! temporary sum g1 + real(8) :: tmp2 ! temporary sum g2 + real(8) :: err ! error in convergence of solution + real(8) :: tol ! tolerance on final error + type(Vector) :: tmpx ! temporary solution vector + + ! Set tolerance + tol = 1.e-10_8 + + ! Dimensions + ng = 2 + nx = cmfd % indices(1) + ny = cmfd % indices(2) + nz = cmfd % indices(3) + n = ng*nx*ny*nz + + ! Perform Gauss Seidel iterations + GS: do igs = 1, 10000 + + ! Copy over x vector + call tmpx % copy(x) + + ! Perform red/black gs iterations + REDBLACK: do irb = 0,1 + + ZLOOP: do k = 1, nz + + YLOOP: do j = 1, ny + + XLOOP: do i = 1, nx + + ! Filter out black cells (even) + if (mod(i+j+k,2) == irb) cycle + + ! Get starting row in matrix for this block + call indices_to_matrix(1, i, j, k, matidx, ng, nx, ny) + + ! Get the index of the diagonals for both rows + call loss % search_indices(matidx, matidx, d1idx, found) + + call loss % search_indices(matidx + 1, matidx + 1, d2idx, found) + + ! Get block diagonal + m11 = loss % val(d1idx) ! group 1 diagonal + m12 = loss % val(d1idx + 1) ! group 1 right of diagonal (sorted by col) + m21 = loss % val(d2idx - 1) ! group 2 left of diagonal (sorted by col) + m22 = loss % val(d2idx) ! group 2 diagonal + + ! Analytically invert the diagonal + dm = m11*m22 - m12*m21 + d11 = m22/dm + d12 = -m12/dm + d21 = -m21/dm + d22 = m11/dm + + ! Perform temporary sums, first do left of diag block, then right of diag block + tmp1 = ZERO + tmp2 = ZERO + do icol = loss % get_row(matidx), d1idx - 1 + tmp1 = tmp1 + loss % val(icol)*x % val(loss % get_col(icol)) + end do + do icol = loss % get_row(matidx + 1), d2idx - 2 + tmp2 = tmp2 + loss % val(icol)*x % val(loss % get_col(icol)) + end do + do icol = d1idx + 2, loss % get_row(matidx + 1) - 1 + tmp1 = tmp1 + loss % val(icol)*x % val(loss % get_col(icol)) + end do + do icol = d2idx + 1, loss % get_row(matidx + 2) - 1 + tmp2 = tmp2 + loss % val(icol)*x % val(loss % get_col(icol)) + end do + + ! Adjust with RHS vector + tmp1 = b % val(matidx) - tmp1 + tmp2 = b % val(matidx + 1) - tmp2 + + ! Solve for new x + x % val(matidx) = d11*tmp1 + d12*tmp2 + x % val(matidx + 1) = d21*tmp1 + d22*tmp2 + + end do XLOOP + + end do YLOOP + + end do ZLOOP + + end do REDBLACK + + ! Check convergence + err = sqrt(sum(((tmpx % val - x % val)/tmpx % val)**2)/n) + if (err < tol) exit + + end do GS + + call tmpx % destroy() + + end subroutine cmfd_linsolver + +!=============================================================================== +! EXTRACT_RESULTS takes results and puts them in CMFD global data object +!=============================================================================== + + subroutine extract_results() + + use global, only: cmfd, cmfd_write_matrices, current_batch + + character(len=25) :: filename ! name of file to write data + integer :: n ! problem size + + ! Get problem size + n = loss % n + + ! Allocate in cmfd object if not already allocated + if (adjoint_calc) then + if (.not. allocated(cmfd%adj_phi)) allocate(cmfd%adj_phi(n)) + else + if (.not. allocated(cmfd%phi)) allocate(cmfd%phi(n)) + end if + + ! Save values + if (adjoint_calc) then + cmfd % adj_phi = phi_n % val + else + cmfd % phi = phi_n % val + end if + + ! Save eigenvalue + if(adjoint_calc) then + cmfd%adj_keff = k_n + else + cmfd%keff = k_n + end if + + ! Normalize phi to 1 + if (adjoint_calc) then + cmfd%adj_phi = cmfd%adj_phi/sqrt(sum(cmfd%adj_phi*cmfd%adj_phi)) + else + cmfd%phi = cmfd%phi/sqrt(sum(cmfd%phi*cmfd%phi)) + end if + + ! Save dominance ratio + cmfd % dom(current_batch) = norm_n/norm_o + + ! Write out results + if (cmfd_write_matrices) then + if (adjoint_calc) then + filename = 'adj_fluxvec.bin' + else + filename = 'fluxvec.bin' + end if + call phi_n % write_petsc_binary(filename) + end if + + end subroutine extract_results + +!=============================================================================== +! INDICES_TO_MATRIX takes (x,y,z,g) indices and computes location in matrix +!=============================================================================== + + subroutine indices_to_matrix(g, i, j, k, matidx, ng, nx, ny) + + use global, only: cmfd, cmfd_coremap + + integer :: matidx ! the index location in matrix + integer :: i ! current x index + integer :: j ! current y index + integer :: k ! current z index + integer :: g ! current group index + integer :: nx ! maximum number of x cells + integer :: ny ! maximum number of y cells + integer :: ng ! maximum number of groups + + ! Check if coremap is used + if (cmfd_coremap) then + + ! Get idx from core map + matidx = ng*(cmfd % coremap(i,j,k)) - (ng - g) + + else + + ! Compute index + matidx = g + ng*(i - 1) + ng*nx*(j - 1) + ng*nx*ny*(k - 1) + + end if + + end subroutine indices_to_matrix + +!=============================================================================== +! FINALIZE frees all memory associated with power iteration +!=============================================================================== + + subroutine finalize() + + ! Destroy all objects +#ifdef PETSC + call gmres % destroy() +#endif + call loss % destroy() + call prod % destroy() + call phi_n % destroy() + call phi_o % destroy() + call s_n % destroy() + call s_o % destroy() + call serr_v % destroy + + end subroutine finalize + +end module cmfd_solver diff --git a/src/input_xml.F90 b/src/input_xml.F90 index f50a4557c5..13b82e9400 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -579,10 +579,10 @@ contains call lower_case(run_cmfd_) if (run_cmfd_ == 'true' .or. run_cmfd_ == '1') then cmfd_run = .true. -#ifndef PETSC - message = 'CMFD is not available, recompile OpenMC with PETSc' - call fatal_error() -#endif +!#ifndef PETSC +! message = 'CMFD is not available, recompile OpenMC with PETSc' +! call fatal_error() +!#endif end if end subroutine read_settings_xml diff --git a/src/matrix_header.F90 b/src/matrix_header.F90 index 25f1df95a5..51308123f5 100644 --- a/src/matrix_header.F90 +++ b/src/matrix_header.F90 @@ -20,17 +20,19 @@ module matrix_header # endif logical :: petsc_active contains - procedure :: create => matrix_create - procedure :: destroy => matrix_destroy - procedure :: add_value => matrix_add_value - procedure :: new_row => matrix_new_row - procedure :: assemble => matrix_assemble - procedure :: get_row => matrix_get_row - procedure :: get_col => matrix_get_col + procedure :: create => matrix_create + procedure :: destroy => matrix_destroy + procedure :: add_value => matrix_add_value + procedure :: new_row => matrix_new_row + procedure :: assemble => matrix_assemble + procedure :: get_row => matrix_get_row + procedure :: get_col => matrix_get_col procedure :: setup_petsc => matrix_setup_petsc procedure :: write_petsc_binary => matrix_write_petsc_binary procedure :: transpose => matrix_transpose procedure :: vector_multiply => matrix_vector_multiply + procedure :: search_indices => matrix_search_indices + procedure :: write => matrix_write end type matrix integer :: petsc_err @@ -355,4 +357,57 @@ contains end subroutine matrix_vector_multiply +!=============================================================================== +! MATRIX_SEARCH_INDICES searches for an index in column corresponding to a row +!=============================================================================== + + subroutine matrix_search_indices(self, row, col, idx, found) + + class(Matrix) :: self + integer :: row + integer :: col + integer :: idx + logical :: found + + integer :: j + + found = .false. + + COLS: do j = self % get_row(row), self % get_row(row + 1) - 1 + + if (self % get_col(j) == col) then + idx = j + found = .true. + exit + end if + + end do COLS + + end subroutine matrix_search_indices + +!=============================================================================== +! MATRIX_WRITE writes a matrix to file +!=============================================================================== + + subroutine matrix_write(self, filename) + + character(*) :: filename + class(Matrix) :: self + + integer :: unit_ + integer :: i + integer :: j + + open(newunit=unit_, file=filename) + + do i = 1, self % n + do j = self % get_row(i), self % get_row(i + 1) - 1 + write(unit_,*) i, self % get_col(j), self % val(j) + end do + end do + + close(unit_) + + end subroutine matrix_write + end module matrix_header diff --git a/src/utils/build_dependencies.py b/src/utils/build_dependencies.py index 19ac978857..cefc59b937 100755 --- a/src/utils/build_dependencies.py +++ b/src/utils/build_dependencies.py @@ -12,7 +12,7 @@ for src in glob.iglob('*.F90'): open(src, 'r').read()) for name in d: if name in ['mpi', 'hdf5', 'h5lt', 'petscsys', 'petscmat', 'petscksp', - 'petscsnes', 'petscvec']: + 'petscsnes', 'petscvec', 'omp_lib']: continue if name.startswith('xml_data_'): name = name.replace('xml_data_', 'templates/') diff --git a/src/vector_header.F90 b/src/vector_header.F90 index 47b865ebec..ed9ceda089 100644 --- a/src/vector_header.F90 +++ b/src/vector_header.F90 @@ -23,6 +23,7 @@ module vector_header procedure :: add_value => vector_add_value procedure :: setup_petsc => vector_setup_petsc procedure :: write_petsc_binary => vector_write_petsc_binary + procedure :: copy => vector_copy end type Vector integer :: petsc_err @@ -123,4 +124,28 @@ contains end subroutine vector_write_petsc_binary +!=============================================================================== +! VECTOR_COPY allocates a separate vector and copies +!=============================================================================== + + subroutine vector_copy(self, vectocopy) + + class(Vector), target :: self + type(Vector) :: vectocopy + + ! Preallocate vector + if (.not.allocated(self % data)) allocate(self % data(vectocopy % n)) + self % val => self % data(1:vectocopy % n) + + ! Set n + self % n = vectocopy % n + + ! Copy values + self % val = vectocopy % val + + ! Petsc is default not active + self % petsc_active = .false. + + end subroutine vector_copy + end module vector_header From c3446ef71450c8866fbc0e208141c903e7850e6e Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Tue, 24 Sep 2013 15:00:22 -0400 Subject: [PATCH 02/95] added SOR --- src/cmfd_input.F90 | 3 +++ src/cmfd_solver.F90 | 20 ++++++++++++++++---- src/global.F90 | 3 +++ src/templates/cmfd_t.xml | 1 + 4 files changed, 23 insertions(+), 4 deletions(-) diff --git a/src/cmfd_input.F90 b/src/cmfd_input.F90 index 9a768f4e3b..5c7b7355a4 100644 --- a/src/cmfd_input.F90 +++ b/src/cmfd_input.F90 @@ -199,6 +199,9 @@ contains cmfd_display = '' end if + ! Read in spectral radius estimate + cmfd_spectral = spectral_ + ! Create tally objects call create_cmfd_tally() diff --git a/src/cmfd_solver.F90 b/src/cmfd_solver.F90 index f8ee244017..53b3f8aed4 100644 --- a/src/cmfd_solver.F90 +++ b/src/cmfd_solver.F90 @@ -251,7 +251,7 @@ contains subroutine cmfd_linsolver(b, x) use constants, only: ONE, ZERO - use global, only: cmfd + use global, only: cmfd, cmfd_spectral type(Vector) :: b ! right hand side vector type(Vector) :: x ! unknown vector @@ -282,12 +282,16 @@ contains real(8) :: d22 ! inverse component 2,2 real(8) :: tmp1 ! temporary sum g1 real(8) :: tmp2 ! temporary sum g2 + real(8) :: x1 ! new g1 value of x + real(8) :: x2 ! new g2 value of x real(8) :: err ! error in convergence of solution real(8) :: tol ! tolerance on final error + real(8) :: w ! overrelaxation parameter type(Vector) :: tmpx ! temporary solution vector - ! Set tolerance + ! Set tolerance and overrelaxation parameter tol = 1.e-10_8 + w = ONE ! Dimensions ng = 2 @@ -356,8 +360,12 @@ contains tmp2 = b % val(matidx + 1) - tmp2 ! Solve for new x - x % val(matidx) = d11*tmp1 + d12*tmp2 - x % val(matidx + 1) = d21*tmp1 + d22*tmp2 + x1 = d11*tmp1 + d12*tmp2 + x2 = d21*tmp1 + d22*tmp2 + + ! Perform overrelaxation + x % val(matidx) = (ONE - w)*x % val(matidx) + w*x1 + x % val(matidx + 1) = (ONE - w)*x % val(matidx + 1) + w*x2 end do XLOOP @@ -369,8 +377,12 @@ contains ! Check convergence err = sqrt(sum(((tmpx % val - x % val)/tmpx % val)**2)/n) +print *, igs, err, w if (err < tol) exit + ! Calculation new overrelaxation parameter + w = ONE/(ONE - 0.25_8*cmfd_spectral*w) + end do GS call tmpx % destroy() diff --git a/src/global.F90 b/src/global.F90 index f12171b257..79cddbaa47 100644 --- a/src/global.F90 +++ b/src/global.F90 @@ -355,6 +355,9 @@ module global ! CMFD display info character(len=25) :: cmfd_display + ! Estimate of spectral radius of CMFD matrices + real(8) :: cmfd_spectral = ONE + ! Information about state points to be written integer :: n_state_points = 0 type(SetInt) :: statepoint_batch diff --git a/src/templates/cmfd_t.xml b/src/templates/cmfd_t.xml index 0e49e0e5ab..901b30181d 100644 --- a/src/templates/cmfd_t.xml +++ b/src/templates/cmfd_t.xml @@ -30,5 +30,6 @@ + From c479adc5678506e06f5d79ab3cfa0cddb8ffb96b Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Tue, 24 Sep 2013 18:00:12 -0400 Subject: [PATCH 03/95] solver now works with coremap feature, loop is around rows now instead of i,j,k --- src/cmfd_solver.F90 | 144 +++++++++++++++++++++++++++----------------- 1 file changed, 88 insertions(+), 56 deletions(-) diff --git a/src/cmfd_solver.F90 b/src/cmfd_solver.F90 index 53b3f8aed4..698e1dd8c1 100644 --- a/src/cmfd_solver.F90 +++ b/src/cmfd_solver.F90 @@ -256,6 +256,7 @@ contains type(Vector) :: b ! right hand side vector type(Vector) :: x ! unknown vector + integer :: g ! group index integer :: i ! loop counter for x integer :: j ! loop counter for y integer :: k ! loop counter for z @@ -264,11 +265,11 @@ contains integer :: ny ! maximum dimension in y direction integer :: nz ! maximum dimension in z direction integer :: ng ! number of energy groups - integer :: matidx ! matrix index of row integer :: d1idx ! index of row "1" diagonal integer :: d2idx ! index of row "2" diagonal integer :: igs ! Gauss-Seidel iteration counter integer :: irb ! Red/Black iteration switch + integer :: irow ! row iteration integer :: icol ! iteration counter over columns logical :: found ! did we find col real(8) :: m11 ! block diagonal component 1,1 @@ -298,7 +299,7 @@ contains nx = cmfd % indices(1) ny = cmfd % indices(2) nz = cmfd % indices(3) - n = ng*nx*ny*nz + n = loss % n ! Perform Gauss Seidel iterations GS: do igs = 1, 10000 @@ -309,75 +310,67 @@ contains ! Perform red/black gs iterations REDBLACK: do irb = 0,1 - ZLOOP: do k = 1, nz + ! Begin loop around matrix rows + ROWS: do irow = 1, n, 2 - YLOOP: do j = 1, ny + ! Get spatial location + call matrix_to_indices(irow, g, i, j, k, ng, nx, ny, nz) - XLOOP: do i = 1, nx + ! Filter out black cells (even) + if (mod(i+j+k,2) == irb) cycle - ! Filter out black cells (even) - if (mod(i+j+k,2) == irb) cycle + ! Get the index of the diagonals for both rows + call loss % search_indices(irow, irow, d1idx, found) + call loss % search_indices(irow + 1, irow + 1, d2idx, found) - ! Get starting row in matrix for this block - call indices_to_matrix(1, i, j, k, matidx, ng, nx, ny) + ! Get block diagonal + m11 = loss % val(d1idx) ! group 1 diagonal + m12 = loss % val(d1idx + 1) ! group 1 right of diagonal (sorted by col) + m21 = loss % val(d2idx - 1) ! group 2 left of diagonal (sorted by col) + m22 = loss % val(d2idx) ! group 2 diagonal - ! Get the index of the diagonals for both rows - call loss % search_indices(matidx, matidx, d1idx, found) + ! Analytically invert the diagonal + dm = m11*m22 - m12*m21 + d11 = m22/dm + d12 = -m12/dm + d21 = -m21/dm + d22 = m11/dm - call loss % search_indices(matidx + 1, matidx + 1, d2idx, found) + ! Perform temporary sums, first do left of diag block, then right of diag block + tmp1 = ZERO + tmp2 = ZERO + do icol = loss % get_row(irow), d1idx - 1 + tmp1 = tmp1 + loss % val(icol)*x % val(loss % get_col(icol)) + end do + do icol = loss % get_row(irow + 1), d2idx - 2 + tmp2 = tmp2 + loss % val(icol)*x % val(loss % get_col(icol)) + end do + do icol = d1idx + 2, loss % get_row(irow + 1) - 1 + tmp1 = tmp1 + loss % val(icol)*x % val(loss % get_col(icol)) + end do + do icol = d2idx + 1, loss % get_row(irow + 2) - 1 + tmp2 = tmp2 + loss % val(icol)*x % val(loss % get_col(icol)) + end do - ! Get block diagonal - m11 = loss % val(d1idx) ! group 1 diagonal - m12 = loss % val(d1idx + 1) ! group 1 right of diagonal (sorted by col) - m21 = loss % val(d2idx - 1) ! group 2 left of diagonal (sorted by col) - m22 = loss % val(d2idx) ! group 2 diagonal + ! Adjust with RHS vector + tmp1 = b % val(irow) - tmp1 + tmp2 = b % val(irow + 1) - tmp2 - ! Analytically invert the diagonal - dm = m11*m22 - m12*m21 - d11 = m22/dm - d12 = -m12/dm - d21 = -m21/dm - d22 = m11/dm + ! Solve for new x + x1 = d11*tmp1 + d12*tmp2 + x2 = d21*tmp1 + d22*tmp2 - ! Perform temporary sums, first do left of diag block, then right of diag block - tmp1 = ZERO - tmp2 = ZERO - do icol = loss % get_row(matidx), d1idx - 1 - tmp1 = tmp1 + loss % val(icol)*x % val(loss % get_col(icol)) - end do - do icol = loss % get_row(matidx + 1), d2idx - 2 - tmp2 = tmp2 + loss % val(icol)*x % val(loss % get_col(icol)) - end do - do icol = d1idx + 2, loss % get_row(matidx + 1) - 1 - tmp1 = tmp1 + loss % val(icol)*x % val(loss % get_col(icol)) - end do - do icol = d2idx + 1, loss % get_row(matidx + 2) - 1 - tmp2 = tmp2 + loss % val(icol)*x % val(loss % get_col(icol)) - end do + ! Perform overrelaxation + x % val(irow) = (ONE - w)*x % val(irow) + w*x1 + x % val(irow + 1) = (ONE - w)*x % val(irow + 1) + w*x2 - ! Adjust with RHS vector - tmp1 = b % val(matidx) - tmp1 - tmp2 = b % val(matidx + 1) - tmp2 - - ! Solve for new x - x1 = d11*tmp1 + d12*tmp2 - x2 = d21*tmp1 + d22*tmp2 - - ! Perform overrelaxation - x % val(matidx) = (ONE - w)*x % val(matidx) + w*x1 - x % val(matidx + 1) = (ONE - w)*x % val(matidx + 1) + w*x2 - - end do XLOOP - - end do YLOOP - - end do ZLOOP + end do ROWS end do REDBLACK ! Check convergence err = sqrt(sum(((tmpx % val - x % val)/tmpx % val)**2)/n) -print *, igs, err, w +! print *, igs, err, w if (err < tol) exit ! Calculation new overrelaxation parameter @@ -478,6 +471,45 @@ print *, igs, err, w end subroutine indices_to_matrix +!=============================================================================== +! MATRIX_TO_INDICES converts a matrix index to spatial and group indicies +!=============================================================================== + + subroutine matrix_to_indices(irow, g, i, j, k, ng, nx, ny, nz) + + use global, only: cmfd, cmfd_coremap + + integer :: i ! iteration counter for x + integer :: j ! iteration counter for y + integer :: k ! iteration counter for z + integer :: g ! iteration counter for groups + integer :: irow ! iteration counter over row (0 reference) + integer :: nx ! maximum number of x cells + integer :: ny ! maximum number of y cells + integer :: nz ! maximum number of z cells + integer :: ng ! maximum number of groups + + ! Check for core map + if (cmfd_coremap) then + + ! Get indices from indexmap + g = mod(irow-1, ng) + 1 + i = cmfd % indexmap((irow-1)/ng+1,1) + j = cmfd % indexmap((irow-1)/ng+1,2) + k = cmfd % indexmap((irow-1)/ng+1,3) + + else + + ! Compute indices + g = mod(irow-1, ng) + 1 + i = mod(irow-1, ng*nx)/ng + 1 + j = mod(irow-1, ng*nx*ny)/(ng*nx)+ 1 + k = mod(irow-1, ng*nx*ny*nz)/(ng*nx*ny) + 1 + + end if + + end subroutine matrix_to_indices + !=============================================================================== ! FINALIZE frees all memory associated with power iteration !=============================================================================== From da9b1051b3b8b49d4c0f9a3608c33d309a45463a Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Tue, 24 Sep 2013 19:06:15 -0400 Subject: [PATCH 04/95] default spectral radius is 0 (G-S no SOR) --- src/global.F90 | 2 +- src/templates/cmfd_t.xml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/global.F90 b/src/global.F90 index 79cddbaa47..62b196319e 100644 --- a/src/global.F90 +++ b/src/global.F90 @@ -356,7 +356,7 @@ module global character(len=25) :: cmfd_display ! Estimate of spectral radius of CMFD matrices - real(8) :: cmfd_spectral = ONE + real(8) :: cmfd_spectral = ZERO ! Information about state points to be written integer :: n_state_points = 0 diff --git a/src/templates/cmfd_t.xml b/src/templates/cmfd_t.xml index 901b30181d..093edf112b 100644 --- a/src/templates/cmfd_t.xml +++ b/src/templates/cmfd_t.xml @@ -30,6 +30,6 @@ - + From e9b0642c1f8959cfbc78da103fbe46f1e7551e36 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Tue, 24 Sep 2013 19:06:59 -0400 Subject: [PATCH 05/95] added 1g solver and procedure pointer --- src/cmfd_solver.F90 | 132 ++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 127 insertions(+), 5 deletions(-) diff --git a/src/cmfd_solver.F90 b/src/cmfd_solver.F90 index 698e1dd8c1..0769beef73 100644 --- a/src/cmfd_solver.F90 +++ b/src/cmfd_solver.F90 @@ -29,6 +29,16 @@ module cmfd_solver type(Vector) :: s_o ! old flux vector type(Vector) :: serr_v ! error in source + ! CMFD linear solver interface + procedure(linsolve), pointer :: cmfd_linsolver => null() + abstract interface + subroutine linsolve(b, x) + import :: Vector + type(Vector) :: b + type(Vector) :: x + end subroutine linsolve + end interface + contains !=============================================================================== @@ -90,7 +100,8 @@ contains subroutine init_data(adjoint) use constants, only: ONE, ZERO - use global, only: cmfd_write_matrices + use error, only: fatal_error + use global, only: cmfd, cmfd_write_matrices, message logical :: adjoint @@ -136,6 +147,18 @@ contains norm_n = ZERO norm_o = ZERO + ! Set up solver + select case(cmfd % indices(4)) + case(1) + cmfd_linsolver => cmfd_linsolver_1g + case(2) + cmfd_linsolver => cmfd_linsolver_2g + case default + message = 'Must use PETSc for more than 2 groups' + call fatal_error() + end select + + end subroutine init_data !=============================================================================== @@ -245,10 +268,109 @@ contains end subroutine convergence !=============================================================================== -! CMFD_LINSOLVER solves the CMFD linear system +! CMFD_LINSOLVER_1g solves the CMFD linear system !=============================================================================== - subroutine cmfd_linsolver(b, x) + subroutine cmfd_linsolver_1g(b, x) + + use constants, only: ONE, ZERO + use global, only: cmfd, cmfd_spectral + + type(Vector) :: b ! right hand side vector + type(Vector) :: x ! unknown vector + + integer :: g ! group index + integer :: i ! loop counter for x + integer :: j ! loop counter for y + integer :: k ! loop counter for z + integer :: n ! total size of vector + integer :: nx ! maximum dimension in x direction + integer :: ny ! maximum dimension in y direction + integer :: nz ! maximum dimension in z direction + integer :: ng ! number of energy groups + integer :: igs ! Gauss-Seidel iteration counter + integer :: irb ! Red/Black iteration switch + integer :: irow ! row iteration + integer :: icol ! iteration counter over columns + integer :: didx ! index for diagonal component + logical :: found ! did we find col + real(8) :: tmp1 ! temporary sum g1 + real(8) :: x1 ! new g1 value of x + real(8) :: err ! error in convergence of solution + real(8) :: tol ! tolerance on final error + real(8) :: w ! overrelaxation parameter + type(Vector) :: tmpx ! temporary solution vector + + ! Set tolerance and overrelaxation parameter + tol = 1.e-10_8 + w = ONE + + ! Dimensions + ng = 1 + nx = cmfd % indices(1) + ny = cmfd % indices(2) + nz = cmfd % indices(3) + n = loss % n + + ! Perform Gauss Seidel iterations + GS: do igs = 1, 10000 + + ! Copy over x vector + call tmpx % copy(x) + + ! Perform red/black gs iterations + REDBLACK: do irb = 0,1 + + ! Begin loop around matrix rows + ROWS: do irow = 1, n + + ! Get spatial location + call matrix_to_indices(irow, g, i, j, k, ng, nx, ny, nz) + + ! Filter out black cells (even) + if (mod(i+j+k,2) == irb) cycle + + ! Get the index of the diagonals for both rows + call loss % search_indices(irow, irow, didx, found) + + ! Perform temporary sums, first do left of diag block, then right of diag block + tmp1 = ZERO + do icol = loss % get_row(irow), didx - 1 + tmp1 = tmp1 + loss % val(icol)*x % val(loss % get_col(icol)) + end do + do icol = didx + 1, loss % get_row(irow + 1) - 1 + tmp1 = tmp1 + loss % val(icol)*x % val(loss % get_col(icol)) + end do + + ! Solve for new x + x1 = (b % val(irow) - tmp1)/loss % val(didx) + + ! Perform overrelaxation + x % val(irow) = (ONE - w)*x % val(irow) + w*x1 + + end do ROWS + + end do REDBLACK + + ! Check convergence + err = sqrt(sum(((tmpx % val - x % val)/tmpx % val)**2)/n) +!print *, igs, err, w + if (err < tol) exit + + ! Calculation new overrelaxation parameter + w = ONE/(ONE - 0.25_8*cmfd_spectral*w) + + end do GS + + call tmpx % destroy() + + end subroutine cmfd_linsolver_1g + +!=============================================================================== +! CMFD_LINSOLVER_2G solves the CMFD linear system +!=============================================================================== + + subroutine cmfd_linsolver_2g(b, x) use constants, only: ONE, ZERO use global, only: cmfd, cmfd_spectral @@ -370,7 +492,7 @@ contains ! Check convergence err = sqrt(sum(((tmpx % val - x % val)/tmpx % val)**2)/n) -! print *, igs, err, w +!print *, igs, err, w if (err < tol) exit ! Calculation new overrelaxation parameter @@ -380,7 +502,7 @@ contains call tmpx % destroy() - end subroutine cmfd_linsolver + end subroutine cmfd_linsolver_2g !=============================================================================== ! EXTRACT_RESULTS takes results and puts them in CMFD global data object From 035534124763d6b5a2a5b21ad064649736ff3886 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Tue, 24 Sep 2013 19:18:42 -0400 Subject: [PATCH 06/95] can now set G-S tolerance, updated tests --- src/cmfd_input.F90 | 3 ++- src/cmfd_solver.F90 | 4 ++-- src/global.F90 | 3 ++- src/templates/cmfd_t.xml | 1 + tests/test_cmfd_feed/cmfd.xml | 1 + tests/test_cmfd_nofeed/cmfd.xml | 1 + 6 files changed, 9 insertions(+), 4 deletions(-) diff --git a/src/cmfd_input.F90 b/src/cmfd_input.F90 index 5c7b7355a4..386b06fc27 100644 --- a/src/cmfd_input.F90 +++ b/src/cmfd_input.F90 @@ -199,8 +199,9 @@ contains cmfd_display = '' end if - ! Read in spectral radius estimate + ! Read in spectral radius estimate and G-S tolerance cmfd_spectral = spectral_ + cmfd_gs_tol = gs_tol_ ! Create tally objects call create_cmfd_tally() diff --git a/src/cmfd_solver.F90 b/src/cmfd_solver.F90 index 0769beef73..b1b95b9823 100644 --- a/src/cmfd_solver.F90 +++ b/src/cmfd_solver.F90 @@ -274,7 +274,7 @@ contains subroutine cmfd_linsolver_1g(b, x) use constants, only: ONE, ZERO - use global, only: cmfd, cmfd_spectral + use global, only: cmfd, cmfd_spectral, cmfd_gs_tol type(Vector) :: b ! right hand side vector type(Vector) :: x ! unknown vector @@ -302,7 +302,7 @@ contains type(Vector) :: tmpx ! temporary solution vector ! Set tolerance and overrelaxation parameter - tol = 1.e-10_8 + tol = cmfd_gs_tol w = ONE ! Dimensions diff --git a/src/global.F90 b/src/global.F90 index 62b196319e..83d99e1f51 100644 --- a/src/global.F90 +++ b/src/global.F90 @@ -355,8 +355,9 @@ module global ! CMFD display info character(len=25) :: cmfd_display - ! Estimate of spectral radius of CMFD matrices + ! Estimate of spectral radius of CMFD matrices and G-S tolerance real(8) :: cmfd_spectral = ZERO + real(8) :: cmfd_gs_tol = 1.e-10_8 ! Information about state points to be written integer :: n_state_points = 0 diff --git a/src/templates/cmfd_t.xml b/src/templates/cmfd_t.xml index 093edf112b..04326bfdc9 100644 --- a/src/templates/cmfd_t.xml +++ b/src/templates/cmfd_t.xml @@ -31,5 +31,6 @@ + diff --git a/tests/test_cmfd_feed/cmfd.xml b/tests/test_cmfd_feed/cmfd.xml index 51def74088..891d264167 100644 --- a/tests/test_cmfd_feed/cmfd.xml +++ b/tests/test_cmfd_feed/cmfd.xml @@ -12,5 +12,6 @@ dominance power true + 1.e-15 diff --git a/tests/test_cmfd_nofeed/cmfd.xml b/tests/test_cmfd_nofeed/cmfd.xml index c36a396043..710b3a7d16 100644 --- a/tests/test_cmfd_nofeed/cmfd.xml +++ b/tests/test_cmfd_nofeed/cmfd.xml @@ -12,5 +12,6 @@ dominance power false + 1.e-15 From 66b5ede5c451a91be058b08285e2d1aa0dc44192 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Wed, 25 Sep 2013 09:16:06 -0400 Subject: [PATCH 07/95] added Wielandt shifting --- src/cmfd_input.F90 | 1 + src/cmfd_solver.F90 | 143 ++++++++++++++++++++++++++++++++------------ src/global.F90 | 1 + 3 files changed, 107 insertions(+), 38 deletions(-) diff --git a/src/cmfd_input.F90 b/src/cmfd_input.F90 index 386b06fc27..444c479599 100644 --- a/src/cmfd_input.F90 +++ b/src/cmfd_input.F90 @@ -202,6 +202,7 @@ contains ! Read in spectral radius estimate and G-S tolerance cmfd_spectral = spectral_ cmfd_gs_tol = gs_tol_ + if (shift_ /= ZERO) cmfd_shift = shift_ ! Create tally objects call create_cmfd_tally() diff --git a/src/cmfd_solver.F90 b/src/cmfd_solver.F90 index b1b95b9823..2fc74df039 100644 --- a/src/cmfd_solver.F90 +++ b/src/cmfd_solver.F90 @@ -14,6 +14,9 @@ module cmfd_solver logical :: iconv ! did the problem converged real(8) :: k_n ! new k-eigenvalue real(8) :: k_o ! old k-eigenvalue + real(8) :: k_s ! shift of eigenvalue + real(8) :: k_ln ! new shifted eigenvalue + real(8) :: k_lo ! old shifted eigenvalue real(8) :: ktol = 1.e-8_8 ! tolerance on keff real(8) :: stol = 1.e-8_8 ! tolerance on source real(8) :: norm_n ! current norm of source vector @@ -32,10 +35,13 @@ module cmfd_solver ! CMFD linear solver interface procedure(linsolve), pointer :: cmfd_linsolver => null() abstract interface - subroutine linsolve(b, x) + subroutine linsolve(A, b, x, i) + import :: Matrix import :: Vector + type(Matrix) :: A type(Vector) :: b type(Vector) :: x + integer :: i end subroutine linsolve end interface @@ -101,12 +107,13 @@ contains use constants, only: ONE, ZERO use error, only: fatal_error - use global, only: cmfd, cmfd_write_matrices, message + use global, only: cmfd, cmfd_write_matrices, message, cmfd_shift, keff logical :: adjoint integer :: n ! problem size real(8) :: guess ! initial guess + real(8) :: dw ! eigenvalue shift ! Set up matrices call init_loss_matrix(loss) @@ -128,8 +135,12 @@ contains guess = ONE phi_n % val = guess phi_o % val = guess - k_n = guess - k_o = guess + k_n = keff + k_o = k_n + dw = cmfd_shift + k_s = k_o + dw + k_ln = ONE/(ONE/k_n - ONE/k_s) + k_lo = k_ln ! Fill in loss matrix call build_loss_matrix(loss, adjoint=adjoint) @@ -188,11 +199,20 @@ contains subroutine execute_power_iter() + use constants, only: ONE + integer :: i ! iteration counter + integer :: innerits ! # of inner iterations + integer :: totalits ! total number of inners + type(Matrix) :: Ms ! Reset convergence flag iconv = .false. + ! Perform shift + call wielandt_shift(Ms) + totalits = 0 + ! Begin power iteration do i = 1, 10000 @@ -200,22 +220,26 @@ contains call prod % vector_multiply(phi_o, s_o) ! Normalize source vector - s_o % val = s_o % val / k_o + s_o % val = s_o % val / k_lo ! Compute new flux vector - call cmfd_linsolver(s_o, phi_n) + call cmfd_linsolver(Ms, s_o, phi_n, innerits) ! Compute new source vector call prod % vector_multiply(phi_n, s_n) - ! Compute new k-eigenvalue - k_n = sum(s_n % val) / sum(s_o % val) + ! Compute new shifted eigenvalue + k_ln = sum(s_n % val) / sum(s_o % val) + + ! Compute new eigenvalue + k_n = ONE/(ONE/k_ln + ONE/k_s) ! Renormalize the old source - s_o % val = s_o % val * k_o + s_o % val = s_o % val * k_lo ! Check convergence - call convergence(i) + call convergence(i, innerits) + totalits = totalits + innerits ! Break loop if converged if (iconv) exit @@ -223,23 +247,58 @@ contains ! Record old values phi_o % val = phi_n % val k_o = k_n + k_lo = k_ln norm_o = norm_n - +read* end do +print *, 'TOTAL INNER:', totalits + ! Destroy shifted matrix + call Ms % destroy() end subroutine execute_power_iter +!=============================================================================== +! WIELANDT SHIFT +!=============================================================================== + + subroutine wielandt_shift(Ms) + + use constants, only: ONE + + type(Matrix) :: Ms + + integer :: irow ! row counter + integer :: icol ! col counter + integer :: jcol ! current col index in prod matrix + + ! copy loss matrix + call Ms % copy(loss) + + ! perform subtraction + jcol = 1 + ROWS: do irow = 1, Ms % n + COLS: do icol = Ms % get_row(irow), Ms % get_row(irow + 1) - 1 + if (Ms % get_col(icol) == prod % get_col(jcol)) then + Ms % val(icol) = Ms % val(icol) - ONE/k_s*prod % val(jcol) + jcol = jcol + 1 + end if + end do COLS + end do ROWS + + end subroutine wielandt_shift + !=============================================================================== ! CONVERGENCE checks the convergence of the CMFD problem !=============================================================================== - subroutine convergence(iter) + subroutine convergence(iter, innerits) use constants, only: ONE, TINY_BIT use global, only: cmfd_power_monitor, master use, intrinsic :: ISO_FORTRAN_ENV - integer :: iter ! iteration number + integer :: iter ! outer iteration number + integer :: innerits ! inner iteration nubmer ! Reset convergence flag iconv = .false. @@ -262,7 +321,8 @@ contains ! Print out to user if (cmfd_power_monitor .and. master) then write(OUTPUT_UNIT,FMT='(I0,":",T10,"k-eff: ",F0.8,T30,"k-error: ", & - &1PE12.5,T55, "src-error: ",1PE12.5)') iter, k_n, kerr, serr + &1PE12.5,T55, "src-error: ",1PE12.5,T80,I0)') iter, k_n, kerr, & + serr, innerits end if end subroutine convergence @@ -271,13 +331,15 @@ contains ! CMFD_LINSOLVER_1g solves the CMFD linear system !=============================================================================== - subroutine cmfd_linsolver_1g(b, x) + subroutine cmfd_linsolver_1g(A, b, x, its) use constants, only: ONE, ZERO use global, only: cmfd, cmfd_spectral, cmfd_gs_tol + type(Matrix) :: A ! coefficient matrix type(Vector) :: b ! right hand side vector type(Vector) :: x ! unknown vector + integer :: its ! number of inner iterations integer :: g ! group index integer :: i ! loop counter for x @@ -310,7 +372,7 @@ contains nx = cmfd % indices(1) ny = cmfd % indices(2) nz = cmfd % indices(3) - n = loss % n + n = A % n ! Perform Gauss Seidel iterations GS: do igs = 1, 10000 @@ -331,19 +393,19 @@ contains if (mod(i+j+k,2) == irb) cycle ! Get the index of the diagonals for both rows - call loss % search_indices(irow, irow, didx, found) + call A % search_indices(irow, irow, didx, found) ! Perform temporary sums, first do left of diag block, then right of diag block tmp1 = ZERO - do icol = loss % get_row(irow), didx - 1 - tmp1 = tmp1 + loss % val(icol)*x % val(loss % get_col(icol)) + do icol = A % get_row(irow), didx - 1 + tmp1 = tmp1 + A % val(icol)*x % val(A % get_col(icol)) end do - do icol = didx + 1, loss % get_row(irow + 1) - 1 - tmp1 = tmp1 + loss % val(icol)*x % val(loss % get_col(icol)) + do icol = didx + 1, A % get_row(irow + 1) - 1 + tmp1 = tmp1 + A % val(icol)*x % val(A % get_col(icol)) end do ! Solve for new x - x1 = (b % val(irow) - tmp1)/loss % val(didx) + x1 = (b % val(irow) - tmp1)/A % val(didx) ! Perform overrelaxation x % val(irow) = (ONE - w)*x % val(irow) + w*x1 @@ -354,6 +416,7 @@ contains ! Check convergence err = sqrt(sum(((tmpx % val - x % val)/tmpx % val)**2)/n) + its = igs !print *, igs, err, w if (err < tol) exit @@ -370,13 +433,15 @@ contains ! CMFD_LINSOLVER_2G solves the CMFD linear system !=============================================================================== - subroutine cmfd_linsolver_2g(b, x) + subroutine cmfd_linsolver_2g(A, b, x, its) use constants, only: ONE, ZERO use global, only: cmfd, cmfd_spectral + type(Matrix) :: A ! coefficient matrix type(Vector) :: b ! right hand side vector type(Vector) :: x ! unknown vector + integer :: its ! number of inner iterations integer :: g ! group index integer :: i ! loop counter for x @@ -421,7 +486,7 @@ contains nx = cmfd % indices(1) ny = cmfd % indices(2) nz = cmfd % indices(3) - n = loss % n + n = A % n ! Perform Gauss Seidel iterations GS: do igs = 1, 10000 @@ -442,14 +507,14 @@ contains if (mod(i+j+k,2) == irb) cycle ! Get the index of the diagonals for both rows - call loss % search_indices(irow, irow, d1idx, found) - call loss % search_indices(irow + 1, irow + 1, d2idx, found) + call A % search_indices(irow, irow, d1idx, found) + call A % search_indices(irow + 1, irow + 1, d2idx, found) ! Get block diagonal - m11 = loss % val(d1idx) ! group 1 diagonal - m12 = loss % val(d1idx + 1) ! group 1 right of diagonal (sorted by col) - m21 = loss % val(d2idx - 1) ! group 2 left of diagonal (sorted by col) - m22 = loss % val(d2idx) ! group 2 diagonal + m11 = A % val(d1idx) ! group 1 diagonal + m12 = A % val(d1idx + 1) ! group 1 right of diagonal (sorted by col) + m21 = A % val(d2idx - 1) ! group 2 left of diagonal (sorted by col) + m22 = A % val(d2idx) ! group 2 diagonal ! Analytically invert the diagonal dm = m11*m22 - m12*m21 @@ -461,17 +526,17 @@ contains ! Perform temporary sums, first do left of diag block, then right of diag block tmp1 = ZERO tmp2 = ZERO - do icol = loss % get_row(irow), d1idx - 1 - tmp1 = tmp1 + loss % val(icol)*x % val(loss % get_col(icol)) + do icol = A % get_row(irow), d1idx - 1 + tmp1 = tmp1 + A % val(icol)*x % val(A % get_col(icol)) end do - do icol = loss % get_row(irow + 1), d2idx - 2 - tmp2 = tmp2 + loss % val(icol)*x % val(loss % get_col(icol)) + do icol = A % get_row(irow + 1), d2idx - 2 + tmp2 = tmp2 + A % val(icol)*x % val(A % get_col(icol)) end do - do icol = d1idx + 2, loss % get_row(irow + 1) - 1 - tmp1 = tmp1 + loss % val(icol)*x % val(loss % get_col(icol)) + do icol = d1idx + 2, A % get_row(irow + 1) - 1 + tmp1 = tmp1 + A % val(icol)*x % val(A % get_col(icol)) end do - do icol = d2idx + 1, loss % get_row(irow + 2) - 1 - tmp2 = tmp2 + loss % val(icol)*x % val(loss % get_col(icol)) + do icol = d2idx + 1, A % get_row(irow + 2) - 1 + tmp2 = tmp2 + A % val(icol)*x % val(A % get_col(icol)) end do ! Adjust with RHS vector @@ -492,7 +557,9 @@ contains ! Check convergence err = sqrt(sum(((tmpx % val - x % val)/tmpx % val)**2)/n) + its = igs !print *, igs, err, w +!read * if (err < tol) exit ! Calculation new overrelaxation parameter diff --git a/src/global.F90 b/src/global.F90 index 83d99e1f51..5f7011b900 100644 --- a/src/global.F90 +++ b/src/global.F90 @@ -358,6 +358,7 @@ module global ! Estimate of spectral radius of CMFD matrices and G-S tolerance real(8) :: cmfd_spectral = ZERO real(8) :: cmfd_gs_tol = 1.e-10_8 + real(8) :: cmfd_shift = INFINITY ! Information about state points to be written integer :: n_state_points = 0 From 9123098acc4ef0fbc39d542cf2ca08a209e75091 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Wed, 25 Sep 2013 09:16:41 -0400 Subject: [PATCH 08/95] added matrix copy and option to read in shift --- src/matrix_header.F90 | 31 +++++++++++++++++++++++++++++++ src/templates/cmfd_t.xml | 1 + 2 files changed, 32 insertions(+) diff --git a/src/matrix_header.F90 b/src/matrix_header.F90 index 51308123f5..40f515c28d 100644 --- a/src/matrix_header.F90 +++ b/src/matrix_header.F90 @@ -33,6 +33,7 @@ module matrix_header procedure :: vector_multiply => matrix_vector_multiply procedure :: search_indices => matrix_search_indices procedure :: write => matrix_write + procedure :: copy => matrix_copy end type matrix integer :: petsc_err @@ -410,4 +411,34 @@ contains end subroutine matrix_write +!=============================================================================== +! MATRIX_COPY copies a matrix +!=============================================================================== + + subroutine matrix_copy(self, mattocopy) + + class(Matrix) :: self + type(Matrix) :: mattocopy + + ! Set n and nnz + self % n_count = mattocopy % n_count + self % nz_count = mattocopy % nz_count + self % n = mattocopy % n + self % nnz = mattocopy % nnz + + ! Allocate vectors + if (.not.allocated(self % row)) allocate(self % row(self % n + 1)) + if (.not.allocated(self % col)) allocate(self % col(self % nnz)) + if (.not.allocated(self % val)) allocate(self % val(self % nnz)) + + ! Set PETSc active to false + self % petsc_active = .false. + + ! Copy over data + self % row = mattocopy % row + self % col = mattocopy % col + self % val = mattocopy % val + + end subroutine matrix_copy + end module matrix_header diff --git a/src/templates/cmfd_t.xml b/src/templates/cmfd_t.xml index 04326bfdc9..7003973679 100644 --- a/src/templates/cmfd_t.xml +++ b/src/templates/cmfd_t.xml @@ -32,5 +32,6 @@ + From f8fe3adf3e2f04aa666d98f62c251c24d9a361c6 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Wed, 25 Sep 2013 10:14:14 -0400 Subject: [PATCH 09/95] added relative tolerancing and now can be set on input --- src/cmfd_input.F90 | 7 +++-- src/cmfd_solver.F90 | 57 +++++++++++++++++++++++----------------- src/global.F90 | 7 +++-- src/templates/cmfd_t.xml | 5 +++- 4 files changed, 47 insertions(+), 29 deletions(-) diff --git a/src/cmfd_input.F90 b/src/cmfd_input.F90 index 444c479599..2b6154b026 100644 --- a/src/cmfd_input.F90 +++ b/src/cmfd_input.F90 @@ -199,10 +199,13 @@ contains cmfd_display = '' end if - ! Read in spectral radius estimate and G-S tolerance + ! Read in spectral radius estimate and tolerances cmfd_spectral = spectral_ - cmfd_gs_tol = gs_tol_ if (shift_ /= ZERO) cmfd_shift = shift_ + cmfd_ktol = ktol_ + cmfd_stol = stol_ + cmfd_atoli = atoli_ + cmfd_rtoli = rtoli_ ! Create tally objects call create_cmfd_tally() diff --git a/src/cmfd_solver.F90 b/src/cmfd_solver.F90 index 2fc74df039..972f3bacee 100644 --- a/src/cmfd_solver.F90 +++ b/src/cmfd_solver.F90 @@ -17,12 +17,12 @@ module cmfd_solver real(8) :: k_s ! shift of eigenvalue real(8) :: k_ln ! new shifted eigenvalue real(8) :: k_lo ! old shifted eigenvalue - real(8) :: ktol = 1.e-8_8 ! tolerance on keff - real(8) :: stol = 1.e-8_8 ! tolerance on source real(8) :: norm_n ! current norm of source vector real(8) :: norm_o ! old norm of source vector real(8) :: kerr ! error in keff real(8) :: serr ! error in source + real(8) :: ktol ! tolerance on keff + real(8) :: stol ! tolerance on source logical :: adjoint_calc ! run an adjoint calculation type(Matrix) :: loss ! cmfd loss matrix type(Matrix) :: prod ! cmfd prod matrix @@ -35,12 +35,13 @@ module cmfd_solver ! CMFD linear solver interface procedure(linsolve), pointer :: cmfd_linsolver => null() abstract interface - subroutine linsolve(A, b, x, i) + subroutine linsolve(A, b, x, tol, i) import :: Matrix import :: Vector type(Matrix) :: A type(Vector) :: b type(Vector) :: x + real(8) :: tol integer :: i end subroutine linsolve end interface @@ -51,20 +52,14 @@ contains ! CMFD_SOLVER_EXECUTE sets up and runs power iteration solver for CMFD !=============================================================================== - subroutine cmfd_solver_execute(k_tol, s_tol, adjoint) + subroutine cmfd_solver_execute(adjoint) use global, only: cmfd_adjoint_type, time_cmfdbuild, time_cmfdsolve - real(8), optional :: k_tol ! tolerance on keff - real(8), optional :: s_tol ! tolerance on source logical, optional :: adjoint ! adjoint calc logical :: physical_adjoint = .false. - ! Set tolerances if present - if (present(k_tol)) ktol = k_tol - if (present(s_tol)) stol = s_tol - ! Check for adjoint execution adjoint_calc = .false. if (present(adjoint)) adjoint_calc = adjoint @@ -107,7 +102,8 @@ contains use constants, only: ONE, ZERO use error, only: fatal_error - use global, only: cmfd, cmfd_write_matrices, message, cmfd_shift, keff + use global, only: cmfd, cmfd_write_matrices, message, cmfd_shift, keff, & + cmfd_ktol, cmfd_stol logical :: adjoint @@ -167,8 +163,11 @@ contains case default message = 'Must use PETSc for more than 2 groups' call fatal_error() - end select - + end select + + ! Set tolerances + ktol = cmfd_ktol + stol = cmfd_stol end subroutine init_data @@ -200,15 +199,24 @@ contains subroutine execute_power_iter() use constants, only: ONE + use global, only: cmfd_atoli, cmfd_rtoli integer :: i ! iteration counter integer :: innerits ! # of inner iterations integer :: totalits ! total number of inners + real(8) :: atoli ! absolute minimum tolerance + real(8) :: rtoli ! relative tolerance based on source conv + real(8) :: toli ! the current tolerance of inners type(Matrix) :: Ms ! Reset convergence flag iconv = .false. + ! Set up tolerances + atoli = cmfd_atoli + rtoli = cmfd_rtoli + toli = rtoli*100._8 + ! Perform shift call wielandt_shift(Ms) totalits = 0 @@ -223,7 +231,7 @@ contains s_o % val = s_o % val / k_lo ! Compute new flux vector - call cmfd_linsolver(Ms, s_o, phi_n, innerits) + call cmfd_linsolver(Ms, s_o, phi_n, toli, innerits) ! Compute new source vector call prod % vector_multiply(phi_n, s_n) @@ -249,9 +257,12 @@ contains k_o = k_n k_lo = k_ln norm_o = norm_n -read* + + ! Get new tolerance for inners + toli = max(atoli, rtoli*serr) + end do -print *, 'TOTAL INNER:', totalits + ! Destroy shifted matrix call Ms % destroy() @@ -331,14 +342,15 @@ print *, 'TOTAL INNER:', totalits ! CMFD_LINSOLVER_1g solves the CMFD linear system !=============================================================================== - subroutine cmfd_linsolver_1g(A, b, x, its) + subroutine cmfd_linsolver_1g(A, b, x, tol, its) use constants, only: ONE, ZERO - use global, only: cmfd, cmfd_spectral, cmfd_gs_tol + use global, only: cmfd, cmfd_spectral type(Matrix) :: A ! coefficient matrix type(Vector) :: b ! right hand side vector type(Vector) :: x ! unknown vector + real(8) :: tol ! tolerance on final error integer :: its ! number of inner iterations integer :: g ! group index @@ -359,12 +371,10 @@ print *, 'TOTAL INNER:', totalits real(8) :: tmp1 ! temporary sum g1 real(8) :: x1 ! new g1 value of x real(8) :: err ! error in convergence of solution - real(8) :: tol ! tolerance on final error real(8) :: w ! overrelaxation parameter type(Vector) :: tmpx ! temporary solution vector - ! Set tolerance and overrelaxation parameter - tol = cmfd_gs_tol + ! Set overrelaxation parameter w = ONE ! Dimensions @@ -433,7 +443,7 @@ print *, 'TOTAL INNER:', totalits ! CMFD_LINSOLVER_2G solves the CMFD linear system !=============================================================================== - subroutine cmfd_linsolver_2g(A, b, x, its) + subroutine cmfd_linsolver_2g(A, b, x, tol, its) use constants, only: ONE, ZERO use global, only: cmfd, cmfd_spectral @@ -441,6 +451,7 @@ print *, 'TOTAL INNER:', totalits type(Matrix) :: A ! coefficient matrix type(Vector) :: b ! right hand side vector type(Vector) :: x ! unknown vector + real(8) :: tol ! tolerance on final error integer :: its ! number of inner iterations integer :: g ! group index @@ -473,12 +484,10 @@ print *, 'TOTAL INNER:', totalits real(8) :: x1 ! new g1 value of x real(8) :: x2 ! new g2 value of x real(8) :: err ! error in convergence of solution - real(8) :: tol ! tolerance on final error real(8) :: w ! overrelaxation parameter type(Vector) :: tmpx ! temporary solution vector ! Set tolerance and overrelaxation parameter - tol = 1.e-10_8 w = ONE ! Dimensions diff --git a/src/global.F90 b/src/global.F90 index 5f7011b900..5f0f4f2e6b 100644 --- a/src/global.F90 +++ b/src/global.F90 @@ -355,10 +355,13 @@ module global ! CMFD display info character(len=25) :: cmfd_display - ! Estimate of spectral radius of CMFD matrices and G-S tolerance + ! Estimate of spectral radius of CMFD matrices and tolerances real(8) :: cmfd_spectral = ZERO - real(8) :: cmfd_gs_tol = 1.e-10_8 real(8) :: cmfd_shift = INFINITY + real(8) :: cmfd_ktol = 1.e-8_8 + real(8) :: cmfd_stol = 1.e-8_8 + real(8) :: cmfd_atoli = 1.e-10_8 + real(8) :: cmfd_rtoli = 1.e-5_8 ! Information about state points to be written integer :: n_state_points = 0 diff --git a/src/templates/cmfd_t.xml b/src/templates/cmfd_t.xml index 7003973679..f372e25b7c 100644 --- a/src/templates/cmfd_t.xml +++ b/src/templates/cmfd_t.xml @@ -31,7 +31,10 @@ - + + + + From ccfc73e42232b2100112c952224142af6c0c208d Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Wed, 25 Sep 2013 10:29:34 -0400 Subject: [PATCH 10/95] removed copy of loss matrix for shift because we can overwrite loss matrix --- src/cmfd_solver.F90 | 23 +++++++---------------- 1 file changed, 7 insertions(+), 16 deletions(-) diff --git a/src/cmfd_solver.F90 b/src/cmfd_solver.F90 index 972f3bacee..edcbaf8db2 100644 --- a/src/cmfd_solver.F90 +++ b/src/cmfd_solver.F90 @@ -207,7 +207,6 @@ contains real(8) :: atoli ! absolute minimum tolerance real(8) :: rtoli ! relative tolerance based on source conv real(8) :: toli ! the current tolerance of inners - type(Matrix) :: Ms ! Reset convergence flag iconv = .false. @@ -218,7 +217,7 @@ contains toli = rtoli*100._8 ! Perform shift - call wielandt_shift(Ms) + call wielandt_shift() totalits = 0 ! Begin power iteration @@ -231,7 +230,7 @@ contains s_o % val = s_o % val / k_lo ! Compute new flux vector - call cmfd_linsolver(Ms, s_o, phi_n, toli, innerits) + call cmfd_linsolver(loss, s_o, phi_n, toli, innerits) ! Compute new source vector call prod % vector_multiply(phi_n, s_n) @@ -263,34 +262,26 @@ contains end do - ! Destroy shifted matrix - call Ms % destroy() - end subroutine execute_power_iter !=============================================================================== ! WIELANDT SHIFT !=============================================================================== - subroutine wielandt_shift(Ms) + subroutine wielandt_shift() use constants, only: ONE - type(Matrix) :: Ms - integer :: irow ! row counter integer :: icol ! col counter integer :: jcol ! current col index in prod matrix - ! copy loss matrix - call Ms % copy(loss) - ! perform subtraction jcol = 1 - ROWS: do irow = 1, Ms % n - COLS: do icol = Ms % get_row(irow), Ms % get_row(irow + 1) - 1 - if (Ms % get_col(icol) == prod % get_col(jcol)) then - Ms % val(icol) = Ms % val(icol) - ONE/k_s*prod % val(jcol) + ROWS: do irow = 1, loss % n + COLS: do icol = loss % get_row(irow), loss % get_row(irow + 1) - 1 + if (loss % get_col(icol) == prod % get_col(jcol)) then + loss % val(icol) = loss % val(icol) - ONE/k_s*prod % val(jcol) jcol = jcol + 1 end if end do COLS From 61f94289e6cd42e6349e87c7dc717cd4a610fead Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Wed, 25 Sep 2013 12:56:50 -0400 Subject: [PATCH 11/95] updated cmfd test cases for tighter tolerances --- tests/test_cmfd_feed/cmfd.xml | 3 ++- tests/test_cmfd_nofeed/cmfd.xml | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/tests/test_cmfd_feed/cmfd.xml b/tests/test_cmfd_feed/cmfd.xml index 891d264167..390e558639 100644 --- a/tests/test_cmfd_feed/cmfd.xml +++ b/tests/test_cmfd_feed/cmfd.xml @@ -12,6 +12,7 @@ dominance power true - 1.e-15 + 1.e-15 + 1.e-20 diff --git a/tests/test_cmfd_nofeed/cmfd.xml b/tests/test_cmfd_nofeed/cmfd.xml index 710b3a7d16..4a4bf30108 100644 --- a/tests/test_cmfd_nofeed/cmfd.xml +++ b/tests/test_cmfd_nofeed/cmfd.xml @@ -12,6 +12,7 @@ dominance power false - 1.e-15 + 1.e-15 + 1.e-20 From d09a98ca131abd74c05fb6aeca4dacfb85e192d3 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Fri, 27 Sep 2013 16:55:39 -0400 Subject: [PATCH 12/95] cmfd shift cant be infinity due to FPE, making it very large and fixed matrix subtraction in solver --- src/cmfd_solver.F90 | 3 ++- src/global.F90 | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/src/cmfd_solver.F90 b/src/cmfd_solver.F90 index edcbaf8db2..614362e40d 100644 --- a/src/cmfd_solver.F90 +++ b/src/cmfd_solver.F90 @@ -280,7 +280,8 @@ contains jcol = 1 ROWS: do irow = 1, loss % n COLS: do icol = loss % get_row(irow), loss % get_row(irow + 1) - 1 - if (loss % get_col(icol) == prod % get_col(jcol)) then + if (loss % get_col(icol) == prod % get_col(jcol) .and. & + jcol < prod % get_row(irow + 1)) then loss % val(icol) = loss % val(icol) - ONE/k_s*prod % val(jcol) jcol = jcol + 1 end if diff --git a/src/global.F90 b/src/global.F90 index 5f0f4f2e6b..46f7ba562b 100644 --- a/src/global.F90 +++ b/src/global.F90 @@ -357,7 +357,7 @@ module global ! Estimate of spectral radius of CMFD matrices and tolerances real(8) :: cmfd_spectral = ZERO - real(8) :: cmfd_shift = INFINITY + real(8) :: cmfd_shift = 1.e6 real(8) :: cmfd_ktol = 1.e-8_8 real(8) :: cmfd_stol = 1.e-8_8 real(8) :: cmfd_atoli = 1.e-10_8 From bb8a95b3f1cca5311e20c6094bda296be9a1e118 Mon Sep 17 00:00:00 2001 From: Nick Horelik Date: Wed, 20 Aug 2014 10:22:00 -0400 Subject: [PATCH 13/95] Added capability to plot meshlines --- src/input_xml.F90 | 65 ++++++++++++++++++++++++- src/plot.F90 | 114 +++++++++++++++++++++++++++++++++++++++++--- src/plot_header.F90 | 2 + 3 files changed, 174 insertions(+), 7 deletions(-) diff --git a/src/input_xml.F90 b/src/input_xml.F90 index 1869b9709d..3f61f8d764 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -2683,7 +2683,7 @@ contains subroutine read_plots_xml() integer i, j - integer n_cols, col_id, n_comp, n_masks + integer n_cols, col_id, n_comp, n_masks, n_meshlines integer, allocatable :: iarray(:) logical :: file_exists ! does plots.xml file exist? character(MAX_LINE_LEN) :: filename ! absolute path to plots.xml @@ -2693,9 +2693,11 @@ contains type(Node), pointer :: node_plot => null() type(Node), pointer :: node_col => null() type(Node), pointer :: node_mask => null() + type(Node), pointer :: node_meshlines => null() type(NodeList), pointer :: node_plot_list => null() type(NodeList), pointer :: node_col_list => null() type(NodeList), pointer :: node_mask_list => null() + type(NodeList), pointer :: node_meshline_list => null() ! Check if plots.xml exists filename = trim(path_input) // "plots.xml" @@ -2947,6 +2949,67 @@ contains end do end if + ! Deal with meshlines + call get_node_list(node_plot, "meshlines", node_meshline_list) + n_meshlines = get_list_size(node_meshline_list) + if (n_meshlines /= 0) then + + if (pl % type == PLOT_TYPE_VOXEL) then + message = "Meshlines ignored in voxel plot " // & + trim(to_str(pl % id)) + call warning() + end if + + select case(n_meshlines) + case default + message = "Mutliple meshlines" // & + " specified in plot " // trim(to_str(pl % id)) + call fatal_error() + case (0) + case (1) + + ! Get pointer to meshlines + call get_list_item(node_meshline_list, 1, node_meshlines) + + ! Ensure that there is a mesh id for this meshlines specification + if (check_for_node(node_meshlines, "mesh")) then + call get_node_value(node_meshlines, "mesh", pl % meshlines_id) + else + message = "Must specify a mesh id for meshlines " // & + "specification in plot " // trim(to_str(pl % id)) + call fatal_error() + end if + + ! Ensure that there is a linewidth for this meshlines specification + if (check_for_node(node_meshlines, "linewidth")) then + call get_node_value(node_meshlines, "linewidth", & + pl % meshlines_width) + else + message = "Must specify a linewidth for meshlines " // & + "specification in plot " // trim(to_str(pl % id)) + call fatal_error() + end if + + ! Check if the specified tally mesh exists + if (mesh_dict % has_key(pl % meshlines_id)) then + pl % meshlines_id = mesh_dict % get_key(pl % meshlines_id) + if (meshes(pl % meshlines_id) % type /= LATTICE_RECT) then + message = "Non-rectangular mesh specified in meshlines for" // & + " plot " // trim(to_str(pl % id)) + call fatal_error() + end if + else + message = "Could not find tally mesh " // & + trim(to_str(pl % meshlines_id)) // & + " specified in meshlines for plot " // & + trim(to_str(pl % id)) + call fatal_error() + end if + + end select + + end if + ! Deal with masks call get_node_list(node_plot, "mask", node_mask_list) n_masks = get_list_size(node_mask_list) diff --git a/src/plot.F90 b/src/plot.F90 index e7642314f9..842b1c089f 100644 --- a/src/plot.F90 +++ b/src/plot.F90 @@ -5,6 +5,7 @@ module plot use geometry, only: find_cell, check_cell_overlap use geometry_header, only: Cell, BASE_UNIVERSE use global + use mesh, only: get_mesh_indices use output, only: write_message use particle_header, only: deallocate_coord, Particle use plot_header @@ -118,27 +119,24 @@ contains call init_image(img) call allocate_image(img, pl % pixels(1), pl % pixels(2)) + in_pixel = pl % width(1)/dble(pl % pixels(1)) + out_pixel = pl % width(2)/dble(pl % pixels(2)) + if (pl % basis == PLOT_BASIS_XY) then in_i = 1 out_i = 2 - in_pixel = pl % width(1)/dble(pl % pixels(1)) - out_pixel = pl % width(2)/dble(pl % pixels(2)) xyz(1) = pl % origin(1) - pl % width(1) / 2.0 xyz(2) = pl % origin(2) + pl % width(2) / 2.0 xyz(3) = pl % origin(3) else if (pl % basis == PLOT_BASIS_XZ) then in_i = 1 out_i = 3 - in_pixel = pl % width(1)/dble(pl % pixels(1)) - out_pixel = pl % width(2)/dble(pl % pixels(2)) xyz(1) = pl % origin(1) - pl % width(1) / 2.0 xyz(2) = pl % origin(2) xyz(3) = pl % origin(3) + pl % width(2) / 2.0 else if (pl % basis == PLOT_BASIS_YZ) then in_i = 2 out_i = 3 - in_pixel = pl % width(1)/dble(pl % pixels(1)) - out_pixel = pl % width(2)/dble(pl % pixels(2)) xyz(1) = pl % origin(1) xyz(2) = pl % origin(2) - pl % width(1) / 2.0 xyz(3) = pl % origin(3) + pl % width(2) / 2.0 @@ -169,6 +167,9 @@ contains p % coord0 % xyz(out_i) = p % coord0 % xyz(out_i) - out_pixel end do + ! Draw tally mesh boundaries on the image if requested + if (pl % meshlines_id > 0) call draw_mesh_lines(pl, img) + ! Write out the ppm to a file call output_ppm(pl,img) @@ -180,6 +181,107 @@ contains end subroutine create_ppm +!=============================================================================== +! DRAW_MESH_LINES draws mesh line boundaries on an image +!=============================================================================== + subroutine draw_mesh_lines(pl, img) + + type(ObjectPlot), pointer :: pl + type(Image) :: img + + logical :: in_mesh + integer :: n + integer :: x, y ! pixel location + integer :: xrange(2), yrange(2) ! range of pixel locations + integer :: i, j ! loop indices + integer :: ijk(3) + integer :: plus + integer :: ijk_ll(3) ! mesh bin ijk indicies of plot lower left + integer :: ijk_ur(3) ! mesh bin ijk indicies of plot upper right + real(8) :: frac + real(8) :: width(3) ! real widths of the plot + real(8) :: xyz_ll_plot(3) ! lower left xyz of plot image + real(8) :: xyz_ur_plot(3) ! upper right xyz of plot image + real(8) :: xyz_ll(3) ! lower left xyz + real(8) :: xyz_ur(3) ! upper right xyz + type(StructuredMesh), pointer :: m => null() + + m => meshes(pl % meshlines_id) + n = m % n_dimension + + select case (pl % basis) + case(PLOT_BASIS_XY) + xyz_ll_plot(1) = pl % origin(1) - pl % width(1) / 2.0 + xyz_ll_plot(2) = pl % origin(2) - pl % width(2) / 2.0 + xyz_ll_plot(3) = pl % origin(3) + xyz_ur_plot(1) = pl % origin(1) + pl % width(1) / 2.0 + xyz_ur_plot(2) = pl % origin(2) + pl % width(2) / 2.0 + xyz_ur_plot(3) = pl % origin(3) + + width = xyz_ur_plot - xyz_ll_plot + + call get_mesh_indices(m, xyz_ll_plot, ijk_ll(:m % n_dimension), in_mesh) + call get_mesh_indices(m, xyz_ur_plot, ijk_ur(:m % n_dimension), in_mesh) + + ! sweep through all meshbins on this plane and draw borders + ijk(3) = 0 + do i = ijk_ll(1), ijk_ur(1) + do j = ijk_ll(2), ijk_ur(2) + ! check if we're in the mesh for this ijk + if (i > 0 .and. i <= m % dimension(1) .and. & + j > 0 .and. j <= m % dimension(2)) then + + ! get xyz's of lower left and upper right of this mesh cell + ijk(1) = i + ijk(2) = j + xyz_ll(:m % n_dimension) = & + m % lower_left + m % width * (ijk(:m % n_dimension) - 1) + xyz_ur(:m % n_dimension) = & + m % lower_left + m % width * ijk(:m % n_dimension) + + ! map the xyz to pixel locations + frac = (xyz_ll(1) - xyz_ll_plot(1)) / width(1) + xrange(1) = int(frac * real(img % width,8)) + frac = (xyz_ur(1) - xyz_ll_plot(1)) / width(1) + xrange(2) = int(frac * real(img % width,8)) + + frac = (xyz_ll(2) - xyz_ll_plot(2)) / width(2) + yrange(1) = img % height - int(frac * real(img % height,8)) + frac = (xyz_ur(2) - xyz_ll_plot(2)) / width(2) + yrange(2) = img % height - int(frac * real(img % height,8)) + + ! draw black lines + do x = xrange(1), xrange(2) + do plus = 0, pl % meshlines_width + call set_pixel(img, x, yrange(1) + plus, 0, 0, 0) + call set_pixel(img, x, yrange(2) + plus, 0, 0, 0) + call set_pixel(img, x, yrange(1) - plus, 0, 0, 0) + call set_pixel(img, x, yrange(2) - plus, 0, 0, 0) + end do + end do + do y = yrange(2), yrange(1) + do plus = 0, pl % meshlines_width + call set_pixel(img, xrange(1) + plus, y, 0, 0, 0) + call set_pixel(img, xrange(2) + plus, y, 0, 0, 0) + call set_pixel(img, xrange(1) - plus, y, 0, 0, 0) + call set_pixel(img, xrange(2) - plus, y, 0, 0, 0) + end do + end do + + end if + end do + end do + + case(PLOT_BASIS_XZ) + message = "Meshline plotting currently only implemented for basis xy" + call fatal_error() + case(PLOT_BASIS_YZ) + message = "Meshline plotting currently only implemented for basis xy" + call fatal_error() + end select + + end subroutine draw_mesh_lines + !=============================================================================== ! OUTPUT_PPM writes out a previously generated image to a PPM file !=============================================================================== diff --git a/src/plot_header.F90 b/src/plot_header.F90 index 6956bfaf93..5a301f8809 100644 --- a/src/plot_header.F90 +++ b/src/plot_header.F90 @@ -25,6 +25,8 @@ module plot_header real(8) :: width(3) ! xyz widths of plot integer :: basis ! direction of plot slice integer :: pixels(3) ! pixel width/height of plot slice + integer :: meshlines_id = -1 ! id of the mesh to plot lines of + integer :: meshlines_width ! pixel width of meshlines type(ObjectColor) :: not_found ! color for positions where no cell found type(ObjectColor), allocatable :: colors(:) ! colors of cells/mats end type ObjectPlot From f77bbb2336547b49fc9272c812ac06df8495fca2 Mon Sep 17 00:00:00 2001 From: Nick Horelik Date: Wed, 20 Aug 2014 10:28:02 -0400 Subject: [PATCH 14/95] Removed unused variable --- src/plot.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/plot.F90 b/src/plot.F90 index 842b1c089f..25c0c7123a 100644 --- a/src/plot.F90 +++ b/src/plot.F90 @@ -190,7 +190,6 @@ contains type(Image) :: img logical :: in_mesh - integer :: n integer :: x, y ! pixel location integer :: xrange(2), yrange(2) ! range of pixel locations integer :: i, j ! loop indices @@ -207,7 +206,6 @@ contains type(StructuredMesh), pointer :: m => null() m => meshes(pl % meshlines_id) - n = m % n_dimension select case (pl % basis) case(PLOT_BASIS_XY) From 583f73764a5664db3e628fe02de11eaadb315c76 Mon Sep 17 00:00:00 2001 From: Nick Horelik Date: Wed, 20 Aug 2014 10:31:16 -0400 Subject: [PATCH 15/95] Updated users guide for meshline plotting --- docs/source/usersguide/input.rst | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/docs/source/usersguide/input.rst b/docs/source/usersguide/input.rst index c9aa8cc866..290713c35a 100644 --- a/docs/source/usersguide/input.rst +++ b/docs/source/usersguide/input.rst @@ -1229,6 +1229,25 @@ attributes or sub-elements. These are not used in "voxel" plots: *Default*: None + :meshlines: + The special ``meshlines`` sub-element allows for plotting the boundaries of + a tally mesh on top of a plot. Only one ``meshlines`` element is allowed per + ``plot`` element, and it must contain as attributes or sub-elements a mesh + id and a linewidth: + + :mesh: + A single integer id number for the mesh specified on ``tallies.xml`` that + should be plotted. + + :linewidth: + A single integer number of pixels to specify the linewidth of the mesh + boundaries. + + *Default*: None + + .. warning:: Meshline plotting is currently only implemented for plots with + an "xy" basis. + ------------------------------ CMFD Specification -- cmfd.xml ------------------------------ From 2ae8fe4e8ae0f00f43e2079a3a66085a00fb5f08 Mon Sep 17 00:00:00 2001 From: Nick Horelik Date: Wed, 20 Aug 2014 10:45:42 -0400 Subject: [PATCH 16/95] Added commented-out example of meshline plotting --- examples/lattice/simple/plots.xml | 1 + 1 file changed, 1 insertion(+) diff --git a/examples/lattice/simple/plots.xml b/examples/lattice/simple/plots.xml index a8c6fbb7c5..a25a5a8280 100644 --- a/examples/lattice/simple/plots.xml +++ b/examples/lattice/simple/plots.xml @@ -5,6 +5,7 @@ 0. 0. 0. 4.0 4.0 400 400 + From cdcbd277ea8ebea9d441fbd0a24831f76f9143fc Mon Sep 17 00:00:00 2001 From: Nick Horelik Date: Wed, 20 Aug 2014 10:46:51 -0400 Subject: [PATCH 17/95] Added support for setting the color of a meshlines plot overlay --- src/input_xml.F90 | 18 ++++++++++++++++++ src/plot.F90 | 21 +++++++++++++-------- src/plot_header.F90 | 1 + 3 files changed, 32 insertions(+), 8 deletions(-) diff --git a/src/input_xml.F90 b/src/input_xml.F90 index 3f61f8d764..5d9d54a976 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -2990,6 +2990,24 @@ contains call fatal_error() end if + ! Check for color + if (check_for_node(node_meshlines, "color")) then + + ! Check and make sure 3 values are specified for RGB + if (get_arraysize_double(node_meshlines, "color") /= 3) then + message = "Bad RGB for meshlines color " & + // "in plot " // trim(to_str(pl % id)) + call fatal_error() + end if + + call get_node_array(node_meshlines, "color", & + pl % meshlines_color % rgb) + else + + pl % meshlines_color % rgb = (/ 0, 0, 0 /) + + end if + ! Check if the specified tally mesh exists if (mesh_dict % has_key(pl % meshlines_id)) then pl % meshlines_id = mesh_dict % get_key(pl % meshlines_id) diff --git a/src/plot.F90 b/src/plot.F90 index 25c0c7123a..888b50dff7 100644 --- a/src/plot.F90 +++ b/src/plot.F90 @@ -191,6 +191,7 @@ contains logical :: in_mesh integer :: x, y ! pixel location + integer :: r, g, b ! RGB color for meshlines pixels integer :: xrange(2), yrange(2) ! range of pixel locations integer :: i, j ! loop indices integer :: ijk(3) @@ -207,6 +208,10 @@ contains m => meshes(pl % meshlines_id) + r = pl % meshlines_color % rgb(1) + g = pl % meshlines_color % rgb(2) + b = pl % meshlines_color % rgb(3) + select case (pl % basis) case(PLOT_BASIS_XY) xyz_ll_plot(1) = pl % origin(1) - pl % width(1) / 2.0 @@ -251,18 +256,18 @@ contains ! draw black lines do x = xrange(1), xrange(2) do plus = 0, pl % meshlines_width - call set_pixel(img, x, yrange(1) + plus, 0, 0, 0) - call set_pixel(img, x, yrange(2) + plus, 0, 0, 0) - call set_pixel(img, x, yrange(1) - plus, 0, 0, 0) - call set_pixel(img, x, yrange(2) - plus, 0, 0, 0) + call set_pixel(img, x, yrange(1) + plus, r, g, b) + call set_pixel(img, x, yrange(2) + plus, r, g, b) + call set_pixel(img, x, yrange(1) - plus, r, g, b) + call set_pixel(img, x, yrange(2) - plus, r, g, b) end do end do do y = yrange(2), yrange(1) do plus = 0, pl % meshlines_width - call set_pixel(img, xrange(1) + plus, y, 0, 0, 0) - call set_pixel(img, xrange(2) + plus, y, 0, 0, 0) - call set_pixel(img, xrange(1) - plus, y, 0, 0, 0) - call set_pixel(img, xrange(2) - plus, y, 0, 0, 0) + call set_pixel(img, xrange(1) + plus, y, r, g, b) + call set_pixel(img, xrange(2) + plus, y, r, g, b) + call set_pixel(img, xrange(1) - plus, y, r, g, b) + call set_pixel(img, xrange(2) - plus, y, r, g, b) end do end do diff --git a/src/plot_header.F90 b/src/plot_header.F90 index 5a301f8809..e66bf9077e 100644 --- a/src/plot_header.F90 +++ b/src/plot_header.F90 @@ -27,6 +27,7 @@ module plot_header integer :: pixels(3) ! pixel width/height of plot slice integer :: meshlines_id = -1 ! id of the mesh to plot lines of integer :: meshlines_width ! pixel width of meshlines + type(ObjectColor) :: meshlines_color ! Color for meshlines type(ObjectColor) :: not_found ! color for positions where no cell found type(ObjectColor), allocatable :: colors(:) ! colors of cells/mats end type ObjectPlot From cdcfa22c51679acc1aa7bc3aa724b7471a9215ad Mon Sep 17 00:00:00 2001 From: Nick Horelik Date: Wed, 20 Aug 2014 10:51:44 -0400 Subject: [PATCH 18/95] Updated plot documentation for colored meshlines --- docs/source/usersguide/input.rst | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/docs/source/usersguide/input.rst b/docs/source/usersguide/input.rst index 290713c35a..fcb979614e 100644 --- a/docs/source/usersguide/input.rst +++ b/docs/source/usersguide/input.rst @@ -1189,7 +1189,7 @@ attributes or sub-elements. These are not used in "voxel" plots: Specifies the RGB color of the regions where no OpenMC cell can be found. Should be three integers separated by spaces. - *Default*: 0 0 0 (white) + *Default*: 0 0 0 (black) :col_spec: Any number of this optional tag may be included in each ```` element, @@ -1233,15 +1233,23 @@ attributes or sub-elements. These are not used in "voxel" plots: The special ``meshlines`` sub-element allows for plotting the boundaries of a tally mesh on top of a plot. Only one ``meshlines`` element is allowed per ``plot`` element, and it must contain as attributes or sub-elements a mesh - id and a linewidth: + id and a linewidth, as well as an optional color: :mesh: A single integer id number for the mesh specified on ``tallies.xml`` that should be plotted. :linewidth: - A single integer number of pixels to specify the linewidth of the mesh - boundaries. + A single integer number of pixels of linewidth to specify for the mesh + boundaries. Specifying this as 0 indicates that lines will be 1 pixel + thick, specifying 1 indicates 3 pixels thick, specifying 2 indicates + 5 pixels thick, etc. + + :color: + Specifies the custom color for the meshlines boundaries. Should be 3 + integers separated by spaces. This element is optional. + + *Default*: 0 0 0 (black) *Default*: None From 20ad38e52832a8b6b0f31703f216a4d7ee9eaec3 Mon Sep 17 00:00:00 2001 From: Nick Horelik Date: Sat, 30 Aug 2014 02:53:08 -0400 Subject: [PATCH 19/95] Added support for other slice orientations --- src/plot.F90 | 137 ++++++++++++++++++++++++++------------------------- 1 file changed, 69 insertions(+), 68 deletions(-) diff --git a/src/plot.F90 b/src/plot.F90 index 888b50dff7..97ead21cb1 100644 --- a/src/plot.F90 +++ b/src/plot.F90 @@ -190,14 +190,14 @@ contains type(Image) :: img logical :: in_mesh - integer :: x, y ! pixel location + integer :: out_, in_ ! pixel location integer :: r, g, b ! RGB color for meshlines pixels - integer :: xrange(2), yrange(2) ! range of pixel locations + integer :: outrange(2), inrange(2) ! range of pixel locations integer :: i, j ! loop indices - integer :: ijk(3) integer :: plus integer :: ijk_ll(3) ! mesh bin ijk indicies of plot lower left integer :: ijk_ur(3) ! mesh bin ijk indicies of plot upper right + integer :: outer, inner real(8) :: frac real(8) :: width(3) ! real widths of the plot real(8) :: xyz_ll_plot(3) ! lower left xyz of plot image @@ -214,74 +214,75 @@ contains select case (pl % basis) case(PLOT_BASIS_XY) - xyz_ll_plot(1) = pl % origin(1) - pl % width(1) / 2.0 - xyz_ll_plot(2) = pl % origin(2) - pl % width(2) / 2.0 - xyz_ll_plot(3) = pl % origin(3) - xyz_ur_plot(1) = pl % origin(1) + pl % width(1) / 2.0 - xyz_ur_plot(2) = pl % origin(2) + pl % width(2) / 2.0 - xyz_ur_plot(3) = pl % origin(3) - - width = xyz_ur_plot - xyz_ll_plot - - call get_mesh_indices(m, xyz_ll_plot, ijk_ll(:m % n_dimension), in_mesh) - call get_mesh_indices(m, xyz_ur_plot, ijk_ur(:m % n_dimension), in_mesh) - - ! sweep through all meshbins on this plane and draw borders - ijk(3) = 0 - do i = ijk_ll(1), ijk_ur(1) - do j = ijk_ll(2), ijk_ur(2) - ! check if we're in the mesh for this ijk - if (i > 0 .and. i <= m % dimension(1) .and. & - j > 0 .and. j <= m % dimension(2)) then - - ! get xyz's of lower left and upper right of this mesh cell - ijk(1) = i - ijk(2) = j - xyz_ll(:m % n_dimension) = & - m % lower_left + m % width * (ijk(:m % n_dimension) - 1) - xyz_ur(:m % n_dimension) = & - m % lower_left + m % width * ijk(:m % n_dimension) - - ! map the xyz to pixel locations - frac = (xyz_ll(1) - xyz_ll_plot(1)) / width(1) - xrange(1) = int(frac * real(img % width,8)) - frac = (xyz_ur(1) - xyz_ll_plot(1)) / width(1) - xrange(2) = int(frac * real(img % width,8)) - - frac = (xyz_ll(2) - xyz_ll_plot(2)) / width(2) - yrange(1) = img % height - int(frac * real(img % height,8)) - frac = (xyz_ur(2) - xyz_ll_plot(2)) / width(2) - yrange(2) = img % height - int(frac * real(img % height,8)) - - ! draw black lines - do x = xrange(1), xrange(2) - do plus = 0, pl % meshlines_width - call set_pixel(img, x, yrange(1) + plus, r, g, b) - call set_pixel(img, x, yrange(2) + plus, r, g, b) - call set_pixel(img, x, yrange(1) - plus, r, g, b) - call set_pixel(img, x, yrange(2) - plus, r, g, b) - end do - end do - do y = yrange(2), yrange(1) - do plus = 0, pl % meshlines_width - call set_pixel(img, xrange(1) + plus, y, r, g, b) - call set_pixel(img, xrange(2) + plus, y, r, g, b) - call set_pixel(img, xrange(1) - plus, y, r, g, b) - call set_pixel(img, xrange(2) - plus, y, r, g, b) - end do - end do - - end if - end do - end do - + outer = 1 + inner = 2 case(PLOT_BASIS_XZ) - message = "Meshline plotting currently only implemented for basis xy" - call fatal_error() + outer = 1 + inner = 3 case(PLOT_BASIS_YZ) - message = "Meshline plotting currently only implemented for basis xy" - call fatal_error() + outer = 2 + inner = 3 end select + + xyz_ll_plot = pl % origin + xyz_ur_plot = pl % origin + + xyz_ll_plot(outer) = pl % origin(1) - pl % width(1) / 2.0 + xyz_ll_plot(inner) = pl % origin(2) - pl % width(2) / 2.0 + xyz_ur_plot(outer) = pl % origin(1) + pl % width(1) / 2.0 + xyz_ur_plot(inner) = pl % origin(2) + pl % width(2) / 2.0 + + width = xyz_ur_plot - xyz_ll_plot + + call get_mesh_indices(m, xyz_ll_plot, ijk_ll(:m % n_dimension), in_mesh) + call get_mesh_indices(m, xyz_ur_plot, ijk_ur(:m % n_dimension), in_mesh) + + ! sweep through all meshbins on this plane and draw borders + do i = ijk_ll(outer), ijk_ur(outer) + do j = ijk_ll(inner), ijk_ur(inner) + ! check if we're in the mesh for this ijk + if (i > 0 .and. i <= m % dimension(outer) .and. & + j > 0 .and. j <= m % dimension(inner)) then + + ! get xyz's of lower left and upper right of this mesh cell + xyz_ll(outer) = m % lower_left(outer) + m % width(outer) * (i - 1) + xyz_ll(inner) = m % lower_left(inner) + m % width(inner) * (j - 1) + xyz_ur(outer) = m % lower_left(outer) + m % width(outer) * i + xyz_ur(inner) = m % lower_left(inner) + m % width(inner) * j + + ! map the xyz ranges to pixel ranges + + frac = (xyz_ll(outer) - xyz_ll_plot(outer)) / width(outer) + outrange(1) = int(frac * real(img % width, 8)) + frac = (xyz_ur(outer) - xyz_ll_plot(outer)) / width(outer) + outrange(2) = int(frac * real(img % width, 8)) + + frac = (xyz_ll(inner) - xyz_ll_plot(inner)) / width(inner) + inrange(1) = int(frac * real(img % height, 8)) + frac = (xyz_ur(inner) - xyz_ll_plot(inner)) / width(inner) + inrange(2) = int(frac * real(img % height, 8)) + + ! draw lines + do out_ = outrange(1), outrange(2) + do plus = 0, pl % meshlines_width + call set_pixel(img, out_, inrange(1) + plus, r, g, b) + call set_pixel(img, out_, inrange(2) + plus, r, g, b) + call set_pixel(img, out_, inrange(1) - plus, r, g, b) + call set_pixel(img, out_, inrange(2) - plus, r, g, b) + end do + end do + do in_ = inrange(1), inrange(2) + do plus = 0, pl % meshlines_width + call set_pixel(img, outrange(1) + plus, in_, r, g, b) + call set_pixel(img, outrange(2) + plus, in_, r, g, b) + call set_pixel(img, outrange(1) - plus, in_, r, g, b) + call set_pixel(img, outrange(2) - plus, in_, r, g, b) + end do + end do + + end if + end do + end do end subroutine draw_mesh_lines From f108e75be42ead7ba2f210826278df2090eef684 Mon Sep 17 00:00:00 2001 From: Nick Horelik Date: Sat, 30 Aug 2014 03:01:47 -0400 Subject: [PATCH 20/95] Switched to pointer for plot mesh --- src/input_xml.F90 | 17 +++++++++-------- src/plot.F90 | 4 ++-- src/plot_header.F90 | 3 ++- 3 files changed, 13 insertions(+), 11 deletions(-) diff --git a/src/input_xml.F90 b/src/input_xml.F90 index 5d9d54a976..8e43ab3973 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -2682,8 +2682,9 @@ contains subroutine read_plots_xml() - integer i, j - integer n_cols, col_id, n_comp, n_masks, n_meshlines + integer :: i, j + integer :: n_cols, col_id, n_comp, n_masks, n_meshlines + integer :: meshid integer, allocatable :: iarray(:) logical :: file_exists ! does plots.xml file exist? character(MAX_LINE_LEN) :: filename ! absolute path to plots.xml @@ -2973,7 +2974,7 @@ contains ! Ensure that there is a mesh id for this meshlines specification if (check_for_node(node_meshlines, "mesh")) then - call get_node_value(node_meshlines, "mesh", pl % meshlines_id) + call get_node_value(node_meshlines, "mesh", meshid) else message = "Must specify a mesh id for meshlines " // & "specification in plot " // trim(to_str(pl % id)) @@ -3009,16 +3010,16 @@ contains end if ! Check if the specified tally mesh exists - if (mesh_dict % has_key(pl % meshlines_id)) then - pl % meshlines_id = mesh_dict % get_key(pl % meshlines_id) - if (meshes(pl % meshlines_id) % type /= LATTICE_RECT) then + if (mesh_dict % has_key(meshid)) then + pl % meshlines_mesh => meshes(mesh_dict % get_key(meshid)) + if (meshes(meshid) % type /= LATTICE_RECT) then message = "Non-rectangular mesh specified in meshlines for" // & " plot " // trim(to_str(pl % id)) call fatal_error() end if else - message = "Could not find tally mesh " // & - trim(to_str(pl % meshlines_id)) // & + message = "Could not find mesh " // & + trim(to_str(meshid)) // & " specified in meshlines for plot " // & trim(to_str(pl % id)) call fatal_error() diff --git a/src/plot.F90 b/src/plot.F90 index 97ead21cb1..f6a41c9513 100644 --- a/src/plot.F90 +++ b/src/plot.F90 @@ -168,7 +168,7 @@ contains end do ! Draw tally mesh boundaries on the image if requested - if (pl % meshlines_id > 0) call draw_mesh_lines(pl, img) + if (associated(pl % meshlines_mesh)) call draw_mesh_lines(pl, img) ! Write out the ppm to a file call output_ppm(pl,img) @@ -206,7 +206,7 @@ contains real(8) :: xyz_ur(3) ! upper right xyz type(StructuredMesh), pointer :: m => null() - m => meshes(pl % meshlines_id) + m => pl % meshlines_mesh r = pl % meshlines_color % rgb(1) g = pl % meshlines_color % rgb(2) diff --git a/src/plot_header.F90 b/src/plot_header.F90 index e66bf9077e..68eb89a11a 100644 --- a/src/plot_header.F90 +++ b/src/plot_header.F90 @@ -1,6 +1,7 @@ module plot_header use constants + use mesh_header, only: StructuredMesh implicit none @@ -25,8 +26,8 @@ module plot_header real(8) :: width(3) ! xyz widths of plot integer :: basis ! direction of plot slice integer :: pixels(3) ! pixel width/height of plot slice - integer :: meshlines_id = -1 ! id of the mesh to plot lines of integer :: meshlines_width ! pixel width of meshlines + type(StructuredMesh), pointer :: meshlines_mesh => null() ! mesh to plot type(ObjectColor) :: meshlines_color ! Color for meshlines type(ObjectColor) :: not_found ! color for positions where no cell found type(ObjectColor), allocatable :: colors(:) ! colors of cells/mats From 02dc33dd7d6bae0b87fceaa6f3e46e39a5e5ef13 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Tue, 9 Sep 2014 09:52:37 -0400 Subject: [PATCH 21/95] updated preprocessing directives --- src/cmfd_solver.F90 | 46 ++++++++++++------------------------------- src/matrix_header.F90 | 8 +++++--- src/vector_header.F90 | 4 +++- 3 files changed, 21 insertions(+), 37 deletions(-) diff --git a/src/cmfd_solver.F90 b/src/cmfd_solver.F90 index 614362e40d..cc27b98574 100644 --- a/src/cmfd_solver.F90 +++ b/src/cmfd_solver.F90 @@ -102,8 +102,11 @@ contains use constants, only: ONE, ZERO use error, only: fatal_error - use global, only: cmfd, cmfd_write_matrices, message, cmfd_shift, keff, & + use global, only: cmfd, message, cmfd_shift, keff, & cmfd_ktol, cmfd_stol +#ifdef PETSC + use global, only: cmfd_write_matrices +#endif logical :: adjoint @@ -177,6 +180,9 @@ contains subroutine compute_adjoint() + use error, only: fatal_error + use global, only: message +#ifdef PETSC use global, only: cmfd_write_matrices ! Transpose matrices @@ -188,6 +194,10 @@ contains call loss % write_petsc_binary('adj_lossmat.bin') call prod % write_petsc_binary('adj_prodmat.bin') end if +#else + message = 'Adjoint calculations only allowed with PETSc' + call fatal_error() +#endif end subroutine compute_adjoint @@ -624,43 +634,13 @@ contains else filename = 'fluxvec.bin' end if +#ifdef PETSC call phi_n % write_petsc_binary(filename) +#endif end if end subroutine extract_results -!=============================================================================== -! INDICES_TO_MATRIX takes (x,y,z,g) indices and computes location in matrix -!=============================================================================== - - subroutine indices_to_matrix(g, i, j, k, matidx, ng, nx, ny) - - use global, only: cmfd, cmfd_coremap - - integer :: matidx ! the index location in matrix - integer :: i ! current x index - integer :: j ! current y index - integer :: k ! current z index - integer :: g ! current group index - integer :: nx ! maximum number of x cells - integer :: ny ! maximum number of y cells - integer :: ng ! maximum number of groups - - ! Check if coremap is used - if (cmfd_coremap) then - - ! Get idx from core map - matidx = ng*(cmfd % coremap(i,j,k)) - (ng - g) - - else - - ! Compute index - matidx = g + ng*(i - 1) + ng*nx*(j - 1) + ng*nx*ny*(k - 1) - - end if - - end subroutine indices_to_matrix - !=============================================================================== ! MATRIX_TO_INDICES converts a matrix index to spatial and group indicies !=============================================================================== diff --git a/src/matrix_header.F90 b/src/matrix_header.F90 index eed6a91fb9..3f5aa204f7 100644 --- a/src/matrix_header.F90 +++ b/src/matrix_header.F90 @@ -27,13 +27,15 @@ module matrix_header procedure :: assemble => matrix_assemble procedure :: get_row => matrix_get_row procedure :: get_col => matrix_get_col - procedure :: setup_petsc => matrix_setup_petsc - procedure :: write_petsc_binary => matrix_write_petsc_binary - procedure :: transpose => matrix_transpose procedure :: vector_multiply => matrix_vector_multiply procedure :: search_indices => matrix_search_indices procedure :: write => matrix_write procedure :: copy => matrix_copy +# ifdef PETSC + procedure :: setup_petsc => matrix_setup_petsc + procedure :: write_petsc_binary => matrix_write_petsc_binary + procedure :: transpose => matrix_transpose +# endif end type matrix #ifdef PETSC diff --git a/src/vector_header.F90 b/src/vector_header.F90 index aab9b2bde0..4d8cb2cf5c 100644 --- a/src/vector_header.F90 +++ b/src/vector_header.F90 @@ -21,9 +21,11 @@ module vector_header procedure :: create => vector_create procedure :: destroy => vector_destroy procedure :: add_value => vector_add_value + procedure :: copy => vector_copy +# ifdef PETSC procedure :: setup_petsc => vector_setup_petsc procedure :: write_petsc_binary => vector_write_petsc_binary - procedure :: copy => vector_copy +# endif end type Vector integer :: petsc_err ! petsc error code From cf8c51d5af0f845cad2a0b38d94cd9c4ff2e95ad Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Tue, 9 Sep 2014 10:02:44 -0400 Subject: [PATCH 22/95] removed some comments and fixed compilation error --- src/cmfd_solver.F90 | 3 --- src/input_xml.F90 | 6 ------ 2 files changed, 9 deletions(-) diff --git a/src/cmfd_solver.F90 b/src/cmfd_solver.F90 index cc27b98574..49efe988dd 100644 --- a/src/cmfd_solver.F90 +++ b/src/cmfd_solver.F90 @@ -687,9 +687,6 @@ contains subroutine finalize() ! Destroy all objects -#ifdef PETSC - call gmres % destroy() -#endif call loss % destroy() call prod % destroy() call phi_n % destroy() diff --git a/src/input_xml.F90 b/src/input_xml.F90 index e615f9c16e..039e0419c3 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -777,12 +777,6 @@ contains call lower_case(temp_str) if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') then cmfd_run = .true. -!#ifndef PETSC -! if (master) then -! message = 'CMFD is not available, compile OpenMC with PETSc' -! call fatal_error() -! end if -!#endif end if end if From 7398a1e8004b105b47f6d13f463e284f62d73b93 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Tue, 9 Sep 2014 10:07:59 -0400 Subject: [PATCH 23/95] fixed misspelling for cmfd_matrices --- src/cmfd_input.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cmfd_input.F90 b/src/cmfd_input.F90 index 09f02e61b3..61d6f6eaba 100644 --- a/src/cmfd_input.F90 +++ b/src/cmfd_input.F90 @@ -190,7 +190,7 @@ contains ! Output logicals if (check_for_node(doc, "write_matrices")) then - call get_node_value(doc, "write_matices", temp_str) + call get_node_value(doc, "write_matrices", temp_str) call lower_case(temp_str) if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') & cmfd_write_matrices = .true. From 58723fa0ecf1a90665032392c88b0ed556006e0f Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Tue, 9 Sep 2014 10:11:36 -0400 Subject: [PATCH 24/95] write matrices when option is set --- src/cmfd_solver.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/cmfd_solver.F90 b/src/cmfd_solver.F90 index 49efe988dd..11989ff4f6 100644 --- a/src/cmfd_solver.F90 +++ b/src/cmfd_solver.F90 @@ -104,9 +104,7 @@ contains use error, only: fatal_error use global, only: cmfd, message, cmfd_shift, keff, & cmfd_ktol, cmfd_stol -#ifdef PETSC use global, only: cmfd_write_matrices -#endif logical :: adjoint @@ -150,8 +148,10 @@ contains ! Setup petsc for everything call loss % assemble() call prod % assemble() - call loss % write('loss.dat') - call prod % write('prod.dat') + if (cmfd_write_matrices) then + call loss % write('loss.dat') + call prod % write('prod.dat') + end if ! Set norms to 0 norm_n = ZERO From a6fa726e18daef8fe0daf70ee7ff73e7645da4ce Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Fri, 28 Feb 2014 23:26:02 -0500 Subject: [PATCH 25/95] added option to write out initial source guess --- src/global.F90 | 3 +++ src/input_xml.F90 | 8 ++++++++ src/source.F90 | 11 +++++++++++ 3 files changed, 22 insertions(+) diff --git a/src/global.F90 b/src/global.F90 index b07132270d..7ec2f0f19c 100644 --- a/src/global.F90 +++ b/src/global.F90 @@ -299,6 +299,9 @@ module global ! Particle restart run logical :: particle_restart_run = .false. + ! Write out initial source + logical :: write_initial_source = .false. + ! ============================================================================ ! CMFD VARIABLES diff --git a/src/input_xml.F90 b/src/input_xml.F90 index 039e0419c3..842c104b36 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -262,6 +262,14 @@ contains call fatal_error() end if + ! Check if we want to write out source + if (check_for_node(node_source, "write_initial")) then + call get_node_value(node_source, "write_initial", temp_str) + call lower_case(temp_str) + if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') & + write_initial_source = .true. + end if + ! Check for external source file if (check_for_node(node_source, "file")) then ! Copy path of source file diff --git a/src/source.F90 b/src/source.F90 index 9dcfd01445..090ea93d1e 100644 --- a/src/source.F90 +++ b/src/source.F90 @@ -27,6 +27,7 @@ contains subroutine initialize_source() + character(MAX_FILE_LEN) :: filename integer(8) :: i ! loop index over bank sites integer(8) :: id ! particle id integer(4) :: itmp ! temporary integer @@ -76,6 +77,16 @@ contains end do end if + ! Write out initial source + if (write_initial_source) then + message = 'Writing out initial source guess...' + call write_message(1) + filename = 'initial_source.h5' + call sp % file_create(filename, serial = .false.) + call sp % write_source_bank() + call sp % file_close() + end if + end subroutine initialize_source !=============================================================================== From 0a31e55e95539ad3b6fee25e16c6586ca55891f4 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Sun, 2 Mar 2014 18:28:14 -0500 Subject: [PATCH 26/95] flushing now performed with sets --- src/cmfd_execute.F90 | 20 ++++---------------- src/cmfd_input.F90 | 24 +++++++++++++++--------- src/global.F90 | 8 +++----- 3 files changed, 22 insertions(+), 30 deletions(-) diff --git a/src/cmfd_execute.F90 b/src/cmfd_execute.F90 index 35485a8945..e4e849436f 100644 --- a/src/cmfd_execute.F90 +++ b/src/cmfd_execute.F90 @@ -82,8 +82,8 @@ contains subroutine cmfd_init_batch() - use global, only: cmfd_begin, cmfd_on, cmfd_tally_on, & - cmfd_inact_flush, cmfd_act_flush, cmfd_run, & + use global, only: cmfd_begin, cmfd_on, cmfd_tally_on, & + cmfd_reset, cmfd_run, & current_batch, cmfd_hold_weights ! Check to activate CMFD diffusion and possible feedback @@ -97,21 +97,9 @@ contains ! If this is a restart run and we are just replaying batches leave if (restart_run .and. current_batch <= restart_batch) return - ! Check to flush cmfd tallies for active batches, no more inactive flush - if (cmfd_run .and. cmfd_act_flush == current_batch) then + ! Check to reset tallies + if (cmfd_run .and. cmfd_reset % contains(current_batch)) then call cmfd_tally_reset() - cmfd_tally_on = .true. - cmfd_inact_flush(2) = -1 - end if - - ! Check to flush cmfd tallies during inactive batches (>= on number of - ! flushes important as the code will flush on the first batch which we - ! dont want to count) - if (cmfd_run .and. mod(current_batch,cmfd_inact_flush(1)) & - == 0 .and. cmfd_inact_flush(2) > 0 .and. cmfd_begin < current_batch) then - cmfd_hold_weights = .true. - call cmfd_tally_reset() - cmfd_inact_flush(2) = cmfd_inact_flush(2) - 1 end if end subroutine cmfd_init_batch diff --git a/src/cmfd_input.F90 b/src/cmfd_input.F90 index 61d6f6eaba..93454ce4c2 100644 --- a/src/cmfd_input.F90 +++ b/src/cmfd_input.F90 @@ -68,6 +68,7 @@ contains integer :: ng integer, allocatable :: iarray(:) + integer, allocatable :: int_array(:) logical :: file_exists ! does cmfd.xml exist? logical :: found character(MAX_LINE_LEN) :: filename @@ -216,15 +217,20 @@ contains cmfd_tally_on = .false. end if - ! Inactive batch flush window - if (check_for_node(doc, "inactive_flush")) & - call get_node_value(doc, "inactive_flush", cmfd_inact_flush(1)) - if (check_for_node(doc, "num_flushes")) & - call get_node_value(doc, "num_flushes", cmfd_inact_flush(2)) - - ! Last flush before active batches - if (check_for_node(doc, "active_flush")) & - call get_node_value(doc, "active_flush", cmfd_act_flush) + ! Check for cmfd tally resets + if (check_for_node(doc, "tally_reset")) then + n_cmfd_resets = get_arraysize_integer(doc, "tally_reset") + else + n_cmfd_resets = 0 + end if + if (n_cmfd_resets > 0) then + allocate(int_array(n_cmfd_resets)) + call get_node_array(doc, "tally_reset", int_array) + do i = 1, n_cmfd_resets + call cmfd_reset % add(int_array(i)) + end do + deallocate(int_array) + end if ! Get display if (check_for_node(doc, "display")) & diff --git a/src/global.F90 b/src/global.F90 index 7ec2f0f19c..02a87051f4 100644 --- a/src/global.F90 +++ b/src/global.F90 @@ -347,11 +347,9 @@ module global ! Batch to begin cmfd integer :: cmfd_begin = 1 - ! When and how long to flush cmfd tallies during inactive batches - integer :: cmfd_inact_flush(2) = (/9999,1/) - - ! Batch to last flush before active batches - integer :: cmfd_act_flush = 0 + ! Tally reset list + integer :: n_cmfd_resets + type(SetInt) :: cmfd_reset ! Compute effective downscatter cross section logical :: cmfd_downscatter = .false. From 16a20d10e816b4b75f03e2d1df40d9a4f1955ece Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Sun, 2 Mar 2014 18:52:23 -0500 Subject: [PATCH 27/95] added flag for cmfd debug printing --- src/CMakeLists.txt | 10 +++++ src/cmfd_data.F90 | 90 +++++++++++++++++++++++++++++++++++++++++++- src/cmfd_execute.F90 | 25 +++++++++++- 3 files changed, 123 insertions(+), 2 deletions(-) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index fc6c6630cc..033ce2a020 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -26,6 +26,7 @@ option(debug "Compile with debug flags" OFF) option(optimize "Turn on all compiler optimization flags" OFF) option(verbose "Create verbose Makefiles" OFF) option(coverage "Compile with flags" OFF) +option(cmfd_debug "Compile with cmfd debug flags" OFF) if (verbose) set(CMAKE_VERBOSE_MAKEFILE on) @@ -214,6 +215,15 @@ if(GIT_SHA1_SUCCESS EQUAL 0) add_definitions(-DGIT_SHA1="${GIT_SHA1}") endif() +#=============================================================================== +# CMFD debug flags +#=============================================================================== + +if (cmfd_debug) + message("-- CMFD Debug flags on") + add_definitions(-DCMFD_DEBUG) +endif() + #=============================================================================== # FoX Fortran XML Library #=============================================================================== diff --git a/src/cmfd_data.F90 b/src/cmfd_data.F90 index b5612dcd05..7962760cbf 100644 --- a/src/cmfd_data.F90 +++ b/src/cmfd_data.F90 @@ -56,7 +56,7 @@ contains ONE, TINY_BIT use error, only: fatal_error use global, only: cmfd, message, n_cmfd_tallies, cmfd_tallies, meshes,& - matching_bins + matching_bins, current_batch use mesh, only: mesh_indices_to_bin use mesh_header, only: StructuredMesh use string, only: to_str @@ -71,6 +71,7 @@ contains integer :: k ! iteration counter for z integer :: g ! iteration counter for g integer :: h ! iteration counter for outgoing groups + integer :: l ! iteration counter for leakage debug integer :: ital ! tally object index integer :: ijk(3) ! indices for mesh cell integer :: score_index ! index to pull from tally object @@ -80,6 +81,8 @@ contains integer :: i_filter_eout ! index for outgoing energy filter integer :: i_filter_surf ! index for surface filter real(8) :: flux ! temp variable for flux + real(8) :: leak1 ! group 1 leakage + real(8) :: leak2 ! group 2 leakage type(TallyObject), pointer :: t => null() ! pointer for tally object type(StructuredMesh), pointer :: m => null() ! pointer for mesh object @@ -301,6 +304,91 @@ contains if (associated(t)) nullify(t) if (associated(m)) nullify(m) +#ifdef CMFD_DEBUG + open(file='cmfd_src_' // trim(to_str(current_batch)) // '.dat', unit=100) + open(file='source_bank_' // trim(to_str(current_batch)) // '.dat', unit=101) + open(file='openmc_src_' // trim(to_str(current_batch)) // '.dat', unit=102) + open(file='totalxs1_' // trim(to_str(current_batch)) // '.dat', unit=103) + open(file='totalxs2_' // trim(to_str(current_batch)) // '.dat', unit=104) + open(file='p1scattxs1_' // trim(to_str(current_batch)) // '.dat', unit=105) + open(file='p1scattxs2_' // trim(to_str(current_batch)) // '.dat', unit=106) + open(file='scattxs11_' // trim(to_str(current_batch)) // '.dat', unit=107) + open(file='scattxs12_' // trim(to_str(current_batch)) // '.dat', unit=108) + open(file='scattxs21_' // trim(to_str(current_batch)) // '.dat', unit=109) + open(file='scattxs22_' // trim(to_str(current_batch)) // '.dat', unit=110) + open(file='nufissxs11_' // trim(to_str(current_batch)) // '.dat', unit=111) + open(file='nufissxs12_' // trim(to_str(current_batch)) // '.dat', unit=112) + open(file='nufissxs21_' // trim(to_str(current_batch)) // '.dat', unit=113) + open(file='nufissxs22_' // trim(to_str(current_batch)) // '.dat', unit=114) + open(file='diff_coef1_' // trim(to_str(current_batch)) // '.dat', unit=115) + open(file='diff_coef2_' // trim(to_str(current_batch)) // '.dat', unit=116) + open(file='flux1_' // trim(to_str(current_batch)) // '.dat', unit=117) + open(file='flux2_' // trim(to_str(current_batch)) // '.dat', unit=118) + open(file='leak1_' // trim(to_str(current_batch)) // '.dat', unit=119) + open(file='leak2_' // trim(to_str(current_batch)) // '.dat', unit=120) + + do i = 1, nx + do j = 1,ny + leak1 = ZERO + leak2 = ZERO + do l = 1, 3 + leak1 = leak1 + ((cmfd % current(4*l,1,i,j,1) - & + cmfd % current(4*l-1,1,i,j,1))) - & + ((cmfd % current(4*l-2,1,i,j,1) - & + cmfd % current(4*l-3,1,i,j,1))) + end do + do l = 1, 3 + leak2 = leak2 + ((cmfd % current(4*l,2,i,j,1) - & + cmfd % current(4*l-1,2,i,j,1))) - & + ((cmfd % current(4*l-2,2,i,j,1) - & + cmfd % current(4*l-3,2,i,j,1))) + end do + write(100,*) cmfd % cmfd_src(1,i,j,1) + write(101,*) cmfd % sourcecounts(1,i,j,1) + write(102,*) cmfd % openmc_src(1,i,j,1) + write(103,*) cmfd % totalxs(1,i,j,1) + write(104,*) cmfd % totalxs(2,i,j,1) + write(105,*) cmfd % p1scattxs(1,i,j,1) + write(106,*) cmfd % p1scattxs(2,i,j,1) + write(107,*) cmfd % scattxs(1,1,i,j,1) + write(108,*) cmfd % scattxs(1,2,i,j,1) + write(109,*) cmfd % scattxs(2,1,i,j,1) + write(110,*) cmfd % scattxs(2,2,i,j,1) + write(111,*) cmfd % nfissxs(1,1,i,j,1) + write(112,*) cmfd % nfissxs(1,2,i,j,1) + write(113,*) cmfd % nfissxs(2,1,i,j,1) + write(114,*) cmfd % nfissxs(2,2,i,j,1) + write(115,*) cmfd % diffcof(1,i,j,1) + write(116,*) cmfd % diffcof(2,i,j,1) + write(117,*) cmfd % flux(1,i,j,1) + write(118,*) cmfd % flux(2,i,j,1) + write(119,*) leak1 + write(120,*) leak2 + end do + end do + close(100) + close(101) + close(102) + close(103) + close(104) + close(105) + close(106) + close(107) + close(108) + close(109) + close(110) + close(111) + close(112) + close(113) + close(114) + close(115) + close(116) + close(117) + close(118) + close(119) + close(120) +#endif + end subroutine compute_xs !=============================================================================== diff --git a/src/cmfd_execute.F90 b/src/cmfd_execute.F90 index e4e849436f..a1b8853042 100644 --- a/src/cmfd_execute.F90 +++ b/src/cmfd_execute.F90 @@ -69,7 +69,7 @@ contains call calc_fission_source() ! calculate weight factors - if (cmfd_feedback) call cmfd_reweight(.true.) + call cmfd_reweight(.true.) ! stop cmfd timer if (master) call time_cmfd % stop() @@ -132,6 +132,7 @@ contains use constants, only: CMFD_NOACCEL, ZERO, TWO use global, only: cmfd, cmfd_coremap, master, entropy_on, current_batch + use string, only: to_str #ifdef MPI use global, only: mpi_err @@ -238,6 +239,15 @@ contains cmfd % src_cmp(current_batch) = sqrt(ONE/cmfd % norm * & sum((cmfd % cmfd_src - cmfd % openmc_src)**2)) +#ifdef CMFD_DEBUG + open(file='cmfd_src_' // trim(to_str(current_batch)) // '.dat', unit=100) + do i = 1, nx + do j = 1,ny + write(100,*) cmfd % sourcecounts(1,i,j,1) + end do + end do + close(100) +#endif end if #ifdef MPI @@ -260,6 +270,7 @@ contains use mesh_header, only: StructuredMesh use mesh, only: count_bank_sites, get_mesh_indices use search, only: binary_search + use string, only: to_str #ifdef MPI use global, only: mpi_err @@ -273,6 +284,7 @@ contains integer :: nz ! maximum number of cells in z direction integer :: ng ! maximum number of energy groups integer :: i ! iteration counter + integer :: j ! iteration counter integer :: ijk(3) ! spatial bin location integer :: e_bin ! energy bin of source particle integer :: n_groups ! number of energy groups @@ -327,8 +339,19 @@ contains cmfd % weightfactors = cmfd % cmfd_src/sum(cmfd % cmfd_src)* & sum(cmfd % sourcecounts) / cmfd % sourcecounts end where +#ifdef CMFD_DEBUG + open(file='source_bank_' // trim(to_str(current_batch)) // '.dat', unit=101) + do i = 1, nx + do j = 1,ny + write(101,*) cmfd % sourcecounts(1,i,j,1) + end do + end do + close(101) +#endif end if +if (.not. cmfd_feedback) return + ! Broadcast weight factors to all procs #ifdef MPI call MPI_BCAST(cmfd % weightfactors, ng*nx*ny*nz, MPI_REAL8, 0, & From cf1ace33032acb370b383c6e72bf7b33b830ef3c Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Sun, 2 Mar 2014 19:39:16 -0500 Subject: [PATCH 28/95] added option to reset dhats --- src/cmfd_data.F90 | 6 ------ src/cmfd_execute.F90 | 2 +- src/cmfd_input.F90 | 8 ++++++++ 3 files changed, 9 insertions(+), 7 deletions(-) diff --git a/src/cmfd_data.F90 b/src/cmfd_data.F90 index 7962760cbf..df6b38e910 100644 --- a/src/cmfd_data.F90 +++ b/src/cmfd_data.F90 @@ -305,8 +305,6 @@ contains if (associated(m)) nullify(m) #ifdef CMFD_DEBUG - open(file='cmfd_src_' // trim(to_str(current_batch)) // '.dat', unit=100) - open(file='source_bank_' // trim(to_str(current_batch)) // '.dat', unit=101) open(file='openmc_src_' // trim(to_str(current_batch)) // '.dat', unit=102) open(file='totalxs1_' // trim(to_str(current_batch)) // '.dat', unit=103) open(file='totalxs2_' // trim(to_str(current_batch)) // '.dat', unit=104) @@ -343,8 +341,6 @@ contains ((cmfd % current(4*l-2,2,i,j,1) - & cmfd % current(4*l-3,2,i,j,1))) end do - write(100,*) cmfd % cmfd_src(1,i,j,1) - write(101,*) cmfd % sourcecounts(1,i,j,1) write(102,*) cmfd % openmc_src(1,i,j,1) write(103,*) cmfd % totalxs(1,i,j,1) write(104,*) cmfd % totalxs(2,i,j,1) @@ -366,8 +362,6 @@ contains write(120,*) leak2 end do end do - close(100) - close(101) close(102) close(103) close(104) diff --git a/src/cmfd_execute.F90 b/src/cmfd_execute.F90 index a1b8853042..f89f8c3c46 100644 --- a/src/cmfd_execute.F90 +++ b/src/cmfd_execute.F90 @@ -243,7 +243,7 @@ contains open(file='cmfd_src_' // trim(to_str(current_batch)) // '.dat', unit=100) do i = 1, nx do j = 1,ny - write(100,*) cmfd % sourcecounts(1,i,j,1) + write(100,*) cmfd % cmfd_src(1,i,j,1) end do end do close(100) diff --git a/src/cmfd_input.F90 b/src/cmfd_input.F90 index 93454ce4c2..39c780173f 100644 --- a/src/cmfd_input.F90 +++ b/src/cmfd_input.F90 @@ -165,6 +165,14 @@ contains cmfd_downscatter = .true. end if + ! Run an adjoint calc + if (check_for_node(doc, "dhat_reset")) then + call get_node_value(doc, "dhat_reset", temp_str) + call lower_case(temp_str) + if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') & + dhat_reset = .true. + end if + ! Set the solver type if (check_for_node(doc, "solver")) & call get_node_value(doc, "solver", cmfd_solver_type) From ccbd5b712817b09f4f8ec41beaaa3e18ba87cb23 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Sun, 2 Mar 2014 19:42:15 -0500 Subject: [PATCH 29/95] added fix neutron balance option --- src/cmfd_input.F90 | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/src/cmfd_input.F90 b/src/cmfd_input.F90 index 39c780173f..2cd3d1f619 100644 --- a/src/cmfd_input.F90 +++ b/src/cmfd_input.F90 @@ -165,7 +165,7 @@ contains cmfd_downscatter = .true. end if - ! Run an adjoint calc + ! Reset dhat parameters if (check_for_node(doc, "dhat_reset")) then call get_node_value(doc, "dhat_reset", temp_str) call lower_case(temp_str) @@ -173,6 +173,14 @@ contains dhat_reset = .true. end if + ! Enforce perfect neutorn balance + if (check_for_node(doc, "balance")) then + call get_node_value(doc, "balance", temp_str) + call lower_case(temp_str) + if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') & + cmfd_fix_balance = .true. + end if + ! Set the solver type if (check_for_node(doc, "solver")) & call get_node_value(doc, "solver", cmfd_solver_type) From 4de45e7b08b9d6a71a8d1c38b9de2bdd066f4809 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Mon, 3 Mar 2014 11:16:50 -0500 Subject: [PATCH 30/95] dhats can be reset from cmfd input --- src/cmfd_data.F90 | 25 +++++++++++++++++++++---- 1 file changed, 21 insertions(+), 4 deletions(-) diff --git a/src/cmfd_data.F90 b/src/cmfd_data.F90 index df6b38e910..1a35ac09bc 100644 --- a/src/cmfd_data.F90 +++ b/src/cmfd_data.F90 @@ -10,8 +10,6 @@ module cmfd_data private public :: set_up_cmfd, neutron_balance - logical :: dhat_reset = .false. - contains !============================================================================== @@ -705,7 +703,8 @@ contains subroutine compute_dhat() use constants, only: CMFD_NOACCEL, ZERO - use global, only: cmfd, cmfd_coremap + use global, only: cmfd, cmfd_coremap, message, dhat_reset + use output, only: write_message integer :: nx ! maximum number of cells in x direction integer :: ny ! maximum number of cells in y direction @@ -825,7 +824,9 @@ contains cmfd%dhat(l,g,i,j,k) = dhat ! check for dhat reset - if (dhat_reset) cmfd%dhat(l,g,i,j,k) = ZERO + if (dhat_reset) then + cmfd%dhat(l,g,i,j,k) = ZERO + end if end do LEAK @@ -837,6 +838,12 @@ contains end do ZLOOP + ! write that dhats are zero + if (dhat_reset) then + message = 'Dhats reset to zero.' + call write_message(1) + end if + end subroutine compute_dhat !=============================================================================== @@ -914,6 +921,16 @@ contains real(8) :: siga1 ! group 1 abs xs real(8) :: siga2 ! group 2 abs xs real(8) :: sigs12_eff ! effective downscatter xs + real(8) :: a ! matrix (1,1) element for balance + real(8) :: b ! matrix (1,2) element for balance + real(8) :: c ! matrix (2,1) element for balance + real(8) :: d ! matrix (2,2) element for balance + real(8) :: r1 ! right hand side element 1 + real(8) :: r2 ! right hand side element 2 + real(8) :: det ! determinant of balance matrix + + message = 'Correcting neutron balance' + call write_message(1) ! Extract spatial and energy indices from object nx = cmfd % indices(1) From d1e46a22ec3cd49c068dc96ab1ab367a47f9323e Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Sat, 15 Mar 2014 08:18:07 -0400 Subject: [PATCH 31/95] added keff balance --- src/cmfd_data.F90 | 52 +++++++++++++++++++++++++++++++++------------ src/cmfd_header.F90 | 3 +++ 2 files changed, 42 insertions(+), 13 deletions(-) diff --git a/src/cmfd_data.F90 b/src/cmfd_data.F90 index 1a35ac09bc..dc5db8352c 100644 --- a/src/cmfd_data.F90 +++ b/src/cmfd_data.F90 @@ -31,6 +31,9 @@ contains ! Compute effective downscatter cross section if (cmfd_downscatter) call compute_effective_downscatter() + ! Compute perfect balance + if (cmfd_fix_balance) call fix_neutron_balance() + ! Check neutron balance call neutron_balance() @@ -104,6 +107,8 @@ contains cmfd % hxyz(2,:,:,:) = m % width(2) ! set y width cmfd % hxyz(3,:,:,:) = m % width(3) ! set z width + cmfd % keff_bal = ZERO + ! Begin loop around tallies TAL: do ital = 1, n_cmfd_tallies @@ -212,6 +217,7 @@ contains ! Bank source cmfd % openmc_src(g,i,j,k) = cmfd % openmc_src(g,i,j,k) + & t % results(2,score_index) % sum + cmfd % keff_bal = cmfd % keff_bal + t % results(2,score_index) % sum / dble(t % n_realizations) end do INGROUP @@ -703,8 +709,9 @@ contains subroutine compute_dhat() use constants, only: CMFD_NOACCEL, ZERO - use global, only: cmfd, cmfd_coremap, message, dhat_reset + use global, only: cmfd, cmfd_coremap, message, dhat_reset, current_batch use output, only: write_message + use string, only: to_str integer :: nx ! maximum number of cells in x direction integer :: ny ! maximum number of cells in y direction @@ -738,6 +745,9 @@ contains nxyz(1,:) = (/1,nx/) nxyz(2,:) = (/1,ny/) nxyz(3,:) = (/1,nz/) +#ifdef CMFD_DEBUG + open(file='cmfd_dhat_' // trim(to_str(current_batch)) // '.dat', unit=125) +#endif ! Geting loop over group and spatial indices ZLOOP: do k = 1,nz @@ -828,6 +838,9 @@ contains cmfd%dhat(l,g,i,j,k) = ZERO end if +#ifdef CMFD_DEBUG + write(125,*) dhat +#endif end do LEAK end do GROUP @@ -844,6 +857,10 @@ contains call write_message(1) end if +#ifdef CMFD_DEBUG + close(unit=125) +#endif + end subroutine compute_dhat !=============================================================================== @@ -889,12 +906,12 @@ contains !=============================================================================== ! FIX_NEUTRON_BALANCE is a method to adjust parameters to have perfect balance !=============================================================================== -#ifdef DEVELOPMENTAL + subroutine fix_neutron_balance() use constants, only: ONE, ZERO, CMFD_NOACCEL - use global, only: cmfd, keff - use, intrinsic :: ISO_FORTRAN_ENV + use global, only: cmfd, message + use output, only: write_message integer :: nx ! number of mesh cells in x direction integer :: ny ! number of mesh cells in y direction @@ -928,6 +945,7 @@ contains real(8) :: r1 ! right hand side element 1 real(8) :: r2 ! right hand side element 2 real(8) :: det ! determinant of balance matrix + real(8) :: keff_bal ! keffective for balance eq. message = 'Correcting neutron balance' call write_message(1) @@ -938,6 +956,10 @@ contains nz = cmfd % indices(3) ng = cmfd % indices(4) + keff_bal = cmfd % keff_bal + + print *, 'KEFF BALANCE is:', keff_bal + ! Return if not two groups if (ng /= 2) return @@ -995,14 +1017,16 @@ contains siga1 = sigt1 - sigs11 - sigs12 siga2 = sigt2 - sigs22 - sigs21 - ! Compute effective downscatter xs - sigs12_eff = (ONE/keff*nsigf11*flux1 - leak1 - siga1*flux1 & - - ONE/keff*nsigf21/siga2*leak2 ) / ( flux1*(ONE & - - ONE/keff*nsigf21/siga2)) - - ! Redefine flux 2 - flux2 = (sigs12_eff*flux1 - leak2)/siga2 - cmfd % flux(2,i,j,k) = flux2 + ! Create matrix and solve for effective downscatter and thermal flux + a = flux1 + b = -ONE/keff_bal*nsigf21 + c = flux1 + d = -siga2 + ONE/keff_bal*nsigf22 + det = a*d - b*c + r1 = ONE/keff_bal*nsigf11*flux1 - siga1*flux1 - leak1 + r2 = leak2 - ONE/keff_bal*nsigf12*flux1 + sigs12_eff = ONE/det*(d*r1 - b*r2) + flux2 = ONE/det*(a*r2 - c*r1) ! Recompute total cross sections (use effective and no upscattering) sigt1 = siga1 + sigs11 + sigs12_eff @@ -1018,6 +1042,9 @@ contains ! Zero out upscatter cross section cmfd % scattxs(2,1,i,j,k) = ZERO + ! Record thermal flux + cmfd % flux(2,i,j,k) = flux2 + end do XLOOP end do YLOOP @@ -1025,7 +1052,6 @@ contains end do ZLOOP end subroutine fix_neutron_balance -#endif !=============================================================================== ! COMPUTE_EFFECTIVE_DOWNSCATTER changes downscatter rate for zero upscatter diff --git a/src/cmfd_header.F90 b/src/cmfd_header.F90 index 73bc0e0163..c9bc0f32af 100644 --- a/src/cmfd_header.F90 +++ b/src/cmfd_header.F90 @@ -83,6 +83,9 @@ module cmfd_header ! List of CMFD k real(8), allocatable :: k_cmfd(:) + ! Balance keff + real(8) :: keff_bal + end type cmfd_type contains From d26b2da8bc4936a0e3d2d50c74205f9e4f6e6fad Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Tue, 9 Sep 2014 11:51:52 -0400 Subject: [PATCH 32/95] updated documentation and removed some unncessary vars --- docs/source/usersguide/input.rst | 136 +++++++++++++++++++++---------- src/cmfd_execute.F90 | 3 +- src/cmfd_input.F90 | 14 ++-- src/global.F90 | 1 - 4 files changed, 97 insertions(+), 57 deletions(-) diff --git a/docs/source/usersguide/input.rst b/docs/source/usersguide/input.rst index c9aa8cc866..301f7f52de 100644 --- a/docs/source/usersguide/input.rst +++ b/docs/source/usersguide/input.rst @@ -1238,14 +1238,26 @@ Currently, it allows users to accelerate fission source convergence during inactive neutron batches. To run CMFD, the ```` element in ``settings.xml`` should be set to "true". -```` Element --------------------------- +```` Element +-------------------- -The ```` element controls the batch where CMFD tallies should be -reset. CMFD tallies should be reset before active batches so they are accumulated -without bias. +The ```` element specifies the absolute inner tolerance on the Gauss-Seidel +when performing CMFD calculations. It is only used in the standalone CMFD solver +and not when PETSc is active. + + *Default*: 1.e-10 + +```` Element +------------------- + +The ```` element controls whether exact neutron balance should be enforced +from CMFD tallies before creating CMFD matrices. This changes effective downscatter +cross section and thermal flux to create exact balance. It should be noted that +this option has led to instabilities when performing CMFD. It can be turned on +with "true" and off with "false". + + *Default*: false - *Default*: 0 ```` Element ------------------- @@ -1268,7 +1280,25 @@ The ```` element sets one additional CMFD output column. Options are: * "source" - prints the RMS [%] between the OpenMC fission source and CMFD fission source. - *Default*: None + *Default*: balance + +```` Element +------------------- + +The ```` element controls whether dhat nonlinear CMFD parameters +should be reset to zero before solving CMFD eigenproblem. It can be turned on with +"true" and off with "false". + + *Default*: false + +```` Element +------------------- + +The ```` element controls whether an effective downscatter cross +section should be used when using 2-group CMFD. It can be turned on with "true" +and off with "false". + + *Default*: false ```` Element ---------------------- @@ -1279,25 +1309,6 @@ It can be turned on with "true" and off with "false". *Default*: false -```` Element ----------------------- - -The ```` element controls if cmfd tallies should be accumulated -during inactive batches. For some applications, CMFD tallies may not be -needed until the start of active batches. This option can be turned on -with "true" and off with "false" - - *Default*: true - -```` Element ----------------------------- - -The ```` element controls when CMFD tallies are reset during -inactive batches. The integer set here is the interval at which this reset -occurs. The amout of resets is controlled with the ```` element. - - *Defualt*: 9999 - ```` Element ------------------------- @@ -1305,9 +1316,16 @@ The ```` element is used to view the convergence of linear GMRES iterations in PETSc. This option can be turned on with "true" and turned off with "false". - *Default*: false +```` Element +-------------------- + +The ```` element specifies the tolerance on the eigenvalue when performing +CMFD power iteration. + + *Default*: 1.e-8 + ```` Element ------------------ @@ -1376,14 +1394,6 @@ not impact the calculation. *Default*: 1.0 -```` Element -------------------------- - -The ```` element controls the number of CMFD tally resets that -occur during inactive CMFD batches. - - *Default*: 9999 - ```` Element --------------------------- @@ -1392,20 +1402,21 @@ This option can be turned on with "true" and turned off with "false". *Default*: false +```` Element +-------------------- + +The ```` element specifies the relative inner tolerance on the Gauss-Seidel +when performing CMFD calculations. It is only used in the standalone CMFD solver +and not when PETSc is active. + + *Default*: 1.e-5 + ```` Element ------------------------- The ```` element can be turned on with "true" to have an adjoint -calculation be performed on the last batch when CMFD is active. - - *Default*: false - -```` Element --------------------------- - -The ```` element is used to view the convergence of the nonlinear SNES -function in PETSc. This option can be turned on with "true" and turned off with "false". - +calculation be performed on the last batch when CMFD is active. OpenMC should be +compiled with PETSc when using this option. *Default*: false @@ -1418,6 +1429,41 @@ By setting "power", power iteration is used and by setting "jfnk", JFNK is used. *Default*: power +```` Element +-------------------- + +The ```` element specifies an optional Wielandt shift parameter for +accelerating power iterations. It can only be used when PETSc is not active. +It is by default very large so the impact of the shift is effectively zero. + + *Default*: 1e6 + +```` Element +-------------------- + +The ```` element specifies an optional spectral radius that can be set to +accelerate the convergence of Gauss-Seidel iterations during CMFD power iteration +solve. Note this is only used in the standalone CMFD solver and does not affect +the calculation when PETSc is active. + + *Default*: power + +```` Element +-------------------- + +The ```` element specifies the tolerance on the fission source when performing +CMFD power iteration. + + *Default*: 1.e-8 + +```` Element +-------------------- + +The ```` element contains a list of batch numbers in which CMFD tallies +should be reset. + + *Default*: None + ```` Element ---------------------------- diff --git a/src/cmfd_execute.F90 b/src/cmfd_execute.F90 index f89f8c3c46..fe19bd95b7 100644 --- a/src/cmfd_execute.F90 +++ b/src/cmfd_execute.F90 @@ -82,7 +82,7 @@ contains subroutine cmfd_init_batch() - use global, only: cmfd_begin, cmfd_on, cmfd_tally_on, & + use global, only: cmfd_begin, cmfd_on, & cmfd_reset, cmfd_run, & current_batch, cmfd_hold_weights @@ -91,7 +91,6 @@ contains ! accumulated if (cmfd_run .and. cmfd_begin == current_batch) then cmfd_on = .true. - cmfd_tally_on = .true. end if ! If this is a restart run and we are just replaying batches leave diff --git a/src/cmfd_input.F90 b/src/cmfd_input.F90 index 2cd3d1f619..0523325c9a 100644 --- a/src/cmfd_input.F90 +++ b/src/cmfd_input.F90 @@ -173,7 +173,7 @@ contains dhat_reset = .true. end if - ! Enforce perfect neutorn balance + ! Enforce perfect neutron balance if (check_for_node(doc, "balance")) then call get_node_value(doc, "balance", temp_str) call lower_case(temp_str) @@ -218,6 +218,10 @@ contains call get_node_value(doc, "run_adjoint", temp_str) call lower_case(temp_str) if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') & +#ifndef PETSC + message = 'Must use PETSc when running adjoint option.' + call fatal_error() +#endif cmfd_run_adjoint = .true. end if @@ -225,14 +229,6 @@ contains if (check_for_node(doc, "begin")) & call get_node_value(doc, "begin", cmfd_begin) - ! Tally during inactive batches - if (check_for_node(doc, "inactive")) then - call get_node_value(doc, "inactive", temp_str) - call lower_case(temp_str) - if (trim(temp_str) == 'false' .or. trim(temp_str) == '0') & - cmfd_tally_on = .false. - end if - ! Check for cmfd tally resets if (check_for_node(doc, "tally_reset")) then n_cmfd_resets = get_arraysize_integer(doc, "tally_reset") diff --git a/src/global.F90 b/src/global.F90 index 02a87051f4..3b9b8bfeea 100644 --- a/src/global.F90 +++ b/src/global.F90 @@ -367,7 +367,6 @@ module global ! CMFD run logicals logical :: cmfd_on = .false. - logical :: cmfd_tally_on = .true. ! CMFD display info character(len=25) :: cmfd_display = 'balance' From 445f3910f8cf06d5f81598164bdea5668270a650 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Tue, 9 Sep 2014 11:56:21 -0400 Subject: [PATCH 33/95] fixed titles in cmfd section --- docs/source/usersguide/input.rst | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/docs/source/usersguide/input.rst b/docs/source/usersguide/input.rst index 301f7f52de..cc2d5e7597 100644 --- a/docs/source/usersguide/input.rst +++ b/docs/source/usersguide/input.rst @@ -1248,7 +1248,7 @@ and not when PETSc is active. *Default*: 1.e-10 ```` Element -------------------- +--------------------- The ```` element controls whether exact neutron balance should be enforced from CMFD tallies before creating CMFD matrices. This changes effective downscatter @@ -1283,7 +1283,7 @@ The ```` element sets one additional CMFD output column. Options are: *Default*: balance ```` Element -------------------- +------------------------ The ```` element controls whether dhat nonlinear CMFD parameters should be reset to zero before solving CMFD eigenproblem. It can be turned on with @@ -1292,7 +1292,7 @@ should be reset to zero before solving CMFD eigenproblem. It can be turned on wi *Default*: false ```` Element -------------------- +------------------------- The ```` element controls whether an effective downscatter cross section should be used when using 2-group CMFD. It can be turned on with "true" @@ -1439,7 +1439,7 @@ It is by default very large so the impact of the shift is effectively zero. *Default*: 1e6 ```` Element --------------------- +---------------------- The ```` element specifies an optional spectral radius that can be set to accelerate the convergence of Gauss-Seidel iterations during CMFD power iteration @@ -1449,7 +1449,7 @@ the calculation when PETSc is active. *Default*: power ```` Element --------------------- +------------------ The ```` element specifies the tolerance on the fission source when performing CMFD power iteration. @@ -1457,7 +1457,7 @@ CMFD power iteration. *Default*: 1.e-8 ```` Element --------------------- +------------------------- The ```` element contains a list of batch numbers in which CMFD tallies should be reset. From bec72d183343a355aeb43dec0e75b47a4a065cfb Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Mon, 18 Aug 2014 22:55:35 -0400 Subject: [PATCH 34/95] Make nuclide/element names case insensitive in input. --- src/ace.F90 | 10 ++--- src/cmfd_input.F90 | 20 +++++----- src/input_xml.F90 | 99 +++++++++++++++++++++------------------------- src/output.F90 | 5 +-- src/string.F90 | 36 +++++++++++------ 5 files changed, 84 insertions(+), 86 deletions(-) diff --git a/src/ace.F90 b/src/ace.F90 index 9c088693de..cacfc24366 100644 --- a/src/ace.F90 +++ b/src/ace.F90 @@ -11,7 +11,7 @@ module ace use material_header, only: Material use output, only: write_message use set_header, only: SetChar - use string, only: to_str + use string, only: to_str, to_lower implicit none @@ -67,8 +67,8 @@ contains name = mat % names(j) if (.not. already_read % contains(name)) then - i_listing = xs_listing_dict % get_key(name) - i_nuclide = nuclide_dict % get_key(name) + i_listing = xs_listing_dict % get_key(to_lower(name)) + i_nuclide = nuclide_dict % get_key(to_lower(name)) name = xs_listings(i_listing) % name alias = xs_listings(i_listing) % alias @@ -91,8 +91,8 @@ contains name = mat % sab_names(k) if (.not. already_read % contains(name)) then - i_listing = xs_listing_dict % get_key(name) - i_sab = sab_dict % get_key(name) + i_listing = xs_listing_dict % get_key(to_lower(name)) + i_sab = sab_dict % get_key(to_lower(name)) ! Read the ACE table into the appropriate entry on the sab_tables ! array diff --git a/src/cmfd_input.F90 b/src/cmfd_input.F90 index 7e6ca18e53..3be4eb66a6 100644 --- a/src/cmfd_input.F90 +++ b/src/cmfd_input.F90 @@ -62,7 +62,7 @@ contains use error, only: fatal_error, warning use global use output, only: write_message - use string, only: lower_case + use string, only: to_lower use xml_interface use, intrinsic :: ISO_FORTRAN_ENV @@ -151,7 +151,7 @@ contains ! Set feedback logical if (check_for_node(doc, "feedback")) then call get_node_value(doc, "feedback", temp_str) - call lower_case(temp_str) + temp_str = to_lower(temp_str) if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') & cmfd_feedback = .true. end if @@ -159,7 +159,7 @@ contains ! Set downscatter logical if (check_for_node(doc, "downscatter")) then call get_node_value(doc, "downscatter", temp_str) - call lower_case(temp_str) + temp_str = to_lower(temp_str) if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') & cmfd_downscatter = .true. end if @@ -171,19 +171,19 @@ contains ! Set monitoring if (check_for_node(doc, "snes_monitor")) then call get_node_value(doc, "snes_monitor", temp_str) - call lower_case(temp_str) + temp_str = to_lower(temp_str) if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') & cmfd_snes_monitor = .true. end if if (check_for_node(doc, "ksp_monitor")) then call get_node_value(doc, "ksp_monitor", temp_str) - call lower_case(temp_str) + temp_str = to_lower(temp_str) if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') & cmfd_ksp_monitor = .true. end if if (check_for_node(doc, "power_monitor")) then call get_node_value(doc, "power_monitor", temp_str) - call lower_case(temp_str) + temp_str = to_lower(temp_str) if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') & cmfd_power_monitor = .true. end if @@ -191,7 +191,7 @@ contains ! Output logicals if (check_for_node(doc, "write_matrices")) then call get_node_value(doc, "write_matices", temp_str) - call lower_case(temp_str) + temp_str = to_lower(temp_str) if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') & cmfd_write_matrices = .true. end if @@ -199,7 +199,7 @@ contains ! Run an adjoint calc if (check_for_node(doc, "run_adjoint")) then call get_node_value(doc, "run_adjoint", temp_str) - call lower_case(temp_str) + temp_str = to_lower(temp_str) if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') & cmfd_run_adjoint = .true. end if @@ -211,7 +211,7 @@ contains ! Tally during inactive batches if (check_for_node(doc, "inactive")) then call get_node_value(doc, "inactive", temp_str) - call lower_case(temp_str) + temp_str = to_lower(temp_str) if (trim(temp_str) == 'false' .or. trim(temp_str) == '0') & cmfd_tally_on = .false. end if @@ -405,7 +405,7 @@ contains ! Set reset property if (check_for_node(doc, "reset")) then call get_node_value(doc, "reset", temp_str) - call lower_case(temp_str) + temp_str = to_lower(temp_str) if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') & t % reset = .true. end if diff --git a/src/input_xml.F90 b/src/input_xml.F90 index f36e4ca3a7..e2baa87a3c 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -11,7 +11,7 @@ module input_xml use output, only: write_message use plot_header use random_lcg, only: prn - use string, only: lower_case, to_str, str_to_int, str_to_real, & + use string, only: to_lower, to_str, str_to_int, str_to_real, & starts_with, ends_with use tally_header, only: TallyObject, TallyFilter use tally_initialize, only: add_tallies @@ -287,8 +287,7 @@ contains type = '' if (check_for_node(node_dist, "type")) & call get_node_value(node_dist, "type", type) - call lower_case(type) - select case (trim(type)) + select case (to_lower(type)) case ('box') external_source % type_space = SRC_SPACE_BOX coeffs_reqd = 6 @@ -337,8 +336,7 @@ contains type = '' if (check_for_node(node_dist, "type")) & call get_node_value(node_dist, "type", type) - call lower_case(type) - select case (trim(type)) + select case (to_lower(type)) case ('isotropic') external_source % type_angle = SRC_ANGLE_ISOTROPIC coeffs_reqd = 0 @@ -389,8 +387,7 @@ contains type = '' if (check_for_node(node_dist, "type")) & call get_node_value(node_dist, "type", type) - call lower_case(type) - select case (trim(type)) + select case (to_lower(type)) case ('monoenergetic') external_source % type_energy = SRC_ENERGY_MONO coeffs_reqd = 1 @@ -440,7 +437,7 @@ contains ! Survival biasing if (check_for_node(doc, "survival_biasing")) then call get_node_value(doc, "survival_biasing", temp_str) - call lower_case(temp_str) + temp_str = to_lower(temp_str) if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') & survival_biasing = .true. end if @@ -448,7 +445,7 @@ contains ! Probability tables if (check_for_node(doc, "ptables")) then call get_node_value(doc, "ptables", temp_str) - call lower_case(temp_str) + temp_str = to_lower(temp_str) if (trim(temp_str) == 'false' .or. trim(temp_str) == '0') & urr_ptables_on = .false. end if @@ -679,19 +676,19 @@ contains ! Check if the user has specified to write binary source file if (check_for_node(node_sp, "separate")) then call get_node_value(node_sp, "separate", temp_str) - call lower_case(temp_str) + temp_str = to_lower(temp_str) if (trim(temp_str) == 'true' .or. & trim(temp_str) == '1') source_separate = .true. end if if (check_for_node(node_sp, "write")) then call get_node_value(node_sp, "write", temp_str) - call lower_case(temp_str) + temp_str = to_lower(temp_str) if (trim(temp_str) == 'false' .or. & trim(temp_str) == '0') source_write = .false. end if if (check_for_node(node_sp, "overwrite_latest")) then call get_node_value(node_sp, "overwrite_latest", temp_str) - call lower_case(temp_str) + temp_str = to_lower(temp_str) if (trim(temp_str) == 'true' .or. & trim(temp_str) == '1') then source_latest = .true. @@ -726,7 +723,7 @@ contains ! batch if (check_for_node(doc, "no_reduce")) then call get_node_value(doc, "no_reduce", temp_str) - call lower_case(temp_str) + temp_str = to_lower(temp_str) if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') & reduce_tallies = .false. end if @@ -735,7 +732,7 @@ contains ! uncertainties rather than standard deviations if (check_for_node(doc, "confidence_intervals")) then call get_node_value(doc, "confidence_intervals", temp_str) - call lower_case(temp_str) + temp_str = to_lower(temp_str) if (trim(temp_str) == 'true' .or. & trim(temp_str) == '1') confidence_intervals = .true. end if @@ -749,7 +746,7 @@ contains ! Check for summary option if (check_for_node(node_output, "summary")) then call get_node_value(node_output, "summary", temp_str) - call lower_case(temp_str) + temp_str = to_lower(temp_str) if (trim(temp_str) == 'true' .or. & trim(temp_str) == '1') output_summary = .true. end if @@ -757,7 +754,7 @@ contains ! Check for cross sections option if (check_for_node(node_output, "cross_sections")) then call get_node_value(node_output, "cross_sections", temp_str) - call lower_case(temp_str) + temp_str = to_lower(temp_str) if (trim(temp_str) == 'true' .or. & trim(temp_str) == '1') output_xs = .true. end if @@ -765,7 +762,7 @@ contains ! Check for ASCII tallies output option if (check_for_node(node_output, "tallies")) then call get_node_value(node_output, "tallies", temp_str) - call lower_case(temp_str) + temp_str = to_lower(temp_str) if (trim(temp_str) == 'false' .or. & trim(temp_str) == '0') output_tallies = .false. end if @@ -774,7 +771,7 @@ contains ! Check for cmfd run if (check_for_node(doc, "run_cmfd")) then call get_node_value(doc, "run_cmfd", temp_str) - call lower_case(temp_str) + temp_str = to_lower(temp_str) if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') then cmfd_run = .true. #ifndef PETSC @@ -789,8 +786,7 @@ contains ! Natural element expansion option if (check_for_node(doc, "natural_elements")) then call get_node_value(doc, "natural_elements", temp_str) - call lower_case(temp_str) - select case (temp_str) + select case (to_lower(temp_str)) case ('endf/b-vii.0') default_expand = ENDF_BVII0 case ('endf/b-vii.1') @@ -923,8 +919,7 @@ contains word = '' if (check_for_node(node_cell, "material")) & call get_node_value(node_cell, "material", word) - call lower_case(word) - select case(word) + select case(to_lower(word)) case ('void') c % material = MATERIAL_VOID @@ -1093,8 +1088,7 @@ contains word = '' if (check_for_node(node_surf, "type")) & call get_node_value(node_surf, "type", word) - call lower_case(word) - select case(trim(word)) + select case(to_lower(word)) case ('x-plane') s % type = SURF_PX coeffs_reqd = 1 @@ -1155,8 +1149,7 @@ contains word = '' if (check_for_node(node_surf, "boundary")) & call get_node_value(node_surf, "boundary", word) - call lower_case(word) - select case (trim(word)) + select case (to_lower(word)) case ('transmission', 'transmit', '') s % bc = BC_TRANSMIT case ('vacuum') @@ -1218,8 +1211,7 @@ contains word = '' if (check_for_node(node_lat, "type")) & call get_node_value(node_lat, "type", word) - call lower_case(word) - select case (trim(word)) + select case (to_lower(word)) case ('rect', 'rectangle', 'rectangular') lat % type = LATTICE_RECT case ('hex', 'hexagon', 'hexagonal') @@ -1450,8 +1442,7 @@ contains end if ! Adjust material density based on specified units - call lower_case(units) - select case(trim(units)) + select case(to_lower(units)) case ('g/cc', 'g/cm3') mat % density = -val case ('kg/m3') @@ -1606,7 +1597,7 @@ contains ALL_NUCLIDES: do j = 1, mat % n_nuclides ! Check that this nuclide is listed in the cross_sections.xml file name = trim(list_names % get_item(j)) - if (.not. xs_listing_dict % has_key(name)) then + if (.not. xs_listing_dict % has_key(to_lower(name))) then message = "Could not find nuclide " // trim(name) // & " in cross_sections.xml file!" call fatal_error() @@ -1621,20 +1612,20 @@ contains end if ! Find xs_listing and set the name/alias according to the listing - index_list = xs_listing_dict % get_key(name) + index_list = xs_listing_dict % get_key(to_lower(name)) name = xs_listings(index_list) % name alias = xs_listings(index_list) % alias ! If this nuclide hasn't been encountered yet, we need to add its name ! and alias to the nuclide_dict - if (.not. nuclide_dict % has_key(name)) then + if (.not. nuclide_dict % has_key(to_lower(name))) then index_nuclide = index_nuclide + 1 mat % nuclide(j) = index_nuclide - call nuclide_dict % add_key(name, index_nuclide) - call nuclide_dict % add_key(alias, index_nuclide) + call nuclide_dict % add_key(to_lower(name), index_nuclide) + call nuclide_dict % add_key(to_lower(alias), index_nuclide) else - mat % nuclide(j) = nuclide_dict % get_key(name) + mat % nuclide(j) = nuclide_dict % get_key(to_lower(name)) end if ! Copy name and atom/weight percent @@ -1693,7 +1684,7 @@ contains mat % sab_names(j) = name ! Check that this nuclide is listed in the cross_sections.xml file - if (.not. xs_listing_dict % has_key(name)) then + if (.not. xs_listing_dict % has_key(to_lower(name))) then message = "Could not find S(a,b) table " // trim(name) // & " in cross_sections.xml file!" call fatal_error() @@ -1701,17 +1692,17 @@ contains ! Find index in xs_listing and set the name and alias according to the ! listing - index_list = xs_listing_dict % get_key(name) + index_list = xs_listing_dict % get_key(to_lower(name)) name = xs_listings(index_list) % name ! If this S(a,b) table hasn't been encountered yet, we need to add its ! name and alias to the sab_dict - if (.not. sab_dict % has_key(name)) then + if (.not. sab_dict % has_key(to_lower(name))) then index_sab = index_sab + 1 mat % i_sab_tables(j) = index_sab - call sab_dict % add_key(name, index_sab) + call sab_dict % add_key(to_lower(name), index_sab) else - mat % i_sab_tables(j) = sab_dict % get_key(name) + mat % i_sab_tables(j) = sab_dict % get_key(to_lower(name)) end if end do end if @@ -1822,7 +1813,7 @@ contains ! Check for setting if (check_for_node(doc, "assume_separate")) then call get_node_value(doc, "assume_separate", temp_str) - call lower_case(temp_str) + temp_str = to_lower(temp_str) if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') & assume_separate = .true. end if @@ -1855,8 +1846,7 @@ contains temp_str = '' if (check_for_node(node_mesh, "type")) & call get_node_value(node_mesh, "type", temp_str) - call lower_case(temp_str) - select case (trim(temp_str)) + select case (to_lower(temp_str)) case ('rect', 'rectangle', 'rectangular') m % type = LATTICE_RECT case ('hex', 'hexagon', 'hexagonal') @@ -2036,7 +2026,7 @@ contains temp_str = '' if (check_for_node(node_filt, "type")) & call get_node_value(node_filt, "type", temp_str) - call lower_case(temp_str) + temp_str = to_lower(temp_str) ! Determine number of bins if (check_for_node(node_filt, "bins")) then @@ -2264,14 +2254,14 @@ contains end if ! Check to make sure nuclide specified is in problem - if (.not. nuclide_dict % has_key(word)) then + if (.not. nuclide_dict % has_key(to_lower(word))) then message = "The nuclide " // trim(word) // " from tally " // & trim(to_str(t % id)) // " is not present in any material." call fatal_error() end if ! Set bin to index in nuclides array - t % nuclide_bins(j) = nuclide_dict % get_key(word) + t % nuclide_bins(j) = nuclide_dict % get_key(to_lower(word)) end do ! Set number of nuclide bins @@ -2302,7 +2292,7 @@ contains ! (i.e., scatter-p#, flux-y#) n_new = 0 do j = 1, n_words - call lower_case(sarray(j)) + sarray(j) = to_lower(sarray(j)) ! Find if scores(j) is of the form 'moment-p' or 'moment-y' present in ! MOMENT_STRS(:) ! If so, check the order, store if OK, then reset the number to 'n' @@ -2744,7 +2734,7 @@ contains temp_str = 'slice' if (check_for_node(node_plot, "type")) & call get_node_value(node_plot, "type", temp_str) - call lower_case(temp_str) + temp_str = to_lower(temp_str) select case (trim(temp_str)) case ("slice") pl % type = PLOT_TYPE_SLICE @@ -2811,7 +2801,7 @@ contains temp_str = 'xy' if (check_for_node(node_plot, "basis")) & call get_node_value(node_plot, "basis", temp_str) - call lower_case(temp_str) + temp_str = to_lower(temp_str) select case (trim(temp_str)) case ("xy") pl % basis = PLOT_BASIS_XY @@ -2858,7 +2848,7 @@ contains temp_str = "cell" if (check_for_node(node_plot, "color")) & call get_node_value(node_plot, "color", temp_str) - call lower_case(temp_str) + temp_str = to_lower(temp_str) select case (trim(temp_str)) case ("cell") @@ -3181,9 +3171,9 @@ contains end if ! create dictionary entry for both name and alias - call xs_listing_dict % add_key(listing % name, i) + call xs_listing_dict % add_key(to_lower(listing % name), i) if (check_for_node(node_ace, "alias")) then - call xs_listing_dict % add_key(listing % alias, i) + call xs_listing_dict % add_key(to_lower(listing % alias), i) end if end do @@ -3212,9 +3202,8 @@ contains character(2) :: element_name element_name = name(1:2) - call lower_case(element_name) - select case (element_name) + select case (to_lower(element_name)) case ('h') call list_names % append('1001.' // xs) call list_density % append(density * 0.999885_8) diff --git a/src/output.F90 b/src/output.F90 index 834c28e188..1493b82943 100644 --- a/src/output.F90 +++ b/src/output.F90 @@ -13,7 +13,7 @@ module output use mesh, only: mesh_indices_to_bin, bin_to_mesh_indices use particle_header, only: LocalCoord, Particle use plot_header - use string, only: upper_case, to_str + use string, only: to_upper, to_str use tally_header, only: TallyObject implicit none @@ -130,8 +130,7 @@ contains if (mod(len_trim(msg),2) == 0) m = m + 1 ! convert line to upper case - line = msg - call upper_case(line) + line = to_upper(msg) ! print header based on level select case (header_level) diff --git a/src/string.F90 b/src/string.F90 index f78b94d07f..d4f8873a0a 100644 --- a/src/string.F90 +++ b/src/string.F90 @@ -152,37 +152,47 @@ contains ! LOWER_CASE converts a string to all lower case characters !=============================================================================== - elemental subroutine lower_case(word) + elemental function to_lower(word) result(word_lower) - character(*), intent(inout) :: word + character(*), intent(in) :: word + character(len=len(word)) :: word_lower integer :: i integer :: ic do i = 1, len(word) ic = ichar(word(i:i)) - if (ic >= 65 .and. ic <= 90) word(i:i) = char(ic+32) + if (ic >= 65 .and. ic <= 90) then + word_lower(i:i) = char(ic+32) + else + word_lower(i:i) = word(i:i) + end if end do - end subroutine lower_case + end function to_lower !=============================================================================== ! UPPER_CASE converts a string to all upper case characters !=============================================================================== - elemental subroutine upper_case(word) + elemental function to_upper(word) result(word_upper) - character(*), intent(inout) :: word + character(*), intent(in) :: word + character(len=len(word)) :: word_upper integer :: i integer :: ic do i = 1, len(word) ic = ichar(word(i:i)) - if (ic >= 97 .and. ic <= 122) word(i:i) = char(ic-32) + if (ic >= 97 .and. ic <= 122) then + word_upper(i:i) = char(ic-32) + else + word_upper(i:i) = word(i:i) + end if end do - end subroutine upper_case + end function to_upper !=============================================================================== ! ZERO_PADDED returns a string of the input integer padded with zeros to the @@ -317,7 +327,7 @@ end function zero_padded ! the loop automatically exits when n_digits = 10. n_digits = n_digits + 1 end do - + end function count_digits !=============================================================================== @@ -349,21 +359,21 @@ end function zero_padded end function int8_to_str !=============================================================================== -! STR_TO_INT converts a string to an integer. +! STR_TO_INT converts a string to an integer. !=============================================================================== function str_to_int(str) result(num) character(*), intent(in) :: str integer(8) :: num - + character(5) :: fmt integer :: w integer :: ioError ! Determine width of string w = len_trim(str) - + ! Create format specifier for reading string write(UNIT=fmt, FMT='("(I",I2,")")') w @@ -404,7 +414,7 @@ end function zero_padded integer :: decimal ! number of places after decimal integer :: width ! total field width - real(8) :: num2 ! absolute value of number + real(8) :: num2 ! absolute value of number character(9) :: fmt ! format specifier for writing number ! set default field width From d1050fa194dcfeea2338837a5659c2ae565d1ba0 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Wed, 10 Sep 2014 09:30:46 -0400 Subject: [PATCH 35/95] indented 5 spaces for line continuation --- src/cmfd_input.F90 | 44 ++++++++++++++++++++++---------------------- 1 file changed, 22 insertions(+), 22 deletions(-) diff --git a/src/cmfd_input.F90 b/src/cmfd_input.F90 index 61d6f6eaba..0a27b6a19c 100644 --- a/src/cmfd_input.F90 +++ b/src/cmfd_input.F90 @@ -153,7 +153,7 @@ contains call get_node_value(doc, "feedback", temp_str) call lower_case(temp_str) if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') & - cmfd_feedback = .true. + cmfd_feedback = .true. end if ! Set downscatter logical @@ -161,31 +161,31 @@ contains call get_node_value(doc, "downscatter", temp_str) call lower_case(temp_str) if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') & - cmfd_downscatter = .true. + cmfd_downscatter = .true. end if ! Set the solver type if (check_for_node(doc, "solver")) & - call get_node_value(doc, "solver", cmfd_solver_type) + call get_node_value(doc, "solver", cmfd_solver_type) ! Set monitoring if (check_for_node(doc, "snes_monitor")) then call get_node_value(doc, "snes_monitor", temp_str) call lower_case(temp_str) if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') & - cmfd_snes_monitor = .true. + cmfd_snes_monitor = .true. end if if (check_for_node(doc, "ksp_monitor")) then call get_node_value(doc, "ksp_monitor", temp_str) call lower_case(temp_str) if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') & - cmfd_ksp_monitor = .true. + cmfd_ksp_monitor = .true. end if if (check_for_node(doc, "power_monitor")) then call get_node_value(doc, "power_monitor", temp_str) call lower_case(temp_str) if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') & - cmfd_power_monitor = .true. + cmfd_power_monitor = .true. end if ! Output logicals @@ -193,7 +193,7 @@ contains call get_node_value(doc, "write_matrices", temp_str) call lower_case(temp_str) if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') & - cmfd_write_matrices = .true. + cmfd_write_matrices = .true. end if ! Run an adjoint calc @@ -201,36 +201,36 @@ contains call get_node_value(doc, "run_adjoint", temp_str) call lower_case(temp_str) if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') & - cmfd_run_adjoint = .true. + cmfd_run_adjoint = .true. end if ! Batch to begin cmfd if (check_for_node(doc, "begin")) & - call get_node_value(doc, "begin", cmfd_begin) + call get_node_value(doc, "begin", cmfd_begin) ! Tally during inactive batches if (check_for_node(doc, "inactive")) then call get_node_value(doc, "inactive", temp_str) call lower_case(temp_str) if (trim(temp_str) == 'false' .or. trim(temp_str) == '0') & - cmfd_tally_on = .false. + cmfd_tally_on = .false. end if ! Inactive batch flush window if (check_for_node(doc, "inactive_flush")) & - call get_node_value(doc, "inactive_flush", cmfd_inact_flush(1)) + call get_node_value(doc, "inactive_flush", cmfd_inact_flush(1)) if (check_for_node(doc, "num_flushes")) & - call get_node_value(doc, "num_flushes", cmfd_inact_flush(2)) + call get_node_value(doc, "num_flushes", cmfd_inact_flush(2)) ! Last flush before active batches if (check_for_node(doc, "active_flush")) & - call get_node_value(doc, "active_flush", cmfd_act_flush) + call get_node_value(doc, "active_flush", cmfd_act_flush) ! Get display if (check_for_node(doc, "display")) & - call get_node_value(doc, "display", cmfd_display) + call get_node_value(doc, "display", cmfd_display) if (trim(cmfd_display) == 'dominance' .and. & - trim(cmfd_solver_type) /= 'power') then + trim(cmfd_solver_type) /= 'power') then message = 'Dominance Ratio only aviable with power iteration solver' call warning() cmfd_display = '' @@ -238,17 +238,17 @@ contains ! Read in spectral radius estimate and tolerances if (check_for_node(doc, "spectral")) & - call get_node_value(doc, "spectral", cmfd_spectral) + call get_node_value(doc, "spectral", cmfd_spectral) if (check_for_node(doc, "shift")) & - call get_node_value(doc, "shift", cmfd_shift) + call get_node_value(doc, "shift", cmfd_shift) if (check_for_node(doc, "ktol")) & - call get_node_value(doc, "ktol", cmfd_ktol) + call get_node_value(doc, "ktol", cmfd_ktol) if (check_for_node(doc, "stol")) & - call get_node_value(doc, "stol", cmfd_stol) + call get_node_value(doc, "stol", cmfd_stol) if (check_for_node(doc, "atoli")) & - call get_node_value(doc, "atoli", cmfd_atoli) + call get_node_value(doc, "atoli", cmfd_atoli) if (check_for_node(doc, "rtoli")) & - call get_node_value(doc, "rtoli", cmfd_rtoli) + call get_node_value(doc, "rtoli", cmfd_rtoli) ! Create tally objects call create_cmfd_tally(doc) @@ -421,7 +421,7 @@ contains call get_node_value(doc, "reset", temp_str) call lower_case(temp_str) if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') & - t % reset = .true. + t % reset = .true. end if ! Set up mesh filter From 736f236a284d6d2cda9f6318b6a80dfeac85467d Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Wed, 10 Sep 2014 09:36:46 -0400 Subject: [PATCH 36/95] remove commented out code --- src/cmfd_solver.F90 | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/cmfd_solver.F90 b/src/cmfd_solver.F90 index 11989ff4f6..9a2ebceb1b 100644 --- a/src/cmfd_solver.F90 +++ b/src/cmfd_solver.F90 @@ -429,7 +429,6 @@ contains ! Check convergence err = sqrt(sum(((tmpx % val - x % val)/tmpx % val)**2)/n) its = igs -!print *, igs, err, w if (err < tol) exit ! Calculation new overrelaxation parameter @@ -569,8 +568,6 @@ contains ! Check convergence err = sqrt(sum(((tmpx % val - x % val)/tmpx % val)**2)/n) its = igs -!print *, igs, err, w -!read * if (err < tol) exit ! Calculation new overrelaxation parameter From 2c98fd3d6e486c916dc099a1ebfaafced0199940 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Tue, 15 Apr 2014 17:26:45 -0400 Subject: [PATCH 37/95] added capability for more than 2 groups --- src/cmfd_solver.F90 | 105 +++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 99 insertions(+), 6 deletions(-) diff --git a/src/cmfd_solver.F90 b/src/cmfd_solver.F90 index 11989ff4f6..dd343d87fc 100644 --- a/src/cmfd_solver.F90 +++ b/src/cmfd_solver.F90 @@ -132,7 +132,7 @@ contains guess = ONE phi_n % val = guess phi_o % val = guess - k_n = keff + k_n = keff k_o = k_n dw = cmfd_shift k_s = k_o + dw @@ -162,10 +162,9 @@ contains case(1) cmfd_linsolver => cmfd_linsolver_1g case(2) - cmfd_linsolver => cmfd_linsolver_2g + cmfd_linsolver => cmfd_linsolver_ng case default - message = 'Must use PETSc for more than 2 groups' - call fatal_error() + cmfd_linsolver => cmfd_linsolver_ng end select ! Set tolerances @@ -306,7 +305,7 @@ contains subroutine convergence(iter, innerits) - use constants, only: ONE, TINY_BIT + use constants, only: ONE, ZERO use global, only: cmfd_power_monitor, master use, intrinsic :: ISO_FORTRAN_ENV @@ -320,7 +319,7 @@ contains kerr = abs(k_o - k_n)/k_n ! Calculate max error in source - where (s_n % val > TINY_BIT) + where (s_n % val > ZERO) serr_v % val = ((s_n % val - s_o % val)/s_n % val)**2 end where serr = sqrt(ONE/dble(s_n % n) * sum(serr_v % val)) @@ -582,6 +581,100 @@ contains end subroutine cmfd_linsolver_2g +!=============================================================================== +! CMFD_LINSOLVER_ng solves the CMFD linear system +!=============================================================================== + + subroutine cmfd_linsolver_ng(A, b, x, tol, its) + + use constants, only: ONE, ZERO + use global, only: cmfd, cmfd_spectral + + type(Matrix) :: A ! coefficient matrix + type(Vector) :: b ! right hand side vector + type(Vector) :: x ! unknown vector + real(8) :: tol ! tolerance on final error + integer :: its ! number of inner iterations + + integer :: g ! group index + integer :: i ! loop counter for x + integer :: j ! loop counter for y + integer :: k ! loop counter for z + integer :: n ! total size of vector + integer :: nx ! maximum dimension in x direction + integer :: ny ! maximum dimension in y direction + integer :: nz ! maximum dimension in z direction + integer :: ng ! number of energy groups + integer :: igs ! Gauss-Seidel iteration counter + integer :: irow ! row iteration + integer :: icol ! iteration counter over columns + integer :: didx ! index for diagonal component + logical :: found ! did we find col + real(8) :: tmp1 ! temporary sum g1 + real(8) :: x1 ! new g1 value of x + real(8) :: err ! error in convergence of solution + real(8) :: w ! overrelaxation parameter + type(Vector) :: tmpx ! temporary solution vector + + ! Set overrelaxation parameter + w = ONE + + ! Dimensions + ng = 1 + nx = cmfd % indices(1) + ny = cmfd % indices(2) + nz = cmfd % indices(3) + n = A % n + + ! Perform Gauss Seidel iterations + GS: do igs = 1, 10000 + + ! Copy over x vector + call tmpx % copy(x) + + ! Begin loop around matrix rows + ROWS: do irow = 1, n + + ! Get spatial location + call matrix_to_indices(irow, g, i, j, k, ng, nx, ny, nz) + + ! Get the index of the diagonals for both rows + call A % search_indices(irow, irow, didx, found) + + ! Perform temporary sums, first do left of diag block, then right of diag block + tmp1 = ZERO + do icol = A % get_row(irow), didx - 1 + tmp1 = tmp1 + A % val(icol)*x % val(A % get_col(icol)) +! print *,A % val(icol),x % val(A % get_col(icol)) + end do + do icol = didx + 1, A % get_row(irow + 1) - 1 + tmp1 = tmp1 + A % val(icol)*x % val(A % get_col(icol)) +! print *,A % val(icol),x % val(A % get_col(icol)) + end do + + ! Solve for new x + x1 = (b % val(irow) - tmp1)/A % val(didx) +!print *, irow, b % val(irow), tmp1, A % val(didx), x1 + ! Perform overrelaxation + x % val(irow) = (ONE - w)*x % val(irow) + w*x1 +!stop + end do ROWS + + ! Check convergence + err = sqrt(sum(((tmpx % val - x % val)/tmpx % val)**2)/n) + its = igs + + if (err < tol) exit + + ! Calculation new overrelaxation parameter + w = ONE/(ONE - 0.25_8*cmfd_spectral*w) + + end do GS + + call tmpx % destroy() + + end subroutine cmfd_linsolver_ng + !=============================================================================== ! EXTRACT_RESULTS takes results and puts them in CMFD global data object !=============================================================================== From b93de8ffc6f3f9fa10c54fce4ba5ec8fc6db4836 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Tue, 15 Apr 2014 17:29:39 -0400 Subject: [PATCH 38/95] use zero --- src/cmfd_power_solver.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/cmfd_power_solver.F90 b/src/cmfd_power_solver.F90 index 65b60bc891..f80c122b71 100644 --- a/src/cmfd_power_solver.F90 +++ b/src/cmfd_power_solver.F90 @@ -242,7 +242,7 @@ contains subroutine convergence(iter) - use constants, only: ONE, TINY_BIT + use constants, only: ONE, ZERO use global, only: cmfd_power_monitor, master use, intrinsic :: ISO_FORTRAN_ENV @@ -255,7 +255,7 @@ contains kerr = abs(k_o - k_n)/k_n ! Calculate max error in source - where (s_n % val > TINY_BIT) + where (s_n % val > ZERO) serr_v % val = ((s_n % val - s_o % val)/s_n % val)**2 end where serr = sqrt(ONE/dble(s_n % n) * sum(serr_v % val)) From 55d105cf68c881d94121906b0ca21e0eec4d74df Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Fri, 18 Apr 2014 10:02:19 -0400 Subject: [PATCH 39/95] fixed using more than 2 groups --- src/cmfd_execute.F90 | 28 ++++++---------------------- 1 file changed, 6 insertions(+), 22 deletions(-) diff --git a/src/cmfd_execute.F90 b/src/cmfd_execute.F90 index fe19bd95b7..645722e618 100644 --- a/src/cmfd_execute.F90 +++ b/src/cmfd_execute.F90 @@ -291,7 +291,6 @@ contains logical :: in_mesh ! source site is inside mesh type(StructuredMesh), pointer :: m ! point to mesh - real(8), allocatable :: egrid(:) ! energy grid ! Associate pointer m => meshes(n_user_meshes + 1) @@ -312,19 +311,16 @@ contains cmfd % weightfactors = ONE end if - ! Allocate energy grid and reverse cmfd energy grid - if (.not. allocated(egrid)) allocate(egrid(ng + 1)) - egrid = (/(cmfd % egrid(ng - i + 2), i = 1, ng + 1)/) - ! Compute new weight factors if (new_weights) then ! Zero out weights - cmfd%weightfactors = ZERO + cmfd%weightfactors = ONE - ! Count bank sites in mesh - call count_bank_sites(m, source_bank, cmfd%sourcecounts, egrid, & + ! Count bank sites in mesh and reverse due to egrid structure + call count_bank_sites(m, source_bank, cmfd%sourcecounts, cmfd % egrid, & sites_outside=outside, size_bank=work) + cmfd % sourcecounts = cmfd%sourcecounts(ng:1:-1,:,:,:) ! Check for sites outside of the mesh if (master .and. outside) then @@ -338,25 +334,16 @@ contains cmfd % weightfactors = cmfd % cmfd_src/sum(cmfd % cmfd_src)* & sum(cmfd % sourcecounts) / cmfd % sourcecounts end where -#ifdef CMFD_DEBUG - open(file='source_bank_' // trim(to_str(current_batch)) // '.dat', unit=101) - do i = 1, nx - do j = 1,ny - write(101,*) cmfd % sourcecounts(1,i,j,1) - end do - end do - close(101) -#endif end if -if (.not. cmfd_feedback) return + if (.not. cmfd_feedback) return ! Broadcast weight factors to all procs #ifdef MPI call MPI_BCAST(cmfd % weightfactors, ng*nx*ny*nz, MPI_REAL8, 0, & MPI_COMM_WORLD, mpi_err) #endif - end if + end if ! begin loop over source bank do i = 1, int(work,4) @@ -393,9 +380,6 @@ if (.not. cmfd_feedback) return end do - ! Deallocate all - if (allocated(egrid)) deallocate(egrid) - end subroutine cmfd_reweight !=============================================================================== From 47d2fe37ba4598620c1c3134d430d2701e3eed9c Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Fri, 18 Apr 2014 10:06:34 -0400 Subject: [PATCH 40/95] switch back to 2g solver --- src/cmfd_solver.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cmfd_solver.F90 b/src/cmfd_solver.F90 index dd343d87fc..8567bd7636 100644 --- a/src/cmfd_solver.F90 +++ b/src/cmfd_solver.F90 @@ -162,7 +162,7 @@ contains case(1) cmfd_linsolver => cmfd_linsolver_1g case(2) - cmfd_linsolver => cmfd_linsolver_ng + cmfd_linsolver => cmfd_linsolver_2g case default cmfd_linsolver => cmfd_linsolver_ng end select From b347c46018ddbd8c3903fac2d475ffa4dbd8c82c Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Wed, 10 Sep 2014 10:00:15 -0400 Subject: [PATCH 41/95] cleaned up code --- src/cmfd_data.F90 | 37 +++++++++++++++++++------------------ src/cmfd_execute.F90 | 3 +-- src/cmfd_input.F90 | 1 + src/cmfd_solver.F90 | 10 ++++++---- src/constants.F90 | 3 --- src/global.F90 | 6 +++--- 6 files changed, 30 insertions(+), 30 deletions(-) diff --git a/src/cmfd_data.F90 b/src/cmfd_data.F90 index dc5db8352c..ef637b4c0b 100644 --- a/src/cmfd_data.F90 +++ b/src/cmfd_data.F90 @@ -20,7 +20,8 @@ contains use cmfd_header, only: allocate_cmfd use constants, only: CMFD_NOACCEL - use global, only: cmfd, cmfd_coremap, cmfd_downscatter + use global, only: cmfd, cmfd_coremap, cmfd_downscatter, & + cmfd_fix_balance ! Check for core map and set it up if ((cmfd_coremap) .and. (cmfd%mat_dim == CMFD_NOACCEL)) call set_coremap() @@ -57,12 +58,16 @@ contains ONE, TINY_BIT use error, only: fatal_error use global, only: cmfd, message, n_cmfd_tallies, cmfd_tallies, meshes,& - matching_bins, current_batch + matching_bins use mesh, only: mesh_indices_to_bin use mesh_header, only: StructuredMesh use string, only: to_str use tally_header, only: TallyObject +#ifdef CMFD_DEBUG + use global, only: current_batch +#endif + integer :: nx ! number of mesh cells in x direction integer :: ny ! number of mesh cells in y direction integer :: nz ! number of mesh cells in z direction @@ -72,7 +77,6 @@ contains integer :: k ! iteration counter for z integer :: g ! iteration counter for g integer :: h ! iteration counter for outgoing groups - integer :: l ! iteration counter for leakage debug integer :: ital ! tally object index integer :: ijk(3) ! indices for mesh cell integer :: score_index ! index to pull from tally object @@ -82,10 +86,13 @@ contains integer :: i_filter_eout ! index for outgoing energy filter integer :: i_filter_surf ! index for surface filter real(8) :: flux ! temp variable for flux - real(8) :: leak1 ! group 1 leakage - real(8) :: leak2 ! group 2 leakage type(TallyObject), pointer :: t => null() ! pointer for tally object type(StructuredMesh), pointer :: m => null() ! pointer for mesh object +#ifdef CMFD_DEBUG + integer :: l ! iteration counter for leakage debug + real(8) :: leak1 ! group 1 leakage + real(8) :: leak2 ! group 2 leakage +#endif ! Extract spatial and energy indices from object nx = cmfd % indices(1) @@ -709,9 +716,12 @@ contains subroutine compute_dhat() use constants, only: CMFD_NOACCEL, ZERO - use global, only: cmfd, cmfd_coremap, message, dhat_reset, current_batch + use global, only: cmfd, cmfd_coremap, message, dhat_reset use output, only: write_message use string, only: to_str +#ifdef CMFD_DEBUG + use global, only: current_batch +#endif integer :: nx ! maximum number of cells in x direction integer :: ny ! maximum number of cells in y direction @@ -869,8 +879,8 @@ contains function get_reflector_albedo(l, g, i, j, k) - use constants, only: ALBEDO_REJECT - use global, only: cmfd, cmfd_hold_weights + use constants, only: ONE + use global, only: cmfd real(8) :: get_reflector_albedo ! reflector albedo integer, intent(in) :: i ! iteration counter for x @@ -892,8 +902,7 @@ contains ! Calculate albedo if ((shift_idx == 1 .and. current(2*l ) < 1.0e-10_8) .or. & (shift_idx == -1 .and. current(2*l-1) < 1.0e-10_8)) then - albedo = ALBEDO_REJECT - cmfd_hold_weights = .true. + albedo = ONE else albedo = (current(2*l-1)/current(2*l))**(shift_idx) end if @@ -958,8 +967,6 @@ contains keff_bal = cmfd % keff_bal - print *, 'KEFF BALANCE is:', keff_bal - ! Return if not two groups if (ng /= 2) return @@ -1007,12 +1014,6 @@ contains nsigf12 = cmfd % nfissxs(1,2,i,j,k) nsigf22 = cmfd % nfissxs(2,2,i,j,k) - ! Check for no fission into group 2 - if (.not.(nsigf12 < 1e-6_8 .and. nsigf22 < 1e-6_8)) then - write(OUTPUT_UNIT,'(A,1PE11.4,1X,1PE11.4)') 'Fission in G=2', & - nsigf12,nsigf22 - end if - ! Compute absorption xs siga1 = sigt1 - sigs11 - sigs12 siga2 = sigt2 - sigs22 - sigs21 diff --git a/src/cmfd_execute.F90 b/src/cmfd_execute.F90 index 645722e618..7aee715ebe 100644 --- a/src/cmfd_execute.F90 +++ b/src/cmfd_execute.F90 @@ -84,7 +84,7 @@ contains use global, only: cmfd_begin, cmfd_on, & cmfd_reset, cmfd_run, & - current_batch, cmfd_hold_weights + current_batch ! Check to activate CMFD diffusion and possible feedback ! this guarantees that when cmfd begins at least one batch of tallies are @@ -283,7 +283,6 @@ contains integer :: nz ! maximum number of cells in z direction integer :: ng ! maximum number of energy groups integer :: i ! iteration counter - integer :: j ! iteration counter integer :: ijk(3) ! spatial bin location integer :: e_bin ! energy bin of source particle integer :: n_groups ! number of energy groups diff --git a/src/cmfd_input.F90 b/src/cmfd_input.F90 index 0523325c9a..32625034c3 100644 --- a/src/cmfd_input.F90 +++ b/src/cmfd_input.F90 @@ -66,6 +66,7 @@ contains use xml_interface use, intrinsic :: ISO_FORTRAN_ENV + integer :: i integer :: ng integer, allocatable :: iarray(:) integer, allocatable :: int_array(:) diff --git a/src/cmfd_solver.F90 b/src/cmfd_solver.F90 index 8567bd7636..45bc918a14 100644 --- a/src/cmfd_solver.F90 +++ b/src/cmfd_solver.F90 @@ -102,9 +102,8 @@ contains use constants, only: ONE, ZERO use error, only: fatal_error - use global, only: cmfd, message, cmfd_shift, keff, & - cmfd_ktol, cmfd_stol - use global, only: cmfd_write_matrices + use global, only: cmfd, cmfd_shift, keff, cmfd_ktol, cmfd_stol, & + cmfd_write_matrices logical :: adjoint @@ -180,10 +179,13 @@ contains subroutine compute_adjoint() use error, only: fatal_error +#ifndef PETSC use global, only: message -#ifdef PETSC +#else use global, only: cmfd_write_matrices +#endif +#ifdef PETSC ! Transpose matrices call loss % transpose() call prod % transpose() diff --git a/src/constants.F90 b/src/constants.F90 index 0d52e8e811..f7d419eaac 100644 --- a/src/constants.F90 +++ b/src/constants.F90 @@ -392,9 +392,6 @@ module constants ! constant to represent a zero flux "albedo" real(8), parameter :: ZERO_FLUX = 999.0_8 - ! constant to represent albedo rejection - real(8), parameter :: ALBEDO_REJECT = 999.0_8 - ! constant for writing out no residual real(8), parameter :: CMFD_NORES = 99999.0_8 diff --git a/src/global.F90 b/src/global.F90 index 3b9b8bfeea..e2509ce1a7 100644 --- a/src/global.F90 +++ b/src/global.F90 @@ -325,6 +325,9 @@ module global ! Flag to reset dhats to zero logical :: dhat_reset = .false. + ! Flag to enforce neutron balance + logical :: cmfd_fix_balance = .false. + ! Flag to activate neutronic feedback via source weights logical :: cmfd_feedback = .false. @@ -332,9 +335,6 @@ module global integer :: n_cmfd_meshes = 1 ! # of structured meshes integer :: n_cmfd_tallies = 3 ! # of user-defined tallies - ! Flag to hold cmfd weight adjustment factors - logical :: cmfd_hold_weights = .false. - ! Eigenvalue solver type character(len=10) :: cmfd_solver_type = 'power' From 7c567e197a14159a8a687180a7a440e88df5382e Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Wed, 10 Sep 2014 15:06:21 -0400 Subject: [PATCH 42/95] added cmfd section to theory which includes notation section --- docs/source/methods/cmfd.rst | 38 +++++++++++++++++++++++++++++++++++ docs/source/methods/index.rst | 1 + 2 files changed, 39 insertions(+) create mode 100644 docs/source/methods/cmfd.rst diff --git a/docs/source/methods/cmfd.rst b/docs/source/methods/cmfd.rst new file mode 100644 index 0000000000..d837048f37 --- /dev/null +++ b/docs/source/methods/cmfd.rst @@ -0,0 +1,38 @@ +.. _methods_cmfd: + +================================================================ +Nonlinear Diffusion Acceleration - Coarse Mesh Finite Difference +================================================================ + +This page section discusses how nonlinear diffusion acceleration (NDA) using coarse mesh finite difference (CMFD) is implemented into OpenMC. Before we get into the theory, general notation for this section is discussed. + +-------- +Notation +-------- + +Before deriving NDA relationships, notation is explained. If a parameter has a +:math:`\overline{\cdot}`, it is surface area-averaged and if it has a +:math:`\overline{\overline\cdot}`, it is volume-averaged. When describing a +specific cell in the geometry, indices :math:`(i,j,k)` are used which correspond +to directions :math:`(x,y,z)`. In most cases, the same operation is performed in +all three directions. To compactly write this, an arbitrary direction set +:math:`(u,v,w)` that corresponds to cell indices :math:`(l,m,n)` is used. Note +that :math:`u` and :math:`l` do not have to correspond to :math:`x` and +:math:`i`. However, if :math:`u` and :math:`l` correspond to :math:`y` and +:math:`j`, :math:`v` and :math:`w` correspond to :math:`x` and :math:`z` +directions. An example of this is shown in the following expression: + +.. math:: + :label: not1 + + \sum\limits_{u\in(x,y,z)}\left\langle\overline{J}^{u,g}_{l+1/2,m,n} + \Delta_m^v\Delta_n^w\right\rangle + +Here, :math:`u` takes on each direction one at a time. The parameter :math:`J` +is surface area-averaged over the transverse indices :math:`m` and :math:`n` +located at :math:`l+1/2`. Usually, spatial indices are listed as subscripts and +the direction as a superscript. Energy group indices represented by :math:`g` +and :math:`h` are also listed as superscripts here. The group :math:`g` is the +group of interest and, if present, :math:`h` is all groups. Finally, any +parameter surrounded by :math:`\left\langle\cdot\right\rangle` represents a +tally quantity that can be edited from an MC solution. diff --git a/docs/source/methods/index.rst b/docs/source/methods/index.rst index 0ff4fb1988..1df4f324a3 100644 --- a/docs/source/methods/index.rst +++ b/docs/source/methods/index.rst @@ -16,3 +16,4 @@ Theory and Methodology tallies eigenvalue parallelization + cmfd From ce56ee4583860b56a459667ea72027da63f700e9 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Wed, 10 Sep 2014 16:28:52 -0400 Subject: [PATCH 43/95] added support for tikz extension in sphinx and included first part of theory section --- docs/source/conf.py | 11 ++- docs/source/methods/cmfd.rst | 75 ++++++++++++++++++++ docs/source/methods/cmfd_tikz/cmfd_flow.tikz | 19 +++++ 3 files changed, 103 insertions(+), 2 deletions(-) create mode 100644 docs/source/methods/cmfd_tikz/cmfd_flow.tikz diff --git a/docs/source/conf.py b/docs/source/conf.py index 1943432165..16be3567d0 100644 --- a/docs/source/conf.py +++ b/docs/source/conf.py @@ -23,7 +23,7 @@ sys.path.insert(0, os.path.abspath('../sphinxext')) # Add any Sphinx extension module names here, as strings. They can be extensions # coming with Sphinx (named 'sphinx.ext.*') or your custom ones. -extensions = ['sphinx.ext.pngmath'] +extensions = ['sphinx.ext.pngmath', 'sphinxcontrib.tikz'] # Add any paths that contain templates here, relative to this directory. templates_path = ['_templates'] @@ -188,7 +188,14 @@ latex_documents = [ u'Massachusetts Institute of Technology', 'manual'), ] -latex_elements = {'preamble': '\\usepackage{enumitem}\\setlistdepth{9}'} +latex_elements = { +'preamble': ''' +\usepackage{enumitem} +\setlistdepth{9} +\usepackage{tikz} +\usetikzlibrary{shapes,snakes,shadows,arrows,calc,decorations.markings,patterns,fit,matrix,spy} +''' +} # The name of an image file (relative to this directory) to place at the top of # the title page. diff --git a/docs/source/methods/cmfd.rst b/docs/source/methods/cmfd.rst index d837048f37..3953825b27 100644 --- a/docs/source/methods/cmfd.rst +++ b/docs/source/methods/cmfd.rst @@ -36,3 +36,78 @@ and :math:`h` are also listed as superscripts here. The group :math:`g` is the group of interest and, if present, :math:`h` is all groups. Finally, any parameter surrounded by :math:`\left\langle\cdot\right\rangle` represents a tally quantity that can be edited from an MC solution. + +------ +Theory +------ + +NDA is a diffusion model that has equivalent physics to a transport model. There +are many different methods that can be classified as NDA. The CMFD method is a +type of NDA that represents second order multigroup diffusion equations on a +coarse spatial mesh. Whether a transport model or diffusion model is used to +represent the distribution of neutrons, these models must satisfy the *neutron +balance equation*. This balance is represented by the following formula for a +specific energy group :math:`g` in cell :math:`(l,m,n)`: + +.. math:: + :label: eq_neut_bal + + \sum\limits_{u\in(x,y,z)}\left(\left\langle\overline{J}^{u,g}_{l+1/2,m,n} + \Delta_m^v\Delta_n^w\right\rangle - + \left\langle\overline{J}^{u,g}_{l-1/2,m,n} + \Delta_m^v\Delta_n^w\right\rangle\right) + + + \left\langle\overline{\overline\Sigma}_{t_{l,m,n}}^g + \overline{\overline\phi}_{l,m,n}^g\Delta_l^u\Delta_m^v\Delta_n^w\right\rangle + = \\ + \sum\limits_{h=1}^G\left\langle + \overline{\overline{\nu_s\Sigma}}_{s_{l,m,n}}^{h\rightarrow + g}\overline{\overline\phi}_{l,m,n}^h\Delta_l^u\Delta_m^v\Delta_n^w + \right\rangle + + + \frac{1}{k_{eff}}\sum\limits_{h=1}^G + \left\langle\overline{\overline{\nu_f\Sigma}}_{f_{l,m,n}}^{h\rightarrow + g}\overline{\overline\phi}_{l,m,n}^h + \Delta_l^u\Delta_m^v\Delta_n^w\right\rangle. + +In eq. :eq:`eq_neut_bal` the parameters are defined as: + +* :math:`\left\langle\overline{J}^{u,g}_{l\pm + 1/2,m,n}\Delta_m^v\Delta_n^w\right\rangle` --- surface area-integrated net + current over surface :math:`(l\pm 1/2,m,n)` with surface normal in direction + $u$ in energy group :math:`g`. By dividing this quantity by the transverse + area, :math:`\Delta_m^v\Delta_n^w`, the surface area-averaged net current can + be computed. +* :math:`\left\langle\overline{\overline\Sigma}_{t_{l,m,n}}^g + \overline{\overline\phi}_{l,m,n}^g\Delta_l^u\Delta_m^v\Delta_n^w\right\rangle` + --- volume-integrated total reaction rate over energy group :math:`g`. + * :math:`\left\langle\overline{\overline{\nu_s\Sigma}}_{s_{l,m,n}}^{h\rightarrow + g} + \overline{\overline\phi}_{l,m,n}^h\Delta_l^u\Delta_m^v\Delta_n^w\right\rangle` + --- volume-integrated scattering production rate of neutrons that begin with + energy in group :math:`h` and exit reaction in group :math:`g`. This reaction + rate also includes the energy transfer of reactions (except fission) that + produce multiple neutrons such as (n, 2n); hence, the need for :math:`\nu_s` + to represent neutron multiplicity. +* :math:`k_{eff}` --- core multiplication factor. +* :math:`\left\langle\overline{\overline{\nu_f\Sigma}}_{f_{l,m,n}}^{h\rightarrow + g}\overline{\overline\phi}_{l,m,n}^h\Delta_l^u\Delta_m^v\Delta_n^w\right\rangle` + --- volume-integrated fission production rate of neutrons from fissions in + group :math:`h` that exit in group :math:`g`. + +Each quantity in :math:`\left\langle\cdot\right\rangle` represents a scalar value that +is obtained from an MC tally. A good verification step when using an MC is +to make sure that tallies satisfy this balance equation within statistics. No +NDA acceleration can be performed if the balance equation is not satisfied. + +There are three major steps to consider when performing NDA: (1) calculation of +macroscopic cross sections and nonlinear parameters, (2) solving an eigenvalue +problem with a system of linear equations, and (3) modifying MC source +distribution to align with the NDA solution on a chosen mesh. This process is +illustrated as a flow chart below. After a batch of neutrons +is simulated, NDA can take place. Each of the steps described above is described +in detail in the following sections. + +.. tikz:: Flow chart of NDA process + :libs: shapes, snakes, shadows, arrows, calc, decorations.markings, patterns, fit, matrix, spy + :include: cmfd_tikz/cmfd_flow.tikz diff --git a/docs/source/methods/cmfd_tikz/cmfd_flow.tikz b/docs/source/methods/cmfd_tikz/cmfd_flow.tikz new file mode 100644 index 0000000000..0611918052 --- /dev/null +++ b/docs/source/methods/cmfd_tikz/cmfd_flow.tikz @@ -0,0 +1,19 @@ +\begin{tikzpicture} + \matrix[every node/.style={draw, thick, minimum width=3cm, minimum height=1cm, align=center}, column sep=2cm, row sep=1cm] (m) { +\node[draw, fill=red!40] (start) {Batch $i$ \\ tally NDA}; & \\ + \node[draw, diamond, aspect=2, fill=green!40] (cmfd) {Run NDA?}; & \node[draw, fill=red!40] (end) {Batch $i + 1$ \\ tally NDA}; \\ +\node[draw, fill=blue!40] (xs) {Calculate XS \& DC}; & \node[draw, fill=blue!40] (modify) {Modify MC Source}; \\ +\node[draw, fill=blue!40] (nonlinear) {Calculate Equivalence}; & \node[draw, fill=blue!40] (eqs) {Solve NDA eqs.};\\ +}; + +\begin{scope}[every path/.style={->,very thick,draw}] + \draw (start.south) -- (cmfd.north); + \draw (cmfd.east) -- node[above] {no} (end.west); + \draw (cmfd.south) -- node[right] {yes} (xs.north); + \draw (xs.south) -- (nonlinear.north); + \draw (nonlinear.east) -- (eqs.west); + \draw (eqs.north) -- (modify.south); + \draw (modify.north) -- (end.south); + \end{scope} + +\end{tikzpicture} \ No newline at end of file From 04eb1e0653e7a9bb14faa7cf3fd93f6e8b349736 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Wed, 10 Sep 2014 16:41:24 -0400 Subject: [PATCH 44/95] added calc of macro xs section --- docs/source/methods/cmfd.rst | 93 +++++++++++++++++++++++++++++++++++- 1 file changed, 92 insertions(+), 1 deletion(-) diff --git a/docs/source/methods/cmfd.rst b/docs/source/methods/cmfd.rst index 3953825b27..09f1328bfb 100644 --- a/docs/source/methods/cmfd.rst +++ b/docs/source/methods/cmfd.rst @@ -4,7 +4,9 @@ Nonlinear Diffusion Acceleration - Coarse Mesh Finite Difference ================================================================ -This page section discusses how nonlinear diffusion acceleration (NDA) using coarse mesh finite difference (CMFD) is implemented into OpenMC. Before we get into the theory, general notation for this section is discussed. +This page section discusses how nonlinear diffusion acceleration (NDA) using +coarse mesh finite difference (CMFD) is implemented into OpenMC. Before we get +into the theory, general notation for this section is discussed. -------- Notation @@ -111,3 +113,92 @@ in detail in the following sections. .. tikz:: Flow chart of NDA process :libs: shapes, snakes, shadows, arrows, calc, decorations.markings, patterns, fit, matrix, spy :include: cmfd_tikz/cmfd_flow.tikz + +Calculation of Macroscopic Cross Sections +----------------------------------------- + +A diffusion model needs macroscopic cross sections and diffusion coefficients to +solve for multigroup fluxes. Cross sections are derived by conserving reaction +rates predicted by MC tallies. From Eq. :eq:`eq_neut_bal`, total, scattering +production and fission production macroscopic cross sections are needed. They are +defined from MC tallies as follows: + +.. math:: + :label: xs1 + + \overline{\overline\Sigma}_{t_{l,m,n}}^g \equiv + \frac{\left\langle\overline{\overline\Sigma}_{t_{l,m,n}}^g + \overline{\overline\phi}_{l,m,n}^g\Delta_l^u\Delta_m^v\Delta_n^w\right\rangle} + {\left\langle\overline{\overline\phi}_{l,m,n}^g + \Delta_l^u\Delta_m^v\Delta_n^w\right\rangle}, + +.. math:: + :label: xs2 + + \overline{\overline{\nu_s\Sigma}}_{s_{l,m,n}}^{h\rightarrow g} \equiv + \frac{\left\langle\overline{\overline{\nu_s\Sigma}}_{s_{l,m,n}}^{h\rightarrow + g}\overline{\overline\phi}_{l,m,n}^h\Delta_l^u\Delta_m^v\Delta_n^w\right\rangle} + {\left\langle\overline{\overline\phi}_{l,m,n}^h + \Delta_l^u\Delta_m^v\Delta_n^w\right\rangle} + +and + +.. math:: + :label: xs3 + + \overline{\overline{\nu_f\Sigma}}_{f_{l,m,n}}^{h\rightarrow g} \equiv + \frac{\left\langle\overline{\overline{\nu_f\Sigma}}_{f_{l,m,n}}^{h\rightarrow + g}\overline{\overline\phi}_{l,m,n}^h\Delta_l^u\Delta_m^v\Delta_n^w\right\rangle} + {\left\langle\overline{\overline\phi}_{l,m,n}^h\Delta_l^u\Delta_m^v\Delta_n^w\right\rangle}. + +In order to fully conserve neutron balance, leakage rates also need to be +preserved. In standard diffusion theory, leakage rates are represented by +diffusion coefficients. Unfortunately, it is not easy in MC to calculate a +single diffusion coefficient for a cell that describes leakage out of each +surface. Luckily, it does not matter what definition of diffusion coefficient is +used because nonlinear equivalence parameters will correct for this +inconsistency. However, depending on the diffusion coefficient definition +chosen, different convergence properties of NDA equations are observed. +Here, we introduce a diffusion coefficient that is derived for a coarse energy +transport reaction rate. This definition can easily be constructed from +MC tallies provided that angular moments of scattering reaction rates can +be obtained. The diffusion coefficient is defined as follows: + +.. math:: + :label: eq_transD + + \overline{\overline D}_{l,m,n}^g = + \frac{\left\langle\overline{\overline\phi}_{l,m,n}^g + \Delta_l^u\Delta_m^v\Delta_n^w\right\rangle}{3 + \left\langle\overline{\overline\Sigma}_{tr_{l,m,n}}^g + \overline{\overline\phi}_{l,m,n}^g + \Delta_l^u\Delta_m^v\Delta_n^w\right\rangle}, + +where + +.. math:: + :label: xs4 + + \left\langle\overline{\overline\Sigma}_{tr_{l,m,n}}^g + \overline{\overline\phi}_{l,m,n}^g\Delta_l^u\Delta_m^v\Delta_n^w\right\rangle + = + \left\langle\overline{\overline\Sigma}_{t_{l,m,n}}^g + \overline{\overline\phi}_{l,m,n}^g\Delta_l^u\Delta_m^v\Delta_n^w\right\rangle + \\ - + \left\langle\overline{\overline{\nu_s\Sigma}}_{s1_{l,m,n}}^g + \overline{\overline\phi}_{l,m,n}^g\Delta_l^u\Delta_m^v\Delta_n^w\right\rangle. + +Note that the transport reaction rate is calculated from the total reaction rate +reduced by the $P_1$ scattering production reaction rate. Equation :eq:`eq_transD` +does not represent the best definition of diffusion coefficients from MC; +however, it is very simple and usually fits into MC tally frameworks +easily. Different methods to calculate more accurate diffusion coefficients can +found in [Herman]_. + +---------- +References +---------- + +.. [Herman] Bryan R. Herman, Benoit Forget, Kord Smith, and Brian N. Aviles. Improved + diffusion coefficients generated from Monte Carlo codes. In *Proceedings of M&C + 2013*, Sun Valley, ID, USA, May 5 - 9 2013. From 9f07c1bb184731880e93ae99028c38218cd3ddce Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Wed, 10 Sep 2014 21:55:22 -0400 Subject: [PATCH 45/95] added more content up to toy problem --- docs/source/_images/loss.png | Bin 0 -> 29146 bytes docs/source/_images/prod.png | Bin 0 -> 18894 bytes docs/source/methods/cmfd.rst | 353 +++++++++++- docs/source/methods/cmfd_tikz/meshfig.tikz | 628 +++++++++++++++++++++ 4 files changed, 980 insertions(+), 1 deletion(-) create mode 100644 docs/source/_images/loss.png create mode 100644 docs/source/_images/prod.png create mode 100644 docs/source/methods/cmfd_tikz/meshfig.tikz diff --git a/docs/source/_images/loss.png b/docs/source/_images/loss.png new file mode 100644 index 0000000000000000000000000000000000000000..37d4169a18bd6cb5719dffac3320fa78365c6fbe GIT binary patch literal 29146 zcmeFZcUV(t_bwbeD$NceO|hW}BS;Y;5gZFrl&XLfr3gqDq98>@5Jv<>L^`N|Ap)Wx zB|uO_suXEbLa2h2L~4W(@~yoCGw*wy-<? zE~c$FMHk*%a7C}&wBp>Rs4e^R-gVfV__ANEa#L#B0fPvlWJuHZl#*=*F`BwMUy?cr zazCZR7tVKz+s>7Tw2M3Dp6Tn+EazGKK{#Z1U-*u7_nt{lrb0yoXZ-F|4J?z1`~$)D2%~u6#IW4{=aiK z)VFs^n-|YF>FH=`YdcYkSq-N|efmNa=2*hZFu1+R#_26|dQ$7N$VfVwy-*z~Eqd&R z3v*^Hh*#Ka@~eWm_gIcHz3@Gix*dbbo>5^fte)$}E|jxx{HTeFH20lN3KCf-KL0(G z_1(K`GTv`inmv%JI!*BPbHHHg+hq(pu@jF&Z%q@;)Ac14%x;cml^4(CWcsj1%;|l2 zuvcO3E1}G`_qKR?*ClpUyoz^ioHC=u#CdweWI4vaHt>%;^L#h!%a>m)L<9#18>fGG z`?mgPX2`<;-Ji;S+u2?#vGb)=rOD9w)BUn5Ff#msS>-JGX8U9zwrP5xE}^uwt2jTu zu$CLcT_isGSVW>!pmXn@J!#GMtOM)UuTR#syLD?m#V@y~)J*bTbF(6~(T8!*$ovwv zGhfy;kAJX+vOgk_c8Ci*AtUffREc{)XY7>7YTy1hehM@N^-!KG#2OlfR2Q#e!mb+0 zB>UE>Fs@Mwj&uau=bV$gx9il-TRN%Q_Z}B8Ug$Q!`fx>-+_X^a!i{9zn*$L>ExZRJ zsw%_xCfw)^j+xJCXlTjAvaZLD7Qg!zMj8C^DdW-x?e&-voIruO%sqZMBL z>i(FOm8BlUd#Uiocukb7vghc~{I;{nx*dKOnKSp=+PJ8lDOx;Z3R&9Tr1^Dj0>2*z zedb?i^6j_mK1FMzCUXT&u}If{ev_>`Hu>$Ww3L*T%CC|Yby)U%5u?kyk!&CtVV|sf zmEn9ab+oJ1mmxlHo+o-!fV(GjN8m*2%r3qaShu=`Lw|O&s=Jj%8N3RfpVzf%wfT4* zja3!y$!_E6VSi#(lv;54^~*fP=D=5fKlYx%@4sU?>Pl~^(dCXx3TlR zvgaE;&rC!2O4^Sa42D~Q{6}SC&o)gxy`K5m59UWzMUG;Frnhb(P=zt4qYa~)2zk^D zH>FM=d`GkW5pDPCF9pnSos)`E7z`n6yehFwb^4L=r-%cNY&C60S{i8urj3x7s$Ev3 zJUMCE@!crlxwKky#b@9fLBqflZ6F&L-F5Tn((**asUcm>+)RDAP29)V$O=?MksIWX=#Gzxv0>~JC+#QIeJ#shwH4!kXG7;?lM?b* zL9Q$C?Gpa_;in%RJp(;xcNB z8zX-&mr5J%pH9`qufc5RY*%j8fQ)RTm!0+Qc8OE&HjoD&!Iv6l2uwy$TU-5v{st#7s?fGI^9KW=_;Ep<}GwKo6VH?Pmk90z2t&gr<2t;54d*oE&l zo;=kT>*<>1_}*K)&BsaGa}DP7qi)~oAA>@?k&!Q(De7F_j1M=m48g4r)fvRa$ikV3 zNg2l--WQ>fQ(5UUP&IdU1CyeB%-DlkETb&cvk|t_;{H!q07LpN{Z?m;$cxQ?kU}43 z3$Ia95!Oz4rGfXScLi+cuR!QaTqH~EB0o| z^u|Vc)*0}K*L=Mf9LyCdgRJ2A9p;#1q%RKLMaGr1oyXj&#PmjVrEFE2&Bx6Xb61gaNtE& z9jVBlHwSY*g;+Ue9J#hKQy)qJx& zUr83Cynd%%YH!yjpD0;bg>8rjL^L=5@Wq2M`p3VA2+-kUZ~miZhw2XA9rsA5}cM$lSfRI^EMq3XW@s z2O^Ou;D4QqMriEoau*sTo%)HFjug^1$uxAhs!I=qZ()3P<}uXsckJ2Q%D2mg5f#;P zHpe)%See5>^U$M3M3L9`+2Jz

y_5`|;->Rd0Ksw6w$*3m-~53oNn+P~xb}czAe6uCw1%!zt>GzK{#VdwPe0Dl4Z; zFSPl%Wlld%ISH1kN9qNuMjedjEuxiCGo`_yE&nk zFxNDw%E&(yX@*-9@zZf}7=7eQ9uM#PZBPecr z@rQ=Cre>3U&b@p04jFB#&nzGz{=y2kccDk>3KcD=BEBAqzRGWKzIR<#^7j7)pA}X& z*S1p*@b{dmN|ScCfh>*d*|IN#-yrRy4*(+Dy7+Xzf$3Ir@?gC82PaDVfW3xx+^`PW z`)OD@1SPS*^zSnJLa}B9eKP=EIi(uOZWH~Ld*g4sU^aiAN~Zca9f};y0DG=CBfKRm z5Ss1Tvsm^Z|0m~#AI>5wUQ@COvo#DqHiP~>t515Nj4Ysb!OX0Sgs0EX&wsqTru@qn zUg4wH$9v0UZEHurXT7X$=G91ku`p85_Xx>3Jt=}Aw^W(LcfIhL#7+|@bN8_ND2>esX0`~q|EY~&%8$r@SdqN#82 z&kDX{zvd_FsNVD~<(~5&5G2W0I+F&(%q}T1Cq;cE$Mft8F|J z_z2wW)wpXN-ZJ(o9O1X=iv*TLY-K%}> z2B(n3ZId#s`(};oJ;OEeJqYNQz9e#njj#qmz7N#kPR0SJ=qZv(#ERX`!a3^ zMobF=5()2(g0#=o2;IB zdn=?!ZUu-PhKUwQ`G-ZLEd(cU~3=E$W&sqN+j(#O()2x!xJ} z_Ze54A#ue=0V0Uqib?#nl9801MN>Vxy(inD&cHF%IAqg1h1w`2=W{Ph*B0b9w!NV3 zZj+MoX?D`l=*p3l7)T(3JjPE1RbhDt(QsC37o#uPFo%NIz+eDuck^`|z2@xRD9LIK z%&k2u2ypp_2~LdcN45u$30N?;6R6X zYOEk2)e;PVbc+i!1f{Q0Kefn6M5zDrRwC+Sa&PTwcrD+K?2RmzMFRv|f&-{wkvBtt z?JKbm%#e`1uit4`ilC>R$j=Bc2w>9mj%_x!yG;LtY%%QGQn{i#PM@~XZFK0Xgdj`7lV8QeOROk0?0%tzA% zYJdVWwQsu^q(}`Otzk+%owuZ3XhtGjbqn6hx2E<|G@41~RdbOW*1^N|E79jvY2Nkgp#~ zAT?EE&g|@4JbljcGrYrNTbu+y`pID0a*R6EF)Nr&+Tb_NZQnc}F{iF8`W*eV8|nyw zkL$U3&-pM=|Og1q4DGlVDlBC3~m}px^QlI&hpJD z3gDbcP!?|8y3;gyKdIclY?*)Y6D!?8R&`0aN(}6kPbFeJuXNz+B6zoOh!OdnF711o z?VmsA07CyeU_G!p&whQpsL*<&%nz3kh=F2NcKSjGy15vGXuC3{}LQC5#1rSUU2hkG?$&~hB{QT)McRhdzzZA9^ zwTvkP^Erenc)V*v#tZn7sW9|fH|-Xq*v{Aw>XagVdoao+?wFejaNYj#3UN9Bl;Qoav!26(Qi5QVP$ zIU4K%IoluKv)&f8*FP*y(O;LWn_asVDL8g)#`jHk-{o7NvYCF^`5r#14}$`KWYc$@ zdenJyFwV9%cD9So>f--2F)_hnP?780UBid)X!S|z&c(Ao95RbM2jlRb`R%uT>@$z> zTn+_56Y$ph?8rvn&q}hpcJbW11(zC9IJ4(w&WpLb*xz^OO6&X zu5$GZM4Fo^7rOL(8X6jUU#Hr^vS0J(LhF&Yv|`fMPjd-cF)!j~8xt}@9?8ev8q*_88Ury;Z^IPK?B%0SyQcw#o zK+xG=rF`UHpVm_{bq~TeuNA*F-`6uYy*2aHE%|V;bKJ2q9-3D1L_}r)zwc0x@71wi zqiyd2>143)sCduBD&uMCxn09<5uYmU0PcIf7sHMRD-I%A@V-Pyx9>nzg!%7#=Fj8f z7lIRh2Mc9t0{Zj&`uX#TbVHL17lzy-cG{uR05SND>!L1hI$#Bv562gL;BMN` zN7mf*2zE9cJB#eVd>nN)j#11gQZP$+{`|EeaoRlp?b~yb5nsy7Nv30OC`HRD^A9`I z-13v&@4ig-4mxw#-92fXA)9Mwoowmt(i;FS=e9G0J56m3BRM%a)OYHo`D~Su??|q% zgO^uvk6H`wj4Sn8%k7(@PgiAKku1QJNv6^#pmbi*z=F+yx)uel`QN#K)UEyUS4#8 zmbc3^|DEsi>z)bmys0{;fR4-FTluP%8F@R@yGQQcs8-CU4(C&fW8W|2dF6}^|Gshm zu#&##n#5d)xi{H|f4NG(NC}HG^b{3bJDu?Q!oV%e)jtuxchQmLk$SM$^ZMDdsV`h%D-#gB2znj;ICf7iW2S3Rn5wimqSzR`=F z&7a4Gpp@MSPQbq{&nbLIwJ5C5!7lx$1BgQa3Wk9hu}FwcD{i9jiSn-D<w3G_5|x4OeL1*t>4~M(nLVJ7r=RsS!mklihMeKmDYzYce?N!A z_)EUB0U|7lVZW#H-r+!yzH$@kKi@nel2+8OLemU)6l#!LZEVyCO_vF}!7d9&5Jbk0 z=6DYm$fA7W4<80R6Md3yq8yS~c><23gR^N#PnRJ2eTGBp(GcG{coP%&1U?1|m+JsCW#rJbDQs1gAiGKJIck%60RSp;aj-KFlmqzP;!$jlKmvpw5mZQ|Yu2<2 z;|OYJoLk=oA6R`4wbh}kB`8aXd&jv$vn8nWK)Le{oYTQW^2a6!NR^a`5VkXfQf)Ym zr)b&_GLg4HfpysCkHYWvMG8fm7#e;;c%?2m5*?vHfW}9-RsR4kTG)A@1aIbV^I&M~ zM$9=D>?&*>)FDIMS1xI@Xj-X`hf$ssHD`6m(y*_9RRNI<0)2kvNbW!A;1$j#s3Rwf zTC_$**4@3Q;xU)e#Y>K~sNioW`G6O4);#=c{T}1zoFdiG`B_uT@3u&py zqKysUxDszH#f#LOlrK}S-h021_rg3l1s69I95VhJlwZC66CvlqxX`Ws`HFxOaj4bQ zJD^>3A(_Shsp9l&_BBW%GWSu)r!E0p<^@LDvuaByRKHEQ#UiXwvjH4&VmG?Y13%oN z>BWA2&*ONcu)Z6x;ZO^4%c0)E-~45E3DUTqpAXdCZ|qSB#EC9axRqHV;9fFU5-lF3 zOpFuk5&G(LegLcv1-K8C`^AN(MUXrXitb4R)VrK!^mjQtyL19h&+Nyiw< z*<{5!gG(3fu2v)QY#+35-NGR_9vM4X$mtyww0F`GHp3^mdH;$y%g#q&5dkwSVB4+~ zAXh}<0$dR(7Li)kq%LahxQIUzQ#S{q*3wx#|Dz@w=(zwN=BLqX0cW95l;P*>l1{&Z zZ3@L576atg&1?i4pTnRA`YjzXWB}-&IUL=Qmivsyj|1)GA(HBXVWW9Kd4s0by~)8= zK0t^mjq_6;L~xzateW?b#al;{j%Ki1CE0l5I?OB@s3LyP>EeMN zka^0v9rNjAnprw@h;VM4-;@Sd>PM=E2g;jqWR8~|eIV3H21qm?LLOJ}1Q7KIUw8$w zYABBG467#}+9L<83>>@pYPq~$ISI(uJQY|rqzt> zHc)kG$ZnRFN&1o@p`rNv_KPI%RR!~ZBrR3deDA!|w`wFW<@cdYuGZ(asN_-K zdW^IHkH=uoC$Qgxp)+W3^DTZK|7j=ZR2%Gjrk6UAMrzINm7D#%cc`sGFlCYp$~<(~FpQ-#;{_p|3L} zlQGo!9|#={j3cX-K3{9TQ0=D_@V2n95PI~pv$IhDJPHW`!gHv%>@O&g+On>k0_(eR zZ5iu&xo}Ta1d!l$Htl5W4s4f~-AIdesAJWupKY4T_`vnsdSeCsO@Ii=$fHwjvCKB4 z5`shX`?c3^VlPw|^9`b`2J`tcbHoBdr1Sm_b_!YN2#ez9t|2rF+4uY1QIYW#)J4v- zL7TTk3d|H`1L78{3ABZ%x_}jHj6YB1iQe$Q|3ekTspT#DOV&GJP^?~g=!%N+WyQPI zKc%Fmmi}yninZkH65`T6kD{DwZ5y9GGcGifJhGDJ1ORdhNR5JC?TBUVRS>JVpqx5K zy!SOG##{l&=Q%BxAi04l)8-@WIrCg!*3VR=$&HX`zl6fM=kEj~g_I_j<+V4{2P@{i zY`{D#q9DoB%~z|^HlO!p(Z--k8h4Uxrt{XT1Ki23!u2i^4;#E~j_S7z{s4Xp$Sv5` zJoP#4xGEx*1$`ZooWi!H_DSdVkHV|ffHzcK7>9Eg)R70SY2Pt43(B}4G~ZN3 z>K+LBVzy{jc=7~-^q5FZHo)`55;W+R`UAJ%U zqaxP)Oh~Bjlrg2SeYacm@#bcjvzLTyEV-G-h+( zMzM!?6WvTQT@RPze9+oh~tfriGuioR;)przbNO1Rz0>DEly5UaOORGb{q)B zCF*?%@d%uNg#-EiJ5TmGkTz#*85bOM{4LZbh$T`lH^9>Q%N=s3QdA_ehR4Ycsc<{0mb=sjkH za6PCnVTQmRi9-Es;Vq&g`Dt2G({RWVQB#~98=MdnXXp)FVql;X~kg`e02! zCxRbjI#K+v=4h2it)_C8$O|jLH!DuKtZ_==lx)@24KxEsq|ZoiNaOGi2CKx*-%)m1 z4_5qs#cf{tL@|e-%<8R;c_ejoBZYM#N3$Q)U8a$$U zAh1!MU~)^)<%D(O{f7U+FAhbc0AB1Rc*TG6i`+`+K3QIZGzE?KVOq&KpfjOz z=zO-w$vUH0MCLQ7sIxwr#;uA>vwn2OTp0#`Z5^BPUL+fs3WByqRb(s0)nY4eMoST_l1 zAG||~TN8_Ai4MM3p4>KPJuovlvaZVF4vU=2$=14ysAUjko>!3@#f~lV;jD#3t*I`FWyWL8yJ+Lbnl!N3& z!7D5%%C6}8m@y!AgkN8dQnXu~%%P@YF-u3UU7f|&+-Exgt-JaTy6uU3-O@;+Nc&tJ zDPr{>$XB{vp+L6@;5No73f+(TbU2zM*6S$rd;mIqqmgH3En^=zMn_n32aF<$8CeX;P-$MJS7pv92F#10LAltYP@+?OK`p z1aKO(F)&zT@*!KLx!4D~{-1V7&vB9tGy}u-LOik4N5ykbHIftN2nlI^;}ZkbIx5pm z{r&xb|A5_WQ0Tg`t3|SYy_N?9dI=r~0}p6kJXUc-Dy}%o7EuqlJ;S;9jhAinW8nSp z*RN+Ulno3FK*m?!s}n!p1X8{HIv*M&az1E1C!dWhFkj`BYFbOA78UR4vO*f85D(!< zCJYXI0L<1w@*JDXF=yt0{ER$_U#Jaf4HZ$@u6AQ~AhMNL+B8q*=+U{+_jR7+_T%Gh zkK<4N<}Z7Z24GLNmfx51KGS4#>c?`=J)U)Np{t9uj4}yhQS3)zr;vHjex| zoLuE41r>PK6{yn2>~ppwDbCshi5p%o>p!xZ2zu-p>Ox1I@67vTp0PCO4O5D|@vH+t zXej~zY2sYeJRn)WW)}FMg>0?M)=1}SC>Yw>5fKrgKBHGe*}u!FfTJ8ui%=BF?)#7a z_3ef4piL-zKQN=yp+q{hKg_w%$iQ=r*a!IjV1nNQoKM1h|6V35L~dVB1D(DeO}a;I z(drr6TsZc9;42e9vS7bKDA>6dJ6j3Ywa+n5H&o|3dlu-1>9JfYuQ;%#Z;Eb|e)^}bz8SwovXA_b($XTADvUjU=N z`3=flQlB)Fl*7R2^_IHz(+8#~+*hyh-Pcu;=@AQ;6G@ zm6=%~J6dt-uud_h*oS!vJJ*o2VN^T-jIPL=QCnAs$V;zX8wK`!o3z<6_a8Nngp~_S z$4c(rNlHcAnj=9m3PH)qT&cpGt_%egV)j70{K&DD_De+NC8P|gf56mo>?)l73km>W zy?@up*3D1pu%}2}(-~A2g%kZw=eJgUQ=oiKVkzgU`vG^E{f>zc2K19}40rgCLO@7vmt4X9xU9_d zN6plz8A21>|A%CP$(lN4{4Ot9L)Wv{guX@-(e znBojMVVe!jaBtaNhg-Cg!J9d4p2p>ixB{n(_G*fT@L1QKJCrs8N#nuDSAz5EJj%I? zeRGFxfBfok>Ba>Rp~;%E9LDr4ErO1Bw!^aQkyz&Pr=QBFiOYo=u-`;XI-T&VhPm^l>zU2lqnk*UknV-o(n>7QKE<~U(kaQ8c;-0vWx zUu~p4Nl^ze=Mi^zSCRCB@itA!&4Dr9yxiGcSfe8W=hDBdZ36&t?i5jPHTNaDb$sl96-f%_*W+h9v*prNa#S0Lck$ZQ?w^ zJg4$jsP6)CgqsqAr2*9spoSP2ie@qyF35JFA@_)&9R!ABl^6;a1P((|-L}nH7g4PG z(@>6i-QAbcNDm(^i~w|SC;tOFA|62WcZ%Ws;#JVzpuF+}Wtq=&%?Qne^F;0UlLhoW z1CfPp!CMSP!A7p*AeG}SKpb-V#Rg53+a{b@c-Sn-4Nohd(mtaujz9sNH2T_do zrAJ=o!Slh@5OV;T;H^%})12A~AqCmQjpNuOT5T%58JN={OJ^oihy)lUq$%2p2-*oZ zmUHa7f(Ews0@XE{lFWJ+=$fFCrr#=JWaS=!$}*HfjDEp#R_5(J0CWd(%meMMp z!6=|{d6>{g;l%ZD`Ptv)AcyE^zTXD- zoCFG%pvkj{zaumbG19(lS6PcYhFbD+g;ssB&}Mp9K6J~eK2{P#RWZil!F* z&Sh@07O0wSDgw3Wk}-(2`&M%xN0)OgeGv&FteP)u&jFrqPC(e+dWlMZ!uO9 zc`K$)fX?-^7X~3>S0$q58ZOrhONEZV0B<9YyN#GDIK~4LSN6BaVtxCm)P<&mH1@xV z7%?~7F5v4(wkb##1$8*2)Fbvf6&6n=ORE6qMxHo8em6q;`qbpZwOORao8xC@W>(Bz zV8WEiEtpFH&QlbqA)qjCjpek`3MXq187aTjS=D>G01-S$z%iPozb^h=CLPGX&Be|(`*6eoqdnUbqz(gDNNnD^b!&m?s-d`)0w(ktIEZ!+k{u-@xCYG|pF*|* z<#vUE>s=<3%3df9;=|7NheJ~zyU^)g$3k`vnd@<0_)7js#~YxeW!PJ|!5v6_V`9tD z-CvG~u+Cw6s}d!hT%0F9^7;M(o^OFgMOa`UM*(-TS1k>}EQ&1a2XxkO=KzVK&P61q zcQ{MJXn{-#@ShQyE_~vJ(8E@c{|od0s@^l#Si}ECQTnS^fWSm8&$r0qB-t}v+y$== zoX=j^8>&;R{d^30HikOalIuHl%J2HvukmuxOnu2rz>@8j$+}9=72l+Dtbrwo^8?Ya zxhc2Q0mppRm@^b%K-aZBh|ZQhm9WqV(>~bwA}X^evv_Wp%x16`YL)4?rkjn(Y$h4| zf5cLTk(L^#wzBtTLTw-XzLugDvt2s}ZOnqlATC(u!(M16&l!=&g~;QGLFg>>>v)cS zA4fKx-4Dn;179@qWt(Zi^`B9;@i%`aM?QP@OyoxQZKM$B@}`HpYkw4~T)$pP1uy`} zK`t2E7i~UZrC^P(Gq|@C%2<@06droKl=9KJ1E-j^;+mXd`~~Qmj!M-ZfyJPi=5|*l zU=K?PQ&btX`3XWgcEzrfX@c^(5fxKu?3Pnapvgn>4MSAmqk6Z^fcsn|_K3C%vB3r{LgLlPlUF6HwO`U?Am(mcfHAN~d;S}BHZh$(F-UaL~ zymLzR2=unj$#6m@>nUVY%H61zA$-s>wCO7>wgGUC^r1kcx-cXHC$Wmt2CMgjGJcFh zZiGGcMQ3b=5UnOG_XSuyB4z;y5|#+23>^2OF6{PYz|rqGtVY;D0NbdrafX1~0D`Ps z4)=%aoio6P9_ELt*Wbhj%}?h{|BKx4QbTh{39e#MVYSH9!FBRhaqi^LR)8x#r9CCL zxs1-^gJL0&quq9135&m}W)Aba2r1AUZYb#gQTLF79MbM=Xy8h{WO^-c)d#cmminP@ zAt~`u`ARCX7zK#qD^fu=1O5(}Enm+w)GfGP5<#8(YA~C*x)Brzpl(AaZju{+S7-vs z61>T>H3OQSr=z-gWk3^7_Z_|PJZf#S?qA6ctvh4=zE)|J?uH=k;%>jk=_lqJ(h5X+ zo8NyYeAeB6Yw9I13$^fp+pnQ!L7~r@CkT)6R{R201`*J?A#F&s$`xXuJCGl2}hzV5LgD?E5{26%a@Z5O7H3E(vQ>r21T! ztBq3b3;~P`;*J!glgiDhF^sm3ZvS=!=Nk&B1VH%MLe?e$34z(q)6;}CE z3zOk%xWisocBEbSFT>S5+Jl zf&Xf)uToiFHZyd-_wOzH{G4~m*Q|865jeS2BCL>usRoq*nZw_90s*~PXAa?Q5y>o6 zlele*4HozfHAsUz6h#GnV#A>%;4B}YPz{qlV1y^5ts^NjKzEBl3)c$NG1QeFX&$AT zOT9j1$SoK&%q6N@5|J(nDqm?iyVwa(qr{1GN+SQ$pp!Kxcg@TaV5-knvmc2DKf^JL zw&LQB$XI%L-1YIciGN2Wm$T8deId_56!76})|V6V)=SKR+Ooxaxt6LuFaa!gyDD0X z1|m~wzf27hU&COyTNqRrSyy~25Q4j`o8z!Jc?jG(NJpY0<42S1OKRNIq9rT*!*BP= z<-&$<)@-=TJPRWU04W$drpdFFM2<4s( zCG)3hVijR`hhD0&zw}dCBtM2bmf;?HY@*^ysLBV>dA6E)k4dwV$#Sx=zc769{|7ih zO5)#v#JNRrjk`@EDBB8+&-*}o^Hw=fTa1M+szbil)KCNer)p_(q34aBPxl%c8f+7M zJ}{ekAIxX2PaN8_*FpRZyDfWvtzE98gQ8<&!uYtNk)WWR;#h4Q^zRYHZbqI^rr(4P zvFfVck``d05)~qTOFrAz*GD80cZJl|Fe^@}PBdrw=I9bSZwzFWi!j?;i)W@Y{fb~( zWK?fi!ME#rgaYNMXGmV3$zvm`Q)tK*BMnj@UE8zm8c9?Z&3rb(Jb&Cy8Td??J05|7 z<9L<9+Bol#^jv_GV$x{R^&G}S?@?egXgLwYwE%tgUy**Zk?e7h6OdUQWR}rFmHEw? zHd}TZmTBuiG|DiIx;oD{{*O*`i~kNJ@<}6+FEJPCGaDI^S!2%Z_DoiLx#~<7LLnzG zI|oHTTk1CsQ!!Ol8lq&Pu8`0CGt5TW(@03#CxNuM74oRA<-+0tfTq~PAx0uM`yT`H zJQS(UwQ19)X8W9lk!@Rng8BCQ_l-zmTn@>od&W=OUwmmA>^Ws5ccs=bqlhGN&}0JB znj=3o$Jf@5&7>q3EH%qn|Aj;`UOi0&(_z}=By?wv8^AOdXhXxr1E_Q9)PnIU#9~)q zf33h%eehg893ZL?U#|b(geER@ibz#~q8hjpr2{nmMC0@sP|qf)`po4I#>YfQAN8I8 zJvusybg>hd`3dV0i3XiQ!u$Fzbbq`H^#qL27Xa{&lC=fk*f3zfCUD=f&-ld_`PZ1z zZ@K}Ep79&<7X^W`JI_3T!&f7tIt{Yfpiod@N(ow`ZGgk28CW>~m!r zObaHrYv4|@v$Lm4U>t}&KM9lD&QF^?Z$V|*5IIZBLKKOiIlKLL{M~#Bi%dZv2GTQK zj6a~Br*{e-GQIC&d|wL@TY7gc6W9q>gfBLl{+U{e$jaZn+c>;t47$P-90-Ri_A<-4mt)wS2xf5>JjQC&o#Y} zUG_asSw4$YKHeNUv1~g{#Mqj#H{l`F&qJuDP5?&-tvRQ6uU5@|erjI2&=-$r!8z?d z|M)7qVouv$6WaFc*XNsldLOk9vxJzJA*}*q`EcmDEn#2;X_%UGn4`|8gQ)R^5Ct_U@kre6rZBgkXJXF`?{3dX-C^ zdt^5DAL19Y>Pe%!0Xhj8FW43rza)qdPP~A$>0=OOu?o_;3{}QdBFcsQPA_O{a(J35 zQ0yavIk;1tJKB66n2hMES*@BV@#Bz2fxS3w3NLNlR{Fuw(Fl5BUbQF-;@>-bmZAdO z-Y~6y5u&WH1R6*KMPA7pQ>i{zC_s9?z0FCaf2LA}+c}WG1oIQV+7b)Olthk7ciA^c z_vv80dai3Mx~GT;fe^MAg<8vWp?H_$lo2KV(FuIs43Jh`tJQppXg^C_M~FTrP!d85AAC`%}II7Aw* z9oW{zf#GIKr8XF;2p$u75;m!7AW(kJE5}$sIK(A5ktz&WUqBL`3W1D^-f#2a$PJNk zVY@2OD7lKvu9Q%7fdL)_+I`QGk=>+`y!C8r#-EDp?H>3=CBkYMMNso_B)4qa4GwwU z_4HcD#r-%}g%si!E;;(7-H(%k{xv8!25WG)ITV!4RdkLA6|umEvN)nse{lr6B2&TX zLNyg45$h#_XDC2K zXZHAbbuL>Xdl3i^P!!;IFb6wZ2q04FUlu8eH0?v2xQ06gnERqBcX&8z=JFiJv$#PZ zg{yL08UzEwz*vmxAZ(q)X%|r9=>116SY+o(%{jp7n8%LtRzmFSeuhpydY{L`m@okz z`2Zz^9j7;pQL9L&7X8eIy1Nl6{UvFbu=Aj_ot#vGv9X92zG;&BQ8<+frz>P{XPQCC z#&m8Gg)+# z3vICe>76q*a@Kei*}o^a@R*~O5U!oyk!EQq7Ypuj9~r3R^zrqHf5!9!U%fdVo>eq1 z_Z1{RkHR^l@*v4qNDJiQ%!u4kgK27ZjNhd5Gx-~ACe^QR{l5TBF94b@Oe8=)ql}1p zd6fcNg!m9(!IB3Z!&6i?(~pge$p{5ee}7T%9pC0R4w;=fV7@T$e>Cq?D}!+|0O$A= zD0F5~8sh{-g3mdQ=u#A`z0)oW@nT79WssL0z&h(uoMraItX+1Xc z{faq)D;K6SL4XLNV@w+a5g128RLhR%y%cN%XW*o_?EDuhNk@@$^D%qW<* zX|@MO@lwWeoF?KojT8E_NRK@+b0Zgxx-gT=uJ)Ui7KQ1aTxV(*oxc0pj_dDJsMKwk zRey&cSueCBC+-cZjJBd*2=|C{!MgT-28MTpX{ELV8zW$*T$doHs@gSRZ#zcYl1CBc z_3t@{6csIeMusn}p{L&>yHmX|jB-5~1W!6XJ4JyD)ey@QRq?uRZ$Au=E=u!r{hz0K zF#VTZv+}7bhMsg6h2c)qtE0R{tg~{{Ae&RK1Jz~%XcZa0bVfWVeN(9PV++6gkRu3- z`j6pq15CwP=+=B5<;*(5lWIJv-(}&!2}K4|1RNp&z_L==QzPc=Id6D&(p)P%6X1XI zfFHM<73xnh_ZNAnyqoS9j32nPFYzEe?$@H1prkQEbX`iKl8w_n;WDEj$0f6J+2kT7 z-;;tuI%eTug)ly`>vqI(mD3U0Jc&Fj6tCP7aM=AieS3)7l_+^*;av+?n~sJXJCqJR zv^o4u?m^0<08cf{nWJ`rPqH>hT^W@yP|8XCcB10rs(`4;Lx;1>G4>FCGV`&(PlzmowI-Z%t^}#i&hpK4rZSF~#Y|J~j zKm4DM>`yLW=DGHCe_UpyR|S;GAMkafpQ75U{A-52&6`iC65G3cYlbR!?)NbSwaDp& zyGCnc^_HEEFHkQ1^GPsB*)UHH@`q``-0q_$cydqR%0ug?%0CiU))FwUk`E%)%t;_l zJs}>STV`zhX|(N>D6bBsDE}f^`NZeN&z&VJ+dZ+m4D=;t3(NysSn!(dcF|sCq4=5< z&b## zAaRK8iMmBI#?NJXhDv)XX(1s!!FxB}h!t~V7=ha(>e=4P1P~8mF zmD-L%jqccWI3*rGiV6WyR~7AC{P^itP!$sPA2e=a>zbHcPS^*!RP`U-2FnNaF;&uV z2)$)J`Gaa?cFfsdY@cD8_3p~gwT#S_zMacnbN%^M>Wno!dF1tZR{7MFmyONWbtWGq z+^tm~No-Q4k~jVaRId99nIzIT3aYL3jn5~I<+{}@CV*! zxVZt^{7)kxVYu4cYYY^_K=HF@%VH?*`TDf4*}g^0v`^(5;Y-HwrOJ_9nn%Z!>S2jXEfwm^oDeF{pSXf?+%f1uC94#Q*m z-o2*#7!cDo=3Vni`T#)}@2+`K@(K=$6h^y7_P@i4OyI)>M=64S)zD#<>)u(%rKs>8N> z2w$$d+i2hCY>dETcqt|8kK2)4KWb#ulx{?nC~fh7Be3)WpWktAcA0)koOh%8nL z!K*4N<(sR6UeJ-58mnlI<5#3S{ZXSCx7~AW*l+(wq)}F`wYcCLU@dm`M}NG#=jHXp zj=(2=9lwnMaX%cyp%{KOJw4O~SH5Sy_>(2=;lVTWN6V9`u_(K%r+-wPI|JAZDBt$j zs2qpV7k`#>o70;c9+yl{)E}XZv^is*zWOJ{Jg3z!Z!XMdbuEEN4cjfchr6?t>M|bWIzvhf11gspT4w z9}W#SgD*1R(N}Wvfpc>!&EUB`7scVJlI39C-V4QPE9@N3BC7LEdpRaqayn9%%#2m) znQmQUnoeAwp1!uQ>OLJG$qAr4a-R;H3 z$&3gFIAdbCRa6!n1{d=7H;x6;Y*BImxEREXA zV^8(8qW}d&A8}Y`#Gq5jR+UfIZrbxu6zdC2BE4`@TbGEzt<^2a9PVx_%2$dQEk+`e zZk8m>0>jYG`mG0l1E0hm7iGIPrx}Fr)miA>M*dwy_mL*IH#g^4e7vI-Bk$8EM7@yj zHUP7|$g~6vdelSkvz2i4lUZ%B`MWf9k_+g?Ot<__0Amw;e4?tI_4RLIl6=0@fM|G+ z-|W_S*?cMRQbq;_6qqwnHy1v!o87nEeY(wzYvkQ8fyoK(EMu+<{loEg;lT5 zmz&PKdH*E;+V01YMf0~XU>g3Rh{_y1MDi=PhMmvMO%R)H2=%@GBg)pyt#bElkZqht zOLC;yT&d`S3#_kX?P1&1-}Li8vYweZ5z^C(`W`8J(z}ZM*bC(%-lG&ewTMY0O%h@9 zC+3eUCwp4!VwK!sq6!$Z?Y)v1m)@#x^sbg?niY`kLqg^#gnbc0ogkLfaRMF`;DcU@ zW|W-Ww|CanEpINmmu)fXH^Rb`ljg33woXq^tEi}?r>Co%uEGSqI_SZGV7~g(b6NFO zL?8lTVhVX?Qe&zPyNA#3cOU3I1BIOO#=i(vchx@;!ri29!RSAOgxs3Rr*rIa3Gp-5 z_M~ZLn#6*XM!6Art~ok7nny@p-^eJ4f9oOB@1326Frwm+k-sP4oVhu*rN!{~G+aF2 zG$SL!=|1u9h-=4kjG~B?lx1z~uelL6TPA@L~Ow< zUNP0D`dN~hXCC)vBP+&t1E(?;=t1LQh+8#h5UNDbB&f{Rs9gE-5IFHIzO0sXlR9|p z6Rb%*V>zbs##qkbCJMb!Hll#!i@sYkQH z*RNk=6r5|Nk0>ZOw`czxCT7-RcT`DY!k$mfQPxYF^kYPzWG9=_uD-11-!cO=NA1xAqg`<| z5kYYhn@A597FbMZ@k2XcW~Rd#@9C)>BR>XzBL7T@ImwzCCH)Jw^k#P@z2W@~99L}O zi?BF-PxC^>HzuuY-8*YZ`$*<~J~wFjRvE_%ArZ|kM3f+(%Y(pk*NU-{of#KgK!S@` zjk&@j^pcZz*TnlwSpr^gXbs$(z-?D|wt=p_%7qg!xD7NsIM62YyMz7e9ikW0Dn@9F zk=pXoytca?SIAx%!T!Ch>oR1G^Ibuck}iJrI&9;OJlg9r}MR^6hV1N zH!`DWQV(vXIFnUwO`XTqF{T1c52bs{Qe4!RN8Ss4*-Th@v=k$D=I1noHU$fFW^VBo zn8d#wdH*f-5@a;G`Pz8^lb>{>=_0Ea-q>?lw!8s3!i4nWCTqQ2e}glzn?IW=Yoazp z=~p~TqaCXJjL?GT41a!&x;as~EONV$x{uFtX@Fa$6`Y(D_UuIg^Z6f1?`3aS^SYTg zhne0kd`&YWsK_qf^SUs&XEX_}$dFfn$4Wv7y{?ERYs|NZ|0VQmlrczWQAmoBJP83A z9;;Df{a1F*ZbQ8Eyy6>Q{F6nLDZmT(WQ`zA)IiZ4e0o^V*u#}Qgoye!-|3~XRtpN70DScuSyTWUDBCDZv}UB4^r z<@PP>!qxNt&U;(l6sbfg$%=N+<4;qHNFA|)8~Zs(Zy%q#%@eW3AB3mk`akeK1C>Q$ zY)zCPOa&no15Tm}9t!gK%TzJah1J`+n8juz;E9I1t0vynMnRlKs)iHEplx^}8HVQ| z4);z3O~`9$S$+z5$rmI=!j7LXEkHmPAh!pmJ*I!~izOI;Up zr+x-_&|lkv2IJSWR{O8iJAR(*ebfWLxEFh-(n&@JyItCH9Mtjnih;R{RRbG|q;1nA z1%)6XCje1a_c<6X@mn&d7GPkV4uAAzJpJ3BxX&Q{+g}Z*SfSBBhfX^ny!|7@o!Xv! z^D&q-5_#RG66tPk@NEyg78PzrQ3*I_(!rhtD5L?;K^V-TM9c*m?1Hg5s(CR6;9y)Ywt?qn!eI*I%>7js)$w*lwm5Or2z{fB0>~b6tN>> zWR1280tEy_kU%1CRIOVmju}YBqVcg#LoL=e!utI zd>KBtBoO}h-e)=Y+~+yh*SWLgqiM|H40Q{q91>q?SRb|NuSc|C-tDl|>va{sMN61XcxQ*pnM+j+E&iB_So`am&6>=G8O)u}_iOw_ElsaAU2qa_ni6Tvl!af!iMWfjnM5C;rB(+Z+A4%}Y$~>r)6y9s^tz3T5?PG1tR-qoYkBP|;pt(S9=g z)Lfr0$Y$owjx?c@iHOFDVOX6{lu5e7CopnO=KDSe$t#`3?Pb48l{txl7MLaJCje{Yh^o7)~i}Zzg8)J#oKb(s<-S+ zBz4@qIz^@M&QcX_nP~vOriKyNmCz)YiJ6?}wSL`qEW%^}6(*;T2>fa$q#ZObPfwv^ zVas_P8Bu#A1nC_5^mnl{Df8fiMFHOXu%GAW<-M%4>(;`4$j0+B6ADFsetz!^pa&qx z^K+L~5=bkV_w@vYqU=uY2q5sb8xr0Ay>Gpt$wP2j_zh8PG%GYC(yg!V!QodYl07_b z-qZ}CYkmuqOK3qlBREUK)wt0Jk`(l@$y)MdK0_m@f5SvNcj>*fG*MTVtB1#8VCD6$ zh}vVDT

5L6&a&;ZCmYF%4JjG0+n}g#E-5bmeEEahn_tm;R0u{`k2z1J$bW-cME0-LGcgTyc%=WXoW1M4ZI5 zG%t5|9qD*=b+v;ossfB2^B;XRWE*l*w1Dyp&H(P+HyvLIOZ+NcP+vFh?C-6WjHd~m zvm~hh5s)EK3(d_vUUK#;Y-Kn`K;y1Ye^te-=}23kvl<^fQfp{vNWlA=4Sjuy4fL!| z42sulwan%yDp0Gcs$z-ULHzOdB%9=HuO?ZW9@|(hwV^xmfyIvxwo6Oe+uN~oatt2k zZ)D(Oyf;q>K|75ctBos*n>qAU%`2$Kz9|M;o%jBEn<#>k?tgBBPdOI_4pKKdy#~!v z_I7qlV71=wpOUI)m|8Hz@X<22?lFJE!dp`*>XC`oC8>^EH7=>DtTj=|>767WD+y{f z{j-T$`Z(2x$AcqR<5t5|U ztIul3<3pEom$LR!C~K^!)Mr(K!P?+Xj*W+xMv9Qt5x23>Z2m(p%k3-w#(s3L{F@N! z+hYhE>Fk!LklP?4?= zdzTdNzu&)S9SE`;mH>ibWx@+z5A&)B?Xp6Jyc#tABHH5Mz<6EOgp1fgH{^o#vRAA- zx7B@E)t{Y+8lL)GsBADRW9lqp%6hxNj*9P`)T>i02Fm#So0)@hdCE*x1B{IF%Lyc3 z{0X{|qO7<}1A0MF3s&5vF$2Y&lsTW_w^9C~xJzRypxeK{dB+26eYJK(SVpZpARYYx z!QLQ<#+6N6+MbO)UA{1{r&viZB{8wI%?EqTwDU##`%PyZ%5rc*z|sru+QAbud31Yw z<_qJF@1XS{mra~uTq&gTP-w-LK4S+}+qzs_Y;p|c=5$9tesWro-RQL1dY_v;srkB* zA-^a`$+RJ-1d+pBm#?V_5|3l5EqN4krXj57Vu-b|4BEe`J^aV#6;PS<;IOADCe4`zUB(! zd2596fs>LCc3EyVGu}N}z^I@#pkdX>K@UlE4hK${#@4u;@{+!YF=igh*j= zXfi!*mgYKWK97Y)H~3tYifoFYQPZm798f-emipnthXcUQJiVw!U)X>t2s$F?$j3M= zG9B^p@o^^p=(`+2JAlyNFgahBln}N0hx5&@bad-tv+RBh2Ba2-+X zs8T9ge2=s|K36zDf%G0nmYYJ~hCG12w&f9;6DiX}HN5R;1=f@WV-4?_`0}5;$p`mo zWy^DrS)?UbAGG1}inyb%Ey!<@9XQJk!avyKZ#Y7sPe*9|LibD%)mgB zKCpbqI`JpITr^J=bsvlTp$K3gVjbkWakOABh#(Z*-q+!z|ji8l6aKRHclfc>I1 zqNlqX8i;wtF66t>1T5tkTs_@IEE-UY>mI zJ(3=psgZ8RLRA}mwr+hEGG#ha4y&BXt*WkW1gkODk(t*VU3|*7UQ*8;#&s-EFC46-@kH?Vpt2Qr8&J_FN2~202TIOLL_9W70!KD< z7pIrk$&=wC28e@$k3_3U6Jh4am^EbYG|(7PIF>ECB5)ML;`x}NRGw^Hv3$E&17X)! zd(`2z@DIWqQoV|*OgaP-(st8#cC%G zyngk{8}psb`mF>n#M(1m)M&<$=J`<^&C#*GUbKjdh@E(q3qEEdp{)AaCXF z42fNC)1Uph%_o%tw_a$ad9p~?Jjz9Tccw>I2?W8-4?|Ex$uhaJRM2-jsWw%($Kch>`}pw$N_lbw&Sy z=mHI=F{07g95Q{@l69j5&uFx4y|~*kA&PVEz0D-6XzA|mt{aK<*7<8GYoP$Jl_QsS z5CwWDh0CK>d)SEvRT~GOTxtZjph+@mOpM~$MK!Szd(a5h$|Y^sW{6#+PT-Qd@$2g9 z2zDr9w1Sp@CVfA zORm7Fsp*iwec_PJtODnXsC4*bu?uwE15uw^Q&kn-L)G$B1ipf`CMLZ8GkT=Fm?ryh z+2whRO-?wUx*#brF&br=daMr@q$Rx`xrvEgsK6wPWh=Mu>+8cV0G_~x9F_Uk+=evt zQi(^z@WwGuLF4ZujkFG>Fk1`=fbw^%xEM}ry-t`t3nJ_gH?n;@Xo|m}ecC$Z@G>}d zK>wrZ0Ea}G3OEx~@Xt*}!HosS#}ZOJqg7UYsd3`@SyBhBd0Gzb%nDjX<(@p~(w9k6 zt@iP(4}ISB{)fHg_mY!)208MeojZ4mm^$I5R1LGBoc?$4BpR|5sybK6S2FEo&%IcK zuhXAiS}Y+V4amN3uC86BEhHS~<>k%P@O=9~^E7(bW-EfWDNoQ2HZ~Aq^)6<<<6U<< zv?~t!)qo90KfjZ1qy%-p^|v~Z0DuDe(JS8zt=ZuAOwL4asWvB8u4liD>u?YYq! zpk3qAX{xVus`x#>w)S`dh$kglaAZcAeyE=+Z7)v|X$)ryQo0R|MWM$z1M3Pe8U z1E&;i^vt{-q&c1>pQofL9f;(87ibn{|Ds8I_|^qoyTZU>qGz!A!q@YcY{z^&efspe zXP)bm^YeGnCWd~~+JWsRNb|aUf?sFh4pWR14ntG>|j>Uy0}NB~;ezVsFYEXd)usSvS8p{p zhCQLOal#X2$~@-iD6r6ut9tqJ2x_@e+s*A)%HXyYK#a=>N?dWPTz6vzu#rR-m**Za z49myN%N}c+eecy+ph)YmMTeuWHmhh`tpmpo=NQHs&%4xD*%(1KpO~vEKHr8;2l^UA zFj}5xym2JE;*0X(d8?Fg*WIuOGn8eC`~D&8&sY)%kp(&Mbz)9bpNwky5K?4Z-sl5C|+ zV&g9rvdi@sH|#3f=W{B@9psIK{7%qem};tSkPGxOuY`q+VeEAIyco6vm&SnMSFIvo zmguG6 zMLyxj#v1*_+4y;M1wYtb3h`mb zuw%t-^t#OFZ{NP%p5@>)O&%E@ekptFih+TFo7-~3JENB7=E5Z}@jV(Lb|(&vJ@KCm z;#MO$bUwea!`))!`FNi2!C}g?)iT+x3=9l!PQ7dXXjz+ok7@HB!}sRpK{7Y`Urt!_ zX1Cq&ZM!kULH@5}Dp(S;?3~+eQ#KO%WH_`S%qHd~lg!~h(zg%xrSODpQ-tI94mYGV z9=oI?-dKrY_%@GVeZ$PDpJ9`MbXa)k+ZVfR?lQiq3m4fPI1~ePla% zHkQDIMF^x7X~e1T<&nMlF*nl@5M~hn^X z+|uaJ3SSWQl4Yb(ODxw3=*#CDS}(@vy_O%=XT-u^uPV)W+D3=P@>(W`PN1F~Q!bIM zwOEZ2&%9URzr%8UpbEZFr3==*_+xIjR{cmqRw>G4;xK7G^j(|FsRrb+Mr}V&<1rYw+&6; z;4zygAv%FlNd{aPQQPC8@XkyI%w~t(`MIBx3|OA+s%gD5Fxgp7Xf#-`uJ7due^%%y zu{jCaF>lpX&jyHgFS$D)03T#mWN+Pxg9}_*(I3zUVk<}M&ixUUWu<=Qa-0|zl-J+A zDkyie5&Z02L{OMntPl5etaognHiZ=VRm95Ni~yf|f8iPa(WV!5Wf;a1EmX3P zzu&4S3T6;r!A!2Mfxh50;mwl@83m*zvAmh6{UxOP+|$Ja&}kBzoyh{4u3|b-0hTDo zJIBk{Vf$X|333-3O%VSGw`qsK++EjBxBcX1!HC_Hk5`r#dMVqVk> z9%x1RQ(lz$YAlxh^s}x*{TDu{p~0=&&?<>$n)nv=_U&5rE3is#`>t~jw5_C0e79gh z-#vNQi%&nm4HMKGa77WC66qHG(weAo5C6_k$vGJ0my$=v>6=cU(}CX2`iAWCH85|z zaU3=NUG=I%G#a@c8gM>!z@%;5>Jl;+L!~>Yjoj}Hb)q(c%g$eniwQlGZr2wbVA5Pu zqa(x_db`_mgZLI6p0l5>HcbrF8W|bM$;#Rff7gCf?R+}tFpq3hJ1>UotJzjzp~V zyfEIU@b>fvf&1^R8WT#Z$z(G7=l=5GZ)^lg`w`2UsQNbs1`4tdrIv5h=QXE9E573V zympyuO}RV{3-^}@HM7HIbG(W1mKn&j?I{eDv=BR+_I|;p;q7U!O?#W)pI4fUoQ;P0 z$9=tU(mXpmdt_w9ud*yej_{)*go%|W)=r8-?Mt-bz4;uM`A1(b^htibkfbNFe*JoV znMddq2yXqWFeb<^lil`Kw zDy^h!latS!hpozfue$ru@b*kY3!Rph7AGes(Xb|X%y82OqcdmXdHP~YgSf{*o}A>e z;xx*-Z3~p*zt^agZGLXf(b3U=&uN`SA(c2ZS&tR3SSg%{t|8=%hp>M>GTmC+)|P#} zEn{=;%-3tzu35W|2P-ib6cmj2m$zgRtSu~l)Wzv$W@OCG&!=8*Yi?*b)%SDDng>CssBW{kv3Pz&ERz9WHWq5u9b*<~yKOWxunso16lwVA zMzq$XJh^;V?b(-&hs~v|`ph$gTlZP*&W%`jm$I0EG9cIGJq});$p9(_SLjlB=BWVBOF43Bx zB6h5>?IS8;Us3UopdxnchCd!r5j%VntqB&?o(_JciEI%VCSLcrM3SzEQY7l27Gsy^ z>SxdkffIHSNvIbu*poaTBGAXlP)8GK4&Nm{^fkKxnBQrixF32Eeuvfz2Q-i^2emz4 zqb3SfG$NW%6I+=0JvkA$cAC+8A&Yu3sQ$YbWYl8DQ!}8ohg6h4$9Z=H6{TN#=qXcC z+J@(;haUP=r{R>)u5)TCN(cs}cdtxm`zkb$$EwtUWHiA*5KMa#hgkupIhde}0MkT| z`>;#!IZcry;$Gg9uK{rM{`ftaT&NE$v_5=CGtv93O6fk}G|p|;_HG2rB*|`8Dl8Xs zP$y#NE%XuF-xHyU$n_i#bt3p(r{d``8C*AsC0Pz5-5Ohe8W_SGwi*5tGuce_Qdl7S z=gG!zWDIZqo!XlXXnKzEuMB7VdT6Wj&@*))Qqob>R^ZMmk~V5QW^mF2rv2rtYdNdX>QBiG})yf~e^yhw5D6E&5&RQi0aSXyVsP{KAI zp102VeX*}{SzPl^5wJY zAU)S~Jy>4zz?^SAR`+xlN9M#S=B&B;#02NtvwZ>X?4izMC1VATw;il_DRZOi^MgM3 z59Z}(K3=YVxPDta-)>X1fOkA?@09<1k4=7y;_VSDQzO^!fRXL(CbM_bZ~P#)rjO^{ zVbJ$^CWk;{zsJrrN=quGhi`f2>t@phA3|17F+%Dw>Hom>3GyCOGC`6K8z7wdz}DFt z>N3?t$R09A(@n{w7r+twH0R)Lh?Pc2s-=kg3N71yl&sGqY z7Jeu!FHPsVbv@X;-63ZMz~5-)p-p7tBO zZ1<}(pO8D>#wI`0iT?Ex&q=e31=>kXO&tpyX-TaNJ(3w69bKwDrUvLox-d|_yArV6 zsbju9G&B^tIA5bC&bvS3_GoubPR?GVPtW@ip9kJdd73TuYJx ze;?o=Q2c%`YHh2AjXMiM@XLEZZ5f`sunT0}7bO57ZbIx`giMje+*-T{s~&>bA~Fgb z0}?0Jq377MUqM;F^UP`=AnP<2AIg4YkpnL~TPr5!x8Q(b@<^ZR{;(*K$K`=!2$%e#A#W8?WIN zSoE`PJ&M{`b5~A^1h?iXpQa8rZK2OCicGPep3z*08; z$2i0(Wm%c%^FN(OPvlMO4Svp&!`37C^Olop@o*pjPv?1hFq7zA4{~5O5_jdI?sb%} z!n}{i>C%f7#LB_X>mI{fl_Zk{2HWUB)-#eM03U63NYF)9dSu7LH7-r*#5-fBiApq- z12F;@)R@+%TsJmM`V7Ium7^=jA0hzIOWaCD{?#?*@FU!P_~a^pet7+d5LTxD=;7P( z3Q)E;_{bWT?=^q;!m`10!MlY(C9Ul^Bh2Otc33zkF5wOU0OQ4Gi`|(^$bh8s6n+hO zJicP)z58Xf*c>iAQKbKLlOzk@-FF@4<81D#R&o@2ci#74K+zKH3b562OwM^q0Zf#`MU{a^m2W6mVD8OTW9tZsD>mXU%?*PZ4m5&^@J7wU zqsq)(7y0H5XU`J|1m^Rg9sArf36xMN%bLOZH*ffOm6Vsy?u%#lSuy|{;xcxb2VO_@ zo`Brm-QqGMA8R#^OxFD~%0KW%lhXZss&i@hL#6!UMC}v#xu5O|3thsxubqG0K&1;!pOm&$zb+8?U_E3^cvkMi7wY>+0+8WT3APRuUOULzl zV`F1&?FX}xXM-yI1hi_mM5VGV`x%%xEY1Efy;*(KBFtqf!8ntg*5d<>P~4X11B~rY z|GO^}&%=Aq)Ch0>4hex@nSogH$!DI%j)@)DQrkYkT2tBX(2Gb6qOsres98FAJ}-@ zJE)s*pDfxB($4D`E`l1y@j9<&5R8QF8wKXCHwu}nu2Q8eQ#vS7eDCjm0B90#Qx!SG zuJef^5QMN9M_;F=_3>-=J`amGh2p)86E<&CqQjg3uH z@}=4sO=|$~pFh7RT~v8@?9Lui8(pzKvwX>c>#Z~Q_!iF9L>>3jWMyMBb?Eaua^%Rt z4(D-RLThzLha2c`wsq_D6xNuz!_qZVZB{6BozCodXPDGI9=5zN5EEuHyKpdP^zl2R z)CAMqB?i8kJg4??ppYn{4VGkdh9lJOOCgiDvtL@cT-j`_EG=MaPrLllq=ay@!Tp|iLm6-V_rlvlnrW(jg zg7gG4X8R$V@KSA@mA|+Fg%!U#YPxo4_D9%qv5I`M^X!22M*HQtW1SfGiQSRB$Y%&?^%FlaRslfra*rSv@B$9AFBEifUL{f?5m&lEx2g0R?j zXV2EX3GA8AS5Gf3Ep5A=*2T9x$`|IgGz+jE5O(%YDd6A=v|9Vkn<~K6F-+Pn6s=4pcHKy~z3GER>c@|IGHc8b*nAO=&Ub;(XqwMzthdB%p~%e{!a`G^cK-Vy z2&N||uQeq{FU&y@0CB-?HUH;)rzBTC8pp0SqGDw=l-aQeZW(#3psTA3!nBdL%+wDb zZVcAN850|`uaRAnuI>k#qHa3Ekh zWh$H`q z(rJkH+zELS=7V5-;38GX;Sm9tp^c3K47pw(c}e_3st>_HB>>g+e2N$%09B?iJVqq| z;m#hWb3A|n;Z0OKgtb`O#hh3S&%Lp@(I%4t9y1CM9HX}y#{v{`c_W_;#sX?m>R#nG zA_^tKyPUsc>K@QRDSxUIq~ihchZFhDLU}CECuM{bI^4uTFf;H8nhAhjH*bn6muY=Tb(_t!dZbuu9RD_;9cOy z_>;3ZIx6bN@>1;w232+FhxBhMyMx>&RXVCL#s({aMdSMm7{d9Xjrbm4hH!20AHb9+ z?pj44u8tp;btrZ%OzlH}M5@4L8dMGA4zGaz3H!kdfyv$C%LXA9K-QKJ zO-7;=LPBk3GA8`tPiI9OQXQx>h0xPjY3Pi3E1k}9$OsgT9mhzgU~zCc1F63lX3aY< z&w$k+w_K6=t{i^VpY962_WRkF#O&{QNdRj-gsI#FqAD#VK$2{qrt5~_9N4wjn+o)F zalo$Bc*5KYy8vqqF9uoU4KSBDHyXLBZkCqBZ=~^&GWhhw!=qws?2<5Uy8>#2N_-9` zJ2jrTA&HFw>Ef7Rj@4m4aYHLj$Vp4){X}wyP`H>gPZs4FdU>NF?jMXD`Y$KoDZ{ew znwV@hn$Fb(Q~-L6g;gHv@!na$BSf#Sc$bt1`m;Z+IIaKVBvo z-7}a36mtl)>w~qM{rM^YSF0nM%e5na*8&{fcHnBPD<^I(tefJOADN~Z*KSe=lOZK# z(wO4d*z-iewRaX^59L1%D*ocMbK-WQkN8ilp8ilFYxVUJ7s{K0(WLKWb%gZb7GN5KUozWQL&>yHUTcWu%5Vm9q zDQa|W0+j5|{?Oh1M|p56$Y z`~akCF&DhofoxZ|usJ**0fG2IcOGG61+#hC52V+4jTN*3_Bycv2eHEqa(7mG$qD}_l<%&IP@g}e_ z*}3w0aYc}vQ)Cu3I6%?D4zW;~f<76NYrQBomn3892P4cO93bkAk=GGXV>G7**Hc$U zWe&+0`n>Z1;88C+S@8&GYiO1cF$)CZX`1-LiU4MCE?JuyY<8eqS9X1Rr1@$IWdshK z*fGM-s{P|+_^H$rsyVf$_qhXsW=^%z9SYnqP6lNjlpidP^??10|KRY0@tiX(+RGx* z8Z5Ev7_=y?h(j!LRuOlBc$4xxcoy3TEEJTVxfd$|gS^V7{R-U+Qi|1+r6!6weXIfv zFFUskH9X)F9oBzf2qZ@1qn9vHb{2R;CoW;JD8O0YHNr)V2S%Fwk;Sk(ETR zwG;YV=SyQG8_1yGAN|Q`-Z1l|6M$IHOEE1g@JQCgG7dnzxfWkDMYi514;UDC1xi-X|YyTWM)hC+xup)7uSk_5Ez(u3AU z6%N|q{j&`zFnqLhSK2_Pz1}YYX8a?VQ+EfZRk${ImCXD=M9O%elVDwrq-ch4OBhM~ zpED{2L6sK5LwGA5pr7$R4&NAXBFSMT z9|R8X5rDlh5-kyY;F{x*Q3vce$EhX@Q^$d5qfb|5B%}@d>(|2U zI1>|-oSYoUR!H?tL0a)QJIJo?(52HU&5}cOm92ATq&WpCO+N67G!Hemwec!`&vLji z+eL266g(O9(Q$HcP^E~}?e@Euf!2`CXV;!!M>mT8TrI@>Ok-hr%L|pu&gIgLP%Du&Rw@XI?zN^fp9SSdJyD9_w2FT0%WrXzB4EJn26rdJAmwG- zi2iPiV_u>#AG#aF9jm<*ncXH-+-~*;iYBC8fUpSy0c%C(uNQ3L+AooB>sArYHQl!XZ1joSg81^7_!Do|fAfgwB6ejeF+-9t3}sw- zaUl0pB}Ub(AIo8N-mt?KvTo3kkO}jYqm`~0vUbE5!naP~FKxkZiX{jp0?q{5GT|%$ zfo;dGGvb$u$@u$O`gA04;s;1MZoN?Du)I7i3SsdFv0UTZ0V;iFqrwu zOa7*v-gb{5ZU|099IWYy7g7BP&X1XJa4GX!11m;B)6`NT>)kjv@bPs z2`Zmw1$czc>(UYc*cEe+005Q`j2Oy-;C%tRNMK&zC27_K2DJhF2T(WD81n7|?nwC) zxUm;P(9hMheqtJsW`Byzi|ZH`5309{9eSY$ayop8)(c`%Y#@IdZBB_`%dL(TqzGeL zDC>4>WhCBSLEO{?c_7p|p{Pn0YAnN90Zp%zQ-v|6daQh%C30E3;T0l~9J$RzM|1>% z6H7CD=+E7S8KsA=I#Za4$gqkHf@;n65FKgp(gZ>HnJea(x6`JBN;U$e^NbLS$xG(l zUm316Oer--ZX}OM75uhhUV78W9RE0w5QB2&usVqS-1{jB?Yvt;4l-kxMIhS+^-;jm{y|N5V6i(V$#sD=1wvvSY`e4HK^H?|%bjWm6^tmw4I9XwiFMo_YCurrq5!rJ zk2x)@tHP}?dh{oFAT?n@cNykAR+z>exOV{LBDdFKL{8tfI|U014EPLCL&(2^I#qc| zVtJhB_Zm8U?N3Ri`v0^b0WI8x9z{!F>}*c@{6#hM3~m5aoIW=|@A5eOU4pnY*Q8ts ziwYQKb?|HF@?D-wTy`8Q5qxskd115&$;Wn^g7smG!xsPN{J@@lbfirx$xd351z?s| ziyrL;$hi4R>wEeQi+{}#U}mjQoWt%jOYt`fa#4>8fo#X2oZGyzH-B;^-u{YAca+Qw zJDqWJK#A>0U1KAmSK7e%R(+!DO ziA*+Bc*%Y}I|ULQbtd4oLD1wjQ@|$%QsE2X3(XGVwUns+OBR6cH$@Ima_lZa5l?LP zM*?F;7odCAXdz7K@ZGgyvCgjlR+owVe}NO2a;IvxQ`OFA7ePg-O-_pXoq&{4sI*lB z1KVMng`atOdGY#h5amE_8$vzE2AG3!CC$zIxP_N^sF?iH-|>M~&xieZ6gX$B8A28E3t zBtAWGdz*MK^u%ytV-RV3JmS;FilMRwx1E+Ez__C-)vy1l9!aO?%6g&91MNOyc04L)Su7E!y_# z&H|AR(tB;EsD6 z__XcSYZ`rEg-6TPMc}^iBU`BC5Y7q^hsfd18JY!;$U!{_W*Jc>A_pxwS69fj136sz zLZc5v4pC_4I~?h#=@AFn+Kn|}_ z3^MDp7EC=P$$?;`JmKO#ZRO!d;sPx>X#_)j4UaD@s$32EqPeoXLn{PR_cSO_7Ol%| zdodC#{NM!)1}6>At6pJbsk=debBIr2YE>cZ=~Q0Wg<%80tUSNF`l_z1?l~HaDIM`6 zJVpe)q(^}M?qG&ngSlTFar6h+LZ>Z4q@gq&ImUK3|JL@0&r@v=sIycIvTAi(=;1>; zGv{Z7m;6-Hlarx`(=#*Y6_$Dw8WK&ZV99?U+~C>qA8f3wQ2YVuWpD{bz~04nGN<72SNBFxy;aB2KifobBw|IJTY@sKdpozjxMCXSRD zHUK=`*XpN}E_{WE1cDlc<=IMwvErR5VEKjwGAi6m41@e5pd%a4AuT{plF3{d>Egh8 zvfD2vw<<`GTGqZEuT*dY*W_UP?Vb=qyF=f&S8`e*ziFN!vKt;Z~FoT2`@|2?fJbi!3> zu}|Dh267;FSHztPwzdC)@W@Y+0Cl3)*4BMPsn#9xPE*7F{{A8=bi_k?4P`F~f=o3| zUbz#|;%%R<8TCD^MiXQa3Z@aN`!f7b38~V54F@ofdqLcG0@*GzXaOxXg)KH2wU7B* zC1y`~OIFM@q~_d${=3Z8hLMMd*YU4oW2=ON5R~@pkdP4F7!9Z-7^F}-GHzKxs0pL_ zWwjQ=J=T!ft>=pGuv0Tkif~ZzH36*Baaly6Nu}G;c^9h8@-fMlCoP<<*+EdOZL-F`YON6_E@oj-I-zD2$#=ccmeO3Hub@_5}s)( zjKl>Cz;b2#Z_tvITmzds$CDmwics0b-FIp=CZS?4=+#<;;WstCInkfyNk{ZXMd@KE zw7PF(eXYG3pF(p*Fpsi~Tj#&7ank?xryN6t9QWCG1zLJ zrzn424;PRY`BFeF9)aTUQc&lA(pvFb$Z62ZXs|pJ{T-dJS7FTj#pI|Exs6!oJ{NP< z{i!=4VG0+bG;ap8ZhnJ;rs^C9;NGYa{3DNUD`KkCCz3YcCsL^b*+)mg=C8DZb*QGJy{fWR= z+$;0Y$+%$(^_yl8VLlrm7KH}ER>1^HP4u@Gk1#@6Y*WZFTWdN@53&qfKR<@=Ky>lj zG{d&&5B_B;F~O(Z@{%ibSOusJk*F3>Ji}0{d&OOpEFIPK+p9W%2OL2Wol& zBd*eEpbnlIXkw~+pnaGb^gd$+o%G{2q_Sf8kP>p;-FYYoUZQ4B{CWZNi4S9cXHG(t zSB4ZWa&klxS(~WT7^n>IJBQvhnw2WUsdx$g>zwd8-?rlw#`IX#I#`>CfvR@F#eJG& z!Ribd{yL;v)ey|B3`r_DJKp5Ka9}ngYVT)2QyKw8p6`F_WBOx;)n?YLGBYp}0XX7O>ao z6zgb=)TH@d?+8!#RhU_aM@PAoInPFeWDziV5JWzPH&Db&$O44V{`Gk+#3>VR5_2*P z_xKM%>bo0q)S{*eQc`+CoUcy?!;rrpYZ292oP`}7oosGiHY}E4rtf&qiMdNMY__aD z+bQ*0O9Mn((`^KWxu211H|-H(OG!Ed=m0P1JV)ZuUE?RU%jen z;ra>Xv$K0sTgM(A%<6istKsk~pDA|Qi(b>)m1?Ogs{2w}bt=S3= zj2=p|oet#RMys2|aJLGLsXP6kB!+51e7AvVg75uL79(~i&9lI2hRmeV4lYZR^e6b9>dD_b(;ze@to2<}>j*qm6IX@V3NPFf}D*uSwQSmpfmAGyF8YrY2f#?Ss$r z0Cc5-9|)zev`xDVK~QV-txYDBs$6aUH~>jL=ni$O4nzlBZ%Xbf)|#rA3$jWO=K1kV zO-yF&?r?}5^LgkxoD-5oYFu{cE$HSBhaVw+k%5Q%n6}^UO#UVoEOF^XlA$wL5c9ph znx}ls$DRjcab@25y{HwuY-ynXW8H-%gCoaaq+45K2ZJN4LLe-WL6VnOo;`QpX|V_!kdB`At@{9OGu^j5T{ z+gvRa?*CY}rjQjsyya8yF`ceVkqK+wx?9NT+4i@sQQE5q&Yq6bWjirKm&{tTwRcyX zx{y)7kI3h-aN(o1^c#|7w?2$+y0e|@a@P*wy?dRv{1mvzHqw=|%(OW-cs^J0>YIk? zxoi`a%mfN+0$csE_Iy*;NO<>dudr~5 ztI7Zrc*W@r0*-l!bI1gq=O7zc&5ref<}T0v0GVUR5j|-b_pai5IPZ7Rr+1=b=hEy& z_~SgAyDvR8^`N-8HJsTPy>wSF5h{MbnHjk0sG25dXLq0#QbIKY6Qo*YjS4dfIL|ga zI}1@%;7e;Iv)#9DHNfeR)2C0LJb7|TV~3!^{O|_{2L}kWn&h~+xYlkK^H$L4?Tv_t z;1WI6+b%3B8hpgbe!+H!;Mrq=$KYtC75cpZl2=W7TvN^%8Cg`k40MW#i0FnxXV6CE zq^euGs5MW?KyJ~~ohlJR@o(RHi*p=KkBN!-@L~LmCkLc*>R@%AN;Ki^&>ZYd%w2K> zHi9TsEm}v(=b5a`qX-B&Mth1hU+g;%^C74iTGkFX7PzxjLP-L=V>m_uhgkx_nSv8@ z5`pT@L3Q<~-636bqhFm&vEF58x3Jp^C?j`aOwGusWe6UzINbr0Bqo2dw-*Yl?%uuI zDhKDqkGL+}Mgx<)`g!q+amLNKw6sIh8n(8!0=|~k)_m_&=Dry_^r&hq?-n!8nE1R_ zTu)#Bt9X$2#v=~-cNu*JPKt<&L)2S|j%AyeZ12$Q?S<3k85tRffP$olrei!`qMejt z)d;l?nNS!E6%>b{-V8!c2xd2j3E0_j9tF?sh;8>5;QHpOs`qZoOQ?nbir}7@PVw$0 z+-iV3i=OZ;S1GYwqU^F8D~F;Gz#tGZetv$)2S@?}Bey~J$5WF-COs=_0a`i{Q#;xR z_M_|EKn#?T!5^VlzTBU(s$H=e_X#*uVw#in=FJcsvw@l99x0k_f%M_K?CeG0O;qd$ zC%&gB9SQ(x)vmF*-;AuY>l+$AL9JP}E6J?_$_<~oSUsI-ET_QvB`78|7d`N_X5c0q zJ#^=DodEz;*8XVI^%>RJA*6%DnBB{f5MC}IBz>JUj1NZ{FiS^lArlUb^@6q0u4>({TKJJSix zEiJlndfM96mygt#l1sO#*vSsM&X1&C`sU9oXOBwIgZE!NHsyL((BRamhPt}LQ{OL| zI*)#x8SO!t*%{X{0WcV@L)H#L-|bLD|MRCu*!#r9#K_2t=g#3yboX|=iHn1+@GXa8 zp(7aZ{JFCB%?_98OB6V+9v&Il17~El?F@>h$ZaicZAW@tG&p2t;jq%4J$tTNTBd`a z4V#|;$7gkQbxlqA;JuH5wYqiNw&39481+C2cnMYs>E8a1c}}iPn|vB}F7_p4+3t#oe3O_+0lqwJ*INu&d`4g2&*^zxN&1?#Ypv7!{NX+D z=cu>$LOCf^_$$oz`hHyosg(jJ^}D;f;nxx2} z1MBLOpm+zufybkAv*x?)#-OCpKwJCid=LfBhb=;`*_KFMxqvL2#Z4BbTCCj`CmX@6 z;1JZ%GcYJpIUZ8BZ;>Gv3tk7a?-B76stmowd#3dqVPzkij(a%5)}h}|eNB&`><5Ws zL&Fy?pU%Q|*|(46po%#5)>Xi~av}~8Hoq+EE zg;JRfGwd00xu@{)=%pQk7E5wBU=cORL0UN*O!02Qi{pcX>H;?)1+FJD3Fna6(!+{N zz#u}WWZ{rKhvkPM<~x_TXnT ziCfOXU}4Ylj{KOr0gHaY;Ba?X>H%qKD8roo)m1P$fYACT=U2*W9Rq`ac@=e^?MJqv zSALgqEudaDNL`rT>&+kIK7N!^P*9kEAotYQeao0V$@68_b zVWwx!z$xBM2rUGBkH^%G|ESEJYPL$f+B7y=#D|WMXmi5$-79|*jdZ+JG*MZ50;;iC z(MU%-j)#EWh9d%S0wWSC`*%&doq*N(vpN!f>%x^QSDGRF3^#|Khz8hA2E;0R&oZsh z1r-KxX5%vKDFEwDVrRcMH_J9_PQ*ar(ehG^7^F|iT|ZMt`f;6u;9Elo5T-bu9ZZjl zvxEbDyLazqWMqW3X9~y4NeZ>TStUyASfa1_p~hzbh_9 Date: Wed, 10 Sep 2014 22:25:47 -0400 Subject: [PATCH 46/95] added last toy problem --- docs/source/methods/cmfd.rst | 132 ++++++++++++++++++++++++++++++++++- 1 file changed, 131 insertions(+), 1 deletion(-) diff --git a/docs/source/methods/cmfd.rst b/docs/source/methods/cmfd.rst index 67967e9339..39573c2fa6 100644 --- a/docs/source/methods/cmfd.rst +++ b/docs/source/methods/cmfd.rst @@ -453,7 +453,7 @@ because no fission neutrons appear with energies in the thermal group. +--------------------------------------------------------------------------------------------+----------------+---------------------------+ +--------------------------------------------------------------------------------------------+----------------+---------------------------+ | tally | score | filter | - +--------------------------------------------------------------------------------------------+----------------+---------------------------+ + +============================================================================================+================+===========================+ | \ :math:`\left\langle\overline{\overline\phi}_{l,m,n}^g | flux | mesh, energy | | \Delta_l^u\Delta_m^v\Delta_n^w\right\rangle` | | | +--------------------------------------------------------------------------------------------+----------------+---------------------------+ @@ -523,6 +523,136 @@ weights of neutrons from the source bank on a given spatial and energy mesh. Once weight adjustment factors were calculated, each neutron's statistical weight in the source bank was modified according to its location and energy. +------------------- +Toy Problem Example +------------------- + +Before applying CMFD to a large reactor, a simple $1$-D slab toy problem was +analyzed to understand how CMFD works. Table :ref:`tab_1Dtoyinput` presents +data used to construct this problem. For MFD, the mesh was 2 cm over the +geometry with one energy group. A comparison of fission source convergence +using Shannon entropy is shown in figure :ref:`fig_1Dentropy`. The figure +illustrates that it takes about 150 FSGs (equivalent to batches) to converge +the source with standard MC without CMFD. For the case with CMFD, it is +activated at batch 11 and directly affects the fission source for batch 12. +Convergence of the fission source is almost immediately reached. + +.. _tab_1Dtoyinput: + +.. table:: Input data for 1-D slab toy problem + + +--------------------------------------------+-------------------+ + +--------------------------------------------+-------------------+ + | Slab Length | 200 cm | + +============================================+===================+ + | Homogeneous material of :math:`\rm UO_2` | 19 g/cc density | + +--------------------------------------------+-------------------+ + | U-235 weight percent | 0.21 | + +--------------------------------------------+-------------------+ + | U-238 weight percent | 0.68 | + +--------------------------------------------+-------------------+ + | O-16 weight percent | 0.11 | + +--------------------------------------------+-------------------+ + | Number of particles per | 4,000,000 | + +--------------------------------------------+-------------------+ + | Number of inactive | 400 | + +--------------------------------------------+-------------------+ + +| +| + +.. _fig_1Dentropy: + +.. figure:: ../_images/entropy_1Dslab.png + :scale: 10 + + Source convergence comparison for $1$-D slab toy problem + +To further show this convergence, source distributions were edited at various +batches and compared. Figures :ref:`fig_toy6` to :ref:`fig_toy200` compare the +OpenMC source distribution from the no CMFD case, the OpenMC source +distribution from the CMFD case and the CMFD source distribution for six +different batches. Figure :ref:`fig_toy6` compares the distributions at batch +6. Here, CMFD has not been activated yet, so it is just plotted at zero. As +expected, the OpenMC source distributions from the two cases are equal because +CMFD has not yet affected it. From this plot, one can also see that the source +distribution is very flat because the initial guess was uniform over space. +Because the dominance ratio is close to unity, the source will slowly converge +to a cosine-like shape. Results from batch 10 are presented in figure +:ref:`fig_toy10`. The same information is shown in this plot, but the source is +slightly more converged. It is plotted here to show how little the source +changes in four batches. Batch 11 is the first time a CMFD source is +calculated. Right away, it appears as a smooth cosine-like shape as shown in +figure :ref:`fig_toy11`. Thus, when CMFD is fed back, its source shape will +modify the OpenMC source bank to preserve this distribution on the CMFD mesh. +On the next batch, shown in :ref:`fig_toy12`, the OpenMC source and the CMFD +source from the CMFD case match, while the OpenMC source from the no CMFD case +lags behind. Two more batches are shown in figure :ref:`fig_toy40` and figure +:ref:`fig_toy200` to illustrate that all source distributions eventually line +up at batch 200. + +.. _fig_toy6: + +.. figure:: ../_images/statepoint6.png + :scale: 10 + + Source at FSG 6 + +| + +.. _fig_toy10: + +.. figure:: ../_images/statepoint10.png + :scale: 10 + + Source at FSG 10 + +| + +.. _fig_toy11: + +.. figure:: ../_images/statepoint11.png + :scale: 10 + + Source at FSG 11 + +| + +.. _fig_toy12: + +.. figure:: ../_images/statepoint12.png + :scale: 10 + + Source at FSG 12 + +| + +.. _fig_toy40: + +.. figure:: ../_images/statepoint40.png + :scale: 10 + + Source at FSG 40 + +| + +.. _fig_toy200: + +.. figure:: ../_images/statepoint200.png + :scale: 10 + + Source at FSG 200 + +| + +This simple illustration shows the power of NDA. Because of the nature of the +diffusion equation, it can propagate and dampen higher harmonics much faster +than the MC transport solution. It should be noted here that this is a very +simplified problem where the dominance ratio was increased by changing the size +of the slab. Also, the source distribution is very smooth and there was only +one homogeneous material. The problem becomes more difficult to solve when +expanding to more spatial dimensions and complex materials. + ---------- References ---------- From dee0c2f10f5a31275a87fd814632b7f110c19d6c Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Thu, 11 Sep 2014 22:52:11 -0400 Subject: [PATCH 47/95] converted nuc_list from elemlist to list --- src/ace.F90 | 9 ++------- src/ace_header.F90 | 6 ++++-- src/cross_section.F90 | 35 +++++++++++++++++------------------ 3 files changed, 23 insertions(+), 27 deletions(-) diff --git a/src/ace.F90 b/src/ace.F90 index fb42180da0..6d4f3c740c 100644 --- a/src/ace.F90 +++ b/src/ace.F90 @@ -7,7 +7,7 @@ module ace use error, only: fatal_error, warning use fission, only: nu_total use global - use list_header, only: ListElemInt, ListInt + use list_header, only: ListInt use material_header, only: Material use output, only: write_message use set_header, only: SetChar @@ -1563,16 +1563,11 @@ contains integer :: i ! index in nuclides array integer :: j ! index in nuclides array - type(ListElemInt), pointer :: nuc_list => null() ! pointer to nuclide list do i = 1, n_nuclides_total - allocate(nuclides(i) % nuc_list) - nuc_list => nuclides(i) % nuc_list do j = 1, n_nuclides_total if (nuclides(i) % zaid == nuclides(j) % zaid) then - nuc_list % data = j - allocate(nuc_list % next) - nuc_list => nuc_list % next + call nuclides(i) % nuc_list % append(j) end if end do end do diff --git a/src/ace_header.F90 b/src/ace_header.F90 index 6d339891c9..89f4901709 100644 --- a/src/ace_header.F90 +++ b/src/ace_header.F90 @@ -2,7 +2,7 @@ module ace_header use constants, only: MAX_FILE_LEN use endf_header, only: Tab1 - use list_header, only: ListElemInt + use list_header, only: ListInt implicit none @@ -97,7 +97,7 @@ module ace_header real(8) :: kT ! temperature in MeV (k*T) ! Linked list of indices in nuclides array of instances of this same nuclide - type(ListElemInt), pointer :: nuc_list => null() + type(ListInt) :: nuc_list ! Energy grid information integer :: n_grid ! # of nuclide grid points @@ -416,6 +416,8 @@ module ace_header deallocate(this % reactions) end if + call this % nuc_list % clear() + end subroutine nuclide_clear end module ace_header diff --git a/src/cross_section.F90 b/src/cross_section.F90 index 0620cf11f8..fddc79dff0 100644 --- a/src/cross_section.F90 +++ b/src/cross_section.F90 @@ -342,21 +342,22 @@ contains integer, intent(in) :: i_nuclide ! index into nuclides array real(8), intent(in) :: E ! energy - integer :: i_energy ! index for energy - integer :: i_low ! band index at lower bounding energy - integer :: i_up ! band index at upper bounding energy - real(8) :: f ! interpolation factor - real(8) :: r ! pseudo-random number - real(8) :: elastic ! elastic cross section - real(8) :: capture ! (n,gamma) cross section - real(8) :: fission ! fission cross section - real(8) :: inelastic ! inelastic cross section - logical :: same_nuc ! do we know the xs for this nuclide at this energy? + integer :: i ! loop index + integer :: i_energy ! index for energy + integer :: i_low ! band index at lower bounding energy + integer :: i_up ! band index at upper bounding energy + integer :: same_nuc_idx ! index of same nuclide + real(8) :: f ! interpolation factor + real(8) :: r ! pseudo-random number + real(8) :: elastic ! elastic cross section + real(8) :: capture ! (n,gamma) cross section + real(8) :: fission ! fission cross section + real(8) :: inelastic ! inelastic cross section + logical :: same_nuc ! do we know the xs for this nuclide at this energy? type(UrrData), pointer, save :: urr => null() type(Nuclide), pointer, save :: nuc => null() type(Reaction), pointer, save :: rxn => null() - type(ListElemInt), pointer :: nuc_list => null() -!$omp threadprivate(urr, nuc, rxn, nuc_list) +!$omp threadprivate(urr, nuc, rxn) micro_xs(i_nuclide) % use_ptable = .true. @@ -381,18 +382,16 @@ contains ! this energy but a different temperature, use the original random number to ! preserve correlation of temperature in probability tables same_nuc = .false. - nuc_list => nuc % nuc_list - do - if (E /= ZERO .and. E == micro_xs(nuc_list % data) % last_E) then + do i = 1, nuc % nuc_list % size() + if (E /= ZERO .and. E == micro_xs(nuc % nuc_list % get_item(i)) % last_E) then same_nuc = .true. + same_nuc_idx = i exit end if - nuc_list => nuc_list % next - if (.not. associated(nuc_list % next)) exit end do if (same_nuc) then - r = micro_xs(nuc_list % data) % last_prn + r = micro_xs(nuc % nuc_list % get_item(same_nuc_idx)) % last_prn else r = prn() micro_xs(i_nuclide) % last_prn = r From b5839d99677184981566d8c445d1ba68037877e4 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Thu, 11 Sep 2014 23:32:46 -0400 Subject: [PATCH 48/95] inititalized name_0K string to default value --- src/ace_header.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/ace_header.F90 b/src/ace_header.F90 index 89f4901709..76492dfe80 100644 --- a/src/ace_header.F90 +++ b/src/ace_header.F90 @@ -114,7 +114,7 @@ module ace_header ! Resonance scattering info logical :: resonant = .false. ! resonant scatterer? - character(10) :: name_0K ! name of 0K nuclide, e.g. 92235.00c + character(10) :: name_0K = '' ! name of 0K nuclide, e.g. 92235.00c character(16) :: scheme ! target velocity sampling scheme integer :: n_grid_0K ! number of 0K energy grid points real(8), allocatable :: energy_0K(:) ! energy grid for 0K xs From 1c797abc38af1a774b182fd78e855ea03240f0a3 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Fri, 12 Sep 2014 09:30:05 -0400 Subject: [PATCH 49/95] added rest of intents and moved convergence logical --- src/cmfd_solver.F90 | 74 ++++++++++++++++++++++++------------------- src/matrix_header.F90 | 18 +++++------ src/vector_header.F90 | 4 +-- 3 files changed, 52 insertions(+), 44 deletions(-) diff --git a/src/cmfd_solver.F90 b/src/cmfd_solver.F90 index 9a2ebceb1b..69a2829039 100644 --- a/src/cmfd_solver.F90 +++ b/src/cmfd_solver.F90 @@ -11,7 +11,6 @@ module cmfd_solver private public :: cmfd_solver_execute - logical :: iconv ! did the problem converged real(8) :: k_n ! new k-eigenvalue real(8) :: k_o ! old k-eigenvalue real(8) :: k_s ! shift of eigenvalue @@ -38,11 +37,11 @@ module cmfd_solver subroutine linsolve(A, b, x, tol, i) import :: Matrix import :: Vector - type(Matrix) :: A - type(Vector) :: b - type(Vector) :: x - real(8) :: tol - integer :: i + type(Matrix), intent(inout) :: A + type(Vector), intent(inout) :: b + type(Vector), intent(inout) :: x + real(8), intent(in) :: tol + integer, intent(out) :: i end subroutine linsolve end interface @@ -56,7 +55,7 @@ contains use global, only: cmfd_adjoint_type, time_cmfdbuild, time_cmfdsolve - logical, optional :: adjoint ! adjoint calc + logical, optional, intent(in) :: adjoint ! adjoint calc logical :: physical_adjoint = .false. @@ -106,7 +105,7 @@ contains cmfd_ktol, cmfd_stol use global, only: cmfd_write_matrices - logical :: adjoint + logical, intent(in) :: adjoint integer :: n ! problem size real(8) :: guess ! initial guess @@ -145,7 +144,7 @@ contains ! Fill in production matrix call build_prod_matrix(prod, adjoint=adjoint) - ! Setup petsc for everything + ! Finalize setup of CSR matrices call loss % assemble() call prod % assemble() if (cmfd_write_matrices) then @@ -209,11 +208,13 @@ contains subroutine execute_power_iter() use constants, only: ONE - use global, only: cmfd_atoli, cmfd_rtoli + use error, only: fatal_error + use global, only: cmfd_atoli, cmfd_rtoli, message integer :: i ! iteration counter integer :: innerits ! # of inner iterations integer :: totalits ! total number of inners + logical :: iconv ! did the problem converged real(8) :: atoli ! absolute minimum tolerance real(8) :: rtoli ! relative tolerance based on source conv real(8) :: toli ! the current tolerance of inners @@ -233,6 +234,12 @@ contains ! Begin power iteration do i = 1, 10000 + ! Check if reached iteration 10000 + if (i == 10000) then + message = 'Reached maximum iterations in CMFD power iteration solver.' + call fatal_error() + end if + ! Compute source vector call prod % vector_multiply(phi_o, s_o) @@ -255,7 +262,7 @@ contains s_o % val = s_o % val * k_lo ! Check convergence - call convergence(i, innerits) + call convergence(i, innerits, iconv) totalits = totalits + innerits ! Break loop if converged @@ -304,14 +311,15 @@ contains ! CONVERGENCE checks the convergence of the CMFD problem !=============================================================================== - subroutine convergence(iter, innerits) + subroutine convergence(iter, innerits, iconv) use constants, only: ONE, TINY_BIT use global, only: cmfd_power_monitor, master use, intrinsic :: ISO_FORTRAN_ENV - integer :: iter ! outer iteration number - integer :: innerits ! inner iteration nubmer + integer, intent(in) :: iter ! outer iteration number + integer, intent(in) :: innerits ! inner iteration nubmer + logical, intent(out) :: iconv ! convergence logical ! Reset convergence flag iconv = .false. @@ -349,11 +357,11 @@ contains use constants, only: ONE, ZERO use global, only: cmfd, cmfd_spectral - type(Matrix) :: A ! coefficient matrix - type(Vector) :: b ! right hand side vector - type(Vector) :: x ! unknown vector - real(8) :: tol ! tolerance on final error - integer :: its ! number of inner iterations + type(Matrix), intent(inout) :: A ! coefficient matrix + type(Vector), intent(inout) :: b ! right hand side vector + type(Vector), intent(inout) :: x ! unknown vector + real(8), intent(in) :: tol ! tolerance on final error + integer, intent(out) :: its ! number of inner iterations integer :: g ! group index integer :: i ! loop counter for x @@ -449,11 +457,11 @@ contains use constants, only: ONE, ZERO use global, only: cmfd, cmfd_spectral - type(Matrix) :: A ! coefficient matrix - type(Vector) :: b ! right hand side vector - type(Vector) :: x ! unknown vector - real(8) :: tol ! tolerance on final error - integer :: its ! number of inner iterations + type(Matrix), intent(inout) :: A ! coefficient matrix + type(Vector), intent(inout) :: b ! right hand side vector + type(Vector), intent(inout) :: x ! unknown vector + real(8), intent(in) :: tol ! tolerance on final error + integer, intent(out) :: its ! number of inner iterations integer :: g ! group index integer :: i ! loop counter for x @@ -646,15 +654,15 @@ contains use global, only: cmfd, cmfd_coremap - integer :: i ! iteration counter for x - integer :: j ! iteration counter for y - integer :: k ! iteration counter for z - integer :: g ! iteration counter for groups - integer :: irow ! iteration counter over row (0 reference) - integer :: nx ! maximum number of x cells - integer :: ny ! maximum number of y cells - integer :: nz ! maximum number of z cells - integer :: ng ! maximum number of groups + integer, intent(out) :: i ! iteration counter for x + integer, intent(out) :: j ! iteration counter for y + integer, intent(out) :: k ! iteration counter for z + integer, intent(out) :: g ! iteration counter for groups + integer, intent(in) :: irow ! iteration counter over row (0 reference) + integer, intent(in) :: nx ! maximum number of x cells + integer, intent(in) :: ny ! maximum number of y cells + integer, intent(in) :: nz ! maximum number of z cells + integer, intent(in) :: ng ! maximum number of groups ! Check for core map if (cmfd_coremap) then diff --git a/src/matrix_header.F90 b/src/matrix_header.F90 index 3f5aa204f7..3e3d4ad0db 100644 --- a/src/matrix_header.F90 +++ b/src/matrix_header.F90 @@ -368,11 +368,11 @@ contains subroutine matrix_search_indices(self, row, col, idx, found) - class(Matrix) :: self - integer :: row - integer :: col - integer :: idx - logical :: found + class(Matrix), intent(inout) :: self + integer, intent(in) :: row + integer, intent(in) :: col + integer, intent(out) :: idx + logical, intent(out) :: found integer :: j @@ -396,8 +396,8 @@ contains subroutine matrix_write(self, filename) - character(*) :: filename - class(Matrix) :: self + character(*), intent(in) :: filename + class(Matrix), intent(inout) :: self integer :: unit_ integer :: i @@ -421,8 +421,8 @@ contains subroutine matrix_copy(self, mattocopy) - class(Matrix) :: self - type(Matrix) :: mattocopy + class(Matrix), intent(inout) :: self + type(Matrix), intent(in) :: mattocopy ! Set n and nnz self % n_count = mattocopy % n_count diff --git a/src/vector_header.F90 b/src/vector_header.F90 index 4d8cb2cf5c..755d374628 100644 --- a/src/vector_header.F90 +++ b/src/vector_header.F90 @@ -132,8 +132,8 @@ contains subroutine vector_copy(self, vectocopy) - class(Vector), target :: self - type(Vector) :: vectocopy + class(Vector), target, intent(inout) :: self + type(Vector), intent(in) :: vectocopy ! Preallocate vector if (.not.allocated(self % data)) allocate(self % data(vectocopy % n)) From 70785e62bddd2bee02744c085f7db1eb104d592f Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Fri, 12 Sep 2014 10:01:56 -0400 Subject: [PATCH 50/95] CMFD tests no longer removed if PETSc is not enabled --- src/CMakeLists.txt | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index fc6c6630cc..acf7314bbc 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -147,9 +147,7 @@ endif() # PETSc for CMFD functionality #=============================================================================== -set (PETSC_ENABLED FALSE) if(petsc) - set(PETSC_ENABLED TRUE) find_package(PETSc REQUIRED HINTS $ENV{PETSC_DIR}/conf) find_library(libpetsc petsc $ENV{PETSC_DIR}/lib) @@ -275,14 +273,6 @@ include(CTest) # Get a list of all the tests to run file(GLOB_RECURSE TESTS ${CMAKE_CURRENT_SOURCE_DIR}/../tests/test_*.py) -# Check to see if PETSC is compiled for CMFD tests -if (NOT ${PETSC_ENABLED}) - file(GLOB_RECURSE CMFD_TESTS ${CMAKE_CURRENT_SOURCE_DIR}/../tests/test_cmfd*.py) - foreach(cmfd_test in ${CMFD_TESTS}) - list(REMOVE_ITEM TESTS ${cmfd_test}) - endforeach(cmfd_test) -endif(NOT ${PETSC_ENABLED}) - # Check for MEM_CHECK and COVERAGE variables if (DEFINED ENV{MEM_CHECK}) set(MEM_CHECK $ENV{MEM_CHECK}) From fe3b178cd41e4120ec45031c6bd90be5abae2aa0 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Fri, 12 Sep 2014 10:35:11 -0400 Subject: [PATCH 51/95] allow power iteration CMFD to run without PETSc --- src/CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index fc6c6630cc..8a9424e79d 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -277,7 +277,7 @@ file(GLOB_RECURSE TESTS ${CMAKE_CURRENT_SOURCE_DIR}/../tests/test_*.py) # Check to see if PETSC is compiled for CMFD tests if (NOT ${PETSC_ENABLED}) - file(GLOB_RECURSE CMFD_TESTS ${CMAKE_CURRENT_SOURCE_DIR}/../tests/test_cmfd*.py) + file(GLOB_RECURSE CMFD_TESTS ${CMAKE_CURRENT_SOURCE_DIR}/../tests/test_cmfd_jfnk.py) foreach(cmfd_test in ${CMFD_TESTS}) list(REMOVE_ITEM TESTS ${cmfd_test}) endforeach(cmfd_test) From 9ef26276c82c54162b22927a9ac6ed73b7a8b813 Mon Sep 17 00:00:00 2001 From: Nick Horelik Date: Fri, 12 Sep 2014 10:55:19 -0400 Subject: [PATCH 52/95] Added support for plotting ufs, entropy, and cmfd meshes --- src/input_xml.F90 | 99 ++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 80 insertions(+), 19 deletions(-) diff --git a/src/input_xml.F90 b/src/input_xml.F90 index 6f1aa5fd01..6ff284152c 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -512,6 +512,7 @@ contains allocate(entropy_mesh) allocate(entropy_mesh % lower_left(3)) allocate(entropy_mesh % upper_right(3)) + allocate(entropy_mesh % width(3)) ! Copy values call get_node_array(node_entropy, "lower_left", & @@ -543,6 +544,11 @@ contains ! Copy dimensions call get_node_array(node_entropy, "dimension", entropy_mesh % dimension) + + ! Calculate width + entropy_mesh % width = (entropy_mesh % upper_right - & + entropy_mesh % lower_left) / entropy_mesh % dimension + end if ! Turn on Shannon entropy calculation @@ -2773,10 +2779,12 @@ contains integer :: i, j integer :: n_cols, col_id, n_comp, n_masks, n_meshlines integer :: meshid + integer :: i_mesh integer, allocatable :: iarray(:) logical :: file_exists ! does plots.xml file exist? character(MAX_LINE_LEN) :: filename ! absolute path to plots.xml character(MAX_LINE_LEN) :: temp_str + character(MAX_WORD_LEN) :: meshtype type(ObjectPlot), pointer :: pl => null() type(Node), pointer :: doc => null() type(Node), pointer :: node_plot => null() @@ -3060,11 +3068,11 @@ contains ! Get pointer to meshlines call get_list_item(node_meshline_list, 1, node_meshlines) - ! Ensure that there is a mesh id for this meshlines specification - if (check_for_node(node_meshlines, "mesh")) then - call get_node_value(node_meshlines, "mesh", meshid) + ! Check mesh type + if (check_for_node(node_meshlines, "meshtype")) then + call get_node_value(node_meshlines, "meshtype", meshtype) else - message = "Must specify a mesh id for meshlines " // & + message = "Must specify a meshtype for meshlines " // & "specification in plot " // trim(to_str(pl % id)) call fatal_error() end if @@ -3084,8 +3092,8 @@ contains ! Check and make sure 3 values are specified for RGB if (get_arraysize_double(node_meshlines, "color") /= 3) then - message = "Bad RGB for meshlines color " & - // "in plot " // trim(to_str(pl % id)) + message = "Bad RGB for meshlines color " // & + "in plot " // trim(to_str(pl % id)) call fatal_error() end if @@ -3097,22 +3105,75 @@ contains end if - ! Check if the specified tally mesh exists - if (mesh_dict % has_key(meshid)) then - pl % meshlines_mesh => meshes(mesh_dict % get_key(meshid)) - if (meshes(meshid) % type /= LATTICE_RECT) then - message = "Non-rectangular mesh specified in meshlines for" // & - " plot " // trim(to_str(pl % id)) + ! Set mesh based on type + select case (trim(meshtype)) + case ('ufs') + + if (.not. associated(ufs_mesh)) then + message = "No UFS mesh for meshlines on plot " // & + trim(to_str(pl % id)) call fatal_error() end if - else - message = "Could not find mesh " // & - trim(to_str(meshid)) // & - " specified in meshlines for plot " // & - trim(to_str(pl % id)) - call fatal_error() - end if + + pl % meshlines_mesh => ufs_mesh + + case ('cmfd') + + if (.not. cmfd_run) then + message = "Need CMFD run to plot CMFD mesh for meshlines " // & + "on plot " // trim(to_str(pl % id)) + call fatal_error() + end if + + i_mesh = cmfd_tallies(1) % & + filters(cmfd_tallies(1) % find_filter(FILTER_MESH)) % & + int_bins(1) + pl % meshlines_mesh => meshes(i_mesh) + + case ('entropy') + if (.not. associated(entropy_mesh)) then + message = "No entropy mesh for meshlines on plot " // & + trim(to_str(pl % id)) + call fatal_error() + end if + + pl % meshlines_mesh => entropy_mesh + + case ('tally') + + ! Ensure that there is a mesh id if the type is tally + if (check_for_node(node_meshlines, "id")) then + call get_node_value(node_meshlines, "id", meshid) + else + message = "Must specify a mesh id for meshlines tally mesh" // & + "specification in plot " // trim(to_str(pl % id)) + call fatal_error() + end if + + ! Check if the specified tally mesh exists + if (mesh_dict % has_key(meshid)) then + pl % meshlines_mesh => meshes(mesh_dict % get_key(meshid)) + if (meshes(meshid) % type /= LATTICE_RECT) then + message = "Non-rectangular mesh specified in meshlines " // & + "for plot " // trim(to_str(pl % id)) + call fatal_error() + end if + else + message = "Could not find mesh " // & + trim(to_str(meshid)) // & + " specified in meshlines for plot " // & + trim(to_str(pl % id)) + call fatal_error() + end if + + case default + message = "Invalid type for meshlines on plot " // & + trim(to_str(pl % id)) // ": " // trim(meshtype) + call fatal_error() + end select + + end select end if From 378aa92e668e5a0f064b09e96f22fb0c2fe3f28c Mon Sep 17 00:00:00 2001 From: Nick Horelik Date: Fri, 12 Sep 2014 10:58:15 -0400 Subject: [PATCH 53/95] Allowed read_tallies_xml to run in plotting mode, only to read mesh info --- src/input_xml.F90 | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/input_xml.F90 b/src/input_xml.F90 index 6ff284152c..42b684abf6 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -36,7 +36,7 @@ contains if (run_mode /= MODE_PLOTTING) call read_cross_sections_xml() call read_geometry_xml() call read_materials_xml() - if (run_mode /= MODE_PLOTTING) call read_tallies_xml() + call read_tallies_xml() if (cmfd_run) call configure_cmfd() end subroutine read_input_xml @@ -1909,7 +1909,7 @@ contains end if ! Allocate tally array - if (n_user_tallies > 0) then + if (n_user_tallies > 0 .and. run_mode /= MODE_PLOTTING) then call add_tallies("user", n_user_tallies) end if @@ -2058,6 +2058,9 @@ contains call mesh_dict % add_key(m % id, i) end do + ! We only need the mesh info for plotting + if (run_mode == MODE_PLOTTING) return + ! ========================================================================== ! READ TALLY DATA From d5ce05cf363b654c66fc6ef6944116c57fcfea57 Mon Sep 17 00:00:00 2001 From: Nick Horelik Date: Fri, 12 Sep 2014 11:04:05 -0400 Subject: [PATCH 54/95] Updates documentation for meshline plotting --- docs/source/usersguide/input.rst | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/docs/source/usersguide/input.rst b/docs/source/usersguide/input.rst index 5cc595ed50..44f67e62c1 100644 --- a/docs/source/usersguide/input.rst +++ b/docs/source/usersguide/input.rst @@ -1298,11 +1298,16 @@ attributes or sub-elements. These are not used in "voxel" plots: The special ``meshlines`` sub-element allows for plotting the boundaries of a tally mesh on top of a plot. Only one ``meshlines`` element is allowed per ``plot`` element, and it must contain as attributes or sub-elements a mesh - id and a linewidth, as well as an optional color: + type and a linewidth, as well as an optional color: - :mesh: + :meshtype: + The type of the mesh to be plotted. Valid options are "tally", "entropy", + "ufs", and "cmfd". If plotting "tally" meshes, the id of the mesh to plot + must be specified with the ``id`` sub-element. + + :id: A single integer id number for the mesh specified on ``tallies.xml`` that - should be plotted. + should be plotted. This element is only required for ``meshtype="tally"``. :linewidth: A single integer number of pixels of linewidth to specify for the mesh @@ -1318,9 +1323,6 @@ attributes or sub-elements. These are not used in "voxel" plots: *Default*: None - .. warning:: Meshline plotting is currently only implemented for plots with - an "xy" basis. - ------------------------------ CMFD Specification -- cmfd.xml ------------------------------ From c8e5f984ad29c1fddc67949101eddacd0d43b1bf Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Fri, 12 Sep 2014 13:28:26 -0400 Subject: [PATCH 55/95] re-added compiler directives around petsc error int --- src/vector_header.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/vector_header.F90 b/src/vector_header.F90 index 755d374628..05cc7e3cde 100644 --- a/src/vector_header.F90 +++ b/src/vector_header.F90 @@ -28,7 +28,9 @@ module vector_header # endif end type Vector +#ifdef PETSC integer :: petsc_err ! petsc error code +#endif contains From b5babb67f1ea50f367c5d1bb5712569589a798bd Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Tue, 16 Sep 2014 16:22:16 -0400 Subject: [PATCH 56/95] removed $ from docs --- docs/source/methods/cmfd.rst | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/docs/source/methods/cmfd.rst b/docs/source/methods/cmfd.rst index 39573c2fa6..78472df37d 100644 --- a/docs/source/methods/cmfd.rst +++ b/docs/source/methods/cmfd.rst @@ -77,7 +77,7 @@ In eq. :eq:`eq_neut_bal` the parameters are defined as: * :math:`\left\langle\overline{J}^{u,g}_{l\pm 1/2,m,n}\Delta_m^v\Delta_n^w\right\rangle` --- surface area-integrated net current over surface :math:`(l\pm 1/2,m,n)` with surface normal in direction - $u$ in energy group :math:`g`. By dividing this quantity by the transverse + :math:`u` in energy group :math:`g`. By dividing this quantity by the transverse area, :math:`\Delta_m^v\Delta_n^w`, the surface area-averaged net current can be computed. * :math:`\left\langle\overline{\overline\Sigma}_{t_{l,m,n}}^g @@ -189,7 +189,7 @@ where \overline{\overline\phi}_{l,m,n}^g\Delta_l^u\Delta_m^v\Delta_n^w\right\rangle. Note that the transport reaction rate is calculated from the total reaction rate -reduced by the $P_1$ scattering production reaction rate. Equation :eq:`eq_transD` +reduced by the :math:`P_1` scattering production reaction rate. Equation :eq:`eq_transD` does not represent the best definition of diffusion coefficients from MC; however, it is very simple and usually fits into MC tally frameworks easily. Different methods to calculate more accurate diffusion coefficients can @@ -527,7 +527,7 @@ weight in the source bank was modified according to its location and energy. Toy Problem Example ------------------- -Before applying CMFD to a large reactor, a simple $1$-D slab toy problem was +Before applying CMFD to a large reactor, a simple 1-D slab toy problem was analyzed to understand how CMFD works. Table :ref:`tab_1Dtoyinput` presents data used to construct this problem. For MFD, the mesh was 2 cm over the geometry with one energy group. A comparison of fission source convergence @@ -566,7 +566,7 @@ Convergence of the fission source is almost immediately reached. .. figure:: ../_images/entropy_1Dslab.png :scale: 10 - Source convergence comparison for $1$-D slab toy problem + Source convergence comparison for 1-D slab toy problem To further show this convergence, source distributions were edited at various batches and compared. Figures :ref:`fig_toy6` to :ref:`fig_toy200` compare the From e2c9d7550793ae01cb732987e2fd40dac5ddd4f8 Mon Sep 17 00:00:00 2001 From: Nicholas Horelik Date: Tue, 16 Sep 2014 22:42:41 -0400 Subject: [PATCH 57/95] Clarified documentation --- docs/source/usersguide/input.rst | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/docs/source/usersguide/input.rst b/docs/source/usersguide/input.rst index 44f67e62c1..c97ab8ac1e 100644 --- a/docs/source/usersguide/input.rst +++ b/docs/source/usersguide/input.rst @@ -1295,10 +1295,10 @@ attributes or sub-elements. These are not used in "voxel" plots: *Default*: None :meshlines: - The special ``meshlines`` sub-element allows for plotting the boundaries of + The ``meshlines`` sub-element allows for plotting the boundaries of a tally mesh on top of a plot. Only one ``meshlines`` element is allowed per ``plot`` element, and it must contain as attributes or sub-elements a mesh - type and a linewidth, as well as an optional color: + type and a linewidth. Optionally, a color may be specified for the overlay: :meshtype: The type of the mesh to be plotted. Valid options are "tally", "entropy", @@ -1317,7 +1317,7 @@ attributes or sub-elements. These are not used in "voxel" plots: :color: Specifies the custom color for the meshlines boundaries. Should be 3 - integers separated by spaces. This element is optional. + integers separated by whitespace. This element is optional. *Default*: 0 0 0 (black) From 224dcb48c878df10934ddf47c033f1688e2891f1 Mon Sep 17 00:00:00 2001 From: Nicholas Horelik Date: Tue, 16 Sep 2014 22:55:28 -0400 Subject: [PATCH 58/95] Tidied up select case --- src/input_xml.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/input_xml.F90 b/src/input_xml.F90 index 42b684abf6..f852d2243d 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -3061,11 +3061,8 @@ contains end if select case(n_meshlines) - case default - message = "Mutliple meshlines" // & - " specified in plot " // trim(to_str(pl % id)) - call fatal_error() case (0) + ! Skip if no meshlines are specified case (1) ! Get pointer to meshlines @@ -3176,7 +3173,10 @@ contains call fatal_error() end select - + case default + message = "Mutliple meshlines" // & + " specified in plot " // trim(to_str(pl % id)) + call fatal_error() end select end if From 1c939cb2403d429b2af0f8467ff6b6347ee50b07 Mon Sep 17 00:00:00 2001 From: Nicholas Horelik Date: Tue, 16 Sep 2014 22:57:22 -0400 Subject: [PATCH 59/95] Added intent --- src/plot.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/plot.F90 b/src/plot.F90 index f6a41c9513..91b2520eb4 100644 --- a/src/plot.F90 +++ b/src/plot.F90 @@ -186,8 +186,8 @@ contains !=============================================================================== subroutine draw_mesh_lines(pl, img) - type(ObjectPlot), pointer :: pl - type(Image) :: img + type(ObjectPlot), pointer, intent(in) :: pl + type(Image), intent(inout) :: img logical :: in_mesh integer :: out_, in_ ! pixel location From bb1785c0629dd65c5fca7c439f3430d7f447a42e Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Wed, 17 Sep 2014 16:51:12 -0400 Subject: [PATCH 60/95] removed subroutine to enforce neutron balance --- src/cmfd_data.F90 | 148 +-------------------------------------------- src/cmfd_input.F90 | 8 --- src/global.F90 | 3 - 3 files changed, 1 insertion(+), 158 deletions(-) diff --git a/src/cmfd_data.F90 b/src/cmfd_data.F90 index ef637b4c0b..116c9bacb1 100644 --- a/src/cmfd_data.F90 +++ b/src/cmfd_data.F90 @@ -20,8 +20,7 @@ contains use cmfd_header, only: allocate_cmfd use constants, only: CMFD_NOACCEL - use global, only: cmfd, cmfd_coremap, cmfd_downscatter, & - cmfd_fix_balance + use global, only: cmfd, cmfd_coremap, cmfd_downscatter ! Check for core map and set it up if ((cmfd_coremap) .and. (cmfd%mat_dim == CMFD_NOACCEL)) call set_coremap() @@ -32,9 +31,6 @@ contains ! Compute effective downscatter cross section if (cmfd_downscatter) call compute_effective_downscatter() - ! Compute perfect balance - if (cmfd_fix_balance) call fix_neutron_balance() - ! Check neutron balance call neutron_balance() @@ -912,148 +908,6 @@ contains end function get_reflector_albedo -!=============================================================================== -! FIX_NEUTRON_BALANCE is a method to adjust parameters to have perfect balance -!=============================================================================== - - subroutine fix_neutron_balance() - - use constants, only: ONE, ZERO, CMFD_NOACCEL - use global, only: cmfd, message - use output, only: write_message - - integer :: nx ! number of mesh cells in x direction - integer :: ny ! number of mesh cells in y direction - integer :: nz ! number of mesh cells in z direction - integer :: ng ! number of energy groups - integer :: i ! iteration counter for x - integer :: j ! iteration counter for y - integer :: k ! iteration counter for z - integer :: l ! iteration counter for surface - real(8) :: leak1 ! leakage rate in group 1 - real(8) :: leak2 ! leakage rate in group 2 - real(8) :: flux1 ! group 1 volume int flux - real(8) :: flux2 ! group 2 volume int flux - real(8) :: sigt1 ! group 1 total xs - real(8) :: sigt2 ! group 2 total xs - real(8) :: sigs11 ! scattering transfer 1 --> 1 - real(8) :: sigs21 ! scattering transfer 2 --> 1 - real(8) :: sigs12 ! scattering transfer 1 --> 2 - real(8) :: sigs22 ! scattering transfer 2 --> 2 - real(8) :: nsigf11 ! fission transfer 1 --> 1 - real(8) :: nsigf21 ! fission transfer 2 --> 1 - real(8) :: nsigf12 ! fission transfer 1 --> 2 - real(8) :: nsigf22 ! fission transfer 2 --> 2 - real(8) :: siga1 ! group 1 abs xs - real(8) :: siga2 ! group 2 abs xs - real(8) :: sigs12_eff ! effective downscatter xs - real(8) :: a ! matrix (1,1) element for balance - real(8) :: b ! matrix (1,2) element for balance - real(8) :: c ! matrix (2,1) element for balance - real(8) :: d ! matrix (2,2) element for balance - real(8) :: r1 ! right hand side element 1 - real(8) :: r2 ! right hand side element 2 - real(8) :: det ! determinant of balance matrix - real(8) :: keff_bal ! keffective for balance eq. - - message = 'Correcting neutron balance' - call write_message(1) - - ! Extract spatial and energy indices from object - nx = cmfd % indices(1) - ny = cmfd % indices(2) - nz = cmfd % indices(3) - ng = cmfd % indices(4) - - keff_bal = cmfd % keff_bal - - ! Return if not two groups - if (ng /= 2) return - - ! Begin loop around space and energy groups - ZLOOP: do k = 1, nz - - YLOOP: do j = 1, ny - - XLOOP: do i = 1, nx - - ! Check for active mesh - if (allocated(cmfd%coremap)) then - if (cmfd%coremap(i,j,k) == CMFD_NOACCEL) cycle - end if - - ! Compute leakage in groups 1 and 2 - leak1 = ZERO - leak2 = ZERO - LEAK: do l = 1, 3 - - leak1 = leak1 + ((cmfd % current(4*l,1,i,j,k) - & - cmfd % current(4*l-1,1,i,j,k))) - & - ((cmfd % current(4*l-2,1,i,j,k) - & - cmfd % current(4*l-3,1,i,j,k))) - - leak2 = leak2 + ((cmfd % current(4*l,2,i,j,k) - & - cmfd % current(4*l-1,2,i,j,k))) - & - ((cmfd % current(4*l-2,2,i,j,k) - & - cmfd % current(4*l-3,2,i,j,k))) - - - end do LEAK - - ! Extract cross sections and flux from object - flux1 = cmfd % flux(1,i,j,k) - flux2 = cmfd % flux(2,i,j,k) - sigt1 = cmfd % totalxs(1,i,j,k) - sigt2 = cmfd % totalxs(2,i,j,k) - sigs11 = cmfd % scattxs(1,1,i,j,k) - sigs21 = cmfd % scattxs(2,1,i,j,k) - sigs12 = cmfd % scattxs(1,2,i,j,k) - sigs22 = cmfd % scattxs(2,2,i,j,k) - nsigf11 = cmfd % nfissxs(1,1,i,j,k) - nsigf21 = cmfd % nfissxs(2,1,i,j,k) - nsigf12 = cmfd % nfissxs(1,2,i,j,k) - nsigf22 = cmfd % nfissxs(2,2,i,j,k) - - ! Compute absorption xs - siga1 = sigt1 - sigs11 - sigs12 - siga2 = sigt2 - sigs22 - sigs21 - - ! Create matrix and solve for effective downscatter and thermal flux - a = flux1 - b = -ONE/keff_bal*nsigf21 - c = flux1 - d = -siga2 + ONE/keff_bal*nsigf22 - det = a*d - b*c - r1 = ONE/keff_bal*nsigf11*flux1 - siga1*flux1 - leak1 - r2 = leak2 - ONE/keff_bal*nsigf12*flux1 - sigs12_eff = ONE/det*(d*r1 - b*r2) - flux2 = ONE/det*(a*r2 - c*r1) - - ! Recompute total cross sections (use effective and no upscattering) - sigt1 = siga1 + sigs11 + sigs12_eff - sigt2 = siga2 + sigs22 - - ! Record total xs - cmfd % totalxs(1,i,j,k) = sigt1 - cmfd % totalxs(2,i,j,k) = sigt2 - - ! Record effective downscatter xs - cmfd % scattxs(1,2,i,j,k) = sigs12_eff - - ! Zero out upscatter cross section - cmfd % scattxs(2,1,i,j,k) = ZERO - - ! Record thermal flux - cmfd % flux(2,i,j,k) = flux2 - - end do XLOOP - - end do YLOOP - - end do ZLOOP - - end subroutine fix_neutron_balance - !=============================================================================== ! COMPUTE_EFFECTIVE_DOWNSCATTER changes downscatter rate for zero upscatter !=============================================================================== diff --git a/src/cmfd_input.F90 b/src/cmfd_input.F90 index 32625034c3..2e531a8157 100644 --- a/src/cmfd_input.F90 +++ b/src/cmfd_input.F90 @@ -174,14 +174,6 @@ contains dhat_reset = .true. end if - ! Enforce perfect neutron balance - if (check_for_node(doc, "balance")) then - call get_node_value(doc, "balance", temp_str) - call lower_case(temp_str) - if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') & - cmfd_fix_balance = .true. - end if - ! Set the solver type if (check_for_node(doc, "solver")) & call get_node_value(doc, "solver", cmfd_solver_type) diff --git a/src/global.F90 b/src/global.F90 index e2509ce1a7..cad98dc329 100644 --- a/src/global.F90 +++ b/src/global.F90 @@ -325,9 +325,6 @@ module global ! Flag to reset dhats to zero logical :: dhat_reset = .false. - ! Flag to enforce neutron balance - logical :: cmfd_fix_balance = .false. - ! Flag to activate neutronic feedback via source weights logical :: cmfd_feedback = .false. From f1f7e76d60fa36137d01e560cfb0103ed3f31e10 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Wed, 17 Sep 2014 16:55:50 -0400 Subject: [PATCH 61/95] removed CMFD debugging code --- src/CMakeLists.txt | 10 ----- src/cmfd_data.F90 | 101 ------------------------------------------- src/cmfd_execute.F90 | 9 ---- 3 files changed, 120 deletions(-) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 3f336767cd..8a9424e79d 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -26,7 +26,6 @@ option(debug "Compile with debug flags" OFF) option(optimize "Turn on all compiler optimization flags" OFF) option(verbose "Create verbose Makefiles" OFF) option(coverage "Compile with flags" OFF) -option(cmfd_debug "Compile with cmfd debug flags" OFF) if (verbose) set(CMAKE_VERBOSE_MAKEFILE on) @@ -215,15 +214,6 @@ if(GIT_SHA1_SUCCESS EQUAL 0) add_definitions(-DGIT_SHA1="${GIT_SHA1}") endif() -#=============================================================================== -# CMFD debug flags -#=============================================================================== - -if (cmfd_debug) - message("-- CMFD Debug flags on") - add_definitions(-DCMFD_DEBUG) -endif() - #=============================================================================== # FoX Fortran XML Library #=============================================================================== diff --git a/src/cmfd_data.F90 b/src/cmfd_data.F90 index 116c9bacb1..3ed77d78be 100644 --- a/src/cmfd_data.F90 +++ b/src/cmfd_data.F90 @@ -60,10 +60,6 @@ contains use string, only: to_str use tally_header, only: TallyObject -#ifdef CMFD_DEBUG - use global, only: current_batch -#endif - integer :: nx ! number of mesh cells in x direction integer :: ny ! number of mesh cells in y direction integer :: nz ! number of mesh cells in z direction @@ -84,11 +80,6 @@ contains real(8) :: flux ! temp variable for flux type(TallyObject), pointer :: t => null() ! pointer for tally object type(StructuredMesh), pointer :: m => null() ! pointer for mesh object -#ifdef CMFD_DEBUG - integer :: l ! iteration counter for leakage debug - real(8) :: leak1 ! group 1 leakage - real(8) :: leak2 ! group 2 leakage -#endif ! Extract spatial and energy indices from object nx = cmfd % indices(1) @@ -311,85 +302,6 @@ contains if (associated(t)) nullify(t) if (associated(m)) nullify(m) -#ifdef CMFD_DEBUG - open(file='openmc_src_' // trim(to_str(current_batch)) // '.dat', unit=102) - open(file='totalxs1_' // trim(to_str(current_batch)) // '.dat', unit=103) - open(file='totalxs2_' // trim(to_str(current_batch)) // '.dat', unit=104) - open(file='p1scattxs1_' // trim(to_str(current_batch)) // '.dat', unit=105) - open(file='p1scattxs2_' // trim(to_str(current_batch)) // '.dat', unit=106) - open(file='scattxs11_' // trim(to_str(current_batch)) // '.dat', unit=107) - open(file='scattxs12_' // trim(to_str(current_batch)) // '.dat', unit=108) - open(file='scattxs21_' // trim(to_str(current_batch)) // '.dat', unit=109) - open(file='scattxs22_' // trim(to_str(current_batch)) // '.dat', unit=110) - open(file='nufissxs11_' // trim(to_str(current_batch)) // '.dat', unit=111) - open(file='nufissxs12_' // trim(to_str(current_batch)) // '.dat', unit=112) - open(file='nufissxs21_' // trim(to_str(current_batch)) // '.dat', unit=113) - open(file='nufissxs22_' // trim(to_str(current_batch)) // '.dat', unit=114) - open(file='diff_coef1_' // trim(to_str(current_batch)) // '.dat', unit=115) - open(file='diff_coef2_' // trim(to_str(current_batch)) // '.dat', unit=116) - open(file='flux1_' // trim(to_str(current_batch)) // '.dat', unit=117) - open(file='flux2_' // trim(to_str(current_batch)) // '.dat', unit=118) - open(file='leak1_' // trim(to_str(current_batch)) // '.dat', unit=119) - open(file='leak2_' // trim(to_str(current_batch)) // '.dat', unit=120) - - do i = 1, nx - do j = 1,ny - leak1 = ZERO - leak2 = ZERO - do l = 1, 3 - leak1 = leak1 + ((cmfd % current(4*l,1,i,j,1) - & - cmfd % current(4*l-1,1,i,j,1))) - & - ((cmfd % current(4*l-2,1,i,j,1) - & - cmfd % current(4*l-3,1,i,j,1))) - end do - do l = 1, 3 - leak2 = leak2 + ((cmfd % current(4*l,2,i,j,1) - & - cmfd % current(4*l-1,2,i,j,1))) - & - ((cmfd % current(4*l-2,2,i,j,1) - & - cmfd % current(4*l-3,2,i,j,1))) - end do - write(102,*) cmfd % openmc_src(1,i,j,1) - write(103,*) cmfd % totalxs(1,i,j,1) - write(104,*) cmfd % totalxs(2,i,j,1) - write(105,*) cmfd % p1scattxs(1,i,j,1) - write(106,*) cmfd % p1scattxs(2,i,j,1) - write(107,*) cmfd % scattxs(1,1,i,j,1) - write(108,*) cmfd % scattxs(1,2,i,j,1) - write(109,*) cmfd % scattxs(2,1,i,j,1) - write(110,*) cmfd % scattxs(2,2,i,j,1) - write(111,*) cmfd % nfissxs(1,1,i,j,1) - write(112,*) cmfd % nfissxs(1,2,i,j,1) - write(113,*) cmfd % nfissxs(2,1,i,j,1) - write(114,*) cmfd % nfissxs(2,2,i,j,1) - write(115,*) cmfd % diffcof(1,i,j,1) - write(116,*) cmfd % diffcof(2,i,j,1) - write(117,*) cmfd % flux(1,i,j,1) - write(118,*) cmfd % flux(2,i,j,1) - write(119,*) leak1 - write(120,*) leak2 - end do - end do - close(102) - close(103) - close(104) - close(105) - close(106) - close(107) - close(108) - close(109) - close(110) - close(111) - close(112) - close(113) - close(114) - close(115) - close(116) - close(117) - close(118) - close(119) - close(120) -#endif - end subroutine compute_xs !=============================================================================== @@ -715,9 +627,6 @@ contains use global, only: cmfd, cmfd_coremap, message, dhat_reset use output, only: write_message use string, only: to_str -#ifdef CMFD_DEBUG - use global, only: current_batch -#endif integer :: nx ! maximum number of cells in x direction integer :: ny ! maximum number of cells in y direction @@ -751,9 +660,6 @@ contains nxyz(1,:) = (/1,nx/) nxyz(2,:) = (/1,ny/) nxyz(3,:) = (/1,nz/) -#ifdef CMFD_DEBUG - open(file='cmfd_dhat_' // trim(to_str(current_batch)) // '.dat', unit=125) -#endif ! Geting loop over group and spatial indices ZLOOP: do k = 1,nz @@ -844,9 +750,6 @@ contains cmfd%dhat(l,g,i,j,k) = ZERO end if -#ifdef CMFD_DEBUG - write(125,*) dhat -#endif end do LEAK end do GROUP @@ -863,10 +766,6 @@ contains call write_message(1) end if -#ifdef CMFD_DEBUG - close(unit=125) -#endif - end subroutine compute_dhat !=============================================================================== diff --git a/src/cmfd_execute.F90 b/src/cmfd_execute.F90 index 7aee715ebe..f76dfb42f9 100644 --- a/src/cmfd_execute.F90 +++ b/src/cmfd_execute.F90 @@ -238,15 +238,6 @@ contains cmfd % src_cmp(current_batch) = sqrt(ONE/cmfd % norm * & sum((cmfd % cmfd_src - cmfd % openmc_src)**2)) -#ifdef CMFD_DEBUG - open(file='cmfd_src_' // trim(to_str(current_batch)) // '.dat', unit=100) - do i = 1, nx - do j = 1,ny - write(100,*) cmfd % cmfd_src(1,i,j,1) - end do - end do - close(100) -#endif end if #ifdef MPI From 0953dc5edf6ae516583f5b212d53d6d773bf572c Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Wed, 17 Sep 2014 16:56:40 -0400 Subject: [PATCH 62/95] removed balance from users guide --- docs/source/usersguide/input.rst | 12 ------------ 1 file changed, 12 deletions(-) diff --git a/docs/source/usersguide/input.rst b/docs/source/usersguide/input.rst index 1a8d1f2ac7..5a775be8e9 100644 --- a/docs/source/usersguide/input.rst +++ b/docs/source/usersguide/input.rst @@ -1312,18 +1312,6 @@ and not when PETSc is active. *Default*: 1.e-10 -```` Element ---------------------- - -The ```` element controls whether exact neutron balance should be enforced -from CMFD tallies before creating CMFD matrices. This changes effective downscatter -cross section and thermal flux to create exact balance. It should be noted that -this option has led to instabilities when performing CMFD. It can be turned on -with "true" and off with "false". - - *Default*: false - - ```` Element ------------------- From 12f9f077573e6177eb0790d06f731c83c8bc995a Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Wed, 17 Sep 2014 16:57:37 -0400 Subject: [PATCH 63/95] modified comment on default weightfactors value --- src/cmfd_execute.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cmfd_execute.F90 b/src/cmfd_execute.F90 index f76dfb42f9..d14a3af243 100644 --- a/src/cmfd_execute.F90 +++ b/src/cmfd_execute.F90 @@ -304,7 +304,7 @@ contains ! Compute new weight factors if (new_weights) then - ! Zero out weights + ! Set weight factors to a default 1.0 cmfd%weightfactors = ONE ! Count bank sites in mesh and reverse due to egrid structure From 495bab1209e0d16f19b1db8845301e84102d8156 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Wed, 17 Sep 2014 17:09:05 -0400 Subject: [PATCH 64/95] fixed compilation error, added check for max GS iters --- src/cmfd_data.F90 | 4 +++- src/cmfd_input.F90 | 2 +- src/cmfd_solver.F90 | 43 +++++++++++++++++++++++++++++++------------ src/input_xml.F90 | 2 +- 4 files changed, 36 insertions(+), 15 deletions(-) diff --git a/src/cmfd_data.F90 b/src/cmfd_data.F90 index 3ed77d78be..abba2d47d7 100644 --- a/src/cmfd_data.F90 +++ b/src/cmfd_data.F90 @@ -211,7 +211,9 @@ contains ! Bank source cmfd % openmc_src(g,i,j,k) = cmfd % openmc_src(g,i,j,k) + & t % results(2,score_index) % sum - cmfd % keff_bal = cmfd % keff_bal + t % results(2,score_index) % sum / dble(t % n_realizations) + cmfd % keff_bal = cmfd % keff_bal + & + t % results(2,score_index) % sum / & + dble(t % n_realizations) end do INGROUP diff --git a/src/cmfd_input.F90 b/src/cmfd_input.F90 index 98aaed9c7d..22bb7b1c8f 100644 --- a/src/cmfd_input.F90 +++ b/src/cmfd_input.F90 @@ -169,7 +169,7 @@ contains ! Reset dhat parameters if (check_for_node(doc, "dhat_reset")) then call get_node_value(doc, "dhat_reset", temp_str) - call lower_case(temp_str) + temp_str = to_lower(temp_str) if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') & dhat_reset = .true. end if diff --git a/src/cmfd_solver.F90 b/src/cmfd_solver.F90 index 38e3436a24..df19861e57 100644 --- a/src/cmfd_solver.F90 +++ b/src/cmfd_solver.F90 @@ -356,7 +356,8 @@ contains subroutine cmfd_linsolver_1g(A, b, x, tol, its) use constants, only: ONE, ZERO - use global, only: cmfd, cmfd_spectral + use error, only: fatal_error + use global, only: cmfd, cmfd_spectral, message type(Matrix), intent(inout) :: A ! coefficient matrix type(Vector), intent(inout) :: b ! right hand side vector @@ -398,6 +399,12 @@ contains ! Perform Gauss Seidel iterations GS: do igs = 1, 10000 + ! Check for max iterations met + if (igs == 10000) then + message = 'Maximum Gauss-Seidel iterations encountered.' + call fatal_error() + endif + ! Copy over x vector call tmpx % copy(x) @@ -456,7 +463,8 @@ contains subroutine cmfd_linsolver_2g(A, b, x, tol, its) use constants, only: ONE, ZERO - use global, only: cmfd, cmfd_spectral + use error, only: fatal_error + use global, only: cmfd, cmfd_spectral, message type(Matrix), intent(inout) :: A ! coefficient matrix type(Vector), intent(inout) :: b ! right hand side vector @@ -510,6 +518,12 @@ contains ! Perform Gauss Seidel iterations GS: do igs = 1, 10000 + ! Check for max iterations met + if (igs == 10000) then + message = 'Maximum Gauss-Seidel iterations encountered.' + call fatal_error() + endif + ! Copy over x vector call tmpx % copy(x) @@ -595,13 +609,14 @@ contains subroutine cmfd_linsolver_ng(A, b, x, tol, its) use constants, only: ONE, ZERO - use global, only: cmfd, cmfd_spectral + use error, only: fatal_error + use global, only: cmfd, cmfd_spectral, message - type(Matrix) :: A ! coefficient matrix - type(Vector) :: b ! right hand side vector - type(Vector) :: x ! unknown vector - real(8) :: tol ! tolerance on final error - integer :: its ! number of inner iterations + type(Matrix), intent(inout) :: A ! coefficient matrix + type(Vector), intent(inout) :: b ! right hand side vector + type(Vector), intent(inout) :: x ! unknown vector + real(8), intent(in) :: tol ! tolerance on final error + integer, intent(out) :: its ! number of inner iterations integer :: g ! group index integer :: i ! loop counter for x @@ -636,6 +651,12 @@ contains ! Perform Gauss Seidel iterations GS: do igs = 1, 10000 + ! Check for max iterations met + if (igs == 10000) then + message = 'Maximum Gauss-Seidel iterations encountered.' + call fatal_error() + endif + ! Copy over x vector call tmpx % copy(x) @@ -652,19 +673,17 @@ contains tmp1 = ZERO do icol = A % get_row(irow), didx - 1 tmp1 = tmp1 + A % val(icol)*x % val(A % get_col(icol)) -! print *,A % val(icol),x % val(A % get_col(icol)) end do do icol = didx + 1, A % get_row(irow + 1) - 1 tmp1 = tmp1 + A % val(icol)*x % val(A % get_col(icol)) -! print *,A % val(icol),x % val(A % get_col(icol)) end do ! Solve for new x x1 = (b % val(irow) - tmp1)/A % val(didx) -!print *, irow, b % val(irow), tmp1, A % val(didx), x1 + ! Perform overrelaxation x % val(irow) = (ONE - w)*x % val(irow) + w*x1 -!stop + end do ROWS ! Check convergence diff --git a/src/input_xml.F90 b/src/input_xml.F90 index 5d0a159238..c7bf3ef17a 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -268,7 +268,7 @@ contains ! Check if we want to write out source if (check_for_node(node_source, "write_initial")) then call get_node_value(node_source, "write_initial", temp_str) - call lower_case(temp_str) + temp_str = to_lower(temp_str) if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') & write_initial_source = .true. end if From 3b1d04eeaf0a53ca4a4dc926169d3be1594eb4bd Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Wed, 17 Sep 2014 17:14:54 -0400 Subject: [PATCH 65/95] added input gauss_seidel_tolerance to replace atoli and rtoli --- src/cmfd_input.F90 | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/src/cmfd_input.F90 b/src/cmfd_input.F90 index 22bb7b1c8f..235a23c60b 100644 --- a/src/cmfd_input.F90 +++ b/src/cmfd_input.F90 @@ -68,12 +68,14 @@ contains integer :: i integer :: ng + integer :: n_params integer, allocatable :: iarray(:) integer, allocatable :: int_array(:) logical :: file_exists ! does cmfd.xml exist? logical :: found character(MAX_LINE_LEN) :: filename character(MAX_LINE_LEN) :: temp_str + real(8) :: gs_tol(2) type(Node), pointer :: doc => null() type(Node), pointer :: node_mesh => null() @@ -256,10 +258,17 @@ contains call get_node_value(doc, "ktol", cmfd_ktol) if (check_for_node(doc, "stol")) & call get_node_value(doc, "stol", cmfd_stol) - if (check_for_node(doc, "atoli")) & - call get_node_value(doc, "atoli", cmfd_atoli) - if (check_for_node(doc, "rtoli")) & - call get_node_value(doc, "rtoli", cmfd_rtoli) + if (check_for_node(doc, "gauss_seidel_tolerance")) then + n_params = get_arraysize_integer(doc, "gauss_seidel_tolerance") + if (n_params /= 2) then + message = 'Gauss Seidel tolerance is not 2 parameters & + &(absolute, relative).' + call fatal_error() + end if + call get_node_array(doc, "gauss_seidel_tolerance", gs_tol) + cmfd_atoli = gs_tol(1) + cmfd_rtoli = gs_tol(2) + end if ! Create tally objects call create_cmfd_tally(doc) From 364199eb2847d67e15d8bc3544a9038b5b3ce177 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Wed, 17 Sep 2014 17:25:06 -0400 Subject: [PATCH 66/95] added input description of write_initial_source and allowed binary extension for name --- docs/source/usersguide/input.rst | 42 ++++++++++++++++---------------- src/source.F90 | 4 +++ 2 files changed, 25 insertions(+), 21 deletions(-) diff --git a/docs/source/usersguide/input.rst b/docs/source/usersguide/input.rst index 5a775be8e9..4fc49b35f5 100644 --- a/docs/source/usersguide/input.rst +++ b/docs/source/usersguide/input.rst @@ -433,6 +433,13 @@ attributes/sub-elements: *Default*: 0.988 2.249 + :write_initial: + An element specifying whether to write out the intial source bank used + at the beginning of the first batch. The output file is named + "initial_source.binary(h5)" + + *Default*: false + ```` Element ------------------------- @@ -1303,15 +1310,6 @@ Currently, it allows users to accelerate fission source convergence during inactive neutron batches. To run CMFD, the ```` element in ``settings.xml`` should be set to "true". -```` Element --------------------- - -The ```` element specifies the absolute inner tolerance on the Gauss-Seidel -when performing CMFD calculations. It is only used in the standalone CMFD solver -and not when PETSc is active. - - *Default*: 1.e-10 - ```` Element ------------------- @@ -1338,9 +1336,9 @@ The ```` element sets one additional CMFD output column. Options are: ```` Element ------------------------ -The ```` element controls whether dhat nonlinear CMFD parameters -should be reset to zero before solving CMFD eigenproblem. It can be turned on with -"true" and off with "false". +The ```` element controls whether :math:`\widehat{D}` nonlinear +CMFD parameters should be reset to zero before solving CMFD eigenproblem. +It can be turned on with "true" and off with "false". *Default*: false @@ -1362,6 +1360,17 @@ It can be turned on with "true" and off with "false". *Default*: false +```` Element +-------------------- + +The ```` element specifies two parameters. The first is +the absolute inner tolerance for Gauss-Seidel iterations when performing CMFD +and the second is the relative inner tolerance for Gauss-Seidel iterations +for CMFD calculations. It is only used in the standalone CMFD power iteration +solver and not when PETSc is active. + + *Default*: 1.e-10 1.e-5 + ```` Element ------------------------- @@ -1455,15 +1464,6 @@ This option can be turned on with "true" and turned off with "false". *Default*: false -```` Element --------------------- - -The ```` element specifies the relative inner tolerance on the Gauss-Seidel -when performing CMFD calculations. It is only used in the standalone CMFD solver -and not when PETSc is active. - - *Default*: 1.e-5 - ```` Element ------------------------- diff --git a/src/source.F90 b/src/source.F90 index f6de6042b1..fd889abc42 100644 --- a/src/source.F90 +++ b/src/source.F90 @@ -81,7 +81,11 @@ contains if (write_initial_source) then message = 'Writing out initial source guess...' call write_message(1) +#ifdef HDF5 filename = 'initial_source.h5' +#else + filename = 'initial_source.binary' +#endif call sp % file_create(filename, serial = .false.) call sp % write_source_bank() call sp % file_close() From 5dab31aa49830907ba981ba85e8cc6ca901117b2 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Wed, 17 Sep 2014 17:26:31 -0400 Subject: [PATCH 67/95] put path_output in front of initial source file --- src/source.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/source.F90 b/src/source.F90 index fd889abc42..9575020e6d 100644 --- a/src/source.F90 +++ b/src/source.F90 @@ -82,9 +82,9 @@ contains message = 'Writing out initial source guess...' call write_message(1) #ifdef HDF5 - filename = 'initial_source.h5' + filename = trim(path_output) // 'initial_source.h5' #else - filename = 'initial_source.binary' + filename = trim(path_output) // 'initial_source.binary' #endif call sp % file_create(filename, serial = .false.) call sp % write_source_bank() From a531aea8ef9b448b89fdd0b83827ca502f1e6e72 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Wed, 17 Sep 2014 19:24:00 -0400 Subject: [PATCH 68/95] changed test input files to use new gs_tol input --- tests/test_cmfd_feed/cmfd.xml | 4 +--- tests/test_cmfd_nofeed/cmfd.xml | 3 +-- 2 files changed, 2 insertions(+), 5 deletions(-) diff --git a/tests/test_cmfd_feed/cmfd.xml b/tests/test_cmfd_feed/cmfd.xml index 390e558639..228b260a46 100644 --- a/tests/test_cmfd_feed/cmfd.xml +++ b/tests/test_cmfd_feed/cmfd.xml @@ -12,7 +12,5 @@ dominance power true - 1.e-15 - 1.e-20 - + 1.e-15 1.e-20 diff --git a/tests/test_cmfd_nofeed/cmfd.xml b/tests/test_cmfd_nofeed/cmfd.xml index 4a4bf30108..eb6c2c721a 100644 --- a/tests/test_cmfd_nofeed/cmfd.xml +++ b/tests/test_cmfd_nofeed/cmfd.xml @@ -12,7 +12,6 @@ dominance power false - 1.e-15 - 1.e-20 + 1.e-15 1.e-20 From 87d7a640b02939764eac2453bea001a2e04f2b73 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Wed, 17 Sep 2014 19:45:40 -0400 Subject: [PATCH 69/95] gs tol should be read in as double --- src/cmfd_input.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cmfd_input.F90 b/src/cmfd_input.F90 index 235a23c60b..67e8f0d0f3 100644 --- a/src/cmfd_input.F90 +++ b/src/cmfd_input.F90 @@ -259,7 +259,7 @@ contains if (check_for_node(doc, "stol")) & call get_node_value(doc, "stol", cmfd_stol) if (check_for_node(doc, "gauss_seidel_tolerance")) then - n_params = get_arraysize_integer(doc, "gauss_seidel_tolerance") + n_params = get_arraysize_double(doc, "gauss_seidel_tolerance") if (n_params /= 2) then message = 'Gauss Seidel tolerance is not 2 parameters & &(absolute, relative).' From 855483e540ecf64308d8418abf3ac37715c394f3 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Wed, 17 Sep 2014 19:56:18 -0400 Subject: [PATCH 70/95] updated RELAX NG schemata --- src/relaxng/cmfd.rnc | 25 +++++++++++++------------ src/relaxng/settings.rnc | 3 ++- 2 files changed, 15 insertions(+), 13 deletions(-) diff --git a/src/relaxng/cmfd.rnc b/src/relaxng/cmfd.rnc index cbcb7709ae..bbb7fc9e6b 100644 --- a/src/relaxng/cmfd.rnc +++ b/src/relaxng/cmfd.rnc @@ -22,15 +22,9 @@ element cmfd { element feedback { xsd:boolean }? & - element n_cmfd_procs { xsd:int }? & - - element reset { xsd:boolean }? & - - element balance { xsd:boolean }? & - element downscatter { xsd:boolean }? & - element run_2grp { xsd:boolean }? & + element dhat_reset { xsd:boolean }? & element solver { xsd:string }? & @@ -40,8 +34,6 @@ element cmfd { element power_monitor { xsd:boolean }? & - element write_balance { xsd:boolean }? & - element write_matrices { xsd:boolean }? & element run_adjoint { xsd:boolean }? & @@ -50,9 +42,18 @@ element cmfd { element begin { xsd:int }? & - element inactive { xsd:boolean }? & + element tally_reset { list { xsd:int+ } }? & - element active_flush { xsd:int }? & + element display { xsd:string }? & + + element spectral { xsd:double }? & + + element shift { xsd:double }? & + + element ktol { xsd: double }? & + + element stol { xsd: double }? & + + element gauss_seidel_tolerance { list { xsd:double+ } }? - element keff_tol { xsd:double }? } diff --git a/src/relaxng/settings.rnc b/src/relaxng/settings.rnc index dd4b91dc7d..707ecbbc80 100644 --- a/src/relaxng/settings.rnc +++ b/src/relaxng/settings.rnc @@ -85,7 +85,8 @@ element settings { attribute interplation { xsd:string { maxLength = "10" } })? & (element parameters { list { xsd:double+ } } | attribute parameters { list { xsd:double+ } })? - }? + }? & + (element write_initial { xsd:boolean } | attribute write_initial { xsd:boolean })? }? & element state_point { From 437188667f8d9df3be2a353a3a6bf262b142c8a0 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Wed, 17 Sep 2014 23:43:52 -0400 Subject: [PATCH 71/95] Fix typo in write_initial description. --- docs/source/usersguide/input.rst | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/docs/source/usersguide/input.rst b/docs/source/usersguide/input.rst index 4fc49b35f5..3d09e75f45 100644 --- a/docs/source/usersguide/input.rst +++ b/docs/source/usersguide/input.rst @@ -269,7 +269,7 @@ attributes or sub-elements: :scatterer: An element with attributes/sub-elements called ``nuclide``, ``method``, ``xs_label``, ``xs_label_0K``, ``E_min``, and ``E_max``. The ``nuclide`` - attribute is the name, as given by the ``name`` attribute within the + attribute is the name, as given by the ``name`` attribute within the ``nuclide`` sub-element of the ``material`` element in ``materials.xml``, of the nuclide to which a resonance scattering treatment is to be applied. The ``method`` attribute gives the type of resonance scattering treatment @@ -434,8 +434,8 @@ attributes/sub-elements: *Default*: 0.988 2.249 :write_initial: - An element specifying whether to write out the intial source bank used - at the beginning of the first batch. The output file is named + An element specifying whether to write out the initial source bank used at + the beginning of the first batch. The output file is named "initial_source.binary(h5)" *Default*: false @@ -1336,8 +1336,8 @@ The ```` element sets one additional CMFD output column. Options are: ```` Element ------------------------ -The ```` element controls whether :math:`\widehat{D}` nonlinear -CMFD parameters should be reset to zero before solving CMFD eigenproblem. +The ```` element controls whether :math:`\widehat{D}` nonlinear +CMFD parameters should be reset to zero before solving CMFD eigenproblem. It can be turned on with "true" and off with "false". *Default*: false @@ -1367,7 +1367,7 @@ The ```` element specifies two parameters. The first is the absolute inner tolerance for Gauss-Seidel iterations when performing CMFD and the second is the relative inner tolerance for Gauss-Seidel iterations for CMFD calculations. It is only used in the standalone CMFD power iteration -solver and not when PETSc is active. +solver and not when PETSc is active. *Default*: 1.e-10 1.e-5 From ee86d13619f2d24be9a12b0c2f62b92ab3fcc40f Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Wed, 17 Sep 2014 23:49:08 -0400 Subject: [PATCH 72/95] Changed an #ifndef to a #ifdef in cmfd_solver. --- src/cmfd_solver.F90 | 46 ++++++++++++++++++++++----------------------- 1 file changed, 23 insertions(+), 23 deletions(-) diff --git a/src/cmfd_solver.F90 b/src/cmfd_solver.F90 index df19861e57..b3e8fb8a88 100644 --- a/src/cmfd_solver.F90 +++ b/src/cmfd_solver.F90 @@ -9,7 +9,7 @@ module cmfd_solver implicit none private - public :: cmfd_solver_execute + public :: cmfd_solver_execute real(8) :: k_n ! new k-eigenvalue real(8) :: k_o ! old k-eigenvalue @@ -42,7 +42,7 @@ module cmfd_solver type(Vector), intent(inout) :: x real(8), intent(in) :: tol integer, intent(out) :: i - end subroutine linsolve + end subroutine linsolve end interface contains @@ -80,7 +80,7 @@ contains ! Stop timer for build call time_cmfdbuild % stop() - ! Begin power iteration + ! Begin power iteration call time_cmfdsolve % start() call execute_power_iter() call time_cmfdsolve % stop() @@ -88,7 +88,7 @@ contains ! Extract results call extract_results() - ! Deallocate data + ! Deallocate data call finalize() end subroutine cmfd_solver_execute @@ -138,7 +138,7 @@ contains k_lo = k_ln ! Fill in loss matrix - call build_loss_matrix(loss, adjoint=adjoint) + call build_loss_matrix(loss, adjoint=adjoint) ! Fill in production matrix call build_prod_matrix(prod, adjoint=adjoint) @@ -163,7 +163,7 @@ contains cmfd_linsolver => cmfd_linsolver_2g case default cmfd_linsolver => cmfd_linsolver_ng - end select + end select ! Set tolerances ktol = cmfd_ktol @@ -172,16 +172,16 @@ contains end subroutine init_data !=============================================================================== -! COMPUTE_ADJOINT computes a mathematical adjoint of CMFD problem +! COMPUTE_ADJOINT computes a mathematical adjoint of CMFD problem !=============================================================================== subroutine compute_adjoint() use error, only: fatal_error -#ifndef PETSC - use global, only: message -#else +#ifdef PETSC use global, only: cmfd_write_matrices +#else + use global, only: message #endif #ifdef PETSC @@ -224,7 +224,7 @@ contains iconv = .false. ! Set up tolerances - atoli = cmfd_atoli + atoli = cmfd_atoli rtoli = cmfd_rtoli toli = rtoli*100._8 @@ -280,7 +280,7 @@ contains end do - end subroutine execute_power_iter + end subroutine execute_power_iter !=============================================================================== ! WIELANDT SHIFT @@ -366,7 +366,7 @@ contains integer, intent(out) :: its ! number of inner iterations integer :: g ! group index - integer :: i ! loop counter for x + integer :: i ! loop counter for x integer :: j ! loop counter for y integer :: k ! loop counter for z integer :: n ! total size of vector @@ -406,7 +406,7 @@ contains endif ! Copy over x vector - call tmpx % copy(x) + call tmpx % copy(x) ! Perform red/black gs iterations REDBLACK: do irb = 0,1 @@ -473,7 +473,7 @@ contains integer, intent(out) :: its ! number of inner iterations integer :: g ! group index - integer :: i ! loop counter for x + integer :: i ! loop counter for x integer :: j ! loop counter for y integer :: k ! loop counter for z integer :: n ! total size of vector @@ -525,7 +525,7 @@ contains endif ! Copy over x vector - call tmpx % copy(x) + call tmpx % copy(x) ! Perform red/black gs iterations REDBLACK: do irb = 0,1 @@ -619,7 +619,7 @@ contains integer, intent(out) :: its ! number of inner iterations integer :: g ! group index - integer :: i ! loop counter for x + integer :: i ! loop counter for x integer :: j ! loop counter for y integer :: k ! loop counter for z integer :: n ! total size of vector @@ -658,7 +658,7 @@ contains endif ! Copy over x vector - call tmpx % copy(x) + call tmpx % copy(x) ! Begin loop around matrix rows ROWS: do irow = 1, n @@ -709,7 +709,7 @@ contains use global, only: cmfd, cmfd_write_matrices, current_batch - character(len=25) :: filename ! name of file to write data + character(len=25) :: filename ! name of file to write data integer :: n ! problem size ! Get problem size @@ -722,11 +722,11 @@ contains if (.not. allocated(cmfd%phi)) allocate(cmfd%phi(n)) end if - ! Save values + ! Save values if (adjoint_calc) then cmfd % adj_phi = phi_n % val else - cmfd % phi = phi_n % val + cmfd % phi = phi_n % val end if ! Save eigenvalue @@ -805,8 +805,8 @@ contains subroutine finalize() - ! Destroy all objects - call loss % destroy() + ! Destroy all objects + call loss % destroy() call prod % destroy() call phi_n % destroy() call phi_o % destroy() From 9cd04862bb89d3f88a11b4251aa5e3686d58335b Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Tue, 23 Sep 2014 21:01:54 -0400 Subject: [PATCH 73/95] Fix underlining in documentation. --- docs/source/usersguide/input.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/source/usersguide/input.rst b/docs/source/usersguide/input.rst index 3d09e75f45..cbe06e5a0d 100644 --- a/docs/source/usersguide/input.rst +++ b/docs/source/usersguide/input.rst @@ -261,7 +261,7 @@ or sub-elements and can be set to either "false" or "true". *Default*: true ```` Element ----------------------- +---------------------------------- The ``resonance_scattering`` element can contain one or more of the following attributes or sub-elements: From 2a95ef7a425af3b498fd95afe3ef7917efea33fe Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Thu, 25 Sep 2014 21:29:07 -0400 Subject: [PATCH 74/95] If "current" score is specified, make sure a mesh filter is also specified. Closes #322 on github. --- src/input_xml.F90 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/input_xml.F90 b/src/input_xml.F90 index c7bf3ef17a..869f9fd63f 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -2647,6 +2647,12 @@ contains ! Get index of mesh filter k = t % find_filter(FILTER_MESH) + ! Check to make sure mesh filter was specified + if (k == 0) then + message = "Cannot tally surface current without a mesh filter." + call fatal_error() + end if + ! Get pointer to mesh i_mesh = t % filters(k) % int_bins(1) m => meshes(i_mesh) From 8974223badb2116d93589dc42c9559efe06b3b0a Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Fri, 26 Sep 2014 00:24:58 -0400 Subject: [PATCH 75/95] Start adding release notes for v0.6.1. --- docs/source/releasenotes/index.rst | 1 + docs/source/releasenotes/notes_0.6.1.rst | 63 ++++++++++++++++++++++++ 2 files changed, 64 insertions(+) create mode 100644 docs/source/releasenotes/notes_0.6.1.rst diff --git a/docs/source/releasenotes/index.rst b/docs/source/releasenotes/index.rst index b40126b243..9799a5cfc7 100644 --- a/docs/source/releasenotes/index.rst +++ b/docs/source/releasenotes/index.rst @@ -10,6 +10,7 @@ bugs fixed, and known issues for each successive release. .. toctree:: :maxdepth: 1 + notes_0.6.1 notes_0.6.0 notes_0.5.4 notes_0.5.3 diff --git a/docs/source/releasenotes/notes_0.6.1.rst b/docs/source/releasenotes/notes_0.6.1.rst new file mode 100644 index 0000000000..b0651a8629 --- /dev/null +++ b/docs/source/releasenotes/notes_0.6.1.rst @@ -0,0 +1,63 @@ +.. _notes_0.6.1: + +============================== +Release Notes for OpenMC 0.6.1 +============================== + +------------------- +System Requirements +------------------- + +There are no special requirements for running the OpenMC code. As of this +release, OpenMC has been tested on a variety of Linux distributions, Mac OS X, +and Microsoft Windows 7. Memory requirements will vary depending on the size of +the problem at hand (mostly on the number of nuclides in the problem). + +------------ +New Features +------------ + +- Coarse mesh finite difference acceleration no longer requires PETSc +- Statepoint file numbering is now zero-padded +- Python scripts now compatible with Python 2 or 3 +- Ability to run particle restarts in fixed source calculations +- Capability to filter box source by fissionable materials +- Nuclide/element names are now case insensitive in input files +- Improved treatment of resonance scattering for heavy nuclides + +--------- +Bug Fixes +--------- + +- 03e890_: Check for energy-dependent multiplicities in ACE files +- 4439de_: Fix distance-to-surface calculation for general plane surface +- 5808ed_: Account for differences in URR band probabilities at different energies +- 2e60c0_: Allow zero atom/weight percents in materials +- 3e0870_: Don't use PWD environment variable when setting path to input files +- dc4776_: Handle probability table resampling correctly +- 01178b_: Fix metastables nuclides in NNDC cross_sections.xml file +- 62ec43_: Don't read tallies.xml when OpenMC is run in plotting mode +- 2a95ef_: Prevent segmentation fault on "current" score without mesh filter + +.. _03e890: https://github.com/mit-crpg/openmc/commit/03e890 +.. _4439de: https://github.com/mit-crpg/openmc/commit/4439de +.. _5808ed: https://github.com/mit-crpg/openmc/commit/5808ed +.. _2e60c0: https://github.com/mit-crpg/openmc/commit/2e60c0 +.. _3e0870: https://github.com/mit-crpg/openmc/commit/3e0870 +.. _dc4776: https://github.com/mit-crpg/openmc/commit/dc4776 +.. _01178b: https://github.com/mit-crpg/openmc/commit/01178b +.. _62ec43: https://github.com/mit-crpg/openmc/commit/62ec43 +.. _2a95ef: https://github.com/mit-crpg/openmc/commit/2a95ef + +------------ +Contributors +------------ + +This release contains new contributions from the following people: + +- `Sterling Harper `_ +- `Bryan Herman `_ +- `Adam Nelson `_ +- `Paul Romano `_ +- `Jon Walsh `_ +- `Will Boyd `_ From 66b9c9802d23557d62d6bdcd258cadcc526ee53b Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Sun, 28 Sep 2014 21:42:25 -0400 Subject: [PATCH 76/95] addressed @paulromano comments --- docs/source/methods/cmfd.rst | 194 ++++++------------------------- docs/source/usersguide/input.rst | 4 +- 2 files changed, 38 insertions(+), 160 deletions(-) diff --git a/docs/source/methods/cmfd.rst b/docs/source/methods/cmfd.rst index 78472df37d..3681df3b75 100644 --- a/docs/source/methods/cmfd.rst +++ b/docs/source/methods/cmfd.rst @@ -37,7 +37,7 @@ the direction as a superscript. Energy group indices represented by :math:`g` and :math:`h` are also listed as superscripts here. The group :math:`g` is the group of interest and, if present, :math:`h` is all groups. Finally, any parameter surrounded by :math:`\left\langle\cdot\right\rangle` represents a -tally quantity that can be edited from an MC solution. +tally quantity that can be edited from a Monte Carlo (MC) solution. ------ Theory @@ -83,7 +83,7 @@ In eq. :eq:`eq_neut_bal` the parameters are defined as: * :math:`\left\langle\overline{\overline\Sigma}_{t_{l,m,n}}^g \overline{\overline\phi}_{l,m,n}^g\Delta_l^u\Delta_m^v\Delta_n^w\right\rangle` --- volume-integrated total reaction rate over energy group :math:`g`. - * :math:`\left\langle\overline{\overline{\nu_s\Sigma}}_{s_{l,m,n}}^{h\rightarrow +* :math:`\left\langle\overline{\overline{\nu_s\Sigma}}_{s_{l,m,n}}^{h\rightarrow g} \overline{\overline\phi}_{l,m,n}^h\Delta_l^u\Delta_m^v\Delta_n^w\right\rangle` --- volume-integrated scattering production rate of neutrons that begin with @@ -98,7 +98,7 @@ In eq. :eq:`eq_neut_bal` the parameters are defined as: group :math:`h` that exit in group :math:`g`. Each quantity in :math:`\left\langle\cdot\right\rangle` represents a scalar value that -is obtained from an MC tally. A good verification step when using an MC is +is obtained from an MC tally. A good verification step when using an MC code is to make sure that tallies satisfy this balance equation within statistics. No NDA acceleration can be performed if the balance equation is not satisfied. @@ -110,7 +110,8 @@ illustrated as a flow chart below. After a batch of neutrons is simulated, NDA can take place. Each of the steps described above is described in detail in the following sections. -.. tikz:: Flow chart of NDA process +.. tikz:: Flow chart of NDA process. Note "XS" is used for cross section and + "DC" is used for diffusion coefficient. :libs: shapes, snakes, shadows, arrows, calc, decorations.markings, patterns, fit, matrix, spy :include: cmfd_tikz/cmfd_flow.tikz @@ -234,9 +235,9 @@ as [Hebert]_. These current/flux relationships are as follows: \beta_{l\pm1/2,m,n}^{u,g}\right)\Delta_l^u}\overline{\overline{\phi}}_{l,m,n}^{g}. In Eqs. :eq:`eq_cell_cell` and :eq:`eq_cell_bound`, the :math:`\pm` refers to -left (-:math:`x`) or right (+:math:`x`) surface in the :math:`x` direction, -back (-:math:`y`) or front (+:math:`y`) surface in the :math:`y` direction and -bottom (-:math:`z`) or top (+:math:`z`) surface in the :math:`z` direction. For +left (:math:`-x`) or right (:math:`+x`) surface in the :math:`x` direction, +back (:math:`-y`) or front (:math:`+y`) surface in the :math:`y` direction and +bottom (:math:`-z`) or top (:math:`+z`) surface in the :math:`z` direction. For cell-to-boundary coupling, a general albedo, :math:`\beta_{l\pm1/2,m,n}^{u,g}`, is used. The albedo is defined as the ratio of incoming (:math:`-` superscript) to outgoing (:math:`+` superscript) partial current on any surface represented @@ -395,7 +396,7 @@ information: It should be noted that for more difficult simulations (e.g., light water reactors), there are other options available to users such as tally resetting parameters, effective down-scatter usage, tally estimator, etc. For more -information please see [Herman_Thesis]_. +information please see :ref:`usersguide_cmfd`. Of the options described above, the optional acceleration subset region is an uncommon feature. Because OpenMC only has a structured Cartesian mesh, mesh @@ -425,26 +426,26 @@ in mesh cells far away from the core. :libs: shapes, snakes, shadows, arrows, calc, decorations.markings, patterns, fit, matrix, spy :include: cmfd_tikz/meshfig.tikz -During an MC simulation, CMFD tallies are accumulated. The basic tallies -needed are listed in Table :ref:`tab_tally`. Each tally is performed on a -spatial and energy mesh basis. The surface area-integrated net current is -tallied on every surface of the mesh. OpenMC tally objects are created by -the CMFD code internally, and cross sections are calculated at each -CMFD feedback iteration. The first CMFD iteration, controlled by the -user, occurs just after tallies are communicated to the master processor. Once -tallies are collapsed, cross sections, diffusion coefficients and equivalence -parameters are calculated. This is performed only on the acceleration region if -that option has been activated by the user. Once all diffusion parameters -are calculated, CMFD matrices are formed where energy groups are the inner -most iteration index. In OpenMC, compressed row storage sparse matrices are -used due to the sparsity of CMFD operators. An example of this sparsity is -shown for the 3-D BEAVRS model in figures :ref:`fig_loss` and :ref:`fig_prod`. These matrices -represent an assembly radial mesh, 24 cell mesh in the axial direction and two -energy groups. The loss matrix is 99.92% sparse and the production matrix is -99.99% sparse. Although the loss matrix looks like it is tridiagonal, it is -really a seven banded matrix with a block diagonal matrix for scattering. The -production matrix is a :math:`2\times 2` block diagonal; however, zeros are present -because no fission neutrons appear with energies in the thermal group. +During an MC simulation, CMFD tallies are accumulated. The basic tallies needed +are listed in Table :ref:`tab_tally`. Each tally is performed on a spatial and +energy mesh basis. The surface area-integrated net current is tallied on every +surface of the mesh. OpenMC tally objects are created by the CMFD code +internally, and cross sections are calculated at each CMFD feedback iteration. +The first CMFD iteration, controlled by the user, occurs just after tallies are +communicated to the master processor. Once tallies are collapsed, cross +sections, diffusion coefficients and equivalence parameters are calculated. This +is performed only on the acceleration region if that option has been activated +by the user. Once all diffusion parameters are calculated, CMFD matrices are +formed where energy groups are the inner most iteration index. In OpenMC, +compressed row storage sparse matrices are used due to the sparsity of CMFD +operators. An example of this sparsity is shown for the 3-D BEAVRS model in +figures :ref:`fig_loss` and :ref:`fig_prod` [BEAVRS]_. These matrices represent +an assembly radial mesh, 24 cell mesh in the axial direction and two energy +groups. The loss matrix is 99.92% sparse and the production matrix is 99.99% +sparse. Although the loss matrix looks like it is tridiagonal, it is really a +seven banded matrix with a block diagonal matrix for scattering. The production +matrix is a :math:`2\times 2` block diagonal; however, zeros are present because +no fission neutrons appear with energies in the thermal group. .. _tab_tally: @@ -518,145 +519,20 @@ source distribution to the current number of neutrons in each mesh. It is straightforward to compute the CMFD number of neutrons because it is the product between the total starting initial weight of neutrons and the CMFD normalized fission source distribution. To compute the number of neutrons from -the current MC source, a subroutine was implemented to sum the statistical +the current MC source, OpenMC sums the statistical weights of neutrons from the source bank on a given spatial and energy mesh. Once weight adjustment factors were calculated, each neutron's statistical weight in the source bank was modified according to its location and energy. - -------------------- -Toy Problem Example -------------------- - -Before applying CMFD to a large reactor, a simple 1-D slab toy problem was -analyzed to understand how CMFD works. Table :ref:`tab_1Dtoyinput` presents -data used to construct this problem. For MFD, the mesh was 2 cm over the -geometry with one energy group. A comparison of fission source convergence -using Shannon entropy is shown in figure :ref:`fig_1Dentropy`. The figure -illustrates that it takes about 150 FSGs (equivalent to batches) to converge -the source with standard MC without CMFD. For the case with CMFD, it is -activated at batch 11 and directly affects the fission source for batch 12. -Convergence of the fission source is almost immediately reached. - -.. _tab_1Dtoyinput: - -.. table:: Input data for 1-D slab toy problem - - +--------------------------------------------+-------------------+ - +--------------------------------------------+-------------------+ - | Slab Length | 200 cm | - +============================================+===================+ - | Homogeneous material of :math:`\rm UO_2` | 19 g/cc density | - +--------------------------------------------+-------------------+ - | U-235 weight percent | 0.21 | - +--------------------------------------------+-------------------+ - | U-238 weight percent | 0.68 | - +--------------------------------------------+-------------------+ - | O-16 weight percent | 0.11 | - +--------------------------------------------+-------------------+ - | Number of particles per | 4,000,000 | - +--------------------------------------------+-------------------+ - | Number of inactive | 400 | - +--------------------------------------------+-------------------+ - -| -| - -.. _fig_1Dentropy: - -.. figure:: ../_images/entropy_1Dslab.png - :scale: 10 - - Source convergence comparison for 1-D slab toy problem - -To further show this convergence, source distributions were edited at various -batches and compared. Figures :ref:`fig_toy6` to :ref:`fig_toy200` compare the -OpenMC source distribution from the no CMFD case, the OpenMC source -distribution from the CMFD case and the CMFD source distribution for six -different batches. Figure :ref:`fig_toy6` compares the distributions at batch -6. Here, CMFD has not been activated yet, so it is just plotted at zero. As -expected, the OpenMC source distributions from the two cases are equal because -CMFD has not yet affected it. From this plot, one can also see that the source -distribution is very flat because the initial guess was uniform over space. -Because the dominance ratio is close to unity, the source will slowly converge -to a cosine-like shape. Results from batch 10 are presented in figure -:ref:`fig_toy10`. The same information is shown in this plot, but the source is -slightly more converged. It is plotted here to show how little the source -changes in four batches. Batch 11 is the first time a CMFD source is -calculated. Right away, it appears as a smooth cosine-like shape as shown in -figure :ref:`fig_toy11`. Thus, when CMFD is fed back, its source shape will -modify the OpenMC source bank to preserve this distribution on the CMFD mesh. -On the next batch, shown in :ref:`fig_toy12`, the OpenMC source and the CMFD -source from the CMFD case match, while the OpenMC source from the no CMFD case -lags behind. Two more batches are shown in figure :ref:`fig_toy40` and figure -:ref:`fig_toy200` to illustrate that all source distributions eventually line -up at batch 200. - -.. _fig_toy6: - -.. figure:: ../_images/statepoint6.png - :scale: 10 - - Source at FSG 6 - -| - -.. _fig_toy10: - -.. figure:: ../_images/statepoint10.png - :scale: 10 - - Source at FSG 10 - -| - -.. _fig_toy11: - -.. figure:: ../_images/statepoint11.png - :scale: 10 - - Source at FSG 11 - -| - -.. _fig_toy12: - -.. figure:: ../_images/statepoint12.png - :scale: 10 - - Source at FSG 12 - -| - -.. _fig_toy40: - -.. figure:: ../_images/statepoint40.png - :scale: 10 - - Source at FSG 40 - -| - -.. _fig_toy200: - -.. figure:: ../_images/statepoint200.png - :scale: 10 - - Source at FSG 200 - -| - -This simple illustration shows the power of NDA. Because of the nature of the -diffusion equation, it can propagate and dampen higher harmonics much faster -than the MC transport solution. It should be noted here that this is a very -simplified problem where the dominance ratio was increased by changing the size -of the slab. Also, the source distribution is very smooth and there was only -one homogeneous material. The problem becomes more difficult to solve when -expanding to more spatial dimensions and complex materials. +Examples of CMFD simulations using OpenMC can be found in [Herman_Thesis]_. ---------- References ---------- +.. [BEAVRS] Nick Horelik, Bryan Herman. *Benchmark for Evaluation And Verification of Reactor + Simulations*. Massachusetts Institute of Technology, http://crpg.mit.edu/pub/beavrs + , 2013. + .. [Gill] Daniel F. Gill. *Newton-Krylov methods for the solution of the k-eigenvalue problem in multigroup neutronics calculations*. Ph.D. thesis, Pennsylvania State University, 2010. diff --git a/docs/source/usersguide/input.rst b/docs/source/usersguide/input.rst index cbe06e5a0d..cf403e8da3 100644 --- a/docs/source/usersguide/input.rst +++ b/docs/source/usersguide/input.rst @@ -1301,6 +1301,8 @@ attributes or sub-elements. These are not used in "voxel" plots: *Default*: None +.. _usersguide_cmfd: + ------------------------------ CMFD Specification -- cmfd.xml ------------------------------ @@ -1361,7 +1363,7 @@ It can be turned on with "true" and off with "false". *Default*: false ```` Element --------------------- +------------------------------------ The ```` element specifies two parameters. The first is the absolute inner tolerance for Gauss-Seidel iterations when performing CMFD From 93e4823641e12b880a3b9bda7301c72254f165a3 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Wed, 1 Oct 2014 21:22:55 -0400 Subject: [PATCH 77/95] Check for negative values when calculating cross sections from URR probability tables. --- src/cross_section.F90 | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) diff --git a/src/cross_section.F90 b/src/cross_section.F90 index fddc79dff0..657935206a 100644 --- a/src/cross_section.F90 +++ b/src/cross_section.F90 @@ -113,7 +113,7 @@ contains atom_density * micro_xs(i_nuclide) % elastic ! Add contributions to material macroscopic absorption cross section - material_xs % absorption = material_xs % absorption + & + material_xs % absorption = material_xs % absorption + & atom_density * micro_xs(i_nuclide) % absorption ! Add contributions to material macroscopic fission cross section @@ -123,7 +123,7 @@ contains ! Add contributions to material macroscopic nu-fission cross section material_xs % nu_fission = material_xs % nu_fission + & atom_density * micro_xs(i_nuclide) % nu_fission - + ! Add contributions to material macroscopic energy release from fission material_xs % kappa_fission = material_xs % kappa_fission + & atom_density * micro_xs(i_nuclide) % kappa_fission @@ -214,7 +214,7 @@ contains ! Calculate microscopic nuclide nu-fission cross section micro_xs(i_nuclide) % nu_fission = (ONE - f) * nuc % nu_fission( & i_grid) + f * nuc % nu_fission(i_grid+1) - + ! Calculate microscopic nuclide kappa-fission cross section ! The ENDF standard (ENDF-102) states that MT 18 stores ! the fission energy as the Q_value (fission(1)) @@ -276,7 +276,7 @@ contains f = ZERO else i_grid = binary_search(sab % inelastic_e_in, sab % n_inelastic_e_in, E) - f = (E - sab%inelastic_e_in(i_grid)) / & + f = (E - sab%inelastic_e_in(i_grid)) / & (sab%inelastic_e_in(i_grid+1) - sab%inelastic_e_in(i_grid)) end if @@ -475,6 +475,11 @@ contains fission = fission * micro_xs(i_nuclide) % fission end if + ! Check for negative calues + if (elastic < ZERO) elastic = ZERO + if (fission < ZERO) fission = ZERO + if (capture < ZERO) capture = ZERO + ! Set elastic, absorption, fission, and total cross sections. Note that the ! total cross section is calculated as sum of partials rather than using the ! table-provided value @@ -538,11 +543,11 @@ contains if (nuc % energy_0K(i_grid) == nuc % energy_0K(i_grid+1)) then i_grid = i_grid + 1 end if - + ! calculate interpolation factor f = (E - nuc % energy_0K(i_grid)) & & / (nuc % energy_0K(i_grid + 1) - nuc % energy_0K(i_grid)) - + ! Calculate microscopic nuclide elastic cross section xs_out = (ONE - f) * nuc % elastic_0K(i_grid) & & + f * nuc % elastic_0K(i_grid + 1) From 6f7149ab0ab5c32dc5c083051f123e9188ff156b Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Thu, 2 Oct 2014 08:33:19 -0400 Subject: [PATCH 78/95] Fix typo --- src/cross_section.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cross_section.F90 b/src/cross_section.F90 index 657935206a..8e4c19cccd 100644 --- a/src/cross_section.F90 +++ b/src/cross_section.F90 @@ -475,7 +475,7 @@ contains fission = fission * micro_xs(i_nuclide) % fission end if - ! Check for negative calues + ! Check for negative values if (elastic < ZERO) elastic = ZERO if (fission < ZERO) fission = ZERO if (capture < ZERO) capture = ZERO From 40577a0ee418784d923b94a91c51ca4354160fae Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Thu, 2 Oct 2014 21:02:31 -0400 Subject: [PATCH 79/95] Bumped version number to 0.6.1. --- docs/source/conf.py | 2 +- src/constants.F90 | 2 +- src/utils/setup.py | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/docs/source/conf.py b/docs/source/conf.py index 16be3567d0..12558139e1 100644 --- a/docs/source/conf.py +++ b/docs/source/conf.py @@ -48,7 +48,7 @@ copyright = u'2011-2014, Massachusetts Institute of Technology' # The short X.Y version. version = "0.6" # The full version, including alpha/beta/rc tags. -release = "0.6.0" +release = "0.6.1" # The language for content autogenerated by Sphinx. Refer to documentation # for a list of supported languages. diff --git a/src/constants.F90 b/src/constants.F90 index ae9c77287a..91aafaa009 100644 --- a/src/constants.F90 +++ b/src/constants.F90 @@ -8,7 +8,7 @@ module constants ! OpenMC major, minor, and release numbers integer, parameter :: VERSION_MAJOR = 0 integer, parameter :: VERSION_MINOR = 6 - integer, parameter :: VERSION_RELEASE = 0 + integer, parameter :: VERSION_RELEASE = 1 ! Revision numbers for binary files integer, parameter :: REVISION_STATEPOINT = 12 diff --git a/src/utils/setup.py b/src/utils/setup.py index 1000e509b3..4c2f1ae246 100644 --- a/src/utils/setup.py +++ b/src/utils/setup.py @@ -3,7 +3,7 @@ from distutils.core import setup setup(name='statepoint', - version='0.6.0', + version='0.6.1', description='OpenMC StatePoint', author='Paul Romano', author_email='paul.k.romano@gmail.com', From 00af4442f24c9f744c033af44d9834677d2b7b99 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Thu, 2 Oct 2014 21:15:45 -0400 Subject: [PATCH 80/95] Update release notes with latest bug fix. --- docs/source/releasenotes/notes_0.6.1.rst | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/docs/source/releasenotes/notes_0.6.1.rst b/docs/source/releasenotes/notes_0.6.1.rst index b0651a8629..71852bd174 100644 --- a/docs/source/releasenotes/notes_0.6.1.rst +++ b/docs/source/releasenotes/notes_0.6.1.rst @@ -17,7 +17,7 @@ the problem at hand (mostly on the number of nuclides in the problem). New Features ------------ -- Coarse mesh finite difference acceleration no longer requires PETSc +- Coarse mesh finite difference (CMFD) acceleration no longer requires PETSc - Statepoint file numbering is now zero-padded - Python scripts now compatible with Python 2 or 3 - Ability to run particle restarts in fixed source calculations @@ -38,6 +38,7 @@ Bug Fixes - 01178b_: Fix metastables nuclides in NNDC cross_sections.xml file - 62ec43_: Don't read tallies.xml when OpenMC is run in plotting mode - 2a95ef_: Prevent segmentation fault on "current" score without mesh filter +- 93e482_: Check for negative values in probability tables .. _03e890: https://github.com/mit-crpg/openmc/commit/03e890 .. _4439de: https://github.com/mit-crpg/openmc/commit/4439de @@ -48,6 +49,7 @@ Bug Fixes .. _01178b: https://github.com/mit-crpg/openmc/commit/01178b .. _62ec43: https://github.com/mit-crpg/openmc/commit/62ec43 .. _2a95ef: https://github.com/mit-crpg/openmc/commit/2a95ef +.. _93e482: https://github.com/mit-crpg/openmc/commit/93e482 ------------ Contributors From 6944e8d2f64458b6139ce7fc3674f7af0bec94f8 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Thu, 2 Oct 2014 21:32:37 -0400 Subject: [PATCH 81/95] Add documentation of statepoint revision 12. --- docs/source/devguide/statepoint.rst | 51 ++++++++++++++++------------- 1 file changed, 29 insertions(+), 22 deletions(-) diff --git a/docs/source/devguide/statepoint.rst b/docs/source/devguide/statepoint.rst index 5f05c92c83..82b0a7f054 100644 --- a/docs/source/devguide/statepoint.rst +++ b/docs/source/devguide/statepoint.rst @@ -4,6 +4,13 @@ State Point Binary File Specifications ====================================== +----------- +Revision 12 +----------- + +Same as revision 11, except **tallies(i) % scatt_order(j)** is now **tallies(i) +% moment_order(j)**. + ----------- Revision 11 ----------- @@ -218,13 +225,13 @@ if (run_mode == MODE_EIGENVALUE) **integer(4) tallies(i) % score_bins(j)** Values of specified scoring bins (e.g. SCORE_FLUX). - + *do j = 1, tallies(i) % n_score_bins* **integer(4) tallies(i) % scatt_order(j)** Scattering Order specified scoring bins. - + **integer(4) tallies(i) % n_score_bins** Number of scoring bins without accounting for those added by @@ -265,7 +272,7 @@ if (tallies_on > 0) *do j = 1, size(tallies(i) % scores, 1)* **real(8) tallies(i) % scores(j,k) % sum** - + Accumulated sum for the j-th score and k-th filter of the i-th tally @@ -295,7 +302,7 @@ if (run_mode == MODE_EIGENVALUE and source_present) Energy of the i-th source particle. ----------- -Revision 10 +Revision 10 ----------- **integer(4) FILETYPE_STATEPOINT** @@ -508,13 +515,13 @@ if (run_mode == MODE_EIGENVALUE) **integer(4) tallies(i) % score_bins(j)** Values of specified scoring bins (e.g. SCORE_FLUX). - + *do j = 1, tallies(i) % n_score_bins* **integer(4) tallies(i) % scatt_order(j)** Scattering Order specified scoring bins. - + **integer(4) tallies(i) % n_score_bins** Number of scoring bins without accounting for those added by @@ -551,7 +558,7 @@ if (tallies_on > 0) *do j = 1, size(tallies(i) % scores, 1)* **real(8) tallies(i) % scores(j,k) % sum** - + Accumulated sum for the j-th score and k-th filter of the i-th tally @@ -760,13 +767,13 @@ if (run_mode == MODE_EIGENVALUE) **integer(4) tallies(i) % score_bins(j)** Values of specified scoring bins (e.g. SCORE_FLUX). - + *do j = 1, tallies(i) % n_score_bins* **integer(4) tallies(i) % scatt_order(j)** Scattering Order specified scoring bins. - + **integer(4) tallies(i) % n_score_bins** Number of scoring bins without accounting for those added by @@ -803,7 +810,7 @@ if (tallies_on > 0) *do j = 1, size(tallies(i) % scores, 1)* **real(8) tallies(i) % scores(j,k) % sum** - + Accumulated sum for the j-th score and k-th filter of the i-th tally @@ -1008,13 +1015,13 @@ if (run_mode == MODE_EIGENVALUE) **integer(4) tallies(i) % score_bins(j)** Values of specified scoring bins (e.g. SCORE_FLUX). - + *do j = 1, tallies(i) % n_score_bins* **integer(4) tallies(i) % scatt_order(j)** Scattering Order specified scoring bins. - + **integer(4) tallies(i) % n_score_bins** Number of scoring bins without accounting for those added by @@ -1051,7 +1058,7 @@ if (tallies_on > 0) *do j = 1, size(tallies(i) % scores, 1)* **real(8) tallies(i) % scores(j,k) % sum** - + Accumulated sum for the j-th score and k-th filter of the i-th tally @@ -1240,13 +1247,13 @@ if (run_mode == MODE_EIGENVALUE) **integer(4) tallies(i) % score_bins(j)** Values of specified scoring bins (e.g. SCORE_FLUX). - + *do j = 1, tallies(i) % n_score_bins* **integer(4) tallies(i) % scatt_order(j)** Scattering Order specified scoring bins. - + **integer(4) tallies(i) % n_score_bins** Number of scoring bins without accounting for those added by @@ -1283,7 +1290,7 @@ if (tallies_on > 0) *do j = 1, size(tallies(i) % scores, 1)* **real(8) tallies(i) % scores(j,k) % sum** - + Accumulated sum for the j-th score and k-th filter of the i-th tally @@ -1504,7 +1511,7 @@ if (tallies_on > 0) *do j = 1, size(tallies(i) % scores, 1)* **real(8) tallies(i) % scores(j,k) % sum** - + Accumulated sum for the j-th score and k-th filter of the i-th tally @@ -1713,7 +1720,7 @@ if (tallies_on > 0) *do j = 1, size(tallies(i) % scores, 1)* **real(8) tallies(i) % scores(j,k) % sum** - + Accumulated sum for the j-th score and k-th filter of the i-th tally @@ -1918,7 +1925,7 @@ if (tallies_on > 0) *do j = 1, size(tallies(i) % scores, 1)* **real(8) tallies(i) % scores(j,k) % sum** - + Accumulated sum for the j-th score and k-th filter of the i-th tally @@ -2119,7 +2126,7 @@ if (tallies_on > 0) *do j = 1, size(tallies(i) % scores, 1)* **real(8) tallies(i) % scores(j,k) % sum** - + Accumulated sum for the j-th score and k-th filter of the i-th tally @@ -2240,7 +2247,7 @@ Revision 2 *do j = 1, size(tallies(i) % scores, 1)* **real(8) tallies(i) % scores(j,k) % sum** - + Accumulated sum for the j-th score and k-th filter of the i-th tally @@ -2339,7 +2346,7 @@ Revision 1 *do j = 1, size(tallies(i) % scores, 1)* **real(8) tallies(i) % scores(j,k) % sum** - + Accumulated sum for the j-th score and k-th filter of the i-th tally From dc4c7c2c8fb3ed7f2c9269a6f5d999c42f4cdb11 Mon Sep 17 00:00:00 2001 From: Adam Nelson Date: Thu, 2 Oct 2014 22:01:56 -0400 Subject: [PATCH 82/95] Fixed total-yN manual entry - good catch Paul --- docs/source/usersguide/input.rst | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/docs/source/usersguide/input.rst b/docs/source/usersguide/input.rst index cf403e8da3..d83e127058 100644 --- a/docs/source/usersguide/input.rst +++ b/docs/source/usersguide/input.rst @@ -1092,10 +1092,10 @@ The ```` element accepts the following sub-elements: all of the harmonic moments of order 0 to N. N must be between 0 and 10. :total-YN: - Spherical harmonic expansion of the incoming particle's direction of - motion :math:`\left(\Omega\right)` of the total flux. This score will - tally all of the harmonic moments of order 0 to N. N must be between 0 - and 10. + The total reaction rate expanded via spherical harmonics about the + direction of motion of the neutron, :math:`\Omega`. + This score will tally all of the harmonic moments of order 0 to N. N must + be between 0 and 10. :current: Partial currents on the boundaries of each cell in a mesh. From 2c433d3061a7cd99fc33ba181ab95b634fb1ef4a Mon Sep 17 00:00:00 2001 From: Nick Horelik Date: Mon, 6 Oct 2014 10:33:22 -0400 Subject: [PATCH 83/95] Fixed entropy mesh width calculation --- src/eigenvalue.F90 | 8 ++++---- src/input_xml.F90 | 6 ++++++ 2 files changed, 10 insertions(+), 4 deletions(-) diff --git a/src/eigenvalue.F90 b/src/eigenvalue.F90 index 37edb922c4..cd95568849 100644 --- a/src/eigenvalue.F90 +++ b/src/eigenvalue.F90 @@ -536,12 +536,12 @@ contains m % n_dimension = 3 allocate(m % dimension(3)) m % dimension = n + + ! determine width + m % width = (m % upper_right - m % lower_left) / m % dimension + end if - ! allocate and determine width - allocate(m % width(3)) - m % width = (m % upper_right - m % lower_left) / m % dimension - ! allocate p allocate(entropy_p(1, m % dimension(1), m % dimension(2), & m % dimension(3))) diff --git a/src/input_xml.F90 b/src/input_xml.F90 index a55fc363f4..522427807d 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -3135,6 +3135,12 @@ contains call fatal_error() end if + if (.not. allocated(entropy_mesh % dimension)) then + message = "No dimension specified on entropy mesh for " // + "meshlines on plot " // trim(to_str(pl % id)) + call fatal_error() + end if + pl % meshlines_mesh => entropy_mesh case ('tally') From 9d32299e4dec2cb9649b53de5eb5c64c223674f4 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Mon, 6 Oct 2014 21:01:17 -0400 Subject: [PATCH 84/95] Ensure installation of Python modules goes into CMAKE_INSTALL_PREFIX. Closes #329 on github. --- docs/source/usersguide/install.rst | 16 +++++++++------- src/CMakeLists.txt | 3 ++- 2 files changed, 11 insertions(+), 8 deletions(-) diff --git a/docs/source/usersguide/install.rst b/docs/source/usersguide/install.rst index 358937e303..33e5936586 100644 --- a/docs/source/usersguide/install.rst +++ b/docs/source/usersguide/install.rst @@ -239,20 +239,22 @@ the root directory of the source code: .. code-block:: sh - cd src + mkdir src/build + cd src/build + cmake .. make - sudo make install + make install This will build an executable named ``openmc`` and install it (by default in /usr/local/bin). If you do not have administrative privileges, you can install -OpenMC locally by replacing the last command with: +OpenMC locally by specifying an install prefix when running cmake: .. code-block:: sh - make install -e prefix=$HOME/.local + cmake -DCMAKE_INSTALL_PREFIX=$HOME/.local .. -The ``prefix`` variable can be changed to any path for which you have -write-access. +The ``CMAKE_INSTALL_PREFIX`` variable can be changed to any path for which you +have write-access. Compiling on Windows -------------------- @@ -326,7 +328,7 @@ Testing Build ------------- If you have ENDF/B-VII.1 cross sections from NNDC_ you can test your build. -Make sure the **CROSS_SECTIONS** environmental variable is set to the +Make sure the **CROSS_SECTIONS** environmental variable is set to the *cross_sections.xml* file in the *data/nndc* directory. There are two ways to run tests. The first is to use the Makefile present in the source directory and run the following: diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 8a9424e79d..bf657c03de 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -261,7 +261,8 @@ install(FILES ../LICENSE DESTINATION "share/doc/${program}/copyright") find_package(PythonInterp) if(PYTHONINTERP_FOUND) install(CODE "execute_process( - COMMAND ${PYTHON_EXECUTABLE} setup.py install --user + COMMAND ${PYTHON_EXECUTABLE} setup.py install + --prefix=${CMAKE_INSTALL_PREFIX} WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}/utils)") endif() From e67211b09cfe994ae51bb88135f07a5bd58f4c74 Mon Sep 17 00:00:00 2001 From: Nick Horelik Date: Tue, 7 Oct 2014 00:56:16 -0400 Subject: [PATCH 85/95] Added missing ampersand --- src/input_xml.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/input_xml.F90 b/src/input_xml.F90 index 522427807d..e84f072ea8 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -3136,7 +3136,7 @@ contains end if if (.not. allocated(entropy_mesh % dimension)) then - message = "No dimension specified on entropy mesh for " // + message = "No dimension specified on entropy mesh for " // & "meshlines on plot " // trim(to_str(pl % id)) call fatal_error() end if From 2a382d70908c153098595f128d21b13ea55baa6d Mon Sep 17 00:00:00 2001 From: Nick Horelik Date: Tue, 7 Oct 2014 00:59:39 -0400 Subject: [PATCH 86/95] Updated rnc file for meshlines plot xml changes --- src/relaxng/plots.rnc | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/relaxng/plots.rnc b/src/relaxng/plots.rnc index 3c29ba4e0b..a7c657864d 100644 --- a/src/relaxng/plots.rnc +++ b/src/relaxng/plots.rnc @@ -26,6 +26,14 @@ element plots { attribute components { list { xsd:int+ } }) & (element background { list { xsd:int+ } } | attribute background { list { xsd:int+ } }) + }* & + element meshlines { + (element meshtype { ( "tally" | "entropy" | "ufs" | "cmfd" ) } | + attribute meshtype { ( "tally" | "entropy" | "ufs" | "cmfd" ) }) & + (element id { xsd:int } | attribute id { xsd:int })? & + (element linewidth { xsd:int } | attribute linewidth { xsd:int }) & + (element color { list { xsd:int+ } } | + attribute color { list { xsd:int+ } })? }* }* } From 5184ca672e3dd517fad127c48bec1006cf419af3 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Thu, 9 Oct 2014 16:40:53 -0400 Subject: [PATCH 87/95] Change sys.path.append to sys.path.insert in results.py for each test. --- tests/test_basic/results.py | 2 +- tests/test_cmfd_feed/results.py | 2 +- tests/test_cmfd_jfnk/results.py | 2 +- tests/test_cmfd_nofeed/results.py | 2 +- tests/test_confidence_intervals/results.py | 2 +- tests/test_density_atombcm/results.py | 2 +- tests/test_density_atomcm3/results.py | 2 +- tests/test_density_kgm3/results.py | 2 +- tests/test_density_sum/results.py | 2 +- tests/test_eigenvalue_genperbatch/results.py | 2 +- tests/test_eigenvalue_no_inactive/results.py | 2 +- tests/test_energy_grid/results.py | 2 +- tests/test_entropy/results.py | 2 +- tests/test_filter_cell/results.py | 2 +- tests/test_filter_cellborn/results.py | 2 +- tests/test_filter_energy/results.py | 2 +- tests/test_filter_energyout/results.py | 2 +- tests/test_filter_group_transfer/results.py | 2 +- tests/test_filter_material/results.py | 2 +- tests/test_filter_mesh_2d/results.py | 2 +- tests/test_filter_mesh_3d/results.py | 2 +- tests/test_filter_universe/results.py | 2 +- tests/test_fixed_source/results.py | 2 +- tests/test_lattice/results.py | 2 +- tests/test_lattice_multiple/results.py | 2 +- tests/test_natural_element/results.py | 2 +- tests/test_output/results.py | 2 +- tests/test_particle_restart_eigval/results.py | 2 +- tests/test_particle_restart_fixed/results.py | 2 +- tests/test_ptables_off/results.py | 2 +- tests/test_reflective_cone/results.py | 2 +- tests/test_reflective_cylinder/results.py | 2 +- tests/test_reflective_plane/results.py | 2 +- tests/test_reflective_sphere/results.py | 2 +- tests/test_resonance_scattering/results.py | 2 +- tests/test_rotation/results.py | 2 +- tests/test_salphabeta/results.py | 2 +- tests/test_salphabeta_multiple/results.py | 2 +- tests/test_score_MT/results.py | 2 +- tests/test_score_absorption/results.py | 2 +- tests/test_score_current/results.py | 2 +- tests/test_score_events/results.py | 2 +- tests/test_score_fission/results.py | 2 +- tests/test_score_flux/results.py | 2 +- tests/test_score_flux_yn/results.py | 2 +- tests/test_score_kappafission/results.py | 2 +- tests/test_score_nufission/results.py | 2 +- tests/test_score_nuscatter/results.py | 2 +- tests/test_score_nuscatter_n/results.py | 2 +- tests/test_score_nuscatter_pn/results.py | 2 +- tests/test_score_nuscatter_yn/results.py | 2 +- tests/test_score_scatter/results.py | 2 +- tests/test_score_scatter_n/results.py | 2 +- tests/test_score_scatter_pn/results.py | 2 +- tests/test_score_scatter_yn/results.py | 2 +- tests/test_score_total/results.py | 2 +- tests/test_score_total_yn/results.py | 2 +- tests/test_seed/results.py | 2 +- tests/test_source_angle_mono/results.py | 2 +- tests/test_source_energy_maxwell/results.py | 2 +- tests/test_source_energy_mono/results.py | 2 +- tests/test_source_file/results.py | 2 +- tests/test_source_point/results.py | 2 +- tests/test_sourcepoint_batch/results.py | 2 +- tests/test_sourcepoint_interval/results.py | 2 +- tests/test_sourcepoint_latest/results.py | 2 +- tests/test_sourcepoint_restart/results.py | 2 +- tests/test_statepoint_batch/results.py | 2 +- tests/test_statepoint_interval/results.py | 2 +- tests/test_statepoint_restart/results.py | 2 +- tests/test_statepoint_sourcesep/results.py | 2 +- tests/test_survival_biasing/results.py | 2 +- tests/test_tally_assumesep/results.py | 2 +- tests/test_tally_nuclides/results.py | 2 +- tests/test_trace/results.py | 2 +- tests/test_translation/results.py | 2 +- tests/test_uniform_fs/results.py | 2 +- tests/test_universe/results.py | 2 +- tests/test_void/results.py | 2 +- 79 files changed, 79 insertions(+), 79 deletions(-) diff --git a/tests/test_basic/results.py b/tests/test_basic/results.py index 8ff10971cd..be13ee66f1 100644 --- a/tests/test_basic/results.py +++ b/tests/test_basic/results.py @@ -3,7 +3,7 @@ import sys # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_cmfd_feed/results.py b/tests/test_cmfd_feed/results.py index 26bcb36d9f..bf969b4b04 100644 --- a/tests/test_cmfd_feed/results.py +++ b/tests/test_cmfd_feed/results.py @@ -4,7 +4,7 @@ import sys import numpy as np # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_cmfd_jfnk/results.py b/tests/test_cmfd_jfnk/results.py index 26bcb36d9f..bf969b4b04 100644 --- a/tests/test_cmfd_jfnk/results.py +++ b/tests/test_cmfd_jfnk/results.py @@ -4,7 +4,7 @@ import sys import numpy as np # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_cmfd_nofeed/results.py b/tests/test_cmfd_nofeed/results.py index 26bcb36d9f..bf969b4b04 100644 --- a/tests/test_cmfd_nofeed/results.py +++ b/tests/test_cmfd_nofeed/results.py @@ -4,7 +4,7 @@ import sys import numpy as np # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_confidence_intervals/results.py b/tests/test_confidence_intervals/results.py index 93371960ae..fd27b041a2 100644 --- a/tests/test_confidence_intervals/results.py +++ b/tests/test_confidence_intervals/results.py @@ -4,7 +4,7 @@ import sys import numpy as np # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_density_atombcm/results.py b/tests/test_density_atombcm/results.py index 8ff10971cd..be13ee66f1 100644 --- a/tests/test_density_atombcm/results.py +++ b/tests/test_density_atombcm/results.py @@ -3,7 +3,7 @@ import sys # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_density_atomcm3/results.py b/tests/test_density_atomcm3/results.py index 8ff10971cd..be13ee66f1 100644 --- a/tests/test_density_atomcm3/results.py +++ b/tests/test_density_atomcm3/results.py @@ -3,7 +3,7 @@ import sys # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_density_kgm3/results.py b/tests/test_density_kgm3/results.py index 8ff10971cd..be13ee66f1 100644 --- a/tests/test_density_kgm3/results.py +++ b/tests/test_density_kgm3/results.py @@ -3,7 +3,7 @@ import sys # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_density_sum/results.py b/tests/test_density_sum/results.py index 8ff10971cd..be13ee66f1 100644 --- a/tests/test_density_sum/results.py +++ b/tests/test_density_sum/results.py @@ -3,7 +3,7 @@ import sys # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_eigenvalue_genperbatch/results.py b/tests/test_eigenvalue_genperbatch/results.py index 36b1a0a5f2..e2bb49e235 100644 --- a/tests/test_eigenvalue_genperbatch/results.py +++ b/tests/test_eigenvalue_genperbatch/results.py @@ -3,7 +3,7 @@ import sys # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_eigenvalue_no_inactive/results.py b/tests/test_eigenvalue_no_inactive/results.py index 8ff10971cd..be13ee66f1 100644 --- a/tests/test_eigenvalue_no_inactive/results.py +++ b/tests/test_eigenvalue_no_inactive/results.py @@ -3,7 +3,7 @@ import sys # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_energy_grid/results.py b/tests/test_energy_grid/results.py index 8ff10971cd..be13ee66f1 100644 --- a/tests/test_energy_grid/results.py +++ b/tests/test_energy_grid/results.py @@ -3,7 +3,7 @@ import sys # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_entropy/results.py b/tests/test_entropy/results.py index 9118335186..6c56b22c19 100644 --- a/tests/test_entropy/results.py +++ b/tests/test_entropy/results.py @@ -4,7 +4,7 @@ import sys import numpy as np # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_filter_cell/results.py b/tests/test_filter_cell/results.py index 93371960ae..fd27b041a2 100644 --- a/tests/test_filter_cell/results.py +++ b/tests/test_filter_cell/results.py @@ -4,7 +4,7 @@ import sys import numpy as np # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_filter_cellborn/results.py b/tests/test_filter_cellborn/results.py index 93371960ae..fd27b041a2 100644 --- a/tests/test_filter_cellborn/results.py +++ b/tests/test_filter_cellborn/results.py @@ -4,7 +4,7 @@ import sys import numpy as np # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_filter_energy/results.py b/tests/test_filter_energy/results.py index 93371960ae..fd27b041a2 100644 --- a/tests/test_filter_energy/results.py +++ b/tests/test_filter_energy/results.py @@ -4,7 +4,7 @@ import sys import numpy as np # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_filter_energyout/results.py b/tests/test_filter_energyout/results.py index 93371960ae..fd27b041a2 100644 --- a/tests/test_filter_energyout/results.py +++ b/tests/test_filter_energyout/results.py @@ -4,7 +4,7 @@ import sys import numpy as np # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_filter_group_transfer/results.py b/tests/test_filter_group_transfer/results.py index 93371960ae..fd27b041a2 100644 --- a/tests/test_filter_group_transfer/results.py +++ b/tests/test_filter_group_transfer/results.py @@ -4,7 +4,7 @@ import sys import numpy as np # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_filter_material/results.py b/tests/test_filter_material/results.py index 93371960ae..fd27b041a2 100644 --- a/tests/test_filter_material/results.py +++ b/tests/test_filter_material/results.py @@ -4,7 +4,7 @@ import sys import numpy as np # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_filter_mesh_2d/results.py b/tests/test_filter_mesh_2d/results.py index 93371960ae..fd27b041a2 100644 --- a/tests/test_filter_mesh_2d/results.py +++ b/tests/test_filter_mesh_2d/results.py @@ -4,7 +4,7 @@ import sys import numpy as np # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_filter_mesh_3d/results.py b/tests/test_filter_mesh_3d/results.py index 93371960ae..fd27b041a2 100644 --- a/tests/test_filter_mesh_3d/results.py +++ b/tests/test_filter_mesh_3d/results.py @@ -4,7 +4,7 @@ import sys import numpy as np # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_filter_universe/results.py b/tests/test_filter_universe/results.py index 93371960ae..fd27b041a2 100644 --- a/tests/test_filter_universe/results.py +++ b/tests/test_filter_universe/results.py @@ -4,7 +4,7 @@ import sys import numpy as np # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_fixed_source/results.py b/tests/test_fixed_source/results.py index ed0c8fd3a7..39695b1e47 100644 --- a/tests/test_fixed_source/results.py +++ b/tests/test_fixed_source/results.py @@ -4,7 +4,7 @@ import sys import numpy as np # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_lattice/results.py b/tests/test_lattice/results.py index 8ff10971cd..be13ee66f1 100644 --- a/tests/test_lattice/results.py +++ b/tests/test_lattice/results.py @@ -3,7 +3,7 @@ import sys # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_lattice_multiple/results.py b/tests/test_lattice_multiple/results.py index 8ff10971cd..be13ee66f1 100644 --- a/tests/test_lattice_multiple/results.py +++ b/tests/test_lattice_multiple/results.py @@ -3,7 +3,7 @@ import sys # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_natural_element/results.py b/tests/test_natural_element/results.py index 8ff10971cd..be13ee66f1 100644 --- a/tests/test_natural_element/results.py +++ b/tests/test_natural_element/results.py @@ -3,7 +3,7 @@ import sys # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_output/results.py b/tests/test_output/results.py index 8ff10971cd..be13ee66f1 100644 --- a/tests/test_output/results.py +++ b/tests/test_output/results.py @@ -3,7 +3,7 @@ import sys # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_particle_restart_eigval/results.py b/tests/test_particle_restart_eigval/results.py index 23670872be..5f522b0848 100644 --- a/tests/test_particle_restart_eigval/results.py +++ b/tests/test_particle_restart_eigval/results.py @@ -3,7 +3,7 @@ import sys # import particle restart -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import particle_restart as pr # read in particle restart file diff --git a/tests/test_particle_restart_fixed/results.py b/tests/test_particle_restart_fixed/results.py index e84cb88cff..84956f1d0b 100644 --- a/tests/test_particle_restart_fixed/results.py +++ b/tests/test_particle_restart_fixed/results.py @@ -3,7 +3,7 @@ import sys # import particle restart -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import particle_restart as pr # read in particle restart file diff --git a/tests/test_ptables_off/results.py b/tests/test_ptables_off/results.py index 8ff10971cd..be13ee66f1 100644 --- a/tests/test_ptables_off/results.py +++ b/tests/test_ptables_off/results.py @@ -3,7 +3,7 @@ import sys # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_reflective_cone/results.py b/tests/test_reflective_cone/results.py index 8ff10971cd..be13ee66f1 100644 --- a/tests/test_reflective_cone/results.py +++ b/tests/test_reflective_cone/results.py @@ -3,7 +3,7 @@ import sys # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_reflective_cylinder/results.py b/tests/test_reflective_cylinder/results.py index 8ff10971cd..be13ee66f1 100644 --- a/tests/test_reflective_cylinder/results.py +++ b/tests/test_reflective_cylinder/results.py @@ -3,7 +3,7 @@ import sys # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_reflective_plane/results.py b/tests/test_reflective_plane/results.py index 8ff10971cd..be13ee66f1 100644 --- a/tests/test_reflective_plane/results.py +++ b/tests/test_reflective_plane/results.py @@ -3,7 +3,7 @@ import sys # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_reflective_sphere/results.py b/tests/test_reflective_sphere/results.py index 8ff10971cd..be13ee66f1 100644 --- a/tests/test_reflective_sphere/results.py +++ b/tests/test_reflective_sphere/results.py @@ -3,7 +3,7 @@ import sys # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_resonance_scattering/results.py b/tests/test_resonance_scattering/results.py index 8ff10971cd..be13ee66f1 100644 --- a/tests/test_resonance_scattering/results.py +++ b/tests/test_resonance_scattering/results.py @@ -3,7 +3,7 @@ import sys # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_rotation/results.py b/tests/test_rotation/results.py index 8ff10971cd..be13ee66f1 100644 --- a/tests/test_rotation/results.py +++ b/tests/test_rotation/results.py @@ -3,7 +3,7 @@ import sys # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_salphabeta/results.py b/tests/test_salphabeta/results.py index 8ff10971cd..be13ee66f1 100644 --- a/tests/test_salphabeta/results.py +++ b/tests/test_salphabeta/results.py @@ -3,7 +3,7 @@ import sys # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_salphabeta_multiple/results.py b/tests/test_salphabeta_multiple/results.py index 8ff10971cd..be13ee66f1 100644 --- a/tests/test_salphabeta_multiple/results.py +++ b/tests/test_salphabeta_multiple/results.py @@ -3,7 +3,7 @@ import sys # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_score_MT/results.py b/tests/test_score_MT/results.py index 93371960ae..fd27b041a2 100644 --- a/tests/test_score_MT/results.py +++ b/tests/test_score_MT/results.py @@ -4,7 +4,7 @@ import sys import numpy as np # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_score_absorption/results.py b/tests/test_score_absorption/results.py index f4c32a893f..fa385bc37f 100644 --- a/tests/test_score_absorption/results.py +++ b/tests/test_score_absorption/results.py @@ -4,7 +4,7 @@ import sys import numpy as np # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_score_current/results.py b/tests/test_score_current/results.py index f4c32a893f..fa385bc37f 100644 --- a/tests/test_score_current/results.py +++ b/tests/test_score_current/results.py @@ -4,7 +4,7 @@ import sys import numpy as np # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_score_events/results.py b/tests/test_score_events/results.py index f4c32a893f..fa385bc37f 100644 --- a/tests/test_score_events/results.py +++ b/tests/test_score_events/results.py @@ -4,7 +4,7 @@ import sys import numpy as np # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_score_fission/results.py b/tests/test_score_fission/results.py index f4c32a893f..fa385bc37f 100644 --- a/tests/test_score_fission/results.py +++ b/tests/test_score_fission/results.py @@ -4,7 +4,7 @@ import sys import numpy as np # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_score_flux/results.py b/tests/test_score_flux/results.py index 93371960ae..fd27b041a2 100644 --- a/tests/test_score_flux/results.py +++ b/tests/test_score_flux/results.py @@ -4,7 +4,7 @@ import sys import numpy as np # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_score_flux_yn/results.py b/tests/test_score_flux_yn/results.py index f4c32a893f..fa385bc37f 100644 --- a/tests/test_score_flux_yn/results.py +++ b/tests/test_score_flux_yn/results.py @@ -4,7 +4,7 @@ import sys import numpy as np # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_score_kappafission/results.py b/tests/test_score_kappafission/results.py index 93371960ae..fd27b041a2 100644 --- a/tests/test_score_kappafission/results.py +++ b/tests/test_score_kappafission/results.py @@ -4,7 +4,7 @@ import sys import numpy as np # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_score_nufission/results.py b/tests/test_score_nufission/results.py index 93371960ae..fd27b041a2 100644 --- a/tests/test_score_nufission/results.py +++ b/tests/test_score_nufission/results.py @@ -4,7 +4,7 @@ import sys import numpy as np # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_score_nuscatter/results.py b/tests/test_score_nuscatter/results.py index 93371960ae..fd27b041a2 100644 --- a/tests/test_score_nuscatter/results.py +++ b/tests/test_score_nuscatter/results.py @@ -4,7 +4,7 @@ import sys import numpy as np # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_score_nuscatter_n/results.py b/tests/test_score_nuscatter_n/results.py index 93371960ae..fd27b041a2 100644 --- a/tests/test_score_nuscatter_n/results.py +++ b/tests/test_score_nuscatter_n/results.py @@ -4,7 +4,7 @@ import sys import numpy as np # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_score_nuscatter_pn/results.py b/tests/test_score_nuscatter_pn/results.py index f4c32a893f..fa385bc37f 100644 --- a/tests/test_score_nuscatter_pn/results.py +++ b/tests/test_score_nuscatter_pn/results.py @@ -4,7 +4,7 @@ import sys import numpy as np # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_score_nuscatter_yn/results.py b/tests/test_score_nuscatter_yn/results.py index f4c32a893f..fa385bc37f 100644 --- a/tests/test_score_nuscatter_yn/results.py +++ b/tests/test_score_nuscatter_yn/results.py @@ -4,7 +4,7 @@ import sys import numpy as np # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_score_scatter/results.py b/tests/test_score_scatter/results.py index 93371960ae..fd27b041a2 100644 --- a/tests/test_score_scatter/results.py +++ b/tests/test_score_scatter/results.py @@ -4,7 +4,7 @@ import sys import numpy as np # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_score_scatter_n/results.py b/tests/test_score_scatter_n/results.py index 93371960ae..fd27b041a2 100644 --- a/tests/test_score_scatter_n/results.py +++ b/tests/test_score_scatter_n/results.py @@ -4,7 +4,7 @@ import sys import numpy as np # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_score_scatter_pn/results.py b/tests/test_score_scatter_pn/results.py index f4c32a893f..fa385bc37f 100644 --- a/tests/test_score_scatter_pn/results.py +++ b/tests/test_score_scatter_pn/results.py @@ -4,7 +4,7 @@ import sys import numpy as np # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_score_scatter_yn/results.py b/tests/test_score_scatter_yn/results.py index f4c32a893f..fa385bc37f 100644 --- a/tests/test_score_scatter_yn/results.py +++ b/tests/test_score_scatter_yn/results.py @@ -4,7 +4,7 @@ import sys import numpy as np # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_score_total/results.py b/tests/test_score_total/results.py index 93371960ae..fd27b041a2 100644 --- a/tests/test_score_total/results.py +++ b/tests/test_score_total/results.py @@ -4,7 +4,7 @@ import sys import numpy as np # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_score_total_yn/results.py b/tests/test_score_total_yn/results.py index f4c32a893f..fa385bc37f 100644 --- a/tests/test_score_total_yn/results.py +++ b/tests/test_score_total_yn/results.py @@ -4,7 +4,7 @@ import sys import numpy as np # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_seed/results.py b/tests/test_seed/results.py index 8ff10971cd..be13ee66f1 100644 --- a/tests/test_seed/results.py +++ b/tests/test_seed/results.py @@ -3,7 +3,7 @@ import sys # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_source_angle_mono/results.py b/tests/test_source_angle_mono/results.py index 8ff10971cd..be13ee66f1 100644 --- a/tests/test_source_angle_mono/results.py +++ b/tests/test_source_angle_mono/results.py @@ -3,7 +3,7 @@ import sys # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_source_energy_maxwell/results.py b/tests/test_source_energy_maxwell/results.py index 8ff10971cd..be13ee66f1 100644 --- a/tests/test_source_energy_maxwell/results.py +++ b/tests/test_source_energy_maxwell/results.py @@ -3,7 +3,7 @@ import sys # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_source_energy_mono/results.py b/tests/test_source_energy_mono/results.py index 8ff10971cd..be13ee66f1 100644 --- a/tests/test_source_energy_mono/results.py +++ b/tests/test_source_energy_mono/results.py @@ -3,7 +3,7 @@ import sys # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_source_file/results.py b/tests/test_source_file/results.py index 8ff10971cd..be13ee66f1 100644 --- a/tests/test_source_file/results.py +++ b/tests/test_source_file/results.py @@ -3,7 +3,7 @@ import sys # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_source_point/results.py b/tests/test_source_point/results.py index 8ff10971cd..be13ee66f1 100644 --- a/tests/test_source_point/results.py +++ b/tests/test_source_point/results.py @@ -3,7 +3,7 @@ import sys # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_sourcepoint_batch/results.py b/tests/test_sourcepoint_batch/results.py index 96984b2fae..1f9f4f1a8d 100644 --- a/tests/test_sourcepoint_batch/results.py +++ b/tests/test_sourcepoint_batch/results.py @@ -3,7 +3,7 @@ import sys # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_sourcepoint_interval/results.py b/tests/test_sourcepoint_interval/results.py index 96984b2fae..1f9f4f1a8d 100644 --- a/tests/test_sourcepoint_interval/results.py +++ b/tests/test_sourcepoint_interval/results.py @@ -3,7 +3,7 @@ import sys # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_sourcepoint_latest/results.py b/tests/test_sourcepoint_latest/results.py index 8ff10971cd..be13ee66f1 100644 --- a/tests/test_sourcepoint_latest/results.py +++ b/tests/test_sourcepoint_latest/results.py @@ -3,7 +3,7 @@ import sys # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_sourcepoint_restart/results.py b/tests/test_sourcepoint_restart/results.py index f4c32a893f..fa385bc37f 100644 --- a/tests/test_sourcepoint_restart/results.py +++ b/tests/test_sourcepoint_restart/results.py @@ -4,7 +4,7 @@ import sys import numpy as np # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_statepoint_batch/results.py b/tests/test_statepoint_batch/results.py index 112c005167..39f6af12f2 100644 --- a/tests/test_statepoint_batch/results.py +++ b/tests/test_statepoint_batch/results.py @@ -3,7 +3,7 @@ import sys # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_statepoint_interval/results.py b/tests/test_statepoint_interval/results.py index 8ff10971cd..be13ee66f1 100644 --- a/tests/test_statepoint_interval/results.py +++ b/tests/test_statepoint_interval/results.py @@ -3,7 +3,7 @@ import sys # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_statepoint_restart/results.py b/tests/test_statepoint_restart/results.py index dd9dedd035..b5daa76874 100644 --- a/tests/test_statepoint_restart/results.py +++ b/tests/test_statepoint_restart/results.py @@ -4,7 +4,7 @@ import sys import numpy as np # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_statepoint_sourcesep/results.py b/tests/test_statepoint_sourcesep/results.py index 8ff10971cd..be13ee66f1 100644 --- a/tests/test_statepoint_sourcesep/results.py +++ b/tests/test_statepoint_sourcesep/results.py @@ -3,7 +3,7 @@ import sys # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_survival_biasing/results.py b/tests/test_survival_biasing/results.py index 8ff10971cd..be13ee66f1 100644 --- a/tests/test_survival_biasing/results.py +++ b/tests/test_survival_biasing/results.py @@ -3,7 +3,7 @@ import sys # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_tally_assumesep/results.py b/tests/test_tally_assumesep/results.py index 3cba794205..9b283b63a3 100644 --- a/tests/test_tally_assumesep/results.py +++ b/tests/test_tally_assumesep/results.py @@ -4,7 +4,7 @@ import sys import numpy as np # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_tally_nuclides/results.py b/tests/test_tally_nuclides/results.py index 3aa0946a5d..4f155fb0f9 100644 --- a/tests/test_tally_nuclides/results.py +++ b/tests/test_tally_nuclides/results.py @@ -4,7 +4,7 @@ import sys import numpy as np # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_trace/results.py b/tests/test_trace/results.py index 8ff10971cd..be13ee66f1 100644 --- a/tests/test_trace/results.py +++ b/tests/test_trace/results.py @@ -3,7 +3,7 @@ import sys # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_translation/results.py b/tests/test_translation/results.py index 8ff10971cd..be13ee66f1 100644 --- a/tests/test_translation/results.py +++ b/tests/test_translation/results.py @@ -3,7 +3,7 @@ import sys # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_uniform_fs/results.py b/tests/test_uniform_fs/results.py index 8ff10971cd..be13ee66f1 100644 --- a/tests/test_uniform_fs/results.py +++ b/tests/test_uniform_fs/results.py @@ -3,7 +3,7 @@ import sys # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_universe/results.py b/tests/test_universe/results.py index 8ff10971cd..be13ee66f1 100644 --- a/tests/test_universe/results.py +++ b/tests/test_universe/results.py @@ -3,7 +3,7 @@ import sys # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file diff --git a/tests/test_void/results.py b/tests/test_void/results.py index 8ff10971cd..be13ee66f1 100644 --- a/tests/test_void/results.py +++ b/tests/test_void/results.py @@ -3,7 +3,7 @@ import sys # import statepoint -sys.path.append('../../src/utils') +sys.path.insert(0, '../../src/utils') import statepoint # read in statepoint file From 8c44836944ed1181adef87a1cf641844b8c0b058 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Thu, 24 Jul 2014 20:36:46 -0400 Subject: [PATCH 88/95] added message at top of module and removed from global Conflicts: src/cmfd_data.F90 src/fixed_source.F90 src/global.F90 src/tally_new.F90 --- src/ace.F90 | 2 ++ src/cmfd_data.F90 | 2 ++ src/cmfd_execute.F90 | 2 ++ src/cmfd_input.F90 | 2 ++ src/eigenvalue.F90 | 1 + src/energy_grid.F90 | 2 ++ src/error.F90 | 9 ++------- src/fission.F90 | 2 ++ src/fixed_source.F90 | 2 ++ src/geometry.F90 | 2 ++ src/global.F90 | 3 --- src/initialize.F90 | 2 ++ src/input_xml.F90 | 1 + src/interpolation.F90 | 2 ++ src/output.F90 | 4 +++- src/particle_restart.F90 | 2 ++ src/physics.F90 | 2 ++ src/plot.F90 | 2 ++ src/search.F90 | 2 ++ src/solver_interface.F90 | 2 ++ src/source.F90 | 2 ++ src/state_point.F90 | 1 + src/string.F90 | 2 ++ src/tally.F90 | 2 ++ src/tracking.F90 | 2 ++ src/xml_interface.F90 | 2 ++ 26 files changed, 48 insertions(+), 11 deletions(-) diff --git a/src/ace.F90 b/src/ace.F90 index 6a712ccd74..6696c1dfa4 100644 --- a/src/ace.F90 +++ b/src/ace.F90 @@ -15,6 +15,8 @@ module ace implicit none + character(2*MAX_LINE_LEN) :: message + integer :: NXS(16) ! Descriptors for ACE XSS tables integer :: JXS(32) ! Pointers into ACE XSS tables real(8), allocatable :: XSS(:) ! Cross section data diff --git a/src/cmfd_data.F90 b/src/cmfd_data.F90 index abba2d47d7..2e4d1e1c4e 100644 --- a/src/cmfd_data.F90 +++ b/src/cmfd_data.F90 @@ -10,6 +10,8 @@ module cmfd_data private public :: set_up_cmfd, neutron_balance + character(2*MAX_LINE_LEN) :: message + contains !============================================================================== diff --git a/src/cmfd_execute.F90 b/src/cmfd_execute.F90 index d14a3af243..2f74f512f8 100644 --- a/src/cmfd_execute.F90 +++ b/src/cmfd_execute.F90 @@ -11,6 +11,8 @@ module cmfd_execute private public :: execute_cmfd, cmfd_init_batch + character(2*MAX_LINE_LEN) :: message + contains !============================================================================== diff --git a/src/cmfd_input.F90 b/src/cmfd_input.F90 index 67e8f0d0f3..dc6bcfa37a 100644 --- a/src/cmfd_input.F90 +++ b/src/cmfd_input.F90 @@ -10,6 +10,8 @@ module cmfd_input private public :: configure_cmfd + character(2*MAX_LINE_LEN) :: message + contains !=============================================================================== diff --git a/src/eigenvalue.F90 b/src/eigenvalue.F90 index cd95568849..0c298ba6d6 100644 --- a/src/eigenvalue.F90 +++ b/src/eigenvalue.F90 @@ -26,6 +26,7 @@ module eigenvalue private public :: run_eigenvalue + character(2*MAX_LINE_LEN) :: message real(8) :: keff_generation ! Single-generation k on each processor real(8) :: k_sum(2) = ZERO ! used to reduce sum and sum_sq diff --git a/src/energy_grid.F90 b/src/energy_grid.F90 index 66b95be0de..95097edd59 100644 --- a/src/energy_grid.F90 +++ b/src/energy_grid.F90 @@ -5,6 +5,8 @@ module energy_grid use list_header, only: ListReal use output, only: write_message + character(2*MAX_LINE_LEN) :: message + contains !=============================================================================== diff --git a/src/error.F90 b/src/error.F90 index 78fd64c25e..1c35be8161 100644 --- a/src/error.F90 +++ b/src/error.F90 @@ -2,8 +2,6 @@ module error use, intrinsic :: ISO_FORTRAN_ENV - use global - #ifdef MPI use mpi #endif @@ -17,9 +15,9 @@ contains ! stream. !=============================================================================== - subroutine warning(force) + subroutine warning(message) - logical, optional :: force ! force write from proc other than master + character(2*MAX_LINE_LEN) :: message integer :: i_start ! starting position integer :: i_end ! ending position @@ -27,9 +25,6 @@ contains integer :: length ! length of message integer :: indent ! length of indentation - ! Only allow master to print to screen - if (.not. master .and. .not. present(force)) return - ! Write warning at beginning write(ERROR_UNIT, fmt='(1X,A)', advance='no') 'WARNING: ' diff --git a/src/fission.F90 b/src/fission.F90 index 8934b79cf5..cff8b7d9dc 100644 --- a/src/fission.F90 +++ b/src/fission.F90 @@ -9,6 +9,8 @@ module fission implicit none + character(2*MAX_LINE_LEN) :: message + contains !=============================================================================== diff --git a/src/fixed_source.F90 b/src/fixed_source.F90 index 11290db538..84993646d7 100644 --- a/src/fixed_source.F90 +++ b/src/fixed_source.F90 @@ -11,6 +11,8 @@ module fixed_source use tally, only: synchronize_tallies, setup_active_usertallies use tracking, only: transport + character(2*MAX_LINE_LEN) :: message + contains subroutine run_fixedsource() diff --git a/src/geometry.F90 b/src/geometry.F90 index 187a207fd9..17ab753379 100644 --- a/src/geometry.F90 +++ b/src/geometry.F90 @@ -11,6 +11,8 @@ module geometry use tally, only: score_surface_current implicit none + + character(2*MAX_LINE_LEN) :: message contains diff --git a/src/global.F90 b/src/global.F90 index b5f9c4a01e..8241580362 100644 --- a/src/global.F90 +++ b/src/global.F90 @@ -272,9 +272,6 @@ module global character(MAX_FILE_LEN) :: path_particle_restart ! Path to particle restart character(MAX_FILE_LEN) :: path_output = '' ! Path to output directory - ! Message used in message/warning/fatal_error - character(2*MAX_LINE_LEN) :: message - ! Random number seed integer(8) :: seed = 1_8 diff --git a/src/initialize.F90 b/src/initialize.F90 index 7d4adad493..7e25498535 100644 --- a/src/initialize.F90 +++ b/src/initialize.F90 @@ -38,6 +38,8 @@ module initialize implicit none + character(2*MAX_LINE_LEN) :: message + contains !=============================================================================== diff --git a/src/input_xml.F90 b/src/input_xml.F90 index e84f072ea8..3b080f2141 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -20,6 +20,7 @@ module input_xml implicit none save + character(2*MAX_LINE_LEN) :: message type(DictIntInt) :: cells_in_univ_dict ! used to count how many cells each ! universe contains diff --git a/src/interpolation.F90 b/src/interpolation.F90 index 748e187a34..531f69ee8c 100644 --- a/src/interpolation.F90 +++ b/src/interpolation.F90 @@ -9,6 +9,8 @@ module interpolation implicit none + character(2*MAX_LINE_LEN) :: message + interface interpolate_tab1 module procedure interpolate_tab1_array, interpolate_tab1_object end interface interpolate_tab1 diff --git a/src/output.F90 b/src/output.F90 index 1493b82943..697bc4834c 100644 --- a/src/output.F90 +++ b/src/output.F90 @@ -22,6 +22,8 @@ module output integer :: ou = OUTPUT_UNIT integer :: eu = ERROR_UNIT + character(2*MAX_LINE_LEN) :: message + contains !=============================================================================== @@ -193,7 +195,7 @@ contains ! standard output stream. !=============================================================================== - subroutine write_message(level) + subroutine write_message(message, level) integer, optional :: level ! verbosity level diff --git a/src/particle_restart.F90 b/src/particle_restart.F90 index db2490dd2a..11adb417a7 100644 --- a/src/particle_restart.F90 +++ b/src/particle_restart.F90 @@ -19,6 +19,8 @@ module particle_restart ! Binary file type(BinaryOutput) :: pr + character(2*MAX_LINE_LEN) :: message + contains !=============================================================================== diff --git a/src/physics.F90 b/src/physics.F90 index 04cc66afa2..d060c37a40 100644 --- a/src/physics.F90 +++ b/src/physics.F90 @@ -20,6 +20,8 @@ module physics implicit none + character(2*MAX_LINE_LEN) :: message + ! TODO: Figure out how to write particle restart files in sample_angle, ! sample_energy, etc. diff --git a/src/plot.F90 b/src/plot.F90 index 91b2520eb4..099e61dffb 100644 --- a/src/plot.F90 +++ b/src/plot.F90 @@ -16,6 +16,8 @@ module plot implicit none + character(2*MAX_LINE_LEN) :: message + contains !=============================================================================== diff --git a/src/search.F90 b/src/search.F90 index 962874a7f9..23f8841bdc 100644 --- a/src/search.F90 +++ b/src/search.F90 @@ -9,6 +9,8 @@ module search module procedure binary_search_real, binary_search_int4, binary_search_int8 end interface binary_search + character(2*MAX_LINE_LEN) :: message + contains !=============================================================================== diff --git a/src/solver_interface.F90 b/src/solver_interface.F90 index b629a0789f..b4d7cfca17 100644 --- a/src/solver_interface.F90 +++ b/src/solver_interface.F90 @@ -70,6 +70,8 @@ module solver_interface integer :: petsc_err ! petsc error code #endif + character(2*MAX_LINE_LEN) :: message + contains #ifdef PETSC diff --git a/src/source.F90 b/src/source.F90 index 9575020e6d..25cfd7e6b4 100644 --- a/src/source.F90 +++ b/src/source.F90 @@ -19,6 +19,8 @@ module source implicit none + character(2*MAX_LINE_LEN) :: message + contains !=============================================================================== diff --git a/src/state_point.F90 b/src/state_point.F90 index 8aff2ec364..6a769c6872 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -26,6 +26,7 @@ module state_point implicit none + character(2*MAX_LINE_LEN) :: message type(BinaryOutput) :: sp ! statepoint/source output file contains diff --git a/src/string.F90 b/src/string.F90 index d4f8873a0a..85bfaa6751 100644 --- a/src/string.F90 +++ b/src/string.F90 @@ -10,6 +10,8 @@ module string module procedure int4_to_str, int8_to_str, real_to_str end interface + character(2*MAX_LINE_LEN) :: message + contains !=============================================================================== diff --git a/src/tally.F90 b/src/tally.F90 index f86d67d168..91c28fbcf9 100644 --- a/src/tally.F90 +++ b/src/tally.F90 @@ -25,6 +25,8 @@ module tally integer :: position(N_FILTER_TYPES - 3) = 0 !$omp threadprivate(position) + character(2*MAX_LINE_LEN) :: message + contains !=============================================================================== diff --git a/src/tracking.F90 b/src/tracking.F90 index 68a0e3d09a..5ddfd32384 100644 --- a/src/tracking.F90 +++ b/src/tracking.F90 @@ -16,6 +16,8 @@ module tracking use track_output, only: initialize_particle_track, write_particle_track, & finalize_particle_track + character(2*MAX_LINE_LEN) :: message + contains !=============================================================================== diff --git a/src/xml_interface.F90 b/src/xml_interface.F90 index 64842a69ec..0860c4fab5 100644 --- a/src/xml_interface.F90 +++ b/src/xml_interface.F90 @@ -38,6 +38,8 @@ module xml_interface module procedure get_node_array_string end interface get_node_array + character(2*MAX_LINE_LEN) :: message + contains !=============================================================================== From b11c54f52b796f57bad60e52eb739aaf40c3e2ef Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Fri, 25 Jul 2014 09:08:36 -0400 Subject: [PATCH 89/95] changed how messages are handled Conflicts: src/cmfd_execute.F90 src/input_xml.F90 src/string.F90 src/tally_new.F90 src/tracking.F90 --- src/ace.F90 | 16 +- src/cmfd_data.F90 | 9 +- src/cmfd_execute.F90 | 18 +- src/cmfd_input.F90 | 32 ++-- src/cmfd_solver.F90 | 22 +-- src/eigenvalue.F90 | 12 +- src/energy_grid.F90 | 2 +- src/error.F90 | 6 +- src/fission.F90 | 3 +- src/fixed_source.F90 | 2 +- src/geometry.F90 | 20 +-- src/initialize.F90 | 40 ++--- src/input_xml.F90 | 354 +++++++++++++++++++-------------------- src/interpolation.F90 | 5 +- src/output.F90 | 6 +- src/particle_restart.F90 | 2 +- src/physics.F90 | 56 +++---- src/plot.F90 | 2 +- src/search.F90 | 14 +- src/solver_interface.F90 | 6 +- src/source.F90 | 16 +- src/state_point.F90 | 20 +-- src/string.F90 | 6 +- src/tally.F90 | 22 +-- src/tracking.F90 | 6 +- src/xml_interface.F90 | 21 ++- 26 files changed, 360 insertions(+), 358 deletions(-) diff --git a/src/ace.F90 b/src/ace.F90 index 6696c1dfa4..a5b042f3ab 100644 --- a/src/ace.F90 +++ b/src/ace.F90 @@ -155,7 +155,7 @@ contains if (mat % i_sab_nuclides(k) == NONE) then message = "S(a,b) table " // trim(mat % sab_names(k)) // " did not & &match any nuclide on material " // trim(to_str(mat % id)) - call fatal_error() + call fatal_error(message) end if end do ASSIGN_SAB @@ -267,16 +267,16 @@ contains inquire(FILE=filename, EXIST=file_exists, READ=readable) if (.not. file_exists) then message = "ACE library '" // trim(filename) // "' does not exist!" - call fatal_error() + call fatal_error(message) elseif (readable(1:3) == 'NO') then message = "ACE library '" // trim(filename) // "' is not readable! & &Change file permissions with chmod command." - call fatal_error() + call fatal_error(message) end if ! display message message = "Loading ACE cross section table: " // listing % name - call write_message(6) + call write_message(message, 6) if (filetype == ASCII) then ! ======================================================================= @@ -297,7 +297,7 @@ contains if(adjustl(name) /= adjustl(listing % name)) then message = "XS listing entry " // trim(listing % name) // " did not & &match ACE data, " // trim(name) // " found instead." - call fatal_error() + call fatal_error(message) end if ! Read more header and NXS and JXS @@ -380,7 +380,7 @@ contains ! abort the run. if (run_mode == MODE_FIXEDSOURCE .and. nuc % fissionable) then message = "Cannot have fissionable material in a fixed source run." - call fatal_error() + call fatal_error(message) end if ! for fissionable nuclides, precalculate microscopic nu-fission cross @@ -1319,7 +1319,7 @@ contains if (nuc % urr_inelastic == NONE) then message = "Could not find inelastic reaction specified on " & // "unresolved resonance probability table." - call fatal_error() + call fatal_error(message) end if end if @@ -1347,7 +1347,7 @@ contains if (any(nuc % urr_data % prob < ZERO)) then message = "Negative value(s) found on probability table for nuclide " & // nuc % name - call warning() + if (master) call warning(message) end if end subroutine read_unr_res diff --git a/src/cmfd_data.F90 b/src/cmfd_data.F90 index 2e4d1e1c4e..c49fc7808c 100644 --- a/src/cmfd_data.F90 +++ b/src/cmfd_data.F90 @@ -5,6 +5,7 @@ module cmfd_data ! parameters for CMFD calculation. !============================================================================== + use constants implicit none private @@ -55,7 +56,7 @@ contains OUT_FRONT, IN_TOP, OUT_TOP, CMFD_NOACCEL, ZERO, & ONE, TINY_BIT use error, only: fatal_error - use global, only: cmfd, message, n_cmfd_tallies, cmfd_tallies, meshes,& + use global, only: cmfd, n_cmfd_tallies, cmfd_tallies, meshes,& matching_bins use mesh, only: mesh_indices_to_bin use mesh_header, only: StructuredMesh @@ -164,7 +165,7 @@ contains message = 'Detected zero flux without coremap overlay at: (' & // to_str(i) // ',' // to_str(j) // ',' // to_str(k) & // ') in group ' // to_str(h) - call fatal_error() + call fatal_error(message) end if ! Get total rr and convert to total xs @@ -628,7 +629,7 @@ contains subroutine compute_dhat() use constants, only: CMFD_NOACCEL, ZERO - use global, only: cmfd, cmfd_coremap, message, dhat_reset + use global, only: cmfd, cmfd_coremap, dhat_reset use output, only: write_message use string, only: to_str @@ -767,7 +768,7 @@ contains ! write that dhats are zero if (dhat_reset) then message = 'Dhats reset to zero.' - call write_message(1) + call write_message(message, 1) end if end subroutine compute_dhat diff --git a/src/cmfd_execute.F90 b/src/cmfd_execute.F90 index 2f74f512f8..19e4a8364d 100644 --- a/src/cmfd_execute.F90 +++ b/src/cmfd_execute.F90 @@ -47,7 +47,7 @@ contains call cmfd_jfnk_execute() else message = 'solver type became invalid after input processing' - call fatal_error() + call fatal_error(message) end if #else call cmfd_solver_execute() @@ -257,8 +257,8 @@ contains use constants, only: ZERO, ONE use error, only: warning, fatal_error - use global, only: meshes, source_bank, work, n_user_meshes, message, & - cmfd, master + use global, only: meshes, source_bank, work, n_user_meshes, cmfd, & + master use mesh_header, only: StructuredMesh use mesh, only: count_bank_sites, get_mesh_indices use search, only: binary_search @@ -317,7 +317,7 @@ contains ! Check for sites outside of the mesh if (master .and. outside) then message = "Source sites outside of the CMFD mesh!" - call fatal_error() + call fatal_error(message) end if ! Have master compute weight factors (watch for 0s) @@ -348,11 +348,11 @@ contains if (source_bank(i) % E < cmfd % egrid(1)) then e_bin = 1 message = 'Source pt below energy grid' - call warning() + if (master) call warning(message) elseif (source_bank(i) % E > cmfd % egrid(n_groups + 1)) then e_bin = n_groups message = 'Source pt above energy grid' - call warning() + if (master) call warning(message) else e_bin = binary_search(cmfd % egrid, n_groups + 1, source_bank(i) % E) end if @@ -363,7 +363,7 @@ contains ! Check for outside of mesh if (.not. in_mesh) then message = 'Source site found outside of CMFD mesh' - call fatal_error() + call fatal_error(message) end if ! Reweight particle @@ -412,7 +412,7 @@ contains subroutine cmfd_tally_reset() - use global, only: n_cmfd_tallies, cmfd_tallies, message + use global, only: n_cmfd_tallies, cmfd_tallies use output, only: write_message use tally, only: reset_result @@ -420,7 +420,7 @@ contains ! Print message message = "CMFD tallies reset" - call write_message(7) + call write_message(message, 7) ! Begin loop around CMFD tallies do i = 1, n_cmfd_tallies diff --git a/src/cmfd_input.F90 b/src/cmfd_input.F90 index dc6bcfa37a..32797a616f 100644 --- a/src/cmfd_input.F90 +++ b/src/cmfd_input.F90 @@ -88,14 +88,14 @@ contains ! CMFD is optional unless it is in on from settings if (cmfd_on) then message = "No CMFD XML file, '" // trim(filename) // "' does not exist!" - call fatal_error() + call fatal_error(message) end if return else ! Tell user message = "Reading CMFD XML file..." - call write_message(5) + call write_message(message, 5) end if @@ -108,7 +108,7 @@ contains ! Check if mesh is there if (.not.found) then message = "No CMFD mesh specified in CMFD XML file." - call fatal_error() + call fatal_error(message) end if ! Set spatial dimensions in cmfd object @@ -140,7 +140,7 @@ contains if (get_arraysize_integer(node_mesh, "map") /= & product(cmfd % indices(1:3))) then message = 'FATAL==>CMFD coremap not to correct dimensions' - call fatal_error() + call fatal_error(message) end if allocate(iarray(get_arraysize_integer(node_mesh, "map"))) call get_node_array(node_mesh, "map", iarray) @@ -217,7 +217,7 @@ contains if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') & #ifndef PETSC message = 'Must use PETSc when running adjoint option.' - call fatal_error() + call fatal_error(message) #endif cmfd_run_adjoint = .true. end if @@ -247,7 +247,7 @@ contains if (trim(cmfd_display) == 'dominance' .and. & trim(cmfd_solver_type) /= 'power') then message = 'Dominance Ratio only aviable with power iteration solver' - call warning() + if (master) call warning(message) cmfd_display = '' end if @@ -265,7 +265,7 @@ contains if (n_params /= 2) then message = 'Gauss Seidel tolerance is not 2 parameters & &(absolute, relative).' - call fatal_error() + call fatal_error(message) end if call get_node_array(doc, "gauss_seidel_tolerance", gs_tol) cmfd_atoli = gs_tol(1) @@ -336,7 +336,7 @@ contains n = get_arraysize_integer(node_mesh, "dimension") if (n /= 2 .and. n /= 3) then message = "Mesh must be two or three dimensions." - call fatal_error() + call fatal_error(message) end if m % n_dimension = n @@ -351,7 +351,7 @@ contains if (any(iarray3(1:n) <= 0)) then message = "All entries on the element for a tally mesh & &must be positive." - call fatal_error() + call fatal_error(message) end if ! Read dimensions in each direction @@ -361,7 +361,7 @@ contains if (m % n_dimension /= get_arraysize_double(node_mesh, "lower_left")) then message = "Number of entries on must be the same as & &the number of entries on ." - call fatal_error() + call fatal_error(message) end if call get_node_array(node_mesh, "lower_left", m % lower_left) @@ -370,7 +370,7 @@ contains check_for_node(node_mesh, "width")) then message = "Cannot specify both and on a & &tally mesh." - call fatal_error() + call fatal_error(message) end if ! Make sure either upper-right or width was specified @@ -378,7 +378,7 @@ contains .not.check_for_node(node_mesh, "width")) then message = "Must specify either and on a & &tally mesh." - call fatal_error() + call fatal_error(message) end if if (check_for_node(node_mesh, "width")) then @@ -387,14 +387,14 @@ contains get_arraysize_double(node_mesh, "lower_left")) then message = "Number of entries on must be the same as the & &number of entries on ." - call fatal_error() + call fatal_error(message) end if ! Check for negative widths call get_node_array(node_mesh, "width", rarray3(1:n)) if (any(rarray3(1:n) < ZERO)) then message = "Cannot have a negative on a tally mesh." - call fatal_error() + call fatal_error(message) end if ! Set width and upper right coordinate @@ -407,7 +407,7 @@ contains get_arraysize_double(node_mesh, "lower_left")) then message = "Number of entries on must be the same as & &the number of entries on ." - call fatal_error() + call fatal_error(message) end if ! Check that upper-right is above lower-left @@ -415,7 +415,7 @@ contains if (any(rarray3(1:n) < m % lower_left)) then message = "The coordinates must be greater than the & & coordinates on a tally mesh." - call fatal_error() + call fatal_error(message) end if ! Set upper right coordinate and width diff --git a/src/cmfd_solver.F90 b/src/cmfd_solver.F90 index b3e8fb8a88..15406c143c 100644 --- a/src/cmfd_solver.F90 +++ b/src/cmfd_solver.F90 @@ -2,6 +2,7 @@ module cmfd_solver ! This module contains routines to execute the power iteration solver + use constants use cmfd_loss_operator, only: init_loss_matrix, build_loss_matrix use cmfd_prod_operator, only: init_prod_matrix, build_prod_matrix use matrix_header, only: Matrix @@ -30,6 +31,7 @@ module cmfd_solver type(Vector) :: s_n ! new source vector type(Vector) :: s_o ! old flux vector type(Vector) :: serr_v ! error in source + character(2*MAX_LINE_LEN) :: message ! CMFD linear solver interface procedure(linsolve), pointer :: cmfd_linsolver => null() @@ -180,8 +182,6 @@ contains use error, only: fatal_error #ifdef PETSC use global, only: cmfd_write_matrices -#else - use global, only: message #endif #ifdef PETSC @@ -196,7 +196,7 @@ contains end if #else message = 'Adjoint calculations only allowed with PETSc' - call fatal_error() + call fatal_error(message) #endif end subroutine compute_adjoint @@ -210,7 +210,7 @@ contains use constants, only: ONE use error, only: fatal_error - use global, only: cmfd_atoli, cmfd_rtoli, message + use global, only: cmfd_atoli, cmfd_rtoli integer :: i ! iteration counter integer :: innerits ! # of inner iterations @@ -238,7 +238,7 @@ contains ! Check if reached iteration 10000 if (i == 10000) then message = 'Reached maximum iterations in CMFD power iteration solver.' - call fatal_error() + call fatal_error(message) end if ! Compute source vector @@ -357,7 +357,7 @@ contains use constants, only: ONE, ZERO use error, only: fatal_error - use global, only: cmfd, cmfd_spectral, message + use global, only: cmfd, cmfd_spectral type(Matrix), intent(inout) :: A ! coefficient matrix type(Vector), intent(inout) :: b ! right hand side vector @@ -402,7 +402,7 @@ contains ! Check for max iterations met if (igs == 10000) then message = 'Maximum Gauss-Seidel iterations encountered.' - call fatal_error() + call fatal_error(message) endif ! Copy over x vector @@ -464,7 +464,7 @@ contains use constants, only: ONE, ZERO use error, only: fatal_error - use global, only: cmfd, cmfd_spectral, message + use global, only: cmfd, cmfd_spectral type(Matrix), intent(inout) :: A ! coefficient matrix type(Vector), intent(inout) :: b ! right hand side vector @@ -521,7 +521,7 @@ contains ! Check for max iterations met if (igs == 10000) then message = 'Maximum Gauss-Seidel iterations encountered.' - call fatal_error() + call fatal_error(message) endif ! Copy over x vector @@ -610,7 +610,7 @@ contains use constants, only: ONE, ZERO use error, only: fatal_error - use global, only: cmfd, cmfd_spectral, message + use global, only: cmfd, cmfd_spectral type(Matrix), intent(inout) :: A ! coefficient matrix type(Vector), intent(inout) :: b ! right hand side vector @@ -654,7 +654,7 @@ contains ! Check for max iterations met if (igs == 10000) then message = 'Maximum Gauss-Seidel iterations encountered.' - call fatal_error() + call fatal_error(message) endif ! Copy over x vector diff --git a/src/eigenvalue.F90 b/src/eigenvalue.F90 index 0c298ba6d6..b0152ddeeb 100644 --- a/src/eigenvalue.F90 +++ b/src/eigenvalue.F90 @@ -116,7 +116,7 @@ contains subroutine initialize_batch() message = "Simulating batch " // trim(to_str(current_batch)) // "..." - call write_message(8) + call write_message(message, 8) ! Reset total starting particle weight used for normalizing tallies total_weight = ZERO @@ -303,7 +303,7 @@ contains if (n_bank == 0) then message = "No fission sites banked on processor " // to_str(rank) - call fatal_error() + call fatal_error(message) end if ! Make sure all processors start at the same point for random sampling. Then @@ -555,7 +555,7 @@ contains ! display warning message if there were sites outside entropy box if (sites_outside) then message = "Fission source site(s) outside of entropy box." - call warning() + if (master) call warning(message) end if ! sum values to obtain shannon entropy @@ -774,7 +774,7 @@ contains ! Check for sites outside of the mesh if (master .and. sites_outside) then message = "Source sites outside of the UFS mesh!" - call fatal_error() + call fatal_error(message) end if #ifdef MPI @@ -805,7 +805,7 @@ contains ! Write message at beginning if (current_batch == 1) then message = "Replaying history from state point..." - call write_message(1) + call write_message(message, 1) end if do current_gen = 1, gen_per_batch @@ -823,7 +823,7 @@ contains ! Write message at end if (current_batch == restart_batch) then message = "Resuming simulation..." - call write_message(1) + call write_message(message, 1) end if end subroutine replay_batch_history diff --git a/src/energy_grid.F90 b/src/energy_grid.F90 index 95097edd59..8d8c549b06 100644 --- a/src/energy_grid.F90 +++ b/src/energy_grid.F90 @@ -24,7 +24,7 @@ contains type(Nuclide), pointer :: nuc => null() message = "Creating unionized energy grid..." - call write_message(5) + call write_message(message, 5) ! Add grid points for each nuclide in the problem do i = 1, n_nuclides_total diff --git a/src/error.F90 b/src/error.F90 index 1c35be8161..78030d18b0 100644 --- a/src/error.F90 +++ b/src/error.F90 @@ -1,6 +1,9 @@ module error use, intrinsic :: ISO_FORTRAN_ENV + use constants + + use global #ifdef MPI use mpi @@ -73,8 +76,9 @@ contains ! the program is aborted. !=============================================================================== - subroutine fatal_error(error_code) + subroutine fatal_error(message, error_code) + character(2*MAX_LINE_LEN) :: message integer, optional :: error_code ! error code integer :: code ! error code diff --git a/src/fission.F90 b/src/fission.F90 index cff8b7d9dc..de82a134a7 100644 --- a/src/fission.F90 +++ b/src/fission.F90 @@ -3,7 +3,6 @@ module fission use ace_header, only: Nuclide use constants use error, only: fatal_error - use global, only: message use interpolation, only: interpolate_tab1 use search, only: binary_search @@ -30,7 +29,7 @@ contains if (nuc % nu_t_type == NU_NONE) then message = "No neutron emission data for table: " // nuc % name - call fatal_error() + call fatal_error(message) elseif (nuc % nu_t_type == NU_POLYNOMIAL) then ! determine number of coefficients NC = int(nuc % nu_t_data(1)) diff --git a/src/fixed_source.F90 b/src/fixed_source.F90 index 84993646d7..b98e35ad92 100644 --- a/src/fixed_source.F90 +++ b/src/fixed_source.F90 @@ -97,7 +97,7 @@ contains subroutine initialize_batch() message = "Simulating batch " // trim(to_str(current_batch)) // "..." - call write_message(1) + call write_message(message, 1) ! Reset total starting particle weight used for normalizing tallies total_weight = ZERO diff --git a/src/geometry.F90 b/src/geometry.F90 index 17ab753379..a0663900ba 100644 --- a/src/geometry.F90 +++ b/src/geometry.F90 @@ -106,7 +106,7 @@ contains trim(to_str(cells(index_cell) % id)) // ", " // & trim(to_str(cells(coord % cell) % id)) // & " on universe " // trim(to_str(univ % id)) - call fatal_error() + call fatal_error(message) end if overlap_check_cnt(index_cell) = overlap_check_cnt(index_cell) + 1 @@ -182,7 +182,7 @@ contains ! Show cell information on trace if (verbosity >= 10 .or. trace) then message = " Entering cell " // trim(to_str(c % id)) - call write_message() + call write_message(message) end if if (c % type == CELL_NORMAL) then @@ -387,7 +387,7 @@ contains surf => surfaces(i_surface) if (verbosity >= 10 .or. trace) then message = " Crossing surface " // trim(to_str(surf % id)) - call write_message() + call write_message(message) end if if (surf % bc == BC_VACUUM .and. (run_mode /= MODE_PLOTTING)) then @@ -420,7 +420,7 @@ contains ! Display message if (verbosity >= 10 .or. trace) then message = " Leaked out of surface " // trim(to_str(surf % id)) - call write_message() + call write_message(message) end if return @@ -566,7 +566,7 @@ contains case default message = "Reflection not supported for surface " // & trim(to_str(surf % id)) - call fatal_error() + call fatal_error(message) end select ! Set new particle direction @@ -597,7 +597,7 @@ contains ! Diagnostic message if (verbosity >= 10 .or. trace) then message = " Reflected from surface " // trim(to_str(surf%id)) - call write_message() + call write_message(message) end if return end if @@ -678,7 +678,7 @@ contains ". Current position (" // trim(to_str(p % coord % lattice_x)) & // "," // trim(to_str(p % coord % lattice_y)) // "," // & trim(to_str(p % coord % lattice_z)) // ")" - call write_message() + call write_message(message) end if if (lat % type == LATTICE_RECT) then @@ -1497,7 +1497,7 @@ contains type(Surface), pointer :: surf message = "Building neighboring cells lists for each surface..." - call write_message(4) + call write_message(message, 4) allocate(count_positive(n_surfaces)) allocate(count_negative(n_surfaces)) @@ -1569,7 +1569,7 @@ contains type(Particle), intent(inout) :: p ! Print warning and write lost particle file - call warning(force = .true.) + call warning(message) call write_particle_restart(p) ! Increment number of lost particles @@ -1582,7 +1582,7 @@ contains ! reached if (n_lost_particles == MAX_LOST_PARTICLES) then message = "Maximum number of lost particles has been reached." - call fatal_error() + call fatal_error(message) end if end subroutine handle_lost_particle diff --git a/src/initialize.F90 b/src/initialize.F90 index 7e25498535..a4384cbbb3 100644 --- a/src/initialize.F90 +++ b/src/initialize.F90 @@ -159,9 +159,9 @@ contains ! Warn if overlap checking is on if (master .and. check_overlaps) then message = "" - call write_message() + call write_message(message) message = "Cell overlap checking is ON" - call warning() + if (master) call warning(message) end if ! Stop initialization timer @@ -346,7 +346,7 @@ contains if (n_particles == ERROR_INT) then message = "Must specify integer after " // trim(argv(i-1)) // & " command-line flag." - call fatal_error() + call fatal_error(message) end if case ('-r', '-restart', '--restart') ! Read path for state point/particle restart @@ -367,7 +367,7 @@ contains particle_restart_run = .true. case default message = "Unrecognized file after restart flag." - call fatal_error() + call fatal_error(message) end select ! If its a restart run check for additional source file @@ -386,7 +386,7 @@ contains call sp % file_close() if (filetype /= FILETYPE_SOURCE) then message = "Second file after restart flag must be a source file" - call fatal_error() + call fatal_error(message) end if ! It is a source file @@ -421,12 +421,12 @@ contains n_threads = int(str_to_int(argv(i)), 4) if (n_threads < 1) then message = "Invalid number of threads specified on command line." - call fatal_error() + call fatal_error(message) end if call omp_set_num_threads(n_threads) #else message = "Ignoring number of threads specified on command line." - call warning() + if (master) call warning(message) #endif case ('-?', '-h', '-help', '--help') @@ -443,7 +443,7 @@ contains i = i + 1 case default message = "Unknown command line option: " // argv(i) - call fatal_error() + call fatal_error(message) end select last_flag = i @@ -581,7 +581,7 @@ contains else message = "Could not find surface " // trim(to_str(abs(id))) // & " specified on cell " // trim(to_str(c % id)) - call fatal_error() + call fatal_error(message) end if end if end do @@ -595,7 +595,7 @@ contains else message = "Could not find universe " // trim(to_str(id)) // & " specified on cell " // trim(to_str(c % id)) - call fatal_error() + call fatal_error(message) end if ! ======================================================================= @@ -611,7 +611,7 @@ contains else message = "Could not find material " // trim(to_str(id)) // & " specified on cell " // trim(to_str(c % id)) - call fatal_error() + call fatal_error(message) end if else id = c % fill @@ -630,13 +630,13 @@ contains else message = "Could not find material " // trim(to_str(mid)) // & " specified on lattice " // trim(to_str(lid)) - call fatal_error() + call fatal_error(message) end if else message = "Specified fill " // trim(to_str(id)) // " on cell " // & trim(to_str(c % id)) // " is neither a universe nor a lattice." - call fatal_error() + call fatal_error(message) end if end if end do @@ -663,7 +663,7 @@ contains else message = "Invalid universe number " // trim(to_str(id)) & // " specified on lattice " // trim(to_str(lat % id)) - call fatal_error() + call fatal_error(message) end if end do end do @@ -689,7 +689,7 @@ contains else message = "Could not find cell " // trim(to_str(id)) // & " specified on tally " // trim(to_str(t % id)) - call fatal_error() + call fatal_error(message) end if end do @@ -705,7 +705,7 @@ contains else message = "Could not find surface " // trim(to_str(id)) // & " specified on tally " // trim(to_str(t % id)) - call fatal_error() + call fatal_error(message) end if end do @@ -718,7 +718,7 @@ contains else message = "Could not find universe " // trim(to_str(id)) // & " specified on tally " // trim(to_str(t % id)) - call fatal_error() + call fatal_error(message) end if end do @@ -731,7 +731,7 @@ contains else message = "Could not find material " // trim(to_str(id)) // & " specified on tally " // trim(to_str(t % id)) - call fatal_error() + call fatal_error(message) end if end do @@ -867,7 +867,7 @@ contains ! Check for allocation errors if (alloc_err /= 0) then message = "Failed to allocate source bank." - call fatal_error() + call fatal_error(message) end if #ifdef _OPENMP @@ -895,7 +895,7 @@ contains ! Check for allocation errors if (alloc_err /= 0) then message = "Failed to allocate fission bank." - call fatal_error() + call fatal_error(message) end if end subroutine allocate_banks diff --git a/src/input_xml.F90 b/src/input_xml.F90 index 3b080f2141..247a97b09b 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -78,7 +78,7 @@ contains ! Display output message message = "Reading settings XML file..." - call write_message(5) + call write_message(message, 5) ! Check if settings.xml exists filename = trim(path_input) // "settings.xml" @@ -89,7 +89,7 @@ contains &minimum, this includes settings.xml, geometry.xml, and & &materials.xml. Please consult the user's guide at & &http://mit-crpg.github.io/openmc for further information." - call fatal_error() + call fatal_error(message) end if ! Parse settings.xml file @@ -111,7 +111,7 @@ contains §ion libraries. Please consult the user's guide at & &http://mit-crpg.github.io/openmc for information on how to set & &up ACE cross section libraries." - call fatal_error() + call fatal_error(message) else path_cross_sections = trim(env_variable) end if @@ -132,7 +132,7 @@ contains if (.not.check_for_node(doc, "eigenvalue") .and. & .not.check_for_node(doc, "fixed_source")) then message = " or not specified." - call fatal_error() + call fatal_error(message) end if ! Eigenvalue information @@ -146,7 +146,7 @@ contains ! Check number of particles if (.not.check_for_node(node_mode, "particles")) then message = "Need to specify number of particles per generation." - call fatal_error() + call fatal_error(message) end if ! Get number of particles @@ -181,7 +181,7 @@ contains ! Check number of particles if (.not.check_for_node(node_mode, "particles")) then message = "Need to specify number of particles per batch." - call fatal_error() + call fatal_error(message) end if ! Get number of particles @@ -201,13 +201,13 @@ contains ! Check number of active batches, inactive batches, and particles if (n_active <= 0) then message = "Number of active batches must be greater than zero." - call fatal_error() + call fatal_error(message) elseif (n_inactive < 0) then message = "Number of inactive batches must be non-negative." - call fatal_error() + call fatal_error(message) elseif (n_particles <= 0) then message = "Number of particles must be greater than zero." - call fatal_error() + call fatal_error(message) end if ! Copy random number seed if specified @@ -226,10 +226,10 @@ contains grid_method = GRID_UNION case ('lethargy') message = "Lethargy mapped energy grid not yet supported." - call fatal_error() + call fatal_error(message) case default message = "Unknown energy grid method: " // trim(temp_str) - call fatal_error() + call fatal_error(message) end select ! Verbosity @@ -245,13 +245,13 @@ contains call get_node_value(doc, "threads", n_threads) if (n_threads < 1) then message = "Invalid number of threads: " // to_str(n_threads) - call fatal_error() + call fatal_error(message) end if call omp_set_num_threads(n_threads) end if #else message = "Ignoring number of threads." - call warning() + if (master) call warning(message) #endif end if @@ -263,7 +263,7 @@ contains call get_node_ptr(doc, "source", node_source) else message = "No source specified in settings XML file." - call fatal_error() + call fatal_error(message) end if ! Check if we want to write out source @@ -284,7 +284,7 @@ contains if (.not. file_exists) then message = "Binary source file '" // trim(path_source) // & "' does not exist!" - call fatal_error() + call fatal_error(message) end if else @@ -312,7 +312,7 @@ contains case default message = "Invalid spatial distribution for external source: " & // trim(type) - call fatal_error() + call fatal_error(message) end select ! Determine number of parameters specified @@ -326,11 +326,11 @@ contains if (n < coeffs_reqd) then message = "Not enough parameters specified for spatial & &distribution of external source." - call fatal_error() + call fatal_error(message) elseif (n > coeffs_reqd) then message = "Too many parameters specified for spatial & &distribution of external source." - call fatal_error() + call fatal_error(message) elseif (n > 0) then allocate(external_source % params_space(n)) call get_node_array(node_dist, "parameters", & @@ -338,7 +338,7 @@ contains end if else message = "No spatial distribution specified for external source." - call fatal_error() + call fatal_error(message) end if ! Determine external source angular distribution @@ -363,7 +363,7 @@ contains case default message = "Invalid angular distribution for external source: " & // trim(type) - call fatal_error() + call fatal_error(message) end select ! Determine number of parameters specified @@ -377,11 +377,11 @@ contains if (n < coeffs_reqd) then message = "Not enough parameters specified for angle & &distribution of external source." - call fatal_error() + call fatal_error(message) elseif (n > coeffs_reqd) then message = "Too many parameters specified for angle & &distribution of external source." - call fatal_error() + call fatal_error(message) elseif (n > 0) then allocate(external_source % params_angle(n)) call get_node_array(node_dist, "parameters", & @@ -417,7 +417,7 @@ contains case default message = "Invalid energy distribution for external source: " & // trim(type) - call fatal_error() + call fatal_error(message) end select ! Determine number of parameters specified @@ -431,11 +431,11 @@ contains if (n < coeffs_reqd) then message = "Not enough parameters specified for energy & &distribution of external source." - call fatal_error() + call fatal_error(message) elseif (n > coeffs_reqd) then message = "Too many parameters specified for energy & &distribution of external source." - call fatal_error() + call fatal_error(message) elseif (n > 0) then allocate(external_source % params_energy(n)) call get_node_array(node_dist, "parameters", & @@ -487,7 +487,7 @@ contains if (mod(n_tracks, 3) /= 0) then message = "Number of integers specified in 'track' is not divisible & &by 3. Please provide 3 integers per particle to be tracked." - call fatal_error() + call fatal_error(message) end if ! Allocate space and get list of tracks @@ -530,7 +530,7 @@ contains if (.not. all(entropy_mesh % upper_right > entropy_mesh % lower_left)) then message = "Upper-right coordinate must be greater than lower-left & &coordinate for Shannon entropy mesh." - call fatal_error() + call fatal_error(message) end if ! Check if dimensions were specified -- if not, they will be calculated @@ -541,7 +541,7 @@ contains if (get_arraysize_integer(node_entropy, "dimension") /= 3) then message = "Dimension of entropy mesh must be given as three & &integers." - call fatal_error() + call fatal_error(message) end if ! Allocate dimensions @@ -576,7 +576,7 @@ contains &of UFS mesh." elseif (get_arraysize_integer(node_ufs, "dimension") /= 3) then message = "Dimension of UFS mesh must be given as three integers." - call fatal_error() + call fatal_error(message) end if ! Allocate mesh object and coordinates on mesh @@ -600,7 +600,7 @@ contains if (.not. all(ufs_mesh % upper_right > ufs_mesh % lower_left)) then message = "Upper-right coordinate must be greater than lower-left & &coordinate for UFS mesh." - call fatal_error() + call fatal_error(message) end if ! Calculate width @@ -735,7 +735,7 @@ contains get_item(i))) then message = 'Sourcepoint batches are not a subset& & of statepoint batches.' - call fatal_error() + call fatal_error(message) end if end do end if @@ -817,7 +817,7 @@ contains if (.not. check_for_node(node_scatterer, "nuclide")) then message = "No nuclide specified for scatterer " // trim(to_str(i)) & // " in settings.xml file!" - call fatal_error() + call fatal_error(message) end if call get_node_value(node_scatterer, "nuclide", & nuclides_0K(i) % nuclide) @@ -831,7 +831,7 @@ contains if (.not. check_for_node(node_scatterer, "xs_label")) then message = "Must specify the temperature dependent name of " // '' & //"scatterer " // trim(to_str(i)) // " given in cross_sections.xml" - call fatal_error() + call fatal_error(message) end if call get_node_value(node_scatterer, "xs_label", & nuclides_0K(i) % name) @@ -840,7 +840,7 @@ contains if (.not. check_for_node(node_scatterer, "xs_label_0K")) then message = "Must specify the 0K name of " // '' & //"scatterer "// trim(to_str(i)) // " given in cross_sections.xml" - call fatal_error() + call fatal_error(message) end if call get_node_value(node_scatterer, "xs_label_0K", & nuclides_0K(i) % name_0K) @@ -853,7 +853,7 @@ contains ! check that E_min is non-negative if (nuclides_0K(i) % E_min < ZERO) then message = "Lower resonance scattering energy bound is negative" - call fatal_error() + call fatal_error(message) end if if (check_for_node(node_scatterer, "E_max")) then @@ -864,7 +864,7 @@ contains ! check that E_max is not less than E_min if (nuclides_0K(i) % E_max < nuclides_0K(i) % E_min) then message = "Lower resonance scattering energy bound exceeds upper" - call fatal_error() + call fatal_error(message) end if nuclides_0K(i) % nuclide = trim(nuclides_0K(i) % nuclide) @@ -875,7 +875,7 @@ contains else message = "No resonant scatterers are specified within the " // "" & // "resonance_scattering element in settings.xml" - call fatal_error() + call fatal_error(message) end if end if @@ -901,7 +901,7 @@ contains default_expand = JENDL_40 case default message = "Unknown natural element expansion option: " // trim(temp_str) - call fatal_error() + call fatal_error(message) end select end if @@ -944,7 +944,7 @@ contains ! Display output message message = "Reading geometry XML file..." - call write_message(5) + call write_message(message, 5) ! ========================================================================== ! READ CELLS FROM GEOMETRY.XML @@ -954,7 +954,7 @@ contains inquire(FILE=filename, EXIST=file_exists) if (.not. file_exists) then message = "Geometry XML file '" // trim(filename) // "' does not exist!" - call fatal_error() + call fatal_error(message) end if ! Parse geometry.xml file @@ -969,7 +969,7 @@ contains ! Check for no cells if (n_cells == 0) then message = "No cells found in geometry.xml!" - call fatal_error() + call fatal_error(message) end if ! Allocate cells array @@ -992,7 +992,7 @@ contains call get_node_value(node_cell, "id", c % id) else message = "Must specify id of cell in geometry XML file." - call fatal_error() + call fatal_error(message) end if if (check_for_node(node_cell, "universe")) then call get_node_value(node_cell, "universe", c % universe) @@ -1008,7 +1008,7 @@ contains ! Check to make sure 'id' hasn't been used if (cell_dict % has_key(c % id)) then message = "Two or more cells use the same unique ID: " // to_str(c % id) - call fatal_error() + call fatal_error(message) end if ! Read material @@ -1029,7 +1029,7 @@ contains ! Check for error if (c % material == ERROR_INT) then message = "Invalid material specified on cell " // to_str(c % id) - call fatal_error() + call fatal_error(message) end if end select @@ -1037,21 +1037,21 @@ contains if (c % material == NONE .and. c % fill == NONE) then message = "Neither material nor fill was specified for cell " // & trim(to_str(c % id)) - call fatal_error() + call fatal_error(message) end if ! Check to make sure that both material and fill haven't been ! specified simultaneously if (c % material /= NONE .and. c % fill /= NONE) then message = "Cannot specify material and fill simultaneously" - call fatal_error() + call fatal_error(message) end if ! Check to make sure that surfaces were specified if (.not. check_for_node(node_cell, "surfaces")) then message = "No surfaces specified for cell " // & trim(to_str(c % id)) - call fatal_error() + call fatal_error(message) end if ! Allocate array for surfaces and copy @@ -1067,7 +1067,7 @@ contains if (c % fill == NONE) then message = "Cannot apply a rotation to cell " // trim(to_str(& c % id)) // " because it is not filled with another universe" - call fatal_error() + call fatal_error(message) end if ! Read number of rotation parameters @@ -1075,7 +1075,7 @@ contains if (n /= 3) then message = "Incorrect number of rotation parameters on cell " // & to_str(c % id) - call fatal_error() + call fatal_error(message) end if ! Copy rotation angles in x,y,z directions @@ -1103,7 +1103,7 @@ contains if (c % fill == NONE) then message = "Cannot apply a translation to cell " // trim(to_str(& c % id)) // " because it is not filled with another universe" - call fatal_error() + call fatal_error(message) end if ! Read number of translation parameters @@ -1111,7 +1111,7 @@ contains if (n /= 3) then message = "Incorrect number of translation parameters on cell " & // to_str(c % id) - call fatal_error() + call fatal_error(message) end if ! Copy translation vector @@ -1153,7 +1153,7 @@ contains ! Check for no surfaces if (n_surfaces == 0) then message = "No surfaces found in geometry.xml!" - call fatal_error() + call fatal_error(message) end if ! Allocate cells array @@ -1170,14 +1170,14 @@ contains call get_node_value(node_surf, "id", s % id) else message = "Must specify id of surface in geometry XML file." - call fatal_error() + call fatal_error(message) end if ! Check to make sure 'id' hasn't been used if (surface_dict % has_key(s % id)) then message = "Two or more surfaces use the same unique ID: " // & to_str(s % id) - call fatal_error() + call fatal_error(message) end if ! Copy and interpret surface type @@ -1220,7 +1220,7 @@ contains coeffs_reqd = 4 case default message = "Invalid surface type: " // trim(word) - call fatal_error() + call fatal_error(message) end select ! Check to make sure that the proper number of coefficients @@ -1231,11 +1231,11 @@ contains if (n < coeffs_reqd) then message = "Not enough coefficients specified for surface: " // & trim(to_str(s % id)) - call fatal_error() + call fatal_error(message) elseif (n > coeffs_reqd) then message = "Too many coefficients specified for surface: " // & trim(to_str(s % id)) - call fatal_error() + call fatal_error(message) else allocate(s % coeffs(n)) call get_node_array(node_surf, "coeffs", s % coeffs) @@ -1257,7 +1257,7 @@ contains case default message = "Unknown boundary condition '" // trim(word) // & "' specified on surface " // trim(to_str(s % id)) - call fatal_error() + call fatal_error(message) end select ! Add surface to dictionary @@ -1269,7 +1269,7 @@ contains ! surface if (.not. boundary_exists) then message = "No boundary conditions were applied to any surfaces!" - call fatal_error() + call fatal_error(message) end if ! ========================================================================== @@ -1293,14 +1293,14 @@ contains call get_node_value(node_lat, "id", lat % id) else message = "Must specify id of lattice in geometry XML file." - call fatal_error() + call fatal_error(message) end if ! Check to make sure 'id' hasn't been used if (lattice_dict % has_key(lat % id)) then message = "Two or more lattices use the same unique ID: " // & to_str(lat % id) - call fatal_error() + call fatal_error(message) end if ! Read lattice type @@ -1314,14 +1314,14 @@ contains lat % type = LATTICE_HEX case default message = "Invalid lattice type: " // trim(word) - call fatal_error() + call fatal_error(message) end select ! Read number of lattice cells in each dimension n = get_arraysize_integer(node_lat, "dimension") if (n /= 2 .and. n /= 3) then message = "Lattice must be two or three dimensions." - call fatal_error() + call fatal_error(message) end if lat % n_dimension = n @@ -1333,7 +1333,7 @@ contains get_arraysize_double(node_lat, "lower_left")) then message = "Number of entries on must be the same as & &the number of entries on ." - call fatal_error() + call fatal_error(message) end if allocate(lat % lower_left(n)) @@ -1344,7 +1344,7 @@ contains get_arraysize_double(node_lat, "width")) then message = "Number of entries on must be the same as & &the number of entries on ." - call fatal_error() + call fatal_error(message) end if allocate(lat % width(n)) @@ -1365,7 +1365,7 @@ contains if (n /= n_x*n_y*n_z) then message = "Number of universes on does not match size of & &lattice " // trim(to_str(lat % id)) // "." - call fatal_error() + call fatal_error(message) end if allocate(temp_int_array(n)) @@ -1442,14 +1442,14 @@ contains ! Display output message message = "Reading materials XML file..." - call write_message(5) + call write_message(message, 5) ! Check is materials.xml exists filename = trim(path_input) // "materials.xml" inquire(FILE=filename, EXIST=file_exists) if (.not. file_exists) then message = "Material XML file '" // trim(filename) // "' does not exist!" - call fatal_error() + call fatal_error(message) end if ! Initialize default cross section variable @@ -1484,14 +1484,14 @@ contains call get_node_value(node_mat, "id", mat % id) else message = "Must specify id of material in materials XML file" - call fatal_error() + call fatal_error(message) end if ! Check to make sure 'id' hasn't been used if (material_dict % has_key(mat % id)) then message = "Two or more materials use the same unique ID: " // & to_str(mat % id) - call fatal_error() + call fatal_error(message) end if if (run_mode == MODE_PLOTTING) then @@ -1509,7 +1509,7 @@ contains else message = "Must specify density element in material " // & trim(to_str(mat % id)) - call fatal_error() + call fatal_error(message) end if ! Initialize value to zero @@ -1534,7 +1534,7 @@ contains if (val <= ZERO) then message = "Need to specify a positive density on material " // & trim(to_str(mat % id)) // "." - call fatal_error() + call fatal_error(message) end if ! Adjust material density based on specified units @@ -1550,7 +1550,7 @@ contains case default message = "Unkwown units '" // trim(units) & // "' specified on material " // trim(to_str(mat % id)) - call fatal_error() + call fatal_error(message) end select end if @@ -1562,7 +1562,7 @@ contains .not. check_for_node(node_mat, "element")) then message = "No nuclides or natural elements specified on material " // & trim(to_str(mat % id)) - call fatal_error() + call fatal_error(message) end if ! Get pointer list of XML @@ -1577,7 +1577,7 @@ contains if (.not.check_for_node(node_nuc, "name")) then message = "No name specified on nuclide in material " // & trim(to_str(mat % id)) - call fatal_error() + call fatal_error(message) end if ! Check for cross section @@ -1585,7 +1585,7 @@ contains if (default_xs == '') then message = "No cross section specified for nuclide in material " & // trim(to_str(mat % id)) - call fatal_error() + call fatal_error(message) else name = trim(default_xs) end if @@ -1606,12 +1606,12 @@ contains .not.check_for_node(node_nuc, "wo")) then message = "No atom or weight percent specified for nuclide " // & trim(name) - call fatal_error() + call fatal_error(message) elseif (check_for_node(node_nuc, "ao") .and. & check_for_node(node_nuc, "wo")) then message = "Cannot specify both atom and weight percents for a & &nuclide: " // trim(name) - call fatal_error() + call fatal_error(message) end if ! Copy atom/weight percents @@ -1637,7 +1637,7 @@ contains if (.not.check_for_node(node_ele, "name")) then message = "No name specified on nuclide in material " // & trim(to_str(mat % id)) - call fatal_error() + call fatal_error(message) end if call get_node_value(node_ele, "name", name) @@ -1648,7 +1648,7 @@ contains if (default_xs == '') then message = "No cross section specified for nuclide in material " & // trim(to_str(mat % id)) - call fatal_error() + call fatal_error(message) else temp_str = trim(default_xs) end if @@ -1660,12 +1660,12 @@ contains .not.check_for_node(node_ele, "wo")) then message = "No atom or weight percent specified for element " // & trim(name) - call fatal_error() + call fatal_error(message) elseif (check_for_node(node_ele, "ao") .and. & check_for_node(node_ele, "wo")) then message = "Cannot specify both atom and weight percents for a & &element: " // trim(name) - call fatal_error() + call fatal_error(message) end if ! Expand element into naturally-occurring isotopes @@ -1676,7 +1676,7 @@ contains else message = "The ability to expand a natural element based on weight & &percentage is not yet supported." - call fatal_error() + call fatal_error(message) end if end do NATURAL_ELEMENTS @@ -1696,7 +1696,7 @@ contains if (.not. xs_listing_dict % has_key(to_lower(name))) then message = "Could not find nuclide " // trim(name) // & " in cross_sections.xml file!" - call fatal_error() + call fatal_error(message) end if ! Check to make sure cross-section is continuous energy neutron table @@ -1704,7 +1704,7 @@ contains if (name(n:n) /= 'c') then message = "Cross-section table " // trim(name) // & " is not a continuous-energy neutron table." - call fatal_error() + call fatal_error(message) end if ! Find xs_listing and set the name/alias according to the listing @@ -1735,7 +1735,7 @@ contains all(mat % atom_density <= ZERO))) then message = "Cannot mix atom and weight percents in material " // & to_str(mat % id) - call fatal_error() + call fatal_error(message) end if ! Determine density if it is a sum value @@ -1772,7 +1772,7 @@ contains if (.not.check_for_node(node_sab, "name") .or. & .not.check_for_node(node_sab, "xs")) then message = "Need to specify and for S(a,b) table." - call fatal_error() + call fatal_error(message) end if call get_node_value(node_sab, "name", name) call get_node_value(node_sab, "xs", temp_str) @@ -1783,7 +1783,7 @@ contains if (.not. xs_listing_dict % has_key(to_lower(name))) then message = "Could not find S(a,b) table " // trim(name) // & " in cross_sections.xml file!" - call fatal_error() + call fatal_error(message) end if ! Find index in xs_listing and set the name and alias according to the @@ -1869,7 +1869,7 @@ contains ! Display output message message = "Reading tallies XML file..." - call write_message(5) + call write_message(message, 5) ! Parse tallies.xml file call open_xmldoc(doc, filename) @@ -1898,7 +1898,7 @@ contains n_user_tallies = get_list_size(node_tal_list) if (n_user_tallies == 0) then message = "No tallies present in tallies.xml file!" - call warning() + if (master) call warning(message) end if ! Allocate tally array @@ -1928,14 +1928,14 @@ contains call get_node_value(node_mesh, "id", m % id) else message = "Must specify id for mesh in tally XML file." - call fatal_error() + call fatal_error(message) end if ! Check to make sure 'id' hasn't been used if (mesh_dict % has_key(m % id)) then message = "Two or more meshes use the same unique ID: " // & to_str(m % id) - call fatal_error() + call fatal_error(message) end if ! Read mesh type @@ -1949,14 +1949,14 @@ contains m % type = LATTICE_HEX case default message = "Invalid mesh type: " // trim(temp_str) - call fatal_error() + call fatal_error(message) end select ! Determine number of dimensions for mesh n = get_arraysize_integer(node_mesh, "dimension") if (n /= 2 .and. n /= 3) then message = "Mesh must be two or three dimensions." - call fatal_error() + call fatal_error(message) end if m % n_dimension = n @@ -1971,7 +1971,7 @@ contains if (any(iarray3(1:n) <= 0)) then message = "All entries on the element for a tally mesh & &must be positive." - call fatal_error() + call fatal_error(message) end if ! Read dimensions in each direction @@ -1981,7 +1981,7 @@ contains if (m % n_dimension /= get_arraysize_double(node_mesh, "lower_left")) then message = "Number of entries on must be the same as & &the number of entries on ." - call fatal_error() + call fatal_error(message) end if call get_node_array(node_mesh, "lower_left", m % lower_left) @@ -1990,7 +1990,7 @@ contains check_for_node(node_mesh, "width")) then message = "Cannot specify both and on a & &tally mesh." - call fatal_error() + call fatal_error(message) end if ! Make sure either upper-right or width was specified @@ -1998,7 +1998,7 @@ contains .not.check_for_node(node_mesh, "width")) then message = "Must specify either and on a & &tally mesh." - call fatal_error() + call fatal_error(message) end if if (check_for_node(node_mesh, "width")) then @@ -2007,14 +2007,14 @@ contains get_arraysize_double(node_mesh, "lower_left")) then message = "Number of entries on must be the same as the & &number of entries on ." - call fatal_error() + call fatal_error(message) end if ! Check for negative widths call get_node_array(node_mesh, "width", rarray3(1:n)) if (any(rarray3(1:n) < ZERO)) then message = "Cannot have a negative on a tally mesh." - call fatal_error() + call fatal_error(message) end if ! Set width and upper right coordinate @@ -2027,7 +2027,7 @@ contains get_arraysize_double(node_mesh, "lower_left")) then message = "Number of entries on must be the same as & &the number of entries on ." - call fatal_error() + call fatal_error(message) end if ! Check that upper-right is above lower-left @@ -2035,7 +2035,7 @@ contains if (any(rarray3(1:n) < m % lower_left)) then message = "The coordinates must be greater than the & & coordinates on a tally mesh." - call fatal_error() + call fatal_error(message) end if ! Set width and upper right coordinate @@ -2079,14 +2079,14 @@ contains call get_node_value(node_tal, "id", t % id) else message = "Must specify id for tally in tally XML file." - call fatal_error() + call fatal_error(message) end if ! Check to make sure 'id' hasn't been used if (tally_dict % has_key(t % id)) then message = "Two or more tallies use the same unique ID: " // & to_str(t % id) - call fatal_error() + call fatal_error(message) end if ! Copy tally label @@ -2104,7 +2104,7 @@ contains ! if (get_number_nodes(node_tal, "filters") > 0) then ! message = "Tally filters should be specified with multiple & ! &elements. Did you forget to change your element?" -! call fatal_error() +! call fatal_error(message) ! end if ! Get pointer list to XML and get number of filters @@ -2137,7 +2137,7 @@ contains end if else message = "Bins not set in filter on tally " // trim(to_str(t % id)) - call fatal_error() + call fatal_error(message) end if ! Determine type of filter @@ -2188,7 +2188,7 @@ contains case ('surface') message = "Surface filter is not yet supported!" - call fatal_error() + call fatal_error(message) ! Set type of filter t % filters(j) % type = FILTER_SURFACE @@ -2207,7 +2207,7 @@ contains ! Check to make sure multiple meshes weren't given if (n_words /= 1) then message = "Can only have one mesh filter specified." - call fatal_error() + call fatal_error(message) end if ! Determine id of mesh @@ -2220,7 +2220,7 @@ contains else message = "Could not find mesh " // trim(to_str(id)) // & " specified on tally " // trim(to_str(t % id)) - call fatal_error() + call fatal_error(message) end if ! Determine number of bins -- this is assuming that the tally is @@ -2262,7 +2262,7 @@ contains message = "Unknown filter type '" // & trim(temp_str) // "' on tally " // & trim(to_str(t % id)) // "." - call fatal_error() + call fatal_error(message) end select @@ -2278,7 +2278,7 @@ contains t % find_filter(FILTER_SURFACE) > 0) then message = "Cannot specify both cell and surface filters for tally " & // trim(to_str(t % id)) - call fatal_error() + call fatal_error(message) end if else @@ -2343,7 +2343,7 @@ contains message = "Could not find the nuclide " // trim(& sarray(j)) // " specified in tally " & // trim(to_str(t % id)) // " in any material." - call fatal_error() + call fatal_error(message) end if deallocate(pair_list) else @@ -2356,7 +2356,7 @@ contains if (.not. nuclide_dict % has_key(to_lower(word))) then message = "The nuclide " // trim(word) // " from tally " // & trim(to_str(t % id)) // " is not present in any material." - call fatal_error() + call fatal_error(message) end if ! Set bin to index in nuclides array @@ -2408,7 +2408,7 @@ contains message = "Invalid scattering order of " // trim(to_str(n_order)) // & " requested. Setting to the maximum permissible value, " // & trim(to_str(MAX_ANG_ORDER)) - call warning() + if (master) call warning(message) n_order = MAX_ANG_ORDER sarray(j) = trim(MOMENT_STRS(imomstr)) // & trim(to_str(MAX_ANG_ORDER)) @@ -2450,7 +2450,7 @@ contains message = "Invalid scattering order of " // trim(to_str(n_order)) // & " requested. Setting to the maximum permissible value, " // & trim(to_str(MAX_ANG_ORDER)) - call warning() + if (master) call warning(message) n_order = MAX_ANG_ORDER end if score_name = trim(MOMENT_STRS(imomstr)) // "n" @@ -2477,7 +2477,7 @@ contains message = "Invalid scattering order of " // trim(to_str(n_order)) // & " requested. Setting to the maximum permissible value, " // & trim(to_str(MAX_ANG_ORDER)) - call warning() + if (master) call warning(message) n_order = MAX_ANG_ORDER end if score_name = trim(MOMENT_N_STRS(imomstr)) // "n" @@ -2492,25 +2492,25 @@ contains if (.not. (t % n_nuclide_bins == 1 .and. & t % nuclide_bins(1) == -1)) then message = "Cannot tally flux for an individual nuclide." - call fatal_error() + call fatal_error(message) end if t % score_bins(j) = SCORE_FLUX if (t % find_filter(FILTER_ENERGYOUT) > 0) then message = "Cannot tally flux with an outgoing energy filter." - call fatal_error() + call fatal_error(message) end if case ('flux-yn') ! Prohibit user from tallying flux for an individual nuclide if (.not. (t % n_nuclide_bins == 1 .and. & t % nuclide_bins(1) == -1)) then message = "Cannot tally flux for an individual nuclide." - call fatal_error() + call fatal_error(message) end if if (t % find_filter(FILTER_ENERGYOUT) > 0) then message = "Cannot tally flux with an outgoing energy filter." - call fatal_error() + call fatal_error(message) end if t % score_bins(j : j + n_bins - 1) = SCORE_FLUX_YN @@ -2522,14 +2522,14 @@ contains if (t % find_filter(FILTER_ENERGYOUT) > 0) then message = "Cannot tally total reaction rate with an & &outgoing energy filter." - call fatal_error() + call fatal_error(message) end if case ('total-yn') if (t % find_filter(FILTER_ENERGYOUT) > 0) then message = "Cannot tally total reaction rate with an & &outgoing energy filter." - call fatal_error() + call fatal_error(message) end if t % score_bins(j : j + n_bins - 1) = SCORE_TOTAL_YN @@ -2600,7 +2600,7 @@ contains case ('diffusion') message = "Diffusion score no longer supported for tallies, & &please remove" - call fatal_error() + call fatal_error(message) case ('n1n') t % score_bins(j) = SCORE_N_1N @@ -2620,14 +2620,14 @@ contains if (t % find_filter(FILTER_ENERGYOUT) > 0) then message = "Cannot tally absorption rate with an outgoing & &energy filter." - call fatal_error() + call fatal_error(message) end if case ('fission') t % score_bins(j) = SCORE_FISSION if (t % find_filter(FILTER_ENERGYOUT) > 0) then message = "Cannot tally fission rate with an outgoing & &energy filter." - call fatal_error() + call fatal_error(message) end if case ('nu-fission') t % score_bins(j) = SCORE_NU_FISSION @@ -2647,7 +2647,7 @@ contains message = "Cannot tally other scoring functions in the same & &tally as surface currents. Separate other scoring & &functions into a distinct tally." - call fatal_error() + call fatal_error(message) end if ! Since the number of bins for the mesh filter was already set @@ -2660,7 +2660,7 @@ contains ! Check to make sure mesh filter was specified if (k == 0) then message = "Cannot tally surface current without a mesh filter." - call fatal_error() + call fatal_error(message) end if ! Get pointer to mesh @@ -2708,14 +2708,14 @@ contains else message = "Invalid MT on : " // & trim(sarray(l)) - call fatal_error() + call fatal_error(message) end if else ! Specified score was not an integer message = "Unknown scoring function: " // & trim(sarray(l)) - call fatal_error() + call fatal_error(message) end if end select @@ -2728,7 +2728,7 @@ contains else message = "No specified on tally " // trim(to_str(t % id)) & // "." - call fatal_error() + call fatal_error(message) end if ! ======================================================================= @@ -2748,7 +2748,7 @@ contains if (t % estimator == ESTIMATOR_ANALOG) then message = "Cannot use track-length estimator for tally " & // to_str(t % id) - call fatal_error() + call fatal_error(message) end if ! Set estimator to track-length estimator @@ -2757,7 +2757,7 @@ contains case default message = "Invalid estimator '" // trim(temp_str) & // "' on tally " // to_str(t % id) - call fatal_error() + call fatal_error(message) end select end if @@ -2802,12 +2802,12 @@ contains inquire(FILE=filename, EXIST=file_exists) if (.not. file_exists) then message = "Plots XML file '" // trim(filename) // "' does not exist!" - call fatal_error() + call fatal_error(message) end if ! Display output message message = "Reading plot XML file..." - call write_message(5) + call write_message(message, 5) ! Parse plots.xml file call open_xmldoc(doc, filename) @@ -2830,14 +2830,14 @@ contains call get_node_value(node_plot, "id", pl % id) else message = "Must specify plot id in plots XML file." - call fatal_error() + call fatal_error(message) end if ! Check to make sure 'id' hasn't been used if (plot_dict % has_key(pl % id)) then message = "Two or more plots use the same unique ID: " // & to_str(pl % id) - call fatal_error() + call fatal_error(message) end if ! Copy plot type @@ -2853,7 +2853,7 @@ contains case default message = "Unsupported plot type '" // trim(temp_str) & // "' in plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end select ! Set output file path @@ -2876,7 +2876,7 @@ contains else message = " must be length 2 in slice plot " // & trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if else if (pl % type == PLOT_TYPE_VOXEL) then if (get_arraysize_integer(node_plot, "pixels") == 3) then @@ -2884,7 +2884,7 @@ contains else message = " must be length 3 in voxel plot " // & trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if end if @@ -2893,14 +2893,14 @@ contains if (pl % type == PLOT_TYPE_VOXEL) then message = "Background color ignored in voxel plot " // & trim(to_str(pl % id)) - call warning() + if (master) call warning(message) end if if (get_arraysize_integer(node_plot, "background") == 3) then call get_node_array(node_plot, "background", pl % not_found % rgb) else message = "Bad background RGB " & // "in plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if else pl % not_found % rgb = (/ 255, 255, 255 /) @@ -2922,7 +2922,7 @@ contains case default message = "Unsupported plot basis '" // trim(temp_str) & // "' in plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end select end if @@ -2932,7 +2932,7 @@ contains else message = "Origin must be length 3 " & // "in plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if ! Copy plotting width @@ -2942,7 +2942,7 @@ contains else message = " must be length 2 in slice plot " // & trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if else if (pl % type == PLOT_TYPE_VOXEL) then if (get_arraysize_double(node_plot, "width") == 3) then @@ -2950,7 +2950,7 @@ contains else message = " must be length 3 in voxel plot " // & trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if end if @@ -2983,7 +2983,7 @@ contains case default message = "Unsupported plot color type '" // trim(temp_str) & // "' in plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end select ! Get the number of nodes and get a list of them @@ -2996,7 +2996,7 @@ contains if (pl % type == PLOT_TYPE_VOXEL) then message = "Color specifications ignored in voxel plot " // & trim(to_str(pl % id)) - call warning() + if (master) call warning(message) end if do j = 1, n_cols @@ -3008,7 +3008,7 @@ contains if (get_arraysize_double(node_col, "rgb") /= 3) then message = "Bad RGB " & // "in plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if ! Ensure that there is an id for this color specification @@ -3017,7 +3017,7 @@ contains else message = "Must specify id for color specification in plot " // & trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if ! Add RGB @@ -3029,7 +3029,7 @@ contains else message = "Could not find cell " // trim(to_str(col_id)) // & " specified in plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if else if (pl % color_by == PLOT_COLOR_MATS) then @@ -3040,7 +3040,7 @@ contains else message = "Could not find material " // trim(to_str(col_id)) // & " specified in plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if end if @@ -3055,7 +3055,7 @@ contains if (pl % type == PLOT_TYPE_VOXEL) then message = "Meshlines ignored in voxel plot " // & trim(to_str(pl % id)) - call warning() + call warning(message) end if select case(n_meshlines) @@ -3072,7 +3072,7 @@ contains else message = "Must specify a meshtype for meshlines " // & "specification in plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if ! Ensure that there is a linewidth for this meshlines specification @@ -3082,7 +3082,7 @@ contains else message = "Must specify a linewidth for meshlines " // & "specification in plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if ! Check for color @@ -3092,7 +3092,7 @@ contains if (get_arraysize_double(node_meshlines, "color") /= 3) then message = "Bad RGB for meshlines color " // & "in plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if call get_node_array(node_meshlines, "color", & @@ -3110,7 +3110,7 @@ contains if (.not. associated(ufs_mesh)) then message = "No UFS mesh for meshlines on plot " // & trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if pl % meshlines_mesh => ufs_mesh @@ -3120,7 +3120,7 @@ contains if (.not. cmfd_run) then message = "Need CMFD run to plot CMFD mesh for meshlines " // & "on plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if i_mesh = cmfd_tallies(1) % & @@ -3133,13 +3133,13 @@ contains if (.not. associated(entropy_mesh)) then message = "No entropy mesh for meshlines on plot " // & trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if if (.not. allocated(entropy_mesh % dimension)) then message = "No dimension specified on entropy mesh for " // & "meshlines on plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if pl % meshlines_mesh => entropy_mesh @@ -3152,7 +3152,7 @@ contains else message = "Must specify a mesh id for meshlines tally mesh" // & "specification in plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if ! Check if the specified tally mesh exists @@ -3161,26 +3161,26 @@ contains if (meshes(meshid) % type /= LATTICE_RECT) then message = "Non-rectangular mesh specified in meshlines " // & "for plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if else message = "Could not find mesh " // & trim(to_str(meshid)) // & " specified in meshlines for plot " // & trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if case default message = "Invalid type for meshlines on plot " // & trim(to_str(pl % id)) // ": " // trim(meshtype) - call fatal_error() + call fatal_error(message) end select case default message = "Mutliple meshlines" // & " specified in plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end select end if @@ -3193,14 +3193,14 @@ contains if (pl % type == PLOT_TYPE_VOXEL) then message = "Mask ignored in voxel plot " // & trim(to_str(pl % id)) - call warning() + if (master) call warning(message) end if select case(n_masks) case default message = "Mutliple masks" // & " specified in plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) case (1) ! Get pointer to mask @@ -3212,7 +3212,7 @@ contains if (n_comp == 0) then message = "Missing in mask of plot " // & trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if allocate(iarray(n_comp)) call get_node_array(node_mask, "components", iarray) @@ -3229,7 +3229,7 @@ contains else message = "Could not find cell " // trim(to_str(col_id)) // & " specified in the mask in plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if else if (pl % color_by == PLOT_COLOR_MATS) then @@ -3239,7 +3239,7 @@ contains else message = "Could not find material " // trim(to_str(col_id)) // & " specified in the mask in plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if end if @@ -3253,7 +3253,7 @@ contains else message = "Missing in mask of plot " // & trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if end if end do @@ -3299,11 +3299,11 @@ contains ! Could not find cross_sections.xml file message = "Cross sections XML file '" // trim(path_cross_sections) // & "' does not exist!" - call fatal_error() + call fatal_error(message) end if message = "Reading cross sections XML file..." - call write_message(5) + call write_message(message, 5) ! Parse cross_sections.xml file call open_xmldoc(doc, path_cross_sections) @@ -3330,7 +3330,7 @@ contains filetype = ASCII else message = "Unknown filetype in cross_sections.xml: " // trim(temp_str) - call fatal_error() + call fatal_error(message) end if ! copy default record length and entries for binary files @@ -3346,7 +3346,7 @@ contains ! Allocate xs_listings array if (n_listings == 0) then message = "No ACE table listings present in cross_sections.xml file!" - call fatal_error() + call fatal_error(message) else allocate(xs_listings(n_listings)) end if @@ -3405,7 +3405,7 @@ contains call get_node_value(node_ace, "path", temp_str) else message = "Path missing for isotope " // listing % name - call fatal_error() + call fatal_error(message) end if if (starts_with(temp_str, '/')) then @@ -3430,7 +3430,7 @@ contains if (.not. xs_listing_dict % has_key(trim(nuclides_0K(i) % name_0K))) then message = "Could not find nuclide " // trim(nuclides_0K(i) % name_0K) // & " in cross_sections.xml file!" - call fatal_error() + call fatal_error(message) end if end do @@ -4270,7 +4270,7 @@ contains case default message = "Cannot expand element: " // name - call fatal_error() + call fatal_error(message) end select diff --git a/src/interpolation.F90 b/src/interpolation.F90 index 531f69ee8c..36c7aa37a2 100644 --- a/src/interpolation.F90 +++ b/src/interpolation.F90 @@ -3,7 +3,6 @@ module interpolation use constants use endf_header, only: Tab1 use error, only: fatal_error - use global, only: message use search, only: binary_search use string, only: to_str @@ -121,7 +120,7 @@ contains y = exp((1-r)*log(y0) + r*log(y1)) case default message = "Unsupported interpolation scheme: " // to_str(interp) - call fatal_error() + call fatal_error(message) end select end function interpolate_tab1_array @@ -207,7 +206,7 @@ contains y = exp((1-r)*log(y0) + r*log(y1)) case default message = "Unsupported interpolation scheme: " // to_str(interp) - call fatal_error() + call fatal_error(message) end select end function interpolate_tab1_object diff --git a/src/output.F90 b/src/output.F90 index 697bc4834c..bd70eeccfb 100644 --- a/src/output.F90 +++ b/src/output.F90 @@ -22,8 +22,6 @@ module output integer :: ou = OUTPUT_UNIT integer :: eu = ERROR_UNIT - character(2*MAX_LINE_LEN) :: message - contains !=============================================================================== @@ -197,6 +195,7 @@ contains subroutine write_message(message, level) + character(2*MAX_LINE_LEN) :: message integer, optional :: level ! verbosity level integer :: i_start ! starting position @@ -1556,6 +1555,7 @@ contains subroutine print_results() + character(2*MAX_LINE_LEN) :: message real(8) :: alpha ! significance level for CI real(8) :: t_value ! t-value for confidence intervals @@ -1590,7 +1590,7 @@ contains global_tallies(LEAKAGE) % sum_sq else message = "Could not compute uncertainties -- only one active batch simulated!" - call warning() + if (master) call warning(message) write(ou,103) "k-effective (Collision)", global_tallies(K_COLLISION) % sum write(ou,103) "k-effective (Track-length)", global_tallies(K_TRACKLENGTH) % sum diff --git a/src/particle_restart.F90 b/src/particle_restart.F90 index 11adb417a7..73ddfd4ae0 100644 --- a/src/particle_restart.F90 +++ b/src/particle_restart.F90 @@ -77,7 +77,7 @@ contains ! Write meessage message = "Loading particle restart file " // trim(path_particle_restart) & // "..." - call write_message(1) + call write_message(message, 1) ! Open file call pr % file_open(path_particle_restart, 'r') diff --git a/src/physics.F90 b/src/physics.F90 index d060c37a40..7bcfa45507 100644 --- a/src/physics.F90 +++ b/src/physics.F90 @@ -52,14 +52,14 @@ contains message = " " // trim(reaction_name(p % event_MT)) // " with " // & trim(adjustl(nuclides(p % event_nuclide) % name)) // & ". Energy = " // trim(to_str(p % E * 1e6_8)) // " eV." - call write_message() + call write_message(message) end if ! check for very low energy if (p % E < 1.0e-100_8) then p % alive = .false. message = "Killing neutron with extremely low energy" - call warning() + if (master) call warning(message) end if end subroutine collision @@ -162,7 +162,7 @@ contains if (i > mat % n_nuclides) then call write_particle_restart(p) message = "Did not sample any nuclide during collision." - call fatal_error() + call fatal_error(message) end if ! Find atom density @@ -372,7 +372,7 @@ contains call write_particle_restart(p) message = "Did not sample any reaction for nuclide " // & trim(nuc % name) - call fatal_error() + call fatal_error(message) end if rxn => nuc % reactions(i) @@ -977,7 +977,7 @@ contains case default message = "Not a recognized resonance scattering treatment!" - call fatal_error() + call fatal_error(message) end select end subroutine sample_target_velocity @@ -1096,7 +1096,7 @@ contains if (.not. in_mesh) then call write_particle_restart(p) message = "Source site outside UFS mesh!" - call fatal_error() + call fatal_error(message) end if if (source_frac(1,ijk(1),ijk(2),ijk(3)) /= ZERO) then @@ -1124,7 +1124,7 @@ contains message = "Maximum number of sites in fission bank reached. This can & &result in irreproducible results using different numbers of & &processes/threads." - call warning() + if (master) call warning(message) end if ! Bank source neutrons @@ -1251,7 +1251,7 @@ contains ! call write_particle_restart(p) message = "Resampled energy distribution maximum number of " // & "times for nuclide " // nuc % name - call fatal_error() + call fatal_error(message) end if end do @@ -1278,7 +1278,7 @@ contains ! call write_particle_restart(p) message = "Resampled energy distribution maximum number of " // & "times for nuclide " // nuc % name - call fatal_error() + call fatal_error(message) end if end do @@ -1460,7 +1460,7 @@ contains else ! call write_particle_restart(p) message = "Unknown interpolation type: " // trim(to_str(interp)) - call fatal_error() + call fatal_error(message) end if ! Because of floating-point roundoff, it may be possible for mu to be @@ -1472,7 +1472,7 @@ contains else ! call write_particle_restart(p) message = "Unknown angular distribution type: " // trim(to_str(type)) - call fatal_error() + call fatal_error(message) end if end function sample_angle @@ -1621,7 +1621,7 @@ contains ! call write_particle_restart(p) message = "Multiple interpolation regions not supported while & &attempting to sample equiprobable energy bins." - call fatal_error() + call fatal_error(message) end if ! determine index on incoming energy grid and interpolation factor @@ -1686,12 +1686,12 @@ contains if (NR == 1) then message = "Assuming linear-linear interpolation when sampling & &continuous tabular distribution" - call warning() + if (master) call warning(message) else if (NR > 1) then ! call write_particle_restart(p) message = "Multiple interpolation regions not supported while & &attempting to sample continuous tabular distribution." - call fatal_error() + call fatal_error(message) end if ! find energy bin and calculate interpolation factor -- if the energy is @@ -1751,7 +1751,7 @@ contains ! call write_particle_restart(p) message = "Discrete lines in continuous tabular distributed not & &yet supported" - call fatal_error() + call fatal_error(message) end if ! determine outgoing energy bin @@ -1792,7 +1792,7 @@ contains else ! call write_particle_restart(p) message = "Unknown interpolation type: " // trim(to_str(INTT)) - call fatal_error() + call fatal_error(message) end if ! Now interpolate between incident energy bins i and i + 1 @@ -1834,7 +1834,7 @@ contains if (n_sample == MAX_SAMPLE) then ! call write_particle_restart(p) message = "Too many rejections on Maxwell fission spectrum." - call fatal_error() + call fatal_error(message) end if end do @@ -1867,7 +1867,7 @@ contains if (n_sample == MAX_SAMPLE) then ! call write_particle_restart(p) message = "Too many rejections on evaporation spectrum." - call fatal_error() + call fatal_error(message) end if end do @@ -1909,7 +1909,7 @@ contains if (n_sample == MAX_SAMPLE) then ! call write_particle_restart(p) message = "Too many rejections on Watt spectrum." - call fatal_error() + call fatal_error(message) end if end do @@ -1920,7 +1920,7 @@ contains if (.not. present(mu_out)) then ! call write_particle_restart(p) message = "Law 44 called without giving mu_out as argument." - call fatal_error() + call fatal_error(message) end if ! read number of interpolation regions and incoming energies @@ -1930,7 +1930,7 @@ contains ! call write_particle_restart(p) message = "Multiple interpolation regions not supported while & &attempting to sample Kalbach-Mann distribution." - call fatal_error() + call fatal_error(message) end if ! find energy bin and calculate interpolation factor -- if the energy is @@ -1991,7 +1991,7 @@ contains ! call write_particle_restart(p) message = "Discrete lines in continuous tabular distributed not & &yet supported" - call fatal_error() + call fatal_error(message) end if ! determine outgoing energy bin @@ -2046,7 +2046,7 @@ contains else ! call write_particle_restart() message = "Unknown interpolation type: " // trim(to_str(INTT)) - call fatal_error() + call fatal_error(message) end if ! Now interpolate between incident energy bins i and i + 1 @@ -2073,7 +2073,7 @@ contains if (.not. present(mu_out)) then ! call write_particle_restart() message = "Law 61 called without giving mu_out as argument." - call fatal_error() + call fatal_error(message) end if ! read number of interpolation regions and incoming energies @@ -2083,7 +2083,7 @@ contains ! call write_particle_restart() message = "Multiple interpolation regions not supported while & &attempting to sample correlated energy-angle distribution." - call fatal_error() + call fatal_error(message) end if ! find energy bin and calculate interpolation factor -- if the energy is @@ -2144,7 +2144,7 @@ contains ! call write_particle_restart() message = "Discrete lines in continuous tabular distributed not & &yet supported" - call fatal_error() + call fatal_error(message) end if ! determine outgoing energy bin @@ -2186,7 +2186,7 @@ contains else ! call write_particle_restart() message = "Unknown interpolation type: " // trim(to_str(INTT)) - call fatal_error() + call fatal_error(message) end if ! Now interpolate between incident energy bins i and i + 1 @@ -2250,7 +2250,7 @@ contains else ! call write_particle_restart() message = "Unknown interpolation type: " // trim(to_str(JJ)) - call fatal_error() + call fatal_error(message) end if case (66) diff --git a/src/plot.F90 b/src/plot.F90 index 099e61dffb..93ff5066f7 100644 --- a/src/plot.F90 +++ b/src/plot.F90 @@ -34,7 +34,7 @@ contains ! Display output message message = "Processing plot " // trim(to_str(pl % id)) // "..." - call write_message(5) + call write_message(message, 5) if (pl % type == PLOT_TYPE_SLICE) then ! create 2d image diff --git a/src/search.F90 b/src/search.F90 index 23f8841bdc..a48348524f 100644 --- a/src/search.F90 +++ b/src/search.F90 @@ -1,7 +1,7 @@ module search + use constants use error, only: fatal_error - use global, only: message integer, parameter :: MAX_ITERATION = 64 @@ -35,7 +35,7 @@ contains if (val < array(L) .or. val > array(R)) then message = "Value outside of array during binary search" - call fatal_error() + call fatal_error(message) end if n_iteration = 0 @@ -63,7 +63,7 @@ contains n_iteration = n_iteration + 1 if (n_iteration == MAX_ITERATION) then message = "Reached maximum number of iterations on binary search." - call fatal_error() + call fatal_error(message) end if end do @@ -88,7 +88,7 @@ contains if (val < array(L) .or. val > array(R)) then message = "Value outside of array during binary search" - call fatal_error() + call fatal_error(message) end if n_iteration = 0 @@ -116,7 +116,7 @@ contains n_iteration = n_iteration + 1 if (n_iteration == MAX_ITERATION) then message = "Reached maximum number of iterations on binary search." - call fatal_error() + call fatal_error(message) end if end do @@ -141,7 +141,7 @@ contains if (val < array(L) .or. val > array(R)) then message = "Value outside of array during binary search" - call fatal_error() + call fatal_error(message) end if n_iteration = 0 @@ -169,7 +169,7 @@ contains n_iteration = n_iteration + 1 if (n_iteration == MAX_ITERATION) then message = "Reached maximum number of iterations on binary search." - call fatal_error() + call fatal_error(message) end if end do diff --git a/src/solver_interface.F90 b/src/solver_interface.F90 index b4d7cfca17..f4b4032e65 100644 --- a/src/solver_interface.F90 +++ b/src/solver_interface.F90 @@ -1,7 +1,7 @@ module solver_interface + use constants use error, only: fatal_error - use global, only: message use matrix_header, only: Matrix use vector_header, only: Vector @@ -13,6 +13,8 @@ module solver_interface implicit none private + character(2*MAX_LINE_LEN) :: message + ! GMRES solver type type, public :: GMRESSolver #ifdef PETSC @@ -70,8 +72,6 @@ module solver_interface integer :: petsc_err ! petsc error code #endif - character(2*MAX_LINE_LEN) :: message - contains #ifdef PETSC diff --git a/src/source.F90 b/src/source.F90 index 25cfd7e6b4..68a9994967 100644 --- a/src/source.F90 +++ b/src/source.F90 @@ -37,14 +37,14 @@ contains type(BinaryOutput) :: sp ! statepoint/source binary file message = "Initializing source particles..." - call write_message(6) + call write_message(message, 6) if (path_source /= '') then ! Read the source from a binary file instead of sampling from some ! assumed source distribution message = 'Reading source file from ' // trim(path_source) // '...' - call write_message(6) + call write_message(message, 6) ! Open the binary file call sp % file_open(path_source, 'r', serial = .false.) @@ -55,7 +55,7 @@ contains ! Check to make sure this is a source file if (itmp /= FILETYPE_SOURCE) then message = "Specified starting source file not a source file type." - call fatal_error() + call fatal_error(message) end if ! Read in the source bank @@ -82,7 +82,7 @@ contains ! Write out initial source if (write_initial_source) then message = 'Writing out initial source guess...' - call write_message(1) + call write_message(message, 1) #ifdef HDF5 filename = trim(path_output) // 'initial_source.h5' #else @@ -146,7 +146,7 @@ contains if (num_resamples == MAX_EXTSRC_RESAMPLES) then message = "Maximum number of external source spatial resamples & &reached!" - call fatal_error() + call fatal_error(message) end if end if end do @@ -176,7 +176,7 @@ contains if (num_resamples == MAX_EXTSRC_RESAMPLES) then message = "Maximum number of external source spatial resamples & &reached!" - call fatal_error() + call fatal_error(message) end if cycle end if @@ -210,7 +210,7 @@ contains case default message = "No angle distribution specified for external source!" - call fatal_error() + call fatal_error(message) end select ! Sample energy distribution @@ -242,7 +242,7 @@ contains case default message = "No energy distribution specified for external source!" - call fatal_error() + call fatal_error(message) end select ! Set the random number generator back to the tracking stream. diff --git a/src/state_point.F90 b/src/state_point.F90 index 6a769c6872..af960c0923 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -56,7 +56,7 @@ contains ! Write message message = "Creating state point " // trim(filename) // "..." - call write_message(1) + call write_message(message, 1) if (master) then ! Create statepoint file @@ -317,7 +317,7 @@ contains ! Write message for new file creation message = "Creating source file " // trim(filename) // "..." - call write_message(1) + call write_message(message, 1) ! Create separate source file call sp % file_create(filename, serial = .false.) @@ -362,7 +362,7 @@ contains ! Write message for new file creation message = "Creating source file " // trim(filename) // "..." - call write_message(1) + call write_message(message, 1) ! Always create this file because it will be overwritten call sp % file_create(filename, serial = .false.) @@ -533,7 +533,7 @@ contains ! Write message message = "Loading state point " // trim(path_state_point) // "..." - call write_message(1) + call write_message(message, 1) ! Open file for reading call sp % file_open(path_state_point, 'r', serial = .false.) @@ -547,7 +547,7 @@ contains if (int_array(1) /= REVISION_STATEPOINT) then message = "State point version does not match current version " & // "in OpenMC." - call fatal_error() + call fatal_error(message) end if ! Read OpenMC version @@ -558,7 +558,7 @@ contains .or. int_array(3) /= VERSION_RELEASE) then message = "State point file was created with a different version " & // "of OpenMC." - call warning() + if (master) call warning(message) end if ! Read date and time @@ -669,7 +669,7 @@ contains if (int_array(1) /= t % total_score_bins .and. & int_array(2) /= t % total_filter_bins) then message = "Input file tally structure is different from restart." - call fatal_error() + call fatal_error(message) end if ! Read number of filters @@ -743,7 +743,7 @@ contains ! Check to make sure source bank is present if (path_source_point == path_state_point .and. .not. source_present) then message = "Source bank must be contained in statepoint restart file" - call fatal_error() + call fatal_error(message) end if ! Read tallies to master @@ -756,7 +756,7 @@ contains call sp % read_data(int_array(1), "n_global_tallies", collect=.false.) if (int_array(1) /= N_GLOBAL_TALLIES) then message = "Number of global tallies does not match in state point." - call fatal_error() + call fatal_error(message) end if ! Read global tally data @@ -793,7 +793,7 @@ contains ! Write message message = "Loading source file " // trim(path_source_point) // "..." - call write_message(1) + call write_message(message, 1) ! Open source file call sp % file_open(path_source_point, 'r', serial = .false.) diff --git a/src/string.F90 b/src/string.F90 index 85bfaa6751..05037d019f 100644 --- a/src/string.F90 +++ b/src/string.F90 @@ -2,7 +2,7 @@ module string use constants, only: MAX_WORDS, MAX_LINE_LEN, ERROR_INT, ERROR_REAL use error, only: fatal_error, warning - use global, only: message + use global, only: master implicit none @@ -53,7 +53,7 @@ contains if (i_end - i_start + 1 > len(words(n))) then message = "The word '" // string(i_start:i_end) // & "' is longer than the space allocated for it." - call warning() + if (master) call warning(message) end if words(n) = string(i_start:i_end) ! reset indices @@ -213,7 +213,7 @@ function zero_padded(num, n_digits) result(str) ! largest integer(4). if (n_digits > 10) then message = 'zero_padded called with an unreasonably large n_digits (>10)' - call fatal_error() + call fatal_error(message) end if ! Write a format string of the form '(In.m)' where n is the max width and diff --git a/src/tally.F90 b/src/tally.F90 index 91c28fbcf9..1803eb34e3 100644 --- a/src/tally.F90 +++ b/src/tally.F90 @@ -874,7 +874,7 @@ contains else message = "Invalid score type on tally " // to_str(t % id) // "." - call fatal_error() + call fatal_error(message) end if end select @@ -1012,7 +1012,7 @@ contains else message = "Invalid score type on tally " // to_str(t % id) // "." - call fatal_error() + call fatal_error(message) end if end select end if @@ -1212,7 +1212,7 @@ contains else message = "Invalid score type on tally " // to_str(t % id) // "." - call fatal_error() + call fatal_error(message) end if end select @@ -1364,7 +1364,7 @@ contains else message = "Invalid score type on tally " // to_str(t % id) // "." - call fatal_error() + call fatal_error(message) end if end select @@ -1711,7 +1711,7 @@ contains case default message = "Invalid score type on tally " // & to_str(t % id) // "." - call fatal_error() + call fatal_error(message) end select else @@ -1787,7 +1787,7 @@ contains case default message = "Invalid score type on tally " // & to_str(t % id) // "." - call fatal_error() + call fatal_error(message) end select end if @@ -2226,7 +2226,7 @@ contains if (filter_index <= 0 .or. filter_index > & t % total_filter_bins) then message = "Score index outside range." - call fatal_error() + call fatal_error(message) end if ! Add to surface current tally @@ -2566,17 +2566,17 @@ contains ! check to see if any of the active tally lists has been allocated if (active_tallies % size() > 0) then message = "Active tallies should not exist before CMFD tallies!" - call fatal_error() + call fatal_error(message) else if (active_analog_tallies % size() > 0) then message = 'Active analog tallies should not exist before CMFD tallies!' - call fatal_error() + call fatal_error(message) else if (active_tracklength_tallies % size() > 0) then message = "Active tracklength tallies should not exist before CMFD & &tallies!" - call fatal_error() + call fatal_error(message) else if (active_current_tallies % size() > 0) then message = "Active current tallies should not exist before CMFD tallies!" - call fatal_error() + call fatal_error(message) end if do i = 1, n_cmfd_tallies diff --git a/src/tracking.F90 b/src/tracking.F90 index 5ddfd32384..f0eb381eb4 100644 --- a/src/tracking.F90 +++ b/src/tracking.F90 @@ -42,7 +42,7 @@ contains ! Display message if high verbosity or trace is on if (verbosity >= 9 .or. trace) then message = "Simulating Particle " // trim(to_str(p % id)) - call write_message() + call write_message(message) end if ! If the cell hasn't been determined based on the particle's location, @@ -53,7 +53,7 @@ contains ! Particle couldn't be located if (.not. found_cell) then message = "Could not locate particle " // trim(to_str(p % id)) - call fatal_error() + call fatal_error(message) end if ! set birth cell attribute @@ -202,7 +202,7 @@ contains if (n_event == MAX_EVENTS) then message = "Particle " // trim(to_str(p%id)) // " underwent maximum & &number of events." - call warning() + if (master) call warning(message) p % alive = .false. end if diff --git a/src/xml_interface.F90 b/src/xml_interface.F90 index 0860c4fab5..43103b153c 100644 --- a/src/xml_interface.F90 +++ b/src/xml_interface.F90 @@ -2,7 +2,6 @@ module xml_interface use constants, only: MAX_LINE_LEN use error, only: fatal_error - use global, only: message use openmc_fox implicit none @@ -205,7 +204,7 @@ contains if (.not. found) then message = "Node " // node_name // " not part of Node " // & getNodeName(ptr) // "." - call fatal_error() + call fatal_error(message) end if ! Extract value @@ -238,7 +237,7 @@ contains if (.not. found) then message = "Node " // node_name // " not part of Node " // & getNodeName(ptr) // "." - call fatal_error() + call fatal_error(message) end if ! Extract value @@ -271,7 +270,7 @@ contains if (.not. found) then message = "Node " // node_name // " not part of Node " // & getNodeName(ptr) // "." - call fatal_error() + call fatal_error(message) end if ! Extract value @@ -304,7 +303,7 @@ contains if (.not. found) then message = "Node " // node_name // " not part of Node " // & getNodeName(ptr) // "." - call fatal_error() + call fatal_error(message) end if ! Extract value @@ -337,7 +336,7 @@ contains if (.not. found) then message = "Node " // node_name // " not part of Node " // & getNodeName(ptr) // "." - call fatal_error() + call fatal_error(message) end if ! Extract value @@ -370,7 +369,7 @@ contains if (.not. found) then message = "Node " // node_name // " not part of Node " // & getNodeName(ptr) // "." - call fatal_error() + call fatal_error(message) end if ! Extract value @@ -403,7 +402,7 @@ contains if (.not. found) then message = "Node " // node_name // " not part of Node " // & getNodeName(ptr) // "." - call fatal_error() + call fatal_error(message) end if ! Extract value @@ -436,7 +435,7 @@ contains if (.not. found) then message = "Node " // node_name // " not part of Node " // & getNodeName(ptr) // "." - call fatal_error() + call fatal_error(message) end if ! Get the size @@ -465,7 +464,7 @@ contains if (.not. found) then message = "Node " // node_name // " not part of Node " // & getNodeName(ptr) // "." - call fatal_error() + call fatal_error(message) end if ! Get the size @@ -494,7 +493,7 @@ contains if (.not. found) then message = "Node " // node_name // " not part of Node " // & getNodeName(ptr) // "." - call fatal_error() + call fatal_error(message) end if ! Get the size From d9f6e44ca076324bdd8734a10c6775b9c543bf17 Mon Sep 17 00:00:00 2001 From: Sterling Harper Date: Tue, 14 Oct 2014 13:36:45 -0400 Subject: [PATCH 90/95] Added comments, alphabetized declarations for #332 --- src/ace.F90 | 13 ++++++------- src/cmfd_solver.F90 | 42 ++++++++++++++++++++-------------------- src/eigenvalue.F90 | 7 ++++--- src/energy_grid.F90 | 2 +- src/fission.F90 | 2 +- src/fixed_source.F90 | 4 ++-- src/geometry.F90 | 2 +- src/global.F90 | 2 +- src/initialize.F90 | 2 +- src/input_xml.F90 | 4 ++-- src/interpolation.F90 | 2 +- src/particle_restart.F90 | 6 ++---- src/physics.F90 | 2 +- src/plot.F90 | 2 +- src/search.F90 | 2 +- src/solver_interface.F90 | 2 +- src/source.F90 | 2 +- src/state_point.F90 | 4 ++-- src/string.F90 | 2 +- src/tally.F90 | 6 ++---- src/tracking.F90 | 2 +- src/xml_interface.F90 | 2 +- 22 files changed, 55 insertions(+), 59 deletions(-) diff --git a/src/ace.F90 b/src/ace.F90 index a5b042f3ab..e4bc3a2f90 100644 --- a/src/ace.F90 +++ b/src/ace.F90 @@ -15,15 +15,14 @@ module ace implicit none - character(2*MAX_LINE_LEN) :: message + integer :: JXS(32) ! Pointers into ACE XSS tables + integer :: NXS(16) ! Descriptors for ACE XSS tables + real(8), allocatable :: XSS(:) ! Cross section data + integer :: XSS_index ! Current index in XSS data + character(2*MAX_LINE_LEN) :: message ! Message to output unit - integer :: NXS(16) ! Descriptors for ACE XSS tables - integer :: JXS(32) ! Pointers into ACE XSS tables - real(8), allocatable :: XSS(:) ! Cross section data - integer :: XSS_index ! current index in XSS data - - private :: NXS private :: JXS + private :: NXS private :: XSS contains diff --git a/src/cmfd_solver.F90 b/src/cmfd_solver.F90 index 15406c143c..360169845e 100644 --- a/src/cmfd_solver.F90 +++ b/src/cmfd_solver.F90 @@ -2,7 +2,7 @@ module cmfd_solver ! This module contains routines to execute the power iteration solver - use constants + use constants, only: MAX_LINE_LEN use cmfd_loss_operator, only: init_loss_matrix, build_loss_matrix use cmfd_prod_operator, only: init_prod_matrix, build_prod_matrix use matrix_header, only: Matrix @@ -12,26 +12,26 @@ module cmfd_solver private public :: cmfd_solver_execute - real(8) :: k_n ! new k-eigenvalue - real(8) :: k_o ! old k-eigenvalue - real(8) :: k_s ! shift of eigenvalue - real(8) :: k_ln ! new shifted eigenvalue - real(8) :: k_lo ! old shifted eigenvalue - real(8) :: norm_n ! current norm of source vector - real(8) :: norm_o ! old norm of source vector - real(8) :: kerr ! error in keff - real(8) :: serr ! error in source - real(8) :: ktol ! tolerance on keff - real(8) :: stol ! tolerance on source - logical :: adjoint_calc ! run an adjoint calculation - type(Matrix) :: loss ! cmfd loss matrix - type(Matrix) :: prod ! cmfd prod matrix - type(Vector) :: phi_n ! new flux vector - type(Vector) :: phi_o ! old flux vector - type(Vector) :: s_n ! new source vector - type(Vector) :: s_o ! old flux vector - type(Vector) :: serr_v ! error in source - character(2*MAX_LINE_LEN) :: message + real(8) :: k_n ! New k-eigenvalue + real(8) :: k_o ! Old k-eigenvalue + real(8) :: k_s ! Shift of eigenvalue + real(8) :: k_ln ! New shifted eigenvalue + real(8) :: k_lo ! Old shifted eigenvalue + real(8) :: norm_n ! Current norm of source vector + real(8) :: norm_o ! Old norm of source vector + real(8) :: kerr ! Error in keff + real(8) :: serr ! Error in source + real(8) :: ktol ! Tolerance on keff + real(8) :: stol ! Tolerance on source + logical :: adjoint_calc ! Run an adjoint calculation + type(Matrix) :: loss ! Cmfd loss matrix + type(Matrix) :: prod ! Cmfd prod matrix + type(Vector) :: phi_n ! New flux vector + type(Vector) :: phi_o ! Old flux vector + type(Vector) :: s_n ! New source vector + type(Vector) :: s_o ! Old flux vector + type(Vector) :: serr_v ! Error in source + character(2*MAX_LINE_LEN) :: message ! Message to output unit ! CMFD linear solver interface procedure(linsolve), pointer :: cmfd_linsolver => null() diff --git a/src/eigenvalue.F90 b/src/eigenvalue.F90 index b0152ddeeb..8605acb0f5 100644 --- a/src/eigenvalue.F90 +++ b/src/eigenvalue.F90 @@ -26,9 +26,10 @@ module eigenvalue private public :: run_eigenvalue - character(2*MAX_LINE_LEN) :: message - real(8) :: keff_generation ! Single-generation k on each processor - real(8) :: k_sum(2) = ZERO ! used to reduce sum and sum_sq + real(8) :: keff_generation ! Single-generation k on each + ! processor + real(8) :: k_sum(2) = ZERO ! Used to reduce sum and sum_sq + character(2*MAX_LINE_LEN) :: message ! Message to output unit contains diff --git a/src/energy_grid.F90 b/src/energy_grid.F90 index 8d8c549b06..e62f84d473 100644 --- a/src/energy_grid.F90 +++ b/src/energy_grid.F90 @@ -5,7 +5,7 @@ module energy_grid use list_header, only: ListReal use output, only: write_message - character(2*MAX_LINE_LEN) :: message + character(2*MAX_LINE_LEN) :: message ! Message to output unit contains diff --git a/src/fission.F90 b/src/fission.F90 index de82a134a7..952fd64de2 100644 --- a/src/fission.F90 +++ b/src/fission.F90 @@ -8,7 +8,7 @@ module fission implicit none - character(2*MAX_LINE_LEN) :: message + character(2*MAX_LINE_LEN) :: message ! Message to output unit contains diff --git a/src/fixed_source.F90 b/src/fixed_source.F90 index b98e35ad92..2016ded5ef 100644 --- a/src/fixed_source.F90 +++ b/src/fixed_source.F90 @@ -1,6 +1,6 @@ module fixed_source - use constants, only: ZERO + use constants, only: ZERO, MAX_LINE_LEN use global use output, only: write_message, header use particle_header, only: Particle @@ -11,7 +11,7 @@ module fixed_source use tally, only: synchronize_tallies, setup_active_usertallies use tracking, only: transport - character(2*MAX_LINE_LEN) :: message + character(2*MAX_LINE_LEN) :: message ! Message to output unit contains diff --git a/src/geometry.F90 b/src/geometry.F90 index a0663900ba..1476fa2e39 100644 --- a/src/geometry.F90 +++ b/src/geometry.F90 @@ -12,7 +12,7 @@ module geometry implicit none - character(2*MAX_LINE_LEN) :: message + character(2*MAX_LINE_LEN) :: message ! Message to output unit contains diff --git a/src/global.F90 b/src/global.F90 index 8241580362..f4c50b8330 100644 --- a/src/global.F90 +++ b/src/global.F90 @@ -393,7 +393,7 @@ module global integer :: n_res_scatterers_total = 0 ! total number of resonant scatterers type(Nuclide0K), allocatable, target :: nuclides_0K(:) ! 0K nuclides info -!$omp threadprivate(micro_xs, material_xs, fission_bank, n_bank, message, & +!$omp threadprivate(micro_xs, material_xs, fission_bank, n_bank, & !$omp& trace, thread_id, current_work, matching_bins) contains diff --git a/src/initialize.F90 b/src/initialize.F90 index a4384cbbb3..dd3b284c20 100644 --- a/src/initialize.F90 +++ b/src/initialize.F90 @@ -38,7 +38,7 @@ module initialize implicit none - character(2*MAX_LINE_LEN) :: message + character(2*MAX_LINE_LEN) :: message ! Message to output unit contains diff --git a/src/input_xml.F90 b/src/input_xml.F90 index 247a97b09b..7025c4b89b 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -20,9 +20,9 @@ module input_xml implicit none save - character(2*MAX_LINE_LEN) :: message - type(DictIntInt) :: cells_in_univ_dict ! used to count how many cells each + type(DictIntInt) :: cells_in_univ_dict ! Used to count how many cells each ! universe contains + character(2*MAX_LINE_LEN) :: message ! Message to output unit contains diff --git a/src/interpolation.F90 b/src/interpolation.F90 index 36c7aa37a2..4075b5e5e4 100644 --- a/src/interpolation.F90 +++ b/src/interpolation.F90 @@ -8,7 +8,7 @@ module interpolation implicit none - character(2*MAX_LINE_LEN) :: message + character(2*MAX_LINE_LEN) :: message ! Message to output unit interface interpolate_tab1 module procedure interpolate_tab1_array, interpolate_tab1_object diff --git a/src/particle_restart.F90 b/src/particle_restart.F90 index 73ddfd4ae0..dd68d5a896 100644 --- a/src/particle_restart.F90 +++ b/src/particle_restart.F90 @@ -16,10 +16,8 @@ module particle_restart private public :: run_particle_restart - ! Binary file - type(BinaryOutput) :: pr - - character(2*MAX_LINE_LEN) :: message + character(2*MAX_LINE_LEN) :: message ! Message to output unit + type(BinaryOutput) :: pr ! Binary file contains diff --git a/src/physics.F90 b/src/physics.F90 index 7bcfa45507..353b7fd344 100644 --- a/src/physics.F90 +++ b/src/physics.F90 @@ -20,7 +20,7 @@ module physics implicit none - character(2*MAX_LINE_LEN) :: message + character(2*MAX_LINE_LEN) :: message ! Message to output unit ! TODO: Figure out how to write particle restart files in sample_angle, ! sample_energy, etc. diff --git a/src/plot.F90 b/src/plot.F90 index 93ff5066f7..a879d4e2ec 100644 --- a/src/plot.F90 +++ b/src/plot.F90 @@ -16,7 +16,7 @@ module plot implicit none - character(2*MAX_LINE_LEN) :: message + character(2*MAX_LINE_LEN) :: message ! Message to output unit contains diff --git a/src/search.F90 b/src/search.F90 index a48348524f..f228060864 100644 --- a/src/search.F90 +++ b/src/search.F90 @@ -9,7 +9,7 @@ module search module procedure binary_search_real, binary_search_int4, binary_search_int8 end interface binary_search - character(2*MAX_LINE_LEN) :: message + character(2*MAX_LINE_LEN) :: message ! Message to output unit contains diff --git a/src/solver_interface.F90 b/src/solver_interface.F90 index f4b4032e65..a2bb900b65 100644 --- a/src/solver_interface.F90 +++ b/src/solver_interface.F90 @@ -13,7 +13,7 @@ module solver_interface implicit none private - character(2*MAX_LINE_LEN) :: message + character(2*MAX_LINE_LEN) :: message ! Message to output unit ! GMRES solver type type, public :: GMRESSolver diff --git a/src/source.F90 b/src/source.F90 index 68a9994967..8b8542fd6a 100644 --- a/src/source.F90 +++ b/src/source.F90 @@ -19,7 +19,7 @@ module source implicit none - character(2*MAX_LINE_LEN) :: message + character(2*MAX_LINE_LEN) :: message ! Message to output unit contains diff --git a/src/state_point.F90 b/src/state_point.F90 index af960c0923..c3332ed740 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -26,8 +26,8 @@ module state_point implicit none - character(2*MAX_LINE_LEN) :: message - type(BinaryOutput) :: sp ! statepoint/source output file + character(2*MAX_LINE_LEN) :: message ! Message to output unit + type(BinaryOutput) :: sp ! Statepoint/source output file contains diff --git a/src/string.F90 b/src/string.F90 index 05037d019f..7b3689f0eb 100644 --- a/src/string.F90 +++ b/src/string.F90 @@ -10,7 +10,7 @@ module string module procedure int4_to_str, int8_to_str, real_to_str end interface - character(2*MAX_LINE_LEN) :: message + character(2*MAX_LINE_LEN) :: message ! Message to output unit contains diff --git a/src/tally.F90 b/src/tally.F90 index 1803eb34e3..db3894379b 100644 --- a/src/tally.F90 +++ b/src/tally.F90 @@ -21,12 +21,10 @@ module tally implicit none - ! Tally map positioning array - integer :: position(N_FILTER_TYPES - 3) = 0 + character(2*MAX_LINE_LEN) :: message ! Message to output unit + integer :: position(N_FILTER_TYPES - 3) = 0 ! Tally map positioning array !$omp threadprivate(position) - character(2*MAX_LINE_LEN) :: message - contains !=============================================================================== diff --git a/src/tracking.F90 b/src/tracking.F90 index f0eb381eb4..eb94016310 100644 --- a/src/tracking.F90 +++ b/src/tracking.F90 @@ -16,7 +16,7 @@ module tracking use track_output, only: initialize_particle_track, write_particle_track, & finalize_particle_track - character(2*MAX_LINE_LEN) :: message + character(2*MAX_LINE_LEN) :: message ! Message to output unit contains diff --git a/src/xml_interface.F90 b/src/xml_interface.F90 index 43103b153c..907de77d96 100644 --- a/src/xml_interface.F90 +++ b/src/xml_interface.F90 @@ -37,7 +37,7 @@ module xml_interface module procedure get_node_array_string end interface get_node_array - character(2*MAX_LINE_LEN) :: message + character(2*MAX_LINE_LEN) :: message ! Message to output unit contains From 56c79d16ee096d025a26767f81c107f5f737897a Mon Sep 17 00:00:00 2001 From: Sterling Harper Date: Tue, 14 Oct 2014 14:00:09 -0400 Subject: [PATCH 91/95] Switched to assumed-length characters for #332 --- src/cmfd_execute.F90 | 20 +++++---------- src/cmfd_solver.F90 | 55 ++++++++++++++++++---------------------- src/energy_grid.F90 | 5 +--- src/error.F90 | 4 +-- src/fission.F90 | 5 +--- src/interpolation.F90 | 8 ++---- src/output.F90 | 2 +- src/plot.F90 | 6 ++--- src/search.F90 | 23 +++++++---------- src/solver_interface.F90 | 3 --- 10 files changed, 49 insertions(+), 82 deletions(-) diff --git a/src/cmfd_execute.F90 b/src/cmfd_execute.F90 index 19e4a8364d..8e0eb3fda0 100644 --- a/src/cmfd_execute.F90 +++ b/src/cmfd_execute.F90 @@ -11,8 +11,6 @@ module cmfd_execute private public :: execute_cmfd, cmfd_init_batch - character(2*MAX_LINE_LEN) :: message - contains !============================================================================== @@ -46,8 +44,7 @@ contains elseif (trim(cmfd_solver_type) == 'jfnk') then call cmfd_jfnk_execute() else - message = 'solver type became invalid after input processing' - call fatal_error(message) + call fatal_error('solver type became invalid after input processing') end if #else call cmfd_solver_execute() @@ -316,8 +313,7 @@ contains ! Check for sites outside of the mesh if (master .and. outside) then - message = "Source sites outside of the CMFD mesh!" - call fatal_error(message) + call fatal_error("Source sites outside of the CMFD mesh!") end if ! Have master compute weight factors (watch for 0s) @@ -347,12 +343,10 @@ contains n_groups = size(cmfd % egrid) - 1 if (source_bank(i) % E < cmfd % egrid(1)) then e_bin = 1 - message = 'Source pt below energy grid' - if (master) call warning(message) + if (master) call warning('Source pt below energy grid') elseif (source_bank(i) % E > cmfd % egrid(n_groups + 1)) then e_bin = n_groups - message = 'Source pt above energy grid' - if (master) call warning(message) + if (master) call warning('Source pt above energy grid') else e_bin = binary_search(cmfd % egrid, n_groups + 1, source_bank(i) % E) end if @@ -362,8 +356,7 @@ contains ! Check for outside of mesh if (.not. in_mesh) then - message = 'Source site found outside of CMFD mesh' - call fatal_error(message) + call fatal_error('Source site found outside of CMFD mesh') end if ! Reweight particle @@ -419,8 +412,7 @@ contains integer :: i ! loop counter ! Print message - message = "CMFD tallies reset" - call write_message(message, 7) + call write_message("CMFD tallies reset", 7) ! Begin loop around CMFD tallies do i = 1, n_cmfd_tallies diff --git a/src/cmfd_solver.F90 b/src/cmfd_solver.F90 index 360169845e..d884514ce1 100644 --- a/src/cmfd_solver.F90 +++ b/src/cmfd_solver.F90 @@ -12,26 +12,25 @@ module cmfd_solver private public :: cmfd_solver_execute - real(8) :: k_n ! New k-eigenvalue - real(8) :: k_o ! Old k-eigenvalue - real(8) :: k_s ! Shift of eigenvalue - real(8) :: k_ln ! New shifted eigenvalue - real(8) :: k_lo ! Old shifted eigenvalue - real(8) :: norm_n ! Current norm of source vector - real(8) :: norm_o ! Old norm of source vector - real(8) :: kerr ! Error in keff - real(8) :: serr ! Error in source - real(8) :: ktol ! Tolerance on keff - real(8) :: stol ! Tolerance on source - logical :: adjoint_calc ! Run an adjoint calculation - type(Matrix) :: loss ! Cmfd loss matrix - type(Matrix) :: prod ! Cmfd prod matrix - type(Vector) :: phi_n ! New flux vector - type(Vector) :: phi_o ! Old flux vector - type(Vector) :: s_n ! New source vector - type(Vector) :: s_o ! Old flux vector - type(Vector) :: serr_v ! Error in source - character(2*MAX_LINE_LEN) :: message ! Message to output unit + real(8) :: k_n ! New k-eigenvalue + real(8) :: k_o ! Old k-eigenvalue + real(8) :: k_s ! Shift of eigenvalue + real(8) :: k_ln ! New shifted eigenvalue + real(8) :: k_lo ! Old shifted eigenvalue + real(8) :: norm_n ! Current norm of source vector + real(8) :: norm_o ! Old norm of source vector + real(8) :: kerr ! Error in keff + real(8) :: serr ! Error in source + real(8) :: ktol ! Tolerance on keff + real(8) :: stol ! Tolerance on source + logical :: adjoint_calc ! Run an adjoint calculation + type(Matrix) :: loss ! Cmfd loss matrix + type(Matrix) :: prod ! Cmfd prod matrix + type(Vector) :: phi_n ! New flux vector + type(Vector) :: phi_o ! Old flux vector + type(Vector) :: s_n ! New source vector + type(Vector) :: s_o ! Old flux vector + type(Vector) :: serr_v ! Error in source ! CMFD linear solver interface procedure(linsolve), pointer :: cmfd_linsolver => null() @@ -195,8 +194,7 @@ contains call prod % write_petsc_binary('adj_prodmat.bin') end if #else - message = 'Adjoint calculations only allowed with PETSc' - call fatal_error(message) + call fatal_error('Adjoint calculations only allowed with PETSc') #endif end subroutine compute_adjoint @@ -237,8 +235,8 @@ contains ! Check if reached iteration 10000 if (i == 10000) then - message = 'Reached maximum iterations in CMFD power iteration solver.' - call fatal_error(message) + call fatal_error('Reached maximum iterations in CMFD power iteration ' & + & // 'solver.') end if ! Compute source vector @@ -401,8 +399,7 @@ contains ! Check for max iterations met if (igs == 10000) then - message = 'Maximum Gauss-Seidel iterations encountered.' - call fatal_error(message) + call fatal_error('Maximum Gauss-Seidel iterations encountered.') endif ! Copy over x vector @@ -520,8 +517,7 @@ contains ! Check for max iterations met if (igs == 10000) then - message = 'Maximum Gauss-Seidel iterations encountered.' - call fatal_error(message) + call fatal_error('Maximum Gauss-Seidel iterations encountered.') endif ! Copy over x vector @@ -653,8 +649,7 @@ contains ! Check for max iterations met if (igs == 10000) then - message = 'Maximum Gauss-Seidel iterations encountered.' - call fatal_error(message) + call fatal_error('Maximum Gauss-Seidel iterations encountered.') endif ! Copy over x vector diff --git a/src/energy_grid.F90 b/src/energy_grid.F90 index e62f84d473..a006959d92 100644 --- a/src/energy_grid.F90 +++ b/src/energy_grid.F90 @@ -5,8 +5,6 @@ module energy_grid use list_header, only: ListReal use output, only: write_message - character(2*MAX_LINE_LEN) :: message ! Message to output unit - contains !=============================================================================== @@ -23,8 +21,7 @@ contains type(ListReal), pointer :: list => null() type(Nuclide), pointer :: nuc => null() - message = "Creating unionized energy grid..." - call write_message(message, 5) + call write_message("Creating unionized energy grid...", 5) ! Add grid points for each nuclide in the problem do i = 1, n_nuclides_total diff --git a/src/error.F90 b/src/error.F90 index 78030d18b0..77f663108f 100644 --- a/src/error.F90 +++ b/src/error.F90 @@ -20,7 +20,7 @@ contains subroutine warning(message) - character(2*MAX_LINE_LEN) :: message + character(*) :: message integer :: i_start ! starting position integer :: i_end ! ending position @@ -78,7 +78,7 @@ contains subroutine fatal_error(message, error_code) - character(2*MAX_LINE_LEN) :: message + character(*) :: message integer, optional :: error_code ! error code integer :: code ! error code diff --git a/src/fission.F90 b/src/fission.F90 index 952fd64de2..27143bf386 100644 --- a/src/fission.F90 +++ b/src/fission.F90 @@ -8,8 +8,6 @@ module fission implicit none - character(2*MAX_LINE_LEN) :: message ! Message to output unit - contains !=============================================================================== @@ -28,8 +26,7 @@ contains real(8) :: c ! polynomial coefficient if (nuc % nu_t_type == NU_NONE) then - message = "No neutron emission data for table: " // nuc % name - call fatal_error(message) + call fatal_error("No neutron emission data for table: " // nuc % name) elseif (nuc % nu_t_type == NU_POLYNOMIAL) then ! determine number of coefficients NC = int(nuc % nu_t_data(1)) diff --git a/src/interpolation.F90 b/src/interpolation.F90 index 4075b5e5e4..5c44ed7c3d 100644 --- a/src/interpolation.F90 +++ b/src/interpolation.F90 @@ -8,8 +8,6 @@ module interpolation implicit none - character(2*MAX_LINE_LEN) :: message ! Message to output unit - interface interpolate_tab1 module procedure interpolate_tab1_array, interpolate_tab1_object end interface interpolate_tab1 @@ -119,8 +117,7 @@ contains r = (log(x) - log(x0))/(log(x1) - log(x0)) y = exp((1-r)*log(y0) + r*log(y1)) case default - message = "Unsupported interpolation scheme: " // to_str(interp) - call fatal_error(message) + call fatal_error("Unsupported interpolation scheme: " // to_str(interp)) end select end function interpolate_tab1_array @@ -205,8 +202,7 @@ contains r = (log(x) - log(x0))/(log(x1) - log(x0)) y = exp((1-r)*log(y0) + r*log(y1)) case default - message = "Unsupported interpolation scheme: " // to_str(interp) - call fatal_error(message) + call fatal_error("Unsupported interpolation scheme: " // to_str(interp)) end select end function interpolate_tab1_object diff --git a/src/output.F90 b/src/output.F90 index bd70eeccfb..5dcd668b44 100644 --- a/src/output.F90 +++ b/src/output.F90 @@ -195,7 +195,7 @@ contains subroutine write_message(message, level) - character(2*MAX_LINE_LEN) :: message + character(*) :: message integer, optional :: level ! verbosity level integer :: i_start ! starting position diff --git a/src/plot.F90 b/src/plot.F90 index a879d4e2ec..1297b746c4 100644 --- a/src/plot.F90 +++ b/src/plot.F90 @@ -16,8 +16,6 @@ module plot implicit none - character(2*MAX_LINE_LEN) :: message ! Message to output unit - contains !=============================================================================== @@ -33,8 +31,8 @@ contains pl => plots(i) ! Display output message - message = "Processing plot " // trim(to_str(pl % id)) // "..." - call write_message(message, 5) + call write_message("Processing plot " // trim(to_str(pl % id)) & + &// "...", 5) if (pl % type == PLOT_TYPE_SLICE) then ! create 2d image diff --git a/src/search.F90 b/src/search.F90 index f228060864..acd1c9ccbc 100644 --- a/src/search.F90 +++ b/src/search.F90 @@ -9,8 +9,6 @@ module search module procedure binary_search_real, binary_search_int4, binary_search_int8 end interface binary_search - character(2*MAX_LINE_LEN) :: message ! Message to output unit - contains !=============================================================================== @@ -34,8 +32,7 @@ contains R = n if (val < array(L) .or. val > array(R)) then - message = "Value outside of array during binary search" - call fatal_error(message) + call fatal_error("Value outside of array during binary search") end if n_iteration = 0 @@ -62,8 +59,8 @@ contains ! check for large number of iterations n_iteration = n_iteration + 1 if (n_iteration == MAX_ITERATION) then - message = "Reached maximum number of iterations on binary search." - call fatal_error(message) + call fatal_error("Reached maximum number of iterations on binary " & + &// "search.") end if end do @@ -87,8 +84,7 @@ contains R = n if (val < array(L) .or. val > array(R)) then - message = "Value outside of array during binary search" - call fatal_error(message) + call fatal_error("Value outside of array during binary search") end if n_iteration = 0 @@ -115,8 +111,8 @@ contains ! check for large number of iterations n_iteration = n_iteration + 1 if (n_iteration == MAX_ITERATION) then - message = "Reached maximum number of iterations on binary search." - call fatal_error(message) + call fatal_error("Reached maximum number of iterations on binary " & + &// "search.") end if end do @@ -140,8 +136,7 @@ contains R = n if (val < array(L) .or. val > array(R)) then - message = "Value outside of array during binary search" - call fatal_error(message) + call fatal_error("Value outside of array during binary search") end if n_iteration = 0 @@ -168,8 +163,8 @@ contains ! check for large number of iterations n_iteration = n_iteration + 1 if (n_iteration == MAX_ITERATION) then - message = "Reached maximum number of iterations on binary search." - call fatal_error(message) + call fatal_error("Reached maximum number of iterations on binary " & + &// "search.") end if end do diff --git a/src/solver_interface.F90 b/src/solver_interface.F90 index a2bb900b65..043b3fd116 100644 --- a/src/solver_interface.F90 +++ b/src/solver_interface.F90 @@ -1,6 +1,5 @@ module solver_interface - use constants use error, only: fatal_error use matrix_header, only: Matrix use vector_header, only: Vector @@ -13,8 +12,6 @@ module solver_interface implicit none private - character(2*MAX_LINE_LEN) :: message ! Message to output unit - ! GMRES solver type type, public :: GMRESSolver #ifdef PETSC From a3ff5423eb29cf89e019fe2e47d53beedb243824 Mon Sep 17 00:00:00 2001 From: Sterling Harper Date: Fri, 17 Oct 2014 04:40:09 -0400 Subject: [PATCH 92/95] Converted messages to string literals #332 --- src/ace.F90 | 37 +- src/cmfd_data.F90 | 12 +- src/cmfd_input.F90 | 68 ++-- src/cmfd_solver.F90 | 5 +- src/eigenvalue.F90 | 20 +- src/geometry.F90 | 78 ++-- src/initialize.F90 | 88 ++-- src/input_xml.F90 | 856 ++++++++++++++++----------------------- src/output.F90 | 5 +- src/particle_restart.F90 | 6 +- src/physics.F90 | 121 +++--- src/search.F90 | 12 +- src/source.F90 | 32 +- src/state_point.F90 | 41 +- src/string.F90 | 11 +- src/tally.F90 | 46 +-- src/tracking.F90 | 13 +- src/xml_interface.F90 | 52 +-- 18 files changed, 609 insertions(+), 894 deletions(-) diff --git a/src/ace.F90 b/src/ace.F90 index e4bc3a2f90..82aa705baa 100644 --- a/src/ace.F90 +++ b/src/ace.F90 @@ -19,7 +19,6 @@ module ace integer :: NXS(16) ! Descriptors for ACE XSS tables real(8), allocatable :: XSS(:) ! Cross section data integer :: XSS_index ! Current index in XSS data - character(2*MAX_LINE_LEN) :: message ! Message to output unit private :: JXS private :: NXS @@ -152,9 +151,9 @@ contains ! Check to make sure S(a,b) table matched a nuclide if (mat % i_sab_nuclides(k) == NONE) then - message = "S(a,b) table " // trim(mat % sab_names(k)) // " did not & - &match any nuclide on material " // trim(to_str(mat % id)) - call fatal_error(message) + call fatal_error("S(a,b) table " // trim(mat % sab_names(k)) & + &// " did not match any nuclide on material " & + &// trim(to_str(mat % id))) end if end do ASSIGN_SAB @@ -265,17 +264,14 @@ contains ! Check if ACE library exists and is readable inquire(FILE=filename, EXIST=file_exists, READ=readable) if (.not. file_exists) then - message = "ACE library '" // trim(filename) // "' does not exist!" - call fatal_error(message) + call fatal_error("ACE library '" // trim(filename) // "' does not exist!") elseif (readable(1:3) == 'NO') then - message = "ACE library '" // trim(filename) // "' is not readable! & - &Change file permissions with chmod command." - call fatal_error(message) + call fatal_error("ACE library '" // trim(filename) // "' is not readable!& + &Change file permissions with chmod command.") end if ! display message - message = "Loading ACE cross section table: " // listing % name - call write_message(message, 6) + call write_message("Loading ACE cross section table: " // listing % name, 6) if (filetype == ASCII) then ! ======================================================================= @@ -294,9 +290,8 @@ contains ! Check that correct xs was found -- if cross_sections.xml is broken, the ! location of the table may be wrong if(adjustl(name) /= adjustl(listing % name)) then - message = "XS listing entry " // trim(listing % name) // " did not & - &match ACE data, " // trim(name) // " found instead." - call fatal_error(message) + call fatal_error("XS listing entry " // trim(listing % name) // " did & + ¬ match ACE data, " // trim(name) // " found instead.") end if ! Read more header and NXS and JXS @@ -378,8 +373,8 @@ contains ! if any fissionable material is found in a fixed source calculation, ! abort the run. if (run_mode == MODE_FIXEDSOURCE .and. nuc % fissionable) then - message = "Cannot have fissionable material in a fixed source run." - call fatal_error(message) + call fatal_error("Cannot have fissionable material in a fixed source & + &run.") end if ! for fissionable nuclides, precalculate microscopic nu-fission cross @@ -1316,9 +1311,8 @@ contains ! Abort if no corresponding inelastic reaction was found if (nuc % urr_inelastic == NONE) then - message = "Could not find inelastic reaction specified on " & - // "unresolved resonance probability table." - call fatal_error(message) + call fatal_error("Could not find inelastic reaction specified on & + &unresolved resonance probability table.") end if end if @@ -1344,9 +1338,8 @@ contains ! Check for negative values if (any(nuc % urr_data % prob < ZERO)) then - message = "Negative value(s) found on probability table for nuclide " & - // nuc % name - if (master) call warning(message) + if (master) call warning("Negative value(s) found on probability table & + &for nuclide " // nuc % name) end if end subroutine read_unr_res diff --git a/src/cmfd_data.F90 b/src/cmfd_data.F90 index c49fc7808c..b392e86a28 100644 --- a/src/cmfd_data.F90 +++ b/src/cmfd_data.F90 @@ -11,8 +11,6 @@ module cmfd_data private public :: set_up_cmfd, neutron_balance - character(2*MAX_LINE_LEN) :: message - contains !============================================================================== @@ -162,10 +160,9 @@ contains ! Detect zero flux, abort if located if ((flux - ZERO) < TINY_BIT) then - message = 'Detected zero flux without coremap overlay at: (' & - // to_str(i) // ',' // to_str(j) // ',' // to_str(k) & - // ') in group ' // to_str(h) - call fatal_error(message) + call fatal_error('Detected zero flux without coremap overlay & + &at: (' // to_str(i) // ',' // to_str(j) // ',' // & + &to_str(k) // ') in group ' // to_str(h)) end if ! Get total rr and convert to total xs @@ -767,8 +764,7 @@ contains ! write that dhats are zero if (dhat_reset) then - message = 'Dhats reset to zero.' - call write_message(message, 1) + call write_message('Dhats reset to zero.', 1) end if end subroutine compute_dhat diff --git a/src/cmfd_input.F90 b/src/cmfd_input.F90 index 32797a616f..32866b52ec 100644 --- a/src/cmfd_input.F90 +++ b/src/cmfd_input.F90 @@ -10,8 +10,6 @@ module cmfd_input private public :: configure_cmfd - character(2*MAX_LINE_LEN) :: message - contains !=============================================================================== @@ -87,15 +85,14 @@ contains if (.not. file_exists) then ! CMFD is optional unless it is in on from settings if (cmfd_on) then - message = "No CMFD XML file, '" // trim(filename) // "' does not exist!" - call fatal_error(message) + call fatal_error("No CMFD XML file, '" // trim(filename) // "' does not& + & exist!") end if return else ! Tell user - message = "Reading CMFD XML file..." - call write_message(message, 5) + call write_message("Reading CMFD XML file...", 5) end if @@ -107,8 +104,7 @@ contains ! Check if mesh is there if (.not.found) then - message = "No CMFD mesh specified in CMFD XML file." - call fatal_error(message) + call fatal_error("No CMFD mesh specified in CMFD XML file.") end if ! Set spatial dimensions in cmfd object @@ -139,8 +135,7 @@ contains cmfd % indices(3))) if (get_arraysize_integer(node_mesh, "map") /= & product(cmfd % indices(1:3))) then - message = 'FATAL==>CMFD coremap not to correct dimensions' - call fatal_error(message) + call fatal_error('FATAL==>CMFD coremap not to correct dimensions') end if allocate(iarray(get_arraysize_integer(node_mesh, "map"))) call get_node_array(node_mesh, "map", iarray) @@ -216,8 +211,7 @@ contains temp_str = to_lower(temp_str) if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') & #ifndef PETSC - message = 'Must use PETSc when running adjoint option.' - call fatal_error(message) + call fatal_error('Must use PETSc when running adjoint option.') #endif cmfd_run_adjoint = .true. end if @@ -246,8 +240,8 @@ contains call get_node_value(doc, "display", cmfd_display) if (trim(cmfd_display) == 'dominance' .and. & trim(cmfd_solver_type) /= 'power') then - message = 'Dominance Ratio only aviable with power iteration solver' - if (master) call warning(message) + if (master) call warning('Dominance Ratio only aviable with power & + &iteration solver') cmfd_display = '' end if @@ -263,9 +257,8 @@ contains if (check_for_node(doc, "gauss_seidel_tolerance")) then n_params = get_arraysize_double(doc, "gauss_seidel_tolerance") if (n_params /= 2) then - message = 'Gauss Seidel tolerance is not 2 parameters & - &(absolute, relative).' - call fatal_error(message) + call fatal_error('Gauss Seidel tolerance is not 2 parameters & + &(absolute, relative).') end if call get_node_array(doc, "gauss_seidel_tolerance", gs_tol) cmfd_atoli = gs_tol(1) @@ -335,8 +328,7 @@ contains ! Determine number of dimensions for mesh n = get_arraysize_integer(node_mesh, "dimension") if (n /= 2 .and. n /= 3) then - message = "Mesh must be two or three dimensions." - call fatal_error(message) + call fatal_error("Mesh must be two or three dimensions.") end if m % n_dimension = n @@ -349,9 +341,8 @@ contains ! Check that dimensions are all greater than zero call get_node_array(node_mesh, "dimension", iarray3(1:n)) if (any(iarray3(1:n) <= 0)) then - message = "All entries on the element for a tally mesh & - &must be positive." - call fatal_error(message) + call fatal_error("All entries on the element for a tally mesh& + &must be positive.") end if ! Read dimensions in each direction @@ -359,42 +350,37 @@ contains ! Read mesh lower-left corner location if (m % n_dimension /= get_arraysize_double(node_mesh, "lower_left")) then - message = "Number of entries on must be the same as & - &the number of entries on ." - call fatal_error(message) + call fatal_error("Number of entries on must be the same as & + &the number of entries on .") end if call get_node_array(node_mesh, "lower_left", m % lower_left) ! Make sure both upper-right or width were specified if (check_for_node(node_mesh, "upper_right") .and. & check_for_node(node_mesh, "width")) then - message = "Cannot specify both and on a & - &tally mesh." - call fatal_error(message) + call fatal_error("Cannot specify both and on a & + &tally mesh.") end if ! Make sure either upper-right or width was specified if (.not.check_for_node(node_mesh, "upper_right") .and. & .not.check_for_node(node_mesh, "width")) then - message = "Must specify either and on a & - &tally mesh." - call fatal_error(message) + call fatal_error("Must specify either and on a & + &tally mesh.") end if if (check_for_node(node_mesh, "width")) then ! Check to ensure width has same dimensions if (get_arraysize_double(node_mesh, "width") /= & get_arraysize_double(node_mesh, "lower_left")) then - message = "Number of entries on must be the same as the & - &number of entries on ." - call fatal_error(message) + call fatal_error("Number of entries on must be the same as the & + &number of entries on .") end if ! Check for negative widths call get_node_array(node_mesh, "width", rarray3(1:n)) if (any(rarray3(1:n) < ZERO)) then - message = "Cannot have a negative on a tally mesh." - call fatal_error(message) + call fatal_error("Cannot have a negative on a tally mesh.") end if ! Set width and upper right coordinate @@ -405,17 +391,15 @@ contains ! Check to ensure width has same dimensions if (get_arraysize_double(node_mesh, "upper_right") /= & get_arraysize_double(node_mesh, "lower_left")) then - message = "Number of entries on must be the same as & - &the number of entries on ." - call fatal_error(message) + call fatal_error("Number of entries on must be the same & + &as the number of entries on .") end if ! Check that upper-right is above lower-left call get_node_array(node_mesh, "upper_right", rarray3(1:n)) if (any(rarray3(1:n) < m % lower_left)) then - message = "The coordinates must be greater than the & - & coordinates on a tally mesh." - call fatal_error(message) + call fatal_error("The coordinates must be greater than & + &the coordinates on a tally mesh.") end if ! Set upper right coordinate and width diff --git a/src/cmfd_solver.F90 b/src/cmfd_solver.F90 index d884514ce1..e660c92470 100644 --- a/src/cmfd_solver.F90 +++ b/src/cmfd_solver.F90 @@ -101,7 +101,6 @@ contains subroutine init_data(adjoint) use constants, only: ONE, ZERO - use error, only: fatal_error use global, only: cmfd, cmfd_shift, keff, cmfd_ktol, cmfd_stol, & cmfd_write_matrices @@ -235,8 +234,8 @@ contains ! Check if reached iteration 10000 if (i == 10000) then - call fatal_error('Reached maximum iterations in CMFD power iteration ' & - & // 'solver.') + call fatal_error('Reached maximum iterations in CMFD power iteration & + &solver.') end if ! Compute source vector diff --git a/src/eigenvalue.F90 b/src/eigenvalue.F90 index 8605acb0f5..c46f90ab17 100644 --- a/src/eigenvalue.F90 +++ b/src/eigenvalue.F90 @@ -29,7 +29,6 @@ module eigenvalue real(8) :: keff_generation ! Single-generation k on each ! processor real(8) :: k_sum(2) = ZERO ! Used to reduce sum and sum_sq - character(2*MAX_LINE_LEN) :: message ! Message to output unit contains @@ -116,8 +115,8 @@ contains subroutine initialize_batch() - message = "Simulating batch " // trim(to_str(current_batch)) // "..." - call write_message(message, 8) + call write_message("Simulating batch " // trim(to_str(current_batch)) & + &// "...", 8) ! Reset total starting particle weight used for normalizing tallies total_weight = ZERO @@ -303,8 +302,7 @@ contains ! runs enough particles to avoid this in the first place. if (n_bank == 0) then - message = "No fission sites banked on processor " // to_str(rank) - call fatal_error(message) + call fatal_error("No fission sites banked on processor " // to_str(rank)) end if ! Make sure all processors start at the same point for random sampling. Then @@ -555,8 +553,7 @@ contains ! display warning message if there were sites outside entropy box if (sites_outside) then - message = "Fission source site(s) outside of entropy box." - if (master) call warning(message) + if (master) call warning("Fission source site(s) outside of entropy box.") end if ! sum values to obtain shannon entropy @@ -774,8 +771,7 @@ contains ! Check for sites outside of the mesh if (master .and. sites_outside) then - message = "Source sites outside of the UFS mesh!" - call fatal_error(message) + call fatal_error("Source sites outside of the UFS mesh!") end if #ifdef MPI @@ -805,8 +801,7 @@ contains ! Write message at beginning if (current_batch == 1) then - message = "Replaying history from state point..." - call write_message(message, 1) + call write_message("Replaying history from state point...", 1) end if do current_gen = 1, gen_per_batch @@ -823,8 +818,7 @@ contains ! Write message at end if (current_batch == restart_batch) then - message = "Resuming simulation..." - call write_message(message, 1) + call write_message("Resuming simulation...", 1) end if end subroutine replay_batch_history diff --git a/src/geometry.F90 b/src/geometry.F90 index 1476fa2e39..043ded05b5 100644 --- a/src/geometry.F90 +++ b/src/geometry.F90 @@ -11,9 +11,7 @@ module geometry use tally, only: score_surface_current implicit none - - character(2*MAX_LINE_LEN) :: message ! Message to output unit - + contains !=============================================================================== @@ -102,11 +100,10 @@ contains if (simple_cell_contains(c, p)) then ! the particle should only be contained in one cell per level if (index_cell /= coord % cell) then - message = "Overlapping cells detected: " // & - trim(to_str(cells(index_cell) % id)) // ", " // & - trim(to_str(cells(coord % cell) % id)) // & - " on universe " // trim(to_str(univ % id)) - call fatal_error(message) + call fatal_error("Overlapping cells detected: " & + &// trim(to_str(cells(index_cell) % id)) // ", " & + &// trim(to_str(cells(coord % cell) % id)) & + &// " on universe " // trim(to_str(univ % id))) end if overlap_check_cnt(index_cell) = overlap_check_cnt(index_cell) + 1 @@ -181,8 +178,7 @@ contains ! Show cell information on trace if (verbosity >= 10 .or. trace) then - message = " Entering cell " // trim(to_str(c % id)) - call write_message(message) + call write_message(" Entering cell " // trim(to_str(c % id))) end if if (c % type == CELL_NORMAL) then @@ -386,8 +382,7 @@ contains i_surface = abs(p % surface) surf => surfaces(i_surface) if (verbosity >= 10 .or. trace) then - message = " Crossing surface " // trim(to_str(surf % id)) - call write_message(message) + call write_message(" Crossing surface " // trim(to_str(surf % id))) end if if (surf % bc == BC_VACUUM .and. (run_mode /= MODE_PLOTTING)) then @@ -419,8 +414,8 @@ contains ! Display message if (verbosity >= 10 .or. trace) then - message = " Leaked out of surface " // trim(to_str(surf % id)) - call write_message(message) + call write_message(" Leaked out of surface " & + &// trim(to_str(surf % id))) end if return @@ -430,9 +425,8 @@ contains ! Do not handle reflective boundary conditions on lower universes if (.not. associated(p % coord, p % coord0)) then - message = "Cannot reflect particle " // trim(to_str(p % id)) // & - " off surface in a lower universe." - call handle_lost_particle(p) + call handle_lost_particle(p, "Cannot reflect particle " & + &// trim(to_str(p % id)) // " off surface in a lower universe.") return end if @@ -564,9 +558,8 @@ contains w = w + 2*dot_prod*R*z case default - message = "Reflection not supported for surface " // & - trim(to_str(surf % id)) - call fatal_error(message) + call fatal_error("Reflection not supported for surface " & + &// trim(to_str(surf % id))) end select ! Set new particle direction @@ -585,8 +578,8 @@ contains call deallocate_coord(p % coord0 % next) call find_cell(p, found) if (.not. found) then - message = "Couldn't find particle after reflecting from surface." - call handle_lost_particle(p) + call handle_lost_particle(p, "Couldn't find particle after reflecting& + & from surface.") return end if end if @@ -596,8 +589,8 @@ contains ! Diagnostic message if (verbosity >= 10 .or. trace) then - message = " Reflected from surface " // trim(to_str(surf%id)) - call write_message(message) + call write_message(" Reflected from surface " & + &// trim(to_str(surf%id))) end if return end if @@ -645,10 +638,9 @@ contains ! undefined region in the geometry. if (.not. found) then - message = "After particle " // trim(to_str(p % id)) // " crossed surface " & - // trim(to_str(surfaces(i_surface) % id)) // " it could not be & - &located in any cell and it did not leak." - call handle_lost_particle(p) + call handle_lost_particle(p, "After particle " // trim(to_str(p % id)) & + &// " crossed surface " // trim(to_str(surfaces(i_surface) % id)) & + &// " it could not be located in any cell and it did not leak.") return end if end if @@ -674,11 +666,10 @@ contains lat => lattices(p % coord % lattice) if (verbosity >= 10 .or. trace) then - message = " Crossing lattice " // trim(to_str(lat % id)) // & - ". Current position (" // trim(to_str(p % coord % lattice_x)) & - // "," // trim(to_str(p % coord % lattice_y)) // "," // & - trim(to_str(p % coord % lattice_z)) // ")" - call write_message(message) + call write_message(" Crossing lattice " // trim(to_str(lat % id)) & + &// ". Current position (" // trim(to_str(p % coord % lattice_x)) & + &// "," // trim(to_str(p % coord % lattice_y)) // "," & + &// trim(to_str(p % coord % lattice_z)) // ")") end if if (lat % type == LATTICE_RECT) then @@ -741,9 +732,8 @@ contains ! Search for particle call find_cell(p, found) if (.not. found) then - message = "Could not locate particle " // trim(to_str(p % id)) // & - " after crossing a lattice boundary." - call handle_lost_particle(p) + call handle_lost_particle(p, "Could not locate particle " & + &// trim(to_str(p % id)) // " after crossing a lattice boundary.") return end if else @@ -764,9 +754,9 @@ contains ! Search for particle call find_cell(p, found) if (.not. found) then - message = "Could not locate particle " // trim(to_str(p % id)) // & - " after crossing a lattice boundary." - call handle_lost_particle(p) + call handle_lost_particle(p, "Could not locate particle " & + &// trim(to_str(p % id)) & + &// " after crossing a lattice boundary.") return end if end if @@ -1496,8 +1486,8 @@ contains type(Cell), pointer :: c type(Surface), pointer :: surf - message = "Building neighboring cells lists for each surface..." - call write_message(message, 4) + call write_message("Building neighboring cells lists for each surface...", & + &4) allocate(count_positive(n_surfaces)) allocate(count_negative(n_surfaces)) @@ -1564,9 +1554,10 @@ contains ! HANDLE_LOST_PARTICLE !=============================================================================== - subroutine handle_lost_particle(p) + subroutine handle_lost_particle(p, message) type(Particle), intent(inout) :: p + character(*) :: message ! Print warning and write lost particle file call warning(message) @@ -1581,8 +1572,7 @@ contains ! Abort the simulation if the maximum number of lost particles has been ! reached if (n_lost_particles == MAX_LOST_PARTICLES) then - message = "Maximum number of lost particles has been reached." - call fatal_error(message) + call fatal_error("Maximum number of lost particles has been reached.") end if end subroutine handle_lost_particle diff --git a/src/initialize.F90 b/src/initialize.F90 index dd3b284c20..e0a5bf8b0c 100644 --- a/src/initialize.F90 +++ b/src/initialize.F90 @@ -38,8 +38,6 @@ module initialize implicit none - character(2*MAX_LINE_LEN) :: message ! Message to output unit - contains !=============================================================================== @@ -158,10 +156,8 @@ contains ! Warn if overlap checking is on if (master .and. check_overlaps) then - message = "" - call write_message(message) - message = "Cell overlap checking is ON" - if (master) call warning(message) + call write_message("") + call warning("Cell overlap checking is ON") end if ! Stop initialization timer @@ -344,9 +340,8 @@ contains ! Check that number specified was valid if (n_particles == ERROR_INT) then - message = "Must specify integer after " // trim(argv(i-1)) // & - " command-line flag." - call fatal_error(message) + call fatal_error("Must specify integer after " // trim(argv(i-1)) & + &// " command-line flag.") end if case ('-r', '-restart', '--restart') ! Read path for state point/particle restart @@ -366,8 +361,7 @@ contains path_particle_restart = argv(i) particle_restart_run = .true. case default - message = "Unrecognized file after restart flag." - call fatal_error(message) + call fatal_error("Unrecognized file after restart flag.") end select ! If its a restart run check for additional source file @@ -385,8 +379,8 @@ contains call sp % read_data(filetype, 'filetype') call sp % file_close() if (filetype /= FILETYPE_SOURCE) then - message = "Second file after restart flag must be a source file" - call fatal_error(message) + call fatal_error("Second file after restart flag must be a & + &source file") end if ! It is a source file @@ -420,13 +414,13 @@ contains ! Read and set number of OpenMP threads n_threads = int(str_to_int(argv(i)), 4) if (n_threads < 1) then - message = "Invalid number of threads specified on command line." - call fatal_error(message) + call fatal_error("Invalid number of threads specified on command & + &line.") end if call omp_set_num_threads(n_threads) #else - message = "Ignoring number of threads specified on command line." - if (master) call warning(message) + if (master) call warning("Ignoring number of threads specified on & + &command line.") #endif case ('-?', '-h', '-help', '--help') @@ -442,8 +436,7 @@ contains write_all_tracks = .true. i = i + 1 case default - message = "Unknown command line option: " // argv(i) - call fatal_error(message) + call fatal_error("Unknown command line option: " // argv(i)) end select last_flag = i @@ -579,9 +572,8 @@ contains i_array = surface_dict % get_key(abs(id)) c % surfaces(j) = sign(i_array, id) else - message = "Could not find surface " // trim(to_str(abs(id))) // & - " specified on cell " // trim(to_str(c % id)) - call fatal_error(message) + call fatal_error("Could not find surface " // trim(to_str(abs(id)))& + &// " specified on cell " // trim(to_str(c % id))) end if end if end do @@ -593,9 +585,8 @@ contains if (universe_dict % has_key(id)) then c % universe = universe_dict % get_key(id) else - message = "Could not find universe " // trim(to_str(id)) // & - " specified on cell " // trim(to_str(c % id)) - call fatal_error(message) + call fatal_error("Could not find universe " // trim(to_str(id)) & + &// " specified on cell " // trim(to_str(c % id))) end if ! ======================================================================= @@ -609,9 +600,8 @@ contains c % type = CELL_NORMAL c % material = material_dict % get_key(id) else - message = "Could not find material " // trim(to_str(id)) // & - " specified on cell " // trim(to_str(c % id)) - call fatal_error(message) + call fatal_error("Could not find material " // trim(to_str(id)) & + &// " specified on cell " // trim(to_str(c % id))) end if else id = c % fill @@ -628,15 +618,14 @@ contains else if (material_dict % has_key(mid)) then c % material = material_dict % get_key(mid) else - message = "Could not find material " // trim(to_str(mid)) // & - " specified on lattice " // trim(to_str(lid)) - call fatal_error(message) + call fatal_error("Could not find material " // trim(to_str(mid)) & + &// " specified on lattice " // trim(to_str(lid))) end if else - message = "Specified fill " // trim(to_str(id)) // " on cell " // & - trim(to_str(c % id)) // " is neither a universe nor a lattice." - call fatal_error(message) + call fatal_error("Specified fill " // trim(to_str(id)) // " on cell "& + &// trim(to_str(c % id)) // " is neither a universe nor a & + &lattice.") end if end if end do @@ -661,9 +650,8 @@ contains if (universe_dict % has_key(id)) then lat % universes(j,k,m) = universe_dict % get_key(id) else - message = "Invalid universe number " // trim(to_str(id)) & - // " specified on lattice " // trim(to_str(lat % id)) - call fatal_error(message) + call fatal_error("Invalid universe number " // trim(to_str(id)) & + &// " specified on lattice " // trim(to_str(lat % id))) end if end do end do @@ -687,9 +675,8 @@ contains if (cell_dict % has_key(id)) then t % filters(j) % int_bins(k) = cell_dict % get_key(id) else - message = "Could not find cell " // trim(to_str(id)) // & - " specified on tally " // trim(to_str(t % id)) - call fatal_error(message) + call fatal_error("Could not find cell " // trim(to_str(id)) & + &// " specified on tally " // trim(to_str(t % id))) end if end do @@ -703,9 +690,8 @@ contains if (surface_dict % has_key(id)) then t % filters(j) % int_bins(k) = surface_dict % get_key(id) else - message = "Could not find surface " // trim(to_str(id)) // & - " specified on tally " // trim(to_str(t % id)) - call fatal_error(message) + call fatal_error("Could not find surface " // trim(to_str(id)) & + &// " specified on tally " // trim(to_str(t % id))) end if end do @@ -716,9 +702,8 @@ contains if (universe_dict % has_key(id)) then t % filters(j) % int_bins(k) = universe_dict % get_key(id) else - message = "Could not find universe " // trim(to_str(id)) // & - " specified on tally " // trim(to_str(t % id)) - call fatal_error(message) + call fatal_error("Could not find universe " // trim(to_str(id)) & + &// " specified on tally " // trim(to_str(t % id))) end if end do @@ -729,9 +714,8 @@ contains if (material_dict % has_key(id)) then t % filters(j) % int_bins(k) = material_dict % get_key(id) else - message = "Could not find material " // trim(to_str(id)) // & - " specified on tally " // trim(to_str(t % id)) - call fatal_error(message) + call fatal_error("Could not find material " // trim(to_str(id)) & + &// " specified on tally " // trim(to_str(t % id))) end if end do @@ -866,8 +850,7 @@ contains ! Check for allocation errors if (alloc_err /= 0) then - message = "Failed to allocate source bank." - call fatal_error(message) + call fatal_error("Failed to allocate source bank.") end if #ifdef _OPENMP @@ -894,8 +877,7 @@ contains ! Check for allocation errors if (alloc_err /= 0) then - message = "Failed to allocate fission bank." - call fatal_error(message) + call fatal_error("Failed to allocate fission bank.") end if end subroutine allocate_banks diff --git a/src/input_xml.F90 b/src/input_xml.F90 index 7025c4b89b..869f7752c7 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -22,7 +22,6 @@ module input_xml type(DictIntInt) :: cells_in_univ_dict ! Used to count how many cells each ! universe contains - character(2*MAX_LINE_LEN) :: message ! Message to output unit contains @@ -77,19 +76,17 @@ contains type(NodeList), pointer :: node_scat_list => null() ! Display output message - message = "Reading settings XML file..." - call write_message(message, 5) + call write_message("Reading settings XML file...", 5) ! Check if settings.xml exists filename = trim(path_input) // "settings.xml" inquire(FILE=filename, EXIST=file_exists) if (.not. file_exists) then - message = "Settings XML file '" // trim(filename) // "' does not exist! & - &In order to run OpenMC, you first need a set of input files; at a & - &minimum, this includes settings.xml, geometry.xml, and & + call fatal_error("Settings XML file '" // trim(filename) // "' does not & + &exist! In order to run OpenMC, you first need a set of input files;& + & at a minimum, this includes settings.xml, geometry.xml, and & &materials.xml. Please consult the user's guide at & - &http://mit-crpg.github.io/openmc for further information." - call fatal_error(message) + &http://mit-crpg.github.io/openmc for further information.") end if ! Parse settings.xml file @@ -105,13 +102,12 @@ contains ! environment variable call get_environment_variable("CROSS_SECTIONS", env_variable) if (len_trim(env_variable) == 0) then - message = "No cross_sections.xml file was specified in settings.xml & - &or in the CROSS_SECTIONS environment variable. OpenMC needs a & - &cross_sections.xml file to identify where to find ACE cross & - §ion libraries. Please consult the user's guide at & - &http://mit-crpg.github.io/openmc for information on how to set & - &up ACE cross section libraries." - call fatal_error(message) + call fatal_error("No cross_sections.xml file was specified in & + &settings.xml or in the CROSS_SECTIONS environment variable. & + &OpenMC needs a cross_sections.xml file to identify where to & + &find ACE cross section libraries. Please consult the user's & + &guide at http://mit-crpg.github.io/openmc for information on & + &how to set up ACE cross section libraries.") else path_cross_sections = trim(env_variable) end if @@ -131,8 +127,7 @@ contains ! Make sure that either eigenvalue or fixed source was specified if (.not.check_for_node(doc, "eigenvalue") .and. & .not.check_for_node(doc, "fixed_source")) then - message = " or not specified." - call fatal_error(message) + call fatal_error(" or not specified.") end if ! Eigenvalue information @@ -145,8 +140,7 @@ contains ! Check number of particles if (.not.check_for_node(node_mode, "particles")) then - message = "Need to specify number of particles per generation." - call fatal_error(message) + call fatal_error("Need to specify number of particles per generation.") end if ! Get number of particles @@ -180,8 +174,7 @@ contains ! Check number of particles if (.not.check_for_node(node_mode, "particles")) then - message = "Need to specify number of particles per batch." - call fatal_error(message) + call fatal_error("Need to specify number of particles per batch.") end if ! Get number of particles @@ -200,14 +193,11 @@ contains ! Check number of active batches, inactive batches, and particles if (n_active <= 0) then - message = "Number of active batches must be greater than zero." - call fatal_error(message) + call fatal_error("Number of active batches must be greater than zero.") elseif (n_inactive < 0) then - message = "Number of inactive batches must be non-negative." - call fatal_error(message) + call fatal_error("Number of inactive batches must be non-negative.") elseif (n_particles <= 0) then - message = "Number of particles must be greater than zero." - call fatal_error(message) + call fatal_error("Number of particles must be greater than zero.") end if ! Copy random number seed if specified @@ -225,11 +215,9 @@ contains case ('union') grid_method = GRID_UNION case ('lethargy') - message = "Lethargy mapped energy grid not yet supported." - call fatal_error(message) + call fatal_error("Lethargy mapped energy grid not yet supported.") case default - message = "Unknown energy grid method: " // trim(temp_str) - call fatal_error(message) + call fatal_error("Unknown energy grid method: " // trim(temp_str)) end select ! Verbosity @@ -244,14 +232,12 @@ contains if (n_threads == NONE) then call get_node_value(doc, "threads", n_threads) if (n_threads < 1) then - message = "Invalid number of threads: " // to_str(n_threads) - call fatal_error(message) + call fatal_error("Invalid number of threads: " // to_str(n_threads)) end if call omp_set_num_threads(n_threads) end if #else - message = "Ignoring number of threads." - if (master) call warning(message) + if (master) call warning("Ignoring number of threads.") #endif end if @@ -262,8 +248,7 @@ contains if (check_for_node(doc, "source")) then call get_node_ptr(doc, "source", node_source) else - message = "No source specified in settings XML file." - call fatal_error(message) + call fatal_error("No source specified in settings XML file.") end if ! Check if we want to write out source @@ -282,9 +267,8 @@ contains ! Check if source file exists inquire(FILE=path_source, EXIST=file_exists) if (.not. file_exists) then - message = "Binary source file '" // trim(path_source) // & - "' does not exist!" - call fatal_error(message) + call fatal_error("Binary source file '" // trim(path_source) & + &// "' does not exist!") end if else @@ -310,9 +294,8 @@ contains external_source % type_space = SRC_SPACE_POINT coeffs_reqd = 3 case default - message = "Invalid spatial distribution for external source: " & - // trim(type) - call fatal_error(message) + call fatal_error("Invalid spatial distribution for external source: "& + &// trim(type)) end select ! Determine number of parameters specified @@ -324,21 +307,19 @@ contains ! Read parameters for spatial distribution if (n < coeffs_reqd) then - message = "Not enough parameters specified for spatial & - &distribution of external source." - call fatal_error(message) + call fatal_error("Not enough parameters specified for spatial & + &distribution of external source.") elseif (n > coeffs_reqd) then - message = "Too many parameters specified for spatial & - &distribution of external source." - call fatal_error(message) + call fatal_error("Too many parameters specified for spatial & + &distribution of external source.") elseif (n > 0) then allocate(external_source % params_space(n)) call get_node_array(node_dist, "parameters", & external_source % params_space) end if else - message = "No spatial distribution specified for external source." - call fatal_error(message) + call fatal_error("No spatial distribution specified for external & + &source.") end if ! Determine external source angular distribution @@ -361,9 +342,8 @@ contains case ('tabular') external_source % type_angle = SRC_ANGLE_TABULAR case default - message = "Invalid angular distribution for external source: " & - // trim(type) - call fatal_error(message) + call fatal_error("Invalid angular distribution for external source: "& + &// trim(type)) end select ! Determine number of parameters specified @@ -375,13 +355,11 @@ contains ! Read parameters for angle distribution if (n < coeffs_reqd) then - message = "Not enough parameters specified for angle & - &distribution of external source." - call fatal_error(message) + call fatal_error("Not enough parameters specified for angle & + &distribution of external source.") elseif (n > coeffs_reqd) then - message = "Too many parameters specified for angle & - &distribution of external source." - call fatal_error(message) + call fatal_error("Too many parameters specified for angle & + &distribution of external source.") elseif (n > 0) then allocate(external_source % params_angle(n)) call get_node_array(node_dist, "parameters", & @@ -415,9 +393,8 @@ contains case ('tabular') external_source % type_energy = SRC_ENERGY_TABULAR case default - message = "Invalid energy distribution for external source: " & - // trim(type) - call fatal_error(message) + call fatal_error("Invalid energy distribution for external source: " & + &// trim(type)) end select ! Determine number of parameters specified @@ -429,13 +406,11 @@ contains ! Read parameters for energy distribution if (n < coeffs_reqd) then - message = "Not enough parameters specified for energy & - &distribution of external source." - call fatal_error(message) + call fatal_error("Not enough parameters specified for energy & + &distribution of external source.") elseif (n > coeffs_reqd) then - message = "Too many parameters specified for energy & - &distribution of external source." - call fatal_error(message) + call fatal_error("Too many parameters specified for energy & + &distribution of external source.") elseif (n > 0) then allocate(external_source % params_energy(n)) call get_node_array(node_dist, "parameters", & @@ -485,9 +460,9 @@ contains ! Make sure that there are three values per particle n_tracks = get_arraysize_integer(doc, "track") if (mod(n_tracks, 3) /= 0) then - message = "Number of integers specified in 'track' is not divisible & - &by 3. Please provide 3 integers per particle to be tracked." - call fatal_error(message) + call fatal_error("Number of integers specified in 'track' is not & + &divisible by 3. Please provide 3 integers per particle to be & + &tracked.") end if ! Allocate space and get list of tracks @@ -507,11 +482,11 @@ contains ! Check to make sure enough values were supplied if (get_arraysize_double(node_entropy, "lower_left") /= 3) then - message = "Need to specify (x,y,z) coordinates of lower-left corner & - &of Shannon entropy mesh." + call fatal_error("Need to specify (x,y,z) coordinates of lower-left & + &corner of Shannon entropy mesh.") elseif (get_arraysize_double(node_entropy, "upper_right") /= 3) then - message = "Need to specify (x,y,z) coordinates of upper-right corner & - &of Shannon entropy mesh." + call fatal_error("Need to specify (x,y,z) coordinates of upper-right & + &corner of Shannon entropy mesh.") end if ! Allocate mesh object and coordinates on mesh @@ -527,10 +502,10 @@ contains entropy_mesh % upper_right) ! Check on values provided - if (.not. all(entropy_mesh % upper_right > entropy_mesh % lower_left)) then - message = "Upper-right coordinate must be greater than lower-left & - &coordinate for Shannon entropy mesh." - call fatal_error(message) + if (.not. all(entropy_mesh % upper_right > entropy_mesh % lower_left)) & + &then + call fatal_error("Upper-right coordinate must be greater than & + &lower-left coordinate for Shannon entropy mesh.") end if ! Check if dimensions were specified -- if not, they will be calculated @@ -539,9 +514,8 @@ contains ! If so, make sure proper number of values were given if (get_arraysize_integer(node_entropy, "dimension") /= 3) then - message = "Dimension of entropy mesh must be given as three & - &integers." - call fatal_error(message) + call fatal_error("Dimension of entropy mesh must be given as three & + &integers.") end if ! Allocate dimensions @@ -569,14 +543,14 @@ contains ! Check to make sure enough values were supplied if (get_arraysize_double(node_ufs, "lower_left") /= 3) then - message = "Need to specify (x,y,z) coordinates of lower-left corner & - &of UFS mesh." + call fatal_error("Need to specify (x,y,z) coordinates of lower-left & + &corner of UFS mesh.") elseif (get_arraysize_double(node_ufs, "upper_right") /= 3) then - message = "Need to specify (x,y,z) coordinates of upper-right corner & - &of UFS mesh." + call fatal_error("Need to specify (x,y,z) coordinates of upper-right & + &corner of UFS mesh.") elseif (get_arraysize_integer(node_ufs, "dimension") /= 3) then - message = "Dimension of UFS mesh must be given as three integers." - call fatal_error(message) + call fatal_error("Dimension of UFS mesh must be given as three & + &integers.") end if ! Allocate mesh object and coordinates on mesh @@ -598,9 +572,8 @@ contains ! Check on values provided if (.not. all(ufs_mesh % upper_right > ufs_mesh % lower_left)) then - message = "Upper-right coordinate must be greater than lower-left & - &coordinate for UFS mesh." - call fatal_error(message) + call fatal_error("Upper-right coordinate must be greater than & + &lower-left coordinate for UFS mesh.") end if ! Calculate width @@ -733,9 +706,8 @@ contains do i = 1, n_source_points if (.not. statepoint_batch % contains(sourcepoint_batch % & get_item(i))) then - message = 'Sourcepoint batches are not a subset& - & of statepoint batches.' - call fatal_error(message) + call fatal_error('Sourcepoint batches are not a subset& + & of statepoint batches.') end if end do end if @@ -815,9 +787,8 @@ contains ! check to make sure a nuclide is specified if (.not. check_for_node(node_scatterer, "nuclide")) then - message = "No nuclide specified for scatterer " // trim(to_str(i)) & - // " in settings.xml file!" - call fatal_error(message) + call fatal_error("No nuclide specified for scatterer " & + &// trim(to_str(i)) // " in settings.xml file!") end if call get_node_value(node_scatterer, "nuclide", & nuclides_0K(i) % nuclide) @@ -829,18 +800,17 @@ contains ! check to make sure xs name for which method is applied is given if (.not. check_for_node(node_scatterer, "xs_label")) then - message = "Must specify the temperature dependent name of " // '' & - //"scatterer " // trim(to_str(i)) // " given in cross_sections.xml" - call fatal_error(message) + call fatal_error("Must specify the temperature dependent name of & + &scatterer " // trim(to_str(i)) & + &// " given in cross_sections.xml") end if call get_node_value(node_scatterer, "xs_label", & nuclides_0K(i) % name) ! check to make sure 0K xs name for which method is applied is given if (.not. check_for_node(node_scatterer, "xs_label_0K")) then - message = "Must specify the 0K name of " // '' & - //"scatterer "// trim(to_str(i)) // " given in cross_sections.xml" - call fatal_error(message) + call fatal_error("Must specify the 0K name of scatterer " & + &// trim(to_str(i)) // " given in cross_sections.xml") end if call get_node_value(node_scatterer, "xs_label_0K", & nuclides_0K(i) % name_0K) @@ -852,8 +822,8 @@ contains ! check that E_min is non-negative if (nuclides_0K(i) % E_min < ZERO) then - message = "Lower resonance scattering energy bound is negative" - call fatal_error(message) + call fatal_error("Lower resonance scattering energy bound is & + &negative") end if if (check_for_node(node_scatterer, "E_max")) then @@ -863,8 +833,8 @@ contains ! check that E_max is not less than E_min if (nuclides_0K(i) % E_max < nuclides_0K(i) % E_min) then - message = "Lower resonance scattering energy bound exceeds upper" - call fatal_error(message) + call fatal_error("Lower resonance scattering energy bound exceeds & + &upper") end if nuclides_0K(i) % nuclide = trim(nuclides_0K(i) % nuclide) @@ -873,9 +843,8 @@ contains nuclides_0K(i) % name_0K = trim(nuclides_0K(i) % name_0K) end do else - message = "No resonant scatterers are specified within the " // "" & - // "resonance_scattering element in settings.xml" - call fatal_error(message) + call fatal_error("No resonant scatterers are specified within the & + &resonance_scattering element in settings.xml") end if end if @@ -900,8 +869,8 @@ contains case ('jendl-4.0') default_expand = JENDL_40 case default - message = "Unknown natural element expansion option: " // trim(temp_str) - call fatal_error(message) + call fatal_error("Unknown natural element expansion option: " & + &// trim(temp_str)) end select end if @@ -943,8 +912,7 @@ contains type(NodeList), pointer :: node_lat_list => null() ! Display output message - message = "Reading geometry XML file..." - call write_message(message, 5) + call write_message("Reading geometry XML file...", 5) ! ========================================================================== ! READ CELLS FROM GEOMETRY.XML @@ -953,8 +921,8 @@ contains filename = trim(path_input) // "geometry.xml" inquire(FILE=filename, EXIST=file_exists) if (.not. file_exists) then - message = "Geometry XML file '" // trim(filename) // "' does not exist!" - call fatal_error(message) + call fatal_error("Geometry XML file '" // trim(filename) // "' does not & + &exist!") end if ! Parse geometry.xml file @@ -968,8 +936,7 @@ contains ! Check for no cells if (n_cells == 0) then - message = "No cells found in geometry.xml!" - call fatal_error(message) + call fatal_error("No cells found in geometry.xml!") end if ! Allocate cells array @@ -991,8 +958,7 @@ contains if (check_for_node(node_cell, "id")) then call get_node_value(node_cell, "id", c % id) else - message = "Must specify id of cell in geometry XML file." - call fatal_error(message) + call fatal_error("Must specify id of cell in geometry XML file.") end if if (check_for_node(node_cell, "universe")) then call get_node_value(node_cell, "universe", c % universe) @@ -1007,8 +973,8 @@ contains ! Check to make sure 'id' hasn't been used if (cell_dict % has_key(c % id)) then - message = "Two or more cells use the same unique ID: " // to_str(c % id) - call fatal_error(message) + call fatal_error("Two or more cells use the same unique ID: " & + &// to_str(c % id)) end if ! Read material @@ -1028,30 +994,27 @@ contains ! Check for error if (c % material == ERROR_INT) then - message = "Invalid material specified on cell " // to_str(c % id) - call fatal_error(message) + call fatal_error("Invalid material specified on cell " & + &// to_str(c % id)) end if end select ! Check to make sure that either material or fill was specified if (c % material == NONE .and. c % fill == NONE) then - message = "Neither material nor fill was specified for cell " // & - trim(to_str(c % id)) - call fatal_error(message) + call fatal_error("Neither material nor fill was specified for cell " & + &// trim(to_str(c % id))) end if ! Check to make sure that both material and fill haven't been ! specified simultaneously if (c % material /= NONE .and. c % fill /= NONE) then - message = "Cannot specify material and fill simultaneously" - call fatal_error(message) + call fatal_error("Cannot specify material and fill simultaneously") end if ! Check to make sure that surfaces were specified if (.not. check_for_node(node_cell, "surfaces")) then - message = "No surfaces specified for cell " // & - trim(to_str(c % id)) - call fatal_error(message) + call fatal_error("No surfaces specified for cell " & + &// trim(to_str(c % id))) end if ! Allocate array for surfaces and copy @@ -1065,17 +1028,15 @@ contains ! Rotations can only be applied to cells that are being filled with ! another universe if (c % fill == NONE) then - message = "Cannot apply a rotation to cell " // trim(to_str(& - c % id)) // " because it is not filled with another universe" - call fatal_error(message) + call fatal_error("Cannot apply a rotation to cell " // trim(to_str(& + &c % id)) // " because it is not filled with another universe") end if ! Read number of rotation parameters n = get_arraysize_double(node_cell, "rotation") if (n /= 3) then - message = "Incorrect number of rotation parameters on cell " // & - to_str(c % id) - call fatal_error(message) + call fatal_error("Incorrect number of rotation parameters on cell " & + &// to_str(c % id)) end if ! Copy rotation angles in x,y,z directions @@ -1101,17 +1062,16 @@ contains ! Translations can only be applied to cells that are being filled with ! another universe if (c % fill == NONE) then - message = "Cannot apply a translation to cell " // trim(to_str(& - c % id)) // " because it is not filled with another universe" - call fatal_error(message) + call fatal_error("Cannot apply a translation to cell " & + &// trim(to_str(c % id)) // " because it is not filled with & + &another universe") end if ! Read number of translation parameters n = get_arraysize_double(node_cell, "translation") if (n /= 3) then - message = "Incorrect number of translation parameters on cell " & - // to_str(c % id) - call fatal_error(message) + call fatal_error("Incorrect number of translation parameters on & + &cell " // to_str(c % id)) end if ! Copy translation vector @@ -1152,8 +1112,7 @@ contains ! Check for no surfaces if (n_surfaces == 0) then - message = "No surfaces found in geometry.xml!" - call fatal_error(message) + call fatal_error("No surfaces found in geometry.xml!") end if ! Allocate cells array @@ -1169,15 +1128,13 @@ contains if (check_for_node(node_surf, "id")) then call get_node_value(node_surf, "id", s % id) else - message = "Must specify id of surface in geometry XML file." - call fatal_error(message) + call fatal_error("Must specify id of surface in geometry XML file.") end if ! Check to make sure 'id' hasn't been used if (surface_dict % has_key(s % id)) then - message = "Two or more surfaces use the same unique ID: " // & - to_str(s % id) - call fatal_error(message) + call fatal_error("Two or more surfaces use the same unique ID: " & + &// to_str(s % id)) end if ! Copy and interpret surface type @@ -1219,8 +1176,7 @@ contains s % type = SURF_CONE_Z coeffs_reqd = 4 case default - message = "Invalid surface type: " // trim(word) - call fatal_error(message) + call fatal_error("Invalid surface type: " // trim(word)) end select ! Check to make sure that the proper number of coefficients @@ -1229,13 +1185,11 @@ contains n = get_arraysize_double(node_surf, "coeffs") if (n < coeffs_reqd) then - message = "Not enough coefficients specified for surface: " // & - trim(to_str(s % id)) - call fatal_error(message) + call fatal_error("Not enough coefficients specified for surface: " & + &// trim(to_str(s % id))) elseif (n > coeffs_reqd) then - message = "Too many coefficients specified for surface: " // & - trim(to_str(s % id)) - call fatal_error(message) + call fatal_error("Too many coefficients specified for surface: " & + &// trim(to_str(s % id))) else allocate(s % coeffs(n)) call get_node_array(node_surf, "coeffs", s % coeffs) @@ -1255,9 +1209,8 @@ contains s % bc = BC_REFLECT boundary_exists = .true. case default - message = "Unknown boundary condition '" // trim(word) // & - "' specified on surface " // trim(to_str(s % id)) - call fatal_error(message) + call fatal_error("Unknown boundary condition '" // trim(word) // & + &"' specified on surface " // trim(to_str(s % id))) end select ! Add surface to dictionary @@ -1268,8 +1221,7 @@ contains ! Check to make sure a boundary condition was applied to at least one ! surface if (.not. boundary_exists) then - message = "No boundary conditions were applied to any surfaces!" - call fatal_error(message) + call fatal_error("No boundary conditions were applied to any surfaces!") end if ! ========================================================================== @@ -1292,15 +1244,13 @@ contains if (check_for_node(node_lat, "id")) then call get_node_value(node_lat, "id", lat % id) else - message = "Must specify id of lattice in geometry XML file." - call fatal_error(message) + call fatal_error("Must specify id of lattice in geometry XML file.") end if ! Check to make sure 'id' hasn't been used if (lattice_dict % has_key(lat % id)) then - message = "Two or more lattices use the same unique ID: " // & - to_str(lat % id) - call fatal_error(message) + call fatal_error("Two or more lattices use the same unique ID: " & + &// to_str(lat % id)) end if ! Read lattice type @@ -1313,15 +1263,13 @@ contains case ('hex', 'hexagon', 'hexagonal') lat % type = LATTICE_HEX case default - message = "Invalid lattice type: " // trim(word) - call fatal_error(message) + call fatal_error("Invalid lattice type: " // trim(word)) end select ! Read number of lattice cells in each dimension n = get_arraysize_integer(node_lat, "dimension") if (n /= 2 .and. n /= 3) then - message = "Lattice must be two or three dimensions." - call fatal_error(message) + call fatal_error("Lattice must be two or three dimensions.") end if lat % n_dimension = n @@ -1331,9 +1279,8 @@ contains ! Read lattice lower-left location if (size(lat % dimension) /= & get_arraysize_double(node_lat, "lower_left")) then - message = "Number of entries on must be the same as & - &the number of entries on ." - call fatal_error(message) + call fatal_error("Number of entries on must be the same & + &as the number of entries on .") end if allocate(lat % lower_left(n)) @@ -1342,9 +1289,8 @@ contains ! Read lattice widths if (size(lat % dimension) /= & get_arraysize_double(node_lat, "width")) then - message = "Number of entries on must be the same as & - &the number of entries on ." - call fatal_error(message) + call fatal_error("Number of entries on must be the same as & + &the number of entries on .") end if allocate(lat % width(n)) @@ -1363,9 +1309,8 @@ contains ! Check that number of universes matches size n = get_arraysize_integer(node_lat, "universes") if (n /= n_x*n_y*n_z) then - message = "Number of universes on does not match size of & - &lattice " // trim(to_str(lat % id)) // "." - call fatal_error(message) + call fatal_error("Number of universes on does not match & + &size of lattice " // trim(to_str(lat % id)) // ".") end if allocate(temp_int_array(n)) @@ -1441,15 +1386,14 @@ contains type(NodeList), pointer :: node_sab_list => null() ! Display output message - message = "Reading materials XML file..." - call write_message(message, 5) + call write_message("Reading materials XML file...", 5) ! Check is materials.xml exists filename = trim(path_input) // "materials.xml" inquire(FILE=filename, EXIST=file_exists) if (.not. file_exists) then - message = "Material XML file '" // trim(filename) // "' does not exist!" - call fatal_error(message) + call fatal_error("Material XML file '" // trim(filename) // "' does not & + &exist!") end if ! Initialize default cross section variable @@ -1483,15 +1427,13 @@ contains if (check_for_node(node_mat, "id")) then call get_node_value(node_mat, "id", mat % id) else - message = "Must specify id of material in materials XML file" - call fatal_error(message) + call fatal_error("Must specify id of material in materials XML file") end if ! Check to make sure 'id' hasn't been used if (material_dict % has_key(mat % id)) then - message = "Two or more materials use the same unique ID: " // & - to_str(mat % id) - call fatal_error(message) + call fatal_error("Two or more materials use the same unique ID: " & + &// to_str(mat % id)) end if if (run_mode == MODE_PLOTTING) then @@ -1507,9 +1449,8 @@ contains if (check_for_node(node_mat, "density")) then call get_node_ptr(node_mat, "density", node_dens) else - message = "Must specify density element in material " // & - trim(to_str(mat % id)) - call fatal_error(message) + call fatal_error("Must specify density element in material " & + &// trim(to_str(mat % id))) end if ! Initialize value to zero @@ -1532,9 +1473,8 @@ contains ! Check for erroneous density sum_density = .false. if (val <= ZERO) then - message = "Need to specify a positive density on material " // & - trim(to_str(mat % id)) // "." - call fatal_error(message) + call fatal_error("Need to specify a positive density on material " & + &// trim(to_str(mat % id)) // ".") end if ! Adjust material density based on specified units @@ -1548,9 +1488,8 @@ contains case ('atom/cm3', 'atom/cc') mat % density = 1.0e-24 * val case default - message = "Unkwown units '" // trim(units) & - // "' specified on material " // trim(to_str(mat % id)) - call fatal_error(message) + call fatal_error("Unkwown units '" // trim(units) & + &// "' specified on material " // trim(to_str(mat % id))) end select end if @@ -1560,9 +1499,8 @@ contains ! Check to ensure material has at least one nuclide if (.not. check_for_node(node_mat, "nuclide") .and. & .not. check_for_node(node_mat, "element")) then - message = "No nuclides or natural elements specified on material " // & - trim(to_str(mat % id)) - call fatal_error(message) + call fatal_error("No nuclides or natural elements specified on & + &material " // trim(to_str(mat % id))) end if ! Get pointer list of XML @@ -1575,17 +1513,15 @@ contains ! Check for empty name on nuclide if (.not.check_for_node(node_nuc, "name")) then - message = "No name specified on nuclide in material " // & - trim(to_str(mat % id)) - call fatal_error(message) + call fatal_error("No name specified on nuclide in material " & + &// trim(to_str(mat % id))) end if ! Check for cross section if (.not.check_for_node(node_nuc, "xs")) then if (default_xs == '') then - message = "No cross section specified for nuclide in material " & - // trim(to_str(mat % id)) - call fatal_error(message) + call fatal_error("No cross section specified for nuclide in & + &material " // trim(to_str(mat % id))) else name = trim(default_xs) end if @@ -1604,14 +1540,12 @@ contains ! weight percents were specified if (.not.check_for_node(node_nuc, "ao") .and. & .not.check_for_node(node_nuc, "wo")) then - message = "No atom or weight percent specified for nuclide " // & - trim(name) - call fatal_error(message) + call fatal_error("No atom or weight percent specified for nuclide " & + &// trim(name)) elseif (check_for_node(node_nuc, "ao") .and. & check_for_node(node_nuc, "wo")) then - message = "Cannot specify both atom and weight percents for a & - &nuclide: " // trim(name) - call fatal_error(message) + call fatal_error("Cannot specify both atom and weight percents for a & + &nuclide: " // trim(name)) end if ! Copy atom/weight percents @@ -1635,9 +1569,8 @@ contains ! Check for empty name on natural element if (.not.check_for_node(node_ele, "name")) then - message = "No name specified on nuclide in material " // & - trim(to_str(mat % id)) - call fatal_error(message) + call fatal_error("No name specified on nuclide in material " & + &// trim(to_str(mat % id))) end if call get_node_value(node_ele, "name", name) @@ -1646,9 +1579,8 @@ contains call get_node_value(node_ele, "xs", temp_str) else if (default_xs == '') then - message = "No cross section specified for nuclide in material " & - // trim(to_str(mat % id)) - call fatal_error(message) + call fatal_error("No cross section specified for nuclide in & + &material " // trim(to_str(mat % id))) else temp_str = trim(default_xs) end if @@ -1658,14 +1590,12 @@ contains ! weight percents were specified if (.not.check_for_node(node_ele, "ao") .and. & .not.check_for_node(node_ele, "wo")) then - message = "No atom or weight percent specified for element " // & - trim(name) - call fatal_error(message) + call fatal_error("No atom or weight percent specified for element " & + &// trim(name)) elseif (check_for_node(node_ele, "ao") .and. & check_for_node(node_ele, "wo")) then - message = "Cannot specify both atom and weight percents for a & - &element: " // trim(name) - call fatal_error(message) + call fatal_error("Cannot specify both atom and weight percents for & + &element: " // trim(name)) end if ! Expand element into naturally-occurring isotopes @@ -1674,9 +1604,8 @@ contains call expand_natural_element(name, temp_str, temp_dble, & list_names, list_density) else - message = "The ability to expand a natural element based on weight & - &percentage is not yet supported." - call fatal_error(message) + call fatal_error("The ability to expand a natural element based on & + &weight percentage is not yet supported.") end if end do NATURAL_ELEMENTS @@ -1694,17 +1623,15 @@ contains ! Check that this nuclide is listed in the cross_sections.xml file name = trim(list_names % get_item(j)) if (.not. xs_listing_dict % has_key(to_lower(name))) then - message = "Could not find nuclide " // trim(name) // & - " in cross_sections.xml file!" - call fatal_error(message) + call fatal_error("Could not find nuclide " // trim(name) & + &// " in cross_sections.xml file!") end if ! Check to make sure cross-section is continuous energy neutron table n = len_trim(name) if (name(n:n) /= 'c') then - message = "Cross-section table " // trim(name) // & - " is not a continuous-energy neutron table." - call fatal_error(message) + call fatal_error("Cross-section table " // trim(name) & + &// " is not a continuous-energy neutron table.") end if ! Find xs_listing and set the name/alias according to the listing @@ -1733,9 +1660,8 @@ contains ! given if (.not. (all(mat % atom_density >= ZERO) .or. & all(mat % atom_density <= ZERO))) then - message = "Cannot mix atom and weight percents in material " // & - to_str(mat % id) - call fatal_error(message) + call fatal_error("Cannot mix atom and weight percents in material " & + &// to_str(mat % id)) end if ! Determine density if it is a sum value @@ -1771,8 +1697,8 @@ contains ! Determine name of S(a,b) table if (.not.check_for_node(node_sab, "name") .or. & .not.check_for_node(node_sab, "xs")) then - message = "Need to specify and for S(a,b) table." - call fatal_error(message) + call fatal_error("Need to specify and for S(a,b) & + &table.") end if call get_node_value(node_sab, "name", name) call get_node_value(node_sab, "xs", temp_str) @@ -1781,9 +1707,8 @@ contains ! Check that this nuclide is listed in the cross_sections.xml file if (.not. xs_listing_dict % has_key(to_lower(name))) then - message = "Could not find S(a,b) table " // trim(name) // & - " in cross_sections.xml file!" - call fatal_error(message) + call fatal_error("Could not find S(a,b) table " // trim(name) & + &// " in cross_sections.xml file!") end if ! Find index in xs_listing and set the name and alias according to the @@ -1868,8 +1793,7 @@ contains end if ! Display output message - message = "Reading tallies XML file..." - call write_message(message, 5) + call write_message("Reading tallies XML file...", 5) ! Parse tallies.xml file call open_xmldoc(doc, filename) @@ -1897,8 +1821,7 @@ contains ! Check for user tallies n_user_tallies = get_list_size(node_tal_list) if (n_user_tallies == 0) then - message = "No tallies present in tallies.xml file!" - if (master) call warning(message) + if (master) call warning("No tallies present in tallies.xml file!") end if ! Allocate tally array @@ -1927,15 +1850,13 @@ contains if (check_for_node(node_mesh, "id")) then call get_node_value(node_mesh, "id", m % id) else - message = "Must specify id for mesh in tally XML file." - call fatal_error(message) + call fatal_error("Must specify id for mesh in tally XML file.") end if ! Check to make sure 'id' hasn't been used if (mesh_dict % has_key(m % id)) then - message = "Two or more meshes use the same unique ID: " // & - to_str(m % id) - call fatal_error(message) + call fatal_error("Two or more meshes use the same unique ID: " & + &// to_str(m % id)) end if ! Read mesh type @@ -1948,15 +1869,13 @@ contains case ('hex', 'hexagon', 'hexagonal') m % type = LATTICE_HEX case default - message = "Invalid mesh type: " // trim(temp_str) - call fatal_error(message) + call fatal_error("Invalid mesh type: " // trim(temp_str)) end select ! Determine number of dimensions for mesh n = get_arraysize_integer(node_mesh, "dimension") if (n /= 2 .and. n /= 3) then - message = "Mesh must be two or three dimensions." - call fatal_error(message) + call fatal_error("Mesh must be two or three dimensions.") end if m % n_dimension = n @@ -1969,9 +1888,8 @@ contains ! Check that dimensions are all greater than zero call get_node_array(node_mesh, "dimension", iarray3(1:n)) if (any(iarray3(1:n) <= 0)) then - message = "All entries on the element for a tally mesh & - &must be positive." - call fatal_error(message) + call fatal_error("All entries on the element for a tally & + &mesh must be positive.") end if ! Read dimensions in each direction @@ -1979,42 +1897,37 @@ contains ! Read mesh lower-left corner location if (m % n_dimension /= get_arraysize_double(node_mesh, "lower_left")) then - message = "Number of entries on must be the same as & - &the number of entries on ." - call fatal_error(message) + call fatal_error("Number of entries on must be the same & + &as the number of entries on .") end if call get_node_array(node_mesh, "lower_left", m % lower_left) ! Make sure both upper-right or width were specified if (check_for_node(node_mesh, "upper_right") .and. & check_for_node(node_mesh, "width")) then - message = "Cannot specify both and on a & - &tally mesh." - call fatal_error(message) + call fatal_error("Cannot specify both and on a & + &tally mesh.") end if ! Make sure either upper-right or width was specified if (.not.check_for_node(node_mesh, "upper_right") .and. & .not.check_for_node(node_mesh, "width")) then - message = "Must specify either and on a & - &tally mesh." - call fatal_error(message) + call fatal_error("Must specify either and on a & + &tally mesh.") end if if (check_for_node(node_mesh, "width")) then ! Check to ensure width has same dimensions if (get_arraysize_double(node_mesh, "width") /= & get_arraysize_double(node_mesh, "lower_left")) then - message = "Number of entries on must be the same as the & - &number of entries on ." - call fatal_error(message) + call fatal_error("Number of entries on must be the same as & + &the number of entries on .") end if ! Check for negative widths call get_node_array(node_mesh, "width", rarray3(1:n)) if (any(rarray3(1:n) < ZERO)) then - message = "Cannot have a negative on a tally mesh." - call fatal_error(message) + call fatal_error("Cannot have a negative on a tally mesh.") end if ! Set width and upper right coordinate @@ -2025,17 +1938,15 @@ contains ! Check to ensure width has same dimensions if (get_arraysize_double(node_mesh, "upper_right") /= & get_arraysize_double(node_mesh, "lower_left")) then - message = "Number of entries on must be the same as & - &the number of entries on ." - call fatal_error(message) + call fatal_error("Number of entries on must be the & + &same as the number of entries on .") end if ! Check that upper-right is above lower-left call get_node_array(node_mesh, "upper_right", rarray3(1:n)) if (any(rarray3(1:n) < m % lower_left)) then - message = "The coordinates must be greater than the & - & coordinates on a tally mesh." - call fatal_error(message) + call fatal_error("The coordinates must be greater than & + &the coordinates on a tally mesh.") end if ! Set width and upper right coordinate @@ -2078,15 +1989,13 @@ contains if (check_for_node(node_tal, "id")) then call get_node_value(node_tal, "id", t % id) else - message = "Must specify id for tally in tally XML file." - call fatal_error(message) + call fatal_error("Must specify id for tally in tally XML file.") end if ! Check to make sure 'id' hasn't been used if (tally_dict % has_key(t % id)) then - message = "Two or more tallies use the same unique ID: " // & - to_str(t % id) - call fatal_error(message) + call fatal_error("Two or more tallies use the same unique ID: " & + &// to_str(t % id)) end if ! Copy tally label @@ -2102,9 +2011,9 @@ contains ! the old format and if it is present, raises an error ! if (get_number_nodes(node_tal, "filters") > 0) then -! message = "Tally filters should be specified with multiple & -! &elements. Did you forget to change your element?" -! call fatal_error(message) +! call fatal_error("Tally filters should be specified with multiple & +! & elements. Did you forget to change your & +! &element?") ! end if ! Get pointer list to XML and get number of filters @@ -2136,8 +2045,8 @@ contains n_words = get_arraysize_integer(node_filt, "bins") end if else - message = "Bins not set in filter on tally " // trim(to_str(t % id)) - call fatal_error(message) + call fatal_error("Bins not set in filter on tally " & + &// trim(to_str(t % id))) end if ! Determine type of filter @@ -2187,8 +2096,7 @@ contains call get_node_array(node_filt, "bins", t % filters(j) % int_bins) case ('surface') - message = "Surface filter is not yet supported!" - call fatal_error(message) + call fatal_error("Surface filter is not yet supported!") ! Set type of filter t % filters(j) % type = FILTER_SURFACE @@ -2206,8 +2114,7 @@ contains ! Check to make sure multiple meshes weren't given if (n_words /= 1) then - message = "Can only have one mesh filter specified." - call fatal_error(message) + call fatal_error("Can only have one mesh filter specified.") end if ! Determine id of mesh @@ -2218,9 +2125,8 @@ contains i_mesh = mesh_dict % get_key(id) m => meshes(i_mesh) else - message = "Could not find mesh " // trim(to_str(id)) // & - " specified on tally " // trim(to_str(t % id)) - call fatal_error(message) + call fatal_error("Could not find mesh " // trim(to_str(id)) & + &// " specified on tally " // trim(to_str(t % id))) end if ! Determine number of bins -- this is assuming that the tally is @@ -2259,10 +2165,9 @@ contains case default ! Specified tally filter is invalid, raise error - message = "Unknown filter type '" // & - trim(temp_str) // "' on tally " // & - trim(to_str(t % id)) // "." - call fatal_error(message) + call fatal_error("Unknown filter type '" & + &// trim(temp_str) // "' on tally " & + &// trim(to_str(t % id)) // ".") end select @@ -2276,9 +2181,8 @@ contains ! Check that both cell and surface weren't specified if (t % find_filter(FILTER_CELL) > 0 .and. & t % find_filter(FILTER_SURFACE) > 0) then - message = "Cannot specify both cell and surface filters for tally " & - // trim(to_str(t % id)) - call fatal_error(message) + call fatal_error("Cannot specify both cell and surface filters for & + &tally " // trim(to_str(t % id))) end if else @@ -2340,10 +2244,9 @@ contains ! Check if no nuclide was found if (.not. associated(pair_list)) then - message = "Could not find the nuclide " // trim(& - sarray(j)) // " specified in tally " & - // trim(to_str(t % id)) // " in any material." - call fatal_error(message) + call fatal_error("Could not find the nuclide " & + &// trim(sarray(j)) // " specified in tally " & + &// trim(to_str(t % id)) // " in any material.") end if deallocate(pair_list) else @@ -2354,9 +2257,9 @@ contains ! Check to make sure nuclide specified is in problem if (.not. nuclide_dict % has_key(to_lower(word))) then - message = "The nuclide " // trim(word) // " from tally " // & - trim(to_str(t % id)) // " is not present in any material." - call fatal_error(message) + call fatal_error("The nuclide " // trim(word) // " from tally " & + &// trim(to_str(t % id)) & + &// " is not present in any material.") end if ! Set bin to index in nuclides array @@ -2405,13 +2308,13 @@ contains ! User requested too many orders; throw a warning and set to the ! maximum order. ! The above scheme will essentially take the absolute value - message = "Invalid scattering order of " // trim(to_str(n_order)) // & - " requested. Setting to the maximum permissible value, " // & - trim(to_str(MAX_ANG_ORDER)) - if (master) call warning(message) + if (master) call warning("Invalid scattering order of " & + &// trim(to_str(n_order)) // " requested. Setting to the & + &maximum permissible value, " & + &// trim(to_str(MAX_ANG_ORDER))) n_order = MAX_ANG_ORDER - sarray(j) = trim(MOMENT_STRS(imomstr)) // & - trim(to_str(MAX_ANG_ORDER)) + sarray(j) = trim(MOMENT_STRS(imomstr)) & + &// trim(to_str(MAX_ANG_ORDER)) end if ! Find total number of bins for this case if (imomstr >= YN_LOC) then @@ -2436,7 +2339,8 @@ contains j = j + 1 ! Get the input string in scores(l) but if score is one of the moment ! scores then strip off the n and store it as an integer to be used - ! later. Then perform the select case on this modified (number removed) string + ! later. Then perform the select case on this modified (number + ! removed) string score_name = sarray(l) do imomstr = 1, size(MOMENT_STRS) if (starts_with(score_name,trim(MOMENT_STRS(imomstr)))) then @@ -2447,10 +2351,6 @@ contains ! User requested too many orders; throw a warning and set to the ! maximum order. ! The above scheme will essentially take the absolute value - message = "Invalid scattering order of " // trim(to_str(n_order)) // & - " requested. Setting to the maximum permissible value, " // & - trim(to_str(MAX_ANG_ORDER)) - if (master) call warning(message) n_order = MAX_ANG_ORDER end if score_name = trim(MOMENT_STRS(imomstr)) // "n" @@ -2474,10 +2374,10 @@ contains ! User requested too many orders; throw a warning and set to the ! maximum order. ! The above scheme will essentially take the absolute value - message = "Invalid scattering order of " // trim(to_str(n_order)) // & - " requested. Setting to the maximum permissible value, " // & - trim(to_str(MAX_ANG_ORDER)) - if (master) call warning(message) + if (master) call warning("Invalid scattering order of " & + &// trim(to_str(n_order)) // " requested. Setting to & + &the maximum permissible value, " & + &// trim(to_str(MAX_ANG_ORDER))) n_order = MAX_ANG_ORDER end if score_name = trim(MOMENT_N_STRS(imomstr)) // "n" @@ -2491,26 +2391,24 @@ contains ! Prohibit user from tallying flux for an individual nuclide if (.not. (t % n_nuclide_bins == 1 .and. & t % nuclide_bins(1) == -1)) then - message = "Cannot tally flux for an individual nuclide." - call fatal_error(message) + call fatal_error("Cannot tally flux for an individual nuclide.") end if t % score_bins(j) = SCORE_FLUX if (t % find_filter(FILTER_ENERGYOUT) > 0) then - message = "Cannot tally flux with an outgoing energy filter." - call fatal_error(message) + call fatal_error("Cannot tally flux with an outgoing energy & + &filter.") end if case ('flux-yn') ! Prohibit user from tallying flux for an individual nuclide if (.not. (t % n_nuclide_bins == 1 .and. & t % nuclide_bins(1) == -1)) then - message = "Cannot tally flux for an individual nuclide." - call fatal_error(message) + call fatal_error("Cannot tally flux for an individual nuclide.") end if if (t % find_filter(FILTER_ENERGYOUT) > 0) then - message = "Cannot tally flux with an outgoing energy filter." - call fatal_error(message) + call fatal_error("Cannot tally flux with an outgoing energy & + &filter.") end if t % score_bins(j : j + n_bins - 1) = SCORE_FLUX_YN @@ -2520,16 +2418,14 @@ contains case ('total') t % score_bins(j) = SCORE_TOTAL if (t % find_filter(FILTER_ENERGYOUT) > 0) then - message = "Cannot tally total reaction rate with an & - &outgoing energy filter." - call fatal_error(message) + call fatal_error("Cannot tally total reaction rate with an & + &outgoing energy filter.") end if case ('total-yn') if (t % find_filter(FILTER_ENERGYOUT) > 0) then - message = "Cannot tally total reaction rate with an & - &outgoing energy filter." - call fatal_error(message) + call fatal_error("Cannot tally total reaction rate with an & + &outgoing energy filter.") end if t % score_bins(j : j + n_bins - 1) = SCORE_TOTAL_YN @@ -2598,9 +2494,8 @@ contains ! Set tally estimator to analog t % estimator = ESTIMATOR_ANALOG case ('diffusion') - message = "Diffusion score no longer supported for tallies, & - &please remove" - call fatal_error(message) + call fatal_error("Diffusion score no longer supported for tallies, & + &please remove") case ('n1n') t % score_bins(j) = SCORE_N_1N @@ -2618,16 +2513,14 @@ contains case ('absorption') t % score_bins(j) = SCORE_ABSORPTION if (t % find_filter(FILTER_ENERGYOUT) > 0) then - message = "Cannot tally absorption rate with an outgoing & - &energy filter." - call fatal_error(message) + call fatal_error("Cannot tally absorption rate with an outgoing & + &energy filter.") end if case ('fission') t % score_bins(j) = SCORE_FISSION if (t % find_filter(FILTER_ENERGYOUT) > 0) then - message = "Cannot tally fission rate with an outgoing & - &energy filter." - call fatal_error(message) + call fatal_error("Cannot tally fission rate with an outgoing & + &energy filter.") end if case ('nu-fission') t % score_bins(j) = SCORE_NU_FISSION @@ -2644,10 +2537,9 @@ contains ! Check to make sure that current is the only desired response ! for this tally if (n_words > 1) then - message = "Cannot tally other scoring functions in the same & - &tally as surface currents. Separate other scoring & - &functions into a distinct tally." - call fatal_error(message) + call fatal_error("Cannot tally other scoring functions in the & + &same tally as surface currents. Separate other scoring & + &functions into a distinct tally.") end if ! Since the number of bins for the mesh filter was already set @@ -2659,8 +2551,8 @@ contains ! Check to make sure mesh filter was specified if (k == 0) then - message = "Cannot tally surface current without a mesh filter." - call fatal_error(message) + call fatal_error("Cannot tally surface current without a mesh & + &filter.") end if ! Get pointer to mesh @@ -2706,16 +2598,14 @@ contains if (MT > 1) then t % score_bins(j) = MT else - message = "Invalid MT on : " // & - trim(sarray(l)) - call fatal_error(message) + call fatal_error("Invalid MT on : " & + &// trim(sarray(l))) end if else ! Specified score was not an integer - message = "Unknown scoring function: " // & - trim(sarray(l)) - call fatal_error(message) + call fatal_error("Unknown scoring function: " & + &// trim(sarray(l))) end if end select @@ -2726,9 +2616,8 @@ contains ! Deallocate temporary string array of scores deallocate(sarray) else - message = "No specified on tally " // trim(to_str(t % id)) & - // "." - call fatal_error(message) + call fatal_error("No specified on tally " & + &// trim(to_str(t % id)) // ".") end if ! ======================================================================= @@ -2746,18 +2635,16 @@ contains ! If the estimator was set to an analog estimator, this means the ! tally needs post-collision information if (t % estimator == ESTIMATOR_ANALOG) then - message = "Cannot use track-length estimator for tally " & - // to_str(t % id) - call fatal_error(message) + call fatal_error("Cannot use track-length estimator for tally " & + &// to_str(t % id)) end if ! Set estimator to track-length estimator t % estimator = ESTIMATOR_TRACKLENGTH case default - message = "Invalid estimator '" // trim(temp_str) & - // "' on tally " // to_str(t % id) - call fatal_error(message) + call fatal_error("Invalid estimator '" // trim(temp_str) & + &// "' on tally " // to_str(t % id)) end select end if @@ -2801,13 +2688,12 @@ contains filename = trim(path_input) // "plots.xml" inquire(FILE=filename, EXIST=file_exists) if (.not. file_exists) then - message = "Plots XML file '" // trim(filename) // "' does not exist!" - call fatal_error(message) + call fatal_error("Plots XML file '" // trim(filename) & + &// "' does not exist!") end if ! Display output message - message = "Reading plot XML file..." - call write_message(message, 5) + call write_message("Reading plot XML file...", 5) ! Parse plots.xml file call open_xmldoc(doc, filename) @@ -2829,15 +2715,13 @@ contains if (check_for_node(node_plot, "id")) then call get_node_value(node_plot, "id", pl % id) else - message = "Must specify plot id in plots XML file." - call fatal_error(message) + call fatal_error("Must specify plot id in plots XML file.") end if ! Check to make sure 'id' hasn't been used if (plot_dict % has_key(pl % id)) then - message = "Two or more plots use the same unique ID: " // & - to_str(pl % id) - call fatal_error(message) + call fatal_error("Two or more plots use the same unique ID: " & + &// to_str(pl % id)) end if ! Copy plot type @@ -2851,9 +2735,8 @@ contains case ("voxel") pl % type = PLOT_TYPE_VOXEL case default - message = "Unsupported plot type '" // trim(temp_str) & - // "' in plot " // trim(to_str(pl % id)) - call fatal_error(message) + call fatal_error("Unsupported plot type '" // trim(temp_str) & + &// "' in plot " // trim(to_str(pl % id))) end select ! Set output file path @@ -2874,33 +2757,29 @@ contains if (get_arraysize_integer(node_plot, "pixels") == 2) then call get_node_array(node_plot, "pixels", pl % pixels(1:2)) else - message = " must be length 2 in slice plot " // & - trim(to_str(pl % id)) - call fatal_error(message) + call fatal_error(" must be length 2 in slice plot " & + &// trim(to_str(pl % id))) end if else if (pl % type == PLOT_TYPE_VOXEL) then if (get_arraysize_integer(node_plot, "pixels") == 3) then call get_node_array(node_plot, "pixels", pl % pixels(1:3)) else - message = " must be length 3 in voxel plot " // & - trim(to_str(pl % id)) - call fatal_error(message) + call fatal_error(" must be length 3 in voxel plot " & + &// trim(to_str(pl % id))) end if end if ! Copy plot background color if (check_for_node(node_plot, "background")) then if (pl % type == PLOT_TYPE_VOXEL) then - message = "Background color ignored in voxel plot " // & - trim(to_str(pl % id)) - if (master) call warning(message) + if (master) call warning("Background color ignored in voxel plot " & + &// trim(to_str(pl % id))) end if if (get_arraysize_integer(node_plot, "background") == 3) then call get_node_array(node_plot, "background", pl % not_found % rgb) else - message = "Bad background RGB " & - // "in plot " // trim(to_str(pl % id)) - call fatal_error(message) + call fatal_error("Bad background RGB in plot " & + &// trim(to_str(pl % id))) end if else pl % not_found % rgb = (/ 255, 255, 255 /) @@ -2920,9 +2799,8 @@ contains case ("yz") pl % basis = PLOT_BASIS_YZ case default - message = "Unsupported plot basis '" // trim(temp_str) & - // "' in plot " // trim(to_str(pl % id)) - call fatal_error(message) + call fatal_error("Unsupported plot basis '" // trim(temp_str) & + &// "' in plot " // trim(to_str(pl % id))) end select end if @@ -2930,9 +2808,8 @@ contains if (get_arraysize_double(node_plot, "origin") == 3) then call get_node_array(node_plot, "origin", pl % origin) else - message = "Origin must be length 3 " & - // "in plot " // trim(to_str(pl % id)) - call fatal_error(message) + call fatal_error("Origin must be length 3 in plot " & + &// trim(to_str(pl % id))) end if ! Copy plotting width @@ -2940,17 +2817,15 @@ contains if (get_arraysize_double(node_plot, "width") == 2) then call get_node_array(node_plot, "width", pl % width(1:2)) else - message = " must be length 2 in slice plot " // & - trim(to_str(pl % id)) - call fatal_error(message) + call fatal_error(" must be length 2 in slice plot " & + &// trim(to_str(pl % id))) end if else if (pl % type == PLOT_TYPE_VOXEL) then if (get_arraysize_double(node_plot, "width") == 3) then call get_node_array(node_plot, "width", pl % width(1:3)) else - message = " must be length 3 in voxel plot " // & - trim(to_str(pl % id)) - call fatal_error(message) + call fatal_error(" must be length 3 in voxel plot " & + &// trim(to_str(pl % id))) end if end if @@ -2981,9 +2856,8 @@ contains end do case default - message = "Unsupported plot color type '" // trim(temp_str) & - // "' in plot " // trim(to_str(pl % id)) - call fatal_error(message) + call fatal_error("Unsupported plot color type '" // trim(temp_str) & + &// "' in plot " // trim(to_str(pl % id))) end select ! Get the number of nodes and get a list of them @@ -2994,9 +2868,8 @@ contains if (n_cols /= 0) then if (pl % type == PLOT_TYPE_VOXEL) then - message = "Color specifications ignored in voxel plot " // & - trim(to_str(pl % id)) - if (master) call warning(message) + if (master) call warning("Color specifications ignored in voxel & + &plot " // trim(to_str(pl % id))) end if do j = 1, n_cols @@ -3006,18 +2879,16 @@ contains ! Check and make sure 3 values are specified for RGB if (get_arraysize_double(node_col, "rgb") /= 3) then - message = "Bad RGB " & - // "in plot " // trim(to_str(pl % id)) - call fatal_error(message) + call fatal_error("Bad RGB in plot " & + &// trim(to_str(pl % id))) end if ! Ensure that there is an id for this color specification if (check_for_node(node_col, "id")) then call get_node_value(node_col, "id", col_id) else - message = "Must specify id for color specification in plot " // & - trim(to_str(pl % id)) - call fatal_error(message) + call fatal_error("Must specify id for color specification in & + &plot " // trim(to_str(pl % id))) end if ! Add RGB @@ -3027,9 +2898,8 @@ contains col_id = cell_dict % get_key(col_id) call get_node_array(node_col, "rgb", pl % colors(col_id) % rgb) else - message = "Could not find cell " // trim(to_str(col_id)) // & - " specified in plot " // trim(to_str(pl % id)) - call fatal_error(message) + call fatal_error("Could not find cell " // trim(to_str(col_id)) & + &// " specified in plot " // trim(to_str(pl % id))) end if else if (pl % color_by == PLOT_COLOR_MATS) then @@ -3038,9 +2908,9 @@ contains col_id = material_dict % get_key(col_id) call get_node_array(node_col, "rgb", pl % colors(col_id) % rgb) else - message = "Could not find material " // trim(to_str(col_id)) // & - " specified in plot " // trim(to_str(pl % id)) - call fatal_error(message) + call fatal_error("Could not find material " & + &// trim(to_str(col_id)) // " specified in plot " & + &// trim(to_str(pl % id))) end if end if @@ -3053,9 +2923,8 @@ contains if (n_meshlines /= 0) then if (pl % type == PLOT_TYPE_VOXEL) then - message = "Meshlines ignored in voxel plot " // & - trim(to_str(pl % id)) - call warning(message) + call warning("Meshlines ignored in voxel plot " & + &// trim(to_str(pl % id))) end if select case(n_meshlines) @@ -3070,9 +2939,8 @@ contains if (check_for_node(node_meshlines, "meshtype")) then call get_node_value(node_meshlines, "meshtype", meshtype) else - message = "Must specify a meshtype for meshlines " // & - "specification in plot " // trim(to_str(pl % id)) - call fatal_error(message) + call fatal_error("Must specify a meshtype for meshlines & + &specification in plot " // trim(to_str(pl % id))) end if ! Ensure that there is a linewidth for this meshlines specification @@ -3080,9 +2948,8 @@ contains call get_node_value(node_meshlines, "linewidth", & pl % meshlines_width) else - message = "Must specify a linewidth for meshlines " // & - "specification in plot " // trim(to_str(pl % id)) - call fatal_error(message) + call fatal_error("Must specify a linewidth for meshlines & + &specification in plot " // trim(to_str(pl % id))) end if ! Check for color @@ -3090,9 +2957,8 @@ contains ! Check and make sure 3 values are specified for RGB if (get_arraysize_double(node_meshlines, "color") /= 3) then - message = "Bad RGB for meshlines color " // & - "in plot " // trim(to_str(pl % id)) - call fatal_error(message) + call fatal_error("Bad RGB for meshlines color in plot " & + &// trim(to_str(pl % id))) end if call get_node_array(node_meshlines, "color", & @@ -3108,19 +2974,17 @@ contains case ('ufs') if (.not. associated(ufs_mesh)) then - message = "No UFS mesh for meshlines on plot " // & - trim(to_str(pl % id)) - call fatal_error(message) + call fatal_error("No UFS mesh for meshlines on plot " & + &// trim(to_str(pl % id))) end if - + pl % meshlines_mesh => ufs_mesh case ('cmfd') if (.not. cmfd_run) then - message = "Need CMFD run to plot CMFD mesh for meshlines " // & - "on plot " // trim(to_str(pl % id)) - call fatal_error(message) + call fatal_error("Need CMFD run to plot CMFD mesh for & + &meshlines on plot " // trim(to_str(pl % id))) end if i_mesh = cmfd_tallies(1) % & @@ -3129,19 +2993,17 @@ contains pl % meshlines_mesh => meshes(i_mesh) case ('entropy') - + if (.not. associated(entropy_mesh)) then - message = "No entropy mesh for meshlines on plot " // & - trim(to_str(pl % id)) - call fatal_error(message) + call fatal_error("No entropy mesh for meshlines on plot " & + &// trim(to_str(pl % id))) end if - + if (.not. allocated(entropy_mesh % dimension)) then - message = "No dimension specified on entropy mesh for " // & - "meshlines on plot " // trim(to_str(pl % id)) - call fatal_error(message) + call fatal_error("No dimension specified on entropy mesh & + &for meshlines on plot " // trim(to_str(pl % id))) end if - + pl % meshlines_mesh => entropy_mesh case ('tally') @@ -3150,37 +3012,31 @@ contains if (check_for_node(node_meshlines, "id")) then call get_node_value(node_meshlines, "id", meshid) else - message = "Must specify a mesh id for meshlines tally mesh" // & - "specification in plot " // trim(to_str(pl % id)) - call fatal_error(message) + call fatal_error("Must specify a mesh id for meshlines tally & + &mesh specification in plot " // trim(to_str(pl % id))) end if ! Check if the specified tally mesh exists if (mesh_dict % has_key(meshid)) then pl % meshlines_mesh => meshes(mesh_dict % get_key(meshid)) if (meshes(meshid) % type /= LATTICE_RECT) then - message = "Non-rectangular mesh specified in meshlines " // & - "for plot " // trim(to_str(pl % id)) - call fatal_error(message) + call fatal_error("Non-rectangular mesh specified in & + &meshlines for plot " // trim(to_str(pl % id))) end if else - message = "Could not find mesh " // & - trim(to_str(meshid)) // & - " specified in meshlines for plot " // & - trim(to_str(pl % id)) - call fatal_error(message) + call fatal_error("Could not find mesh " & + &// trim(to_str(meshid)) // " specified in meshlines for & + &plot " // trim(to_str(pl % id))) end if case default - message = "Invalid type for meshlines on plot " // & - trim(to_str(pl % id)) // ": " // trim(meshtype) - call fatal_error(message) + call fatal_error("Invalid type for meshlines on plot " & + &// trim(to_str(pl % id)) // ": " // trim(meshtype)) end select case default - message = "Mutliple meshlines" // & - " specified in plot " // trim(to_str(pl % id)) - call fatal_error(message) + call fatal_error("Mutliple meshlines specified in plot " & + &// trim(to_str(pl % id))) end select end if @@ -3191,16 +3047,14 @@ contains if (n_masks /= 0) then if (pl % type == PLOT_TYPE_VOXEL) then - message = "Mask ignored in voxel plot " // & - trim(to_str(pl % id)) - if (master) call warning(message) + if (master) call warning("Mask ignored in voxel plot " & + &// trim(to_str(pl % id))) end if select case(n_masks) case default - message = "Mutliple masks" // & - " specified in plot " // trim(to_str(pl % id)) - call fatal_error(message) + call fatal_error("Mutliple masks specified in plot " & + &// trim(to_str(pl % id))) case (1) ! Get pointer to mask @@ -3210,9 +3064,8 @@ contains n_comp = 0 n_comp = get_arraysize_integer(node_mask, "components") if (n_comp == 0) then - message = "Missing in mask of plot " // & - trim(to_str(pl % id)) - call fatal_error(message) + call fatal_error("Missing in mask of plot " & + &// trim(to_str(pl % id))) end if allocate(iarray(n_comp)) call get_node_array(node_mask, "components", iarray) @@ -3227,9 +3080,9 @@ contains if (cell_dict % has_key(col_id)) then iarray(j) = cell_dict % get_key(col_id) else - message = "Could not find cell " // trim(to_str(col_id)) // & - " specified in the mask in plot " // trim(to_str(pl % id)) - call fatal_error(message) + call fatal_error("Could not find cell " & + &// trim(to_str(col_id)) // " specified in the mask in & + &plot " // trim(to_str(pl % id))) end if else if (pl % color_by == PLOT_COLOR_MATS) then @@ -3237,9 +3090,9 @@ contains if (material_dict % has_key(col_id)) then iarray(j) = material_dict % get_key(col_id) else - message = "Could not find material " // trim(to_str(col_id)) // & - " specified in the mask in plot " // trim(to_str(pl % id)) - call fatal_error(message) + call fatal_error("Could not find material " & + &// trim(to_str(col_id)) // " specified in the mask in & + &plot " // trim(to_str(pl % id))) end if end if @@ -3251,9 +3104,8 @@ contains if (check_for_node(node_mask, "background")) then call get_node_array(node_mask, "background", pl % colors(j) % rgb) else - message = "Missing in mask of plot " // & - trim(to_str(pl % id)) - call fatal_error(message) + call fatal_error("Missing in mask of plot " & + &// trim(to_str(pl % id))) end if end if end do @@ -3297,13 +3149,11 @@ contains inquire(FILE=path_cross_sections, EXIST=file_exists) if (.not. file_exists) then ! Could not find cross_sections.xml file - message = "Cross sections XML file '" // trim(path_cross_sections) // & - "' does not exist!" - call fatal_error(message) + call fatal_error("Cross sections XML file '" & + &// trim(path_cross_sections) // "' does not exist!") end if - message = "Reading cross sections XML file..." - call write_message(message, 5) + call write_message("Reading cross sections XML file...", 5) ! Parse cross_sections.xml file call open_xmldoc(doc, path_cross_sections) @@ -3329,8 +3179,8 @@ contains elseif (len_trim(temp_str) == 0) then filetype = ASCII else - message = "Unknown filetype in cross_sections.xml: " // trim(temp_str) - call fatal_error(message) + call fatal_error("Unknown filetype in cross_sections.xml: " & + &// trim(temp_str)) end if ! copy default record length and entries for binary files @@ -3345,8 +3195,8 @@ contains ! Allocate xs_listings array if (n_listings == 0) then - message = "No ACE table listings present in cross_sections.xml file!" - call fatal_error(message) + call fatal_error("No ACE table listings present in cross_sections.xml & + &file!") else allocate(xs_listings(n_listings)) end if @@ -3404,8 +3254,7 @@ contains if (check_for_node(node_ace, "path")) then call get_node_value(node_ace, "path", temp_str) else - message = "Path missing for isotope " // listing % name - call fatal_error(message) + call fatal_error("Path missing for isotope " // listing % name) end if if (starts_with(temp_str, '/')) then @@ -3428,9 +3277,9 @@ contains ! Check that 0K nuclides are listed in the cross_sections.xml file do i = 1, n_res_scatterers_total if (.not. xs_listing_dict % has_key(trim(nuclides_0K(i) % name_0K))) then - message = "Could not find nuclide " // trim(nuclides_0K(i) % name_0K) // & - " in cross_sections.xml file!" - call fatal_error(message) + call fatal_error("Could not find nuclide " & + &// trim(nuclides_0K(i) % name_0K) & + &// " in cross_sections.xml file!") end if end do @@ -4269,8 +4118,7 @@ contains call list_density % append(density * 0.992742_8) case default - message = "Cannot expand element: " // name - call fatal_error(message) + call fatal_error("Cannot expand element: " // name) end select diff --git a/src/output.F90 b/src/output.F90 index 5dcd668b44..4d0ef7edd4 100644 --- a/src/output.F90 +++ b/src/output.F90 @@ -1555,7 +1555,6 @@ contains subroutine print_results() - character(2*MAX_LINE_LEN) :: message real(8) :: alpha ! significance level for CI real(8) :: t_value ! t-value for confidence intervals @@ -1589,8 +1588,8 @@ contains write(ou,102) "Leakage Fraction", global_tallies(LEAKAGE) % sum, & global_tallies(LEAKAGE) % sum_sq else - message = "Could not compute uncertainties -- only one active batch simulated!" - if (master) call warning(message) + if (master) call warning("Could not compute uncertainties -- only one & + &active batch simulated!") write(ou,103) "k-effective (Collision)", global_tallies(K_COLLISION) % sum write(ou,103) "k-effective (Track-length)", global_tallies(K_TRACKLENGTH) % sum diff --git a/src/particle_restart.F90 b/src/particle_restart.F90 index dd68d5a896..6ff5d63c2d 100644 --- a/src/particle_restart.F90 +++ b/src/particle_restart.F90 @@ -16,7 +16,6 @@ module particle_restart private public :: run_particle_restart - character(2*MAX_LINE_LEN) :: message ! Message to output unit type(BinaryOutput) :: pr ! Binary file contains @@ -73,9 +72,8 @@ contains type(Particle), intent(inout) :: p ! Write meessage - message = "Loading particle restart file " // trim(path_particle_restart) & - // "..." - call write_message(message, 1) + call write_message("Loading particle restart file " & + &// trim(path_particle_restart) // "...", 1) ! Open file call pr % file_open(path_particle_restart, 'r') diff --git a/src/physics.F90 b/src/physics.F90 index 353b7fd344..8fa0575cdc 100644 --- a/src/physics.F90 +++ b/src/physics.F90 @@ -20,8 +20,6 @@ module physics implicit none - character(2*MAX_LINE_LEN) :: message ! Message to output unit - ! TODO: Figure out how to write particle restart files in sample_angle, ! sample_energy, etc. @@ -49,17 +47,15 @@ contains ! Display information about collision if (verbosity >= 10 .or. trace) then - message = " " // trim(reaction_name(p % event_MT)) // " with " // & - trim(adjustl(nuclides(p % event_nuclide) % name)) // & - ". Energy = " // trim(to_str(p % E * 1e6_8)) // " eV." - call write_message(message) + call write_message(" " // trim(reaction_name(p % event_MT)) & + &// " with " // trim(adjustl(nuclides(p % event_nuclide) % name)) & + &// ". Energy = " // trim(to_str(p % E * 1e6_8)) // " eV.") end if ! check for very low energy if (p % E < 1.0e-100_8) then p % alive = .false. - message = "Killing neutron with extremely low energy" - if (master) call warning(message) + if (master) call warning("Killing neutron with extremely low energy") end if end subroutine collision @@ -161,8 +157,7 @@ contains ! Check to make sure that a nuclide was sampled if (i > mat % n_nuclides) then call write_particle_restart(p) - message = "Did not sample any nuclide during collision." - call fatal_error(message) + call fatal_error("Did not sample any nuclide during collision.") end if ! Find atom density @@ -370,9 +365,8 @@ contains ! Check to make sure inelastic scattering reaction sampled if (i > nuc % n_reaction) then call write_particle_restart(p) - message = "Did not sample any reaction for nuclide " // & - trim(nuc % name) - call fatal_error(message) + call fatal_error("Did not sample any reaction for nuclide " & + &// trim(nuc % name)) end if rxn => nuc % reactions(i) @@ -723,8 +717,8 @@ contains mu = sab % inelastic_data(l) % mu(k, j) else - message = "Invalid secondary energy mode on S(a,b) table " // & - trim(sab % name) + call fatal_error("Invalid secondary energy mode on S(a,b) table " & + &// trim(sab % name)) end if ! (inelastic secondary energy treatment) end if ! (elastic or inelastic) @@ -976,8 +970,7 @@ contains end do case default - message = "Not a recognized resonance scattering treatment!" - call fatal_error(message) + call fatal_error("Not a recognized resonance scattering treatment!") end select end subroutine sample_target_velocity @@ -1095,8 +1088,7 @@ contains call get_mesh_indices(ufs_mesh, p % coord0 % xyz, ijk, in_mesh) if (.not. in_mesh) then call write_particle_restart(p) - message = "Source site outside UFS mesh!" - call fatal_error(message) + call fatal_error("Source site outside UFS mesh!") end if if (source_frac(1,ijk(1),ijk(2),ijk(3)) /= ZERO) then @@ -1121,10 +1113,9 @@ contains ! Check for fission bank size getting hit if (n_bank + nu > size(fission_bank)) then - message = "Maximum number of sites in fission bank reached. This can & - &result in irreproducible results using different numbers of & - &processes/threads." - if (master) call warning(message) + if (master) call warning("Maximum number of sites in fission bank & + &reached. This can result in irreproducible results using different & + &numbers of processes/threads.") end if ! Bank source neutrons @@ -1249,9 +1240,8 @@ contains n_sample = n_sample + 1 if (n_sample == MAX_SAMPLE) then ! call write_particle_restart(p) - message = "Resampled energy distribution maximum number of " // & - "times for nuclide " // nuc % name - call fatal_error(message) + call fatal_error("Resampled energy distribution maximum number of " & + &// "times for nuclide " // nuc % name) end if end do @@ -1276,9 +1266,8 @@ contains n_sample = n_sample + 1 if (n_sample == MAX_SAMPLE) then ! call write_particle_restart(p) - message = "Resampled energy distribution maximum number of " // & - "times for nuclide " // nuc % name - call fatal_error(message) + call fatal_error("Resampled energy distribution maximum number of " & + &// "times for nuclide " // nuc % name) end if end do @@ -1459,8 +1448,7 @@ contains end if else ! call write_particle_restart(p) - message = "Unknown interpolation type: " // trim(to_str(interp)) - call fatal_error(message) + call fatal_error("Unknown interpolation type: " // trim(to_str(interp))) end if ! Because of floating-point roundoff, it may be possible for mu to be @@ -1471,8 +1459,8 @@ contains else ! call write_particle_restart(p) - message = "Unknown angular distribution type: " // trim(to_str(type)) - call fatal_error(message) + call fatal_error("Unknown angular distribution type: " & + &// trim(to_str(type))) end if end function sample_angle @@ -1619,9 +1607,8 @@ contains NET = int(edist % data(3 + 2*NR + NE)) if (NR > 0) then ! call write_particle_restart(p) - message = "Multiple interpolation regions not supported while & - &attempting to sample equiprobable energy bins." - call fatal_error(message) + call fatal_error("Multiple interpolation regions not supported while & + &attempting to sample equiprobable energy bins.") end if ! determine index on incoming energy grid and interpolation factor @@ -1684,14 +1671,12 @@ contains NR = int(edist % data(1)) NE = int(edist % data(2 + 2*NR)) if (NR == 1) then - message = "Assuming linear-linear interpolation when sampling & - &continuous tabular distribution" - if (master) call warning(message) + if (master) call warning("Assuming linear-linear interpolation when & + &sampling continuous tabular distribution") else if (NR > 1) then ! call write_particle_restart(p) - message = "Multiple interpolation regions not supported while & - &attempting to sample continuous tabular distribution." - call fatal_error(message) + call fatal_error("Multiple interpolation regions not supported while & + &attempting to sample continuous tabular distribution.") end if ! find energy bin and calculate interpolation factor -- if the energy is @@ -1749,9 +1734,8 @@ contains if (ND > 0) then ! discrete lines present ! call write_particle_restart(p) - message = "Discrete lines in continuous tabular distributed not & - &yet supported" - call fatal_error(message) + call fatal_error("Discrete lines in continuous tabular distributed not & + &yet supported") end if ! determine outgoing energy bin @@ -1791,8 +1775,7 @@ contains end if else ! call write_particle_restart(p) - message = "Unknown interpolation type: " // trim(to_str(INTT)) - call fatal_error(message) + call fatal_error("Unknown interpolation type: " // trim(to_str(INTT))) end if ! Now interpolate between incident energy bins i and i + 1 @@ -1833,8 +1816,7 @@ contains n_sample = n_sample + 1 if (n_sample == MAX_SAMPLE) then ! call write_particle_restart(p) - message = "Too many rejections on Maxwell fission spectrum." - call fatal_error(message) + call fatal_error("Too many rejections on Maxwell fission spectrum.") end if end do @@ -1866,8 +1848,7 @@ contains n_sample = n_sample + 1 if (n_sample == MAX_SAMPLE) then ! call write_particle_restart(p) - message = "Too many rejections on evaporation spectrum." - call fatal_error(message) + call fatal_error("Too many rejections on evaporation spectrum.") end if end do @@ -1908,8 +1889,7 @@ contains n_sample = n_sample + 1 if (n_sample == MAX_SAMPLE) then ! call write_particle_restart(p) - message = "Too many rejections on Watt spectrum." - call fatal_error(message) + call fatal_error("Too many rejections on Watt spectrum.") end if end do @@ -1919,8 +1899,7 @@ contains if (.not. present(mu_out)) then ! call write_particle_restart(p) - message = "Law 44 called without giving mu_out as argument." - call fatal_error(message) + call fatal_error("Law 44 called without giving mu_out as argument.") end if ! read number of interpolation regions and incoming energies @@ -1928,9 +1907,8 @@ contains NE = int(edist % data(2 + 2*NR)) if (NR > 0) then ! call write_particle_restart(p) - message = "Multiple interpolation regions not supported while & - &attempting to sample Kalbach-Mann distribution." - call fatal_error(message) + call fatal_error("Multiple interpolation regions not supported while & + &attempting to sample Kalbach-Mann distribution.") end if ! find energy bin and calculate interpolation factor -- if the energy is @@ -1989,9 +1967,8 @@ contains if (ND > 0) then ! discrete lines present ! call write_particle_restart(p) - message = "Discrete lines in continuous tabular distributed not & - &yet supported" - call fatal_error(message) + call fatal_error("Discrete lines in continuous tabular distributed not & + &yet supported") end if ! determine outgoing energy bin @@ -2045,8 +2022,7 @@ contains KM_A = A_k + (A_k1 - A_k)*(E_out - E_l_k)/(E_l_k1 - E_l_k) else ! call write_particle_restart() - message = "Unknown interpolation type: " // trim(to_str(INTT)) - call fatal_error(message) + call fatal_error("Unknown interpolation type: " // trim(to_str(INTT))) end if ! Now interpolate between incident energy bins i and i + 1 @@ -2072,8 +2048,7 @@ contains if (.not. present(mu_out)) then ! call write_particle_restart() - message = "Law 61 called without giving mu_out as argument." - call fatal_error(message) + call fatal_error("Law 61 called without giving mu_out as argument.") end if ! read number of interpolation regions and incoming energies @@ -2081,9 +2056,8 @@ contains NE = int(edist % data(2 + 2*NR)) if (NR > 0) then ! call write_particle_restart() - message = "Multiple interpolation regions not supported while & - &attempting to sample correlated energy-angle distribution." - call fatal_error(message) + call fatal_error("Multiple interpolation regions not supported while & + &attempting to sample correlated energy-angle distribution.") end if ! find energy bin and calculate interpolation factor -- if the energy is @@ -2142,9 +2116,8 @@ contains if (ND > 0) then ! discrete lines present ! call write_particle_restart() - message = "Discrete lines in continuous tabular distributed not & - &yet supported" - call fatal_error(message) + call fatal_error("Discrete lines in continuous tabular distributed not & + &yet supported") end if ! determine outgoing energy bin @@ -2185,8 +2158,7 @@ contains end if else ! call write_particle_restart() - message = "Unknown interpolation type: " // trim(to_str(INTT)) - call fatal_error(message) + call fatal_error("Unknown interpolation type: " // trim(to_str(INTT))) end if ! Now interpolate between incident energy bins i and i + 1 @@ -2249,8 +2221,7 @@ contains end if else ! call write_particle_restart() - message = "Unknown interpolation type: " // trim(to_str(JJ)) - call fatal_error(message) + call fatal_error("Unknown interpolation type: " // trim(to_str(JJ))) end if case (66) diff --git a/src/search.F90 b/src/search.F90 index acd1c9ccbc..c8fc71d365 100644 --- a/src/search.F90 +++ b/src/search.F90 @@ -59,8 +59,8 @@ contains ! check for large number of iterations n_iteration = n_iteration + 1 if (n_iteration == MAX_ITERATION) then - call fatal_error("Reached maximum number of iterations on binary " & - &// "search.") + call fatal_error("Reached maximum number of iterations on binary & + &search.") end if end do @@ -111,8 +111,8 @@ contains ! check for large number of iterations n_iteration = n_iteration + 1 if (n_iteration == MAX_ITERATION) then - call fatal_error("Reached maximum number of iterations on binary " & - &// "search.") + call fatal_error("Reached maximum number of iterations on binary & + &search.") end if end do @@ -163,8 +163,8 @@ contains ! check for large number of iterations n_iteration = n_iteration + 1 if (n_iteration == MAX_ITERATION) then - call fatal_error("Reached maximum number of iterations on binary " & - &// "search.") + call fatal_error("Reached maximum number of iterations on binary & + &search.") end if end do diff --git a/src/source.F90 b/src/source.F90 index 8b8542fd6a..07c1bfb411 100644 --- a/src/source.F90 +++ b/src/source.F90 @@ -19,8 +19,6 @@ module source implicit none - character(2*MAX_LINE_LEN) :: message ! Message to output unit - contains !=============================================================================== @@ -36,15 +34,14 @@ contains type(Bank), pointer :: src => null() ! source bank site type(BinaryOutput) :: sp ! statepoint/source binary file - message = "Initializing source particles..." - call write_message(message, 6) + call write_message("Initializing source particles...", 6) if (path_source /= '') then ! Read the source from a binary file instead of sampling from some ! assumed source distribution - message = 'Reading source file from ' // trim(path_source) // '...' - call write_message(message, 6) + call write_message('Reading source file from ' // trim(path_source) & + &// '...', 6) ! Open the binary file call sp % file_open(path_source, 'r', serial = .false.) @@ -54,8 +51,8 @@ contains ! Check to make sure this is a source file if (itmp /= FILETYPE_SOURCE) then - message = "Specified starting source file not a source file type." - call fatal_error(message) + call fatal_error("Specified starting source file not a source file & + &type.") end if ! Read in the source bank @@ -81,8 +78,7 @@ contains ! Write out initial source if (write_initial_source) then - message = 'Writing out initial source guess...' - call write_message(message, 1) + call write_message('Writing out initial source guess...', 1) #ifdef HDF5 filename = trim(path_output) // 'initial_source.h5' #else @@ -144,9 +140,8 @@ contains if (.not. found) then num_resamples = num_resamples + 1 if (num_resamples == MAX_EXTSRC_RESAMPLES) then - message = "Maximum number of external source spatial resamples & - &reached!" - call fatal_error(message) + call fatal_error("Maximum number of external source spatial & + &resamples reached!") end if end if end do @@ -174,9 +169,8 @@ contains if (.not. found) then num_resamples = num_resamples + 1 if (num_resamples == MAX_EXTSRC_RESAMPLES) then - message = "Maximum number of external source spatial resamples & - &reached!" - call fatal_error(message) + call fatal_error("Maximum number of external source spatial & + &resamples reached!") end if cycle end if @@ -209,8 +203,7 @@ contains site % uvw = external_source % params_angle case default - message = "No angle distribution specified for external source!" - call fatal_error(message) + call fatal_error("No angle distribution specified for external source!") end select ! Sample energy distribution @@ -241,8 +234,7 @@ contains end do case default - message = "No energy distribution specified for external source!" - call fatal_error(message) + call fatal_error("No energy distribution specified for external source!") end select ! Set the random number generator back to the tracking stream. diff --git a/src/state_point.F90 b/src/state_point.F90 index c3332ed740..5d8b370cd2 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -26,7 +26,6 @@ module state_point implicit none - character(2*MAX_LINE_LEN) :: message ! Message to output unit type(BinaryOutput) :: sp ! Statepoint/source output file contains @@ -55,8 +54,7 @@ contains #endif ! Write message - message = "Creating state point " // trim(filename) // "..." - call write_message(message, 1) + call write_message("Creating state point " // trim(filename) // "...", 1) if (master) then ! Create statepoint file @@ -316,8 +314,8 @@ contains #endif ! Write message for new file creation - message = "Creating source file " // trim(filename) // "..." - call write_message(message, 1) + call write_message("Creating source file " // trim(filename) // "...", & + &1) ! Create separate source file call sp % file_create(filename, serial = .false.) @@ -361,8 +359,7 @@ contains #endif ! Write message for new file creation - message = "Creating source file " // trim(filename) // "..." - call write_message(message, 1) + call write_message("Creating source file " // trim(filename) // "...", 1) ! Always create this file because it will be overwritten call sp % file_create(filename, serial = .false.) @@ -532,8 +529,8 @@ contains type(TallyObject), pointer :: t => null() ! Write message - message = "Loading state point " // trim(path_state_point) // "..." - call write_message(message, 1) + call write_message("Loading state point " // trim(path_state_point) & + &// "...", 1) ! Open file for reading call sp % file_open(path_state_point, 'r', serial = .false.) @@ -545,9 +542,8 @@ contains ! current version call sp % read_data(int_array(1), "revision") if (int_array(1) /= REVISION_STATEPOINT) then - message = "State point version does not match current version " & - // "in OpenMC." - call fatal_error(message) + call fatal_error("State point version does not match current version & + &in OpenMC.") end if ! Read OpenMC version @@ -556,9 +552,8 @@ contains call sp % read_data(int_array(3), "version_release") if (int_array(1) /= VERSION_MAJOR .or. int_array(2) /= VERSION_MINOR & .or. int_array(3) /= VERSION_RELEASE) then - message = "State point file was created with a different version " & - // "of OpenMC." - if (master) call warning(message) + if (master) call warning("State point file was created with a different & + &version of OpenMC.") end if ! Read date and time @@ -668,8 +663,8 @@ contains ! Check size of tally results array if (int_array(1) /= t % total_score_bins .and. & int_array(2) /= t % total_filter_bins) then - message = "Input file tally structure is different from restart." - call fatal_error(message) + call fatal_error("Input file tally structure is different from & + &restart.") end if ! Read number of filters @@ -742,8 +737,8 @@ contains ! Check to make sure source bank is present if (path_source_point == path_state_point .and. .not. source_present) then - message = "Source bank must be contained in statepoint restart file" - call fatal_error(message) + call fatal_error("Source bank must be contained in statepoint restart & + &file") end if ! Read tallies to master @@ -755,8 +750,8 @@ contains ! Read number of global tallies call sp % read_data(int_array(1), "n_global_tallies", collect=.false.) if (int_array(1) /= N_GLOBAL_TALLIES) then - message = "Number of global tallies does not match in state point." - call fatal_error(message) + call fatal_error("Number of global tallies does not match in state & + &point.") end if ! Read global tally data @@ -792,8 +787,8 @@ contains call sp % file_close() ! Write message - message = "Loading source file " // trim(path_source_point) // "..." - call write_message(message, 1) + call write_message("Loading source file " // trim(path_source_point) & + &// "...", 1) ! Open source file call sp % file_open(path_source_point, 'r', serial = .false.) diff --git a/src/string.F90 b/src/string.F90 index 7b3689f0eb..cff69bb16e 100644 --- a/src/string.F90 +++ b/src/string.F90 @@ -10,8 +10,6 @@ module string module procedure int4_to_str, int8_to_str, real_to_str end interface - character(2*MAX_LINE_LEN) :: message ! Message to output unit - contains !=============================================================================== @@ -51,9 +49,8 @@ contains if (i_end > 0) then n = n + 1 if (i_end - i_start + 1 > len(words(n))) then - message = "The word '" // string(i_start:i_end) // & - "' is longer than the space allocated for it." - if (master) call warning(message) + if (master) call warning("The word '" // string(i_start:i_end) & + &// "' is longer than the space allocated for it.") end if words(n) = string(i_start:i_end) ! reset indices @@ -212,8 +209,8 @@ function zero_padded(num, n_digits) result(str) ! Make sure n_digits is reasonable. 10 digits is the maximum needed for the ! largest integer(4). if (n_digits > 10) then - message = 'zero_padded called with an unreasonably large n_digits (>10)' - call fatal_error(message) + call fatal_error('zero_padded called with an unreasonably large & + &n_digits (>10)') end if ! Write a format string of the form '(In.m)' where n is the max width and diff --git a/src/tally.F90 b/src/tally.F90 index db3894379b..87f5a2cab7 100644 --- a/src/tally.F90 +++ b/src/tally.F90 @@ -21,7 +21,6 @@ module tally implicit none - character(2*MAX_LINE_LEN) :: message ! Message to output unit integer :: position(N_FILTER_TYPES - 3) = 0 ! Tally map positioning array !$omp threadprivate(position) @@ -871,8 +870,8 @@ contains end do REACTION_LOOP else - message = "Invalid score type on tally " // to_str(t % id) // "." - call fatal_error(message) + call fatal_error("Invalid score type on tally " & + &// to_str(t % id) // ".") end if end select @@ -1009,8 +1008,8 @@ contains end do else - message = "Invalid score type on tally " // to_str(t % id) // "." - call fatal_error(message) + call fatal_error("Invalid score type on tally " & + &// to_str(t % id) // ".") end if end select end if @@ -1209,8 +1208,8 @@ contains end do REACTION_LOOP else - message = "Invalid score type on tally " // to_str(t % id) // "." - call fatal_error(message) + call fatal_error("Invalid score type on tally " & + &// to_str(t % id) // ".") end if end select @@ -1361,8 +1360,8 @@ contains end do else - message = "Invalid score type on tally " // to_str(t % id) // "." - call fatal_error(message) + call fatal_error("Invalid score type on tally " & + &// to_str(t % id) // ".") end if end select @@ -1707,9 +1706,8 @@ contains case (SCORE_EVENTS) score = ONE case default - message = "Invalid score type on tally " // & - to_str(t % id) // "." - call fatal_error(message) + call fatal_error("Invalid score type on tally " & + &// to_str(t % id) // ".") end select else @@ -1783,9 +1781,8 @@ contains case (SCORE_EVENTS) score = ONE case default - message = "Invalid score type on tally " // & - to_str(t % id) // "." - call fatal_error(message) + call fatal_error("Invalid score type on tally " & + &// to_str(t % id) // ".") end select end if @@ -2223,8 +2220,7 @@ contains ! Check for errors if (filter_index <= 0 .or. filter_index > & t % total_filter_bins) then - message = "Score index outside range." - call fatal_error(message) + call fatal_error("Score index outside range.") end if ! Add to surface current tally @@ -2563,18 +2559,16 @@ contains ! check to see if any of the active tally lists has been allocated if (active_tallies % size() > 0) then - message = "Active tallies should not exist before CMFD tallies!" - call fatal_error(message) + call fatal_error("Active tallies should not exist before CMFD tallies!") else if (active_analog_tallies % size() > 0) then - message = 'Active analog tallies should not exist before CMFD tallies!' - call fatal_error(message) + call fatal_error('Active analog tallies should not exist before CMFD & + &tallies!') else if (active_tracklength_tallies % size() > 0) then - message = "Active tracklength tallies should not exist before CMFD & - &tallies!" - call fatal_error(message) + call fatal_error("Active tracklength tallies should not exist before & + &CMFD tallies!") else if (active_current_tallies % size() > 0) then - message = "Active current tallies should not exist before CMFD tallies!" - call fatal_error(message) + call fatal_error("Active current tallies should not exist before CMFD & + &tallies!") end if do i = 1, n_cmfd_tallies diff --git a/src/tracking.F90 b/src/tracking.F90 index eb94016310..9545d41ee6 100644 --- a/src/tracking.F90 +++ b/src/tracking.F90 @@ -16,8 +16,6 @@ module tracking use track_output, only: initialize_particle_track, write_particle_track, & finalize_particle_track - character(2*MAX_LINE_LEN) :: message ! Message to output unit - contains !=============================================================================== @@ -41,8 +39,7 @@ contains ! Display message if high verbosity or trace is on if (verbosity >= 9 .or. trace) then - message = "Simulating Particle " // trim(to_str(p % id)) - call write_message(message) + call write_message("Simulating Particle " // trim(to_str(p % id))) end if ! If the cell hasn't been determined based on the particle's location, @@ -52,8 +49,7 @@ contains ! Particle couldn't be located if (.not. found_cell) then - message = "Could not locate particle " // trim(to_str(p % id)) - call fatal_error(message) + call fatal_error("Could not locate particle " // trim(to_str(p % id))) end if ! set birth cell attribute @@ -200,9 +196,8 @@ contains ! If particle has too many events, display warning and kill it n_event = n_event + 1 if (n_event == MAX_EVENTS) then - message = "Particle " // trim(to_str(p%id)) // " underwent maximum & - &number of events." - if (master) call warning(message) + if (master) call warning("Particle " // trim(to_str(p%id)) & + &// " underwent maximum number of events.") p % alive = .false. end if diff --git a/src/xml_interface.F90 b/src/xml_interface.F90 index 907de77d96..1a24bc14b3 100644 --- a/src/xml_interface.F90 +++ b/src/xml_interface.F90 @@ -37,8 +37,6 @@ module xml_interface module procedure get_node_array_string end interface get_node_array - character(2*MAX_LINE_LEN) :: message ! Message to output unit - contains !=============================================================================== @@ -202,9 +200,8 @@ contains ! Leave if it was not found if (.not. found) then - message = "Node " // node_name // " not part of Node " // & - getNodeName(ptr) // "." - call fatal_error(message) + call fatal_error("Node " // node_name // " not part of Node " & + &// getNodeName(ptr) // ".") end if ! Extract value @@ -235,9 +232,8 @@ contains ! Leave if it was not found if (.not. found) then - message = "Node " // node_name // " not part of Node " // & - getNodeName(ptr) // "." - call fatal_error(message) + call fatal_error("Node " // node_name // " not part of Node " & + &// getNodeName(ptr) // ".") end if ! Extract value @@ -268,9 +264,8 @@ contains ! Leave if it was not found if (.not. found) then - message = "Node " // node_name // " not part of Node " // & - getNodeName(ptr) // "." - call fatal_error(message) + call fatal_error("Node " // node_name // " not part of Node " & + &// getNodeName(ptr) // ".") end if ! Extract value @@ -301,9 +296,8 @@ contains ! Leave if it was not found if (.not. found) then - message = "Node " // node_name // " not part of Node " // & - getNodeName(ptr) // "." - call fatal_error(message) + call fatal_error("Node " // node_name // " not part of Node " & + &// getNodeName(ptr) // ".") end if ! Extract value @@ -334,9 +328,8 @@ contains ! Leave if it was not found if (.not. found) then - message = "Node " // node_name // " not part of Node " // & - getNodeName(ptr) // "." - call fatal_error(message) + call fatal_error("Node " // node_name // " not part of Node " & + &// getNodeName(ptr) // ".") end if ! Extract value @@ -367,9 +360,8 @@ contains ! Leave if it was not found if (.not. found) then - message = "Node " // node_name // " not part of Node " // & - getNodeName(ptr) // "." - call fatal_error(message) + call fatal_error("Node " // node_name // " not part of Node " & + &// getNodeName(ptr) // ".") end if ! Extract value @@ -400,9 +392,8 @@ contains ! Leave if it was not found if (.not. found) then - message = "Node " // node_name // " not part of Node " // & - getNodeName(ptr) // "." - call fatal_error(message) + call fatal_error("Node " // node_name // " not part of Node " // & + getNodeName(ptr) // ".") end if ! Extract value @@ -433,9 +424,8 @@ contains ! Leave if it was not found if (.not. found) then - message = "Node " // node_name // " not part of Node " // & - getNodeName(ptr) // "." - call fatal_error(message) + call fatal_error("Node " // node_name // " not part of Node " & + &// getNodeName(ptr) // ".") end if ! Get the size @@ -462,9 +452,8 @@ contains ! Leave if it was not found if (.not. found) then - message = "Node " // node_name // " not part of Node " // & - getNodeName(ptr) // "." - call fatal_error(message) + call fatal_error("Node " // node_name // " not part of Node " & + &// getNodeName(ptr) // ".") end if ! Get the size @@ -491,9 +480,8 @@ contains ! Leave if it was not found if (.not. found) then - message = "Node " // node_name // " not part of Node " // & - getNodeName(ptr) // "." - call fatal_error(message) + call fatal_error("Node " // node_name // " not part of Node " // & + getNodeName(ptr) // ".") end if ! Get the size From e7d6d7487f2aa038ad94113de2cf8837cbf686df Mon Sep 17 00:00:00 2001 From: Sterling Harper Date: Fri, 17 Oct 2014 14:21:15 -0400 Subject: [PATCH 93/95] Small fixes for #332 --- src/ace.F90 | 2 +- src/cmfd_input.F90 | 4 ++-- src/fixed_source.F90 | 6 ++---- src/input_xml.F90 | 10 ---------- 4 files changed, 5 insertions(+), 17 deletions(-) diff --git a/src/ace.F90 b/src/ace.F90 index 82aa705baa..584254149d 100644 --- a/src/ace.F90 +++ b/src/ace.F90 @@ -267,7 +267,7 @@ contains call fatal_error("ACE library '" // trim(filename) // "' does not exist!") elseif (readable(1:3) == 'NO') then call fatal_error("ACE library '" // trim(filename) // "' is not readable!& - &Change file permissions with chmod command.") + & Change file permissions with chmod command.") end if ! display message diff --git a/src/cmfd_input.F90 b/src/cmfd_input.F90 index 32866b52ec..578ecb9678 100644 --- a/src/cmfd_input.F90 +++ b/src/cmfd_input.F90 @@ -135,7 +135,7 @@ contains cmfd % indices(3))) if (get_arraysize_integer(node_mesh, "map") /= & product(cmfd % indices(1:3))) then - call fatal_error('FATAL==>CMFD coremap not to correct dimensions') + call fatal_error('CMFD coremap not to correct dimensions') end if allocate(iarray(get_arraysize_integer(node_mesh, "map"))) call get_node_array(node_mesh, "map", iarray) @@ -342,7 +342,7 @@ contains call get_node_array(node_mesh, "dimension", iarray3(1:n)) if (any(iarray3(1:n) <= 0)) then call fatal_error("All entries on the element for a tally mesh& - &must be positive.") + & must be positive.") end if ! Read dimensions in each direction diff --git a/src/fixed_source.F90 b/src/fixed_source.F90 index 2016ded5ef..3cbf8673a6 100644 --- a/src/fixed_source.F90 +++ b/src/fixed_source.F90 @@ -11,8 +11,6 @@ module fixed_source use tally, only: synchronize_tallies, setup_active_usertallies use tracking, only: transport - character(2*MAX_LINE_LEN) :: message ! Message to output unit - contains subroutine run_fixedsource() @@ -96,8 +94,8 @@ contains subroutine initialize_batch() - message = "Simulating batch " // trim(to_str(current_batch)) // "..." - call write_message(message, 1) + call write_message("Simulating batch " // trim(to_str(current_batch)) & + &// "...", 1) ! Reset total starting particle weight used for normalizing tallies total_weight = ZERO diff --git a/src/input_xml.F90 b/src/input_xml.F90 index 869f7752c7..e992a0eae0 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -2006,16 +2006,6 @@ contains ! ======================================================================= ! READ DATA FOR FILTERS - ! In older versions, tally filters were specified with a - ! element followed by sub-elements , , etc. This checks for - ! the old format and if it is present, raises an error - -! if (get_number_nodes(node_tal, "filters") > 0) then -! call fatal_error("Tally filters should be specified with multiple & -! & elements. Did you forget to change your & -! &element?") -! end if - ! Get pointer list to XML and get number of filters call get_node_list(node_tal, "filter", node_filt_list) n_filters = get_list_size(node_filt_list) From 0576d425652f8d24872393b1eb2eb7e9ffe67add Mon Sep 17 00:00:00 2001 From: Anton Leontiev Date: Mon, 20 Oct 2014 19:06:12 +0400 Subject: [PATCH 94/95] Fix Python 3.x incompatibility in trace test --- tests/test_trace/test_trace.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/test_trace/test_trace.py b/tests/test_trace/test_trace.py index 59488412c7..eab3f922aa 100644 --- a/tests/test_trace/test_trace.py +++ b/tests/test_trace/test_trace.py @@ -23,7 +23,7 @@ def test_run(): print(stdout) returncode = proc.returncode assert returncode == 0, 'OpenMC did not exit successfully.' - assert stdout.find('Simulating Particle 453') != -1 + assert stdout.find(b'Simulating Particle 453') != -1 def test_created_statepoint(): statepoint = glob.glob(os.path.join(cwd, 'statepoint.10.*')) From 0bff38bf194ded61bea2a057f67ddb06211698be Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Tue, 21 Oct 2014 23:52:57 -0400 Subject: [PATCH 95/95] Fix a typo in user's guide and add an entry to the RELAX NG schemata for plots.xml. --- docs/source/usersguide/input.rst | 8 ++++---- src/relaxng/plots.rnc | 17 +++++++++-------- 2 files changed, 13 insertions(+), 12 deletions(-) diff --git a/docs/source/usersguide/input.rst b/docs/source/usersguide/input.rst index d7245bc6e1..f7e70ef209 100644 --- a/docs/source/usersguide/input.rst +++ b/docs/source/usersguide/input.rst @@ -1092,7 +1092,7 @@ The ```` element accepts the following sub-elements: all of the harmonic moments of order 0 to N. N must be between 0 and 10. :total-YN: - The total reaction rate expanded via spherical harmonics about the + The total reaction rate expanded via spherical harmonics about the direction of motion of the neutron, :math:`\Omega`. This score will tally all of the harmonic moments of order 0 to N. N must be between 0 and 10. @@ -1229,7 +1229,7 @@ sub-elements: attribute or sub-element: :pixels: - Specifies the number of pixes or voxels to be used along each of the basis + Specifies the number of pixels or voxels to be used along each of the basis directions for "slice" and "voxel" plots, respectively. Should be two or three integers separated by spaces. @@ -1321,11 +1321,11 @@ attributes or sub-elements. These are not used in "voxel" plots: boundaries. Specifying this as 0 indicates that lines will be 1 pixel thick, specifying 1 indicates 3 pixels thick, specifying 2 indicates 5 pixels thick, etc. - + :color: Specifies the custom color for the meshlines boundaries. Should be 3 integers separated by whitespace. This element is optional. - + *Default*: 0 0 0 (black) *Default*: None diff --git a/src/relaxng/plots.rnc b/src/relaxng/plots.rnc index a7c657864d..27b2ae7f72 100644 --- a/src/relaxng/plots.rnc +++ b/src/relaxng/plots.rnc @@ -3,28 +3,29 @@ element plots { (element id { xsd:int } | attribute id { xsd:int })? & (element filename { xsd:string { maxLength = "50" } } | attribute filename { xsd:string { maxLength = "50" } })? & - (element type { "slice" } | attribute type { "slice" })? & + (element type { "slice" | "voxel" } | + attribute type { "slice" | "voxel" })? & (element color { ( "cell" | "mat" | "material" ) } | attribute color { ( "cell" | "mat" | "material" ) })? & - (element origin { list { xsd:double+ } } | + (element origin { list { xsd:double+ } } | attribute origin { list { xsd:double+ } })? & - (element width { list { xsd:double+ } } | + (element width { list { xsd:double+ } } | attribute width { list { xsd:double+ } })? & (element basis { ( "xy" | "yz" | "xz" ) } | attribute basis { ( "xy" | "yz" | "xz" ) })? & - (element pixels { list { xsd:int+ } } | + (element pixels { list { xsd:int+ } } | attribute pixels { list { xsd:int+ } })? & (element background { list { xsd:int+ } } | attribute background { list { xsd:int+ } })? & element col_spec { (element id { xsd:int } | attribute id { xsd:int }) & - (element rgb { list { xsd:int+ } } | + (element rgb { list { xsd:int+ } } | attribute rgb { list { xsd:int+ } }) }* & element mask { - (element components { list { xsd:int+ } } | + (element components { list { xsd:int+ } } | attribute components { list { xsd:int+ } }) & - (element background { list { xsd:int+ } } | + (element background { list { xsd:int+ } } | attribute background { list { xsd:int+ } }) }* & element meshlines { @@ -32,7 +33,7 @@ element plots { attribute meshtype { ( "tally" | "entropy" | "ufs" | "cmfd" ) }) & (element id { xsd:int } | attribute id { xsd:int })? & (element linewidth { xsd:int } | attribute linewidth { xsd:int }) & - (element color { list { xsd:int+ } } | + (element color { list { xsd:int+ } } | attribute color { list { xsd:int+ } })? }* }*