Skip to content

Memory checking utility for CCPP builds (of NEMSfv3gfs) #147

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
climbfuji merged 3 commits into from
Aug 22, 2018
Merged

Memory checking utility for CCPP builds (of NEMSfv3gfs) #147

Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
dea0b33
physics/memcheck.F90: fix memcheck scheme for hybrid MPI/OpenMP calls…
climbfuji Aug 21, 2018
1d92609
Merge branch 'master' of https://github.com/NCAR/ccpp-physics into me…
climbfuji Aug 22, 2018
a75cdd7
physics/memcheck.F90: bugfix, remove test for ompthread being 0
climbfuji Aug 22, 2018
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
69 changes: 30 additions & 39 deletions physics/memcheck.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3,19 +3,13 @@

module memcheck

use machine, only: kind_phys

implicit none

private

public memcheck_init, memcheck_run, memcheck_finalize

! Can use larger time frame to track memory leaks
real(kind_phys), parameter :: SECONDS_ELAPSED_MIN = 3500.0
real(kind_phys), parameter :: SECONDS_ELAPSED_MAX = 3700.0

contains
contains

subroutine memcheck_init ()
end subroutine memcheck_init
Expand All @@ -24,15 +18,17 @@ subroutine memcheck_finalize ()
end subroutine memcheck_finalize

!> \section arg_table_memcheck_run Argument Table
!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional |
!! |-----------------|--------------------------------------------------------|---------------------------------------------------------|---------------|------|-----------|-----------|--------|----------|
!! | seconds_elapsed | seconds_elapsed_since_model_initialization | seconds elapsed since model initialization | s | 0 | real | kind_phys | in | F |
!! | block_number | block_number | for explicit data blocking: block number of this block | index | 0 | integer | | in | F |
!! | mpicomm | mpi_comm | MPI communicator | index | 0 | integer | | in | F |
!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F |
!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F |
!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional |
!! |-----------------|--------------------------------------------------------|---------------------------------------------------------|-------|------|-----------|-----------|--------|----------|
!! | mpicomm | mpi_comm | MPI communicator | index | 0 | integer | | in | F |
!! | mpirank | mpi_rank | current MPI-rank | index | 0 | integer | | in | F |
!! | mpisize | mpi_size | number of MPI tasks in communicator | count | 0 | integer | | in | F |
!! | mpiroot | mpi_root | master MPI-rank | index | 0 | integer | | in | T |
!! | ompthreads | omp_threads | number of OpenMP threads available for physics schemes | count | 0 | integer | | in | F |
!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F |
!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F |
!!
subroutine memcheck_run (seconds_elapsed, block_number, mpicomm, errmsg, errflg)
subroutine memcheck_run (mpicomm, mpirank, mpisize, mpiroot, ompthreads, errmsg, errflg)

#ifdef MPI
use mpi
Expand All @@ -45,52 +41,47 @@ subroutine memcheck_run (seconds_elapsed, block_number, mpicomm, errmsg, errflg)
implicit none

!--- interface variables
real(kind=kind_phys), intent(in) :: seconds_elapsed
integer, intent(in) :: block_number
integer, intent(in) :: mpicomm
integer, intent(in) :: mpirank
integer, intent(in) :: mpisize
integer, optional, intent(in) :: mpiroot
integer, intent(in) :: ompthreads
character(len=*), intent(out) :: errmsg
integer, intent(out) :: errflg

!--- local variables
integer :: impi, ierr
integer :: mpirank, mpisize
integer :: ompthread
character(len=1024) :: memory_usage

! Initialize CCPP error handling variables
errmsg = ''
errflg = 0

if (seconds_elapsed < SECONDS_ELAPSED_MIN .or. &
seconds_elapsed > SECONDS_ELAPSED_MAX) return

if (block_number>1) return

#ifdef MPI
call MPI_COMM_RANK(MPI_COMM_WORLD, mpirank, ierr)
call MPI_COMM_SIZE(MPI_COMM_WORLD, mpisize, ierr)
#else
mpirank = 0
mpisize = 1
#endif

#ifdef OPENMP
ompthread = OMP_GET_THREAD_NUM()
#else
ompthread = 0
#endif

ierr = ccpp_memory_usage(mpicomm, memory_usage)
if (present(mpiroot) .and. mpirank==mpiroot) then
write(0,'(a)') trim(memory_usage)
else if (.not.present(mpiroot)) then
! Output ordered by MPI rank
do impi=0,mpisize-1
if (mpirank==impi) then
write(0,'(a)') trim(memory_usage)
end if
#ifdef MPI
call MPI_BARRIER(mpicomm,ierr)
#endif
end do
end if

! Output ordered by MPI rank
do impi=0,mpisize-1
if (mpirank==impi .and. ompthread==0) then
write(0,'(a)') trim(memory_usage)
end if
#ifdef MPI
call MPI_BARRIER(MPI_COMM_WORLD,ierr)
call MPI_BARRIER(mpicomm,ierr)
#endif
end do

end subroutine memcheck_run

Expand Down