@@ -16,7 +16,7 @@ module shr_log_mod
16
16
use shr_kind_mod, only: shr_kind_in, shr_kind_cx
17
17
use shr_strconvert_mod, only: toString
18
18
19
- use , intrinsic :: iso_fortran_env, only: output_unit
19
+ use , intrinsic :: iso_fortran_env, only: output_unit, error_unit
20
20
21
21
implicit none
22
22
private
@@ -31,6 +31,7 @@ module shr_log_mod
31
31
public :: shr_log_OOBMsg
32
32
public :: shr_log_setLogUnit
33
33
public :: shr_log_getLogUnit
34
+ public :: shr_log_error
34
35
35
36
! !PUBLIC DATA MEMBERS:
36
37
@@ -74,33 +75,33 @@ pure function shr_log_errMsg(file, line)
74
75
character (len= SHR_KIND_CX) :: shr_log_errMsg
75
76
character (len=* ), intent (in ) :: file
76
77
integer , intent (in ) :: line
77
-
78
+
78
79
! EOP
79
-
80
+
80
81
shr_log_errMsg = ' ERROR in ' // trim (file)// ' at line ' // toString(line)
81
-
82
+
82
83
end function shr_log_errMsg
83
-
84
+
84
85
! Create a message for an out of bounds error.
85
86
pure function shr_log_OOBMsg (operation , bounds , idx ) result(OOBMsg)
86
87
87
88
! A name for the operation being attempted when the bounds error
88
89
! occurred. A string containing the subroutine name is ideal, but more
89
90
! generic descriptions such as "read", "modify", or "insert" could be used.
90
91
character (len=* ), intent (in ) :: operation
91
-
92
+
92
93
! Upper and lower bounds allowed for the operation.
93
94
integer , intent (in ) :: bounds(2 )
94
-
95
+
95
96
! Index at which access was attempted.
96
97
integer , intent (in ) :: idx
97
-
98
+
98
99
! Output message
99
100
character (len= :), allocatable :: OOBMsg
100
-
101
+
101
102
allocate (OOBMsg, source= (operation// " : " // toString(idx)// " not in range [" // &
102
103
toString(bounds(1 ))// " , " // toString(bounds(2 ))// " ]." ))
103
-
104
+
104
105
end function shr_log_OOBMsg
105
106
106
107
subroutine shr_log_setLogUnit (unit )
@@ -117,4 +118,47 @@ subroutine shr_log_getLogUnit(unit)
117
118
118
119
end subroutine shr_log_getLogUnit
119
120
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
+
120
164
end module shr_log_mod
0 commit comments