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
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
87 SUBROUTINE raise_fatal_error(msg, ierval)
88 CHARACTER (len=*),
OPTIONAL,
INTENT(in) :: msg
89 INTEGER,
OPTIONAL,
INTENT(in) :: ierval
91 IF (
PRESENT(msg))
CALL output_message(
'Fatal error: ', msg, -1, ierval)
92 IF (
PRESENT(ierval))
CALL exit(abs(ierval))
95 END SUBROUTINE raise_fatal_error
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
107 IF (
PRESENT(msg))
CALL output_message(
'Error: ', msg, eh_verbose_err, ierval)
109 IF (
PRESENT(ierval))
CALL exit(abs(ierval))
112 IF (
PRESENT(ier) .AND.
PRESENT(ierval)) ier = ierval
114 END SUBROUTINE raise_error
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
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
126 END SUBROUTINE raise_warning
130 SUBROUTINE print_info(msg, verblev)
131 CHARACTER (len=*),
INTENT(in) :: msg
132 INTEGER,
OPTIONAL,
INTENT(in) :: verblev
136 IF (
PRESENT(verblev))
THEN
139 lverblev = eh_verbose_info
142 CALL output_message(
'Per favore, non usare la print_info nei tuoi programmi, e` obsoleta: ', msg, lverblev)
144 END SUBROUTINE print_info
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
154 IF (
PRESENT(fatal)) eh_fatal = fatal
155 IF (
PRESENT(verbose)) eh_verbose = max(verbose,0)
156 IF (
PRESENT(to_stderr))
THEN
158 eh_unit = stderr_unit
160 eh_unit = stdout_unit
163 IF (
PRESENT(to_stdout))
THEN
165 eh_unit = stdout_unit
167 eh_unit = stderr_unit
170 IF (
PRESENT(to_unit)) eh_unit = to_unit
172 END SUBROUTINE eh_setval
175 SUBROUTINE eh_getval(fatal, verbose, to_unit)
176 LOGICAL,
OPTIONAL,
INTENT(out) :: fatal
177 INTEGER,
OPTIONAL,
INTENT(out) :: verbose, to_unit
179 IF (
PRESENT(fatal)) fatal = eh_fatal
180 IF (
PRESENT(verbose)) verbose = eh_verbose
181 IF (
PRESENT(to_unit)) to_unit = eh_unit
183 END SUBROUTINE eh_getval
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
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
196 END SUBROUTINE output_message
Definition of constants related to I/O units.