1!pr 12839- F2003 formatting of Inf /Nan
2! Modified for PR47434
3       implicit none
4       character*40 l
5       character*12 fmt
6       real zero, pos_inf, neg_inf, nan
7       zero = 0.0
8
9! need a better way of generating these floating point
10! exceptional constants.
11
12       pos_inf =  1.0/zero
13       neg_inf = -1.0/zero
14       nan = zero/zero
15
16! check a field width = 0
17       fmt = '(F0.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
22       write(l,fmt=fmt)nan
23       if (l.ne.'NaN') STOP 3
24
25! check a field width < 3
26       fmt = '(F2.0)'
27       write(l,fmt=fmt)pos_inf
28       if (l.ne.'**') STOP 4
29       write(l,fmt=fmt)neg_inf
30       if (l.ne.'**') STOP 5
31       write(l,fmt=fmt)nan
32       if (l.ne.'**') STOP 6
33
34! check a field width = 3
35       fmt = '(F3.0)'
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
40       write(l,fmt=fmt)nan
41       if (l.ne.'NaN') STOP 9
42
43! check a field width > 3
44       fmt = '(F4.0)'
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
49       write(l,fmt=fmt)nan
50       if (l.ne.' NaN') STOP 12
51
52! check a field width = 7
53       fmt = '(F7.0)'
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
58       write(l,fmt=fmt)nan
59       if (l.ne.'    NaN') STOP 15
60
61! check a field width = 8
62       fmt = '(F8.0)'
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
67       write(l,fmt=fmt)nan
68       if (l.ne.'     NaN') STOP 18
69
70! check a field width = 9
71       fmt = '(F9.0)'
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
76       write(l,fmt=fmt)nan
77       if (l.ne.'      NaN') STOP 21
78
79! check a field width = 14
80       fmt = '(F14.0)'
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
85       write(l,fmt=fmt)nan
86       if (l.ne.'           NaN') STOP 24
87       end
88
89