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
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
|
!pr 12839- F2003 formatting of Inf /Nan
! Modified for PR47434
implicit none
character*40 l
character*12 fmt
real zero, pos_inf, neg_inf, nan
zero = 0.0
! need a better way of generating these floating point
! exceptional constants.
pos_inf = 1.0/zero
neg_inf = -1.0/zero
nan = zero/zero
! check a field width = 0
fmt = '(F0.0)'
write(l,fmt=fmt)pos_inf
if (l.ne.'Inf') call abort
write(l,fmt=fmt)neg_inf
if (l.ne.'-Inf') call abort
write(l,fmt=fmt)nan
if (l.ne.'NaN') call abort
! check a field width < 3
fmt = '(F2.0)'
write(l,fmt=fmt)pos_inf
if (l.ne.'**') call abort
write(l,fmt=fmt)neg_inf
if (l.ne.'**') call abort
write(l,fmt=fmt)nan
if (l.ne.'**') call abort
! check a field width = 3
fmt = '(F3.0)'
write(l,fmt=fmt)pos_inf
if (l.ne.'Inf') call abort
write(l,fmt=fmt)neg_inf
if (l.ne.'***') call abort
write(l,fmt=fmt)nan
if (l.ne.'NaN') call abort
! check a field width > 3
fmt = '(F4.0)'
write(l,fmt=fmt)pos_inf
if (l.ne.' Inf') call abort
write(l,fmt=fmt)neg_inf
if (l.ne.'-Inf') call abort
write(l,fmt=fmt)nan
if (l.ne.' NaN') call abort
! check a field width = 7
fmt = '(F7.0)'
write(l,fmt=fmt)pos_inf
if (l.ne.' Inf') call abort
write(l,fmt=fmt)neg_inf
if (l.ne.' -Inf') call abort
write(l,fmt=fmt)nan
if (l.ne.' NaN') call abort
! check a field width = 8
fmt = '(F8.0)'
write(l,fmt=fmt)pos_inf
if (l.ne.'Infinity') call abort
write(l,fmt=fmt)neg_inf
if (l.ne.' -Inf') call abort
write(l,fmt=fmt)nan
if (l.ne.' NaN') call abort
! check a field width = 9
fmt = '(F9.0)'
write(l,fmt=fmt)pos_inf
if (l.ne.' Infinity') call abort
write(l,fmt=fmt)neg_inf
if (l.ne.'-Infinity') call abort
write(l,fmt=fmt)nan
if (l.ne.' NaN') call abort
! check a field width = 14
fmt = '(F14.0)'
write(l,fmt=fmt)pos_inf
if (l.ne.' Infinity') call abort
write(l,fmt=fmt)neg_inf
if (l.ne.' -Infinity') call abort
write(l,fmt=fmt)nan
if (l.ne.' NaN') call abort
end
|
