Skip to content

Commit

Permalink
code cleanup
Browse files Browse the repository at this point in the history
  • Loading branch information
Courtney Peverley committed Jul 8, 2024
1 parent f7e9d1f commit 498dbbb
Show file tree
Hide file tree
Showing 3 changed files with 183 additions and 148 deletions.
50 changes: 23 additions & 27 deletions src/control/cam_instance.F90
View file
Original file line number Diff line number Diff line change
@@ -1,34 +1,30 @@
module cam_instance

implicit none
private
save
implicit none
public

public :: cam_instance_init
integer , public :: atm_id
integer , public :: inst_index
character(len=16), public :: inst_name
character(len=16), public :: inst_suffix

integer, public :: atm_id
integer, public :: inst_index
character(len=16), public :: inst_name
character(len=16), public :: inst_suffix

!==============================================================================
!===============================================================================
CONTAINS
!==============================================================================

subroutine cam_instance_init(atm_id_in, inst_name_in, inst_index_in, &
inst_suffix_in)
! Dummy arguments
integer, intent(in) :: atm_id_in
character(len=*), intent(in) :: inst_name_in
integer, intent(in) :: inst_index_in
character(len=*), intent(in) :: inst_suffix_in

! The following sets the module variables
atm_id = atm_id_in
inst_name = inst_name_in
inst_index = inst_index_in
inst_suffix = inst_suffix_in

end subroutine cam_instance_init
!===============================================================================

subroutine cam_instance_init(atm_id_in, inst_name_in, inst_index_in, inst_suffix_in)

integer , intent(in) :: atm_id_in
character(len=*) , intent(in) :: inst_name_in
integer , intent(in) :: inst_index_in
character(len=*) , intent(in) :: inst_suffix_in

! The following sets the module variables
atm_id = atm_id_in
inst_name = inst_name_in
inst_index = inst_index_in
inst_suffix = inst_suffix_in

end subroutine cam_instance_init

end module cam_instance
172 changes: 159 additions & 13 deletions src/utils/cam_abortutils.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -12,8 +12,20 @@ module cam_abortutils
save

public :: endrun
public :: safe_endrun
public :: check_allocate
public :: check_endrun ! Stub needed for testing
public :: cam_register_open_file
public :: cam_register_close_file

type :: open_file_pointer
type(file_desc_t), pointer :: file_desc => NULL()
character(len=max_chars) :: file_name = ''
type(open_file_pointer), pointer :: next => NULL()
end type open_file_pointer

type(open_file_pointer), pointer :: open_files_head => NULL()
type(open_file_pointer), pointer :: open_files_tail => NULL()
type(open_file_pointer), pointer :: open_files_pool => NULL()

CONTAINS

Expand All @@ -35,10 +47,10 @@ subroutine check_allocate(errcode, subname, fieldname, file, line)
call shr_mem_getusage(mem_hw_val, mem_val)

! Write error message with memory stats
write(abort_msg, '(4a,i0,a,f10.2,a,f10.2,a)') &
trim(subname), ": Allocate of '", &
trim(fieldname), "' failed with code ", errcode, &
". Memory highwater is ", mem_hw_val, &
write(abort_msg, '(4a,i0,a,f10.2,a,f10.2,a)') &
trim(subname), ": Allocate of '", &
trim(fieldname), "' failed with code ", errcode, &
". Memory highwater is ", mem_hw_val, &
" mb, current memory usage is ", mem_val, " mb"

! End the simulation
Expand All @@ -47,6 +59,110 @@ subroutine check_allocate(errcode, subname, fieldname, file, line)

end subroutine check_allocate

subroutine cam_register_open_file(file, file_name)
! Dummy arguments
type(file_desc_t), target, intent(in) :: file
character(len=*), intent(in) :: file_name
! Local variables
type(open_file_pointer), pointer :: of_ptr
type(open_file_pointer), pointer :: of_new
character(len=*), parameter :: subname = 'cam_register_open_file'

nullify(of_new)
! First, make sure we do not have this file
of_ptr => open_files_head
do while (associated(of_ptr))
if (file%fh == of_ptr%file_desc%fh) then
call endrun(subname//': Cannot register '//trim(file_name)//', file already open as '//trim(of_ptr%file_name))
end if
of_ptr => of_ptr%next
end do
! If we get here, go ahead and register the file
if (associated(open_files_pool)) then
of_new => open_files_pool
of_new%file_desc = file
of_new%file_name = file_name
allocate(open_files_pool%next)
open_files_pool%next => open_files_pool
else
allocate(of_new)
allocate(of_new%file_desc)
of_new%file_desc = file
of_new%file_name = file_name
open_files_pool => of_new
end if
open_files_tail => of_new
if (.not. associated(open_files_head)) then
open_files_head => of_new
end if
end subroutine cam_register_open_file

subroutine cam_register_close_file(file, log_shutdown_in)
! Dummy arguments
type(file_desc_t), target, intent(in) :: file
character(len=*), optional, intent(in) :: log_shutdown_in
! Local variables
type(open_file_pointer), pointer :: of_ptr
type(open_file_pointer), pointer :: of_prev
character(len=msg_len) :: log_shutdown
character(len=*), parameter :: subname = 'cam_register_close_file'
logical :: file_loop_var

nullify(of_prev)
! Are we going to log shutdown events?
if (present(log_shutdown_in)) then
log_shutdown = trim(log_shutdown_in)
else
log_shutdown = ''
end if
! Look to see if we have this file
of_ptr => open_files_head

!Set while-loop control variable
file_loop_var = .false.
if (associated(of_ptr)) then
if(associated(of_ptr%file_desc)) then
file_loop_var = .true.
end if
end if

do while (file_loop_var)
if (file%fh == of_ptr%file_desc%fh) then
! Remove this file from the list
if (associated(of_prev)) then
of_prev%next => of_ptr%next
else
open_files_head => of_ptr%next
end if
! Log closure?
! Note, no masterproc control because this could be any PE
if (len_trim(log_shutdown) > 0) then
write(iulog, '(a,": ",a," of ",a)') subname, &
trim(log_shutdown), trim(of_ptr%file_name)
call shr_sys_flush(iulog)
end if
! Push this object on to free pool
nullify(of_ptr%file_desc)
of_ptr%next => open_files_pool
open_files_pool => of_ptr
nullify(of_ptr)
exit
else
of_prev => of_ptr
of_ptr => of_ptr%next
end if
!Check if loop needs to continue
if (.not.associated(of_ptr)) then
file_loop_var = .false.
else
if(.not.associated(of_ptr%file_desc)) then
file_loop_var = .false.
end if
end if

end do
end subroutine cam_register_close_file

subroutine endrun(message, file, line)
! Parallel emergency stop
! Dummy arguments
Expand All @@ -68,14 +184,44 @@ subroutine endrun(message, file, line)

end subroutine endrun

logical function check_endrun(test_desc, output)
character(len=*), optional, intent(in) :: test_desc
integer, optional, intent(in) :: output

! Return .true. if an endrun message has been created
! Stub, always return .false.
check_endrun = .false.
subroutine safe_endrun(message, file, line)
! Sequential/global emergency stop
use pio, only : pio_closefile
! Dummy arguments
character(len=*), intent(in) :: message
character(len=*), optional, intent(in) :: file
integer, optional, intent(in) :: line

end function check_endrun
! Local variables
character(len=max_chars) :: abort_msg
type(open_file_pointer), pointer :: of_ptr
logical :: keep_loop

! First, close all open PIO files
of_ptr => open_files_head

!Check if needed pointers are associated:
keep_loop = .false.
if (associated(of_ptr)) then
if (associated(of_ptr%file_desc)) then
keep_loop = .true.
end if
end if

do while (keep_loop)
call pio_closefile(of_ptr%file_desc)
call cam_register_close_file(of_ptr%file_desc, &
log_shutdown_in="Emergency close")
of_ptr => of_ptr%next
!End loop if new pointers aren't associated:
if (.not. associated(of_ptr)) then
keep_loop = .false.
else if (.not. associated(of_ptr%file_desc)) then
keep_loop = .false.
end if
end do

call endrun(message, file, line)

end subroutine safe_endrun
end module cam_abortutils
109 changes: 1 addition & 108 deletions src/utils/cam_pio_utils.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -101,7 +101,6 @@ module cam_pio_utils
end interface cam_permute_array

interface cam_pio_dump_field
module procedure dump_field_1d_d
module procedure dump_field_2d_d
module procedure dump_field_3d_d
module procedure dump_field_4d_d
Expand Down Expand Up @@ -1317,7 +1316,7 @@ logical function cam_pio_fileexists(fname)
end if

! Back to whatever error handling was running before this routine
call pio_seterrorhandling(pio_subsystem, err_handling)
call pio_seterrorhandling(File, err_handling)

end function cam_pio_fileexists

Expand Down Expand Up @@ -1440,112 +1439,6 @@ subroutine find_dump_filename(fieldname, filename)
end subroutine find_dump_filename

!===========================================================================
subroutine dump_field_1d_d(fieldname, dim1b, dim1e, field, &
compute_maxdim_in, fill_value)
use pio, only: file_desc_t, var_desc_t, io_desc_t
use pio, only: pio_offset_kind, pio_enddef
use pio, only: pio_double, pio_int, pio_write_darray
use pio, only: pio_put_att, pio_initdecomp, pio_freedecomp

use mpi, only: mpi_max, mpi_integer
use spmd_utils, only: iam, npes, mpicom

! Dummy arguments
character(len=*), intent(in) :: fieldname
integer, intent(in) :: dim1b
integer, intent(in) :: dim1e
real(r8), target, intent(in) :: field(dim1b:dim1e)
logical, optional, intent(in) :: compute_maxdim_in
real(r8), optional, intent(in) :: fill_value

! Local variables
type(file_desc_t) :: file
type(var_desc_t) :: vdesc
type(var_desc_t) :: bnddesc
type(io_desc_t) :: iodesc
character(len=64) :: filename
real(r8) :: fillval
integer(PIO_OFFSET_KIND), allocatable :: ldof(:)
integer :: dimids(2)
integer :: bnddimid
integer :: bounds(2)
integer :: dimsizes(2)
integer :: ierr
integer :: i, m, lsize
logical :: compute_maxdim

! Find an unused filename for this variable
call find_dump_filename(fieldname, filename)

! Should we compute max dim sizes or assume they are all the same?
if (present(compute_maxdim_in)) then
compute_maxdim = compute_maxdim_in
else
compute_maxdim = .true.
end if

if (present(fill_value)) then
fillval = fill_value
else
fillval = -900._r8
end if

! Open the file for writing
call cam_pio_createfile(file, trim(filename))

! Define dimensions
if (compute_maxdim) then
call MPI_allreduce((dim1e - dim1b + 1), dimsizes(1), 1, MPI_integer, &
mpi_max, mpicom, ierr)
else
dimsizes(1) = dim1e - dim1b + 1
end if
dimsizes(2) = npes
do i = 1, size(dimids, 1)
write(filename, '(a,i0)') 'dim', i
call cam_pio_def_dim(file, trim(filename), dimsizes(i), dimids(i))
end do
call cam_pio_def_dim(file, 'bounds', size(bounds, 1), bnddimid)
! Define the variables
call cam_pio_def_var(file, trim(fieldname), pio_double, dimids, vdesc)
call cam_pio_def_var(file, 'field_bounds', pio_int, &
(/ bnddimid, dimids(size(dimids, 1)) /), bnddesc)
if (present(fill_value)) then
ierr = pio_put_att(file, vdesc, '_FillValue', fill_value)
end if
ierr = pio_enddef(file)

! Compute the variable decomposition and write field
lsize = product(dimsizes(1:2))
allocate(ldof(dim1e - dim1b + 1))
m = 0
do i = dim1b, dim1e
m = m + 1
ldof(m) = (iam * lsize) + (i - dim1b + 1)
end do
call pio_initdecomp(pio_subsystem, PIO_DOUBLE, dimsizes, ldof, iodesc)
call pio_write_darray(file, vdesc, iodesc, field(dim1b:dim1e), &
ierr, fillval)
call pio_freedecomp(file, iodesc)
deallocate(ldof)
! Compute the bounds decomposition and write field bounds
bounds(1) = dim1b
bounds(2) = dim1e
dimsizes(1) = size(bounds, 1)
dimsizes(2) = npes
allocate(ldof(size(bounds, 1)))
do i = 1, size(bounds, 1)
ldof(i) = (iam * size(bounds, 1)) + i
end do
call pio_initdecomp(pio_subsystem, PIO_INT, dimsizes(1:2), ldof, iodesc)
call pio_write_darray(file, bnddesc, iodesc, bounds, ierr, -900)
call pio_freedecomp(file, iodesc)
deallocate(ldof)

! All done
call cam_pio_closefile(file)
end subroutine dump_field_1d_d

subroutine dump_field_2d_d(fieldname, dim1b, dim1e, dim2b, dim2e, field, &
compute_maxdim_in, fill_value)
use pio, only: file_desc_t, var_desc_t, io_desc_t
Expand Down

0 comments on commit 498dbbb

Please sign in to comment.