V3FIT
LIBSTELL
Sources
Lsode
xerrwv.f
1
SUBROUTINE
xerrwv(msg, nmes, nerr, level, ni, i1, i2, nr, r1, r2)
2
C-----------------------------------------------
3
C M o d u l e s
4
C-----------------------------------------------
5
USE
stel_kinds
6
IMPLICIT NONE
7
C-----------------------------------------------
8
C D u m m y A r g u m e n t s
9
C-----------------------------------------------
10
INTEGER
:: nmes, nerr, level, ni, i1, i2, nr
11
REAL
(rprec) r1, r2
12
CHARACTER(LEN=*)
:: msg
13
C-----------------------------------------------
14
C L o c a l V a r i a b l e s
15
C-----------------------------------------------
16
! INTEGER :: lun, ncpw, nch, nwds
17
INTEGER
,
PARAMETER
:: lunit = 6
18
c-----------------------------------------------------------------------
19
c Subroutines xerrwv, xsetf, and xsetun, as given here, constitute
20
c a simplified version of the slatec error handling package.
21
c written by a. c. hindmarsh at llnl. version of march 30, 1987.
22
c the following is valid for the pdp-11, or vax with 2-byte integers.
23
c-----------------------------------------------------------------------
24
c WRITE the message. ---------------------------------------------------
25
WRITE
(lunit,
'(a)'
) trim(msg)
26
IF
(ni == 1)
WRITE
(lunit, 20) i1
27
20
FORMAT
(6x,
'in above message, i1 ='
,i10)
28
IF
(ni == 2)
WRITE
(lunit, 30) i1, i2
29
30
FORMAT
(6x,
'in above message, i1 ='
,i10,3x,
'i2 ='
,i10)
30
IF
(nr == 1)
WRITE
(lunit, 40) r1
31
40
FORMAT
(6x,
'in above message, r1 ='
,d14.6)
32
IF
(nr == 2)
WRITE
(lunit, 50) r1, r2
33
50
FORMAT
(6x,
'in above, r1 ='
,d21.13,3x,
'r2 ='
,d14.6)
34
35
c abort the run if level = 2. ------------------------------------------
36
IF
(level /= 2)
RETURN
37
stop
38
39
END SUBROUTINE
xerrwv
Generated on Thu Mar 5 2020 15:49:23 for V3FIT by
1.8.17