diff --git a/share/shr_abort_mod.F90 b/share/shr_abort_mod.F90 index 6e3a9068..b651db2a 100644 --- a/share/shr_abort_mod.F90 +++ b/share/shr_abort_mod.F90 @@ -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 @@ -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 @@ -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() @@ -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 diff --git a/share/shr_log_mod.F90 b/share/shr_log_mod.F90 index a7e4c70e..7676294a 100644 --- a/share/shr_log_mod.F90 +++ b/share/shr_log_mod.F90 @@ -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 @@ -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: @@ -74,13 +75,13 @@ 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) @@ -88,19 +89,19 @@ pure function shr_log_OOBMsg(operation, bounds, idx) result(OOBMsg) ! 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) @@ -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