~ubuntu-branches/ubuntu/karmic/python-scipy/karmic

« back to all changes in this revision

Viewing changes to Lib/integrate/odepack/xerrwv.f

  • Committer: Bazaar Package Importer
  • Author(s): Daniel T. Chen (new)
  • Date: 2005-03-16 02:15:29 UTC
  • Revision ID: james.westby@ubuntu.com-20050316021529-xrjlowsejs0cijig
Tags: upstream-0.3.2
ImportĀ upstreamĀ versionĀ 0.3.2

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
      subroutine xerrwv (msg, nmes, nerr, level, ni, i1, i2, nr, r1, r2)
 
2
      integer msg, nmes, nerr, level, ni, i1, i2, nr,
 
3
     1   i, lun, lunit, mesflg, ncpw, nch, nwds
 
4
      double precision r1, r2
 
5
      dimension msg(nmes)
 
6
c-----------------------------------------------------------------------
 
7
c subroutines xerrwv, xsetf, and xsetun, as given here, constitute
 
8
c a simplified version of the slatec error handling package.
 
9
c written by a. c. hindmarsh at llnl.  version of march 30, 1987.
 
10
c this version is in double precision.
 
11
c
 
12
c all arguments are input arguments.
 
13
c
 
14
c msg    = the message (hollerith literal or integer array).
 
15
c nmes   = the length of msg (number of characters).
 
16
c nerr   = the error number (not used).
 
17
c level  = the error level..
 
18
c          0 or 1 means recoverable (control returns to caller).
 
19
c          2 means fatal (run is aborted--see note below).
 
20
c ni     = number of integers (0, 1, or 2) to be printed with message.
 
21
c i1,i2  = integers to be printed, depending on ni.
 
22
c nr     = number of reals (0, 1, or 2) to be printed with message.
 
23
c r1,r2  = reals to be printed, depending on nr.
 
24
c
 
25
c note..  this routine is machine-dependent and specialized for use
 
26
c in limited context, in the following ways..
 
27
c 1. the number of hollerith characters stored per word, denoted
 
28
c    by ncpw below, is a data-loaded constant.
 
29
c 2. the value of nmes is assumed to be at most 60.
 
30
c    (multi-line messages are generated by repeated calls.)
 
31
c 3. if level = 2, control passes to the statement   stop
 
32
c    to abort the run.  this statement may be machine-dependent.
 
33
c 4. r1 and r2 are assumed to be in double precision and are printed
 
34
c    in d21.13 format.
 
35
c 5. the common block /eh0001/ below is data-loaded (a machine-
 
36
c    dependent feature) with default values.
 
37
c    this block is needed for proper retention of parameters used by
 
38
c    this routine which the user can reset by calling xsetf or xsetun.
 
39
c    the variables in this block are as follows..
 
40
c       mesflg = print control flag..
 
41
c                1 means print all messages (the default).
 
42
c                0 means no printing.
 
43
c       lunit  = logical unit number for messages.
 
44
c                the default is 6 (machine-dependent).
 
45
c-----------------------------------------------------------------------
 
46
c the following are instructions for installing this routine
 
47
c in different machine environments.
 
48
c
 
49
c to change the default output unit, change the data statement
 
50
c in the block data subprogram below.
 
51
c
 
52
c for a different number of characters per word, change the
 
53
c data statement setting ncpw below, and format 10.  alternatives for
 
54
c various computers are shown in comment cards.
 
55
c
 
56
c for a different run-abort command, change the statement following
 
57
c statement 100 at the end.
 
58
c-----------------------------------------------------------------------
 
59
      common /eh0001/ mesflg, lunit
 
60
c-----------------------------------------------------------------------
 
61
c the following data-loaded value of ncpw is valid for the cdc-6600
 
62
c and cdc-7600 computers.
 
63
c     data ncpw/10/
 
64
c the following is valid for the cray-1 computer.
 
65
c     data ncpw/8/
 
66
c the following is valid for the burroughs 6700 and 7800 computers.
 
67
c     data ncpw/6/
 
68
c the following is valid for the pdp-10 computer.
 
69
c     data ncpw/5/
 
70
c the following is valid for the vax computer with 4 bytes per integer,
 
71
c and for the ibm-360, ibm-370, ibm-303x, and ibm-43xx computers.
 
72
      data ncpw/4/
 
73
c the following is valid for the pdp-11, or vax with 2-byte integers.
 
74
c     data ncpw/2/
 
75
c-----------------------------------------------------------------------
 
76
      if (mesflg .eq. 0) go to 100
 
77
c get logical unit number. ---------------------------------------------
 
78
      lun = lunit
 
79
c get number of words in message. --------------------------------------
 
80
      nch = min0(nmes,60)
 
81
      nwds = nch/ncpw
 
82
      if (nch .ne. nwds*ncpw) nwds = nwds + 1
 
83
c write the message. ---------------------------------------------------
 
84
      write (lun, 10) (msg(i),i=1,nwds)
 
85
c-----------------------------------------------------------------------
 
86
c the following format statement is to have the form
 
87
c 10  format(1x,mmann)
 
88
c where nn = ncpw and mm is the smallest integer .ge. 60/ncpw.
 
89
c the following is valid for ncpw = 10.
 
90
c 10  format(1x,6a10)
 
91
c the following is valid for ncpw = 8.
 
92
c 10  format(1x,8a8)
 
93
c the following is valid for ncpw = 6.
 
94
c 10  format(1x,10a6)
 
95
c the following is valid for ncpw = 5.
 
96
c 10  format(1x,12a5)
 
97
c the following is valid for ncpw = 4.
 
98
  10  format(1x,15a4)
 
99
c the following is valid for ncpw = 2.
 
100
c 10  format(1x,30a2)
 
101
c-----------------------------------------------------------------------
 
102
      if (ni .eq. 1) write (lun, 20) i1
 
103
 20   format(6x,23hin above message,  i1 =,i10)
 
104
      if (ni .eq. 2) write (lun, 30) i1,i2
 
105
 30   format(6x,23hin above message,  i1 =,i10,3x,4hi2 =,i10)
 
106
      if (nr .eq. 1) write (lun, 40) r1
 
107
 40   format(6x,23hin above message,  r1 =,d21.13)
 
108
      if (nr .eq. 2) write (lun, 50) r1,r2
 
109
 50   format(6x,15hin above,  r1 =,d21.13,3x,4hr2 =,d21.13)
 
110
c abort the run if level = 2. ------------------------------------------
 
111
 100  if (level .ne. 2) return
 
112
      stop
 
113
c----------------------- end of subroutine xerrwv ----------------------
 
114
      end