V3FIT
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   doxygen 1.8.17