Blame view

fvn_fnlib/e9rint.f 1.56 KB
38581db0c   daniau   git-svn-id: https...
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
        subroutine e9rint(messg,nw,nerr,save)
  c
  c  this routine stores the current error message or prints the old one,
  c  if any, depending on whether or not save = .true. .
  c
        integer messg(nw)
        logical save
        external i1mach, i8save
  c
  c  messgp stores at least the first 72 characters of the previous
  c  message. its length is machine dependent and must be at least
  c
  c       1 + 71/(the number of characters stored per integer word).
  c
        integer messgp(36),fmt(14),ccplus
  c
  c  start with no previous message.
  c
        data messgp(1)/1h1/, nwp/0/, nerrp/0/
  c
  c  set up the format for printing the error message.
  c  the format is simply (a1,14x,72axx) where xx=i1mach(6) is the
  c  number of characters stored per integer word.
  c
        data ccplus  / 1h+ /
  c
        data fmt( 1) / 1h( /
        data fmt( 2) / 1ha /
        data fmt( 3) / 1h1 /
        data fmt( 4) / 1h, /
        data fmt( 5) / 1h1 /
        data fmt( 6) / 1h4 /
        data fmt( 7) / 1hx /
        data fmt( 8) / 1h, /
        data fmt( 9) / 1h7 /
        data fmt(10) / 1h2 /
        data fmt(11) / 1ha /
        data fmt(12) / 1hx /
        data fmt(13) / 1hx /
        data fmt(14) / 1h) /
  c
        if (.not.save) go to 20
  c
  c  save the message.
  c
          nwp=nw
          nerrp=nerr
          do 10 i=1,nw
   10     messgp(i)=messg(i)
  c
          go to 30
  c
   20   if (i8save(1,0,.false.).eq.0) go to 30
  c
  c  print the message.
  c
          iwunit=i1mach(4)
          write(iwunit,9000) nerrp
   9000   format(7h error ,i4,4h in )
  c
          call s88fmt(2,i1mach(6),fmt(12))
          write(iwunit,fmt) ccplus,(messgp(i),i=1,nwp)
  c
   30   return
  c
        end