Skip to content

Commit 3cd9f5b

Browse files
committed
add the updated shr_log_mod and shr_abort_mod files
1 parent 4aa602b commit 3cd9f5b

File tree

2 files changed

+57
-51
lines changed

2 files changed

+57
-51
lines changed

share/shr_abort_mod.F90

Lines changed: 3 additions & 41 deletions
Original file line numberDiff line numberDiff line change
@@ -7,10 +7,7 @@ module shr_abort_mod
77
! (shr_sys_abort, shr_sys_backtrace). (This is for consistency with older code, from
88
! when these routines were defined in shr_sys_mod.)
99

10-
use, intrinsic :: iso_fortran_env, only: output_unit, error_unit
11-
1210
use shr_kind_mod, only : shr_kind_in, shr_kind_cx
13-
use shr_log_mod , only : s_logunit => shr_log_Unit
1411

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

4139
!----- arguments -----
4240
character(len=*) , intent(in), optional :: string ! error message string
43-
integer(shr_kind_in), intent(in), optional :: rc ! error code
41+
integer(shr_kind_in), intent(inout), optional :: rc ! error code
4442
integer(shr_kind_in), intent(in), optional :: line
4543
character(len=*), intent(in), optional :: file
4644

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

61-
call print_error_to_logs("ERROR", local_string)
62-
63-
call ESMF_LogWrite(local_string, ESMF_LOGMSG_ERROR, line=line, file=file)
59+
call shr_log_error(local_string, rc=rc, line=line, file=file)
6460

6561
call shr_abort_backtrace()
6662

@@ -120,41 +116,7 @@ end subroutine xl_trbk
120116

121117
#endif
122118

123-
flush(error_unit)
124-
125119
end subroutine shr_abort_backtrace
126120
!===============================================================================
127121

128-
!===============================================================================
129-
subroutine print_error_to_logs(error_type, message)
130-
! This routine prints error messages to s_logunit (which is standard output
131-
! for most tasks in CESM) and also to standard error if s_logunit is a
132-
! file.
133-
!
134-
! It also flushes these output units.
135-
136-
character(len=*), intent(in) :: error_type, message
137-
138-
integer, allocatable :: log_units(:)
139-
140-
integer :: i
141-
142-
if (s_logunit == output_unit .or. s_logunit == error_unit) then
143-
! If the log unit number is standard output or standard error, just
144-
! print to that.
145-
allocate(log_units(1), source=[s_logunit])
146-
else
147-
! Otherwise print the same message to both the log unit and standard
148-
! error.
149-
allocate(log_units(2), source=[error_unit, s_logunit])
150-
end if
151-
152-
do i = 1, size(log_units)
153-
write(log_units(i),*) trim(error_type), ": ", trim(message)
154-
flush(log_units(i))
155-
end do
156-
157-
end subroutine print_error_to_logs
158-
!===============================================================================
159-
160122
end module shr_abort_mod

share/shr_log_mod.F90

Lines changed: 54 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -16,7 +16,7 @@ module shr_log_mod
1616
use shr_kind_mod, only: shr_kind_in, shr_kind_cx
1717
use shr_strconvert_mod, only: toString
1818

19-
use, intrinsic :: iso_fortran_env, only: output_unit
19+
use, intrinsic :: iso_fortran_env, only: output_unit, error_unit
2020

2121
implicit none
2222
private
@@ -31,6 +31,7 @@ module shr_log_mod
3131
public :: shr_log_OOBMsg
3232
public :: shr_log_setLogUnit
3333
public :: shr_log_getLogUnit
34+
public :: shr_log_error
3435

3536
! !PUBLIC DATA MEMBERS:
3637

@@ -74,33 +75,33 @@ pure function shr_log_errMsg(file, line)
7475
character(len=SHR_KIND_CX) :: shr_log_errMsg
7576
character(len=*), intent(in) :: file
7677
integer , intent(in) :: line
77-
78+
7879
!EOP
79-
80+
8081
shr_log_errMsg = 'ERROR in '//trim(file)//' at line '//toString(line)
81-
82+
8283
end function shr_log_errMsg
83-
84+
8485
! Create a message for an out of bounds error.
8586
pure function shr_log_OOBMsg(operation, bounds, idx) result(OOBMsg)
8687

8788
! A name for the operation being attempted when the bounds error
8889
! occurred. A string containing the subroutine name is ideal, but more
8990
! generic descriptions such as "read", "modify", or "insert" could be used.
9091
character(len=*), intent(in) :: operation
91-
92+
9293
! Upper and lower bounds allowed for the operation.
9394
integer, intent(in) :: bounds(2)
94-
95+
9596
! Index at which access was attempted.
9697
integer, intent(in) :: idx
97-
98+
9899
! Output message
99100
character(len=:), allocatable :: OOBMsg
100-
101+
101102
allocate(OOBMsg, source=(operation//": "//toString(idx)//" not in range ["//&
102103
toString(bounds(1))//", "//toString(bounds(2))//"]."))
103-
104+
104105
end function shr_log_OOBMsg
105106

106107
subroutine shr_log_setLogUnit(unit)
@@ -117,4 +118,47 @@ subroutine shr_log_getLogUnit(unit)
117118

118119
end subroutine shr_log_getLogUnit
119120

121+
subroutine shr_log_error(string, rc, line, file)
122+
use esmf, only : ESMF_LOGWRITE, ESMF_LOGMSG_ERROR, ESMF_FINALIZE, ESMF_END_ABORT, ESMF_FAILURE, ESMF_SUCCESS
123+
! Consistent stopping mechanism
124+
125+
!----- arguments -----
126+
character(len=*) , intent(in) :: string ! error message string
127+
integer(shr_kind_in), intent(inout), optional :: rc ! error code
128+
integer(shr_kind_in), intent(in), optional :: line
129+
character(len=*), intent(in), optional :: file
130+
131+
! Local version of the string.
132+
! (Gets a default value if string is not present.)
133+
character(len=shr_kind_cx) :: local_string
134+
integer, allocatable :: log_units(:)
135+
integer :: i
136+
!-------------------------------------------------------------------------------
137+
138+
local_string = trim(string)
139+
if(present(rc)) then
140+
if (rc /= ESMF_SUCCESS) then
141+
write(local_string, *) trim(local_string), ' rc=',rc
142+
endif
143+
rc = ESMF_FAILURE
144+
endif
145+
146+
call ESMF_LogWrite(local_string, ESMF_LOGMSG_ERROR, line=line, file=file)
147+
if (shr_log_unit == output_unit .or. shr_log_unit == error_unit) then
148+
! If the log unit number is standard output or standard error, just
149+
! print to that.
150+
allocate(log_units(1), source=[shr_log_unit])
151+
else
152+
! Otherwise print the same message to both the log unit and standard
153+
! error.
154+
allocate(log_units(2), source=[error_unit, shr_log_unit])
155+
end if
156+
157+
do i = 1, size(log_units)
158+
write(log_units(i),*) trim(local_string)
159+
flush(log_units(i))
160+
end do
161+
162+
end subroutine shr_log_error
163+
120164
end module shr_log_mod

0 commit comments

Comments
 (0)