MODFLOW 6  version 6.9.0.dev0
USGS Modular Hydrologic Model
messagemodule Module Reference

Store and issue logging messages to output units.

Data Types

type  messagestype
 Container for related messages. More...
 

Functions/Subroutines

subroutine init (this)
 Initialize message storage. More...
 
integer(i4b) function count (this)
 Return the number of messages currently stored. More...
 
subroutine set_max (this, imax)
 Set the maximum number of messages. More...
 
subroutine store (this, msg, substring)
 Add a message to storage. More...
 
subroutine write_all (this, title, kind, iunit)
 Write all stored messages to standard output. More...
 
subroutine deallocate (this)
 @ brief Deallocate message storage. More...
 
subroutine, public write_message (text, iunit, fmt, skipbefore, skipafter, advance)
 Write a message to an output unit. More...
 
subroutine, public write_message_counter (text, iunit, icount, iwidth, skipbefore, skipafter)
 Write a message with configurable indentation and numbering. More...
 
subroutine, public write_message_centered (text, linelen, iunit)
 Write horizontally centered text, left-padding as needed. More...
 

Function/Subroutine Documentation

◆ count()

integer(i4b) function messagemodule::count ( class(messagestype)  this)
Parameters
thisMessageType object

Definition at line 49 of file Message.f90.

50  class(MessagesType) :: this !< MessageType object
51  integer(I4B) :: nmessage
52 
53  if (allocated(this%messages)) then
54  nmessage = this%num_messages
55  else
56  nmessage = 0
57  end if

◆ deallocate()

subroutine messagemodule::deallocate ( class(messagestype)  this)

Definition at line 198 of file Message.f90.

199  class(MessagesType) :: this
200  if (allocated(this%messages)) deallocate (this%messages)
201  this%num_messages = 0
202  this%max_exceeded = 0

◆ init()

subroutine messagemodule::init ( class(messagestype)  this)
Parameters
thisMessageType object

Definition at line 39 of file Message.f90.

40  class(MessagesType) :: this !< MessageType object
41 
42  this%num_messages = 0
43  this%max_messages = 1000
44  this%max_exceeded = 0
45  this%exp_messages = 100

◆ set_max()

subroutine messagemodule::set_max ( class(messagestype)  this,
integer(i4b), intent(in)  imax 
)
Parameters
thisMessageType object
[in]imaxmaximum number of messages that will be stored

Definition at line 61 of file Message.f90.

62  class(MessagesType) :: this !< MessageType object
63  integer(I4B), intent(in) :: imax !< maximum number of messages that will be stored
64 
65  this%max_messages = imax

◆ store()

subroutine messagemodule::store ( class(messagestype)  this,
character(len=*), intent(in)  msg,
character(len=*), intent(in), optional  substring 
)

An optional string may be provided to filter out duplicate messages. If any stored messages contain the string the message is not stored.

Parameters
thisMessageType object
[in]msgmessage
[in]substringduplicate pattern

Definition at line 73 of file Message.f90.

74  ! -- dummy variables
75  class(MessagesType) :: this !< MessageType object
76  character(len=*), intent(in) :: msg !< message
77  character(len=*), intent(in), optional :: substring !< duplicate pattern
78  ! -- local variables
79  logical(LGP) :: inc_array
80  integer(I4B) :: i, n
81 
82  ! -- resize message array if needed
83  inc_array = .true.
84  if (allocated(this%messages)) then
85  if (this%num_messages < size(this%messages)) then
86  inc_array = .false.
87  end if
88  end if
89  if (inc_array) then
90  call expandarray(this%messages, increment=this%exp_messages)
91  this%exp_messages = int(this%exp_messages * 1.1)
92  end if
93 
94  ! -- don't store duplicate messages
95  if (present(substring)) then
96  do i = 1, this%num_messages
97  if (index(this%messages(i), substring) > 0) return
98  end do
99  end if
100 
101  ! -- store message and update count unless
102  ! at capacity, then update excess count
103  n = this%num_messages + 1
104  if (n <= this%max_messages) then
105  this%num_messages = n
106  this%messages(n) = msg
107  else
108  this%max_exceeded = this%max_exceeded + 1
109  end if

◆ write_all()

subroutine messagemodule::write_all ( class(messagestype)  this,
character(len=*), intent(in), optional  title,
character(len=*), intent(in), optional  kind,
integer(i4b), intent(in), optional  iunit 
)

An optional title to precede the messages may be provided. The title is printed on a separate line. An arbitrary kind may be specified, e.g. 'note', 'warning' or 'error. A file unit can also be specified to write in addition to stdout.

Parameters
thisMessageType object
[in]titlemessage title
[in]kindmessage kind
[in]iunitfile unit

Definition at line 119 of file Message.f90.

120  ! -- dummy variables
121  class(MessagesType) :: this !< MessageType object
122  character(len=*), intent(in), optional :: title !< message title
123  character(len=*), intent(in), optional :: kind !< message kind
124  integer(I4B), intent(in), optional :: iunit !< file unit
125  ! -- local
126  character(len=LINELENGTH) :: ltitle
127  character(len=LINELENGTH) :: lkind
128  character(len=LINELENGTH) :: errmsg
129  character(len=LINELENGTH) :: cerr
130  integer(I4B) :: iu
131  integer(I4B) :: i
132  integer(I4B) :: isize
133  integer(I4B) :: iwidth
134  ! -- formats
135  character(len=*), parameter :: stdfmt = "(/,A,/)"
136 
137  ! -- process optional variables
138  if (present(title)) then
139  ltitle = title
140  else
141  ltitle = ''
142  end if
143  if (present(kind)) then
144  lkind = kind
145  else
146  lkind = ''
147  end if
148  if (present(iunit)) then
149  iu = iunit
150  else
151  iu = 0
152  end if
153 
154  ! -- write messages, if any
155  if (allocated(this%messages)) then
156  isize = this%num_messages
157  if (isize > 0) then
158  ! -- calculate the maximum width of the prepended string
159  ! for the counter
160  write (cerr, '(i0)') isize
161  iwidth = len_trim(cerr) + 1
162 
163  ! -- write title for message
164  if (trim(ltitle) /= '') then
165  if (iu > 0) &
166  call write_message(iunit=iu, text=ltitle, fmt=stdfmt)
167  call write_message(text=ltitle, fmt=stdfmt)
168  end if
169 
170  ! -- write each message
171  do i = 1, isize
172  if (iu > 0) &
173  call write_message_counter( &
174  iunit=iu, &
175  text=this%messages(i), &
176  icount=i, &
177  iwidth=iwidth)
178  call write_message_counter( &
179  text=this%messages(i), &
180  icount=i, &
181  iwidth=iwidth)
182  end do
183 
184  ! -- write the number of additional messages
185  if (this%max_exceeded > 0) then
186  write (errmsg, '(i0,3(1x,a))') &
187  this%max_exceeded, 'additional', trim(kind), &
188  'detected but not printed.'
189  if (iu > 0) &
190  call write_message(iunit=iu, text=trim(errmsg), fmt='(/,1x,a)')
191  call write_message(text=trim(errmsg), fmt='(/,1x,a)')
192  end if
193  end if
194  end if
Here is the call graph for this function:

◆ write_message()

subroutine, public messagemodule::write_message ( character(len=*), intent(in)  text,
integer(i4b), intent(in), optional  iunit,
character(len=*), intent(in), optional  fmt,
integer(i4b), intent(in), optional  skipbefore,
integer(i4b), intent(in), optional  skipafter,
logical(lgp), intent(in), optional  advance 
)

Use advance to toggle advancing output. Use skipbefore/after to configure the number of whitespace lines before/after the message.

Parameters
[in]textmessage to write
[in]iunitoutput unit to write the message to
[in]fmtformat to write the message (default='(a)')
[in]skipbeforenumber of empty lines before message (default=0)
[in]skipafternumber of empty lines after message (default=0)
[in]advancewhether to use advancing output (default is .true.)

Definition at line 210 of file Message.f90.

212  ! -- dummy
213  character(len=*), intent(in) :: text !< message to write
214  integer(I4B), intent(in), optional :: iunit !< output unit to write the message to
215  character(len=*), intent(in), optional :: fmt !< format to write the message (default='(a)')
216  integer(I4B), intent(in), optional :: skipbefore !< number of empty lines before message (default=0)
217  integer(I4B), intent(in), optional :: skipafter !< number of empty lines after message (default=0)
218  logical(LGP), intent(in), optional :: advance !< whether to use advancing output (default is .true.)
219  ! -- local
220  character(len=3) :: cadvance
221  integer(I4B) :: i
222  integer(I4B) :: ilen
223  integer(I4B) :: iu
224  character(len=LENHUGELINE) :: simfmt
225  character(len=*), parameter :: stdfmt = '(a)'
226  character(len=*), parameter :: emptyfmt = '()'
227 
228  if (present(iunit)) then
229  iu = iunit
230  else
231  iu = istdout
232  end if
233 
234  ! -- get message length
235  ilen = len_trim(text)
236 
237  ! -- process optional arguments
238  if (present(fmt)) then
239  simfmt = fmt
240  else
241  if (ilen > 0) then
242  simfmt = stdfmt
243  else
244  simfmt = emptyfmt
245  end if
246  end if
247  if (present(advance)) then
248  if (advance) then
249  cadvance = 'YES'
250  else
251  cadvance = 'NO'
252  end if
253  else
254  cadvance = 'YES'
255  end if
256 
257  ! -- write empty line before message, if enabled
258  if (present(skipbefore)) then
259  do i = 1, skipbefore
260  write (iu, *)
261  end do
262  end if
263 
264  ! -- write message if it isn't empty
265  if (ilen > 0) then
266  write (iu, trim(simfmt), advance=cadvance) text(1:ilen)
267  else
268  write (iu, trim(simfmt), advance=cadvance)
269  end if
270 
271  ! -- write empty line after message, if enabled
272  if (present(skipafter)) then
273  do i = 1, skipafter
274  write (iu, *)
275  end do
276  end if
Here is the caller graph for this function:

◆ write_message_centered()

subroutine, public messagemodule::write_message_centered ( character(len=*), intent(in)  text,
integer(i4b), intent(in)  linelen,
integer(i4b), intent(in), optional  iunit 
)
Parameters
[in]textmessage to write to iunit
[in]linelenlength of line to center text in
[in]iunitoutput unit to write text

Definition at line 427 of file Message.f90.

428  ! -- dummy
429  character(len=*), intent(in) :: text !< message to write to iunit
430  integer(I4B), intent(in) :: linelen !< length of line to center text in
431  integer(I4B), intent(in), optional :: iunit !< output unit to write text
432  ! -- local
433  character(len=linelen) :: line
434  character(len=linelen) :: blank
435  integer(I4B) :: iu
436  integer(I4B) :: len_message
437  integer(I4B) :: jend
438  integer(I4B) :: ipad
439  integer(I4B) :: i
440  integer(I4B) :: j
441 
442  if (present(iunit)) then
443  iu = iunit
444  else
445  iu = istdout
446  end if
447 
448  ! -- initialize local variables
449  blank = ''
450  len_message = len_trim(adjustl(text))
451  j = 0
452 
453  ! -- parse the amessage into multiple lines
454  outer: do while (.true.)
455  jend = j + linelen
456 
457  ! last line
458  if (jend >= len_message) then
459  jend = len_message
460  line = text(j + 1:jend)
461  ipad = ((linelen - len_trim(line)) / 2)
462  call write_message(text=blank(1:ipad)//line, iunit=iunit)
463  exit outer
464  end if
465 
466  do i = jend, j + 1, -1
467  if (text(i:i) .eq. ' ') then
468  line = text(j + 1:i)
469  ipad = ((linelen - len_trim(line)) / 2)
470  call write_message(text=blank(1:ipad)//line, iunit=iunit)
471  j = i
472  cycle outer
473  end if
474  end do
475 
476  line = text(j + 1:jend)
477  ipad = ((linelen - len_trim(line)) / 2)
478  call write_message(text=blank(1:ipad)//line, iunit=iunit)
479  j = jend
480  end do outer
Here is the call graph for this function:
Here is the caller graph for this function:

◆ write_message_counter()

subroutine, public messagemodule::write_message_counter ( character(len=*), intent(in)  text,
integer(i4b), intent(in), optional  iunit,
integer(i4b), intent(in), optional  icount,
integer(i4b), intent(in), optional  iwidth,
integer(i4b), intent(in), optional  skipbefore,
integer(i4b), intent(in), optional  skipafter 
)

The message may exceed 78 characters in length. Messages longer than 78 characters are written across multiple lines. After icount lines, subsequent lines are indented and numbered. Use skipbefore/after to configure the number of empty lines before/after the message.

Parameters
[in]textmessage to be written
[in]iunitthe unit number to which the message is written
[in]icountcounter to prepended to the message
[in]iwidthmaximum width of the prepended counter
[in]skipbeforeoptional number of empty lines before message (default=0)
[in]skipafteroptional number of empty lines after message (default=0)

Definition at line 286 of file Message.f90.

288  ! -- dummy
289  character(len=*), intent(in) :: text !< message to be written
290  integer(I4B), intent(in), optional :: iunit !< the unit number to which the message is written
291  integer(I4B), intent(in), optional :: icount !< counter to prepended to the message
292  integer(I4B), intent(in), optional :: iwidth !< maximum width of the prepended counter
293  integer(I4B), intent(in), optional :: skipbefore !< optional number of empty lines before message (default=0)
294  integer(I4B), intent(in), optional :: skipafter !< optional number of empty lines after message (default=0)
295  ! -- local
296  integer(I4B), parameter :: len_line = 78
297  character(len=LENHUGELINE) :: amessage
298  character(len=len_line) :: line
299  character(len=16) :: cfmt
300  character(len=10) :: counter
301  character(len=5) :: fmt_first
302  character(len=20) :: fmt_cont
303  logical(LGP) :: include_counter
304  integer(I4B) :: isb
305  integer(I4B) :: isa
306  integer(I4B) :: jend
307  integer(I4B) :: len_str1
308  integer(I4B) :: len_str2
309  integer(I4B) :: len_message
310  integer(I4B) :: i
311  integer(I4B) :: j
312  integer(I4B) :: iu
313 
314  if (present(iunit)) then
315  iu = iunit
316  else
317  iu = istdout
318  end if
319 
320  ! -- abort if message is empty
321  if (len_trim(text) < 1) return
322 
323  ! -- initialize local variables
324  amessage = text
325  counter = ''
326  fmt_first = '(A)'
327  fmt_cont = '(A)'
328  len_str1 = 0
329  len_str2 = len_line
330  include_counter = .false.
331  j = 0
332 
333  ! -- process optional arguments
334  if (present(skipbefore)) then
335  isb = skipbefore
336  else
337  isb = 0
338  end if
339  if (present(skipafter)) then
340  isa = skipafter
341  else
342  isa = 0
343  end if
344 
345  ! -- create the counter to prepend to the start of the message,
346  ! formats, and variables used to create strings
347  if (present(iwidth) .and. present(icount)) then
348  include_counter = .true.
349 
350  ! -- write counter
351  write (cfmt, '(A,I0,A)') '(1x,i', iwidth, ',".",1x)'
352  write (counter, cfmt) icount
353 
354  ! -- calculate the length of the first and second string on a line
355  len_str1 = len(trim(counter)) + 1
356  len_str2 = len_line - len_str1
357 
358  ! -- write format for the continuation lines
359  write (fmt_cont, '(a,i0,a)') &
360  '(', len(trim(counter)) + 1, 'x,a)'
361  end if
362 
363  ! -- calculate the length of the message
364  len_message = len_trim(amessage)
365 
366  ! -- parse the message into multiple lines
367 5 continue
368  jend = j + len_str2
369  if (jend >= len_message) go to 100
370  do i = jend, j + 1, -1
371  if (amessage(i:i) .eq. ' ') then
372  if (j == 0) then
373  if (include_counter) then
374  line = counter(1:len_str1)//amessage(j + 1:i)
375  else
376  line = amessage(j + 1:i)
377  end if
378  call write_message(text=line, iunit=iu, &
379  fmt=fmt_first, &
380  skipbefore=isb)
381  else
382  line = adjustl(amessage(j + 1:i))
383  call write_message(text=line, iunit=iu, &
384  fmt=fmt_cont)
385  end if
386  j = i
387  go to 5
388  end if
389  end do
390  if (j == 0) then
391  if (include_counter) then
392  line = counter(1:len_str1)//amessage(j + 1:jend)
393  else
394  line = amessage(j + 1:jend)
395  end if
396  call write_message(text=line, iunit=iu, &
397  fmt=fmt_first, &
398  skipbefore=isb)
399  else
400  line = amessage(j + 1:jend)
401  call write_message(text=line, iunit=iu, &
402  fmt=fmt_cont)
403  end if
404  j = jend
405  go to 5
406 
407  ! -- last piece of amessage to write to a line
408 100 continue
409  jend = len_message
410  if (j == 0) then
411  if (include_counter) then
412  line = counter(1:len_str1)//amessage(j + 1:jend)
413  else
414  line = amessage(j + 1:jend)
415  end if
416  call write_message(text=line, iunit=iu, &
417  fmt=fmt_first, &
418  skipbefore=isb, skipafter=isa)
419  else
420  line = amessage(j + 1:jend)
421  call write_message(text=line, iunit=iu, fmt=fmt_cont, &
422  skipafter=isa)
423  end if
Here is the call graph for this function:
Here is the caller graph for this function: