0.6.2-dev0
FORCES
FORtran lib for Comp. Env. Sys.
Loading...
Searching...
No Matches
mo_message.F90
Go to the documentation of this file.
1#include "logging.h"
2!> \file mo_message.f90
3!> \brief \copybrief mo_message
4!> \details \copydetails mo_message
5
6!> \brief Write out concatenated strings
7!> \details Write out several strings concatenated on standard out or a given unit, either advancing or not.
8!> \author Matthias Cuntz, Sebastian Mueller
9!> \date Jul 2011, Dec 2019
10!> \copyright Copyright 2005-\today, the CHS Developers, Sabine Attinger: All rights reserved.
11!! FORCES is released under the LGPLv3+ license \license_note
12MODULE mo_message
13
14 use mo_logging
15 USE mo_constants, ONLY : nout, nerr
16
17 IMPLICIT NONE
18
19 PRIVATE
20
21 PUBLIC :: message ! versatile routine to write out strings in file or on screen
22 PUBLIC :: error_message ! write error message to ERROR_UNIT and call stop 1
23
24 logical, public, save :: show_msg = .true. !< global control switch to show normal messages
25 logical, public, save :: show_err = .true. !< global control switch to show error messages
26
27 ! ------------------------------------------------------------------
28
29CONTAINS
30
31 function process_arguments(t01, t02, t03, t04, t05, t06, t07, t08, t09, t10, t11, t12, t13, t14, t15, t16) result(outString)
32
33 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t01
34 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t02
35 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t03
36 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t04
37 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t05
38 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t06
39 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t07
40 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t08
41 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t09
42 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t10
43 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t11
44 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t12
45 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t13
46 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t14
47 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t15
48 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t16
49
50 CHARACTER(len = 32000) :: outstring
51
52 outstring = ''
53 ! start from back so that trim does not remove user desired blanks
54 if (present(t16)) outstring = t16 // trim(outstring)
55 if (present(t15)) outstring = t15 // trim(outstring)
56 if (present(t14)) outstring = t14 // trim(outstring)
57 if (present(t13)) outstring = t13 // trim(outstring)
58 if (present(t12)) outstring = t12 // trim(outstring)
59 if (present(t11)) outstring = t11 // trim(outstring)
60 if (present(t10)) outstring = t10 // trim(outstring)
61 if (present(t09)) outstring = t09 // trim(outstring)
62 if (present(t08)) outstring = t08 // trim(outstring)
63 if (present(t07)) outstring = t07 // trim(outstring)
64 if (present(t06)) outstring = t06 // trim(outstring)
65 if (present(t05)) outstring = t05 // trim(outstring)
66 if (present(t04)) outstring = t04 // trim(outstring)
67 if (present(t03)) outstring = t03 // trim(outstring)
68 if (present(t02)) outstring = t02 // trim(outstring)
69 if (present(t01)) outstring = t01 // trim(outstring)
70
71 end function process_arguments
72
73
74 !> \brief Write out an error message to stdout
75 SUBROUTINE message(t01, t02, t03, t04, t05, t06, t07, t08, t09, t10, t11, t12, t13, t14, t15, t16, &
76 uni, advance, show, reset_format)
77
78 IMPLICIT NONE
79
80 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t01 !< optional string arguments
81 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t02 !< optional string arguments
82 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t03 !< optional string arguments
83 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t04 !< optional string arguments
84 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t05 !< optional string arguments
85 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t06 !< optional string arguments
86 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t07 !< optional string arguments
87 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t08 !< optional string arguments
88 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t09 !< optional string arguments
89 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t10 !< optional string arguments
90 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t11 !< optional string arguments
91 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t12 !< optional string arguments
92 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t13 !< optional string arguments
93 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t14 !< optional string arguments
94 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t15 !< optional string arguments
95 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t16 !< optional string arguments
96 INTEGER, INTENT(IN), OPTIONAL :: uni !< Unit to write to (default: stdout)
97 CHARACTER(len = *), INTENT(IN), OPTIONAL :: advance !< add linebreak after message, default: 'yes', else 'no'
98 LOGICAL, INTENT(IN), OPTIONAL :: show !< control if message should be shown (show_msg as default)
99 LOGICAL, INTENT(IN), OPTIONAL :: reset_format !< Reset formatting (default: .false.)
100
101 CHARACTER(len = 32000) :: outstring
102 CHARACTER(len = 10) :: format_string
103 INTEGER :: uni_
104 CHARACTER(len = 3) :: advance_
105 logical :: reset_format_, show_
106
107 show_ = show_msg
108 if ( present(show) ) show_ = show
109 ! short circuit if message should not be shown
110 if (.not. show_ ) return
111
112 uni_ = nout
113 advance_ = 'yes'
114 reset_format_ = .false.
115 if ( present(uni) ) uni_ = uni
116 if ( present(advance) ) advance_ = advance
117 if ( present(reset_format) ) reset_format_ = reset_format
118
119 outstring = process_arguments(t01, t02, t03, t04, t05, t06, t07, t08, t09, t10, t11, t12, t13, t14, t15, t16)
120
121 if ( reset_format_ ) then
122 format_string = ""
123 call stput(format_string, "0")
124 outstring = trim(format_string) // outstring
125 end if
126
127 write(uni_, '(a)', advance = advance_) trim(outstring)
128
129 END SUBROUTINE message
130
131 !> \brief Write out an error message to stderr and call stop 1.
132 SUBROUTINE error_message(t01, t02, t03, t04, t05, t06, t07, t08, t09, t10, t11, t12, t13, t14, t15, t16, &
133 uni, advance, show, raise, reset_format)
134
135 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t01 !< optional string arguments
136 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t02 !< optional string arguments
137 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t03 !< optional string arguments
138 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t04 !< optional string arguments
139 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t05 !< optional string arguments
140 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t06 !< optional string arguments
141 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t07 !< optional string arguments
142 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t08 !< optional string arguments
143 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t09 !< optional string arguments
144 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t10 !< optional string arguments
145 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t11 !< optional string arguments
146 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t12 !< optional string arguments
147 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t13 !< optional string arguments
148 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t14 !< optional string arguments
149 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t15 !< optional string arguments
150 CHARACTER(len = *), INTENT(IN), OPTIONAL :: t16 !< optional string arguments
151 INTEGER, INTENT(IN), OPTIONAL :: uni !< Unit to write to (default: stderr)
152 CHARACTER(len = *), INTENT(IN), OPTIONAL :: advance !< add linebreak after message, default: 'yes', else 'no'
153 LOGICAL, INTENT(IN), OPTIONAL :: show !< control if message should be shown (show_err as default)
154 LOGICAL, INTENT(IN), OPTIONAL :: raise !< control if an exception is raised with error code 1 (.true. as default)
155 LOGICAL, INTENT(IN), OPTIONAL :: reset_format !< Reset formatting (default: .false.)
156
157 INTEGER :: uni_
158 logical :: show_, raise_
159
160 show_ = show_err
161 raise_ = .true.
162 uni_ = nerr
163 if ( present(show) ) show_ = show
164 if ( present(raise) ) raise_ = raise
165 if (present(uni) ) uni_ = uni
166
167 call message(t01, t02, t03, t04, t05, t06, t07, t08, t09, t10, t11, t12, t13, t14, t15, t16, uni_, advance, show_, reset_format)
168 if ( raise_ ) stop 1
169
170 END SUBROUTINE error_message
171
172END MODULE mo_message
mo_constants
Provides computational, mathematical, physical, and file constants.
Definition mo_constants.f90:13
mo_constants::nerr
integer, parameter nerr
Standard error file unit.
Definition mo_constants.f90:142
mo_constants::nout
integer, parameter nout
Standard output file unit.
Definition mo_constants.f90:139
mo_logging
Module providing a logging framework.
Definition mo_logging.F90:61
mo_logging::stput
subroutine, public stput(str, code)
generate format string
Definition mo_logging.F90:163
mo_message
Write out concatenated strings.
Definition mo_message.F90:12
mo_message::error_message
subroutine, public error_message(t01, t02, t03, t04, t05, t06, t07, t08, t09, t10, t11, t12, t13, t14, t15, t16, uni, advance, show, raise, reset_format)
Write out an error message to stderr and call stop 1.
Definition mo_message.F90:134
mo_message::show_err
logical, save, public show_err
global control switch to show error messages
Definition mo_message.F90:25
mo_message::show_msg
logical, save, public show_msg
global control switch to show normal messages
Definition mo_message.F90:24
mo_message::message
subroutine, public message(t01, t02, t03, t04, t05, t06, t07, t08, t09, t10, t11, t12, t13, t14, t15, t16, uni, advance, show, reset_format)
Write out an error message to stdout.
Definition mo_message.F90:77