Line data Source code
1 :
2 : module icepack_warnings
3 :
4 : use icepack_kinds
5 :
6 : implicit none
7 :
8 : private
9 :
10 : ! warning messages
11 : character(len=char_len_long), dimension(:), allocatable :: warnings
12 : integer :: nWarnings = 0
13 : integer, parameter :: nWarningsBuffer = 10 ! incremental number of messages
14 :
15 : ! abort flag, accessed via icepack_warnings_setabort and icepack_warnings_aborted
16 : logical :: warning_abort = .false.
17 :
18 : ! public string for all subroutines to use
19 : character(len=char_len_long), public :: warnstr
20 :
21 : public :: &
22 : icepack_warnings_clear, & ! LCOV_EXCL_LINE
23 : icepack_warnings_print, & ! LCOV_EXCL_LINE
24 : icepack_warnings_flush, & ! LCOV_EXCL_LINE
25 : icepack_warnings_aborted, & ! LCOV_EXCL_LINE
26 : icepack_warnings_add, & ! LCOV_EXCL_LINE
27 : icepack_warnings_setabort, & ! LCOV_EXCL_LINE
28 : icepack_warnings_getall
29 :
30 : private :: &
31 : icepack_warnings_getone
32 :
33 : !=======================================================================
34 :
35 : contains
36 :
37 : !=======================================================================
38 : !autodocument_start icepack_warnings_aborted
39 : ! turn on the abort flag in the icepack warnings package
40 : ! pass in an optional error message
41 :
42 2826875538 : logical function icepack_warnings_aborted(instring)
43 :
44 : character(len=*),intent(in), optional :: instring
45 :
46 : !autodocument_end
47 :
48 : character(len=*),parameter :: subname='(icepack_warnings_aborted)'
49 :
50 2826875538 : icepack_warnings_aborted = warning_abort
51 2826875538 : if (warning_abort .and. present(instring)) then
52 0 : call icepack_warnings_add(subname//' ... '//trim(instring))
53 : endif
54 :
55 2826875538 : end function icepack_warnings_aborted
56 :
57 : !=======================================================================
58 :
59 37 : subroutine icepack_warnings_setabort(abortflag,file,line)
60 :
61 : logical, intent(in) :: abortflag
62 : character(len=*), intent(in), optional :: file
63 : integer, intent(in), optional :: line
64 :
65 : character(len=*),parameter :: subname='(icepack_warnings_setabort)'
66 :
67 : ! try to capture just the first setabort call
68 :
69 37 : if (abortflag) then
70 0 : write(warnstr,*) subname,abortflag
71 0 : if (present(file)) write(warnstr,*) trim(warnstr)//' :file '//trim(file)
72 0 : if (present(line)) write(warnstr,*) trim(warnstr)//' :line ',line
73 0 : call icepack_warnings_add(warnstr)
74 : endif
75 :
76 37 : warning_abort = abortflag
77 :
78 37 : end subroutine icepack_warnings_setabort
79 :
80 : !=======================================================================
81 : !autodocument_start icepack_warnings_clear
82 : ! clear all warning messages from the icepack warning buffer
83 :
84 9570680 : subroutine icepack_warnings_clear()
85 :
86 : !autodocument_end
87 :
88 : character(len=*),parameter :: subname='(icepack_warnings_clear)'
89 :
90 9570680 : nWarnings = 0
91 :
92 9570680 : end subroutine icepack_warnings_clear
93 :
94 : !=======================================================================
95 : !autodocument_start icepack_warnings_clear
96 : ! return an array of all the current warning messages
97 :
98 0 : subroutine icepack_warnings_getall(warningsOut)
99 :
100 : character(len=char_len_long), dimension(:), allocatable, intent(out) :: &
101 : warningsOut
102 :
103 : !autodocument_end
104 :
105 : integer :: iWarning
106 : character(len=*),parameter :: subname='(icepack_warnings_getall)'
107 :
108 0 : if (allocated(warningsOut)) deallocate(warningsOut)
109 0 : allocate(warningsOut(nWarnings))
110 :
111 0 : do iWarning = 1, nWarnings
112 0 : warningsOut(iWarning) = trim(icepack_warnings_getone(iWarning))
113 : enddo
114 :
115 0 : end subroutine icepack_warnings_getall
116 :
117 : !=======================================================================
118 : !autodocument_start icepack_warnings_print
119 : ! print all warning messages from the icepack warning buffer
120 :
121 7 : subroutine icepack_warnings_print(iounit)
122 :
123 : integer, intent(in) :: iounit
124 :
125 : !autodocument_end
126 :
127 : integer :: iWarning
128 : character(len=*),parameter :: subname='(icepack_warnings_print)'
129 :
130 : ! tcraig
131 : ! this code intermittenly aborts on recursive IO errors with intel
132 : ! not sure if it's OMP or something else causing this
133 4 : !$OMP MASTER
134 70 : do iWarning = 1, nWarnings
135 70 : write(iounit,*) trim(icepack_warnings_getone(iWarning))
136 : enddo
137 : !$OMP END MASTER
138 :
139 7 : end subroutine icepack_warnings_print
140 :
141 : !=======================================================================
142 : !autodocument_start icepack_warnings_flush
143 : ! print and clear all warning messages from the icepack warning buffer
144 :
145 9570680 : subroutine icepack_warnings_flush(iounit)
146 :
147 : integer, intent(in) :: iounit
148 :
149 : !autodocument_end
150 :
151 : character(len=*),parameter :: subname='(icepack_warnings_flush)'
152 :
153 9570680 : if (nWarnings > 0) then
154 7 : call icepack_warnings_print(iounit)
155 : endif
156 9570680 : call icepack_warnings_clear()
157 :
158 9570680 : end subroutine icepack_warnings_flush
159 :
160 : !=======================================================================
161 :
162 63 : subroutine icepack_warnings_add(warning)
163 :
164 : character(len=*), intent(in) :: warning ! warning to add to array of warnings
165 :
166 : ! local
167 :
168 63 : character(len=char_len_long), dimension(:), allocatable :: warningsTmp
169 : integer :: &
170 : nWarningsArray, & ! size of warnings array at start ! LCOV_EXCL_LINE
171 : iWarning ! warning index
172 : character(len=*),parameter :: subname='(icepack_warnings_add)'
173 :
174 72 : !$OMP CRITICAL (omp_warnings_add)
175 : ! check if warnings array is not allocated
176 63 : if (.not. allocated(warnings)) then
177 :
178 : ! allocate warning array with number of buffer elements
179 7 : allocate(warnings(nWarningsBuffer))
180 :
181 : ! set initial number of nWarnings
182 7 : nWarnings = 0
183 :
184 : ! already allocated
185 : else
186 :
187 : ! find the size of the warnings array at the start
188 56 : nWarningsArray = size(warnings)
189 :
190 : ! check to see if need more space in warnings array
191 56 : if (nWarnings + 1 > nWarningsArray) then
192 :
193 : ! allocate the temporary warning storage
194 0 : allocate(warningsTmp(nWarningsArray))
195 :
196 : ! copy the warnings to temporary storage
197 0 : do iWarning = 1, nWarningsArray
198 0 : warningsTmp(iWarning) = trim(warnings(iWarning))
199 : enddo ! iWarning
200 :
201 : ! increase the size of the warning array by the buffer size
202 0 : deallocate(warnings)
203 0 : allocate(warnings(nWarningsArray + nWarningsBuffer))
204 :
205 : ! copy back the temporary stored warnings
206 0 : do iWarning = 1, nWarningsArray
207 0 : warnings(iWarning) = trim(warningsTmp(iWarning))
208 : enddo ! iWarning
209 :
210 : ! deallocate the temporary storage
211 0 : deallocate(warningsTmp)
212 :
213 : endif
214 :
215 : endif
216 :
217 : ! increase warning number
218 63 : nWarnings = nWarnings + 1
219 : !$OMP END CRITICAL (omp_warnings_add)
220 :
221 : ! add the new warning
222 63 : warnings(nWarnings) = trim(warning)
223 :
224 126 : end subroutine icepack_warnings_add
225 :
226 : !=======================================================================
227 :
228 63 : function icepack_warnings_getone(iWarning) result(warning)
229 :
230 : integer, intent(in) :: iWarning
231 :
232 : character(len=char_len_long) :: warning
233 :
234 : character(len=*),parameter :: subname='(icepack_warnings_getone)'
235 :
236 63 : if (iWarning <= nWarnings) then
237 63 : warning = warnings(iWarning)
238 : else
239 0 : warning = ""
240 : endif
241 :
242 63 : end function icepack_warnings_getone
243 :
244 : !=======================================================================
245 :
246 : end module icepack_warnings
|
