libsim Versione 7.2.0
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/>.
68USE io_units
69IMPLICIT NONE
70
71INTEGER, PARAMETER :: eh_verbose_err=1
72INTEGER, PARAMETER :: eh_verbose_warn=2
73INTEGER, PARAMETER :: eh_verbose_info=3
74LOGICAL :: eh_fatal = .true., eh_to_stderr = .true.
75INTEGER :: eh_unit = stderr_unit, eh_verbose = eh_verbose_info
76
77PRIVATE
78PUBLIC eh_verbose_err, eh_verbose_warn, eh_verbose_info, &
79 raise_fatal_error, raise_error, raise_warning, print_info, eh_setval, eh_getval
80
81CONTAINS
82
87SUBROUTINE raise_fatal_error(msg, ierval)
88CHARACTER (len=*), OPTIONAL, INTENT(in) :: msg
89INTEGER, OPTIONAL, INTENT(in) :: ierval
90
91IF (PRESENT(msg)) CALL output_message('Fatal error: ', msg, -1, ierval)
92IF (PRESENT(ierval)) CALL exit(abs(ierval))
93CALL exit(1)
94
95END SUBROUTINE raise_fatal_error
96
97
102SUBROUTINE raise_error(msg, ierval, ier)
103CHARACTER (len=*), OPTIONAL, INTENT(in) :: msg
104INTEGER, OPTIONAL, INTENT(in) :: ierval
105INTEGER, OPTIONAL, INTENT(out) :: ier
106
107IF (PRESENT(msg)) CALL output_message('Error: ', msg, eh_verbose_err, ierval)
108IF (eh_fatal) THEN
109 IF (PRESENT(ierval)) CALL exit(abs(ierval))
110 CALL exit(1)
111ENDIF
112IF (PRESENT(ier) .AND. PRESENT(ierval)) ier = ierval
113
114END SUBROUTINE raise_error
115
116
118SUBROUTINE raise_warning(msg, ierval, ier)
119CHARACTER (len=*), INTENT(in) :: msg
120INTEGER, OPTIONAL, INTENT(in) :: ierval
121INTEGER, OPTIONAL, INTENT(out) :: ier
122
123CALL output_message('Per favore, non usare la raise_warning nei tuoi programmi, e` obsoleta: ', msg, eh_verbose_warn, ierval)
124IF (PRESENT(ier) .AND. PRESENT(ierval)) ier = ierval
125
126END SUBROUTINE raise_warning
127
128
130SUBROUTINE print_info(msg, verblev)
131CHARACTER (len=*), INTENT(in) :: msg
132INTEGER, OPTIONAL, INTENT(in) :: verblev
133
134INTEGER :: lverblev
135
136IF (PRESENT(verblev)) THEN
137 lverblev = verblev
138ELSE
139 lverblev = eh_verbose_info
140ENDIF
141
142CALL output_message('Per favore, non usare la print_info nei tuoi programmi, e` obsoleta: ', msg, lverblev)
143
144END SUBROUTINE print_info
145
146
147SUBROUTINE eh_setval(fatal, verbose, to_stderr, to_stdout, to_unit)
148LOGICAL, OPTIONAL, INTENT(in) :: fatal
149LOGICAL, OPTIONAL, INTENT(in) :: to_stderr
150LOGICAL, OPTIONAL, INTENT(in) :: to_stdout
151INTEGER, OPTIONAL, INTENT(in) :: verbose
152INTEGER, OPTIONAL, INTENT(in) :: to_unit
153
154IF (PRESENT(fatal)) eh_fatal = fatal
155IF (PRESENT(verbose)) eh_verbose = max(verbose,0)
156IF (PRESENT(to_stderr)) THEN
157 IF (to_stderr) THEN
158 eh_unit = stderr_unit
159 ELSE
160 eh_unit = stdout_unit
161 ENDIF
162ENDIF
163IF (PRESENT(to_stdout)) THEN
164 IF (to_stdout) THEN
165 eh_unit = stdout_unit
166 ELSE
167 eh_unit = stderr_unit
168 ENDIF
169ENDIF
170IF (PRESENT(to_unit)) eh_unit = to_unit
171
172END SUBROUTINE eh_setval
173
174
175SUBROUTINE eh_getval(fatal, verbose, to_unit)
176LOGICAL, OPTIONAL, INTENT(out) :: fatal
177INTEGER, OPTIONAL, INTENT(out) :: verbose, to_unit
178
179IF (PRESENT(fatal)) fatal = eh_fatal
180IF (PRESENT(verbose)) verbose = eh_verbose
181IF (PRESENT(to_unit)) to_unit = eh_unit
182
183END SUBROUTINE eh_getval
184
185
186SUBROUTINE output_message(head, msg, verblev, ierval)
187CHARACTER (len=*), INTENT(in) :: head, msg
188INTEGER, INTENT(in) :: verblev
189INTEGER, OPTIONAL, INTENT(in) :: ierval
190
191IF (eh_verbose >= verblev) THEN
192 WRITE(eh_unit, '(2A)') head, trim(msg)
193 IF (PRESENT(ierval)) WRITE(eh_unit, '(2A,I6)') head,' code: ',ierval
194ENDIF
195
196END SUBROUTINE output_message
197
198
199END MODULE err_handling
Gestione degli errori.
Definition of constants related to I/O units.
Definition: io_units.F90:225

Generated with Doxygen.