Skip to content

Commit

Permalink
add the updated shr_log_mod and shr_abort_mod files
Browse files Browse the repository at this point in the history
  • Loading branch information
jedwards4b committed Jan 30, 2025
1 parent 4aa602b commit 3cd9f5b
Show file tree
Hide file tree
Showing 2 changed files with 57 additions and 51 deletions.
44 changes: 3 additions & 41 deletions share/shr_abort_mod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -7,10 +7,7 @@ module shr_abort_mod
! (shr_sys_abort, shr_sys_backtrace). (This is for consistency with older code, from
! when these routines were defined in shr_sys_mod.)

use, intrinsic :: iso_fortran_env, only: output_unit, error_unit

use shr_kind_mod, only : shr_kind_in, shr_kind_cx
use shr_log_mod , only : s_logunit => shr_log_Unit

#ifdef CPRNAG
! NAG does not provide this as an intrinsic, but it does provide modules
Expand All @@ -36,11 +33,12 @@ module shr_abort_mod
!===============================================================================
subroutine shr_abort_abort(string,rc, line, file)
use esmf, only : ESMF_LOGWRITE, ESMF_LOGMSG_ERROR, ESMF_FINALIZE, ESMF_END_ABORT
use shr_log_mod, only : shr_log_error
! Consistent stopping mechanism

!----- arguments -----
character(len=*) , intent(in), optional :: string ! error message string
integer(shr_kind_in), intent(in), optional :: rc ! error code
integer(shr_kind_in), intent(inout), optional :: rc ! error code
integer(shr_kind_in), intent(in), optional :: line
character(len=*), intent(in), optional :: file

Expand All @@ -58,9 +56,7 @@ subroutine shr_abort_abort(string,rc, line, file)
write(local_string, *) trim(local_string), ' rc=',rc
endif

call print_error_to_logs("ERROR", local_string)

call ESMF_LogWrite(local_string, ESMF_LOGMSG_ERROR, line=line, file=file)
call shr_log_error(local_string, rc=rc, line=line, file=file)

call shr_abort_backtrace()

Expand Down Expand Up @@ -120,41 +116,7 @@ end subroutine xl_trbk

#endif

flush(error_unit)

end subroutine shr_abort_backtrace
!===============================================================================

!===============================================================================
subroutine print_error_to_logs(error_type, message)
! This routine prints error messages to s_logunit (which is standard output
! for most tasks in CESM) and also to standard error if s_logunit is a
! file.
!
! It also flushes these output units.

character(len=*), intent(in) :: error_type, message

integer, allocatable :: log_units(:)

integer :: i

if (s_logunit == output_unit .or. s_logunit == error_unit) then
! If the log unit number is standard output or standard error, just
! print to that.
allocate(log_units(1), source=[s_logunit])
else
! Otherwise print the same message to both the log unit and standard
! error.
allocate(log_units(2), source=[error_unit, s_logunit])
end if

do i = 1, size(log_units)
write(log_units(i),*) trim(error_type), ": ", trim(message)
flush(log_units(i))
end do

end subroutine print_error_to_logs
!===============================================================================

end module shr_abort_mod
64 changes: 54 additions & 10 deletions share/shr_log_mod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,7 @@ module shr_log_mod
use shr_kind_mod, only: shr_kind_in, shr_kind_cx
use shr_strconvert_mod, only: toString

use, intrinsic :: iso_fortran_env, only: output_unit
use, intrinsic :: iso_fortran_env, only: output_unit, error_unit

implicit none
private
Expand All @@ -31,6 +31,7 @@ module shr_log_mod
public :: shr_log_OOBMsg
public :: shr_log_setLogUnit
public :: shr_log_getLogUnit
public :: shr_log_error

! !PUBLIC DATA MEMBERS:

Expand Down Expand Up @@ -74,33 +75,33 @@ pure function shr_log_errMsg(file, line)
character(len=SHR_KIND_CX) :: shr_log_errMsg
character(len=*), intent(in) :: file
integer , intent(in) :: line

!EOP

shr_log_errMsg = 'ERROR in '//trim(file)//' at line '//toString(line)

end function shr_log_errMsg

! Create a message for an out of bounds error.
pure function shr_log_OOBMsg(operation, bounds, idx) result(OOBMsg)

! A name for the operation being attempted when the bounds error
! occurred. A string containing the subroutine name is ideal, but more
! generic descriptions such as "read", "modify", or "insert" could be used.
character(len=*), intent(in) :: operation

! Upper and lower bounds allowed for the operation.
integer, intent(in) :: bounds(2)

! Index at which access was attempted.
integer, intent(in) :: idx

! Output message
character(len=:), allocatable :: OOBMsg

allocate(OOBMsg, source=(operation//": "//toString(idx)//" not in range ["//&
toString(bounds(1))//", "//toString(bounds(2))//"]."))

end function shr_log_OOBMsg

subroutine shr_log_setLogUnit(unit)
Expand All @@ -117,4 +118,47 @@ subroutine shr_log_getLogUnit(unit)

end subroutine shr_log_getLogUnit

subroutine shr_log_error(string, rc, line, file)
use esmf, only : ESMF_LOGWRITE, ESMF_LOGMSG_ERROR, ESMF_FINALIZE, ESMF_END_ABORT, ESMF_FAILURE, ESMF_SUCCESS
! Consistent stopping mechanism

!----- arguments -----
character(len=*) , intent(in) :: string ! error message string
integer(shr_kind_in), intent(inout), optional :: rc ! error code
integer(shr_kind_in), intent(in), optional :: line
character(len=*), intent(in), optional :: file

! Local version of the string.
! (Gets a default value if string is not present.)
character(len=shr_kind_cx) :: local_string
integer, allocatable :: log_units(:)
integer :: i
!-------------------------------------------------------------------------------

local_string = trim(string)
if(present(rc)) then
if (rc /= ESMF_SUCCESS) then
write(local_string, *) trim(local_string), ' rc=',rc
endif
rc = ESMF_FAILURE
endif

call ESMF_LogWrite(local_string, ESMF_LOGMSG_ERROR, line=line, file=file)
if (shr_log_unit == output_unit .or. shr_log_unit == error_unit) then
! If the log unit number is standard output or standard error, just
! print to that.
allocate(log_units(1), source=[shr_log_unit])
else
! Otherwise print the same message to both the log unit and standard
! error.
allocate(log_units(2), source=[error_unit, shr_log_unit])
end if

do i = 1, size(log_units)
write(log_units(i),*) trim(local_string)
flush(log_units(i))
end do

end subroutine shr_log_error

end module shr_log_mod

0 comments on commit 3cd9f5b

Please sign in to comment.