libsim  Versione 7.2.6
err_handling.f90
1 ! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
2 ! authors:
3 ! Davide Cesari <dcesari@arpa.emr.it>
4 ! Paolo Patruno <ppatruno@arpa.emr.it>
5 
6 ! This program is free software; you can redistribute it and/or
7 ! modify it under the terms of the GNU General Public License as
8 ! published by the Free Software Foundation; either version 2 of
9 ! the License, or (at your option) any later version.
10 
11 ! This program is distributed in the hope that it will be useful,
12 ! but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ! GNU General Public License for more details.
15 
16 ! You should have received a copy of the GNU General Public License
17 ! along with this program. If not, see <http://www.gnu.org/licenses/>.
68 USE io_units
69 IMPLICIT NONE
70 
71 INTEGER, PARAMETER :: eh_verbose_err=1
72 INTEGER, PARAMETER :: eh_verbose_warn=2
73 INTEGER, PARAMETER :: eh_verbose_info=3
74 LOGICAL :: eh_fatal = .true., eh_to_stderr = .true.
75 INTEGER :: eh_unit = stderr_unit, eh_verbose = eh_verbose_info
76 
77 PRIVATE
78 PUBLIC eh_verbose_err, eh_verbose_warn, eh_verbose_info, &
79  raise_fatal_error, raise_error, raise_warning, print_info, eh_setval, eh_getval
80 
81 CONTAINS
82 
87 SUBROUTINE raise_fatal_error(msg, ierval)
88 CHARACTER (len=*), OPTIONAL, INTENT(in) :: msg
89 INTEGER, OPTIONAL, INTENT(in) :: ierval
90 
91 IF (PRESENT(msg)) CALL output_message('Fatal error: ', msg, -1, ierval)
92 IF (PRESENT(ierval)) CALL exit(abs(ierval))
93 CALL exit(1)
94 
95 END SUBROUTINE raise_fatal_error
96 
97 
102 SUBROUTINE raise_error(msg, ierval, ier)
103 CHARACTER (len=*), OPTIONAL, INTENT(in) :: msg
104 INTEGER, OPTIONAL, INTENT(in) :: ierval
105 INTEGER, OPTIONAL, INTENT(out) :: ier
106 
107 IF (PRESENT(msg)) CALL output_message('Error: ', msg, eh_verbose_err, ierval)
108 IF (eh_fatal) THEN
109  IF (PRESENT(ierval)) CALL exit(abs(ierval))
110  CALL exit(1)
111 ENDIF
112 IF (PRESENT(ier) .AND. PRESENT(ierval)) ier = ierval
113 
114 END SUBROUTINE raise_error
115 
116 
118 SUBROUTINE raise_warning(msg, ierval, ier)
119 CHARACTER (len=*), INTENT(in) :: msg
120 INTEGER, OPTIONAL, INTENT(in) :: ierval
121 INTEGER, OPTIONAL, INTENT(out) :: ier
122 
123 CALL output_message('Per favore, non usare la raise_warning nei tuoi programmi, e` obsoleta: ', msg, eh_verbose_warn, ierval)
124 IF (PRESENT(ier) .AND. PRESENT(ierval)) ier = ierval
125 
126 END SUBROUTINE raise_warning
127 
128 
130 SUBROUTINE print_info(msg, verblev)
131 CHARACTER (len=*), INTENT(in) :: msg
132 INTEGER, OPTIONAL, INTENT(in) :: verblev
133 
134 INTEGER :: lverblev
135 
136 IF (PRESENT(verblev)) THEN
137  lverblev = verblev
138 ELSE
139  lverblev = eh_verbose_info
140 ENDIF
141 
142 CALL output_message('Per favore, non usare la print_info nei tuoi programmi, e` obsoleta: ', msg, lverblev)
143 
144 END SUBROUTINE print_info
145 
146 
147 SUBROUTINE eh_setval(fatal, verbose, to_stderr, to_stdout, to_unit)
148 LOGICAL, OPTIONAL, INTENT(in) :: fatal
149 LOGICAL, OPTIONAL, INTENT(in) :: to_stderr
150 LOGICAL, OPTIONAL, INTENT(in) :: to_stdout
151 INTEGER, OPTIONAL, INTENT(in) :: verbose
152 INTEGER, OPTIONAL, INTENT(in) :: to_unit
153 
154 IF (PRESENT(fatal)) eh_fatal = fatal
155 IF (PRESENT(verbose)) eh_verbose = max(verbose,0)
156 IF (PRESENT(to_stderr)) THEN
157  IF (to_stderr) THEN
158  eh_unit = stderr_unit
159  ELSE
160  eh_unit = stdout_unit
161  ENDIF
162 ENDIF
163 IF (PRESENT(to_stdout)) THEN
164  IF (to_stdout) THEN
165  eh_unit = stdout_unit
166  ELSE
167  eh_unit = stderr_unit
168  ENDIF
169 ENDIF
170 IF (PRESENT(to_unit)) eh_unit = to_unit
171 
172 END SUBROUTINE eh_setval
173 
174 
175 SUBROUTINE eh_getval(fatal, verbose, to_unit)
176 LOGICAL, OPTIONAL, INTENT(out) :: fatal
177 INTEGER, OPTIONAL, INTENT(out) :: verbose, to_unit
178 
179 IF (PRESENT(fatal)) fatal = eh_fatal
180 IF (PRESENT(verbose)) verbose = eh_verbose
181 IF (PRESENT(to_unit)) to_unit = eh_unit
182 
183 END SUBROUTINE eh_getval
184 
185 
186 SUBROUTINE output_message(head, msg, verblev, ierval)
187 CHARACTER (len=*), INTENT(in) :: head, msg
188 INTEGER, INTENT(in) :: verblev
189 INTEGER, OPTIONAL, INTENT(in) :: ierval
190 
191 IF (eh_verbose >= verblev) THEN
192  WRITE(eh_unit, '(2A)') head, trim(msg)
193  IF (PRESENT(ierval)) WRITE(eh_unit, '(2A,I6)') head,' code: ',ierval
194 ENDIF
195 
196 END SUBROUTINE output_message
197 
198 
199 END MODULE err_handling
Gestione degli errori.
Definition of constants related to I/O units.
Definition: io_units.F90:235

Generated with Doxygen.