1 !pr 12839- F2003 formatting of Inf /Nan
6 real zero
, pos_inf
, neg_inf
, nan
9 ! need a better way of generating these floating point
10 ! exceptional constants.
16 ! check a field width = 0
18 write(l
,fmt
=fmt
)pos_inf
19 if (l
.ne
.'Inf') STOP 1
20 write(l
,fmt
=fmt
)neg_inf
21 if (l
.ne
.'-Inf') STOP 2
23 if (l
.ne
.'NaN') STOP 3
25 ! check a field width < 3
27 write(l
,fmt
=fmt
)pos_inf
29 write(l
,fmt
=fmt
)neg_inf
34 ! check a field width = 3
36 write(l
,fmt
=fmt
)pos_inf
37 if (l
.ne
.'Inf') STOP 7
38 write(l
,fmt
=fmt
)neg_inf
39 if (l
.ne
.'***') STOP 8
41 if (l
.ne
.'NaN') STOP 9
43 ! check a field width > 3
45 write(l
,fmt
=fmt
)pos_inf
46 if (l
.ne
.' Inf') STOP 10
47 write(l
,fmt
=fmt
)neg_inf
48 if (l
.ne
.'-Inf') STOP 11
50 if (l
.ne
.' NaN') STOP 12
52 ! check a field width = 7
54 write(l
,fmt
=fmt
)pos_inf
55 if (l
.ne
.' Inf') STOP 13
56 write(l
,fmt
=fmt
)neg_inf
57 if (l
.ne
.' -Inf') STOP 14
59 if (l
.ne
.' NaN') STOP 15
61 ! check a field width = 8
63 write(l
,fmt
=fmt
)pos_inf
64 if (l
.ne
.'Infinity') STOP 16
65 write(l
,fmt
=fmt
)neg_inf
66 if (l
.ne
.' -Inf') STOP 17
68 if (l
.ne
.' NaN') STOP 18
70 ! check a field width = 9
72 write(l
,fmt
=fmt
)pos_inf
73 if (l
.ne
.' Infinity') STOP 19
74 write(l
,fmt
=fmt
)neg_inf
75 if (l
.ne
.'-Infinity') STOP 20
77 if (l
.ne
.' NaN') STOP 21
79 ! check a field width = 14
81 write(l
,fmt
=fmt
)pos_inf
82 if (l
.ne
.' Infinity') STOP 22
83 write(l
,fmt
=fmt
)neg_inf
84 if (l
.ne
.' -Infinity') STOP 23
86 if (l
.ne
.' NaN') STOP 24