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