blob: 4da41236db23efdc95f790b7d06da29686634e70 [file] [log] [blame]
!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') STOP 1
write(l,fmt=fmt)neg_inf
if (l.ne.'-Inf') STOP 2
write(l,fmt=fmt)nan
if (l.ne.'NaN') STOP 3
! check a field width < 3
fmt = '(F2.0)'
write(l,fmt=fmt)pos_inf
if (l.ne.'**') STOP 4
write(l,fmt=fmt)neg_inf
if (l.ne.'**') STOP 5
write(l,fmt=fmt)nan
if (l.ne.'**') STOP 6
! check a field width = 3
fmt = '(F3.0)'
write(l,fmt=fmt)pos_inf
if (l.ne.'Inf') STOP 7
write(l,fmt=fmt)neg_inf
if (l.ne.'***') STOP 8
write(l,fmt=fmt)nan
if (l.ne.'NaN') STOP 9
! check a field width > 3
fmt = '(F4.0)'
write(l,fmt=fmt)pos_inf
if (l.ne.' Inf') STOP 10
write(l,fmt=fmt)neg_inf
if (l.ne.'-Inf') STOP 11
write(l,fmt=fmt)nan
if (l.ne.' NaN') STOP 12
! check a field width = 7
fmt = '(F7.0)'
write(l,fmt=fmt)pos_inf
if (l.ne.' Inf') STOP 13
write(l,fmt=fmt)neg_inf
if (l.ne.' -Inf') STOP 14
write(l,fmt=fmt)nan
if (l.ne.' NaN') STOP 15
! check a field width = 8
fmt = '(F8.0)'
write(l,fmt=fmt)pos_inf
if (l.ne.'Infinity') STOP 16
write(l,fmt=fmt)neg_inf
if (l.ne.' -Inf') STOP 17
write(l,fmt=fmt)nan
if (l.ne.' NaN') STOP 18
! check a field width = 9
fmt = '(F9.0)'
write(l,fmt=fmt)pos_inf
if (l.ne.' Infinity') STOP 19
write(l,fmt=fmt)neg_inf
if (l.ne.'-Infinity') STOP 20
write(l,fmt=fmt)nan
if (l.ne.' NaN') STOP 21
! check a field width = 14
fmt = '(F14.0)'
write(l,fmt=fmt)pos_inf
if (l.ne.' Infinity') STOP 22
write(l,fmt=fmt)neg_inf
if (l.ne.' -Infinity') STOP 23
write(l,fmt=fmt)nan
if (l.ne.' NaN') STOP 24
end