| !pr 12839- F2003 formatting of Inf /Nan |
| 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.' +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 = 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 |
| |