1 !pr 12839- F2003 formatting of Inf /Nan
5 real zero
, pos_inf
, neg_inf
, nan
8 ! need a better way of generating these floating point
9 ! exceptional constants.
15 ! check a field width = 0
17 write(l
,fmt
=fmt
)pos_inf
18 if (l
.ne
.'+Inf') call abort
19 write(l
,fmt
=fmt
)neg_inf
20 if (l
.ne
.'-Inf') call abort
22 if (l
.ne
.' NaN') call abort
24 ! check a field width < 3
26 write(l
,fmt
=fmt
)pos_inf
27 if (l
.ne
.'**') call abort
28 write(l
,fmt
=fmt
)neg_inf
29 if (l
.ne
.'**') call abort
31 if (l
.ne
.'**') call abort
33 ! check a field width = 3
35 write(l
,fmt
=fmt
)pos_inf
36 if (l
.ne
.'Inf') call abort
37 write(l
,fmt
=fmt
)neg_inf
38 if (l
.ne
.'***') call abort
40 if (l
.ne
.'NaN') call abort
42 ! check a field width > 3
44 write(l
,fmt
=fmt
)pos_inf
45 if (l
.ne
.'+Inf') call abort
46 write(l
,fmt
=fmt
)neg_inf
47 if (l
.ne
.'-Inf') call abort
49 if (l
.ne
.' NaN') call abort
51 ! check a field width = 7
53 write(l
,fmt
=fmt
)pos_inf
54 if (l
.ne
.' +Inf') call abort
55 write(l
,fmt
=fmt
)neg_inf
56 if (l
.ne
.' -Inf') call abort
58 if (l
.ne
.' NaN') call abort
60 ! check a field width = 8
62 write(l
,fmt
=fmt
)pos_inf
63 if (l
.ne
.' +Inf') call abort
64 write(l
,fmt
=fmt
)neg_inf
65 if (l
.ne
.' -Inf') call abort
67 if (l
.ne
.' NaN') call abort
69 ! check a field width = 9
71 write(l
,fmt
=fmt
)pos_inf
72 if (l
.ne
.'+Infinity') call abort
73 write(l
,fmt
=fmt
)neg_inf
74 if (l
.ne
.'-Infinity') call abort
76 if (l
.ne
.' NaN') call abort
78 ! check a field width = 14
80 write(l
,fmt
=fmt
)pos_inf
81 if (l
.ne
.' +Infinity') call abort
82 write(l
,fmt
=fmt
)neg_inf
83 if (l
.ne
.' -Infinity') call abort
85 if (l
.ne
.' NaN') call abort