From 22808785cf963ab21456e7c2765460839d017d22 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Tue, 24 Sep 2013 14:04:27 -0400 Subject: [PATCH 001/109] 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 002/109] 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 003/109] 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 004/109] 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 005/109] 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 006/109] 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 007/109] 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 008/109] 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 009/109] 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 010/109] 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 011/109] 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 012/109] 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 7bb1df8c7402f7c637530d4ba4695625e898e80a Mon Sep 17 00:00:00 2001 From: walshjon Date: Thu, 21 Nov 2013 16:55:54 -0500 Subject: [PATCH 013/109] added res scat variables to template files --- src/templates/settings.rnc | 13 +++++++++++++ src/templates/settings_t.xml | 10 ++++++++++ 2 files changed, 23 insertions(+) diff --git a/src/templates/settings.rnc b/src/templates/settings.rnc index 1c7cabafab..e2f5757ad0 100644 --- a/src/templates/settings.rnc +++ b/src/templates/settings.rnc @@ -112,5 +112,18 @@ element settings { attribute lower_left { list { xsd:double+ } }) & (element upper_right { list { xsd:double+ } } | attribute upper_right { list { xsd:double+ } }) + }? & + + element resonance_scattering { + (element method { xsd:positiveInteger } | + attribute method { xsd:positiveInteger }) & + (element scatterer { xsd:positiveInteger } | + attribute scatterer { xsd:positiveInteger }) & + (element xs_label { xsd:positiveInteger } | + attribute xs_label { xsd:positiveInteger }) & + (element xs_label_0K { xsd:positiveInteger } | + attribute xs_label_0K { xsd:positiveInteger }) & + (element E_min { xsd:double } | attribute E_min { xsd:double }) & + (element E_max { xsd:double } | attribute E_max { xsd:double }) }? } diff --git a/src/templates/settings_t.xml b/src/templates/settings_t.xml index 02ee8a0f12..c00826f817 100644 --- a/src/templates/settings_t.xml +++ b/src/templates/settings_t.xml @@ -42,6 +42,15 @@ + + + + + + + + + @@ -63,6 +72,7 @@ + From 882d7c3cb78e3ce2e79d5649de9856b3c14c3eb8 Mon Sep 17 00:00:00 2001 From: walshjon Date: Fri, 22 Nov 2013 09:23:51 -0500 Subject: [PATCH 014/109] added type for 0K nuclides --- src/ace_header.F90 | 57 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 57 insertions(+) diff --git a/src/ace_header.F90 b/src/ace_header.F90 index 5e2f39a007..0048d455b5 100644 --- a/src/ace_header.F90 +++ b/src/ace_header.F90 @@ -143,6 +143,40 @@ module ace_header procedure :: clear => nuclide_clear ! Deallocates Nuclide end type Nuclide +!=============================================================================== +! NUCLIDE_0K contains all the data for an ACE-format continuous-energy cross +! section that is required for treatment of resonance scattering. The ACE format +! (A Compact ENDF format) is used in MCNP and several other Monte Carlo codes. +!=============================================================================== + + type Nuclide_0K + character(10) :: name ! name of nuclide, e.g. 92235.03c + integer :: zaid ! Z and A identifier, e.g. 92235 + integer :: listing ! index in xs_listings + real(8) :: awr ! weight of nucleus in neutron masses + real(8) :: kT ! temperature in MeV (k*T) + + ! Energy grid information + integer :: n_grid ! # of nuclide grid points + integer, allocatable :: grid_index(:) ! pointers to union grid + real(8), allocatable :: energy(:) ! energy values corresponding to xs + + ! CDF of neutron velocity x cross section + real(8), allocatable :: xs_cdf(:) + + ! Microscopic elastic cross section + real(8), allocatable :: elastic(:) ! elastic scattering + + ! Unresolved resonance data + logical :: urr_present + integer :: urr_inelastic + type(UrrData), pointer :: urr_data => null() + + ! Type-Bound procedures + contains + procedure :: clear => nuclide_clear ! Deallocates Nuclide + end type Nuclide_0K + !=============================================================================== ! SALPHABETA contains S(a,b) data for thermal neutron scattering, typically off ! of light isotopes such as water, graphite, Be, etc @@ -361,4 +395,27 @@ module ace_header end subroutine nuclide_clear +!=============================================================================== +! NUCLIDE_0K_CLEAR resets and deallocates data in Nuclide_0K. +!=============================================================================== + + subroutine nuclide_0K_clear(this) + + class(Nuclide_0K), intent(inout) :: this ! The Nuclide object to clear + + integer :: i ! Loop counter + + if (allocated(this % grid_index)) & + deallocate(this % grid_index) + + if (allocated(this % energy)) & + deallocate(this % elastic, this % xs_cdf) + + if (associated(this % urr_data)) then + call this % urr_data % clear() + deallocate(this % urr_data) + end if + + end subroutine nuclide_0K_clear + end module ace_header From 46d23f60a28f60e445af5caed6fb34e4eb6ec574 Mon Sep 17 00:00:00 2001 From: walshjon Date: Fri, 22 Nov 2013 09:59:33 -0500 Subject: [PATCH 015/109] added 0K xs global variables --- src/global.F90 | 18 ++++++++++++++---- 1 file changed, 14 insertions(+), 4 deletions(-) diff --git a/src/global.F90 b/src/global.F90 index 637ea315e6..4b0a4b1d01 100644 --- a/src/global.F90 +++ b/src/global.F90 @@ -1,7 +1,7 @@ module global use ace_header, only: Nuclide, SAlphaBeta, xsListing, NuclideMicroXS, & - MaterialMacroXS + MaterialMacroXS, Nuclide_0K use bank_header, only: Bank use cmfd_header use constants @@ -61,6 +61,7 @@ module global ! Cross section arrays type(Nuclide), allocatable, target :: nuclides(:) ! Nuclide cross-sections + type(Nuclide_0K), allocatable, target :: nuclides_0K(:) ! 0K nuclides type(SAlphaBeta), allocatable, target :: sab_tables(:) ! S(a,b) tables type(XsListing), allocatable, target :: xs_listings(:) ! cross_sections.xml listings @@ -68,9 +69,10 @@ module global type(NuclideMicroXS), allocatable :: micro_xs(:) ! Cache for each nuclide type(MaterialMacroXS) :: material_xs ! Cache for current material - integer :: n_nuclides_total ! Number of nuclide cross section tables - integer :: n_sab_tables ! Number of S(a,b) thermal scattering tables - integer :: n_listings ! Number of listings in cross_sections.xml + integer :: n_nuclides_total ! Number of nuclide cross section tables + integer :: n_nuclides_0K_total ! Number of 0K nuclide cross section tables + integer :: n_sab_tables ! Number of S(a,b) thermal scattering tables + integer :: n_listings ! Number of listings in cross_sections.xml ! Dictionaries to look up cross sections and listings type(DictCharInt) :: nuclide_dict @@ -401,6 +403,14 @@ contains end do deallocate(nuclides) end if + ! Deallocate 0K cross section data, listings + if (allocated(nuclides_0K)) then + ! First call the clear routines + do i = 1, size(nuclides_0K) + call nuclides_0K(i) % clear() + end do + deallocate(nuclides_0K) + end if if (allocated(sab_tables)) deallocate(sab_tables) if (allocated(xs_listings)) deallocate(xs_listings) if (allocated(micro_xs)) deallocate(micro_xs) From f9311b5780ffb48a31cbe106a251c31e0f5df23b Mon Sep 17 00:00:00 2001 From: walshjon Date: Fri, 22 Nov 2013 10:00:32 -0500 Subject: [PATCH 016/109] modified template files to allow for multiple scatterers --- src/templates/settings.rnc | 16 ++++++++-------- src/templates/settings_t.xml | 8 ++++---- 2 files changed, 12 insertions(+), 12 deletions(-) diff --git a/src/templates/settings.rnc b/src/templates/settings.rnc index e2f5757ad0..f846e950d3 100644 --- a/src/templates/settings.rnc +++ b/src/templates/settings.rnc @@ -115,14 +115,14 @@ element settings { }? & element resonance_scattering { - (element method { xsd:positiveInteger } | - attribute method { xsd:positiveInteger }) & - (element scatterer { xsd:positiveInteger } | - attribute scatterer { xsd:positiveInteger }) & - (element xs_label { xsd:positiveInteger } | - attribute xs_label { xsd:positiveInteger }) & - (element xs_label_0K { xsd:positiveInteger } | - attribute xs_label_0K { xsd:positiveInteger }) & + (element method { xsd:string { maxLength = "16" } } | + attribute method { xsd:string { maxLength = "16" } }) & + (element scatterer { list { xsd:string { maxLength = "12" }+ } } | + attribute scatterer { list { xsd:string { maxLength = "12" }+ } }) & + (element xs_label { list { xsd:string { maxLength = "12" }+ } } | + attribute xs_label { list { xsd:string { maxLength = "12" }+ } }) & + (element xs_label_0K { list { xsd:string { maxLength = "12" }+ } } | + attribute xs_label_0K { list { xsd:string { maxLength = "12" }+ } }) & (element E_min { xsd:double } | attribute E_min { xsd:double }) & (element E_max { xsd:double } | attribute E_max { xsd:double }) }? diff --git a/src/templates/settings_t.xml b/src/templates/settings_t.xml index c00826f817..7fbf624d2f 100644 --- a/src/templates/settings_t.xml +++ b/src/templates/settings_t.xml @@ -43,10 +43,10 @@ - - - - + + + + From 66aff51ccbddc44a664cbcd3ee45c475ba58e3f2 Mon Sep 17 00:00:00 2001 From: walshjon Date: Fri, 22 Nov 2013 10:20:23 -0500 Subject: [PATCH 017/109] added logical indicating resonant nuclides --- src/ace_header.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/ace_header.F90 b/src/ace_header.F90 index 0048d455b5..1be53134a3 100644 --- a/src/ace_header.F90 +++ b/src/ace_header.F90 @@ -108,6 +108,9 @@ module ace_header real(8), allocatable :: absorption(:) ! absorption (MT > 100) real(8), allocatable :: heating(:) ! heating + ! Resonance scattering info + logical :: resonant ! is nuclide to be treated as a resonant scatterer? + ! Fission information logical :: fissionable ! nuclide is fissionable? logical :: has_partial_fission ! nuclide has partial fission reactions? From e1cedd23b953290e4cf72bd8c259902f3ea3fd5f Mon Sep 17 00:00:00 2001 From: walshjon Date: Fri, 22 Nov 2013 11:55:41 -0500 Subject: [PATCH 018/109] first crack at weight correction method (WCM) target sampling --- src/physics.F90 | 170 ++++++++++++++++++++++++++++++++++++------------ 1 file changed, 130 insertions(+), 40 deletions(-) diff --git a/src/physics.F90 b/src/physics.F90 index fb1f891943..411722efeb 100644 --- a/src/physics.F90 +++ b/src/physics.F90 @@ -627,14 +627,19 @@ contains !=============================================================================== ! SAMPLE_TARGET_VELOCITY samples the target velocity based on the free gas ! scattering formulation used by most Monte Carlo codes. Excellent documentation -! for this method can be found in FRA-TM-123. +! for this method can be found in FRA-TM-123. Methods for correctly accounting +! for the energy dependence of cross sections in treating resonance elastic +! scattering such as the DBRC, WCM, and a new, accelerated scheme are also +! implemented here. !=============================================================================== - subroutine sample_target_velocity(nuc, v_target, E, uvw) + subroutine sample_target_velocity(nuc, v_target, E, uvw, v_neut, wgt) type(Nuclide), pointer :: nuc real(8), intent(out) :: v_target(3) + real(8), intent(in) :: v_neut(3) real(8), intent(in) :: E + real(8), intent(inout) :: wgt real(8), intent(in) :: uvw(3) real(8) :: kT ! equilibrium temperature of target in MeV @@ -647,62 +652,147 @@ contains real(8) :: beta_vt ! beta * speed of target real(8) :: beta_vt_sq ! (beta * speed of target)^2 real(8) :: vt ! speed of target + real(8) :: E_old ! tmp storage of current energy + logical :: reject ! resample if true + real(8) :: E_rel ! trial relative energy + real(8) :: xs_0K ! 0K xs at E_rel + real(8) :: wcf ! weight correction factor ! Determine equilibrium temperature in MeV kT = nuc % kT - ! Check if energy is above threshold - if (E >= FREE_GAS_THRESHOLD * kT .and. nuc % awr > ONE) then - v_target = ZERO - return + ! Check if nuclide is a resonant scatterer and which sampling scheme + ! to use based on neutron energy + if (nuc % resonant) then + if (E > E_max_res_scat) then + v_target = ZERO + return + else if (E < E_min_res_scat) then + target_sampling = 'cxs' + end if + else + if (E >= FREE_GAS_THRESHOLD * kT .and. nuc % awr > ONE) then + v_target = ZERO + return + else + target_sampling = 'cxs' end if - ! calculate beta - beta_vn = sqrt(nuc%awr * E / kT) + E_old = E - alpha = ONE/(ONE + sqrt(pi)*beta_vn/TWO) + ! reject unless criteria are satisfied + reject = .true. - do - ! Sample two random numbers - r1 = prn() - r2 = prn() + select case (target_sampling) + case ('svt') + ! calculate beta, alpha + beta_vn = sqrt(nuc%awr * E / kT) + alpha = ONE/(ONE + sqrt(pi)*beta_vn/TWO) - if (prn() < alpha) then - ! With probability alpha, we sample the distribution p(y) = - ! y*e^(-y). This can be done with sampling scheme C45 frmo the Monte - ! Carlo sampler + do + ! Sample two random numbers + r1 = prn() + r2 = prn() - beta_vt_sq = -log(r1*r2) + if (prn() < alpha) then + ! With probability alpha, we sample the distribution p(y) = + ! y*e^(-y). This can be done with sampling scheme C45 frmo the Monte + ! Carlo sampler - else - ! With probability 1-alpha, we sample the distribution p(y) = y^2 * - ! e^(-y^2). This can be done with sampling scheme C61 from the Monte - ! Carlo sampler + beta_vt_sq = -log(r1*r2) - c = cos(PI/TWO * prn()) - beta_vt_sq = -log(r1) - log(r2)*c*c - end if + else + ! With probability 1-alpha, we sample the distribution p(y) = y^2 * + ! e^(-y^2). This can be done with sampling scheme C61 from the Monte + ! Carlo sampler - ! Determine beta * vt - beta_vt = sqrt(beta_vt_sq) + c = cos(PI/TWO * prn()) + beta_vt_sq = -log(r1) - log(r2)*c*c + end if - ! Sample cosine of angle between neutron and target velocity - mu = TWO*prn() - ONE + ! Determine beta * vt + beta_vt = sqrt(beta_vt_sq) - ! Determine rejection probability - accept_prob = sqrt(beta_vn*beta_vn + beta_vt_sq - 2*beta_vn*beta_vt*mu) & - /(beta_vn + beta_vt) + ! Sample cosine of angle between neutron and target velocity + mu = TWO*prn() - ONE - ! Perform rejection sampling on vt and mu - if (prn() < accept_prob) exit - end do + ! Determine rejection probability + accept_prob = sqrt(beta_vn*beta_vn + beta_vt_sq - 2*beta_vn*beta_vt*mu) & + /(beta_vn + beta_vt) - ! determine speed of target nucleus - vt = sqrt(beta_vt_sq*kT/nuc % awr) + ! Perform rejection sampling on vt and mu + if (prn() < accept_prob) exit + end do - ! determine velocity vector of target nucleus based on neutron's velocity - ! and the sampled angle between them - v_target = vt * rotate_angle(uvw, mu) + ! determine speed of target nucleus + vt = sqrt(beta_vt_sq*kT/nuc % awr) + + ! determine velocity vector of target nucleus based on neutron's velocity + ! and the sampled angle between them + v_target = vt * rotate_angle(uvw, mu) + + case ('wcm') + ! calculate beta, alpha + beta_vn = sqrt(nuc%awr * E / kT) + alpha = ONE/(ONE + sqrt(pi)*beta_vn/TWO) + + do + ! Sample two random numbers + r1 = prn() + r2 = prn() + + if (prn() < alpha) then + ! With probability alpha, we sample the distribution p(y) = + ! y*e^(-y). This can be done with sampling scheme C45 frmo the Monte + ! Carlo sampler + + beta_vt_sq = -log(r1*r2) + + else + ! With probability 1-alpha, we sample the distribution p(y) = y^2 * + ! e^(-y^2). This can be done with sampling scheme C61 from the Monte + ! Carlo sampler + + c = cos(PI/TWO * prn()) + beta_vt_sq = -log(r1) - log(r2)*c*c + end if + + ! Determine beta * vt + beta_vt = sqrt(beta_vt_sq) + + ! Sample cosine of angle between neutron and target velocity + mu = TWO*prn() - ONE + + ! Determine rejection probability + accept_prob = sqrt(beta_vn*beta_vn + beta_vt_sq - 2*beta_vn*beta_vt*mu) & + /(beta_vn + beta_vt) + + ! Perform rejection sampling on vt and mu + if (prn() < accept_prob) exit + end do + + ! determine speed of target nucleus + vt = sqrt(beta_vt_sq*kT/nuc % awr) + + ! determine velocity vector of target nucleus based on neutron's velocity + ! and the sampled angle between them + v_target = vt * rotate_angle(uvw, mu) + + ! adjust particle weight + E_rel = dot_product((v_neut - v_target), (v_neut - v_target)) + E = E_rel + if (grid_method == GRID_UNION) call find_energy_index(E) + call calculate_elastic_xs(nuc % i_nuclide_0K, NONE) + xs_0K = micro_xs(i_nuclide_0K) % elastic + wcf = xs_0K / micro_xs(i_nuclide) % elastic + wgt = wcf * wgt + + E = E_old + + case default + message = "Not a recognized resonance scattering treatment!" + call fatal_error() + end select end subroutine sample_target_velocity From 0a106a6eaee718b6fa52ce90cf9ad6887bb3ca67 Mon Sep 17 00:00:00 2001 From: walshjon Date: Sat, 23 Nov 2013 09:49:22 -0800 Subject: [PATCH 019/109] allow for diff E ranges and methods for each scatterer --- src/templates/settings.rnc | 10 ++++++---- src/templates/settings_t.xml | 6 +++--- 2 files changed, 9 insertions(+), 7 deletions(-) diff --git a/src/templates/settings.rnc b/src/templates/settings.rnc index f846e950d3..735fc6c4f3 100644 --- a/src/templates/settings.rnc +++ b/src/templates/settings.rnc @@ -115,15 +115,17 @@ element settings { }? & element resonance_scattering { - (element method { xsd:string { maxLength = "16" } } | - attribute method { xsd:string { maxLength = "16" } }) & + (element method { list { xsd:string { maxLength = "16" }+ } | + attribute method { list { xsd:string { maxLength = "16" }+ }) & (element scatterer { list { xsd:string { maxLength = "12" }+ } } | attribute scatterer { list { xsd:string { maxLength = "12" }+ } }) & (element xs_label { list { xsd:string { maxLength = "12" }+ } } | attribute xs_label { list { xsd:string { maxLength = "12" }+ } }) & (element xs_label_0K { list { xsd:string { maxLength = "12" }+ } } | attribute xs_label_0K { list { xsd:string { maxLength = "12" }+ } }) & - (element E_min { xsd:double } | attribute E_min { xsd:double }) & - (element E_max { xsd:double } | attribute E_max { xsd:double }) + (element E_min { list { xsd:double+ } } | + attribute E_min { list { xsd:double+ } }) & + (element E_max { list { xsd:double+ } } | + attribute E_max { list { xsd:double+ } }) }? } diff --git a/src/templates/settings_t.xml b/src/templates/settings_t.xml index 7fbf624d2f..dbceb7550d 100644 --- a/src/templates/settings_t.xml +++ b/src/templates/settings_t.xml @@ -43,12 +43,12 @@ - + - - + + From 9d6d66e33c4cdb4f4136801f72861fed76948946 Mon Sep 17 00:00:00 2001 From: walshjon Date: Sat, 23 Nov 2013 09:51:09 -0800 Subject: [PATCH 020/109] added resonance scattering header --- src/res_scat_header.F90 | 60 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 60 insertions(+) create mode 100644 src/res_scat_header.F90 diff --git a/src/res_scat_header.F90 b/src/res_scat_header.F90 new file mode 100644 index 0000000000..3007acc809 --- /dev/null +++ b/src/res_scat_header.F90 @@ -0,0 +1,60 @@ +module res_scat_header + + implicit none + private + + type, public :: ResScatterer + + character(10) :: name ! name of nuclide, e.g. 92235.03c + integer :: zaid ! Z and A identifier, e.g. 92235 + integer :: listing ! index in xs_listings + real(8) :: awr ! weight of nucleus in neutron masses + real(8) :: kT ! temperature in MeV (k*T) + + ! Energy grid information + integer :: n_grid + integer, allocatable :: grid_index(:) ! pointers to union grid + real(8), allocatable :: energy(:) ! energy values corresponding to xs + + ! CDF of neutron velocity x cross section + real(8), allocatable :: xs_cdf(:) + + ! Microscopic elastic cross section + real(8), allocatable :: elastic(:) + + ! lower cutoff energy for resonance scattering + real(8) :: E_min + + ! upper cutoff energy for resonance scattering + real(8) :: E_max + + ! target velocity sampling scheme + character(16) :: scheme + + ! Type-Bound procedures + contains + procedure :: clear => res_scatterer_clear ! Deallocates resonant scatterer + + end type ResScatterer + +contains + +!=============================================================================== +! RES_SCATTERER_CLEAR resets and deallocates data in ResScatterer. +!=============================================================================== + + subroutine res_scatterer_clear(this) + + class(ResScatterer), intent(inout) :: this ! the ResScatterer object to clear + + integer :: i ! Loop counter + + if (allocated(this % grid_index)) & + deallocate(this % grid_index) + + if (allocated(this % energy)) & + deallocate(this % elastic, this % xs_cdf, this % energy) + + end subroutine res_scatterer_clear + +end module res_scat_header From 03edddff8a579051fee61dc60e9fae792b6040c8 Mon Sep 17 00:00:00 2001 From: walshjon Date: Sat, 23 Nov 2013 09:52:52 -0800 Subject: [PATCH 021/109] cleaned up variables to switch to the ones defined in res_scat_header --- src/ace_header.F90 | 58 +--------- src/global.F90 | 35 ++++-- src/physics.F90 | 271 +++++++++++++++++++++++---------------------- 3 files changed, 162 insertions(+), 202 deletions(-) diff --git a/src/ace_header.F90 b/src/ace_header.F90 index 1be53134a3..4f0bb6e5d4 100644 --- a/src/ace_header.F90 +++ b/src/ace_header.F90 @@ -110,6 +110,7 @@ module ace_header ! Resonance scattering info logical :: resonant ! is nuclide to be treated as a resonant scatterer? + integer :: i_0K ! index into 0K nuclides (resonant scatterers) ! Fission information logical :: fissionable ! nuclide is fissionable? @@ -146,40 +147,6 @@ module ace_header procedure :: clear => nuclide_clear ! Deallocates Nuclide end type Nuclide -!=============================================================================== -! NUCLIDE_0K contains all the data for an ACE-format continuous-energy cross -! section that is required for treatment of resonance scattering. The ACE format -! (A Compact ENDF format) is used in MCNP and several other Monte Carlo codes. -!=============================================================================== - - type Nuclide_0K - character(10) :: name ! name of nuclide, e.g. 92235.03c - integer :: zaid ! Z and A identifier, e.g. 92235 - integer :: listing ! index in xs_listings - real(8) :: awr ! weight of nucleus in neutron masses - real(8) :: kT ! temperature in MeV (k*T) - - ! Energy grid information - integer :: n_grid ! # of nuclide grid points - integer, allocatable :: grid_index(:) ! pointers to union grid - real(8), allocatable :: energy(:) ! energy values corresponding to xs - - ! CDF of neutron velocity x cross section - real(8), allocatable :: xs_cdf(:) - - ! Microscopic elastic cross section - real(8), allocatable :: elastic(:) ! elastic scattering - - ! Unresolved resonance data - logical :: urr_present - integer :: urr_inelastic - type(UrrData), pointer :: urr_data => null() - - ! Type-Bound procedures - contains - procedure :: clear => nuclide_clear ! Deallocates Nuclide - end type Nuclide_0K - !=============================================================================== ! SALPHABETA contains S(a,b) data for thermal neutron scattering, typically off ! of light isotopes such as water, graphite, Be, etc @@ -398,27 +365,4 @@ module ace_header end subroutine nuclide_clear -!=============================================================================== -! NUCLIDE_0K_CLEAR resets and deallocates data in Nuclide_0K. -!=============================================================================== - - subroutine nuclide_0K_clear(this) - - class(Nuclide_0K), intent(inout) :: this ! The Nuclide object to clear - - integer :: i ! Loop counter - - if (allocated(this % grid_index)) & - deallocate(this % grid_index) - - if (allocated(this % energy)) & - deallocate(this % elastic, this % xs_cdf) - - if (associated(this % urr_data)) then - call this % urr_data % clear() - deallocate(this % urr_data) - end if - - end subroutine nuclide_0K_clear - end module ace_header diff --git a/src/global.F90 b/src/global.F90 index 4b0a4b1d01..02f618fbb7 100644 --- a/src/global.F90 +++ b/src/global.F90 @@ -1,7 +1,7 @@ module global use ace_header, only: Nuclide, SAlphaBeta, xsListing, NuclideMicroXS, & - MaterialMacroXS, Nuclide_0K + MaterialMacroXS use bank_header, only: Bank use cmfd_header use constants @@ -11,6 +11,7 @@ module global use mesh_header, only: StructuredMesh use plot_header, only: ObjectPlot use set_header, only: SetInt + use res_scat_header, only: ResScatterer use source_header, only: ExtSource use tally_header, only: TallyObject, TallyMap, TallyResult use timer_header, only: Timer @@ -61,7 +62,6 @@ module global ! Cross section arrays type(Nuclide), allocatable, target :: nuclides(:) ! Nuclide cross-sections - type(Nuclide_0K), allocatable, target :: nuclides_0K(:) ! 0K nuclides type(SAlphaBeta), allocatable, target :: sab_tables(:) ! S(a,b) tables type(XsListing), allocatable, target :: xs_listings(:) ! cross_sections.xml listings @@ -70,7 +70,6 @@ module global type(MaterialMacroXS) :: material_xs ! Cache for current material integer :: n_nuclides_total ! Number of nuclide cross section tables - integer :: n_nuclides_0K_total ! Number of 0K nuclide cross section tables integer :: n_sab_tables ! Number of S(a,b) thermal scattering tables integer :: n_listings ! Number of listings in cross_sections.xml @@ -369,7 +368,19 @@ module global logical :: output_summary = .false. logical :: output_xs = .false. logical :: output_tallies = .true. + + ! ============================================================================ + ! RESONANCE SCATTERING VARIABLES + ! Is resonance scattering treated? + logical :: treat_res_scat = .false. + + ! Number of resonant scatterers + integer :: n_res_scatterers_total + + ! Main object + type(ResScatterer), allocatable, target :: res_scatterers(:) + !$omp threadprivate(micro_xs, material_xs, fission_bank, n_bank, message, & !$omp& trace, thread_id, current_work, matching_bins) @@ -403,18 +414,20 @@ contains end do deallocate(nuclides) end if - ! Deallocate 0K cross section data, listings - if (allocated(nuclides_0K)) then - ! First call the clear routines - do i = 1, size(nuclides_0K) - call nuclides_0K(i) % clear() - end do - deallocate(nuclides_0K) - end if + if (allocated(sab_tables)) deallocate(sab_tables) if (allocated(xs_listings)) deallocate(xs_listings) if (allocated(micro_xs)) deallocate(micro_xs) + ! Deallocate resonance scattering data + if (allocated(res_scatterers)) then + ! First call the clear routines + do i = 1, size(res_scatterers) + call res_scatterers(i) % clear() + end do + deallocate(res_scatterers) + end if + ! Deallocate external source if (allocated(external_source % params_space)) & deallocate(external_source % params_space) diff --git a/src/physics.F90 b/src/physics.F90 index 411722efeb..abe1c3303d 100644 --- a/src/physics.F90 +++ b/src/physics.F90 @@ -2,6 +2,7 @@ module physics use ace_header, only: Nuclide, Reaction, DistEnergy use constants + use cross_section, only: elastic_0K_xs use endf, only: reaction_name use error, only: fatal_error, warning use fission, only: nu_total, nu_delayed @@ -14,6 +15,7 @@ module physics use particle_header, only: Particle use particle_restart_write, only: write_particle_restart use random_lcg, only: prn + use res_scat_header, only: ResScatterer use search, only: binary_search use string, only: to_str @@ -344,7 +346,7 @@ contains ! Perform collision physics for elastic scattering call elastic_scatter(i_nuclide, rxn, & - p % E, p % coord0 % uvw, p % mu) + p % E, p % coord0 % uvw, p % mu, p % wgt) end if p % event_MT = ELASTIC @@ -403,13 +405,14 @@ contains ! target. !=============================================================================== - subroutine elastic_scatter(i_nuclide, rxn, E, uvw, mu_lab) + subroutine elastic_scatter(i_nuclide, rxn, E, uvw, mu_lab, wgt) integer, intent(in) :: i_nuclide type(Reaction), pointer :: rxn real(8), intent(inout) :: E real(8), intent(inout) :: uvw(3) real(8), intent(out) :: mu_lab + real(8), intent(inout) :: wgt real(8) :: awr ! atomic weight ratio of target real(8) :: mu_cm ! cosine of polar angle in center-of-mass @@ -432,7 +435,7 @@ contains ! Sample velocity of target nucleus if (.not. micro_xs(i_nuclide) % use_ptable) then - call sample_target_velocity(nuc, v_t, E, uvw) + call sample_target_velocity(nuc, v_t, E, uvw, v_n, wgt, micro_xs(i_nuclide) % elastic) else v_t = ZERO end if @@ -633,14 +636,16 @@ contains ! implemented here. !=============================================================================== - subroutine sample_target_velocity(nuc, v_target, E, uvw, v_neut, wgt) + subroutine sample_target_velocity(nuc, v_target, E, uvw, v_neut, wgt, xs_eff) - type(Nuclide), pointer :: nuc - real(8), intent(out) :: v_target(3) - real(8), intent(in) :: v_neut(3) - real(8), intent(in) :: E - real(8), intent(inout) :: wgt - real(8), intent(in) :: uvw(3) + type(Nuclide), pointer :: nuc ! target nuclide at temperature + type(ResScatterer), pointer :: nuc_0K => null() ! (resonant) target nuclide at 0K + + real(8), intent(out) :: v_target(3) + real(8), intent(in) :: v_neut(3) + real(8), intent(in) :: E + real(8), intent(in) :: uvw(3) + real(8), intent(inout) :: wgt real(8) :: kT ! equilibrium temperature of target in MeV real(8) :: alpha ! probability of sampling f2 over f1 @@ -652,148 +657,146 @@ contains real(8) :: beta_vt ! beta * speed of target real(8) :: beta_vt_sq ! (beta * speed of target)^2 real(8) :: vt ! speed of target - real(8) :: E_old ! tmp storage of current energy - logical :: reject ! resample if true +! real(8) :: E_old ! tmp storage of current energy real(8) :: E_rel ! trial relative energy real(8) :: xs_0K ! 0K xs at E_rel + real(8) :: xs_eff ! effective elastic xs at temperature T real(8) :: wcf ! weight correction factor + logical :: reject ! resample if true + + nuc_0K => res_scatterers(nuc % i_0K) + ! Determine equilibrium temperature in MeV kT = nuc % kT ! Check if nuclide is a resonant scatterer and which sampling scheme ! to use based on neutron energy if (nuc % resonant) then - if (E > E_max_res_scat) then - v_target = ZERO - return - else if (E < E_min_res_scat) then - target_sampling = 'cxs' - end if + if (E > nuc_0K % E_max) then + v_target = ZERO + return + else if (E < nuc_0K % E_min) then + nuc_0K % scheme = 'cxs' + end if else - if (E >= FREE_GAS_THRESHOLD * kT .and. nuc % awr > ONE) then - v_target = ZERO - return - else - target_sampling = 'cxs' + if (E >= FREE_GAS_THRESHOLD * kT .and. nuc % awr > ONE) then + v_target = ZERO + return + else + nuc_0K % scheme = 'cxs' + end if end if - E_old = E - ! reject unless criteria are satisfied reject = .true. - - select case (target_sampling) - case ('svt') - ! calculate beta, alpha - beta_vn = sqrt(nuc%awr * E / kT) - alpha = ONE/(ONE + sqrt(pi)*beta_vn/TWO) - - do - ! Sample two random numbers - r1 = prn() - r2 = prn() - - if (prn() < alpha) then - ! With probability alpha, we sample the distribution p(y) = - ! y*e^(-y). This can be done with sampling scheme C45 frmo the Monte - ! Carlo sampler - - beta_vt_sq = -log(r1*r2) - - else - ! With probability 1-alpha, we sample the distribution p(y) = y^2 * - ! e^(-y^2). This can be done with sampling scheme C61 from the Monte - ! Carlo sampler - - c = cos(PI/TWO * prn()) - beta_vt_sq = -log(r1) - log(r2)*c*c - end if - - ! Determine beta * vt - beta_vt = sqrt(beta_vt_sq) - - ! Sample cosine of angle between neutron and target velocity - mu = TWO*prn() - ONE - - ! Determine rejection probability - accept_prob = sqrt(beta_vn*beta_vn + beta_vt_sq - 2*beta_vn*beta_vt*mu) & - /(beta_vn + beta_vt) - - ! Perform rejection sampling on vt and mu - if (prn() < accept_prob) exit - end do - - ! determine speed of target nucleus - vt = sqrt(beta_vt_sq*kT/nuc % awr) - - ! determine velocity vector of target nucleus based on neutron's velocity - ! and the sampled angle between them - v_target = vt * rotate_angle(uvw, mu) - + + select case (nuc_0K % scheme) + case ('cxs') + ! calculate beta, alpha + beta_vn = sqrt(nuc%awr * E / kT) + alpha = ONE/(ONE + sqrt(pi)*beta_vn/TWO) + + do + ! Sample two random numbers + r1 = prn() + r2 = prn() + + if (prn() < alpha) then + ! With probability alpha, we sample the distribution p(y) = + ! y*e^(-y). This can be done with sampling scheme C45 frmo the Monte + ! Carlo sampler + + beta_vt_sq = -log(r1*r2) + + else + ! With probability 1-alpha, we sample the distribution p(y) = y^2 * + ! e^(-y^2). This can be done with sampling scheme C61 from the Monte + ! Carlo sampler + + c = cos(PI/TWO * prn()) + beta_vt_sq = -log(r1) - log(r2)*c*c + end if + + ! Determine beta * vt + beta_vt = sqrt(beta_vt_sq) + + ! Sample cosine of angle between neutron and target velocity + mu = TWO*prn() - ONE + + ! Determine rejection probability + accept_prob = sqrt(beta_vn*beta_vn + beta_vt_sq - 2*beta_vn*beta_vt*mu) & + /(beta_vn + beta_vt) + + ! Perform rejection sampling on vt and mu + if (prn() < accept_prob) exit + end do + + ! determine speed of target nucleus + vt = sqrt(beta_vt_sq*kT/nuc % awr) + + ! determine velocity vector of target nucleus based on neutron's velocity + ! and the sampled angle between them + v_target = vt * rotate_angle(uvw, mu) + case ('wcm') - ! calculate beta, alpha - beta_vn = sqrt(nuc%awr * E / kT) - alpha = ONE/(ONE + sqrt(pi)*beta_vn/TWO) - - do - ! Sample two random numbers - r1 = prn() - r2 = prn() - - if (prn() < alpha) then - ! With probability alpha, we sample the distribution p(y) = - ! y*e^(-y). This can be done with sampling scheme C45 frmo the Monte - ! Carlo sampler - - beta_vt_sq = -log(r1*r2) - - else - ! With probability 1-alpha, we sample the distribution p(y) = y^2 * - ! e^(-y^2). This can be done with sampling scheme C61 from the Monte - ! Carlo sampler - - c = cos(PI/TWO * prn()) - beta_vt_sq = -log(r1) - log(r2)*c*c - end if - - ! Determine beta * vt - beta_vt = sqrt(beta_vt_sq) - - ! Sample cosine of angle between neutron and target velocity - mu = TWO*prn() - ONE - - ! Determine rejection probability - accept_prob = sqrt(beta_vn*beta_vn + beta_vt_sq - 2*beta_vn*beta_vt*mu) & - /(beta_vn + beta_vt) - - ! Perform rejection sampling on vt and mu - if (prn() < accept_prob) exit - end do - - ! determine speed of target nucleus - vt = sqrt(beta_vt_sq*kT/nuc % awr) - - ! determine velocity vector of target nucleus based on neutron's velocity - ! and the sampled angle between them - v_target = vt * rotate_angle(uvw, mu) - - ! adjust particle weight - E_rel = dot_product((v_neut - v_target), (v_neut - v_target)) - E = E_rel - if (grid_method == GRID_UNION) call find_energy_index(E) - call calculate_elastic_xs(nuc % i_nuclide_0K, NONE) - xs_0K = micro_xs(i_nuclide_0K) % elastic - wcf = xs_0K / micro_xs(i_nuclide) % elastic - wgt = wcf * wgt - - E = E_old - + ! calculate beta, alpha + beta_vn = sqrt(nuc%awr * E / kT) + alpha = ONE/(ONE + sqrt(pi)*beta_vn/TWO) + + do + ! Sample two random numbers + r1 = prn() + r2 = prn() + + if (prn() < alpha) then + ! With probability alpha, we sample the distribution p(y) = + ! y*e^(-y). This can be done with sampling scheme C45 frmo the Monte + ! Carlo sampler + + beta_vt_sq = -log(r1*r2) + + else + ! With probability 1-alpha, we sample the distribution p(y) = y^2 * + ! e^(-y^2). This can be done with sampling scheme C61 from the Monte + ! Carlo sampler + + c = cos(PI/TWO * prn()) + beta_vt_sq = -log(r1) - log(r2)*c*c + end if + + ! Determine beta * vt + beta_vt = sqrt(beta_vt_sq) + + ! Sample cosine of angle between neutron and target velocity + mu = TWO*prn() - ONE + + ! Determine rejection probability + accept_prob = sqrt(beta_vn*beta_vn + beta_vt_sq - 2*beta_vn*beta_vt*mu) & + /(beta_vn + beta_vt) + + ! Perform rejection sampling on vt and mu + if (prn() < accept_prob) exit + end do + + ! determine speed of target nucleus + vt = sqrt(beta_vt_sq*kT/nuc % awr) + + ! determine velocity vector of target nucleus based on neutron's velocity + ! and the sampled angle between them + v_target = vt * rotate_angle(uvw, mu) + + ! adjust particle weight + E_rel = dot_product((v_neut - v_target), (v_neut - v_target)) + xs_0K = elastic_0K_xs(E_rel, nuc_0K, nuc % i_0K) + wcf = xs_0K / xs_eff + wgt = wcf * wgt + case default - message = "Not a recognized resonance scattering treatment!" - call fatal_error() + message = "Not a recognized resonance scattering treatment!" + call fatal_error() end select - + end subroutine sample_target_velocity !=============================================================================== From 4c9dd3f094b9c238e2d09ccb7ff3c321479d1aa5 Mon Sep 17 00:00:00 2001 From: walshjon Date: Sat, 23 Nov 2013 09:53:45 -0800 Subject: [PATCH 022/109] added required dependencies --- src/DEPENDENCIES | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/DEPENDENCIES b/src/DEPENDENCIES index e404cd9913..afb953272a 100644 --- a/src/DEPENDENCIES +++ b/src/DEPENDENCIES @@ -158,6 +158,7 @@ global.o: hdf5_interface.o global.o: material_header.o global.o: mesh_header.o global.o: plot_header.o +global.o: res_scat_header.o global.o: set_header.o global.o: source_header.o global.o: tally_header.o @@ -289,6 +290,7 @@ particle_restart_write.o: string.o physics.o: ace_header.o physics.o: constants.o +physics.o: cross_section.o physics.o: endf.o physics.o: error.o physics.o: fission.o From bead663f806dd48a5b3e94a936e95223e9a74740 Mon Sep 17 00:00:00 2001 From: walshjon Date: Sat, 23 Nov 2013 09:54:34 -0800 Subject: [PATCH 023/109] function for calculating 0K xs --- src/cross_section.F90 | 51 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 51 insertions(+) diff --git a/src/cross_section.F90 b/src/cross_section.F90 index 299033590d..e05b18949b 100644 --- a/src/cross_section.F90 +++ b/src/cross_section.F90 @@ -478,4 +478,55 @@ contains end subroutine find_energy_index +!=============================================================================== +! ELASTIC_0K_XS determines the microscopic elastic cross section for a +! nuclide of a given index in the nuclides array at the energy of the particle +!=============================================================================== + + function elastic_0K_xs(E, nuc_0K, i_0K) result(xs_out) + + type(ResScatterer), pointer :: nuc_0K + + integer, intent(in) :: i_0K ! index into 0K nuclides array + integer :: i_grid ! index on nuclide energy grid + + real(8) :: f ! interp factor on nuclide energy grid + real(8), intent(in) :: E ! trial energy + real(8) :: xs_out + + ! Determine index on nuclide energy grid + select case (grid_method) + case (GRID_UNION) + ! If we're using the unionized grid with pointers, finding the index on + ! the nuclide energy grid is as simple as looking up the pointer + + call find_energy_index(E) + i_grid = nuc_0K % grid_index(union_grid_index) + + case (GRID_NUCLIDE) + ! If we're not using the unionized grid, we have to do a binary search on + ! the nuclide energy grid in order to determine which points to + ! interpolate between + + if (E < nuc_0K % energy(1)) then + i_grid = 1 + elseif (E > nuc_0K % energy(nuc_0K % n_grid)) then + i_grid = nuc_0K % n_grid - 1 + else + i_grid = binary_search(nuc_0K % energy, nuc_0K % n_grid, E) + end if + + end select + + ! check for rare case where two energy points are the same + if (nuc_0K % energy(i_grid) == nuc_0K % energy(i_grid+1)) i_grid = i_grid + 1 + + ! calculate interpolation factor + f = (E - nuc_0K%energy(i_grid))/(nuc_0K%energy(i_grid+1) - nuc_0K%energy(i_grid)) + + ! Calculate microscopic nuclide elastic cross section + xs_out = (ONE - f) * nuc_0K % elastic(i_grid) + f * nuc_0K % elastic(i_grid+1) + + end function elastic_0K_xs + end module cross_section From 99249940e5ed150b63e9ec49e8f0d0aa296e0154 Mon Sep 17 00:00:00 2001 From: walshjon Date: Sat, 23 Nov 2013 15:12:22 -0800 Subject: [PATCH 024/109] moved contents of res_scat_header to ace_header --- src/DEPENDENCIES | 1 - src/Makefile | 4 +-- src/ace_header.F90 | 56 ++++++++++++++++++++++++++++++++++++++ src/global.F90 | 3 +-- src/input_xml.F90 | 10 +++++++ src/physics.F90 | 3 +-- src/res_scat_header.F90 | 60 ----------------------------------------- 7 files changed, 70 insertions(+), 67 deletions(-) delete mode 100644 src/res_scat_header.F90 diff --git a/src/DEPENDENCIES b/src/DEPENDENCIES index afb953272a..016163ce84 100644 --- a/src/DEPENDENCIES +++ b/src/DEPENDENCIES @@ -158,7 +158,6 @@ global.o: hdf5_interface.o global.o: material_header.o global.o: mesh_header.o global.o: plot_header.o -global.o: res_scat_header.o global.o: set_header.o global.o: source_header.o global.o: tally_header.o diff --git a/src/Makefile b/src/Makefile index 4300d42e6e..1a75b941c9 100644 --- a/src/Makefile +++ b/src/Makefile @@ -16,7 +16,7 @@ COMPILER = gnu DEBUG = no PROFILE = no OPTIMIZE = no -MPI = no +MPI = yes OPENMP = no HDF5 = no PETSC = no @@ -25,7 +25,7 @@ PETSC = no # External Library Paths #=============================================================================== -MPI_DIR = /opt/mpich/3.0.4-$(COMPILER) +MPI_DIR = /opt/mpich/3.0.2-$(COMPILER) HDF5_DIR = /opt/hdf5/1.8.11-$(COMPILER) PHDF5_DIR = /opt/phdf5/1.8.11-$(COMPILER) PETSC_DIR = /opt/petsc/3.4.2-$(COMPILER) diff --git a/src/ace_header.F90 b/src/ace_header.F90 index 4f0bb6e5d4..d8b3178e73 100644 --- a/src/ace_header.F90 +++ b/src/ace_header.F90 @@ -147,6 +147,44 @@ module ace_header procedure :: clear => nuclide_clear ! Deallocates Nuclide end type Nuclide +!=============================================================================== +! RESSCATTERER contains all the data for a resonance scattering nuclide at 0K +!=============================================================================== + + type :: ResScatterer + + character(10) :: name ! name of nuclide, e.g. 92235.03c + integer :: zaid ! Z and A identifier, e.g. 92235 + integer :: listing ! index in xs_listings + real(8) :: awr ! weight of nucleus in neutron masses + real(8) :: kT ! temperature in MeV (k*T) + + ! Energy grid information + integer :: n_grid + integer, allocatable :: grid_index(:) ! pointers to union grid + real(8), allocatable :: energy(:) ! energy values corresponding to xs + + ! CDF of neutron velocity x cross section + real(8), allocatable :: xs_cdf(:) + + ! Microscopic elastic cross section + real(8), allocatable :: elastic(:) + + ! lower cutoff energy for resonance scattering + real(8) :: E_min + + ! upper cutoff energy for resonance scattering + real(8) :: E_max + + ! target velocity sampling scheme + character(16) :: scheme + + ! Type-Bound procedures + contains + procedure :: clear => res_scatterer_clear ! Deallocates resonant scatterer + + end type ResScatterer + !=============================================================================== ! SALPHABETA contains S(a,b) data for thermal neutron scattering, typically off ! of light isotopes such as water, graphite, Be, etc @@ -365,4 +403,22 @@ module ace_header end subroutine nuclide_clear +!=============================================================================== +! RES_SCATTERER_CLEAR resets and deallocates data in ResScatterer. +!=============================================================================== + + subroutine res_scatterer_clear(this) + + class(ResScatterer), intent(inout) :: this ! the ResScatterer object to clear + + integer :: i ! Loop counter + + if (allocated(this % grid_index)) & + deallocate(this % grid_index) + + if (allocated(this % energy)) & + deallocate(this % elastic, this % xs_cdf, this % energy) + + end subroutine res_scatterer_clear + end module ace_header diff --git a/src/global.F90 b/src/global.F90 index 02f618fbb7..2b634db409 100644 --- a/src/global.F90 +++ b/src/global.F90 @@ -1,7 +1,7 @@ module global use ace_header, only: Nuclide, SAlphaBeta, xsListing, NuclideMicroXS, & - MaterialMacroXS + MaterialMacroXS, ResScatterer use bank_header, only: Bank use cmfd_header use constants @@ -11,7 +11,6 @@ module global use mesh_header, only: StructuredMesh use plot_header, only: ObjectPlot use set_header, only: SetInt - use res_scat_header, only: ResScatterer use source_header, only: ExtSource use tally_header, only: TallyObject, TallyMap, TallyResult use timer_header, only: Timer diff --git a/src/input_xml.F90 b/src/input_xml.F90 index 9bedbc8b3c..536628ba36 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -602,6 +602,16 @@ contains #endif end if + ! set up resonance scattering treatment + call lower_case(resonance_scattering_ % method(1)) + if (resonance_scattering_ % method(1) /= '') then + treat_res_scat = .true. + n_res_scatterers_total = size(resonance_scattering_ % scatterer) + do i = 1, n_res_scatterers_total + + end do + end if + end subroutine read_settings_xml !=============================================================================== diff --git a/src/physics.F90 b/src/physics.F90 index abe1c3303d..fdd4f50f8a 100644 --- a/src/physics.F90 +++ b/src/physics.F90 @@ -1,6 +1,6 @@ module physics - use ace_header, only: Nuclide, Reaction, DistEnergy + use ace_header, only: Nuclide, Reaction, DistEnergy, ResScatterer use constants use cross_section, only: elastic_0K_xs use endf, only: reaction_name @@ -15,7 +15,6 @@ module physics use particle_header, only: Particle use particle_restart_write, only: write_particle_restart use random_lcg, only: prn - use res_scat_header, only: ResScatterer use search, only: binary_search use string, only: to_str diff --git a/src/res_scat_header.F90 b/src/res_scat_header.F90 deleted file mode 100644 index 3007acc809..0000000000 --- a/src/res_scat_header.F90 +++ /dev/null @@ -1,60 +0,0 @@ -module res_scat_header - - implicit none - private - - type, public :: ResScatterer - - character(10) :: name ! name of nuclide, e.g. 92235.03c - integer :: zaid ! Z and A identifier, e.g. 92235 - integer :: listing ! index in xs_listings - real(8) :: awr ! weight of nucleus in neutron masses - real(8) :: kT ! temperature in MeV (k*T) - - ! Energy grid information - integer :: n_grid - integer, allocatable :: grid_index(:) ! pointers to union grid - real(8), allocatable :: energy(:) ! energy values corresponding to xs - - ! CDF of neutron velocity x cross section - real(8), allocatable :: xs_cdf(:) - - ! Microscopic elastic cross section - real(8), allocatable :: elastic(:) - - ! lower cutoff energy for resonance scattering - real(8) :: E_min - - ! upper cutoff energy for resonance scattering - real(8) :: E_max - - ! target velocity sampling scheme - character(16) :: scheme - - ! Type-Bound procedures - contains - procedure :: clear => res_scatterer_clear ! Deallocates resonant scatterer - - end type ResScatterer - -contains - -!=============================================================================== -! RES_SCATTERER_CLEAR resets and deallocates data in ResScatterer. -!=============================================================================== - - subroutine res_scatterer_clear(this) - - class(ResScatterer), intent(inout) :: this ! the ResScatterer object to clear - - integer :: i ! Loop counter - - if (allocated(this % grid_index)) & - deallocate(this % grid_index) - - if (allocated(this % energy)) & - deallocate(this % elastic, this % xs_cdf, this % energy) - - end subroutine res_scatterer_clear - -end module res_scat_header From 78746e1a928a07100e051626e123704065f11b5b Mon Sep 17 00:00:00 2001 From: walshjon Date: Sun, 24 Nov 2013 16:40:41 -0800 Subject: [PATCH 025/109] started setting up reading in 0K xs --- src/ace.F90 | 204 +++++++++++++++++++++++++++++++++++++++++++++ src/ace_header.F90 | 43 +++++----- src/input_xml.F90 | 8 +- 3 files changed, 233 insertions(+), 22 deletions(-) diff --git a/src/ace.F90 b/src/ace.F90 index d54aa83c28..8ae447d4cc 100644 --- a/src/ace.F90 +++ b/src/ace.F90 @@ -35,6 +35,8 @@ contains integer :: i ! index in materials array integer :: j ! index over nuclides in material integer :: k ! index over S(a,b) tables in material + integer :: l ! index over 0K nuclides + integer :: index_res_scatterers ! index into res_scatterers integer :: i_listing ! index in xs_listings array integer :: i_nuclide ! index in nuclides integer :: i_sab ! index in sab_tables @@ -58,6 +60,8 @@ contains ! ========================================================================== ! READ ALL ACE CROSS SECTION TABLES + index_res_scatterers = 0 + ! Loop over all files MATERIAL_LOOP: do i = 1, n_materials mat => materials(i) @@ -71,6 +75,15 @@ contains name = xs_listings(i_listing) % name alias = xs_listings(i_listing) % alias + ! check if nuclide's a resonant scatterer + do l = 1, n_res_scatterers_total + if (name == res_scatterers(l) % name) then + nuclides(i_nuclide) % resonant = .true. + index_res_scatterers = index_res_scatterers + 1 + nuclides(i_nuclide) % i_0k = index_res_scatterers + end if + end do + ! Keep track of what listing is associated with this nuclide nuc => nuclides(i_nuclide) nuc % listing = i_listing @@ -170,6 +183,26 @@ contains ! Avoid some valgrind leak errors call already_read % clear() + + ! check if nuclide's a resonant scatterer + do l = 1, n_res_scatterers_total + name = res_scatterers(l) % scatterer + i_listing = xs_listing_dict % get_key(name) + name = xs_listings(i_listing) % name + alias = xs_listings(i_listing) % alias + + nuc => nuclides(i_nuclide) + nuc % listing = i_listing + + ! Read the ACE table into the appropriate entry on the nuclides + ! array + call read_ace_table(i_nuclide, i_listing) + + ! Add name and alias to dictionary + call already_read % add(name) + call already_read % add(alias) + end if + end do end subroutine read_xs @@ -344,6 +377,177 @@ contains end subroutine read_ace_table +!=============================================================================== +! READ_0K_ACE_TABLE reads a single cross section table in either ASCII or binary +! format. This routine reads the header data for each table and then calls +! appropriate subroutines to parse the actual data. +!=============================================================================== + + subroutine read_0K_ace_table(i_table, i_listing) + + integer, intent(in) :: i_table ! index in nuclides/sab_tables + integer, intent(in) :: i_listing ! index in xs_listings + + integer :: i ! loop index for XSS records + integer :: j, j1, j2 ! indices in XSS + integer :: record_length ! Fortran record length + integer :: location ! location of ACE table + integer :: entries ! number of entries on each record + integer :: length ! length of ACE table + integer :: in = 7 ! file unit + integer :: zaids(16) ! list of ZAIDs (only used for S(a,b)) + integer :: filetype ! filetype (ASCII or BINARY) + real(8) :: kT ! temperature of table + real(8) :: awrs(16) ! list of atomic weight ratios (not used) + real(8) :: awr ! atomic weight ratio for table + logical :: file_exists ! does ACE library exist? + character(7) :: readable ! is ACE library readable? + character(10) :: name ! name of ACE table + character(10) :: date_ ! date ACE library was processed + character(10) :: mat ! material identifier + character(70) :: comment ! comment for ACE table + character(MAX_FILE_LEN) :: filename ! path to ACE cross section library + type(Nuclide), pointer :: nuc => null() + type(SAlphaBeta), pointer :: sab => null() + type(XsListing), pointer :: listing => null() + + ! determine path, record length, and location of table + listing => xs_listings(i_listing) + filename = listing % path + record_length = listing % recl + location = listing % location + entries = listing % entries + filetype = listing % filetype + + ! 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() + elseif (readable(1:3) == 'NO') then + message = "ACE library '" // trim(filename) // "' is not readable! & + &Change file permissions with chmod command." + call fatal_error() + end if + + ! display message + message = "Loading ACE cross section table: " // listing % name + call write_message(6) + + if (filetype == ASCII) then + ! ======================================================================= + ! READ ACE TABLE IN ASCII FORMAT + + ! Find location of table + open(UNIT=in, FILE=filename, STATUS='old', ACTION='read') + rewind(UNIT=in) + do i = 1, location - 1 + read(UNIT=in, FMT=*) + end do + + ! Read first line of header + read(UNIT=in, FMT='(A10,2G12.0,1X,A10)') name, awr, kT, date_ + + ! 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() + end if + + ! Read more header and NXS and JXS + read(UNIT=in, FMT=100) comment, mat, & + (zaids(i), awrs(i), i=1,16), NXS, JXS +100 format(A70,A10/4(I7,F11.0)/4(I7,F11.0)/4(I7,F11.0)/4(I7,F11.0)/& + ,8I9/8I9/8I9/8I9/8I9/8I9) + + ! determine table length + length = NXS(1) + allocate(XSS(length)) + + ! Read XSS array + read(UNIT=in, FMT='(4G20.0)') XSS + + ! Close ACE file + close(UNIT=in) + + elseif (filetype == BINARY) then + ! ======================================================================= + ! READ ACE TABLE IN BINARY FORMAT + + ! Open ACE file + open(UNIT=in, FILE=filename, STATUS='old', ACTION='read', & + ACCESS='direct', RECL=record_length) + + ! Read all header information + read(UNIT=in, REC=location) name, awr, kT, date_, & + comment, mat, (zaids(i), awrs(i), i=1,16), NXS, JXS + + ! determine table length + length = NXS(1) + allocate(XSS(length)) + + ! Read remaining records with XSS + do i = 1, (length + entries - 1)/entries + j1 = 1 + (i-1)*entries + j2 = min(length, j1 + entries - 1) + read(UNIT=IN, REC=location + i) (XSS(j), j=j1,j2) + end do + + ! Close ACE file + close(UNIT=in) + end if + + ! ========================================================================== + ! PARSE DATA BASED ON NXS, JXS, AND XSS ARRAYS + + select case(listing % type) + case (ACE_NEUTRON) + nuc => nuclides(i_table) + nuc % name = name + nuc % awr = awr + nuc % kT = kT + nuc % zaid = NXS(2) + + ! read all blocks + call read_esz(nuc) + call read_nu_data(nuc) + call read_reactions(nuc) + call read_angular_dist(nuc) + call read_energy_dist(nuc) + call read_unr_res(nuc) + + ! Currently subcritical fixed source calculations are not allowed. Thus, + ! 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() + end if + + ! for fissionable nuclides, precalculate microscopic nu-fission cross + ! sections so that we don't need to call the nu_total function during + ! cross section lookups + + if (nuc % fissionable) call generate_nu_fission(nuc) + + case (ACE_THERMAL) + sab => sab_tables(i_table) + sab % name = name + sab % awr = awr + sab % kT = kT + sab % zaid = zaids(1) + + call read_thermal_data(sab) + end select + + deallocate(XSS) + if(associated(nuc)) nullify(nuc) + if(associated(sab)) nullify(sab) + + end subroutine read_0K_ace_table + !=============================================================================== ! READ_ESZ - reads through the ESZ block. This block contains the energy grid, ! total xs, absorption xs, elastic scattering xs, and heating numbers. diff --git a/src/ace_header.F90 b/src/ace_header.F90 index d8b3178e73..425d2a36c4 100644 --- a/src/ace_header.F90 +++ b/src/ace_header.F90 @@ -153,36 +153,37 @@ module ace_header type :: ResScatterer - character(10) :: name ! name of nuclide, e.g. 92235.03c - integer :: zaid ! Z and A identifier, e.g. 92235 - integer :: listing ! index in xs_listings - real(8) :: awr ! weight of nucleus in neutron masses - real(8) :: kT ! temperature in MeV (k*T) + character(10) :: name ! name of nuclide, e.g. 92235.70c + character(10) :: name_0K ! name of 0K nuclide, e.g. 92235.00c +! integer :: zaid ! Z and A identifier, e.g. 92235 +! integer :: listing ! index in xs_listings +! real(8) :: awr ! weight of nucleus in neutron masses +! real(8) :: kT ! temperature in MeV (k*T) - ! Energy grid information - integer :: n_grid - integer, allocatable :: grid_index(:) ! pointers to union grid - real(8), allocatable :: energy(:) ! energy values corresponding to xs + ! Energy grid information +! integer :: n_grid +! integer, allocatable :: grid_index(:) ! pointers to union grid +! real(8), allocatable :: energy(:) ! energy values corresponding to xs - ! CDF of neutron velocity x cross section - real(8), allocatable :: xs_cdf(:) + ! CDF of neutron velocity x cross section +! real(8), allocatable :: xs_cdf(:) - ! Microscopic elastic cross section - real(8), allocatable :: elastic(:) + ! Microscopic elastic cross section +! real(8), allocatable :: elastic(:) - ! lower cutoff energy for resonance scattering + ! lower cutoff energy for resonance scattering real(8) :: E_min - ! upper cutoff energy for resonance scattering + ! upper cutoff energy for resonance scattering real(8) :: E_max - ! target velocity sampling scheme + ! target velocity sampling scheme character(16) :: scheme - - ! Type-Bound procedures - contains - procedure :: clear => res_scatterer_clear ! Deallocates resonant scatterer - + + ! Type-Bound procedures + contains + procedure :: clear => res_scatterer_clear ! Deallocates resonant scatterer + end type ResScatterer !=============================================================================== diff --git a/src/input_xml.F90 b/src/input_xml.F90 index 536628ba36..32ea3e2f64 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -607,8 +607,13 @@ contains if (resonance_scattering_ % method(1) /= '') then treat_res_scat = .true. n_res_scatterers_total = size(resonance_scattering_ % scatterer) + allocate(res_scatterers(n_res_scatterers_total)) do i = 1, n_res_scatterers_total - + res_scatterers(i) % name = trim(resonance_scattering_ % xs_label(i)) + res_scatterers(i) % name_0K = trim(resonance_scattering_ % xs_0K_label(i)) + res_scatterers(i) % scheme = trim(resonance_scattering_ % method(i)) + res_scatterers(i) % E_min = resonance_scattering_ % E_min(i) + res_scatterers(i) % E_max = resonance_scattering_ % E_max(i) end do end if @@ -1052,6 +1057,7 @@ contains integer :: i ! loop index for materials integer :: j ! loop index for nuclides + integer :: k ! loop index for resonant scatterers integer :: n ! number of nuclides integer :: n_sab ! number of sab tables for a material integer :: index_list ! index in xs_listings array From e77d2d51ff692b054d77e37e1c920c23ec5e5762 Mon Sep 17 00:00:00 2001 From: walshjon Date: Tue, 26 Nov 2013 10:09:35 -0800 Subject: [PATCH 026/109] incorporated ResScatterer derived type into Nuclide --- src/ace_header.F90 | 71 +++++++--------------------------------------- 1 file changed, 10 insertions(+), 61 deletions(-) diff --git a/src/ace_header.F90 b/src/ace_header.F90 index 425d2a36c4..b880032070 100644 --- a/src/ace_header.F90 +++ b/src/ace_header.F90 @@ -109,8 +109,13 @@ module ace_header real(8), allocatable :: heating(:) ! heating ! Resonance scattering info - logical :: resonant ! is nuclide to be treated as a resonant scatterer? - integer :: i_0K ! index into 0K nuclides (resonant scatterers) + logical :: resonant = .false. ! resonant scatterer? + character(10) :: name_0K ! name of 0K nuclide, e.g. 92235.00c + character(16) :: scheme ! target velocity sampling scheme + real(8), allocatable :: xs_cdf(:) ! CDF of v_rel times cross section + real(8), allocatable :: elastic_0K(:) ! Microscopic elastic cross section + real(8) :: E_min ! lower cutoff energy for res scattering + real(8) :: E_max ! upper cutoff energy for res scattering ! Fission information logical :: fissionable ! nuclide is fissionable? @@ -146,46 +151,7 @@ module ace_header contains procedure :: clear => nuclide_clear ! Deallocates Nuclide end type Nuclide - -!=============================================================================== -! RESSCATTERER contains all the data for a resonance scattering nuclide at 0K -!=============================================================================== - - type :: ResScatterer - - character(10) :: name ! name of nuclide, e.g. 92235.70c - character(10) :: name_0K ! name of 0K nuclide, e.g. 92235.00c -! integer :: zaid ! Z and A identifier, e.g. 92235 -! integer :: listing ! index in xs_listings -! real(8) :: awr ! weight of nucleus in neutron masses -! real(8) :: kT ! temperature in MeV (k*T) - - ! Energy grid information -! integer :: n_grid -! integer, allocatable :: grid_index(:) ! pointers to union grid -! real(8), allocatable :: energy(:) ! energy values corresponding to xs - - ! CDF of neutron velocity x cross section -! real(8), allocatable :: xs_cdf(:) - - ! Microscopic elastic cross section -! real(8), allocatable :: elastic(:) - - ! lower cutoff energy for resonance scattering - real(8) :: E_min - - ! upper cutoff energy for resonance scattering - real(8) :: E_max - - ! target velocity sampling scheme - character(16) :: scheme - ! Type-Bound procedures - contains - procedure :: clear => res_scatterer_clear ! Deallocates resonant scatterer - - end type ResScatterer - !=============================================================================== ! SALPHABETA contains S(a,b) data for thermal neutron scattering, typically off ! of light isotopes such as water, graphite, Be, etc @@ -363,8 +329,9 @@ module ace_header deallocate(this % grid_index) if (allocated(this % energy)) & - deallocate(this % total, this % elastic, this % fission, & - this % nu_fission, this % absorption) + deallocate(this % total, this % elastic, this % fission, & + this % nu_fission, this % absorption, & + this % elastic_0K, this % xs_cdf) if (allocated(this % heating)) & deallocate(this % heating) @@ -404,22 +371,4 @@ module ace_header end subroutine nuclide_clear -!=============================================================================== -! RES_SCATTERER_CLEAR resets and deallocates data in ResScatterer. -!=============================================================================== - - subroutine res_scatterer_clear(this) - - class(ResScatterer), intent(inout) :: this ! the ResScatterer object to clear - - integer :: i ! Loop counter - - if (allocated(this % grid_index)) & - deallocate(this % grid_index) - - if (allocated(this % energy)) & - deallocate(this % elastic, this % xs_cdf, this % energy) - - end subroutine res_scatterer_clear - end module ace_header From e69706b92188e8b15d6f7faf68228258bcac2342 Mon Sep 17 00:00:00 2001 From: walshjon Date: Tue, 26 Nov 2013 10:12:51 -0800 Subject: [PATCH 027/109] removed separate 0K subroutines --- src/ace.F90 | 215 +++------------------------------------------------- 1 file changed, 11 insertions(+), 204 deletions(-) diff --git a/src/ace.F90 b/src/ace.F90 index 8ae447d4cc..0cb97c647b 100644 --- a/src/ace.F90 +++ b/src/ace.F90 @@ -35,11 +35,11 @@ contains integer :: i ! index in materials array integer :: j ! index over nuclides in material integer :: k ! index over S(a,b) tables in material - integer :: l ! index over 0K nuclides - integer :: index_res_scatterers ! index into res_scatterers + integer :: l ! index over res_scatterers integer :: i_listing ! index in xs_listings array integer :: i_nuclide ! index in nuclides integer :: i_sab ! index in sab_tables + integer :: i_res_scat = 0 ! index in res_scatterers integer :: m ! position for sorting integer :: temp_nuclide ! temporary value for sorting integer :: temp_table ! temporary value for sorting @@ -60,8 +60,6 @@ contains ! ========================================================================== ! READ ALL ACE CROSS SECTION TABLES - index_res_scatterers = 0 - ! Loop over all files MATERIAL_LOOP: do i = 1, n_materials mat => materials(i) @@ -75,19 +73,19 @@ contains name = xs_listings(i_listing) % name alias = xs_listings(i_listing) % alias - ! check if nuclide's a resonant scatterer - do l = 1, n_res_scatterers_total - if (name == res_scatterers(l) % name) then - nuclides(i_nuclide) % resonant = .true. - index_res_scatterers = index_res_scatterers + 1 - nuclides(i_nuclide) % i_0k = index_res_scatterers - end if - end do - ! Keep track of what listing is associated with this nuclide nuc => nuclides(i_nuclide) nuc % listing = i_listing + do l = 1, n_res_scatterers_total + if (name == res_scatterers(l) % name) then + i_res_scat = i_res_scat + 1 + nuclides(i_nuclide) % resonant = .true. + nuclides(i_nuclide) % i_0K = i_res_scat + exit + end if + end do + ! Read the ACE table into the appropriate entry on the nuclides ! array call read_ace_table(i_nuclide, i_listing) @@ -183,26 +181,6 @@ contains ! Avoid some valgrind leak errors call already_read % clear() - - ! check if nuclide's a resonant scatterer - do l = 1, n_res_scatterers_total - name = res_scatterers(l) % scatterer - i_listing = xs_listing_dict % get_key(name) - name = xs_listings(i_listing) % name - alias = xs_listings(i_listing) % alias - - nuc => nuclides(i_nuclide) - nuc % listing = i_listing - - ! Read the ACE table into the appropriate entry on the nuclides - ! array - call read_ace_table(i_nuclide, i_listing) - - ! Add name and alias to dictionary - call already_read % add(name) - call already_read % add(alias) - end if - end do end subroutine read_xs @@ -377,177 +355,6 @@ contains end subroutine read_ace_table -!=============================================================================== -! READ_0K_ACE_TABLE reads a single cross section table in either ASCII or binary -! format. This routine reads the header data for each table and then calls -! appropriate subroutines to parse the actual data. -!=============================================================================== - - subroutine read_0K_ace_table(i_table, i_listing) - - integer, intent(in) :: i_table ! index in nuclides/sab_tables - integer, intent(in) :: i_listing ! index in xs_listings - - integer :: i ! loop index for XSS records - integer :: j, j1, j2 ! indices in XSS - integer :: record_length ! Fortran record length - integer :: location ! location of ACE table - integer :: entries ! number of entries on each record - integer :: length ! length of ACE table - integer :: in = 7 ! file unit - integer :: zaids(16) ! list of ZAIDs (only used for S(a,b)) - integer :: filetype ! filetype (ASCII or BINARY) - real(8) :: kT ! temperature of table - real(8) :: awrs(16) ! list of atomic weight ratios (not used) - real(8) :: awr ! atomic weight ratio for table - logical :: file_exists ! does ACE library exist? - character(7) :: readable ! is ACE library readable? - character(10) :: name ! name of ACE table - character(10) :: date_ ! date ACE library was processed - character(10) :: mat ! material identifier - character(70) :: comment ! comment for ACE table - character(MAX_FILE_LEN) :: filename ! path to ACE cross section library - type(Nuclide), pointer :: nuc => null() - type(SAlphaBeta), pointer :: sab => null() - type(XsListing), pointer :: listing => null() - - ! determine path, record length, and location of table - listing => xs_listings(i_listing) - filename = listing % path - record_length = listing % recl - location = listing % location - entries = listing % entries - filetype = listing % filetype - - ! 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() - elseif (readable(1:3) == 'NO') then - message = "ACE library '" // trim(filename) // "' is not readable! & - &Change file permissions with chmod command." - call fatal_error() - end if - - ! display message - message = "Loading ACE cross section table: " // listing % name - call write_message(6) - - if (filetype == ASCII) then - ! ======================================================================= - ! READ ACE TABLE IN ASCII FORMAT - - ! Find location of table - open(UNIT=in, FILE=filename, STATUS='old', ACTION='read') - rewind(UNIT=in) - do i = 1, location - 1 - read(UNIT=in, FMT=*) - end do - - ! Read first line of header - read(UNIT=in, FMT='(A10,2G12.0,1X,A10)') name, awr, kT, date_ - - ! 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() - end if - - ! Read more header and NXS and JXS - read(UNIT=in, FMT=100) comment, mat, & - (zaids(i), awrs(i), i=1,16), NXS, JXS -100 format(A70,A10/4(I7,F11.0)/4(I7,F11.0)/4(I7,F11.0)/4(I7,F11.0)/& - ,8I9/8I9/8I9/8I9/8I9/8I9) - - ! determine table length - length = NXS(1) - allocate(XSS(length)) - - ! Read XSS array - read(UNIT=in, FMT='(4G20.0)') XSS - - ! Close ACE file - close(UNIT=in) - - elseif (filetype == BINARY) then - ! ======================================================================= - ! READ ACE TABLE IN BINARY FORMAT - - ! Open ACE file - open(UNIT=in, FILE=filename, STATUS='old', ACTION='read', & - ACCESS='direct', RECL=record_length) - - ! Read all header information - read(UNIT=in, REC=location) name, awr, kT, date_, & - comment, mat, (zaids(i), awrs(i), i=1,16), NXS, JXS - - ! determine table length - length = NXS(1) - allocate(XSS(length)) - - ! Read remaining records with XSS - do i = 1, (length + entries - 1)/entries - j1 = 1 + (i-1)*entries - j2 = min(length, j1 + entries - 1) - read(UNIT=IN, REC=location + i) (XSS(j), j=j1,j2) - end do - - ! Close ACE file - close(UNIT=in) - end if - - ! ========================================================================== - ! PARSE DATA BASED ON NXS, JXS, AND XSS ARRAYS - - select case(listing % type) - case (ACE_NEUTRON) - nuc => nuclides(i_table) - nuc % name = name - nuc % awr = awr - nuc % kT = kT - nuc % zaid = NXS(2) - - ! read all blocks - call read_esz(nuc) - call read_nu_data(nuc) - call read_reactions(nuc) - call read_angular_dist(nuc) - call read_energy_dist(nuc) - call read_unr_res(nuc) - - ! Currently subcritical fixed source calculations are not allowed. Thus, - ! 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() - end if - - ! for fissionable nuclides, precalculate microscopic nu-fission cross - ! sections so that we don't need to call the nu_total function during - ! cross section lookups - - if (nuc % fissionable) call generate_nu_fission(nuc) - - case (ACE_THERMAL) - sab => sab_tables(i_table) - sab % name = name - sab % awr = awr - sab % kT = kT - sab % zaid = zaids(1) - - call read_thermal_data(sab) - end select - - deallocate(XSS) - if(associated(nuc)) nullify(nuc) - if(associated(sab)) nullify(sab) - - end subroutine read_0K_ace_table - !=============================================================================== ! READ_ESZ - reads through the ESZ block. This block contains the energy grid, ! total xs, absorption xs, elastic scattering xs, and heating numbers. From 4c4e875262963f9f36efbc0b8af59390b6560b0d Mon Sep 17 00:00:00 2001 From: walshjon Date: Tue, 26 Nov 2013 10:18:06 -0800 Subject: [PATCH 028/109] removed extraneous res scatter variables --- src/global.F90 | 14 +------------- 1 file changed, 1 insertion(+), 13 deletions(-) diff --git a/src/global.F90 b/src/global.F90 index 2b634db409..5f32374c59 100644 --- a/src/global.F90 +++ b/src/global.F90 @@ -1,7 +1,7 @@ module global use ace_header, only: Nuclide, SAlphaBeta, xsListing, NuclideMicroXS, & - MaterialMacroXS, ResScatterer + MaterialMacroXS use bank_header, only: Bank use cmfd_header use constants @@ -368,18 +368,6 @@ module global logical :: output_xs = .false. logical :: output_tallies = .true. - ! ============================================================================ - ! RESONANCE SCATTERING VARIABLES - - ! Is resonance scattering treated? - logical :: treat_res_scat = .false. - - ! Number of resonant scatterers - integer :: n_res_scatterers_total - - ! Main object - type(ResScatterer), allocatable, target :: res_scatterers(:) - !$omp threadprivate(micro_xs, material_xs, fission_bank, n_bank, message, & !$omp& trace, thread_id, current_work, matching_bins) From 0a01092cc855861cac5e6f28f0139d9efa6c3ff7 Mon Sep 17 00:00:00 2001 From: walshjon Date: Tue, 26 Nov 2013 10:42:32 -0800 Subject: [PATCH 029/109] removed dependence on ResScatterer type --- src/ace.F90 | 13 +------------ src/cross_section.F90 | 33 +++++++++++++++------------------ src/global.F90 | 9 --------- src/input_xml.F90 | 16 +--------------- src/physics.F90 | 26 +++++++++++++++----------- 5 files changed, 32 insertions(+), 65 deletions(-) diff --git a/src/ace.F90 b/src/ace.F90 index 0cb97c647b..005a17d17c 100644 --- a/src/ace.F90 +++ b/src/ace.F90 @@ -35,11 +35,9 @@ contains integer :: i ! index in materials array integer :: j ! index over nuclides in material integer :: k ! index over S(a,b) tables in material - integer :: l ! index over res_scatterers integer :: i_listing ! index in xs_listings array integer :: i_nuclide ! index in nuclides integer :: i_sab ! index in sab_tables - integer :: i_res_scat = 0 ! index in res_scatterers integer :: m ! position for sorting integer :: temp_nuclide ! temporary value for sorting integer :: temp_table ! temporary value for sorting @@ -66,7 +64,7 @@ contains NUCLIDE_LOOP: do j = 1, mat % n_nuclides name = mat % names(j) - + print*, name if (.not. already_read % contains(name)) then i_listing = xs_listing_dict % get_key(name) i_nuclide = nuclide_dict % get_key(name) @@ -77,15 +75,6 @@ contains nuc => nuclides(i_nuclide) nuc % listing = i_listing - do l = 1, n_res_scatterers_total - if (name == res_scatterers(l) % name) then - i_res_scat = i_res_scat + 1 - nuclides(i_nuclide) % resonant = .true. - nuclides(i_nuclide) % i_0K = i_res_scat - exit - end if - end do - ! Read the ACE table into the appropriate entry on the nuclides ! array call read_ace_table(i_nuclide, i_listing) diff --git a/src/cross_section.F90 b/src/cross_section.F90 index e05b18949b..086d758afc 100644 --- a/src/cross_section.F90 +++ b/src/cross_section.F90 @@ -479,20 +479,17 @@ contains end subroutine find_energy_index !=============================================================================== -! ELASTIC_0K_XS determines the microscopic elastic cross section for a +! ELASTIC_0K_XS determines the microscopic 0K elastic cross section for a ! nuclide of a given index in the nuclides array at the energy of the particle !=============================================================================== - function elastic_0K_xs(E, nuc_0K, i_0K) result(xs_out) + function elastic_0K_xs(E, nuc) result(xs_out) - type(ResScatterer), pointer :: nuc_0K - - integer, intent(in) :: i_0K ! index into 0K nuclides array - integer :: i_grid ! index on nuclide energy grid - - real(8) :: f ! interp factor on nuclide energy grid - real(8), intent(in) :: E ! trial energy - real(8) :: xs_out + type(Nuclide), pointer :: nuc ! target nuclide at temperature + integer :: i_grid ! index on nuclide energy grid + real(8) :: f ! interp factor on nuclide energy grid + real(8), intent(in) :: E ! trial energy + real(8) :: xs_out ! Determine index on nuclide energy grid select case (grid_method) @@ -501,31 +498,31 @@ contains ! the nuclide energy grid is as simple as looking up the pointer call find_energy_index(E) - i_grid = nuc_0K % grid_index(union_grid_index) + i_grid = nuc % grid_index(union_grid_index) case (GRID_NUCLIDE) ! If we're not using the unionized grid, we have to do a binary search on ! the nuclide energy grid in order to determine which points to ! interpolate between - if (E < nuc_0K % energy(1)) then + if (E < nuc % energy(1)) then i_grid = 1 - elseif (E > nuc_0K % energy(nuc_0K % n_grid)) then - i_grid = nuc_0K % n_grid - 1 + elseif (E > nuc % energy(nuc % n_grid)) then + i_grid = nuc % n_grid - 1 else - i_grid = binary_search(nuc_0K % energy, nuc_0K % n_grid, E) + i_grid = binary_search(nuc % energy, nuc % n_grid, E) end if end select ! check for rare case where two energy points are the same - if (nuc_0K % energy(i_grid) == nuc_0K % energy(i_grid+1)) i_grid = i_grid + 1 + if (nuc % energy(i_grid) == nuc % energy(i_grid+1)) i_grid = i_grid + 1 ! calculate interpolation factor - f = (E - nuc_0K%energy(i_grid))/(nuc_0K%energy(i_grid+1) - nuc_0K%energy(i_grid)) + f = (E - nuc%energy(i_grid))/(nuc%energy(i_grid+1) - nuc%energy(i_grid)) ! Calculate microscopic nuclide elastic cross section - xs_out = (ONE - f) * nuc_0K % elastic(i_grid) + f * nuc_0K % elastic(i_grid+1) + xs_out = (ONE - f) * nuc % elastic(i_grid) + f * nuc % elastic(i_grid+1) end function elastic_0K_xs diff --git a/src/global.F90 b/src/global.F90 index 5f32374c59..8b8e929a69 100644 --- a/src/global.F90 +++ b/src/global.F90 @@ -406,15 +406,6 @@ contains if (allocated(xs_listings)) deallocate(xs_listings) if (allocated(micro_xs)) deallocate(micro_xs) - ! Deallocate resonance scattering data - if (allocated(res_scatterers)) then - ! First call the clear routines - do i = 1, size(res_scatterers) - call res_scatterers(i) % clear() - end do - deallocate(res_scatterers) - end if - ! Deallocate external source if (allocated(external_source % params_space)) & deallocate(external_source % params_space) diff --git a/src/input_xml.F90 b/src/input_xml.F90 index 32ea3e2f64..5cfaa4bb2f 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -602,21 +602,6 @@ contains #endif end if - ! set up resonance scattering treatment - call lower_case(resonance_scattering_ % method(1)) - if (resonance_scattering_ % method(1) /= '') then - treat_res_scat = .true. - n_res_scatterers_total = size(resonance_scattering_ % scatterer) - allocate(res_scatterers(n_res_scatterers_total)) - do i = 1, n_res_scatterers_total - res_scatterers(i) % name = trim(resonance_scattering_ % xs_label(i)) - res_scatterers(i) % name_0K = trim(resonance_scattering_ % xs_0K_label(i)) - res_scatterers(i) % scheme = trim(resonance_scattering_ % method(i)) - res_scatterers(i) % E_min = resonance_scattering_ % E_min(i) - res_scatterers(i) % E_max = resonance_scattering_ % E_max(i) - end do - end if - end subroutine read_settings_xml !=============================================================================== @@ -1223,6 +1208,7 @@ contains else call list_density % append(-nuc % wo) end if + end do INDIVIDUAL_NUCLIDES ! ======================================================================= diff --git a/src/physics.F90 b/src/physics.F90 index fdd4f50f8a..9acdc1393c 100644 --- a/src/physics.F90 +++ b/src/physics.F90 @@ -1,8 +1,8 @@ module physics - use ace_header, only: Nuclide, Reaction, DistEnergy, ResScatterer + use ace_header, only: Nuclide, Reaction, DistEnergy use constants - use cross_section, only: elastic_0K_xs + use cross_section, only: elastic_0K_xs use endf, only: reaction_name use error, only: fatal_error, warning use fission, only: nu_total, nu_delayed @@ -638,7 +638,6 @@ contains subroutine sample_target_velocity(nuc, v_target, E, uvw, v_neut, wgt, xs_eff) type(Nuclide), pointer :: nuc ! target nuclide at temperature - type(ResScatterer), pointer :: nuc_0K => null() ! (resonant) target nuclide at 0K real(8), intent(out) :: v_target(3) real(8), intent(in) :: v_neut(3) @@ -664,7 +663,7 @@ contains logical :: reject ! resample if true - nuc_0K => res_scatterers(nuc % i_0K) + character(80) :: sampling_scheme ! Determine equilibrium temperature in MeV kT = nuc % kT @@ -672,25 +671,30 @@ contains ! Check if nuclide is a resonant scatterer and which sampling scheme ! to use based on neutron energy if (nuc % resonant) then - if (E > nuc_0K % E_max) then + print*, 'aaaaaaaaaa' + sampling_scheme = nuc % scheme + sampling_scheme = trim(sampling_scheme) + if (E > nuc % E_max) then v_target = ZERO return - else if (E < nuc_0K % E_min) then - nuc_0K % scheme = 'cxs' + else if (E < nuc % E_min) then + sampling_scheme = 'cxs' + sampling_scheme = trim(sampling_scheme) end if else if (E >= FREE_GAS_THRESHOLD * kT .and. nuc % awr > ONE) then v_target = ZERO return else - nuc_0K % scheme = 'cxs' + sampling_scheme = 'cxs' + sampling_scheme = trim(sampling_scheme) end if end if ! reject unless criteria are satisfied reject = .true. - select case (nuc_0K % scheme) + select case (sampling_scheme) case ('cxs') ! calculate beta, alpha beta_vn = sqrt(nuc%awr * E / kT) @@ -784,10 +788,10 @@ contains ! determine velocity vector of target nucleus based on neutron's velocity ! and the sampled angle between them v_target = vt * rotate_angle(uvw, mu) - + ! adjust particle weight E_rel = dot_product((v_neut - v_target), (v_neut - v_target)) - xs_0K = elastic_0K_xs(E_rel, nuc_0K, nuc % i_0K) + xs_0K = elastic_0K_xs(E_rel, nuc) wcf = xs_0K / xs_eff wgt = wcf * wgt From 2c5d1ac4500fd901027bc9a4727d6f71cba32b46 Mon Sep 17 00:00:00 2001 From: walshjon Date: Wed, 27 Nov 2013 00:18:39 -0800 Subject: [PATCH 030/109] wcm w/ arbitrary number of nuclides tentatively working --- src/ace.F90 | 116 +++++++++++++++++++++++++---------- src/ace_header.F90 | 33 ++++++++-- src/cross_section.F90 | 61 +++++++++--------- src/energy_grid.F90 | 22 ++++++- src/global.F90 | 15 ++++- src/input_xml.F90 | 17 ++++- src/physics.F90 | 5 +- src/templates/settings_t.xml | 12 ++-- 8 files changed, 201 insertions(+), 80 deletions(-) diff --git a/src/ace.F90 b/src/ace.F90 index 005a17d17c..02eafa6911 100644 --- a/src/ace.F90 +++ b/src/ace.F90 @@ -35,6 +35,7 @@ contains integer :: i ! index in materials array integer :: j ! index over nuclides in material integer :: k ! index over S(a,b) tables in material + integer :: n ! index over resonant scatterers integer :: i_listing ! index in xs_listings array integer :: i_nuclide ! index in nuclides integer :: i_sab ! index in sab_tables @@ -64,7 +65,7 @@ contains NUCLIDE_LOOP: do j = 1, mat % n_nuclides name = mat % names(j) - print*, name + if (.not. already_read % contains(name)) then i_listing = xs_listing_dict % get_key(name) i_nuclide = nuclide_dict % get_key(name) @@ -79,6 +80,25 @@ contains ! array call read_ace_table(i_nuclide, i_listing) + if (treat_res_scat) then + do n = 1, n_res_scatterers_total + if (name == nuclides_0K(n) % name) then + nuclides(i_nuclide) % resonant = .true. + nuclides(i_nuclide) % name_0K = nuclides_0K(n) % name_0K + nuclides(i_nuclide) % name_0K = trim(nuclides(i_nuclide) % name_0K) + nuclides(i_nuclide) % scheme = nuclides_0K(n) % scheme + nuclides(i_nuclide) % scheme = trim(nuclides(i_nuclide) % scheme) + nuclides(i_nuclide) % E_min = nuclides_0K(n) % E_min + nuclides(i_nuclide) % E_max = nuclides_0K(n) % E_max + if (.not. already_read % contains(nuclides(i_nuclide) % name_0K)) then + i_listing = xs_listing_dict % get_key(nuclides(i_nuclide) % name_0K) + call read_ace_table(i_nuclide, i_listing) + end if + exit + end if + end do + end if + ! Add name and alias to dictionary call already_read % add(name) call already_read % add(alias) @@ -206,6 +226,7 @@ contains type(Nuclide), pointer :: nuc => null() type(SAlphaBeta), pointer :: sab => null() type(XsListing), pointer :: listing => null() + type(SetChar) :: already_read ! determine path, record length, and location of table listing => xs_listings(i_listing) @@ -301,18 +322,22 @@ contains select case(listing % type) case (ACE_NEUTRON) nuc => nuclides(i_table) - nuc % name = name - nuc % awr = awr - nuc % kT = kT - nuc % zaid = NXS(2) + if (trim(adjustl(name)) /= nuc % name_0K) then + nuc % name = name + nuc % awr = awr + nuc % kT = kT + nuc % zaid = NXS(2) + end if ! read all blocks call read_esz(nuc) - call read_nu_data(nuc) - call read_reactions(nuc) - call read_angular_dist(nuc) - call read_energy_dist(nuc) - call read_unr_res(nuc) + if (.not. allocated(nuc % energy_0K)) then + call read_nu_data(nuc) + call read_reactions(nuc) + call read_angular_dist(nuc) + call read_energy_dist(nuc) + call read_unr_res(nuc) + end if ! Currently subcritical fixed source calculations are not allowed. Thus, ! if any fissionable material is found in a fixed source calculation, @@ -326,7 +351,9 @@ contains ! sections so that we don't need to call the nu_total function during ! cross section lookups - if (nuc % fissionable) call generate_nu_fission(nuc) + if (nuc % fissionable .and. .not. allocated(nuc % energy_0K)) then + call generate_nu_fission(nuc) + end if case (ACE_THERMAL) sab => sab_tables(i_table) @@ -357,35 +384,58 @@ contains ! determine number of energy points NE = NXS(3) - nuc % n_grid = NE ! allocate storage for energy grid and cross section arrays - allocate(nuc % energy(NE)) - allocate(nuc % total(NE)) - allocate(nuc % elastic(NE)) - allocate(nuc % fission(NE)) - allocate(nuc % nu_fission(NE)) - allocate(nuc % absorption(NE)) + if (allocated(nuc % energy)) then + nuc % n_grid_0K = NE + allocate(nuc % energy_0K(NE)) + allocate(nuc % elastic_0K(NE)) - ! initialize cross sections - nuc % total = ZERO - nuc % elastic = ZERO - nuc % fission = ZERO - nuc % nu_fission = ZERO - nuc % absorption = ZERO + nuc % elastic_0K = ZERO - ! Read data from XSS -- only the energy grid, elastic scattering and heating - ! cross section values are actually read from here. The total and absorption - ! cross sections are reconstructed from the partial reaction data. + ! Read data from XSS -- only the energy grid, elastic scattering and heating + ! cross section values are actually read from here. The total and absorption + ! cross sections are reconstructed from the partial reaction data. - XSS_index = 1 - nuc % energy = get_real(NE) + XSS_index = 1 + nuc % energy_0K = get_real(NE) - ! Skip total and absorption - XSS_index = XSS_index + 2*NE + ! Skip total and absorption + XSS_index = XSS_index + 2*NE + + ! Continue reading elastic scattering and heating + nuc % elastic_0K = get_real(NE) - ! Continue reading elastic scattering and heating - nuc % elastic = get_real(NE) + else + nuc % n_grid = NE + allocate(nuc % energy(NE)) + allocate(nuc % total(NE)) + allocate(nuc % elastic(NE)) + allocate(nuc % fission(NE)) + allocate(nuc % nu_fission(NE)) + allocate(nuc % absorption(NE)) + + ! initialize cross sections + nuc % total = ZERO + nuc % elastic = ZERO + nuc % fission = ZERO + nuc % nu_fission = ZERO + nuc % absorption = ZERO + + ! Read data from XSS -- only the energy grid, elastic scattering and heating + ! cross section values are actually read from here. The total and absorption + ! cross sections are reconstructed from the partial reaction data. + + XSS_index = 1 + nuc % energy = get_real(NE) + + ! Skip total and absorption + XSS_index = XSS_index + 2*NE + + ! Continue reading elastic scattering and heating + nuc % elastic = get_real(NE) + + end if end subroutine read_esz diff --git a/src/ace_header.F90 b/src/ace_header.F90 index b880032070..8e41e77c48 100644 --- a/src/ace_header.F90 +++ b/src/ace_header.F90 @@ -112,8 +112,11 @@ module ace_header logical :: resonant = .false. ! resonant scatterer? character(10) :: name_0K ! name of 0K nuclide, e.g. 92235.00c character(16) :: scheme ! target velocity sampling scheme - real(8), allocatable :: xs_cdf(:) ! CDF of v_rel times cross section + integer :: n_grid_0K + real(8), allocatable :: grid_index_0K(:) ! pointers to union grid + real(8), allocatable :: energy_0K(:) ! energy grid for 0K xs real(8), allocatable :: elastic_0K(:) ! Microscopic elastic cross section + real(8), allocatable :: xs_cdf(:) ! CDF of v_rel times cross section real(8) :: E_min ! lower cutoff energy for res scattering real(8) :: E_max ! upper cutoff energy for res scattering @@ -151,7 +154,23 @@ module ace_header contains procedure :: clear => nuclide_clear ! Deallocates Nuclide end type Nuclide - + +!=============================================================================== +! NUCLIDE_0K contains all 0K cross section data and other parameters needed to +! treat resonance scattering +!=============================================================================== + + type Nuclide0K + + character(10) :: nuclide ! name of nuclide, e.g. U-238 + character(16) :: scheme ! target velocity sampling scheme + character(10) :: name ! name of nuclide, e.g. 92235.03c + character(10) :: name_0K ! name of 0K nuclide, e.g. 92235.00c + real(8) :: E_min ! lower cutoff energy for res scattering + real(8) :: E_max ! upper cutoff energy for res scattering + + end type Nuclide0K + !=============================================================================== ! SALPHABETA contains S(a,b) data for thermal neutron scattering, typically off ! of light isotopes such as water, graphite, Be, etc @@ -328,10 +347,16 @@ module ace_header if (allocated(this % grid_index)) & deallocate(this % grid_index) + if (allocated(this % grid_index_0K)) & + deallocate(this % grid_index_0K) + if (allocated(this % energy)) & deallocate(this % total, this % elastic, this % fission, & - this % nu_fission, this % absorption, & - this % elastic_0K, this % xs_cdf) + this % nu_fission, this % absorption) + + if (allocated(this % energy_0K)) & + deallocate(this % elastic_0K, this % xs_cdf) + if (allocated(this % heating)) & deallocate(this % heating) diff --git a/src/cross_section.F90 b/src/cross_section.F90 index 086d758afc..7a30330a1d 100644 --- a/src/cross_section.F90 +++ b/src/cross_section.F90 @@ -468,6 +468,7 @@ contains ! if particle's energy is outside of energy grid range, set to first or last ! index. Otherwise, do a binary search through the union energy grid. + if (E < e_grid(1)) then union_grid_index = 1 elseif (E > e_grid(n_grid)) then @@ -488,42 +489,42 @@ contains type(Nuclide), pointer :: nuc ! target nuclide at temperature integer :: i_grid ! index on nuclide energy grid real(8) :: f ! interp factor on nuclide energy grid - real(8), intent(in) :: E ! trial energy + real(8), intent(inout) :: E ! trial energy real(8) :: xs_out ! Determine index on nuclide energy grid select case (grid_method) - case (GRID_UNION) - ! If we're using the unionized grid with pointers, finding the index on - ! the nuclide energy grid is as simple as looking up the pointer - - call find_energy_index(E) - i_grid = nuc % grid_index(union_grid_index) - - case (GRID_NUCLIDE) - ! If we're not using the unionized grid, we have to do a binary search on - ! the nuclide energy grid in order to determine which points to - ! interpolate between - - if (E < nuc % energy(1)) then - i_grid = 1 - elseif (E > nuc % energy(nuc % n_grid)) then - i_grid = nuc % n_grid - 1 - else - i_grid = binary_search(nuc % energy, nuc % n_grid, E) - end if - - end select - - ! check for rare case where two energy points are the same - if (nuc % energy(i_grid) == nuc % energy(i_grid+1)) i_grid = i_grid + 1 + case (GRID_UNION) + ! If we're using the unionized grid with pointers, finding the index on + ! the nuclide energy grid is as simple as looking up the pointer - ! calculate interpolation factor - f = (E - nuc%energy(i_grid))/(nuc%energy(i_grid+1) - nuc%energy(i_grid)) + call find_energy_index(E) + i_grid = nuc % grid_index_0K(union_grid_index) - ! Calculate microscopic nuclide elastic cross section - xs_out = (ONE - f) * nuc % elastic(i_grid) + f * nuc % elastic(i_grid+1) + case (GRID_NUCLIDE) + ! If we're not using the unionized grid, we have to do a binary search on + ! the nuclide energy grid in order to determine which points to + ! interpolate between - end function elastic_0K_xs + if (E < nuc % energy(1)) then + i_grid = 1 + elseif (E > nuc % energy(nuc % n_grid)) then + i_grid = nuc % n_grid - 1 + else + i_grid = binary_search(nuc % energy, nuc % n_grid, E) + end if + + end select + + ! check for rare case where two energy points are the same + if (nuc % energy_0K(i_grid) == nuc % energy_0K(i_grid+1)) i_grid = i_grid + 1 + + ! 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) + + end function elastic_0K_xs end module cross_section diff --git a/src/energy_grid.F90 b/src/energy_grid.F90 index 66b95be0de..41f79d1ad3 100644 --- a/src/energy_grid.F90 +++ b/src/energy_grid.F90 @@ -28,6 +28,7 @@ contains do i = 1, n_nuclides_total nuc => nuclides(i) call add_grid_points(list, nuc % energy) + if (nuc % resonant) call add_grid_points(list, nuc % energy_0K) end do ! Set size of unionized energy grid @@ -132,10 +133,10 @@ contains do i = 1, n_nuclides_total nuc => nuclides(i) allocate(nuc % grid_index(n_grid)) - + index_e = 1 energy = nuc % energy(index_e) - + do j = 1, n_grid union_energy = e_grid(j) if (union_energy >= energy .and. index_e < nuc % n_grid) then @@ -144,6 +145,23 @@ contains end if nuc % grid_index(j) = index_e - 1 end do + + if (nuc % resonant) then + allocate(nuc % grid_index_0K(n_grid)) + + index_e = 1 + energy = nuc % energy_0K(index_e) + + do j = 1, n_grid + union_energy = e_grid(j) + if (union_energy >= energy .and. index_e < nuc % n_grid_0K) then + index_e = index_e + 1 + energy = nuc % energy_0K(index_e) + end if + nuc % grid_index_0K(j) = index_e - 1 + end do + end if + end do end subroutine grid_pointers diff --git a/src/global.F90 b/src/global.F90 index 8b8e929a69..dac10ee8ac 100644 --- a/src/global.F90 +++ b/src/global.F90 @@ -1,7 +1,7 @@ module global use ace_header, only: Nuclide, SAlphaBeta, xsListing, NuclideMicroXS, & - MaterialMacroXS + MaterialMacroXS, Nuclide0K use bank_header, only: Bank use cmfd_header use constants @@ -367,7 +367,14 @@ module global logical :: output_summary = .false. logical :: output_xs = .false. logical :: output_tallies = .true. - + + ! ============================================================================ + ! RESONANCE SCATTERING VARIABLES + + logical :: treat_res_scat = .false. + integer :: n_res_scatterers_total = 0 + type(Nuclide0K), allocatable, target :: nuclides_0K(:) ! 0K nuclides + !$omp threadprivate(micro_xs, material_xs, fission_bank, n_bank, message, & !$omp& trace, thread_id, current_work, matching_bins) @@ -402,6 +409,10 @@ contains deallocate(nuclides) end if + if (allocated(nuclides_0K)) then + deallocate(nuclides_0K) + end if + if (allocated(sab_tables)) deallocate(sab_tables) if (allocated(xs_listings)) deallocate(xs_listings) if (allocated(micro_xs)) deallocate(micro_xs) diff --git a/src/input_xml.F90 b/src/input_xml.F90 index 5cfaa4bb2f..af4d289fe0 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -602,6 +602,21 @@ contains #endif end if + ! Resonance scattering parameters + if (lbound(resonance_scattering_ % scatterer, 1) > 0) then + treat_res_scat = .true. + n_res_scatterers_total = size(resonance_scattering_ % scatterer) + allocate(nuclides_0K(n_res_scatterers_total)) + do i = 1, n_res_scatterers_total + nuclides_0K(i) % nuclide = trim(resonance_scattering_ % scatterer(i)) + nuclides_0K(i) % scheme = trim(resonance_scattering_ % method(i)) + nuclides_0K(i) % name = trim(resonance_scattering_ % xs_label(i)) + nuclides_0K(i) % name_0K = trim(resonance_scattering_ % xs_label_0K(i)) + nuclides_0K(i) % E_min = resonance_scattering_ % E_min(i) + nuclides_0K(i) % E_max = resonance_scattering_ % E_max(i) + end do + end if + end subroutine read_settings_xml !=============================================================================== @@ -1301,7 +1316,7 @@ contains else mat % nuclide(j) = nuclide_dict % get_key(name) end if - + ! Copy name and atom/weight percent mat % names(j) = name mat % atom_density(j) = list_density % get_item(j) diff --git a/src/physics.F90 b/src/physics.F90 index 9acdc1393c..45660f50cb 100644 --- a/src/physics.F90 +++ b/src/physics.F90 @@ -655,7 +655,6 @@ contains real(8) :: beta_vt ! beta * speed of target real(8) :: beta_vt_sq ! (beta * speed of target)^2 real(8) :: vt ! speed of target -! real(8) :: E_old ! tmp storage of current energy real(8) :: E_rel ! trial relative energy real(8) :: xs_0K ! 0K xs at E_rel real(8) :: xs_eff ! effective elastic xs at temperature T @@ -671,7 +670,6 @@ contains ! Check if nuclide is a resonant scatterer and which sampling scheme ! to use based on neutron energy if (nuc % resonant) then - print*, 'aaaaaaaaaa' sampling_scheme = nuc % scheme sampling_scheme = trim(sampling_scheme) if (E > nuc % E_max) then @@ -794,6 +792,9 @@ contains xs_0K = elastic_0K_xs(E_rel, nuc) wcf = xs_0K / xs_eff wgt = wcf * wgt + if (wgt < ZERO) then +! print*, wgt, wcf, xs_0K, xs_eff + end if case default message = "Not a recognized resonance scattering treatment!" diff --git a/src/templates/settings_t.xml b/src/templates/settings_t.xml index dbceb7550d..57710206bf 100644 --- a/src/templates/settings_t.xml +++ b/src/templates/settings_t.xml @@ -43,12 +43,12 @@ - - - - - - + + + + + + From b3b02b8370d4ed02e382f3f1fc79307c7c58fd2e Mon Sep 17 00:00:00 2001 From: walshjon Date: Wed, 27 Nov 2013 07:36:22 -0800 Subject: [PATCH 031/109] DBRC tentatively working --- src/physics.F90 | 124 ++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 119 insertions(+), 5 deletions(-) diff --git a/src/physics.F90 b/src/physics.F90 index 45660f50cb..012fbd2bd8 100644 --- a/src/physics.F90 +++ b/src/physics.F90 @@ -2,7 +2,8 @@ module physics use ace_header, only: Nuclide, Reaction, DistEnergy use constants - use cross_section, only: elastic_0K_xs + use cross_section, only: elastic_0K_xs, find_energy_index, & + union_grid_index use endf, only: reaction_name use error, only: fatal_error, warning use fission, only: nu_total, nu_delayed @@ -641,7 +642,7 @@ contains real(8), intent(out) :: v_target(3) real(8), intent(in) :: v_neut(3) - real(8), intent(in) :: E + real(8), intent(inout) :: E real(8), intent(in) :: uvw(3) real(8), intent(inout) :: wgt @@ -659,6 +660,18 @@ contains real(8) :: xs_0K ! 0K xs at E_rel real(8) :: xs_eff ! effective elastic xs at temperature T real(8) :: wcf ! weight correction factor + real(8) :: E_red ! reduced energy + real(8) :: E_low ! lowest practical relative energy + real(8) :: E_up ! highest practical relative energy + real(8) :: E_old ! tmp storage of current energy + real(8) :: awr ! target/neutron mass ratio + integer :: i_E_low ! 0K index to lowest practical relative energy + integer :: i_E_up ! 0K index to highest practical relative energy + real(8) :: xs_max ! max 0K xs over practical relative energies + real(8) :: xs_low ! 0K xs at lowest practical relative energy + real(8) :: xs_up ! 0K xs at highest practical relative energy + real(8) :: m ! slope for interpolation + real(8) :: R_dbrc ! DBRC rejection criterion logical :: reject ! resample if true @@ -666,6 +679,7 @@ contains ! Determine equilibrium temperature in MeV kT = nuc % kT + awr = nuc % awr ! Check if nuclide is a resonant scatterer and which sampling scheme ! to use based on neutron energy @@ -792,9 +806,109 @@ contains xs_0K = elastic_0K_xs(E_rel, nuc) wcf = xs_0K / xs_eff wgt = wcf * wgt - if (wgt < ZERO) then -! print*, wgt, wcf, xs_0K, xs_eff - end if + + case ('dbrc') + ! reduced neutron energy + E_red = sqrt((awr * E) / kT) + + ! lower limit for range that max xs is determined over + E_low = (((E_red - 4.0_8)**2) * kT) / awr + + ! upper limit for range that max xs is determined over + E_up = (((E_red + 4.0_8)**2) * kT) / awr + + ! incident neutron energy + E_old = E + + ! find index and calculate 0K xs at lower energy bound + E = E_low + call find_energy_index(E) + ! nuclide energy grid index + i_E_low = nuc % grid_index(union_grid_index) + + ! find index and calculate 0K xs at upper energy bound + E = E_up + call find_energy_index(E) + ! nuclide energy grid index + i_E_up = nuc % grid_index(union_grid_index) + + ! reset particle energy to incident value + ! (it was only changed to calculate 0K xs at different energies) + E = E_old + + ! xs at lower bounding index + xs_low = nuc % elastic_0K(i_E_low) + + ! slope + m = (nuc % elastic_0K(i_E_low + 1) - xs_low) & + & / (nuc % energy_0K(i_E_low + 1) - nuc % energy_0K(i_E_low)) + + ! actual lower bound 0K xs + xs_low = xs_low + m * (E_low - nuc % energy_0K(i_E_low)) + + ! xs at upper bounding index + xs_up = nuc % elastic_0K(i_E_up) + + ! slope + m = (nuc % elastic_0K(i_E_up + 1) - xs_up) & + & / (nuc % energy_0K(i_E_up + 1) - nuc % energy_0K(i_E_up)) + + ! actual upper bound 0K xs + xs_up = xs_up + m * (E_up - nuc % energy_0K(i_E_up)) + + ! get max 0K xs value + xs_max = max(xs_low, maxval(nuc % elastic_0K(i_E_low + 1 : i_E_up - 1)), xs_up) + + ! calculate beta + beta_vn = sqrt(awr * E / kT) + alpha = ONE / (ONE + sqrt(pi) * beta_vn / TWO) + + do + ! Sample two random numbers + r1 = prn() + r2 = prn() + + if (prn() < alpha) then + ! With probability alpha, we sample the distribution p(y) = + ! y*e^(-y). This can be done with sampling scheme C45 frmo the Monte + ! Carlo sampler + beta_vt_sq = -log(r1 * r2) + else + ! With probability 1-alpha, we sample the distribution p(y) = y^2 * + ! e^(-y^2). This can be done with sampling scheme C61 from the Monte + ! Carlo sampler + c = cos(PI / TWO * prn()) + beta_vt_sq = -log(r1) - log(r2) * c**2 + end if + + ! Determine beta * vt + beta_vt = sqrt(beta_vt_sq) + + ! Sample cosine of angle between neutron and target velocity + mu = TWO * prn() - ONE + + ! Determine rejection probability + accept_prob = sqrt(beta_vn * beta_vn + beta_vt_sq - 2 * beta_vn * beta_vt * mu) & + / (beta_vn + beta_vt) + + ! Perform rejection sampling on vt and mu + if (prn() < accept_prob) then + vt = sqrt(beta_vt_sq * kT / awr) + v_target = vt * rotate_angle(uvw, mu) + + E_rel = dot_product((v_neut - v_target), (v_neut - v_target)) + + xs_0K = elastic_0K_xs(E_rel, nuc) + + R_dbrc = xs_0K / xs_max + + if (prn() < R_dbrc) then + reject = .false. + end if + end if + + if (.not. reject) exit + end do case default message = "Not a recognized resonance scattering treatment!" From 9b03eedc90d9d4b0147866b0fda0949f6626376b Mon Sep 17 00:00:00 2001 From: walshjon Date: Sun, 1 Dec 2013 18:03:11 -0800 Subject: [PATCH 032/109] fixed calculation of 0K xs --- src/ace_header.F90 | 5 ++++- src/physics.F90 | 9 ++++----- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/src/ace_header.F90 b/src/ace_header.F90 index 8e41e77c48..a19795d8eb 100644 --- a/src/ace_header.F90 +++ b/src/ace_header.F90 @@ -355,7 +355,10 @@ module ace_header this % nu_fission, this % absorption) if (allocated(this % energy_0K)) & - deallocate(this % elastic_0K, this % xs_cdf) + deallocate(this % elastic_0K) + + if (allocated(this % xs_cdf)) & + deallocate(this % xs_cdf) if (allocated(this % heating)) & deallocate(this % heating) diff --git a/src/physics.F90 b/src/physics.F90 index 012fbd2bd8..2c16402023 100644 --- a/src/physics.F90 +++ b/src/physics.F90 @@ -824,13 +824,13 @@ contains E = E_low call find_energy_index(E) ! nuclide energy grid index - i_E_low = nuc % grid_index(union_grid_index) + i_E_low = nuc % grid_index_0K(union_grid_index) ! find index and calculate 0K xs at upper energy bound E = E_up call find_energy_index(E) ! nuclide energy grid index - i_E_up = nuc % grid_index(union_grid_index) + i_E_up = nuc % grid_index_0K(union_grid_index) ! reset particle energy to incident value ! (it was only changed to calculate 0K xs at different energies) @@ -894,6 +894,7 @@ contains ! Perform rejection sampling on vt and mu if (prn() < accept_prob) then vt = sqrt(beta_vt_sq * kT / awr) + v_target = vt * rotate_angle(uvw, mu) E_rel = dot_product((v_neut - v_target), (v_neut - v_target)) @@ -902,9 +903,7 @@ contains R_dbrc = xs_0K / xs_max - if (prn() < R_dbrc) then - reject = .false. - end if + if (prn() < R_dbrc) reject = .false. end if if (.not. reject) exit From 3c6781facf213f4d09d0a870e6941237d5932b20 Mon Sep 17 00:00:00 2001 From: walshjon Date: Fri, 6 Dec 2013 19:09:53 -0800 Subject: [PATCH 033/109] new free gas subroutine to remove duplicate code in DBRC, CXS, WCM --- src/Makefile | 4 +- src/ace_header.F90 | 2 +- src/cross_section.F90 | 9 +- src/energy_grid.F90 | 4 +- src/global.F90 | 6 +- src/input_xml.F90 | 3 +- src/physics.F90 | 451 ++++++++++++++++++------------------------ 7 files changed, 202 insertions(+), 277 deletions(-) diff --git a/src/Makefile b/src/Makefile index 94da0f5288..03c370e07a 100644 --- a/src/Makefile +++ b/src/Makefile @@ -13,7 +13,7 @@ COMPILER = gnu DEBUG = no PROFILE = no OPTIMIZE = no -MPI = yes +MPI = no OPENMP = no HDF5 = no PETSC = no @@ -22,7 +22,7 @@ PETSC = no # External Library Paths #=============================================================================== -MPI_DIR = /opt/mpich/3.0.2-$(COMPILER) +MPI_DIR = /opt/mpich/3.0.4-$(COMPILER) HDF5_DIR = /opt/hdf5/1.8.11-$(COMPILER) PHDF5_DIR = /opt/phdf5/1.8.11-$(COMPILER) PETSC_DIR = /opt/petsc/3.4.2-$(COMPILER) diff --git a/src/ace_header.F90 b/src/ace_header.F90 index a19795d8eb..de9d115b3f 100644 --- a/src/ace_header.F90 +++ b/src/ace_header.F90 @@ -112,7 +112,7 @@ module ace_header logical :: resonant = .false. ! resonant scatterer? character(10) :: name_0K ! name of 0K nuclide, e.g. 92235.00c character(16) :: scheme ! target velocity sampling scheme - integer :: n_grid_0K + integer :: n_grid_0K ! number of 0K energy grid points real(8), allocatable :: grid_index_0K(:) ! pointers to union grid real(8), allocatable :: energy_0K(:) ! energy grid for 0K xs real(8), allocatable :: elastic_0K(:) ! Microscopic elastic cross section diff --git a/src/cross_section.F90 b/src/cross_section.F90 index 7a30330a1d..a8be4f5c87 100644 --- a/src/cross_section.F90 +++ b/src/cross_section.F90 @@ -468,7 +468,6 @@ contains ! if particle's energy is outside of energy grid range, set to first or last ! index. Otherwise, do a binary search through the union energy grid. - if (E < e_grid(1)) then union_grid_index = 1 elseif (E > e_grid(n_grid)) then @@ -480,11 +479,11 @@ contains end subroutine find_energy_index !=============================================================================== -! ELASTIC_0K_XS determines the microscopic 0K elastic cross section for a -! nuclide of a given index in the nuclides array at the energy of the particle +! CALCULATE_0K_ELASTIC_XS determines the microscopic 0K elastic cross section +! for a given nuclide at the trial relative energy used in resonance scattering !=============================================================================== - function elastic_0K_xs(E, nuc) result(xs_out) + function calculate_0K_elastic_xs(E, nuc) result(xs_out) type(Nuclide), pointer :: nuc ! target nuclide at temperature integer :: i_grid ! index on nuclide energy grid @@ -525,6 +524,6 @@ contains ! Calculate microscopic nuclide elastic cross section xs_out = (ONE - f) * nuc % elastic_0K(i_grid) + f * nuc % elastic_0K(i_grid+1) - end function elastic_0K_xs + end function calculate_0K_elastic_xs end module cross_section diff --git a/src/energy_grid.F90 b/src/energy_grid.F90 index 41f79d1ad3..097b74ff5d 100644 --- a/src/energy_grid.F90 +++ b/src/energy_grid.F90 @@ -133,10 +133,10 @@ contains do i = 1, n_nuclides_total nuc => nuclides(i) allocate(nuc % grid_index(n_grid)) - + index_e = 1 energy = nuc % energy(index_e) - + do j = 1, n_grid union_energy = e_grid(j) if (union_energy >= energy .and. index_e < nuc % n_grid) then diff --git a/src/global.F90 b/src/global.F90 index dac10ee8ac..9f646ba04e 100644 --- a/src/global.F90 +++ b/src/global.F90 @@ -68,9 +68,9 @@ module global type(NuclideMicroXS), allocatable :: micro_xs(:) ! Cache for each nuclide type(MaterialMacroXS) :: material_xs ! Cache for current material - integer :: n_nuclides_total ! Number of nuclide cross section tables - integer :: n_sab_tables ! Number of S(a,b) thermal scattering tables - integer :: n_listings ! Number of listings in cross_sections.xml + integer :: n_nuclides_total ! Number of nuclide cross section tables + integer :: n_sab_tables ! Number of S(a,b) thermal scattering tables + integer :: n_listings ! Number of listings in cross_sections.xml ! Dictionaries to look up cross sections and listings type(DictCharInt) :: nuclide_dict diff --git a/src/input_xml.F90 b/src/input_xml.F90 index cc55a242b8..95c6ab5f8f 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -1457,7 +1457,6 @@ contains call get_node_value(node_nuc, "wo", temp_dble) call list_density % append(-temp_dble) end if - end do INDIVIDUAL_NUCLIDES ! ======================================================================= @@ -1557,7 +1556,7 @@ contains else mat % nuclide(j) = nuclide_dict % get_key(name) end if - + ! Copy name and atom/weight percent mat % names(j) = name mat % atom_density(j) = list_density % get_item(j) diff --git a/src/physics.F90 b/src/physics.F90 index 2c16402023..722678cd9b 100644 --- a/src/physics.F90 +++ b/src/physics.F90 @@ -2,7 +2,7 @@ module physics use ace_header, only: Nuclide, Reaction, DistEnergy use constants - use cross_section, only: elastic_0K_xs, find_energy_index, & + use cross_section, only: calculate_0K_elastic_xs, find_energy_index, & union_grid_index use endf, only: reaction_name use error, only: fatal_error, warning @@ -435,7 +435,8 @@ contains ! Sample velocity of target nucleus if (.not. micro_xs(i_nuclide) % use_ptable) then - call sample_target_velocity(nuc, v_t, E, uvw, v_n, wgt, micro_xs(i_nuclide) % elastic) + call sample_target_velocity(nuc, v_t, E, uvw, v_n, wgt, & + & micro_xs(i_nuclide) % elastic) else v_t = ZERO end if @@ -628,9 +629,8 @@ contains end subroutine sab_scatter !=============================================================================== -! SAMPLE_TARGET_VELOCITY samples the target velocity based on the free gas -! scattering formulation used by most Monte Carlo codes. Excellent documentation -! for this method can be found in FRA-TM-123. Methods for correctly accounting +! SAMPLE_TARGET_VELOCITY samples the target velocity. The constant cross section +! free gas model is the default method. Methods for correctly accounting ! for the energy dependence of cross sections in treating resonance elastic ! scattering such as the DBRC, WCM, and a new, accelerated scheme are also ! implemented here. @@ -638,15 +638,151 @@ contains subroutine sample_target_velocity(nuc, v_target, E, uvw, v_neut, wgt, xs_eff) - type(Nuclide), pointer :: nuc ! target nuclide at temperature + type(Nuclide), pointer :: nuc ! target nuclide at temperature - real(8), intent(out) :: v_target(3) - real(8), intent(in) :: v_neut(3) - real(8), intent(inout) :: E - real(8), intent(in) :: uvw(3) - real(8), intent(inout) :: wgt + real(8), intent(out) :: v_target(3) ! target velocity + real(8), intent(in) :: v_neut(3) ! neutron velocity + real(8), intent(in) :: E ! particle energy + real(8), intent(in) :: uvw(3) ! direction cosines + real(8), intent(inout) :: wgt ! particle weight + + real(8) :: awr ! target/neutron mass ratio + real(8) :: kT ! equilibrium temperature of target in MeV + real(8) :: E_rel ! trial relative energy + real(8) :: xs_0K ! 0K xs at E_rel + real(8) :: xs_eff ! effective elastic xs at temperature T + real(8) :: wcf ! weight correction factor + real(8) :: E_red ! reduced energy (same as used by Cullen in SIGMA1) + real(8) :: E_low ! lowest practical relative energy + real(8) :: E_up ! highest practical relative energy + real(8) :: xs_max ! max 0K xs over practical relative energies + real(8) :: xs_low ! 0K xs at lowest practical relative energy + real(8) :: xs_up ! 0K xs at highest practical relative energy + real(8) :: m ! slope for interpolation + real(8) :: R_dbrc ! DBRC rejection criterion + + integer :: i_E_low ! 0K index to lowest practical relative energy + integer :: i_E_up ! 0K index to highest practical relative energy + + logical :: reject ! resample if true + + character(80) :: sampling_scheme ! method of target velocity sampling + + kT = nuc % kT + awr = nuc % awr + + ! Check if nuclide is a resonant scatterer + if (nuc % resonant) then + + ! sampling scheme to use + sampling_scheme = nuc % scheme + sampling_scheme = trim(sampling_scheme) + + ! upper resonance scattering energy bound (target is at rest above this E) + if (E > nuc % E_max) then + v_target = ZERO + return + + ! lower resonance scattering energy bound (should be no resonances below) + else if (E < nuc % E_min) then + sampling_scheme = 'cxs' + sampling_scheme = trim(sampling_scheme) + end if + + ! Otherwise, use free gas model + else + if (E >= FREE_GAS_THRESHOLD * kT .and. awr > ONE) then + v_target = ZERO + return + else + sampling_scheme = 'cxs' + sampling_scheme = trim(sampling_scheme) + end if + end if + + ! Use appropriate target velocity sampling method + select case (sampling_scheme) + + case ('cxs') + + ! sample target velocity with the constant cross section (cxs) approx. + call sample_cxs_target_velocity(nuc, v_target, E, uvw) + + case ('wcm') + + ! sample target velocity with the constant cross section (cxs) approx. + call sample_cxs_target_velocity(nuc, v_target, E, uvw) + + ! Adjust weight as prescribed by the weight correction method (wcm) + E_rel = dot_product((v_neut - v_target), (v_neut - v_target)) + xs_0K = calculate_0K_elastic_xs(E_rel, nuc) + wcf = xs_0K / xs_eff + wgt = wcf * wgt + + case ('dbrc') + E_red = sqrt((awr * E) / kT) + E_low = (((E_red - 4.0_8)**2) * kT) / awr + E_up = (((E_red + 4.0_8)**2) * kT) / awr + + ! find lower and upper energy bound indices + call find_energy_index(E_low) + i_E_low = nuc % grid_index_0K(union_grid_index) + call find_energy_index(E_up) + i_E_up = nuc % grid_index_0K(union_grid_index) + + ! interpolate xs since we're not exactly at the energy indices + xs_low = nuc % elastic_0K(i_E_low) + m = (nuc % elastic_0K(i_E_low + 1) - xs_low) & + & / (nuc % energy_0K(i_E_low + 1) - nuc % energy_0K(i_E_low)) + xs_low = xs_low + m * (E_low - nuc % energy_0K(i_E_low)) + xs_up = nuc % elastic_0K(i_E_up) + m = (nuc % elastic_0K(i_E_up + 1) - xs_up) & + & / (nuc % energy_0K(i_E_up + 1) - nuc % energy_0K(i_E_up)) + xs_up = xs_up + m * (E_up - nuc % energy_0K(i_E_up)) + + ! get max 0K xs value over range of practical relative energies + xs_max = max(xs_low, & + & maxval(nuc % elastic_0K(i_E_low + 1 : i_E_up - 1)), xs_up) + + reject = .true. + + ! sample target velocities until one is accepted by the DBRC + do + + ! sample target velocity with the constant cross section (cxs) approx. + call sample_cxs_target_velocity(nuc, v_target, E, uvw) + + ! perform Doppler broadening rejection correction (dbrc) + E_rel = dot_product((v_neut - v_target), (v_neut - v_target)) + xs_0K = calculate_0K_elastic_xs(E_rel, nuc) + R_dbrc = xs_0K / xs_max + if (prn() < R_dbrc) reject = .false. + if (.not. reject) exit + end do + + case default + message = "Not a recognized resonance scattering treatment!" + call fatal_error() + end select + + end subroutine sample_target_velocity + +!=============================================================================== +! SAMPLE_CXS_TARGET_VELOCITY samples a target velocity based on the free gas +! scattering formulation, used by most Monte Carlo codes, in which cross section +! is assumed to be constant in energy. Excellent documentation for this method +! can be found in FRA-TM-123. +!=============================================================================== + + subroutine sample_cxs_target_velocity(nuc, v_target, E, uvw) + + type(Nuclide), pointer :: nuc ! target nuclide at temperature + real(8), intent(out) :: v_target(3) + real(8), intent(in) :: E + real(8), intent(in) :: uvw(3) real(8) :: kT ! equilibrium temperature of target in MeV + real(8) :: awr ! target/neutron mass ratio real(8) :: alpha ! probability of sampling f2 over f1 real(8) :: mu ! cosine of angle between neutron and target vel real(8) :: r1, r2 ! pseudo-random numbers @@ -656,265 +792,56 @@ contains real(8) :: beta_vt ! beta * speed of target real(8) :: beta_vt_sq ! (beta * speed of target)^2 real(8) :: vt ! speed of target - real(8) :: E_rel ! trial relative energy - real(8) :: xs_0K ! 0K xs at E_rel - real(8) :: xs_eff ! effective elastic xs at temperature T - real(8) :: wcf ! weight correction factor - real(8) :: E_red ! reduced energy - real(8) :: E_low ! lowest practical relative energy - real(8) :: E_up ! highest practical relative energy - real(8) :: E_old ! tmp storage of current energy - real(8) :: awr ! target/neutron mass ratio - integer :: i_E_low ! 0K index to lowest practical relative energy - integer :: i_E_up ! 0K index to highest practical relative energy - real(8) :: xs_max ! max 0K xs over practical relative energies - real(8) :: xs_low ! 0K xs at lowest practical relative energy - real(8) :: xs_up ! 0K xs at highest practical relative energy - real(8) :: m ! slope for interpolation - real(8) :: R_dbrc ! DBRC rejection criterion - logical :: reject ! resample if true - - character(80) :: sampling_scheme - - ! Determine equilibrium temperature in MeV kT = nuc % kT awr = nuc % awr - ! Check if nuclide is a resonant scatterer and which sampling scheme - ! to use based on neutron energy - if (nuc % resonant) then - sampling_scheme = nuc % scheme - sampling_scheme = trim(sampling_scheme) - if (E > nuc % E_max) then - v_target = ZERO - return - else if (E < nuc % E_min) then - sampling_scheme = 'cxs' - sampling_scheme = trim(sampling_scheme) - end if - else - if (E >= FREE_GAS_THRESHOLD * kT .and. nuc % awr > ONE) then - v_target = ZERO - return + beta_vn = sqrt(awr * E / kT) + alpha = ONE/(ONE + sqrt(pi)*beta_vn/TWO) + + do + ! Sample two random numbers + r1 = prn() + r2 = prn() + + if (prn() < alpha) then + ! With probability alpha, we sample the distribution p(y) = + ! y*e^(-y). This can be done with sampling scheme C45 frmo the Monte + ! Carlo sampler + + beta_vt_sq = -log(r1*r2) + else - sampling_scheme = 'cxs' - sampling_scheme = trim(sampling_scheme) + ! With probability 1-alpha, we sample the distribution p(y) = y^2 * + ! e^(-y^2). This can be done with sampling scheme C61 from the Monte + ! Carlo sampler + + c = cos(PI/TWO * prn()) + beta_vt_sq = -log(r1) - log(r2)*c*c end if - end if - - ! reject unless criteria are satisfied - reject = .true. + + ! Determine beta * vt + beta_vt = sqrt(beta_vt_sq) + + ! Sample cosine of angle between neutron and target velocity + mu = TWO*prn() - ONE + + ! Determine rejection probability + accept_prob = sqrt(beta_vn*beta_vn + beta_vt_sq - 2*beta_vn*beta_vt*mu) & + /(beta_vn + beta_vt) + + ! Perform rejection sampling on vt and mu + if (prn() < accept_prob) exit + end do - select case (sampling_scheme) - case ('cxs') - ! calculate beta, alpha - beta_vn = sqrt(nuc%awr * E / kT) - alpha = ONE/(ONE + sqrt(pi)*beta_vn/TWO) - - do - ! Sample two random numbers - r1 = prn() - r2 = prn() - - if (prn() < alpha) then - ! With probability alpha, we sample the distribution p(y) = - ! y*e^(-y). This can be done with sampling scheme C45 frmo the Monte - ! Carlo sampler - - beta_vt_sq = -log(r1*r2) - - else - ! With probability 1-alpha, we sample the distribution p(y) = y^2 * - ! e^(-y^2). This can be done with sampling scheme C61 from the Monte - ! Carlo sampler - - c = cos(PI/TWO * prn()) - beta_vt_sq = -log(r1) - log(r2)*c*c - end if - - ! Determine beta * vt - beta_vt = sqrt(beta_vt_sq) - - ! Sample cosine of angle between neutron and target velocity - mu = TWO*prn() - ONE - - ! Determine rejection probability - accept_prob = sqrt(beta_vn*beta_vn + beta_vt_sq - 2*beta_vn*beta_vt*mu) & - /(beta_vn + beta_vt) - - ! Perform rejection sampling on vt and mu - if (prn() < accept_prob) exit - end do - - ! determine speed of target nucleus - vt = sqrt(beta_vt_sq*kT/nuc % awr) - - ! determine velocity vector of target nucleus based on neutron's velocity - ! and the sampled angle between them - v_target = vt * rotate_angle(uvw, mu) - - case ('wcm') - ! calculate beta, alpha - beta_vn = sqrt(nuc%awr * E / kT) - alpha = ONE/(ONE + sqrt(pi)*beta_vn/TWO) - - do - ! Sample two random numbers - r1 = prn() - r2 = prn() - - if (prn() < alpha) then - ! With probability alpha, we sample the distribution p(y) = - ! y*e^(-y). This can be done with sampling scheme C45 frmo the Monte - ! Carlo sampler - - beta_vt_sq = -log(r1*r2) - - else - ! With probability 1-alpha, we sample the distribution p(y) = y^2 * - ! e^(-y^2). This can be done with sampling scheme C61 from the Monte - ! Carlo sampler - - c = cos(PI/TWO * prn()) - beta_vt_sq = -log(r1) - log(r2)*c*c - end if - - ! Determine beta * vt - beta_vt = sqrt(beta_vt_sq) - - ! Sample cosine of angle between neutron and target velocity - mu = TWO*prn() - ONE - - ! Determine rejection probability - accept_prob = sqrt(beta_vn*beta_vn + beta_vt_sq - 2*beta_vn*beta_vt*mu) & - /(beta_vn + beta_vt) - - ! Perform rejection sampling on vt and mu - if (prn() < accept_prob) exit - end do - - ! determine speed of target nucleus - vt = sqrt(beta_vt_sq*kT/nuc % awr) - - ! determine velocity vector of target nucleus based on neutron's velocity - ! and the sampled angle between them - v_target = vt * rotate_angle(uvw, mu) - - ! adjust particle weight - E_rel = dot_product((v_neut - v_target), (v_neut - v_target)) - xs_0K = elastic_0K_xs(E_rel, nuc) - wcf = xs_0K / xs_eff - wgt = wcf * wgt - - case ('dbrc') - ! reduced neutron energy - E_red = sqrt((awr * E) / kT) - - ! lower limit for range that max xs is determined over - E_low = (((E_red - 4.0_8)**2) * kT) / awr - - ! upper limit for range that max xs is determined over - E_up = (((E_red + 4.0_8)**2) * kT) / awr - - ! incident neutron energy - E_old = E - - ! find index and calculate 0K xs at lower energy bound - E = E_low - call find_energy_index(E) - ! nuclide energy grid index - i_E_low = nuc % grid_index_0K(union_grid_index) - - ! find index and calculate 0K xs at upper energy bound - E = E_up - call find_energy_index(E) - ! nuclide energy grid index - i_E_up = nuc % grid_index_0K(union_grid_index) - - ! reset particle energy to incident value - ! (it was only changed to calculate 0K xs at different energies) - E = E_old - - ! xs at lower bounding index - xs_low = nuc % elastic_0K(i_E_low) - - ! slope - m = (nuc % elastic_0K(i_E_low + 1) - xs_low) & - & / (nuc % energy_0K(i_E_low + 1) - nuc % energy_0K(i_E_low)) - - ! actual lower bound 0K xs - xs_low = xs_low + m * (E_low - nuc % energy_0K(i_E_low)) - - ! xs at upper bounding index - xs_up = nuc % elastic_0K(i_E_up) - - ! slope - m = (nuc % elastic_0K(i_E_up + 1) - xs_up) & - & / (nuc % energy_0K(i_E_up + 1) - nuc % energy_0K(i_E_up)) - - ! actual upper bound 0K xs - xs_up = xs_up + m * (E_up - nuc % energy_0K(i_E_up)) - - ! get max 0K xs value - xs_max = max(xs_low, maxval(nuc % elastic_0K(i_E_low + 1 : i_E_up - 1)), xs_up) - - ! calculate beta - beta_vn = sqrt(awr * E / kT) - alpha = ONE / (ONE + sqrt(pi) * beta_vn / TWO) - - do - ! Sample two random numbers - r1 = prn() - r2 = prn() - - if (prn() < alpha) then - ! With probability alpha, we sample the distribution p(y) = - ! y*e^(-y). This can be done with sampling scheme C45 frmo the Monte - ! Carlo sampler - beta_vt_sq = -log(r1 * r2) - else - ! With probability 1-alpha, we sample the distribution p(y) = y^2 * - ! e^(-y^2). This can be done with sampling scheme C61 from the Monte - ! Carlo sampler - c = cos(PI / TWO * prn()) - beta_vt_sq = -log(r1) - log(r2) * c**2 - end if - - ! Determine beta * vt - beta_vt = sqrt(beta_vt_sq) - - ! Sample cosine of angle between neutron and target velocity - mu = TWO * prn() - ONE - - ! Determine rejection probability - accept_prob = sqrt(beta_vn * beta_vn + beta_vt_sq - 2 * beta_vn * beta_vt * mu) & - / (beta_vn + beta_vt) - - ! Perform rejection sampling on vt and mu - if (prn() < accept_prob) then - vt = sqrt(beta_vt_sq * kT / awr) - - v_target = vt * rotate_angle(uvw, mu) - - E_rel = dot_product((v_neut - v_target), (v_neut - v_target)) - - xs_0K = elastic_0K_xs(E_rel, nuc) - - R_dbrc = xs_0K / xs_max - - if (prn() < R_dbrc) reject = .false. - end if - - if (.not. reject) exit - end do - - case default - message = "Not a recognized resonance scattering treatment!" - call fatal_error() - end select + ! determine speed of target nucleus + vt = sqrt(beta_vt_sq*kT/awr) - end subroutine sample_target_velocity + ! determine velocity vector of target nucleus based on neutron's velocity + ! and the sampled angle between them + v_target = vt * rotate_angle(uvw, mu) + + end subroutine sample_cxs_target_velocity !=============================================================================== ! CREATE_FISSION_SITES determines the average total, prompt, and delayed From e59f05e3c1cd826af2cd9b3d6ede52f3aa41a85e Mon Sep 17 00:00:00 2001 From: walshjon Date: Sat, 7 Dec 2013 17:31:32 -0800 Subject: [PATCH 034/109] cleaned up error handling, comments --- src/Makefile | 4 +- src/ace.F90 | 31 ++++++----- src/ace_header.F90 | 16 +++--- src/cross_section.F90 | 6 +-- src/energy_grid.F90 | 3 ++ src/global.F90 | 6 +-- src/input_xml.F90 | 112 +++++++++++++++++++++++++++++---------- src/physics.F90 | 38 ++++++------- src/relaxng/settings.rnc | 26 ++++----- 9 files changed, 154 insertions(+), 88 deletions(-) diff --git a/src/Makefile b/src/Makefile index 03c370e07a..94da0f5288 100644 --- a/src/Makefile +++ b/src/Makefile @@ -13,7 +13,7 @@ COMPILER = gnu DEBUG = no PROFILE = no OPTIMIZE = no -MPI = no +MPI = yes OPENMP = no HDF5 = no PETSC = no @@ -22,7 +22,7 @@ PETSC = no # External Library Paths #=============================================================================== -MPI_DIR = /opt/mpich/3.0.4-$(COMPILER) +MPI_DIR = /opt/mpich/3.0.2-$(COMPILER) HDF5_DIR = /opt/hdf5/1.8.11-$(COMPILER) PHDF5_DIR = /opt/phdf5/1.8.11-$(COMPILER) PETSC_DIR = /opt/petsc/3.4.2-$(COMPILER) diff --git a/src/ace.F90 b/src/ace.F90 index 02eafa6911..894d7fcdc0 100644 --- a/src/ace.F90 +++ b/src/ace.F90 @@ -80,18 +80,23 @@ contains ! array call read_ace_table(i_nuclide, i_listing) + ! 0K resonant scatterer information, if treating resonance scattering if (treat_res_scat) then do n = 1, n_res_scatterers_total if (name == nuclides_0K(n) % name) then nuclides(i_nuclide) % resonant = .true. nuclides(i_nuclide) % name_0K = nuclides_0K(n) % name_0K - nuclides(i_nuclide) % name_0K = trim(nuclides(i_nuclide) % name_0K) + nuclides(i_nuclide) % name_0K = trim(nuclides(i_nuclide) % & + & name_0K) nuclides(i_nuclide) % scheme = nuclides_0K(n) % scheme - nuclides(i_nuclide) % scheme = trim(nuclides(i_nuclide) % scheme) + nuclides(i_nuclide) % scheme = trim(nuclides(i_nuclide) % & + & scheme) nuclides(i_nuclide) % E_min = nuclides_0K(n) % E_min nuclides(i_nuclide) % E_max = nuclides_0K(n) % E_max - if (.not. already_read % contains(nuclides(i_nuclide) % name_0K)) then - i_listing = xs_listing_dict % get_key(nuclides(i_nuclide) % name_0K) + if (.not. already_read % contains(nuclides(i_nuclide) % & + & name_0K)) then + i_listing = xs_listing_dict % get_key(nuclides(i_nuclide) % & + & name_0K) call read_ace_table(i_nuclide, i_listing) end if exit @@ -226,7 +231,6 @@ contains type(Nuclide), pointer :: nuc => null() type(SAlphaBeta), pointer :: sab => null() type(XsListing), pointer :: listing => null() - type(SetChar) :: already_read ! determine path, record length, and location of table listing => xs_listings(i_listing) @@ -321,6 +325,8 @@ contains select case(listing % type) case (ACE_NEUTRON) + + ! only read in a resonant scatterers info once nuc => nuclides(i_table) if (trim(adjustl(name)) /= nuc % name_0K) then nuc % name = name @@ -331,6 +337,8 @@ contains ! read all blocks call read_esz(nuc) + + ! don't read unnecessary 0K data for resonant scatterers if (.not. allocated(nuc % energy_0K)) then call read_nu_data(nuc) call read_reactions(nuc) @@ -349,7 +357,8 @@ contains ! for fissionable nuclides, precalculate microscopic nu-fission cross ! sections so that we don't need to call the nu_total function during - ! cross section lookups + ! cross section lookups (except if we're dealing w/ 0K data for resonant + ! scatterers) if (nuc % fissionable .and. .not. allocated(nuc % energy_0K)) then call generate_nu_fission(nuc) @@ -386,17 +395,13 @@ contains NE = NXS(3) ! allocate storage for energy grid and cross section arrays + + ! read in 0K data if we've already read in non-0K data if (allocated(nuc % energy)) then nuc % n_grid_0K = NE allocate(nuc % energy_0K(NE)) allocate(nuc % elastic_0K(NE)) - nuc % elastic_0K = ZERO - - ! Read data from XSS -- only the energy grid, elastic scattering and heating - ! cross section values are actually read from here. The total and absorption - ! cross sections are reconstructed from the partial reaction data. - XSS_index = 1 nuc % energy_0K = get_real(NE) @@ -406,7 +411,7 @@ contains ! Continue reading elastic scattering and heating nuc % elastic_0K = get_real(NE) - else + else ! read in non-0K data nuc % n_grid = NE allocate(nuc % energy(NE)) allocate(nuc % total(NE)) diff --git a/src/ace_header.F90 b/src/ace_header.F90 index de9d115b3f..14cc984928 100644 --- a/src/ace_header.F90 +++ b/src/ace_header.F90 @@ -156,18 +156,18 @@ module ace_header end type Nuclide !=============================================================================== -! NUCLIDE_0K contains all 0K cross section data and other parameters needed to -! treat resonance scattering +! NUCLIDE_0K temporarily contains all 0K cross section data and other parameters +! needed to treat resonance scattering before transferring them to NUCLIDE !=============================================================================== type Nuclide0K - character(10) :: nuclide ! name of nuclide, e.g. U-238 - character(16) :: scheme ! target velocity sampling scheme - character(10) :: name ! name of nuclide, e.g. 92235.03c - character(10) :: name_0K ! name of 0K nuclide, e.g. 92235.00c - real(8) :: E_min ! lower cutoff energy for res scattering - real(8) :: E_max ! upper cutoff energy for res scattering + character(10) :: nuclide ! name of nuclide, e.g. U-238 + character(16) :: scheme = 'dbrc' ! target velocity sampling scheme + character(10) :: name ! name of nuclide, e.g. 92235.03c + character(10) :: name_0K ! name of 0K nuclide, e.g. 92235.00c + real(8) :: E_min = 0.1e-6 ! lower cutoff energy for res scattering + real(8) :: E_max = 1000.0e-6 ! upper cutoff energy for res scattering end type Nuclide0K diff --git a/src/cross_section.F90 b/src/cross_section.F90 index a8be4f5c87..9b5073235a 100644 --- a/src/cross_section.F90 +++ b/src/cross_section.F90 @@ -487,9 +487,9 @@ contains type(Nuclide), pointer :: nuc ! target nuclide at temperature integer :: i_grid ! index on nuclide energy grid - real(8) :: f ! interp factor on nuclide energy grid - real(8), intent(inout) :: E ! trial energy - real(8) :: xs_out + real(8) :: f ! interp factor on nuclide energy grid + real(8), intent(inout) :: E ! trial energy + real(8) :: xs_out ! 0K xs at trial energy ! Determine index on nuclide energy grid select case (grid_method) diff --git a/src/energy_grid.F90 b/src/energy_grid.F90 index 097b74ff5d..642b86b100 100644 --- a/src/energy_grid.F90 +++ b/src/energy_grid.F90 @@ -28,6 +28,8 @@ contains do i = 1, n_nuclides_total nuc => nuclides(i) call add_grid_points(list, nuc % energy) + + ! add 0K points to the grid if (nuc % resonant) call add_grid_points(list, nuc % energy_0K) end do @@ -146,6 +148,7 @@ contains nuc % grid_index(j) = index_e - 1 end do + ! set pointers for 0K energy grid to the unionized grid if (nuc % resonant) then allocate(nuc % grid_index_0K(n_grid)) diff --git a/src/global.F90 b/src/global.F90 index 9f646ba04e..4da06301b4 100644 --- a/src/global.F90 +++ b/src/global.F90 @@ -371,9 +371,9 @@ module global ! ============================================================================ ! RESONANCE SCATTERING VARIABLES - logical :: treat_res_scat = .false. - integer :: n_res_scatterers_total = 0 - type(Nuclide0K), allocatable, target :: nuclides_0K(:) ! 0K nuclides + logical :: treat_res_scat = .false. ! is resonance scattering treated? + 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& trace, thread_id, current_work, matching_bins) diff --git a/src/input_xml.F90 b/src/input_xml.F90 index 95c6ab5f8f..6fcbb1c7b6 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -61,17 +61,19 @@ contains character(MAX_FILE_LEN) :: env_variable character(MAX_WORD_LEN) :: type character(MAX_LINE_LEN) :: filename - type(Node), pointer :: doc => null() - type(Node), pointer :: node_mode => null() - type(Node), pointer :: node_source => null() - type(Node), pointer :: node_dist => null() - type(Node), pointer :: node_cutoff => null() - type(Node), pointer :: node_entropy => null() - type(Node), pointer :: node_ufs => null() - type(Node), pointer :: node_sp => null() - type(Node), pointer :: node_output => null() - type(Node), pointer :: node_verb => null() - type(Node), pointer :: node_res_scat => null() + type(Node), pointer :: doc => null() + type(Node), pointer :: node_mode => null() + type(Node), pointer :: node_source => null() + type(Node), pointer :: node_dist => null() + type(Node), pointer :: node_cutoff => null() + type(Node), pointer :: node_entropy => null() + type(Node), pointer :: node_ufs => null() + type(Node), pointer :: node_sp => null() + type(Node), pointer :: node_output => null() + type(Node), pointer :: node_verb => null() + type(Node), pointer :: node_res_scat => null() + type(Node), pointer :: node_scatterer => null() + type(NodeList), pointer :: node_scat_list => null() ! Display output message message = "Reading settings XML file..." @@ -712,26 +714,72 @@ contains ! Resonance scattering parameters if (check_for_node(doc, "resonance_scattering")) then - ! Get pointer to output node call get_node_ptr(doc, "resonance_scattering", node_res_scat) - ! Check if any resonant scatterers specified - if (get_arraysize_string(node_res_scat, "scatterer") >= 1) then + call get_node_list(node_res_scat, "scatterer", node_scat_list) + + ! check that a nuclide is specified + if (get_list_size(node_scat_list) >= 1) then treat_res_scat = .true. - n_res_scatterers_total = get_arraysize_string(node_res_scat, "scatterer") + n_res_scatterers_total = get_list_size(node_scat_list) + + ! store 0K info for resonant scatterers allocate(nuclides_0K(n_res_scatterers_total)) - call get_node_array(node_res_scat, "scatterer", nuclides_0K % nuclide) - call get_node_array(node_res_scat, "method", nuclides_0K % scheme) - call get_node_array(node_res_scat, "xs_label", nuclides_0K % name) - call get_node_array(node_res_scat, "xs_label_0K", nuclides_0K % name_0K) - call get_node_array(node_res_scat, "E_min", nuclides_0K % E_min) - call get_node_array(node_res_scat, "E_max", nuclides_0K % E_max) + do i = 1, n_res_scatterers_total + call get_list_item(node_scat_list, i, node_scatterer) + + ! 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() + end if + call get_node_value(node_scatterer, "nuclide", & + nuclides_0K(i) % nuclide) + + if (check_for_node(node_scatterer, "method")) then + call get_node_value(node_scatterer, "method", & + nuclides_0K(i) % scheme) + end if + + ! 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() + 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() + end if + call get_node_value(node_scatterer, "xs_label_0K", & + nuclides_0K(i) % name_0K) + + if (check_for_node(node_scatterer, "E_min")) then + call get_node_value(node_scatterer, "E_min", & + nuclides_0K(i) % E_min) + end if + + if (check_for_node(node_scatterer, "E_max")) then + call get_node_value(node_scatterer, "E_max", & + nuclides_0K(i) % E_max) + end if + + nuclides_0K(i) % nuclide = trim(nuclides_0K(i) % nuclide) + nuclides_0K(i) % scheme = trim(nuclides_0K(i) % scheme) + call lower_case(nuclides_0K(i) % scheme) + nuclides_0K(i) % name = trim(nuclides_0K(i) % name) + 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() end if - do i = 1, n_res_scatterers_total - nuclides_0K(i) % nuclide = trim(nuclides_0K(i) % nuclide) - nuclides_0K(i) % scheme = trim(nuclides_0K(i) % scheme) - nuclides_0K(i) % name = trim(nuclides_0K(i) % name) - nuclides_0K(i) % name_0K = trim(nuclides_0K(i) % name_0K) - end do end if ! Close settings XML file @@ -1245,7 +1293,6 @@ contains integer :: i ! loop index for materials integer :: j ! loop index for nuclides - integer :: k ! loop index for resonant scatterers integer :: n ! number of nuclides integer :: n_sab ! number of sab tables for a material integer :: index_list ! index in xs_listings array @@ -3002,6 +3049,15 @@ contains end if end do + ! 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() + end if + end do + ! Close cross sections XML file call close_xmldoc(doc) diff --git a/src/physics.F90 b/src/physics.F90 index 722678cd9b..dec8db1adf 100644 --- a/src/physics.F90 +++ b/src/physics.F90 @@ -638,7 +638,7 @@ contains subroutine sample_target_velocity(nuc, v_target, E, uvw, v_neut, wgt, xs_eff) - type(Nuclide), pointer :: nuc ! target nuclide at temperature + type(Nuclide), pointer :: nuc ! target nuclide at temperature T real(8), intent(out) :: v_target(3) ! target velocity real(8), intent(in) :: v_neut(3) ! neutron velocity @@ -671,7 +671,7 @@ contains kT = nuc % kT awr = nuc % awr - ! Check if nuclide is a resonant scatterer + ! check if nuclide is a resonant scatterer if (nuc % resonant) then ! sampling scheme to use @@ -689,7 +689,7 @@ contains sampling_scheme = trim(sampling_scheme) end if - ! Otherwise, use free gas model + ! otherwise, use free gas model else if (E >= FREE_GAS_THRESHOLD * kT .and. awr > ONE) then v_target = ZERO @@ -700,20 +700,20 @@ contains end if end if - ! Use appropriate target velocity sampling method + ! use appropriate target velocity sampling method select case (sampling_scheme) case ('cxs') ! sample target velocity with the constant cross section (cxs) approx. call sample_cxs_target_velocity(nuc, v_target, E, uvw) - + case ('wcm') ! sample target velocity with the constant cross section (cxs) approx. call sample_cxs_target_velocity(nuc, v_target, E, uvw) - ! Adjust weight as prescribed by the weight correction method (wcm) + ! adjust weight as prescribed by the weight correction method (wcm) E_rel = dot_product((v_neut - v_target), (v_neut - v_target)) xs_0K = calculate_0K_elastic_xs(E_rel, nuc) wcf = xs_0K / xs_eff @@ -798,46 +798,46 @@ contains beta_vn = sqrt(awr * E / kT) alpha = ONE/(ONE + sqrt(pi)*beta_vn/TWO) - + do ! Sample two random numbers r1 = prn() r2 = prn() - + if (prn() < alpha) then ! With probability alpha, we sample the distribution p(y) = ! y*e^(-y). This can be done with sampling scheme C45 frmo the Monte ! Carlo sampler - + beta_vt_sq = -log(r1*r2) - + else ! With probability 1-alpha, we sample the distribution p(y) = y^2 * ! e^(-y^2). This can be done with sampling scheme C61 from the Monte ! Carlo sampler - + c = cos(PI/TWO * prn()) beta_vt_sq = -log(r1) - log(r2)*c*c end if - + ! Determine beta * vt beta_vt = sqrt(beta_vt_sq) - + ! Sample cosine of angle between neutron and target velocity mu = TWO*prn() - ONE - + ! Determine rejection probability accept_prob = sqrt(beta_vn*beta_vn + beta_vt_sq - 2*beta_vn*beta_vt*mu) & /(beta_vn + beta_vt) - + ! Perform rejection sampling on vt and mu if (prn() < accept_prob) exit end do - - ! determine speed of target nucleus + + ! Determine speed of target nucleus vt = sqrt(beta_vt_sq*kT/awr) - - ! determine velocity vector of target nucleus based on neutron's velocity + + ! Determine velocity vector of target nucleus based on neutron's velocity ! and the sampled angle between them v_target = vt * rotate_angle(uvw, mu) diff --git a/src/relaxng/settings.rnc b/src/relaxng/settings.rnc index 609815f411..eb78483a3f 100644 --- a/src/relaxng/settings.rnc +++ b/src/relaxng/settings.rnc @@ -119,17 +119,19 @@ element settings { }? & element resonance_scattering { - (element method { list { xsd:string { maxLength = "16" }+ } | - attribute method { list { xsd:string { maxLength = "16" }+ }) & - (element scatterer { list { xsd:string { maxLength = "12" }+ } } | - attribute scatterer { list { xsd:string { maxLength = "12" }+ } }) & - (element xs_label { list { xsd:string { maxLength = "12" }+ } } | - attribute xs_label { list { xsd:string { maxLength = "12" }+ } }) & - (element xs_label_0K { list { xsd:string { maxLength = "12" }+ } } | - attribute xs_label_0K { list { xsd:string { maxLength = "12" }+ } }) & - (element E_min { list { xsd:double+ } } | - attribute E_min { list { xsd:double+ } }) & - (element E_max { list { xsd:double+ } } | - attribute E_max { list { xsd:double+ } }) + element scatterer { + (element nuclide { xsd:string { maxLength = "12" } } | + attribute nuclide { xsd:string { maxLength = "12" } }) & + (element method { xsd:string { maxLength = "16" } } | + attribute method { xsd:string { maxLength = "16" } }) & + (element xs_label { xsd:string { maxLength = "12" } } | + attribute xs_label { xsd:string { maxLength = "12" } }) & + (element xs_label_0K { xsd:string { maxLength = "12" } } | + attribute xs_label_0K { xsd:string { maxLength = "12" } }) & + (element E_min { xsd:double } | + attribute E_min { xsd:double }) & + (element E_max { xsd:double } | + attribute E_max { xsd:double })? + }* }? } From 649f3b109a1bb0c0fb906ef987c1a99e7c0258ae Mon Sep 17 00:00:00 2001 From: walshjon Date: Sun, 8 Dec 2013 20:51:30 -0800 Subject: [PATCH 035/109] changed 0K grid pointers to integers --- 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 14cc984928..12808dd9f3 100644 --- a/src/ace_header.F90 +++ b/src/ace_header.F90 @@ -113,7 +113,7 @@ module ace_header 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 :: grid_index_0K(:) ! pointers to union grid + integer, allocatable :: grid_index_0K(:) ! pointers to union grid real(8), allocatable :: energy_0K(:) ! energy grid for 0K xs real(8), allocatable :: elastic_0K(:) ! Microscopic elastic cross section real(8), allocatable :: xs_cdf(:) ! CDF of v_rel times cross section From 771670f87303cb392b6f40fdced2e866005ede09 Mon Sep 17 00:00:00 2001 From: walshjon Date: Mon, 23 Dec 2013 17:01:24 -0800 Subject: [PATCH 036/109] handle negative 0K elastic xs values by setting to ZERO --- src/ace.F90 | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/src/ace.F90 b/src/ace.F90 index e902b516db..6aec1702dc 100644 --- a/src/ace.F90 +++ b/src/ace.F90 @@ -398,6 +398,7 @@ contains type(Nuclide), pointer :: nuc integer :: NE ! number of energy points for total and elastic cross sections + integer :: i ! index in 0K elastic xs array for this nuclide ! determine number of energy points NE = NXS(3) @@ -419,6 +420,12 @@ contains ! Continue reading elastic scattering and heating nuc % elastic_0K = get_real(NE) + ! Negative cross sections result in a CDF that is not monotonically + ! increasing. Set all negative xs values to ZERO. + do i = 1, nuc % n_grid_0K + if (nuc % elastic_0K(i) < ZERO) nuc % elastic_0K(i) = ZERO + end do + else ! read in non-0K data nuc % n_grid = NE allocate(nuc % energy(NE)) From cf739db807adc1b57e05b5e0cd649f730ead817a Mon Sep 17 00:00:00 2001 From: walshjon Date: Mon, 10 Mar 2014 16:08:53 -0700 Subject: [PATCH 037/109] added accelerated sampling scheme --- src/ace.F90 | 17 ++++++-- src/physics.F90 | 105 +++++++++++++++++++++++++++++++++++++++++------- 2 files changed, 104 insertions(+), 18 deletions(-) diff --git a/src/ace.F90 b/src/ace.F90 index 6aec1702dc..41596e2fe1 100644 --- a/src/ace.F90 +++ b/src/ace.F90 @@ -400,6 +400,8 @@ contains integer :: NE ! number of energy points for total and elastic cross sections integer :: i ! index in 0K elastic xs array for this nuclide + real(8) :: xs_cdf_sum = ZERO ! xs cdf value + ! determine number of energy points NE = NXS(3) @@ -410,7 +412,9 @@ contains nuc % n_grid_0K = NE allocate(nuc % energy_0K(NE)) allocate(nuc % elastic_0K(NE)) + allocate(nuc % xs_cdf(NE)) nuc % elastic_0K = ZERO + nuc % xs_cdf = ZERO XSS_index = 1 nuc % energy_0K = get_real(NE) @@ -420,10 +424,17 @@ contains ! Continue reading elastic scattering and heating nuc % elastic_0K = get_real(NE) - ! Negative cross sections result in a CDF that is not monotonically - ! increasing. Set all negative xs values to ZERO. - do i = 1, nuc % n_grid_0K + do i = 1, nuc % n_grid_0K - 1 + + ! Negative cross sections result in a CDF that is not monotonically + ! increasing. Set all negative xs values to ZERO. if (nuc % elastic_0K(i) < ZERO) nuc % elastic_0K(i) = ZERO + + ! build xs cdf + xs_cdf_sum = xs_cdf_sum + (sqrt(nuc % energy_0K(i)) * nuc % elastic_0K(i) & + & + sqrt(nuc % energy_0K(i+1)) * nuc % elastic_0K(i+1)) / TWO & + & * (nuc % energy_0K(i+1) - nuc % energy_0K(i)) + nuc % xs_cdf(i) = xs_cdf_sum end do else ! read in non-0K data diff --git a/src/physics.F90 b/src/physics.F90 index adbfa28719..e16c9d3068 100644 --- a/src/physics.F90 +++ b/src/physics.F90 @@ -745,25 +745,36 @@ contains real(8), intent(in) :: uvw(3) ! direction cosines real(8), intent(inout) :: wgt ! particle weight - real(8) :: awr ! target/neutron mass ratio - real(8) :: kT ! equilibrium temperature of target in MeV - real(8) :: E_rel ! trial relative energy - real(8) :: xs_0K ! 0K xs at E_rel - real(8) :: xs_eff ! effective elastic xs at temperature T - real(8) :: wcf ! weight correction factor - real(8) :: E_red ! reduced energy (same as used by Cullen in SIGMA1) - real(8) :: E_low ! lowest practical relative energy - real(8) :: E_up ! highest practical relative energy - real(8) :: xs_max ! max 0K xs over practical relative energies - real(8) :: xs_low ! 0K xs at lowest practical relative energy - real(8) :: xs_up ! 0K xs at highest practical relative energy - real(8) :: m ! slope for interpolation - real(8) :: R_dbrc ! DBRC rejection criterion + real(8) :: awr ! target/neutron mass ratio + real(8) :: kT ! equilibrium temperature of target in MeV + real(8) :: E_rel ! trial relative energy + real(8) :: xs_0K ! 0K xs at E_rel + real(8) :: xs_eff ! effective elastic xs at temperature T + real(8) :: wcf ! weight correction factor + real(8) :: E_red ! reduced energy (same as used by Cullen in SIGMA1) + real(8) :: E_low ! lowest practical relative energy + real(8) :: E_up ! highest practical relative energy + real(8) :: E_mode ! most probable Maxwellian energy + real(8) :: E_t_max ! highest practical target energy + real(8) :: E_t ! trial target energy + real(8) :: xs_max ! max 0K xs over practical relative energies + real(8) :: xs_low ! 0K xs at lowest practical relative energy + real(8) :: xs_up ! 0K xs at highest practical relative energy + real(8) :: m ! slope for interpolation + real(8) :: R_dbrc ! DBRC rejection criterion + real(8) :: R_speed ! target speed rejection criterion + real(8) :: cdf_low ! xs cdf at lowest practical relative energy + real(8) :: cdf_up ! xs cdf at highest practical relative energy + real(8) :: cdf_rel ! trial xs cdf value + real(8) :: p_mode ! probability at most probable energy + real(8) :: p_t ! probability at trial target energy + real(8) :: mu ! cosine between neutron and target velocities integer :: i_E_low ! 0K index to lowest practical relative energy integer :: i_E_up ! 0K index to highest practical relative energy + integer :: i_E_rel ! index to trial relative energy - logical :: reject ! resample if true + logical :: reject ! resample if true character(80) :: sampling_scheme ! method of target velocity sampling @@ -859,6 +870,70 @@ contains if (.not. reject) exit end do + case ('arts') + E_red = sqrt((awr * E) / kT) + E_low = (((E_red - 4.0_8)**2) * kT) / awr + E_up = (((E_red + 4.0_8)**2) * kT) / awr + + ! find lower and upper energy bound indices + call find_energy_index(E_low) + i_E_low = nuc % grid_index_0K(union_grid_index) + call find_energy_index(E_up) + i_E_up = nuc % grid_index_0K(union_grid_index) + + ! interpolate xs CDF since we're not exactly at the energy indices + m = (nuc % xs_cdf(i_E_low) - nuc % xs_cdf(i_E_low - 1)) & + & / (nuc % energy_0K(i_E_low + 1) - nuc % energy_0K(i_E_low)) + cdf_low = nuc % xs_cdf(i_E_low - 1) + m * (E_low - nuc % energy_0K(i_E_low)) + m = (nuc % xs_cdf(i_E_up) - nuc % xs_cdf(i_E_up - 1)) & + & / (nuc % energy_0K(i_E_up + 1) - nuc % energy_0K(i_E_up)) + cdf_up = nuc % xs_cdf(i_E_up - 1) + m * (E_up - nuc % energy_0K(i_E_up)) + + ! values used to sample the Maxwellian + E_mode = kT + p_mode = TWO * sqrt(E_mode / pi) * sqrt((ONE / kT)**3) & + & * exp(-E_mode / kT) + E_t_max = 16.0_8 * E_mode + + reject = .true. + + do + + ! perform Maxwellian rejection sampling + E_t = E_t_max * prn()**2 + p_t = TWO * sqrt(E_t / pi) * sqrt((ONE / kT)**3) & + & * exp(-E_t / kT) + R_speed = p_t / p_mode + + if (prn() < R_speed) then + + ! sample a relative energy using the xs cdf + cdf_rel = cdf_low + prn() * (cdf_up - cdf_low) + i_E_rel = binary_search(nuc % xs_cdf(i_E_low-1:i_E_up), & + & i_E_up - i_E_low + 2, cdf_rel) + E_rel = nuc % energy_0K(i_E_low + i_E_rel - 1) + m = (nuc % xs_cdf(i_E_low + i_E_rel - 1) & + & - nuc % xs_cdf(i_E_low + i_E_rel - 2)) & + & / (nuc % energy_0K(i_E_low + i_E_rel) & + & - nuc % energy_0K(i_E_low + i_E_rel - 1)) + E_rel = E_rel + (cdf_rel - nuc % xs_cdf(i_E_low + i_E_rel - 2)) / m + + ! perform rejection sampling on cosine between + ! neutron and target velocities + mu = (E_t + awr * (E - E_rel)) / (TWO * sqrt(awr * E * E_t)) + + if (abs(mu) < ONE) then + + ! set and accept target velocity + E_t = E_t / awr + v_target = sqrt(E_t) * rotate_angle(uvw, mu) + reject = .false. + end if + end if + + if (.not. reject) exit + end do + case default message = "Not a recognized resonance scattering treatment!" call fatal_error() From 9d28e6817019964279ffb81aacd40c5bb32df053 Mon Sep 17 00:00:00 2001 From: walshjon Date: Wed, 19 Mar 2014 17:23:51 -0400 Subject: [PATCH 038/109] Update publications.rst --- docs/source/publications.rst | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/docs/source/publications.rst b/docs/source/publications.rst index df7ca639bc..70ad1a6b64 100644 --- a/docs/source/publications.rst +++ b/docs/source/publications.rst @@ -4,6 +4,10 @@ Publications ============ +- Jonathan A. Walsh, Benoit Forget, and Kord S. Smith, "Accelerated sampling + of the free gas resonance elastic scattering kernel," *Ann. Nucl. Energy*, + **69**, 116--124 (2014). ``_ + - Benoit Forget, Sheng Xu, and Kord Smith, "Direct Doppler broadening in Monte Carlo simulations using the multipole representation," *Ann. Nucl. Energy*, **64**, 78--85 (2014). ``_ From 67a1e50b964039e09ef9f918e6f969a8fe9117d9 Mon Sep 17 00:00:00 2001 From: walshjon Date: Wed, 19 Mar 2014 18:30:49 -0400 Subject: [PATCH 039/109] updated input.rst w/ resonance scattering info --- docs/source/usersguide/input.rst | 56 ++++++++++++++++++++++++++++++++ 1 file changed, 56 insertions(+) diff --git a/docs/source/usersguide/input.rst b/docs/source/usersguide/input.rst index 83eb2a3d8a..5cc8f46b5e 100644 --- a/docs/source/usersguide/input.rst +++ b/docs/source/usersguide/input.rst @@ -237,6 +237,62 @@ 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: + + :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 + ``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 + that is to be applied to the ``nuclide``. Acceptable inputs for the + ``method`` attribute are ``ARTS``, ``CXS``, ``WCM``, and ``DBRC``. + Descriptions of each of these methods are documented here_. The + ``xs_label`` attribute gives the label for the cross section data of the + ``nuclide`` at a given temperature. The ``xs_label_0K`` gives the label + for the 0 K cross section data for the ``nuclide``. The ``E_min`` attribute + gives the minimum energy above which the ``method`` is applied. The + ``E_max`` attribute gives the maximum energy below which the ``method`` is + applied. One example would be as follows: + + .. _here: http://dx.doi.org/10.1016/j.anucene.2014.01.017 + + .. code-block:: xml + + + + U-238 + ARTS + 92238.72c + 92238.00c + 5.0e-6 + 40.0e-6 + + + Pu-239 + dbrc + 94239.72c + 94239.00c + 0.01e-6 + 210.0e-6 + + + + .. note:: The free gas, constant cross section (``cxs``) scattering model, + which has historically been used by Monte Carlo codes to sample + target velocities, is the default ``method``. Below ``E_min``, + the ``cxs`` default method is applied and above ``E_max``, the + target-at-rest (asymptotic) kernel is used. An arbitrary number of + ``scatterer`` elements may be specified, each corresponding to a + single nuclide at a single material temperature. + + *Default*: None + ```` Element ---------------------- From 436b4fd95afb5be4deeb443bba9b98a38f342c79 Mon Sep 17 00:00:00 2001 From: walshjon Date: Wed, 19 Mar 2014 19:04:21 -0400 Subject: [PATCH 040/109] added reference to resonance scattering paper --- docs/source/methods/physics.rst | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/docs/source/methods/physics.rst b/docs/source/methods/physics.rst index 54dc913455..55051d5979 100644 --- a/docs/source/methods/physics.rst +++ b/docs/source/methods/physics.rst @@ -997,9 +997,14 @@ Carlo code, it must be done in such a way that preserves the thermally-averaged reaction rate as per equation :eq:`doppler-broaden`. The method by which most Monte Carlo codes sample the target velocity for use in -elastic scattering kinematics is outlined in detail by [Gelbard]_. The -derivation here largely follows that of Gelbard. Let us first write the reaction -rate as a function of the velocity of the target nucleus: +elastic scattering kinematics is outlined in detail by [Gelbard]_. This is the +default method for sampling target velocities in OpenMC. Alternate methods for +treating thermal target motion which reproduce the exact elastic scattering kernel +have been implemented in OpenMC and are described by [Walsh]_. + +Here, the derivation of the default method largely follows that of Gelbard. Let +us first write the reaction rate as a function of the velocity of the target +nucleus: .. math:: :label: reaction-rate @@ -1559,6 +1564,10 @@ References .. [Gelbard] Ely M. Gelbard, "Epithermal Scattering in VIM," FRA-TM-123, Argonne National Laboratory (1979). + +.. [Walsh] Jonathan A. Walsh, Benoit Forget, and Kord S. Smith, "Accelerated + sampling of the free gas resonance elastic scattering kernel," *Ann. Nucl. + Energy*, **69**, 116-124 (2014). http://dx.doi.org/10.1016/j.anucene.2014.01.017 .. [Levitt] Leo B. Levitt, "The Probability Table Method for Treating Unresolved Neutron Resonances in Monte Carlo Calculations," *Nucl. Sci. Eng.*, **49**, From 10aa60dc7843d16d06d2354b59dc83dc622fe428 Mon Sep 17 00:00:00 2001 From: walshjon Date: Fri, 21 Mar 2014 12:09:30 -0700 Subject: [PATCH 041/109] Revert "added reference to resonance scattering paper" This reverts commit 436b4fd95afb5be4deeb443bba9b98a38f342c79. --- docs/source/methods/physics.rst | 15 +++------------ 1 file changed, 3 insertions(+), 12 deletions(-) diff --git a/docs/source/methods/physics.rst b/docs/source/methods/physics.rst index 55051d5979..54dc913455 100644 --- a/docs/source/methods/physics.rst +++ b/docs/source/methods/physics.rst @@ -997,14 +997,9 @@ Carlo code, it must be done in such a way that preserves the thermally-averaged reaction rate as per equation :eq:`doppler-broaden`. The method by which most Monte Carlo codes sample the target velocity for use in -elastic scattering kinematics is outlined in detail by [Gelbard]_. This is the -default method for sampling target velocities in OpenMC. Alternate methods for -treating thermal target motion which reproduce the exact elastic scattering kernel -have been implemented in OpenMC and are described by [Walsh]_. - -Here, the derivation of the default method largely follows that of Gelbard. Let -us first write the reaction rate as a function of the velocity of the target -nucleus: +elastic scattering kinematics is outlined in detail by [Gelbard]_. The +derivation here largely follows that of Gelbard. Let us first write the reaction +rate as a function of the velocity of the target nucleus: .. math:: :label: reaction-rate @@ -1564,10 +1559,6 @@ References .. [Gelbard] Ely M. Gelbard, "Epithermal Scattering in VIM," FRA-TM-123, Argonne National Laboratory (1979). - -.. [Walsh] Jonathan A. Walsh, Benoit Forget, and Kord S. Smith, "Accelerated - sampling of the free gas resonance elastic scattering kernel," *Ann. Nucl. - Energy*, **69**, 116-124 (2014). http://dx.doi.org/10.1016/j.anucene.2014.01.017 .. [Levitt] Leo B. Levitt, "The Probability Table Method for Treating Unresolved Neutron Resonances in Monte Carlo Calculations," *Nucl. Sci. Eng.*, **49**, From 23929d49b9586dad42ae3acc3de8e406a8e9d0f3 Mon Sep 17 00:00:00 2001 From: walshjon Date: Sat, 22 Mar 2014 15:56:45 -0400 Subject: [PATCH 042/109] add resonance scattering test case --- tests/test_resonance_scattering/geometry.xml | 8 ++++ tests/test_resonance_scattering/materials.xml | 9 ++++ tests/test_resonance_scattering/results.py | 25 +++++++++++ .../results_true.dat | 2 + tests/test_resonance_scattering/settings.xml | 27 ++++++++++++ .../test_resonance_scattering.py | 44 +++++++++++++++++++ 6 files changed, 115 insertions(+) create mode 100644 tests/test_resonance_scattering/geometry.xml create mode 100644 tests/test_resonance_scattering/materials.xml create mode 100644 tests/test_resonance_scattering/results.py create mode 100644 tests/test_resonance_scattering/results_true.dat create mode 100644 tests/test_resonance_scattering/settings.xml create mode 100644 tests/test_resonance_scattering/test_resonance_scattering.py diff --git a/tests/test_resonance_scattering/geometry.xml b/tests/test_resonance_scattering/geometry.xml new file mode 100644 index 0000000000..612e46132e --- /dev/null +++ b/tests/test_resonance_scattering/geometry.xml @@ -0,0 +1,8 @@ + + + + + + + + diff --git a/tests/test_resonance_scattering/materials.xml b/tests/test_resonance_scattering/materials.xml new file mode 100644 index 0000000000..f1f941f6b8 --- /dev/null +++ b/tests/test_resonance_scattering/materials.xml @@ -0,0 +1,9 @@ + + + + + + + + + diff --git a/tests/test_resonance_scattering/results.py b/tests/test_resonance_scattering/results.py new file mode 100644 index 0000000000..8ff10971cd --- /dev/null +++ b/tests/test_resonance_scattering/results.py @@ -0,0 +1,25 @@ +#!/usr/bin/env python + +import sys + +# import statepoint +sys.path.append('../../src/utils') +import statepoint + +# read in statepoint file +if len(sys.argv) > 1: + sp = statepoint.StatePoint(sys.argv[1]) +else: + sp = statepoint.StatePoint('statepoint.10.binary') +sp.read_results() + +# set up output string +outstr = '' + +# write out k-combined +outstr += 'k-combined:\n' +outstr += "{0:12.6E} {1:12.6E}\n".format(sp.k_combined[0], sp.k_combined[1]) + +# write results to file +with open('results_test.dat','w') as fh: + fh.write(outstr) diff --git a/tests/test_resonance_scattering/results_true.dat b/tests/test_resonance_scattering/results_true.dat new file mode 100644 index 0000000000..caf9941fe0 --- /dev/null +++ b/tests/test_resonance_scattering/results_true.dat @@ -0,0 +1,2 @@ +k-combined: +6.712684E-02 1.123945E-03 diff --git a/tests/test_resonance_scattering/settings.xml b/tests/test_resonance_scattering/settings.xml new file mode 100644 index 0000000000..2ac47de972 --- /dev/null +++ b/tests/test_resonance_scattering/settings.xml @@ -0,0 +1,27 @@ + + + + + + U-238 + cxs + 92238.72c + 92238.72c + 5.0e-6 + 40.0e-6 + + + + + 10 + 5 + 1000 + + + + + -4 -4 -4 4 4 4 + + + + diff --git a/tests/test_resonance_scattering/test_resonance_scattering.py b/tests/test_resonance_scattering/test_resonance_scattering.py new file mode 100644 index 0000000000..64d20b6115 --- /dev/null +++ b/tests/test_resonance_scattering/test_resonance_scattering.py @@ -0,0 +1,44 @@ +#!/usr/bin/env python + +import os +from subprocess import Popen, STDOUT, PIPE, call +import filecmp +from nose_mpi import NoseMPI +import glob + +pwd = os.path.dirname(__file__) + +def setup(): + os.putenv('PWD', pwd) + os.chdir(pwd) + +def test_run(): + openmc_path = pwd + '/../../src/openmc' + if int(NoseMPI.mpi_np) > 0: + proc = Popen([NoseMPI.mpi_exec, '-np', NoseMPI.mpi_np, openmc_path], + stderr=STDOUT, stdout=PIPE) + else: + proc = Popen([openmc_path], stderr=STDOUT, stdout=PIPE) + print(proc.communicate()[0]) + returncode = proc.returncode + assert returncode == 0 + +def test_created_statepoint(): + statepoint = glob.glob(pwd + '/statepoint.10.*') + assert len(statepoint) == 1 + assert statepoint[0].endswith('binary') or statepoint[0].endswith('h5') + +def test_results(): + statepoint = glob.glob(pwd + '/statepoint.10.*') + call(['python', 'results.py', statepoint[0]]) + compare = filecmp.cmp('results_test.dat', 'results_true.dat') + if not compare: + os.rename('results_test.dat', 'results_error.dat') + assert compare + +def teardown(): + output = glob.glob(pwd + '/statepoint.10.*') + output.append(pwd + '/results_test.dat') + for f in output: + if os.path.exists(f): + os.remove(f) From b5ddfa0355c81730c2be5ba1fe334fdbe6cfb41d Mon Sep 17 00:00:00 2001 From: walshjon Date: Mon, 7 Apr 2014 16:06:15 -0400 Subject: [PATCH 043/109] removed extraneous character trimming --- src/physics.F90 | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/physics.F90 b/src/physics.F90 index bc5cf9bc38..118e1c2816 100644 --- a/src/physics.F90 +++ b/src/physics.F90 @@ -786,7 +786,6 @@ contains ! sampling scheme to use sampling_scheme = nuc % scheme - sampling_scheme = trim(sampling_scheme) ! upper resonance scattering energy bound (target is at rest above this E) if (E > nuc % E_max) then @@ -796,7 +795,6 @@ contains ! lower resonance scattering energy bound (should be no resonances below) else if (E < nuc % E_min) then sampling_scheme = 'cxs' - sampling_scheme = trim(sampling_scheme) end if ! otherwise, use free gas model @@ -806,7 +804,6 @@ contains return else sampling_scheme = 'cxs' - sampling_scheme = trim(sampling_scheme) end if end if From ca561f4d6c67695a419fd22069e42cb07b604d4a Mon Sep 17 00:00:00 2001 From: walshjon Date: Mon, 7 Apr 2014 16:14:48 -0400 Subject: [PATCH 044/109] changed calculate_0K_elastic_xs to 0K_elastic_xs --- src/cross_section.F90 | 6 +++--- src/physics.F90 | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/cross_section.F90 b/src/cross_section.F90 index 9b5073235a..82e01c8798 100644 --- a/src/cross_section.F90 +++ b/src/cross_section.F90 @@ -479,11 +479,11 @@ contains end subroutine find_energy_index !=============================================================================== -! CALCULATE_0K_ELASTIC_XS determines the microscopic 0K elastic cross section +! 0K_ELASTIC_XS determines the microscopic 0K elastic cross section ! for a given nuclide at the trial relative energy used in resonance scattering !=============================================================================== - function calculate_0K_elastic_xs(E, nuc) result(xs_out) + function 0K_elastic_xs(E, nuc) result(xs_out) type(Nuclide), pointer :: nuc ! target nuclide at temperature integer :: i_grid ! index on nuclide energy grid @@ -524,6 +524,6 @@ contains ! Calculate microscopic nuclide elastic cross section xs_out = (ONE - f) * nuc % elastic_0K(i_grid) + f * nuc % elastic_0K(i_grid+1) - end function calculate_0K_elastic_xs + end function 0K_elastic_xs end module cross_section diff --git a/src/physics.F90 b/src/physics.F90 index 118e1c2816..0d27f1fc7d 100644 --- a/src/physics.F90 +++ b/src/physics.F90 @@ -2,7 +2,7 @@ module physics use ace_header, only: Nuclide, Reaction, DistEnergy use constants - use cross_section, only: calculate_0K_elastic_xs, find_energy_index, & + use cross_section, only: 0K_elastic_xs, find_energy_index, & union_grid_index use endf, only: reaction_name use error, only: fatal_error, warning @@ -822,7 +822,7 @@ contains ! adjust weight as prescribed by the weight correction method (wcm) E_rel = dot_product((v_neut - v_target), (v_neut - v_target)) - xs_0K = calculate_0K_elastic_xs(E_rel, nuc) + xs_0K = 0K_elastic_xs(E_rel, nuc) wcf = xs_0K / xs_eff wgt = wcf * wgt @@ -861,7 +861,7 @@ contains ! perform Doppler broadening rejection correction (dbrc) E_rel = dot_product((v_neut - v_target), (v_neut - v_target)) - xs_0K = calculate_0K_elastic_xs(E_rel, nuc) + xs_0K = 0K_elastic_xs(E_rel, nuc) R_dbrc = xs_0K / xs_max if (prn() < R_dbrc) reject = .false. if (.not. reject) exit From daaf718870d22fc7349a05c60536d6977a8c6f5d Mon Sep 17 00:00:00 2001 From: walshjon Date: Mon, 7 Apr 2014 16:15:41 -0400 Subject: [PATCH 045/109] deallocate 0 K energy grid --- src/ace_header.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/ace_header.F90 b/src/ace_header.F90 index 2f2c4c3f3f..70958259f2 100644 --- a/src/ace_header.F90 +++ b/src/ace_header.F90 @@ -376,6 +376,9 @@ module ace_header this % nu_fission, this % absorption) if (allocated(this % energy_0K)) & + deallocate(this % energy_0K) + + if (allocated(this % elastic_0K)) & deallocate(this % elastic_0K) if (allocated(this % xs_cdf)) & From 423136518f7c79c4af065e0e00848f19f493d215 Mon Sep 17 00:00:00 2001 From: walshjon Date: Mon, 7 Apr 2014 16:23:01 -0400 Subject: [PATCH 046/109] changed default resonance scattering treatment to arts --- src/ace_header.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/ace_header.F90 b/src/ace_header.F90 index 70958259f2..bbf1c6fb98 100644 --- a/src/ace_header.F90 +++ b/src/ace_header.F90 @@ -163,10 +163,10 @@ module ace_header type Nuclide0K character(10) :: nuclide ! name of nuclide, e.g. U-238 - character(16) :: scheme = 'dbrc' ! target velocity sampling scheme + character(16) :: scheme = 'arts' ! target velocity sampling scheme character(10) :: name ! name of nuclide, e.g. 92235.03c character(10) :: name_0K ! name of 0K nuclide, e.g. 92235.00c - real(8) :: E_min = 0.1e-6 ! lower cutoff energy for res scattering + real(8) :: E_min = 0.01e-6 ! lower cutoff energy for res scattering real(8) :: E_max = 1000.0e-6 ! upper cutoff energy for res scattering end type Nuclide0K From a38c3e393750f4e393e3fa13f5f010cb5caa7fad Mon Sep 17 00:00:00 2001 From: walshjon Date: Mon, 7 Apr 2014 17:37:22 -0400 Subject: [PATCH 047/109] changed 0K_elastic_xs to elastic_xs_0K --- src/cross_section.F90 | 4 ++-- src/physics.F90 | 6 +++--- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/cross_section.F90 b/src/cross_section.F90 index 82e01c8798..efb38fe0e1 100644 --- a/src/cross_section.F90 +++ b/src/cross_section.F90 @@ -483,7 +483,7 @@ contains ! for a given nuclide at the trial relative energy used in resonance scattering !=============================================================================== - function 0K_elastic_xs(E, nuc) result(xs_out) + function elastic_xs_0K(E, nuc) result(xs_out) type(Nuclide), pointer :: nuc ! target nuclide at temperature integer :: i_grid ! index on nuclide energy grid @@ -524,6 +524,6 @@ contains ! Calculate microscopic nuclide elastic cross section xs_out = (ONE - f) * nuc % elastic_0K(i_grid) + f * nuc % elastic_0K(i_grid+1) - end function 0K_elastic_xs + end function elastic_xs_0K end module cross_section diff --git a/src/physics.F90 b/src/physics.F90 index 0d27f1fc7d..4584416bd8 100644 --- a/src/physics.F90 +++ b/src/physics.F90 @@ -2,7 +2,7 @@ module physics use ace_header, only: Nuclide, Reaction, DistEnergy use constants - use cross_section, only: 0K_elastic_xs, find_energy_index, & + use cross_section, only: elastic_xs_0K, find_energy_index, & union_grid_index use endf, only: reaction_name use error, only: fatal_error, warning @@ -822,7 +822,7 @@ contains ! adjust weight as prescribed by the weight correction method (wcm) E_rel = dot_product((v_neut - v_target), (v_neut - v_target)) - xs_0K = 0K_elastic_xs(E_rel, nuc) + xs_0K = elastic_xs_0K(E_rel, nuc) wcf = xs_0K / xs_eff wgt = wcf * wgt @@ -861,7 +861,7 @@ contains ! perform Doppler broadening rejection correction (dbrc) E_rel = dot_product((v_neut - v_target), (v_neut - v_target)) - xs_0K = 0K_elastic_xs(E_rel, nuc) + xs_0K = elastic_xs_0K(E_rel, nuc) R_dbrc = xs_0K / xs_max if (prn() < R_dbrc) reject = .false. if (.not. reject) exit From 979b0b13bc70c9c562589e5492e5506847820911 Mon Sep 17 00:00:00 2001 From: walshjon Date: Mon, 7 Apr 2014 18:02:39 -0400 Subject: [PATCH 048/109] cleaned up reading in of 0 K data --- src/ace.F90 | 20 ++++++++++++++------ 1 file changed, 14 insertions(+), 6 deletions(-) diff --git a/src/ace.F90 b/src/ace.F90 index c5afb2a219..da3631c706 100644 --- a/src/ace.F90 +++ b/src/ace.F90 @@ -222,6 +222,7 @@ contains real(8) :: awrs(16) ! list of atomic weight ratios (not used) real(8) :: awr ! atomic weight ratio for table logical :: file_exists ! does ACE library exist? + logical :: data_0K ! are we reading 0K data? character(7) :: readable ! is ACE library readable? character(10) :: name ! name of ACE table character(10) :: date_ ! date ACE library was processed @@ -328,7 +329,10 @@ contains ! only read in a resonant scatterers info once nuc => nuclides(i_table) - if (trim(adjustl(name)) /= nuc % name_0K) then + data_0K = .false. + if (trim(adjustl(name)) == nuc % name_0K) then + data_0K = .true. + else nuc % name = name nuc % awr = awr nuc % kT = kT @@ -336,10 +340,12 @@ contains end if ! read all blocks - call read_esz(nuc) + call read_esz(nuc, data_0K) ! don't read unnecessary 0K data for resonant scatterers - if (.not. allocated(nuc % energy_0K)) then + if (data_0K) then + continue + else call read_nu_data(nuc) call read_reactions(nuc) call read_angular_dist(nuc) @@ -360,7 +366,7 @@ contains ! cross section lookups (except if we're dealing w/ 0K data for resonant ! scatterers) - if (nuc % fissionable .and. .not. allocated(nuc % energy_0K)) then + if (nuc % fissionable .and. .not. data_0K) then call generate_nu_fission(nuc) end if @@ -393,10 +399,12 @@ contains ! total xs, absorption xs, elastic scattering xs, and heating numbers. !=============================================================================== - subroutine read_esz(nuc) + subroutine read_esz(nuc, data_0K) type(Nuclide), pointer :: nuc + logical :: data_0K ! are we reading 0K data? + integer :: NE ! number of energy points for total and elastic cross sections integer :: i ! index in 0K elastic xs array for this nuclide @@ -408,7 +416,7 @@ contains ! allocate storage for energy grid and cross section arrays ! read in 0K data if we've already read in non-0K data - if (allocated(nuc % energy)) then + if (data_0K) then nuc % n_grid_0K = NE allocate(nuc % energy_0K(NE)) allocate(nuc % elastic_0K(NE)) From 044cad1f073fd51737c3ac18aa78e7c349bc5df3 Mon Sep 17 00:00:00 2001 From: walshjon Date: Mon, 7 Apr 2014 18:28:28 -0400 Subject: [PATCH 049/109] reflect changes to resonance_scattering defaults --- docs/source/usersguide/input.rst | 37 +++++++++++++++++--------------- 1 file changed, 20 insertions(+), 17 deletions(-) diff --git a/docs/source/usersguide/input.rst b/docs/source/usersguide/input.rst index 2ba8df75bf..59209b52e3 100644 --- a/docs/source/usersguide/input.rst +++ b/docs/source/usersguide/input.rst @@ -250,15 +250,16 @@ attributes or sub-elements: ``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 - that is to be applied to the ``nuclide``. Acceptable inputs for the - ``method`` attribute are ``ARTS``, ``CXS``, ``WCM``, and ``DBRC``. - Descriptions of each of these methods are documented here_. The - ``xs_label`` attribute gives the label for the cross section data of the - ``nuclide`` at a given temperature. The ``xs_label_0K`` gives the label - for the 0 K cross section data for the ``nuclide``. The ``E_min`` attribute - gives the minimum energy above which the ``method`` is applied. The - ``E_max`` attribute gives the maximum energy below which the ``method`` is - applied. One example would be as follows: + that is to be applied to the ``nuclide``. Acceptable inputs - none of + which are case-sensitive - for the ``method`` attribute are ``ARTS``, + ``CXS``, ``WCM``, and ``DBRC``. Descriptions of each of these methods + are documented here_. The ``xs_label`` attribute gives the label for the + cross section data of the ``nuclide`` at a given temperature. The + ``xs_label_0K`` gives the label for the 0 K cross section data for the + ``nuclide``. The ``E_min`` attribute gives the minimum energy above + which the ``method`` is applied. The ``E_max`` attribute gives the + maximum energy below which the ``method`` is applied. One example would + be as follows: .. _here: http://dx.doi.org/10.1016/j.anucene.2014.01.017 @@ -283,15 +284,17 @@ attributes or sub-elements: - .. note:: The free gas, constant cross section (``cxs``) scattering model, - which has historically been used by Monte Carlo codes to sample - target velocities, is the default ``method``. Below ``E_min``, - the ``cxs`` default method is applied and above ``E_max``, the - target-at-rest (asymptotic) kernel is used. An arbitrary number of - ``scatterer`` elements may be specified, each corresponding to a - single nuclide at a single material temperature. + .. note:: If the ``resonance_scattering`` element is not given, the free gas, + constant cross section (``cxs``) scattering model, which has + historically been used by Monte Carlo codes to sample target + velocities, is used to treat the target motion of all nuclides. If + ``resonance_scattering`` is present, the ``cxs`` method is applied + below ``E_min`` and the target-at-rest (asymptotic) kernel is used + above ``E_max``. An arbitrary number of ``scatterer`` elements may + be specified, each corresponding to a single nuclide at a single + temperature. - *Default*: None + *Defaults*: None (scatterer), ARTS (method), 0.01 eV (E_min), 1.0 keV (E_max) ```` Element ---------------------- From f8c0d77c40868ebc988f01cee209c9ea9823691b Mon Sep 17 00:00:00 2001 From: walshjon Date: Fri, 25 Apr 2014 07:16:51 -0400 Subject: [PATCH 050/109] modified resonance scattering test --- .../test_resonance_scattering.py | 49 ++++++++++++------- 1 file changed, 31 insertions(+), 18 deletions(-) diff --git a/tests/test_resonance_scattering/test_resonance_scattering.py b/tests/test_resonance_scattering/test_resonance_scattering.py index 64d20b6115..bcc3f8a819 100644 --- a/tests/test_resonance_scattering/test_resonance_scattering.py +++ b/tests/test_resonance_scattering/test_resonance_scattering.py @@ -3,42 +3,55 @@ import os from subprocess import Popen, STDOUT, PIPE, call import filecmp -from nose_mpi import NoseMPI import glob +from optparse import OptionParser -pwd = os.path.dirname(__file__) - -def setup(): - os.putenv('PWD', pwd) - os.chdir(pwd) +parser = OptionParser() +parser.add_option('--mpi_exec', dest='mpi_exec', default='') +parser.add_option('--mpi_np', dest='mpi_np', default='3') +parser.add_option('--exe', dest='exe') +(opts, args) = parser.parse_args() +cwd = os.getcwd() def test_run(): - openmc_path = pwd + '/../../src/openmc' - if int(NoseMPI.mpi_np) > 0: - proc = Popen([NoseMPI.mpi_exec, '-np', NoseMPI.mpi_np, openmc_path], + if opts.mpi_exec != '': + proc = Popen([opts.mpi_exec, '-np', opts.mpi_np, opts.exe, cwd], stderr=STDOUT, stdout=PIPE) else: - proc = Popen([openmc_path], stderr=STDOUT, stdout=PIPE) + proc = Popen([opts.exe, cwd], stderr=STDOUT, stdout=PIPE) print(proc.communicate()[0]) returncode = proc.returncode - assert returncode == 0 + assert returncode == 0, 'OpenMC did not exit successfully.' def test_created_statepoint(): - statepoint = glob.glob(pwd + '/statepoint.10.*') - assert len(statepoint) == 1 - assert statepoint[0].endswith('binary') or statepoint[0].endswith('h5') + statepoint = glob.glob(os.path.join(cwd, 'statepoint.10.*')) + assert len(statepoint) == 1, 'Either multiple or no statepoint files exist.' + assert statepoint[0].endswith('binary') or statepoint[0].endswith('h5'),\ + 'Statepoint file is not a binary or hdf5 file.' def test_results(): - statepoint = glob.glob(pwd + '/statepoint.10.*') + statepoint = glob.glob(os.path.join(cwd, 'statepoint.10.*')) call(['python', 'results.py', statepoint[0]]) compare = filecmp.cmp('results_test.dat', 'results_true.dat') if not compare: os.rename('results_test.dat', 'results_error.dat') - assert compare + assert compare, 'Results do not agree.' def teardown(): - output = glob.glob(pwd + '/statepoint.10.*') - output.append(pwd + '/results_test.dat') + output = glob.glob(os.path.join(cwd, 'statepoint.10.*')) + output.append(os.path.join(cwd, 'results_test.dat')) for f in output: if os.path.exists(f): os.remove(f) + +if __name__ == '__main__': + + # test for openmc executable + if opts.exe is None: + raise Exception('Must specify OpenMC executable from command line with --exe.') + + # run tests + test_run() + test_created_statepoint() + test_results() + teardown() From a35c705248bb7c759e638effdbf56b67ee67af12 Mon Sep 17 00:00:00 2001 From: walshjon Date: Mon, 12 May 2014 19:36:18 -0700 Subject: [PATCH 051/109] set lower cdf bound to zero if lower energy bound is below available data --- src/physics.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/physics.F90 b/src/physics.F90 index 4584416bd8..baf649b66a 100644 --- a/src/physics.F90 +++ b/src/physics.F90 @@ -882,6 +882,7 @@ contains m = (nuc % xs_cdf(i_E_low) - nuc % xs_cdf(i_E_low - 1)) & & / (nuc % energy_0K(i_E_low + 1) - nuc % energy_0K(i_E_low)) cdf_low = nuc % xs_cdf(i_E_low - 1) + m * (E_low - nuc % energy_0K(i_E_low)) + if (i_E_low == 1) cdf_low = ZERO m = (nuc % xs_cdf(i_E_up) - nuc % xs_cdf(i_E_up - 1)) & & / (nuc % energy_0K(i_E_up + 1) - nuc % energy_0K(i_E_up)) cdf_up = nuc % xs_cdf(i_E_up - 1) + m * (E_up - nuc % energy_0K(i_E_up)) From 8367a9727cc42c122ed83bb270cc82327fb7d3f7 Mon Sep 17 00:00:00 2001 From: walshjon Date: Thu, 19 Jun 2014 10:09:43 -0400 Subject: [PATCH 052/109] modified res scat test to use nndc data and at a provided temperature --- tests/test_resonance_scattering/materials.xml | 2 +- tests/test_resonance_scattering/results_true.dat | 2 +- tests/test_resonance_scattering/settings.xml | 4 ++-- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/test_resonance_scattering/materials.xml b/tests/test_resonance_scattering/materials.xml index f1f941f6b8..52a8c04be2 100644 --- a/tests/test_resonance_scattering/materials.xml +++ b/tests/test_resonance_scattering/materials.xml @@ -3,7 +3,7 @@ - + diff --git a/tests/test_resonance_scattering/results_true.dat b/tests/test_resonance_scattering/results_true.dat index caf9941fe0..2649c4414f 100644 --- a/tests/test_resonance_scattering/results_true.dat +++ b/tests/test_resonance_scattering/results_true.dat @@ -1,2 +1,2 @@ k-combined: -6.712684E-02 1.123945E-03 +6.822440E-02 6.306868E-04 diff --git a/tests/test_resonance_scattering/settings.xml b/tests/test_resonance_scattering/settings.xml index 2ac47de972..7ce4f23ac7 100644 --- a/tests/test_resonance_scattering/settings.xml +++ b/tests/test_resonance_scattering/settings.xml @@ -5,8 +5,8 @@ U-238 cxs - 92238.72c - 92238.72c + 92238.71c + 92238.71c 5.0e-6 40.0e-6 From c5a43746ad2d26e734abf728e729299d79475046 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Fri, 28 Feb 2014 18:37:11 -0500 Subject: [PATCH 053/109] added spatial source filter by fissionable material --- src/constants.F90 | 5 +++-- src/initialize.F90 | 36 ++++++++++++++++++++++++++++++++++++ src/input_xml.F90 | 3 +++ src/material_header.F90 | 4 ++++ src/source.F90 | 33 +++++++++++++++++++++++++++++++++ 5 files changed, 79 insertions(+), 2 deletions(-) diff --git a/src/constants.F90 b/src/constants.F90 index f83f7bd2c1..fa19a2ce1e 100644 --- a/src/constants.F90 +++ b/src/constants.F90 @@ -361,8 +361,9 @@ module constants ! Source spatial distribution types integer, parameter :: & - SRC_SPACE_BOX = 1, & ! Source in a rectangular prism - SRC_SPACE_POINT = 2 ! Source at a single point + SRC_SPACE_BOX = 1, & ! Source in a rectangular prism + SRC_SPACE_POINT = 2, & ! Source at a single point + SRC_SPACE_FISSION = 3 ! Source in prism filtered by fissionable mats ! Source angular distribution types integer, parameter :: & diff --git a/src/initialize.F90 b/src/initialize.F90 index 3e67ae8662..586051a9b2 100644 --- a/src/initialize.F90 +++ b/src/initialize.F90 @@ -11,6 +11,7 @@ module initialize use global use input_xml, only: read_input_xml, read_cross_sections_xml, & cells_in_univ_dict, read_plots_xml + use material_header, only: Material use output, only: title, header, write_summary, print_version, & print_usage, write_xs_summary, print_plot, & write_message @@ -107,6 +108,9 @@ contains ! Create linked lists for multiple instances of the same nuclide call same_nuclide_list() + ! Check for fissionable material + call check_mat_fission() + ! Construct unionized energy grid from cross-sections if (grid_method == GRID_UNION) then call time_unionize % start() @@ -897,4 +901,36 @@ contains end subroutine allocate_banks +!=============================================================================== +! CHECK_MAT_FISSION checks material for fissionable nuclides +!=============================================================================== + + subroutine check_mat_fission() + + integer :: i ! Material index counter + integer :: j ! Nuclide index counter + type(Material), pointer :: m => null() + + ! Loop around material + MAT: do i = 1, n_materials + + ! Get material + m => materials(i) + m % fissionable = .false. + + ! Loop around nuclides in material + NUC: do j = 1, m % n_nuclides + + ! Check for fission in nuclide + if (nuclides(m % nuclide(j)) % fissionable) then + m % fissionable = .true. + exit NUC + end if + + end do NUC + + end do MAT + + end subroutine check_mat_fission + end module initialize diff --git a/src/input_xml.F90 b/src/input_xml.F90 index 1869b9709d..c024a0f431 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -292,6 +292,9 @@ contains case ('box') external_source % type_space = SRC_SPACE_BOX coeffs_reqd = 6 + case ('fission') + external_source % type_space = SRC_SPACE_FISSION + coeffs_reqd = 6 case ('point') external_source % type_space = SRC_SPACE_POINT coeffs_reqd = 3 diff --git a/src/material_header.F90 b/src/material_header.F90 index cbfd917498..4f996a7e00 100644 --- a/src/material_header.F90 +++ b/src/material_header.F90 @@ -21,6 +21,10 @@ module material_header ! Temporary names read during initialization character(12), allocatable :: names(:) ! isotope names character(12), allocatable :: sab_names(:) ! name of S(a,b) table + + ! Does this material contain fissionable nuclides? + logical :: fissionable + end type Material end module material_header diff --git a/src/source.F90 b/src/source.F90 index 9dcfd01445..d23c90b71b 100644 --- a/src/source.F90 +++ b/src/source.F90 @@ -135,6 +135,39 @@ contains end do call p % clear() + case (SRC_SPACE_FISSION) + ! Set particle defaults + call p % initialize() + ! Repeat sampling source location until a good site has been found + found = .false. + do while (.not.found) + ! Coordinates sampled uniformly over a box + p_min = external_source % params_space(1:3) + p_max = external_source % params_space(4:6) + r = (/ (prn(), i = 1,3) /) + site % xyz = p_min + r*(p_max - p_min) + + ! Fill p with needed data + p % coord0 % xyz = site % xyz + p % coord0 % uvw = [ ONE, ZERO, ZERO ] + + ! Now search to see if location exists in geometry + call find_cell(p, found) + 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() + end if + cycle + end if + if (.not. materials(p % material) % fissionable) then + found = .false. + call p % initialize() + end if + end do + case (SRC_SPACE_POINT) ! Point source site % xyz = external_source % params_space From a3df011e7c1b319aa6f24921c024b64bfa700c7b Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Fri, 5 Sep 2014 15:01:56 -0400 Subject: [PATCH 054/109] added documentation for fission box source --- docs/source/usersguide/input.rst | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/docs/source/usersguide/input.rst b/docs/source/usersguide/input.rst index c9aa8cc866..4a92305bcc 100644 --- a/docs/source/usersguide/input.rst +++ b/docs/source/usersguide/input.rst @@ -311,6 +311,12 @@ attributes/sub-elements: parallelepiped and the last three of which specify the upper-right corner. Source sites are sampled uniformly through that parallelepiped. + To filter a "box" spatial distribution by fissionable material, specify + "fission" tag instead of "box". The ``parameters`` should be given as six + real numbers, the first three of which specify the lower-left corner of a + parallelepiped and the last three of which specify the upper-right + corner. Source sites are sampled uniformly through that parallelepiped. + For a "point" spatial distribution, ``parameters`` should be given as three real numbers which specify the (x,y,z) location of an isotropic point source From 1159c2f3e963caa94b4ac7a915169d4b15c844c1 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Fri, 5 Sep 2014 15:55:33 -0400 Subject: [PATCH 055/109] clear particle after fission sampling --- src/source.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/source.F90 b/src/source.F90 index d23c90b71b..d742c78109 100644 --- a/src/source.F90 +++ b/src/source.F90 @@ -167,6 +167,7 @@ contains call p % initialize() end if end do + call p % clear() case (SRC_SPACE_POINT) ! Point source From 7cdb34e2fd362209bd6c4388d738d66486996610 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Tue, 9 Sep 2014 09:01:24 -0400 Subject: [PATCH 056/109] moved location where materials are set to fissionable --- src/ace.F90 | 19 +++++++++++++++++++ src/initialize.F90 | 35 ----------------------------------- 2 files changed, 19 insertions(+), 35 deletions(-) diff --git a/src/ace.F90 b/src/ace.F90 index 58f7fd5707..1586c4dc6d 100644 --- a/src/ace.F90 +++ b/src/ace.F90 @@ -172,6 +172,25 @@ contains ! Avoid some valgrind leak errors call already_read % clear() + ! Loop around material + MAT: do i = 1, n_materials + + ! Get material + m => materials(i) + + ! Loop around nuclides in material + NUC: do j = 1, m % n_nuclides + + ! Check for fission in nuclide + if (nuclides(m % nuclide(j)) % fissionable) then + m % fissionable = .true. + exit NUC + end if + + end do NUC + + end do MAT + end subroutine read_xs !=============================================================================== diff --git a/src/initialize.F90 b/src/initialize.F90 index 586051a9b2..7d4adad493 100644 --- a/src/initialize.F90 +++ b/src/initialize.F90 @@ -108,9 +108,6 @@ contains ! Create linked lists for multiple instances of the same nuclide call same_nuclide_list() - ! Check for fissionable material - call check_mat_fission() - ! Construct unionized energy grid from cross-sections if (grid_method == GRID_UNION) then call time_unionize % start() @@ -901,36 +898,4 @@ contains end subroutine allocate_banks -!=============================================================================== -! CHECK_MAT_FISSION checks material for fissionable nuclides -!=============================================================================== - - subroutine check_mat_fission() - - integer :: i ! Material index counter - integer :: j ! Nuclide index counter - type(Material), pointer :: m => null() - - ! Loop around material - MAT: do i = 1, n_materials - - ! Get material - m => materials(i) - m % fissionable = .false. - - ! Loop around nuclides in material - NUC: do j = 1, m % n_nuclides - - ! Check for fission in nuclide - if (nuclides(m % nuclide(j)) % fissionable) then - m % fissionable = .true. - exit NUC - end if - - end do NUC - - end do MAT - - end subroutine check_mat_fission - end module initialize From deb3934152821e896b99c72fc0da357d0f2c5658 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Tue, 9 Sep 2014 09:02:51 -0400 Subject: [PATCH 057/109] default fissionable material to false --- src/material_header.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/material_header.F90 b/src/material_header.F90 index 4f996a7e00..fca735fd2a 100644 --- a/src/material_header.F90 +++ b/src/material_header.F90 @@ -23,7 +23,7 @@ module material_header character(12), allocatable :: sab_names(:) ! name of S(a,b) table ! Does this material contain fissionable nuclides? - logical :: fissionable + logical :: fissionable = .false. end type Material From 6d65923da28f5aab230cf60e7eedaa88bf6f660a Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Tue, 9 Sep 2014 09:05:31 -0400 Subject: [PATCH 058/109] accounted for void material --- src/source.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/source.F90 b/src/source.F90 index d742c78109..94d81d5060 100644 --- a/src/source.F90 +++ b/src/source.F90 @@ -162,6 +162,7 @@ contains end if cycle end if + if (p % material == MATERIAL_VOID) cycle if (.not. materials(p % material) % fissionable) then found = .false. call p % initialize() From e877f9aba0a994fa06880a2416507f2719569b1f Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Tue, 9 Sep 2014 09:10:17 -0400 Subject: [PATCH 059/109] fixed variable names when setting materials to fissionable --- src/ace.F90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/ace.F90 b/src/ace.F90 index 1586c4dc6d..8067439e1e 100644 --- a/src/ace.F90 +++ b/src/ace.F90 @@ -173,23 +173,23 @@ contains call already_read % clear() ! Loop around material - MAT: do i = 1, n_materials + MATERIAL_LOOP3: do i = 1, n_materials ! Get material - m => materials(i) + mat => materials(i) ! Loop around nuclides in material - NUC: do j = 1, m % n_nuclides + NUCLIDE_LOOP2: do j = 1, mat % n_nuclides ! Check for fission in nuclide - if (nuclides(m % nuclide(j)) % fissionable) then - m % fissionable = .true. - exit NUC + if (nuclides(mat % nuclide(j)) % fissionable) then + mat % fissionable = .true. + exit NUCLIDE_LOOP2 end if - end do NUC + end do NUCLIDE_LOOP2 - end do MAT + end do MATERIAL_LOOP3 end subroutine read_xs From 02dc33dd7d6bae0b87fceaa6f3e46e39a5e5ef13 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Tue, 9 Sep 2014 09:52:37 -0400 Subject: [PATCH 060/109] 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 061/109] 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 062/109] 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 063/109] 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 064/109] 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 065/109] 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 066/109] 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 067/109] 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 068/109] 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 069/109] 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 070/109] 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 071/109] 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 072/109] 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 39e272cd63b6c6785bb8c9e130f09186770830d4 Mon Sep 17 00:00:00 2001 From: walshjon Date: Tue, 9 Sep 2014 13:18:43 -0400 Subject: [PATCH 073/109] added some checks on resonance scattering energy bounds and in test problem python script --- src/input_xml.F90 | 14 +++++++++++++- .../test_resonance_scattering.py | 10 ++++++---- 2 files changed, 19 insertions(+), 5 deletions(-) diff --git a/src/input_xml.F90 b/src/input_xml.F90 index 7132d18e65..9b8b1a3c11 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -840,12 +840,24 @@ contains call get_node_value(node_scatterer, "E_min", & nuclides_0K(i) % E_min) end if - + + ! check that E_min is non-negative + if (E_min < ZERO) then + message = "Lower resonance scattering energy bound is negative" + call fatal_error() + end if + if (check_for_node(node_scatterer, "E_max")) then call get_node_value(node_scatterer, "E_max", & nuclides_0K(i) % E_max) end if + ! check that E_max is not less than E_min + if (E_max < E_min) then + message = "Lower resonance scattering energy bound exceeds upper" + call fatal_error() + end if + nuclides_0K(i) % nuclide = trim(nuclides_0K(i) % nuclide) nuclides_0K(i) % scheme = trim(nuclides_0K(i) % scheme) call lower_case(nuclides_0K(i) % scheme) diff --git a/tests/test_resonance_scattering/test_resonance_scattering.py b/tests/test_resonance_scattering/test_resonance_scattering.py index bcc3f8a819..6fdbf87459 100644 --- a/tests/test_resonance_scattering/test_resonance_scattering.py +++ b/tests/test_resonance_scattering/test_resonance_scattering.py @@ -51,7 +51,9 @@ if __name__ == '__main__': raise Exception('Must specify OpenMC executable from command line with --exe.') # run tests - test_run() - test_created_statepoint() - test_results() - teardown() + try: + test_run() + test_created_statepoint() + test_results() + finally: + teardown() From 20cffb0c4a850ab97c8262c86734d2f566549b03 Mon Sep 17 00:00:00 2001 From: walshjon Date: Tue, 9 Sep 2014 18:47:44 -0400 Subject: [PATCH 074/109] handle case with neutron being in the lowest energy grid bin or below --- src/physics.F90 | 21 ++++++++++++++++----- 1 file changed, 16 insertions(+), 5 deletions(-) diff --git a/src/physics.F90 b/src/physics.F90 index ba317f5fd8..32d3175673 100644 --- a/src/physics.F90 +++ b/src/physics.F90 @@ -884,13 +884,24 @@ contains i_E_up = nuc % grid_index_0K(union_grid_index) ! interpolate xs CDF since we're not exactly at the energy indices - m = (nuc % xs_cdf(i_E_low) - nuc % xs_cdf(i_E_low - 1)) & - & / (nuc % energy_0K(i_E_low + 1) - nuc % energy_0K(i_E_low)) - cdf_low = nuc % xs_cdf(i_E_low - 1) + m * (E_low - nuc % energy_0K(i_E_low)) - if (i_E_low == 1) cdf_low = ZERO + ! cdf value at lower bound attainable energy + if (i_E_low > 1) then + m = (nuc % xs_cdf(i_E_low) - nuc % xs_cdf(i_E_low - 1)) & + & / (nuc % energy_0K(i_E_low + 1) - nuc % energy_0K(i_E_low)) + cdf_low = nuc % xs_cdf(i_E_low - 1) & + & + m * (E_low - nuc % energy_0K(i_E_low)) + else + m = nuc % xs_cdf(i_E_low) & + & / (nuc % energy_0K(i_E_low + 1) - nuc % energy_0K(i_E_low)) + cdf_low = m * (E_low - nuc % energy_0K(i_E_low)) + if (E_low <= nuc % energy_0K(1)) cdf_low = ZERO + end if + + ! cdf value at upper bound attainable energy m = (nuc % xs_cdf(i_E_up) - nuc % xs_cdf(i_E_up - 1)) & & / (nuc % energy_0K(i_E_up + 1) - nuc % energy_0K(i_E_up)) - cdf_up = nuc % xs_cdf(i_E_up - 1) + m * (E_up - nuc % energy_0K(i_E_up)) + cdf_up = nuc % xs_cdf(i_E_up - 1) & + & + m * (E_up - nuc % energy_0K(i_E_up)) ! values used to sample the Maxwellian E_mode = kT From bec72d183343a355aeb43dec0e75b47a4a065cfb Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Mon, 18 Aug 2014 22:55:35 -0400 Subject: [PATCH 075/109] 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 43dafeec32614e30ba29355a3aeab1166708b992 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Wed, 10 Sep 2014 09:19:38 -0400 Subject: [PATCH 076/109] if in void material resample particle site and moved particle initialize for initial source in fission regions --- src/source.F90 | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/src/source.F90 b/src/source.F90 index 94d81d5060..c501b633be 100644 --- a/src/source.F90 +++ b/src/source.F90 @@ -136,11 +136,12 @@ contains call p % clear() case (SRC_SPACE_FISSION) - ! Set particle defaults - call p % initialize() ! Repeat sampling source location until a good site has been found found = .false. do while (.not.found) + ! Set particle defaults + call p % initialize() + ! Coordinates sampled uniformly over a box p_min = external_source % params_space(1:3) p_max = external_source % params_space(4:6) @@ -162,11 +163,8 @@ contains end if cycle end if - if (p % material == MATERIAL_VOID) cycle - if (.not. materials(p % material) % fissionable) then - found = .false. - call p % initialize() - end if + if (p % material == MATERIAL_VOID) found = .false. + if (.not. materials(p % material) % fissionable) found = .false. end do call p % clear() From 9e8c7531c5cf17544a92aef2042e71149dc93142 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Wed, 10 Sep 2014 09:23:03 -0400 Subject: [PATCH 077/109] must cycle when encountering material void when performing initial fission source box --- src/source.F90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/source.F90 b/src/source.F90 index c501b633be..5f928436b9 100644 --- a/src/source.F90 +++ b/src/source.F90 @@ -163,7 +163,10 @@ contains end if cycle end if - if (p % material == MATERIAL_VOID) found = .false. + if (p % material == MATERIAL_VOID) then + found = .false. + cycle + end if if (.not. materials(p % material) % fissionable) found = .false. end do call p % clear() From d1050fa194dcfeea2338837a5659c2ae565d1ba0 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Wed, 10 Sep 2014 09:30:46 -0400 Subject: [PATCH 078/109] 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 079/109] 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 080/109] 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 081/109] 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 082/109] 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 083/109] 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 084/109] 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 4f8634680e04ab0144679c0a89d40d4ea8afb3f8 Mon Sep 17 00:00:00 2001 From: walshjon Date: Wed, 10 Sep 2014 12:03:38 -0400 Subject: [PATCH 085/109] only use nuclide grids for resonance scattering --- src/ace_header.F90 | 4 ---- src/cross_section.F90 | 39 +++++++++++++----------------------- src/energy_grid.F90 | 18 ----------------- src/input_xml.F90 | 4 ++-- src/physics.F90 | 46 +++++++++++++++++++++++++++++++++---------- 5 files changed, 52 insertions(+), 59 deletions(-) diff --git a/src/ace_header.F90 b/src/ace_header.F90 index c881a559dc..b0fec99b6c 100644 --- a/src/ace_header.F90 +++ b/src/ace_header.F90 @@ -117,7 +117,6 @@ module ace_header 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 - integer, allocatable :: grid_index_0K(:) ! pointers to union grid real(8), allocatable :: energy_0K(:) ! energy grid for 0K xs real(8), allocatable :: elastic_0K(:) ! Microscopic elastic cross section real(8), allocatable :: xs_cdf(:) ! CDF of v_rel times cross section @@ -372,9 +371,6 @@ module ace_header if (allocated(this % grid_index)) & deallocate(this % grid_index) - - if (allocated(this % grid_index_0K)) & - deallocate(this % grid_index_0K) if (allocated(this % energy)) & deallocate(this % energy, this % total, this % elastic, & diff --git a/src/cross_section.F90 b/src/cross_section.F90 index 1c6ed8ae8f..0620cf11f8 100644 --- a/src/cross_section.F90 +++ b/src/cross_section.F90 @@ -527,37 +527,26 @@ contains real(8) :: xs_out ! 0K xs at trial energy ! Determine index on nuclide energy grid - select case (grid_method) - case (GRID_UNION) - ! If we're using the unionized grid with pointers, finding the index on - ! the nuclide energy grid is as simple as looking up the pointer - - call find_energy_index(E) - i_grid = nuc % grid_index_0K(union_grid_index) - - case (GRID_NUCLIDE) - ! If we're not using the unionized grid, we have to do a binary search on - ! the nuclide energy grid in order to determine which points to - ! interpolate between - - if (E < nuc % energy(1)) then - i_grid = 1 - elseif (E > nuc % energy(nuc % n_grid)) then - i_grid = nuc % n_grid - 1 - else - i_grid = binary_search(nuc % energy, nuc % n_grid, E) - end if - - end select + if (E < nuc % energy_0K(1)) then + i_grid = 1 + elseif (E > nuc % energy_0K(nuc % n_grid_0K)) then + i_grid = nuc % n_grid_0K - 1 + else + i_grid = binary_search(nuc % energy_0K, nuc % n_grid_0K, E) + end if ! check for rare case where two energy points are the same - if (nuc % energy_0K(i_grid) == nuc % energy_0K(i_grid+1)) i_grid = i_grid + 1 + 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)) + 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) + xs_out = (ONE - f) * nuc % elastic_0K(i_grid) & + & + f * nuc % elastic_0K(i_grid + 1) end function elastic_xs_0K diff --git a/src/energy_grid.F90 b/src/energy_grid.F90 index 642b86b100..a38a305d3e 100644 --- a/src/energy_grid.F90 +++ b/src/energy_grid.F90 @@ -147,24 +147,6 @@ contains end if nuc % grid_index(j) = index_e - 1 end do - - ! set pointers for 0K energy grid to the unionized grid - if (nuc % resonant) then - allocate(nuc % grid_index_0K(n_grid)) - - index_e = 1 - energy = nuc % energy_0K(index_e) - - do j = 1, n_grid - union_energy = e_grid(j) - if (union_energy >= energy .and. index_e < nuc % n_grid_0K) then - index_e = index_e + 1 - energy = nuc % energy_0K(index_e) - end if - nuc % grid_index_0K(j) = index_e - 1 - end do - end if - end do end subroutine grid_pointers diff --git a/src/input_xml.F90 b/src/input_xml.F90 index 9b8b1a3c11..27995597ce 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -842,7 +842,7 @@ contains end if ! check that E_min is non-negative - if (E_min < ZERO) then + if (nuclides_0K(i) % E_min < ZERO) then message = "Lower resonance scattering energy bound is negative" call fatal_error() end if @@ -853,7 +853,7 @@ contains end if ! check that E_max is not less than E_min - if (E_max < E_min) then + if (nuclides_0K(i) % E_max < nuclides_0K(i) % E_min) then message = "Lower resonance scattering energy bound exceeds upper" call fatal_error() end if diff --git a/src/physics.F90 b/src/physics.F90 index 32d3175673..e0fbf80d25 100644 --- a/src/physics.F90 +++ b/src/physics.F90 @@ -835,13 +835,26 @@ contains E_red = sqrt((awr * E) / kT) E_low = (((E_red - 4.0_8)**2) * kT) / awr E_up = (((E_red + 4.0_8)**2) * kT) / awr - + ! find lower and upper energy bound indices - call find_energy_index(E_low) - i_E_low = nuc % grid_index_0K(union_grid_index) - call find_energy_index(E_up) - i_E_up = nuc % grid_index_0K(union_grid_index) - + ! lower index + if (E_low < nuc % energy_0K(1)) then + i_E_low = 1 + elseif (E_low > nuc % energy_0K(nuc % n_grid_0K)) then + i_E_low = nuc % n_grid_0K - 1 + else + i_E_low = binary_search(nuc % energy_0K, nuc % n_grid_0K, E_low) + end if + + ! upper index + if (E_up < nuc % energy_0K(1)) then + i_E_up = 1 + elseif (E_up > nuc % energy_0K(nuc % n_grid_0K)) then + i_E_up = nuc % n_grid_0K - 1 + else + i_E_up = binary_search(nuc % energy_0K, nuc % n_grid_0K, E_up) + end if + ! interpolate xs since we're not exactly at the energy indices xs_low = nuc % elastic_0K(i_E_low) m = (nuc % elastic_0K(i_E_low + 1) - xs_low) & @@ -878,10 +891,23 @@ contains E_up = (((E_red + 4.0_8)**2) * kT) / awr ! find lower and upper energy bound indices - call find_energy_index(E_low) - i_E_low = nuc % grid_index_0K(union_grid_index) - call find_energy_index(E_up) - i_E_up = nuc % grid_index_0K(union_grid_index) + ! lower index + if (E_low < nuc % energy_0K(1)) then + i_E_low = 1 + elseif (E_low > nuc % energy_0K(nuc % n_grid_0K)) then + i_E_low = nuc % n_grid_0K - 1 + else + i_E_low = binary_search(nuc % energy_0K, nuc % n_grid_0K, E_low) + end if + + ! upper index + if (E_up < nuc % energy_0K(1)) then + i_E_up = 1 + elseif (E_up > nuc % energy_0K(nuc % n_grid_0K)) then + i_E_up = nuc % n_grid_0K - 1 + else + i_E_up = binary_search(nuc % energy_0K, nuc % n_grid_0K, E_up) + end if ! interpolate xs CDF since we're not exactly at the energy indices ! cdf value at lower bound attainable energy From 4d10704a8771d25537e000c1e6e7195a061699ca Mon Sep 17 00:00:00 2001 From: walshjon Date: Wed, 10 Sep 2014 11:35:09 -0700 Subject: [PATCH 086/109] updated resonance scattering test --- tests/test_resonance_scattering/results_true.dat | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/test_resonance_scattering/results_true.dat b/tests/test_resonance_scattering/results_true.dat index 2649c4414f..62b0ac2239 100644 --- a/tests/test_resonance_scattering/results_true.dat +++ b/tests/test_resonance_scattering/results_true.dat @@ -1,2 +1,2 @@ k-combined: -6.822440E-02 6.306868E-04 +6.452021E-02 1.738736E-03 From 3a9f2268def5f2354069f8d5ea9d78a4f76491ca Mon Sep 17 00:00:00 2001 From: walshjon Date: Wed, 10 Sep 2014 12:20:58 -0700 Subject: [PATCH 087/109] do not add 0 K energy points to union grid --- docs/source/usersguide/input.rst | 6 +++--- src/ace_header.F90 | 4 ++-- src/energy_grid.F90 | 3 --- src/physics.F90 | 5 ++--- 4 files changed, 7 insertions(+), 11 deletions(-) diff --git a/docs/source/usersguide/input.rst b/docs/source/usersguide/input.rst index f50c7ff217..c22008b793 100644 --- a/docs/source/usersguide/input.rst +++ b/docs/source/usersguide/input.rst @@ -274,7 +274,7 @@ attributes or sub-elements: of the nuclide to which a resonance scattering treatment is to be applied. The ``method`` attribute gives the type of resonance scattering treatment that is to be applied to the ``nuclide``. Acceptable inputs - none of - which are case-sensitive - for the ``method`` attribute are ``ARTS``, + which are case-sensitive - for the ``method`` attribute are ``ARES``, ``CXS``, ``WCM``, and ``DBRC``. Descriptions of each of these methods are documented here_. The ``xs_label`` attribute gives the label for the cross section data of the ``nuclide`` at a given temperature. The @@ -291,7 +291,7 @@ attributes or sub-elements: U-238 - ARTS + ARES 92238.72c 92238.00c 5.0e-6 @@ -317,7 +317,7 @@ attributes or sub-elements: be specified, each corresponding to a single nuclide at a single temperature. - *Defaults*: None (scatterer), ARTS (method), 0.01 eV (E_min), 1.0 keV (E_max) + *Defaults*: None (scatterer), ARES (method), 0.01 eV (E_min), 1.0 keV (E_max) ```` Element ---------------------- diff --git a/src/ace_header.F90 b/src/ace_header.F90 index b0fec99b6c..6d339891c9 100644 --- a/src/ace_header.F90 +++ b/src/ace_header.F90 @@ -159,14 +159,14 @@ module ace_header end type Nuclide !=============================================================================== -! NUCLIDE_0K temporarily contains all 0K cross section data and other parameters +! NUCLIDE0K temporarily contains all 0K cross section data and other parameters ! needed to treat resonance scattering before transferring them to NUCLIDE !=============================================================================== type Nuclide0K character(10) :: nuclide ! name of nuclide, e.g. U-238 - character(16) :: scheme = 'arts' ! target velocity sampling scheme + character(16) :: scheme = 'ares' ! target velocity sampling scheme character(10) :: name ! name of nuclide, e.g. 92235.03c character(10) :: name_0K ! name of 0K nuclide, e.g. 92235.00c real(8) :: E_min = 0.01e-6 ! lower cutoff energy for res scattering diff --git a/src/energy_grid.F90 b/src/energy_grid.F90 index a38a305d3e..66b95be0de 100644 --- a/src/energy_grid.F90 +++ b/src/energy_grid.F90 @@ -28,9 +28,6 @@ contains do i = 1, n_nuclides_total nuc => nuclides(i) call add_grid_points(list, nuc % energy) - - ! add 0K points to the grid - if (nuc % resonant) call add_grid_points(list, nuc % energy_0K) end do ! Set size of unionized energy grid diff --git a/src/physics.F90 b/src/physics.F90 index e0fbf80d25..04cc66afa2 100644 --- a/src/physics.F90 +++ b/src/physics.F90 @@ -2,8 +2,7 @@ module physics use ace_header, only: Nuclide, Reaction, DistEnergy use constants - use cross_section, only: elastic_xs_0K, find_energy_index, & - union_grid_index + use cross_section, only: elastic_xs_0K use endf, only: reaction_name use error, only: fatal_error, warning use fission, only: nu_total, nu_delayed @@ -885,7 +884,7 @@ contains if (.not. reject) exit end do - case ('arts') + case ('ares') E_red = sqrt((awr * E) / kT) E_low = (((E_red - 4.0_8)**2) * kT) / awr E_up = (((E_red + 4.0_8)**2) * kT) / awr From dee0c2f10f5a31275a87fd814632b7f110c19d6c Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Thu, 11 Sep 2014 22:52:11 -0400 Subject: [PATCH 088/109] 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 089/109] 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 090/109] 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 091/109] 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 092/109] 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 c8e5f984ad29c1fddc67949101eddacd0d43b1bf Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Fri, 12 Sep 2014 13:28:26 -0400 Subject: [PATCH 093/109] 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 bb1785c0629dd65c5fca7c439f3430d7f447a42e Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Wed, 17 Sep 2014 16:51:12 -0400 Subject: [PATCH 094/109] 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 095/109] 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 096/109] 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 097/109] 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 098/109] 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 099/109] 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 100/109] 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 101/109] 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 102/109] 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 103/109] 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 104/109] 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 105/109] 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 106/109] 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 107/109] 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 108/109] 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 109/109] 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 `_