Line data Source code
1 :
2 : module icepack_warnings
3 :
4 : ! Provides a logging and abort package for Icepack.
5 : ! Icepack has no idea about MPI, OpenMP, or IO.
6 : ! Store error message and provide methods for the driver
7 : ! to write these messages to a Fortran unit number.
8 : ! Needs to be thread safe. This could be called within
9 : ! a threaded or non-threaded region or both. Need to make
10 : ! sure multiple threads are not adding to the warnings
11 : ! buffer at the same time. Also need to make sure warnings
12 : ! buffers are not added at the same time messages are
13 : ! cleared by a different thread. Use multiple critical
14 : ! regions using the same ID to allow threads to block
15 : ! each other during multiple operations.
16 :
17 : use icepack_kinds
18 : implicit none
19 :
20 : private
21 :
22 : ! warning messages
23 : character(len=char_len_long), dimension(:), allocatable :: warnings
24 : integer :: nWarnings = 0
25 : integer :: nWarningsBuffer = 10 ! incremental number of messages
26 :
27 : ! abort flag, accessed via icepack_warnings_setabort and icepack_warnings_aborted
28 : logical :: warning_abort = .false.
29 :
30 : ! public string for all subroutines to use
31 : character(len=char_len_long), public :: warnstr
32 :
33 : public :: &
34 : icepack_warnings_clear, &
35 : icepack_warnings_print, &
36 : icepack_warnings_flush, &
37 : icepack_warnings_aborted, &
38 : icepack_warnings_add, &
39 : icepack_warnings_setabort, &
40 : icepack_warnings_getall
41 :
42 : private :: &
43 : icepack_warnings_getone
44 :
45 : ! variables are shared by default
46 : ! have warnstr be private
47 : !$OMP THREADPRIVATE(warnstr)
48 :
49 : !=======================================================================
50 :
51 : contains
52 :
53 : !=======================================================================
54 : !autodocument_start icepack_warnings_aborted
55 : ! turn on the abort flag in the icepack warnings package
56 : ! pass in an optional error message
57 :
58 955042483 : logical function icepack_warnings_aborted(instring)
59 :
60 : character(len=*),intent(in), optional :: instring
61 :
62 : !autodocument_end
63 :
64 : character(len=*),parameter :: subname='(icepack_warnings_aborted)'
65 :
66 955042483 : icepack_warnings_aborted = warning_abort
67 955042483 : if (warning_abort .and. present(instring)) then
68 0 : call icepack_warnings_add(subname//' ... '//trim(instring))
69 : endif
70 :
71 955042483 : end function icepack_warnings_aborted
72 :
73 : !=======================================================================
74 :
75 83 : subroutine icepack_warnings_setabort(abortflag,file,line)
76 :
77 : logical, intent(in) :: abortflag
78 : character(len=*), intent(in), optional :: file
79 : integer, intent(in), optional :: line
80 :
81 : character(len=*),parameter :: subname='(icepack_warnings_setabort)'
82 :
83 : ! try to capture just the first setabort call
84 :
85 83 : if (abortflag) then
86 0 : write(warnstr,*) subname,abortflag
87 0 : call icepack_warnings_add(warnstr)
88 0 : if (present(file)) then
89 0 : write(warnstr,*) trim(warnstr)//' :file '//trim(file)
90 0 : call icepack_warnings_add(warnstr)
91 : endif
92 0 : if (present(line)) then
93 0 : write(warnstr,*) trim(warnstr)//' :line ',line
94 0 : call icepack_warnings_add(warnstr)
95 : endif
96 : endif
97 :
98 83 : warning_abort = abortflag
99 :
100 83 : end subroutine icepack_warnings_setabort
101 :
102 : !=======================================================================
103 : !autodocument_start icepack_warnings_clear
104 : ! clear all warning messages from the icepack warning buffer
105 :
106 26223304 : subroutine icepack_warnings_clear()
107 :
108 : !autodocument_end
109 :
110 : character(len=*),parameter :: subname='(icepack_warnings_clear)'
111 :
112 26223304 : nWarnings = 0
113 :
114 26223304 : end subroutine icepack_warnings_clear
115 :
116 : !=======================================================================
117 : !autodocument_start icepack_warnings_clear
118 : ! return an array of all the current warning messages
119 :
120 0 : subroutine icepack_warnings_getall(warningsOut)
121 :
122 : character(len=char_len_long), dimension(:), allocatable, intent(out) :: &
123 : warningsOut
124 :
125 : !autodocument_end
126 :
127 : integer :: iWarning
128 : character(len=*),parameter :: subname='(icepack_warnings_getall)'
129 :
130 0 : if (allocated(warningsOut)) deallocate(warningsOut)
131 0 : allocate(warningsOut(nWarnings))
132 :
133 0 : do iWarning = 1, nWarnings
134 0 : warningsOut(iWarning) = trim(icepack_warnings_getone(iWarning))
135 : enddo
136 :
137 0 : end subroutine icepack_warnings_getall
138 :
139 : !=======================================================================
140 : !autodocument_start icepack_warnings_print
141 : ! print all warning messages from the icepack warning buffer
142 :
143 18412 : subroutine icepack_warnings_print(iounit)
144 :
145 : integer, intent(in) :: iounit
146 :
147 : !autodocument_end
148 :
149 : integer :: iWarning
150 : character(len=*),parameter :: subname='(icepack_warnings_print)'
151 :
152 1708466 : do iWarning = 1, nWarnings
153 1708466 : write(iounit,*) trim(icepack_warnings_getone(iWarning))
154 : enddo
155 :
156 18412 : end subroutine icepack_warnings_print
157 :
158 : !=======================================================================
159 : !autodocument_start icepack_warnings_flush
160 : ! print and clear all warning messages from the icepack warning buffer
161 :
162 26223304 : subroutine icepack_warnings_flush(iounit)
163 :
164 : integer, intent(in) :: iounit
165 :
166 : !autodocument_end
167 :
168 : character(len=*),parameter :: subname='(icepack_warnings_flush)'
169 :
170 : !$OMP CRITICAL (omp_warnings)
171 26223304 : if (nWarnings > 0) then
172 18412 : call icepack_warnings_print(iounit)
173 : endif
174 26223304 : call icepack_warnings_clear()
175 : !$OMP END CRITICAL (omp_warnings)
176 :
177 26223304 : end subroutine icepack_warnings_flush
178 :
179 : !=======================================================================
180 :
181 1690054 : subroutine icepack_warnings_add(warning)
182 :
183 : character(len=*), intent(in) :: warning ! warning to add to array of warnings
184 :
185 : ! local
186 :
187 1690054 : character(len=char_len_long), dimension(:), allocatable :: warningsTmp
188 : integer :: &
189 : nWarningsArray, & ! size of warnings array at start
190 : iWarning ! warning index
191 : character(len=*),parameter :: subname='(icepack_warnings_add)'
192 :
193 : !$OMP CRITICAL (omp_warnings)
194 : ! check if warnings array is not allocated
195 1690054 : if (.not. allocated(warnings)) then
196 :
197 : ! allocate warning array with number of buffer elements
198 83 : allocate(warnings(nWarningsBuffer))
199 :
200 : ! set initial number of nWarnings
201 83 : nWarnings = 0
202 :
203 : else
204 :
205 : ! find the size of the warnings array at the start
206 1689971 : nWarningsArray = size(warnings)
207 :
208 : ! check to see if need more space in warnings array
209 1689971 : if (nWarnings + 1 > nWarningsArray) then
210 :
211 : ! allocate the temporary warning storage
212 32 : allocate(warningsTmp(nWarningsArray))
213 :
214 : ! copy the warnings to temporary storage
215 1762 : do iWarning = 1, nWarningsArray
216 1762 : warningsTmp(iWarning) = trim(warnings(iWarning))
217 : enddo ! iWarning
218 :
219 : ! increase the size of the warning array by the buffer size
220 32 : deallocate(warnings)
221 32 : allocate(warnings(nWarningsArray + nWarningsBuffer))
222 :
223 : ! copy back the temporary stored warnings
224 1762 : do iWarning = 1, nWarningsArray
225 1762 : warnings(iWarning) = trim(warningsTmp(iWarning))
226 : enddo ! iWarning
227 :
228 : ! deallocate the temporary storage
229 32 : deallocate(warningsTmp)
230 :
231 : ! increase nWarningsBuffer for next reallocation
232 32 : nWarningsBuffer = nWarningsBuffer * 2
233 : endif
234 :
235 : endif
236 :
237 : ! increase warning number
238 1690054 : nWarnings = nWarnings + 1
239 :
240 : ! add the new warning
241 1690054 : warnings(nWarnings) = trim(warning)
242 : !$OMP END CRITICAL (omp_warnings)
243 :
244 3380108 : end subroutine icepack_warnings_add
245 :
246 : !=======================================================================
247 :
248 1690054 : function icepack_warnings_getone(iWarning) result(warning)
249 :
250 : integer, intent(in) :: iWarning
251 :
252 : character(len=char_len_long) :: warning
253 :
254 : character(len=*),parameter :: subname='(icepack_warnings_getone)'
255 :
256 1690054 : if (iWarning <= nWarnings) then
257 1690054 : warning = warnings(iWarning)
258 : else
259 0 : warning = ""
260 : endif
261 :
262 1690054 : end function icepack_warnings_getone
263 :
264 : !=======================================================================
265 :
266 : end module icepack_warnings
|
