1module message_mod
2 ! MODULE message_mod (prefix='msg' category='8. Low-level utilities and constants')
3 !
4 !:Purpose: Output message interface with configurable verbosity.
5 ! Also provides string representation for some intrinsic types.
6 !
7 use midasMpi_mod
8 use utilities_mod
9 implicit none
10 save
11 private
12
13 ! public procedures
14 public :: msg, msg_memUsage, msg_section, msg_setVerbThreshold
15
16 ! public module variables
17 integer, public, parameter :: msg_ALWAYS = -99 ! verbosity level indicating a message is always printed irrespectively of set threshold
18 integer, public, parameter :: msg_NEVER = 99 ! verbosity level indicating a message is never printed irrespectively of set threshold
19 integer, public, parameter :: msg_DEFAULT = 1 ! default verbosity level
20
21 integer, public :: msg_NML = msg_DEFAULT ! verbosity level fixed from namelist
22
23 ! intrinsic type string representations
24 public :: str
25 interface str
26 module procedure msg_str2str
27 module procedure msg_log2str
28 module procedure msg_int2str
29 module procedure msg_real42str
30 module procedure msg_real82str
31 module procedure msg_charArray2str
32 module procedure msg_logArray2str
33 module procedure msg_intArray2str
34 module procedure msg_real4Array2str
35 module procedure msg_real8Array2str
36 end interface
37
38 ! private module variables
39 integer, parameter :: msg_lineLen = 70
40 integer, parameter :: msg_num2strBufferLen = 200
41 integer, parameter :: msg_indent = 4
42
43 integer :: verbosityThreshold
44 logical :: msg_arrayVertical
45
46 contains
47
48 !--------------------------------------------------------------------------
49 ! msg
50 !--------------------------------------------------------------------------
51 subroutine msg(origin, message, verb_opt, mpiAll_opt, separator_opt)
52 !
53 !:Purpose: Output message if its verbosity level is less than or equal to
54 ! the user provided verbosity threshold (see `msg_readNml()`).
55 ! The verbosity levels are:
56 !
57 ! * msg_ALWAYS : always printed, irrespectively of the threshold
58 ! * 0 : critical, should always printed
59 ! * 1 : default priority; printed in operational context
60 ! * 2 : detailed output, provides extra information
61 ! * 3 : intended for developers, printed for debugging or specific diagnostcs
62 ! * msg_NEVER : never printed, irrespectively of the threshold
63 !
64 implicit none
65
66 ! Arguments:
67 character(len=*), intent(in) :: origin ! originating subroutine, function or program
68 character(len=*), intent(in) :: message ! message to be printed
69 integer, optional, intent(in) :: verb_opt ! maximum verbosity level of messages to be printed, defaults to 1
70 logical, optional, intent(in) :: mpiAll_opt ! choose to prints to all MPI tasks (default), otherwise only task 0
71 character(len=*), optional, intent(in) :: separator_opt ! separator string between origin and message
72
73 ! Locals:
74 logical :: mpiAll
75 integer :: verbLevel
76
77 if (present(verb_opt)) then
78 verbLevel = verb_opt
79 else
80 verbLevel = msg_DEFAULT
81 end if
82
83 if (present(mpiAll_opt)) then
84 mpiAll = mpiAll_opt
85 else
86 mpiAll = .true.
87 end if
88
89 if (verbLevel == msg_ALWAYS) then
90 if (mpiAll) then
91 call msg_write(origin, message, separator_opt=separator_opt)
92 else
93 if (mmpi_myid == 0) call msg_write(origin, message, separator_opt=separator_opt)
94 end if
95
96 else if (verbLevel == msg_NEVER) then
97 return
98
99 else
100 call msg_readNml()
101 if (verbLevel <= verbosityThreshold) then
102 if (mpiAll) then
103 call msg_write(origin, message, separator_opt=separator_opt)
104 else
105 if (mmpi_myid == 0) call msg_write(origin, message, separator_opt=separator_opt)
106 end if
107 end if
108 end if
109
110 end subroutine msg
111
112 !--------------------------------------------------------------------------
113 ! msg_memUsage
114 !--------------------------------------------------------------------------
115 subroutine msg_memUsage(origin, verb_opt, mpiAll_opt)
116 !
117 !:Purpose: Report memory usage
118 !
119 implicit none
120
121 ! Arguments:
122 character(len=*), intent(in) :: origin ! originating subroutine, function or program
123 integer, optional, intent(in) :: verb_opt ! verbosity level of the message
124 logical, optional, intent(in) :: mpiAll_opt ! choose to prints to all MPI tasks (default), otherwise only task 0
125
126 ! Locals:
127 integer :: usageMb
128 integer, external :: get_max_rss
129
130 usageMb = get_max_rss()/1024
131 call msg( origin, 'Memory Used: '//str(usageMb)//' Mb', verb_opt, mpiAll_opt)
132
133 end subroutine msg_memUsage
134
135 !--------------------------------------------------------------------------
136 ! msg_section
137 !--------------------------------------------------------------------------
138 subroutine msg_section(origin, section, description_opt, verb_opt, mpiAll_opt)
139 !
140 !:Purpose: Document, both in source and runtime listings, sections of a program.
141 !
142 implicit none
143
144 ! Arguments:
145 character(len=*), intent(in) :: origin ! originating subroutine, function or program
146 character(len=*), intent(in) :: section ! section number
147 character(len=*), optional, intent(in) :: description_opt ! optional description message to be printed
148 integer, optional, intent(in) :: verb_opt ! verbosity level of the message
149 logical, optional, intent(in) :: mpiAll_opt ! choose to prints to all MPI tasks (default), otherwise only task 0
150
151 ! Locals:
152 character(len=:), allocatable :: message
153
154 message = 'SECTION '//str(section, quote_opt=.false.)
155 if (present(description_opt)) then
156 message = message//' - '//description_opt
157 end if
158 write(*,*)
159 write(*,*) repeat('_',msg_lineLen)
160 call msg(origin, message, verb_opt, mpiAll_opt, separator_opt=' >>> ')
161
162 end subroutine msg_section
163
164 !--------------------------------------------------------------------------
165 ! msg_setVerbThreshold
166 !--------------------------------------------------------------------------
167 subroutine msg_setVerbThreshold(threshold, beSilent_opt)
168 !
169 !:Purpose: Sets the maximum verbosity level of messages to be printed.
170 !
171 implicit none
172
173 ! Arguments:
174 integer, intent(in) :: threshold ! maximum verbosity level of messages to be printed to listing
175 logical, optional, intent(in) :: beSilent_opt ! choose to not print warning message (default .false.)
176
177 ! Locals:
178 logical :: beSilent
179
180 if (present(beSilent_opt)) then
181 beSilent = beSilent_opt
182 else
183 beSilent = .false.
184 end if
185
186 verbosityThreshold = threshold
187 if (.not. beSilent) then
188 call msg( 'msg_setVerbThreshold', 'WARNING: Setting verbosity threshold to '&
189 //str(verbosityThreshold)//' for DEBUGGING purposes.', verb_opt=msg_ALWAYS)
190 end if
191
192 end subroutine msg_setVerbThreshold
193
194 !--------------------------------------------------------------------------
195 ! msg_readNml (private)
196 !--------------------------------------------------------------------------
197 subroutine msg_readNml()
198 !
199 !:Purpose: Reads the module configuration namelist
200 !
201 !:Namelist parameters:
202 ! :verbosity: Each call to `msg()` specifies a verbosity level;
203 ! this threshold configures until which level
204 ! messages will be outputed.
205 !
206 implicit none
207
208 ! Locals:
209 logical, save :: alreadyRead = .false.
210 integer :: nulnam, ierr, fnom, fclos
211
212 ! Namelist variables
213 logical :: arrayVertical ! choose to use array vertical representation by default
214 integer :: verbosity ! maximum verbosity level of messages to be printed in the listing
215 namelist /NAMMSG/verbosity, arrayVertical
216
217 if (alreadyRead) then
218 return
219 else
220 alreadyRead = .true.
221 end if
222
223 ! default namelist value
224 verbosity = msg_DEFAULT
225 arrayVertical = .false.
226
227 if ( .not. utl_isNamelistPresent('NAMMSG','./flnml') ) then
228 call msg( 'msg_readNml', 'NAMMSG is missing in the namelist. The default values will be taken.', &
229 mpiAll_opt=.false., verb_opt=msg_ALWAYS)
230 else
231 nulnam = 0
232 ierr = fnom(nulnam, 'flnml','FTN+SEQ+R/O',0)
233 read(nulnam,nml=nammsg,iostat=ierr)
234 if (ierr /= 0) call utl_abort('msg_readNml: Error reading namelist NAMMSG')
235 if (mmpi_myid == 0) write(*,nml=nammsg)
236 ierr = fclos(nulnam)
237 end if
238 msg_NML = verbosity
239 call msg_setVerbThreshold(msg_NML, beSilent_opt=.true.)
240 msg_arrayVertical = arrayVertical
241
242 end subroutine msg_readNml
243
244 !--------------------------------------------------------------------------
245 ! msg_write (private)
246 !--------------------------------------------------------------------------
247 subroutine msg_write(origin, message, separator_opt)
248 !
249 !:Purpose: Format and write message to default output
250 !
251 implicit none
252
253 ! Arguments:
254 character(len=*), intent(in) :: origin ! originating subroutine/function
255 character(len=*), intent(in) :: message ! message to be printed
256 character(len=*), optional, intent(in) :: separator_opt ! separator string between origin and message
257
258 ! Locals:
259 integer :: originLen, oneLineMsgLen, posIdx
260 character(len=15) :: firstLineFormat, otherLineFormat
261 character(len=msg_lineLen) :: msgLine
262 character(len=msg_lineLen) :: readLine
263 character(len=:), allocatable :: originTrunc, adjustedLine, separator
264
265 if (present(separator_opt)) then
266 separator = separator_opt
267 else
268 separator = ': '
269 end if
270
271 if (len(origin) > msg_lineLen) then
272 originTrunc = origin(1:msg_lineLen)
273 else
274 originTrunc = origin
275 end if
276 originLen = len(originTrunc)
277
278 oneLineMsgLen = msg_lineLen - originLen - len(separator)
279
280 if (len(message) > oneLineMsgLen) then
281 ! Multiple lines message
282 ! format: "origin: message on the first line..........."
283 ! " second line........................."
284 ! " last line"
285 posIdx = 0
286 readLine = message(1:oneLineMsgLen+1)
287 msgLine = msg_breakOnSpace(readLine)
288 posIdx = posIdx + len(trim(msgLine)) +1
289 write(firstLineFormat,'(A,I2,A,I2,A,I2,A)') '(A',originLen,',A',len(separator),&
290 ',A', len(trim(msgLine)),')'
291 write(*,firstLineFormat) originTrunc, separator, message(1:oneLineMsgLen)
292 oneLineMsgLen = msg_lineLen - msg_indent - len(separator)
293 do
294 if ( posIdx >= len(message) ) then
295 ! message printed
296 return
297 else if ( posIdx + oneLineMsgLen > len(trim(message)) ) then
298 ! last line
299 msgLine = message(posIdx+1:len(message))
300 else
301 ! neither first nor last
302 readLine = message(posIdx+1:min(posIdx+oneLineMsgLen+1,len(message)))
303 msgLine = msg_breakOnSpace(readLine)
304 end if
305 adjustedLine = adjustl(trim(msgLine))
306 posIdx = posIdx + len(adjustedLine) +1
307 write(otherLineFormat,'(A,I2,A,I2,A)') '(A',msg_indent,',A', &
308 len(adjustedLine),')'
309 write(*,otherLineFormat) repeat(' ',msg_indent),adjustedLine
310 end do
311 else
312 ! Single lines message
313 ! format: "origin: short message"
314 write(firstLineFormat,'(A,I2,A,I2,A, I2, A)') '(A',originLen,',A',len(separator), &
315 ',A',len(message),')'
316 write(*,firstLineFormat) originTrunc, separator, message
317 end if
318 contains
319 !----------------------------------------------------------------------
320 ! msg_breakOnSpace (private)
321 !----------------------------------------------------------------------
322 function msg_breakOnSpace(line) result(shorterLine)
323 !
324 !:Purpose: Breaks line on last full word
325 !
326 implicit none
327
328 ! Arguments:
329 character(len=*), intent(inout) :: line ! line of text to be processed
330 ! Result:
331 character(len=msg_lineLen) :: shorterLine ! resulting processed line of text
332
333 ! Locals:
334 integer :: idx, idxNewLine
335
336 idxNewLine = scan(line, new_line(''))
337 if ( idxNewLine == 0) then ! no new line
338 idx = scan(trim(line),' ',back=.true.)
339 if (idx == 0 .or. idx == len(trim(line)) ) then
340 shorterLine = trim(line)
341 else
342 shorterLine = line(1:idx-1)
343 end if
344 else ! presence of a new line
345 shorterLine = trim(line(1:idxNewLine-1))
346 end if
347
348 end function msg_breakOnSpace
349 end subroutine msg_write
350
351 !--------------------------------------------------------------------------
352 ! msg_str2str (private)
353 !--------------------------------------------------------------------------
354 function msg_str2str(stringIn, trim_opt, quote_opt) result(string)
355 !
356 !:Purpose: Trivial overloading (for uniformity of concatenation)
357 !
358 implicit none
359
360 ! Arguments:
361 character(len=*), intent(in) :: stringIn ! input string to be processed
362 logical, optional, intent(in) :: trim_opt ! choose to trim the string (possibly inside quotes)
363 logical, optional, intent(in) :: quote_opt ! choose to write preceding and following single quote "'" to insist it is a string
364 ! Result:
365 character(len=:), allocatable :: string ! resulting string that was processed
366
367 ! Locals:
368 logical :: doTrim, showQuotes
369 character(len=1) :: quote
370
371 if ( present(trim_opt) ) then
372 doTrim = trim_opt
373 else
374 doTrim = .true.
375 end if
376 if ( present(quote_opt) ) then
377 showQuotes = quote_opt
378 else
379 showQuotes = .true.
380 end if
381 if (showQuotes) then
382 quote = "'"
383 else
384 quote = ''
385 end if
386
387 if (doTrim) then
388 string = quote//trim(stringIn)//quote
389 else
390 string = quote//stringIn//quote
391 end if
392
393 end function msg_str2str
394
395 !--------------------------------------------------------------------------
396 ! msg_log2str (private)
397 !--------------------------------------------------------------------------
398 function msg_log2str(num) result(string)
399 !
400 !:Purpose: Returns string representation of `logical` variable value
401 !
402 implicit none
403
404 ! Arguments:
405 logical, intent(in) :: num ! input logical variable to be interpreted
406 ! Result:
407 character(len=:), allocatable :: string ! resulting string with logical value
408
409 ! Locals:
410 character(len=msg_num2strBufferLen) :: buffer
411
412 write(buffer,*) num
413 string = trim(adjustl(buffer))
414
415 end function msg_log2str
416
417 !--------------------------------------------------------------------------
418 ! msg_int2str (private)
419 !--------------------------------------------------------------------------
420 function msg_int2str(num) result(string)
421 !
422 !:Purpose: Returns string representation of `integer`
423 !
424 implicit none
425
426 ! Arguments:
427 integer, intent(in) :: num ! input integer variable to be interpreted
428 ! Result:
429 character(len=:), allocatable :: string ! resulting string with integer value
430
431 ! Locals:
432 character(len=msg_num2strBufferLen) :: buffer
433
434 write(buffer,*) num
435 string = trim(adjustl(buffer))
436
437 end function msg_int2str
438
439 !--------------------------------------------------------------------------
440 ! msg_real42str (private)
441 !--------------------------------------------------------------------------
442 function msg_real42str(num, digits_opt) result(string)
443 !
444 !:Purpose: Returns string representation of `real(4)`
445 !
446 implicit none
447
448 ! Arguments:
449 real(4), intent(in) :: num ! input real(4) variable to be interpreted
450 integer, optional, intent(in) :: digits_opt ! number of digits to include in output
451 ! Result:
452 character(len=:), allocatable :: string ! resulting string with variable's value
453
454 ! Locals:
455 character(len=20) :: readFmt, digitBuffer
456 character(len=msg_num2strBufferLen) :: buffer
457
458 if (present(digits_opt)) then
459 write(digitBuffer, *) digits_opt
460 write(readFmt,*) '(F20.'//trim(adjustl(digitBuffer))//')'
461 write(buffer, readFmt) num
462 else
463 write(buffer,*) num
464 end if
465 string = trim(adjustl(buffer))
466
467 end function msg_real42str
468
469 !--------------------------------------------------------------------------
470 ! msg_real82str (private)
471 !--------------------------------------------------------------------------
472 function msg_real82str(num, digits_opt) result(string)
473 !
474 !:Purpose: Returns string representation of `real(8)`
475 !
476 implicit none
477
478 ! Arguments:
479 real(8), intent(in) :: num ! input real(8) variable to be interpreted
480 integer, optional, intent(in) :: digits_opt ! number of digits to include in output
481 ! Result:
482 character(len=:), allocatable :: string ! resulting string with variable's value
483
484 ! Locals:
485 character(len=20) :: readFmt, digitBuffer
486 character(len=msg_num2strBufferLen) :: buffer
487
488 if (present(digits_opt)) then
489 write(digitBuffer, *) digits_opt
490 write(readFmt,*) '(F20.'//trim(adjustl(digitBuffer))//')'
491 write(buffer, readFmt) num
492 else
493 write(buffer,*) num
494 end if
495 string = trim(adjustl(buffer))
496
497 end function msg_real82str
498
499 !--------------------------------------------------------------------------
500 ! msg_charArray2str (private)
501 !--------------------------------------------------------------------------
502 function msg_charArray2str(array, vertical_opt) result(string)
503 !
504 !:Purpose: Returns string representation of `character(len=*), dimension(:)`
505 !
506 implicit none
507
508 ! Arguments:
509 character(len=*), intent(in) :: array(:) ! input character string array
510 logical, optional, intent(in) :: vertical_opt ! choose to represent array vertically (default .false.)
511 ! Result:
512 character(len=:), allocatable :: string ! resulting string
513
514 ! Locals:
515 integer :: arrIndex
516 logical :: vertical
517 character(len=:), allocatable :: sep
518
519 if (present(vertical_opt)) then
520 vertical = vertical_opt
521 else
522 vertical = msg_arrayVertical
523 end if
524
525 if (vertical) then
526 sep = new_line('')//repeat(' ', msg_indent)
527 string = '(/'//sep
528 else
529 sep = ', '
530 string = '(/ '
531 end if
532
533 do arrIndex = 1, size(array)
534 string = string//trim(array(arrIndex))
535 if (arrIndex /= size(array)) string = string//sep
536 end do
537 string = string//' /)'
538
539 end function msg_charArray2str
540
541 !--------------------------------------------------------------------------
542 ! msg_logArray2str (private)
543 !--------------------------------------------------------------------------
544 function msg_logArray2str(array, vertical_opt) result(string)
545 !
546 !:Purpose: Returns string representation of `logical, dimension(:)`
547 !
548 implicit none
549
550 ! Arguments:
551 logical, intent(in) :: array(:) ! input array of logical variables
552 logical, optional, intent(in) :: vertical_opt ! choose to represent the array vertically (default .false.)
553 ! Result:
554 character(len=:), allocatable :: string ! resulting string
555
556 ! Locals:
557 integer :: arrIndex
558 logical :: vertical
559 character(len=:), allocatable :: sep
560
561 if (present(vertical_opt)) then
562 vertical = vertical_opt
563 else
564 vertical = msg_arrayVertical
565 end if
566
567 if (vertical) then
568 sep = new_line('')//repeat(' ', msg_indent)
569 string = '(/'//sep
570 else
571 sep = ', '
572 string = '(/ '
573 end if
574
575 do arrIndex = 1, size(array)
576 string = string//msg_log2str(array(arrIndex))
577 if (arrIndex /= size(array)) string = string//sep
578 end do
579 string = string//' /)'
580
581 end function msg_logArray2str
582
583 !--------------------------------------------------------------------------
584 ! msg_intArray2str (private)
585 !--------------------------------------------------------------------------
586 function msg_intArray2str(array, vertical_opt) result(string)
587 !
588 !:Purpose: Returns string representation of `integer, dimension(:)`
589 !
590 implicit none
591
592 ! Arguments:
593 integer, intent(in) :: array(:) ! input array of integer variables
594 logical, optional, intent(in) :: vertical_opt ! choose to represent the array vertically (defaults .false.)
595 ! Result:
596 character(len=:), allocatable :: string ! resulting string
597
598 ! Locals:
599 integer :: arrIndex
600 logical :: vertical
601 character(len=:), allocatable :: sep
602
603 if (present(vertical_opt)) then
604 vertical = vertical_opt
605 else
606 vertical = msg_arrayVertical
607 end if
608
609 if (vertical) then
610 sep = new_line('')//repeat(' ', msg_indent)
611 string = '(/'//sep
612 else
613 sep = ', '
614 string = '(/ '
615 end if
616
617 do arrIndex = 1, size(array)
618 string = string//msg_int2str(array(arrIndex))
619 if (arrIndex /= size(array)) string = string//sep
620 end do
621 string = string//' /)'
622
623 end function msg_intArray2str
624
625 !--------------------------------------------------------------------------
626 ! msg_real4Array2str (private)
627 !--------------------------------------------------------------------------
628 function msg_real4Array2str(array, digits_opt, vertical_opt) result(string)
629 !
630 !:Purpose: Returns string representation of `real(4), dimension(:)`
631 !
632 implicit none
633
634 ! Arguments:
635 real(4), intent(in) :: array(:) ! input array of real(4) variables
636 integer, optional, intent(in) :: digits_opt ! number of digits to include in output
637 logical, optional, intent(in) :: vertical_opt ! choose to represent array vertically (default .false.)
638 ! Result:
639 character(len=:), allocatable :: string ! resulting string
640
641 ! Locals:
642 integer :: arrIndex
643 logical :: vertical
644 character(len=:), allocatable :: sep
645
646 if (present(vertical_opt)) then
647 vertical = vertical_opt
648 else
649 vertical = msg_arrayVertical
650 end if
651
652 if (vertical) then
653 sep = new_line('')//repeat(' ', msg_indent)
654 string = '(/'//sep
655 else
656 sep = ', '
657 string = '(/ '
658 end if
659
660 do arrIndex = 1, size(array)
661 string = string//msg_real42str(array(arrIndex), digits_opt=digits_opt)
662 if (arrIndex /= size(array)) string = string//sep
663 end do
664 string = string//' /)'
665
666 end function msg_real4Array2str
667
668 !--------------------------------------------------------------------------
669 ! msg_real8Array2str (private)
670 !--------------------------------------------------------------------------
671 function msg_real8Array2str(array, digits_opt, vertical_opt) result(string)
672 !
673 !:Purpose: Returns string representation of `real(8), dimension(:)`
674 !
675 implicit none
676
677 ! Arguments:
678 real(8), intent(in) :: array(:) ! input array of real(4) variables
679 integer, optional, intent(in) :: digits_opt ! number of digits to include in output
680 logical, optional, intent(in) :: vertical_opt ! choose to represent array vertically (default .false.)
681 ! Result:
682 character(len=:), allocatable :: string ! resulting string
683
684 ! Locals:
685 integer :: arrIndex
686 logical :: vertical
687 character(len=:), allocatable :: sep
688
689 if (present(vertical_opt)) then
690 vertical = vertical_opt
691 else
692 vertical = msg_arrayVertical
693 end if
694
695 if (vertical) then
696 sep = new_line('')//repeat(' ', msg_indent)
697 string = '(/'//sep
698 else
699 sep = ', '
700 string = '(/ '
701 end if
702
703 do arrIndex = 1, size(array)
704 string = string//msg_real82str(array(arrIndex), digits_opt=digits_opt)
705 if (arrIndex /= size(array)) string = string//sep
706 end do
707 string = string//' /)'
708
709 end function msg_real8Array2str
710
711end module message_mod
