e9rint.f
1.56 KB
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