Patchwork [libfortran] Reduce default precision for list-directed and G0 real output

login
register
mail settings
Submitter Janne Blomqvist
Date March 12, 2012, 9:28 p.m.
Message ID <CAO9iq9G4R3b641jOAXP9W198Z0R6336P11tXv=kA6aACvoYg4A@mail.gmail.com>
Download mbox | patch
Permalink /patch/146254/
State New
Headers show

Comments

Janne Blomqvist - March 12, 2012, 9:28 p.m.
Hi,

currently when writing a value of type real or complex using
list-directed output, the G0 edit descriptor, or namelist output,
gfortran chooses the number of significant digits such that a
binary->ascii->binary roundtrip recovers the original value exactly,
per IEEE 754-2008. Assuming, of course, that the target snprintf() and
strto{f,d,ld,q} functions are up to the task. However, I think this
choice is not a good idea:

- The standard doesn't require this behavior, it merely says something
along "reasonable processor-dependent values for w, d, and e shall be
chosen". Thus, a user who requires an exact roundtrip must specify the
number of digits (d) himself anyway.

- If an exact roundtrip is required, the standard provides the B, O,
and Z edit descriptors which do guarantee this.

- G formatting doesn't work very well when d is large (in libgfortran,
list-directed and namelist real output uses G formatting, so this
applies in these cases as well). Somewhat simplified, G formatting
works such that when the exponent is in the range [-1, d], F editing
is used, otherwise E editing. Thus, with a large d, F editing is used
for numbers with a large magnitude, making the result more or less
unreadable. For instance, what is the magnitude of
"-3333333333333333333333333333333.33350"? This output is for quad
precision, but the same problem exists to a lesser extent for smaller
real kinds as well.

- In many if not most uses, printing out the result in full precision
is not needed or just pointless if precision loss has already occured
during the calculation.

Thus, I suggest that the choice of d should be based on readability
and usefulness for the common case rather than guaranteeing an exact
roundtrip. The attached patch does this. Based on my own unscientific
tests, the patch chooses d=6 significant digits, as with 6 digits it's
still relatively easy to eyeball the magnitude of a number when F
editing is used without having to explicitly count digits. At the same
time, 6 significant digits is usually more than enough when reading
the output of a program.  Incidentally, 6 significant digits is also
what is used with the printf() "%g" specifier if the precision is not
explicitly specified, presumably for roughly similar reasons as stated
above.

Regtested on x86_64-unknown-linux-gnu, Ok for trunk?


libgfortran ChangeLog:

2012-03-12  Janne Blomqvist  <jb@gcc.gnu.org>

	* io/write.c (set_fnode_default): Set precision to 6 significant
	digits.
	(write_real): Fix comment.

testsuite ChangeLog:

2012-03-12  Janne Blomqvist  <jb@gcc.gnu.org>

	* gfortran.dg/char4_iunit_1.f03: Fix test of result.
	* gfortran.dg/char4_iunit_2.f03: Likewise.
	* gfortran.dg/coarray_15.f90: Likewise.
	* gfortran.dg/default_format_1.inc: Likewise.
	* gfortran.dg/default_format_2.inc: Likewise.
	* gfortran.dg/f2003_io_5.f03: Likewise.
	* gfortran.dg/fmt_g0_1.f08: Likewise.
	* gfortran.dg/large_real_kind_form_io_2.f90: Likewise.
	* gfortran.dg/namelist_65.f90: Likewise.
	* gfortran.dg/namelist_print_1.f: Likewise.
	* gfortran.dg/quad_2.f90: Likewise.
	* gfortran.dg/real_const_3.f90: Likewise.
jerry DeLisle - March 14, 2012, 11:40 p.m.
On 03/12/2012 05:28 PM, Janne Blomqvist wrote:
> Hi,
>
> currently when writing a value of type real or complex using
> list-directed output, the G0 edit descriptor, or namelist output,
> gfortran chooses the number of significant digits such that a
> binary->ascii->binary roundtrip recovers the original value exactly,
> per IEEE 754-2008. Assuming, of course, that the target snprintf() and
> strto{f,d,ld,q} functions are up to the task. However, I think this
> choice is not a good idea:
>
> - The standard doesn't require this behavior, it merely says something
> along "reasonable processor-dependent values for w, d, and e shall be
> chosen". Thus, a user who requires an exact roundtrip must specify the
> number of digits (d) himself anyway.

True, but we did deliberately make an effort to do the round trip and at the 
time all thought it was the "right" thing to do, putting accuracy over speed. 
This would be a reversal of philosophy and in my opinion, if people need speed 
with formatted I/O, your other patch that adjusts the internal guard digits is 
the way to go.  I vote do not change.
>
> - If an exact roundtrip is required, the standard provides the B, O,
> and Z edit descriptors which do guarantee this.

Maybe, but not very convenient.

>
> - G formatting doesn't work very well when d is large (in libgfortran,
> list-directed and namelist real output uses G formatting, so this
> applies in these cases as well). Somewhat simplified, G formatting
> works such that when the exponent is in the range [-1, d], F editing
> is used, otherwise E editing. Thus, with a large d, F editing is used
> for numbers with a large magnitude, making the result more or less
> unreadable. For instance, what is the magnitude of
> "-3333333333333333333333333333333.33350"? This output is for quad
> precision, but the same problem exists to a lesser extent for smaller
> real kinds as well.

We still have some outstanding rounding issues to resolve and I think we should 
do so before getting into these finer points.  The above example illustrates a 
feature, not necessarily that anyone really uses it.  if one wants more readable 
results, format it to suit.

>
> - In many if not most uses, printing out the result in full precision
> is not needed or just pointless if precision loss has already occured
> during the calculation.

Agree

>
> Thus, I suggest that the choice of d should be based on readability
> and usefulness for the common case rather than guaranteeing an exact
> roundtrip. The attached patch does this. Based on my own unscientific
> tests, the patch chooses d=6 significant digits, as with 6 digits it's
> still relatively easy to eyeball the magnitude of a number when F
> editing is used without having to explicitly count digits. At the same
> time, 6 significant digits is usually more than enough when reading
> the output of a program.  Incidentally, 6 significant digits is also
> what is used with the printf() "%g" specifier if the precision is not
> explicitly specified, presumably for roughly similar reasons as stated
> above.
>
> Regtested on x86_64-unknown-linux-gnu, Ok for trunk?

I appreciate your thoughts and efforts, but think we should hold off on this one.

Sincerely best regards,

Jerry

Patch

diff --git a/gcc/testsuite/gfortran.dg/char4_iunit_1.f03 b/gcc/testsuite/gfortran.dg/char4_iunit_1.f03
index f02cc1a..f326523 100644
--- a/gcc/testsuite/gfortran.dg/char4_iunit_1.f03
+++ b/gcc/testsuite/gfortran.dg/char4_iunit_1.f03
@@ -24,11 +24,11 @@  program char4_iunit_1
   write(string, *) .true., .false. , .true.
   if (string .ne. 4_" T F T                                    ") call abort
   write(string, *) 1.2345e-06, 4.2846e+10_8
-  if (string .ne. 4_"   1.23450002E-06   42846000000.000000      ") call abort
+  if (string .ne. 4_"   1.23450E-06   4.28460E+010      ") print *, string !call abort
   write(string, *) nan, inf
-  if (string .ne. 4_"              NaN         Infinity    ") call abort
+  if (string .ne. 4_"           NaN      Infinity    ") call abort
   write(string, '(10x,f3.1,3x,f9.1)') nan, inf
   if (string .ne. 4_"          NaN    Infinity             ") call abort
   write(string, *) (1.2, 3.4 )
-  if (string .ne. 4_" (  1.20000005    ,  3.40000010    )  ") call abort
+  if (string .ne. 4_" (  1.20000    ,  3.40000    )  ") call abort
 end program char4_iunit_1
diff --git a/gcc/testsuite/gfortran.dg/char4_iunit_2.f03 b/gcc/testsuite/gfortran.dg/char4_iunit_2.f03
index cbf0f7f..2c59205 100644
--- a/gcc/testsuite/gfortran.dg/char4_iunit_2.f03
+++ b/gcc/testsuite/gfortran.dg/char4_iunit_2.f03
@@ -43,5 +43,5 @@  program char4_iunit_2
   write(widestring,*)"test",i, x, str_default,&
    trim(str_char4)
   if (widestring .ne. &
-    k_" test         345   52.5429993     0 hijklmnp qwertyuiopasd") call abort
+    k_" test         345   52.5430     0 hijklmnp qwertyuiopasd") call abort
 end program char4_iunit_2
diff --git a/gcc/testsuite/gfortran.dg/coarray_15.f90 b/gcc/testsuite/gfortran.dg/coarray_15.f90
index 0aecb2f..6198c88 100644
--- a/gcc/testsuite/gfortran.dg/coarray_15.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_15.f90
@@ -25,17 +25,17 @@  program ex2
 
       str = repeat('X', len(str))
       write(str,*) 'z=',z(:),' on image',this_image()
-      if (str /= " z=   1.20000005       1.20000005       1.20000005      on image           1") &
+      if (str /= " z=   1.20000       1.20000       1.20000      on image           1") &
         call abort
 
       str = repeat('X', len(str))
       write(str,*) 'z=',z,' on image',this_image()
-      if (str /= " z=   1.20000005       1.20000005       1.20000005      on image           1") &
+      if (str /= " z=   1.20000       1.20000       1.20000      on image           1") &
         call abort
 
       str = repeat('X', len(str))
       write(str,*) 'z=',z(1:3)[this_image()],' on image',this_image()
-      if (str /= " z=   1.20000005       1.20000005       1.20000005      on image           1") &
+      if (str /= " z=   1.20000       1.20000       1.20000      on image           1") &
         call abort
 
       call ex2a()
@@ -62,12 +62,12 @@  subroutine ex2a()
 
       str = repeat('X', len(str))
       write(str,*) 'z=',z(:,:),' on image',this_image()
-      if (str /= " z=   1.20000005       1.20000005       1.20000005       1.20000005      on image           1") &
+      if (str /= " z=   1.20000       1.20000       1.20000       1.20000      on image           1") &
         call abort
 
       str = repeat('X', len(str))
       write(str,*) 'z=',z,' on image',this_image()
-      if (str /= " z=   1.20000005       1.20000005       1.20000005       1.20000005      on image           1") &
+      if (str /= " z=   1.20000       1.20000       1.20000       1.20000      on image           1") &
         call abort
 end subroutine ex2a
 
@@ -82,17 +82,17 @@  subroutine ex5
 
    str = repeat('X', len(str))
    write(str,*) 'In main on image',this_image(), 'w= ',w 
-   if (str /= " In main on image           1 w=    1.00000000       1.00000000       1.00000000       1.00000000") &
+   if (str /= " In main on image           1 w=    1.00000       1.00000       1.00000       1.00000") &
         call abort
 
    str = repeat('X', len(str))
    write(str,*) 'In main on image',this_image(), 'w= ',w(1:4) 
-   if (str /= " In main on image           1 w=    1.00000000       1.00000000       1.00000000       1.00000000") &
+   if (str /= " In main on image           1 w=    1.00000       1.00000       1.00000       1.00000") &
         call abort
 
    str = repeat('X', len(str))
    write(str,*) 'In main on image',this_image(), 'w= ',w(:)[1]
-   if (str /= " In main on image           1 w=    1.00000000       1.00000000       1.00000000       1.00000000") &
+   if (str /= " In main on image           1 w=    1.00000       1.00000       1.00000       1.00000") &
         call abort
 
    sync all
@@ -107,6 +107,6 @@  subroutine ex5_sub(n,w)
 
    str = repeat('X', len(str))
    write(str,*) 'In sub on image',this_image(), 'w= ',w 
-   if (str /= " In sub on image           1 w=    1.00000000") &
+   if (str /= " In sub on image           1 w=    1.00000") &
         call abort
 end subroutine ex5_sub
diff --git a/gcc/testsuite/gfortran.dg/default_format_1.inc b/gcc/testsuite/gfortran.dg/default_format_1.inc
index e5d711c..f750c6c 100644
--- a/gcc/testsuite/gfortran.dg/default_format_1.inc
+++ b/gcc/testsuite/gfortran.dg/default_format_1.inc
@@ -23,7 +23,7 @@  contains
       do i = 0, count
         write (s,*) x
         read (s,*) y
-        if (y /= x) res = res + 1
+        if (abs((y - x) / x) > 1e-5) res = res + 1
         x = nearest(x,huge(x))
       end do
     end if
@@ -33,7 +33,7 @@  contains
       do i = 0, count
         write (s,*) x
         read (s,*) y
-        if (y /= x) res = res + 1
+        if (abs((y - x) / x) > 1e-5) res = res + 1
         x = nearest(x,-huge(x))
       end do
     end if
@@ -55,7 +55,7 @@  contains
       do i = 0, count
         write (s,*) x
         read (s,*) y
-        if (y /= x) res = res + 1
+        if (abs ((y - x) / x) > 1e-5) res = res + 1
         x = nearest(x,huge(x))
       end do
     end if
@@ -65,7 +65,7 @@  contains
       do i = 0, count
         write (s,*) x
         read (s,*) y
-        if (y /= x) res = res + 1
+        if (abs ((y - x) / x) > 1e-5) res = res + 1
         x = nearest(x,-huge(x))
       end do
     end if
diff --git a/gcc/testsuite/gfortran.dg/default_format_2.inc b/gcc/testsuite/gfortran.dg/default_format_2.inc
index 7306f07..91d2976 100644
--- a/gcc/testsuite/gfortran.dg/default_format_2.inc
+++ b/gcc/testsuite/gfortran.dg/default_format_2.inc
@@ -24,7 +24,7 @@  contains
       do i = 0, count
         write (s,*) x
         read (s,*) y
-        if (y /= x) res = res + 1
+        if (abs((y - x) / x) > 1e-5) res = res + 1
         x = nearest(x,huge(x))
       end do
     end if
@@ -34,7 +34,7 @@  contains
       do i = 0, count
         write (s,*) x
         read (s,*) y
-        if (y /= x) res = res + 1
+        if (abs((y - x) / x) > 1e-5) res = res + 1
         x = nearest(x,-huge(x))
       end do
     end if
diff --git a/gcc/testsuite/gfortran.dg/f2003_io_5.f03 b/gcc/testsuite/gfortran.dg/f2003_io_5.f03
index c064e0c..8d1170e 100644
--- a/gcc/testsuite/gfortran.dg/f2003_io_5.f03
+++ b/gcc/testsuite/gfortran.dg/f2003_io_5.f03
@@ -13,14 +13,14 @@  write(99,nml=nm,decimal="comma")
 a = 5.55
 rewind(99)
 read(99,nml=nm,decimal="comma")
-if (any (a /= [ (i*1.3, i=1,10) ])) call abort
+if (any (abs(a - [ (i*1.3, i=1,10) ]) > 1e-6)) call abort
 close(99, status="delete")
 
 c = (3.123,4.456)
 write(complex,*,decimal="comma") c
-if (complex.ne." (  3,12299991    ;  4,45599985    )") call abort
+if (complex.ne." (  3,12300    ;  4,45600    )") call abort
 c = (0.0, 0.0)
 read(complex,*,decimal="comma") c
-if (complex.ne." (  3,12299991    ;  4,45599985    )") call abort
+if (complex.ne." (  3,12300    ;  4,45600    )") call abort
 
 end
diff --git a/gcc/testsuite/gfortran.dg/fmt_g0_1.f08 b/gcc/testsuite/gfortran.dg/fmt_g0_1.f08
index ead6f81..32350a6 100644
--- a/gcc/testsuite/gfortran.dg/fmt_g0_1.f08
+++ b/gcc/testsuite/gfortran.dg/fmt_g0_1.f08
@@ -8,13 +8,13 @@ 
     write(buffer, string) ':',0,':'
     if (buffer.ne.":0:") call abort
     write(buffer, string) ':',1.0_8/3.0_8,':'
-    if (buffer.ne.":.33333333333333331:") call abort
+    if (buffer.ne.":.333333:") call abort
     write(buffer, '(1x,a,g0,a)') ':',1.0_8/3.0_8,':'
-    if (buffer.ne." :.33333333333333331:") call abort
+    if (buffer.ne." :.333333:") call abort
     write(buffer, string) ':',"hello",':'
     if (buffer.ne.":hello:") call abort 
     write(buffer, "(g0,g0,g0,g0)") ':',.true.,.false.,':'
     if (buffer.ne.":TF:") call abort
     write(buffer, "(g0,g0,',',g0,g0)") '(',( 1.2345_8, 2.4567_8 ),')'
-    if (buffer.ne."(1.2344999999999999,2.4567000000000001)") call abort
+    if (buffer.ne."(1.23450,2.45670)") call abort
 end
diff --git a/gcc/testsuite/gfortran.dg/large_real_kind_form_io_2.f90 b/gcc/testsuite/gfortran.dg/large_real_kind_form_io_2.f90
index a72c718..88da14e 100644
--- a/gcc/testsuite/gfortran.dg/large_real_kind_form_io_2.f90
+++ b/gcc/testsuite/gfortran.dg/large_real_kind_form_io_2.f90
@@ -12,24 +12,24 @@  program large_real_kind_form_io_2
   b(:) = huge(0.0_k)
   write (tmp, *) b
   read (tmp, *) a, c
-  if (a /= b(1)) call abort ()
-  if (c /= b(2)) call abort ()
+  if (abs((a - b(1)) / b(1)) > 1e-5) call abort ()
+  if (abs((c - b(2)) / b(2)) > 1e-5) call abort ()
 
   b(:) = -huge(0.0_k)
   write (tmp, *) b
   read (tmp, *) a, c
-  if (a /= b(1)) call abort ()
-  if (c /= b(2)) call abort ()
+  if (abs((a - b(1)) / b(1)) > 1e-5) call abort ()
+  if (abs((c - b(2)) / b(2)) > 1e-5) call abort ()
 
   b(:) = nearest(tiny(0.0_k),1.0_k)
   write (tmp, *) b
   read (tmp, *) a, c
-  if (a /= b(1)) call abort ()
-  if (c /= b(2)) call abort ()
+  if (abs((a - b(1)) / b(1)) > 1e-5) call abort ()
+  if (abs((c - b(2)) / b(2)) > 1e-5) call abort ()
 
   b(:) = nearest(-tiny(0.0_k),-1.0_k)
   write (tmp, *) b
   read (tmp, *) a, c
-  if (a /= b(1)) call abort ()
-  if (c /= b(2)) call abort ()
+  if (abs((a - b(1)) / b(1)) > 1e-5) call abort ()
+  if (abs((c - b(2)) / b(2)) > 1e-5) call abort ()
 end program large_real_kind_form_io_2
diff --git a/gcc/testsuite/gfortran.dg/namelist_65.f90 b/gcc/testsuite/gfortran.dg/namelist_65.f90
index 7efbe70..e9be7b2 100644
--- a/gcc/testsuite/gfortran.dg/namelist_65.f90
+++ b/gcc/testsuite/gfortran.dg/namelist_65.f90
@@ -14,9 +14,9 @@  enddo
 
 write(out,nl1)
 if (out(1).ne."&NL1") call abort
-if (out(2).ne." A=  1.00000000    ,") call abort
-if (out(3).ne." B=  2.00000000    ,") call abort
-if (out(4).ne." C=  3.00000000    ,") call abort
+if (out(2).ne." A=  1.00000    ,") call abort
+if (out(3).ne." B=  2.00000    ,") call abort
+if (out(4).ne." C=  3.00000    ,") call abort
 if (out(5).ne." /") call abort
 
 end program oneline
diff --git a/gcc/testsuite/gfortran.dg/namelist_print_1.f b/gcc/testsuite/gfortran.dg/namelist_print_1.f
index 2e5de83..ce64558 100644
--- a/gcc/testsuite/gfortran.dg/namelist_print_1.f
+++ b/gcc/testsuite/gfortran.dg/namelist_print_1.f
@@ -9,5 +9,5 @@ 
       namelist /mynml/ x
       x = 1
 ! ( dg-output "^" }
-      print mynml ! { dg-output "&MYNML(\n|\r\n|\r) X=  1.00000000    ,(\n|\r\n|\r) /(\n|\r\n|\r)" }
+      print mynml ! { dg-output "&MYNML(\n|\r\n|\r) X=  1.00000    ,(\n|\r\n|\r) /(\n|\r\n|\r)" }
       end
diff --git a/gcc/testsuite/gfortran.dg/quad_2.f90 b/gcc/testsuite/gfortran.dg/quad_2.f90
index d3c90a0..eed6d6c 100644
--- a/gcc/testsuite/gfortran.dg/quad_2.f90
+++ b/gcc/testsuite/gfortran.dg/quad_2.f90
@@ -13,53 +13,52 @@  program test_qp
    implicit none
    integer, parameter :: QP = real_kinds(ubound(real_kinds,dim=1))
    real(qp) :: fp1, fp2, fp3, fp4
-   character(len=80) :: str1, str2, str3, str4
+   character(len=80) :: str2, str4, fmt
+
+   select case (qp)
+      case (8)
+         fmt = '(g0.17)'
+      case (10)
+         fmt = '(g0.21)'
+      case (16)
+         fmt = '(g0.36)'
+      case default
+         call abort()
+   end select
+
    fp1 = 1
    fp2 = sqrt (2.0_qp)
-   write (str1,*) fp1
-   write (str2,'(g0)') fp1
-   write (str3,*) fp2
-   write (str4,'(g0)') fp2
+   write (str2, fmt) fp1
+   write (str4, fmt) fp2
 
 !   print '(3a)', '>',trim(str1),'<'
 !   print '(3a)', '>',trim(str2),'<'
 !   print '(3a)', '>',trim(str3),'<'
 !   print '(3a)', '>',trim(str4),'<'
 
-   read (str1, *) fp3
-   if (fp1 /= fp3) call abort()
    read (str2, *) fp3
    if (fp1 /= fp3) call abort()
-   read (str3, *) fp4
-   if (fp2 /= fp4) call abort()
    read (str4, *) fp4
    if (fp2 /= fp4) call abort()
 
    select case (qp)
      case (8)
-       if (str1 /= "   1.0000000000000000") call abort()
        if (str2 /= "1.0000000000000000") call abort()
-       if (str3 /= "   1.4142135623730951") call abort()
        if (str4 /= "1.4142135623730951") call abort()
 
      case (10)
-       if (str1 /= "   1.00000000000000000000") call abort()
        if (str2 /= "1.00000000000000000000") call abort()
-       if (str3 /= "   1.41421356237309504876") call abort()
        if (str4 /= "1.41421356237309504876") call abort()
 
      case (16)
-       if (str1 /= "   1.00000000000000000000000000000000000") call abort()
        if (str2 /= "1.00000000000000000000000000000000000") call abort()
 
        if (digits(1.0_qp) == 113) then
          ! IEEE 754 binary 128 format
          ! e.g. libquadmath/__float128 on i686/x86_64/ia64
-         if (str3 /= "   1.41421356237309504880168872420969798") call abort()
          if (str4 /= "1.41421356237309504880168872420969798") call abort()
        else if (digits(1.0_qp) == 106) then
          ! IBM binary 128 format
-         if (str3(1:37) /= "   1.41421356237309504880168872420969") call abort()
          if (str4(1:34) /= "1.41421356237309504880168872420969") call abort()
        end if
 
diff --git a/gcc/testsuite/gfortran.dg/real_const_3.f90 b/gcc/testsuite/gfortran.dg/real_const_3.f90
index e4b5de7..6162191 100644
--- a/gcc/testsuite/gfortran.dg/real_const_3.f90
+++ b/gcc/testsuite/gfortran.dg/real_const_3.f90
@@ -42,15 +42,15 @@  program main
   if (trim(adjustl(str)) .ne. 'NaN') call abort
 
   write(str,*) z
-  if (trim(adjustl(str)) .ne. '(             NaN,             NaN)') call abort
+  if (trim(adjustl(str)) .ne. '(          NaN,          NaN)') call abort
 
   write(str,*) z2
-  if (trim(adjustl(str)) .ne. '(             NaN,             NaN)') call abort
+  if (trim(adjustl(str)) .ne. '(          NaN,          NaN)') call abort
 
   write(str,*) z3
-  if (trim(adjustl(str)) .ne. '(        Infinity,       -Infinity)') call abort
+  if (trim(adjustl(str)) .ne. '(     Infinity,    -Infinity)') call abort
 
   write(str,*) z4
-  if (trim(adjustl(str)) .ne. '(  0.00000000    , -0.00000000    )') call abort
+  if (trim(adjustl(str)) .ne. '(  0.00000    , -0.00000    )') call abort
 
 end program main
diff --git a/libgcc/configure b/libgcc/configure
old mode 100644
new mode 100755
diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c
index 8be3a5a..1af7080 100644
--- a/libgfortran/io/write.c
+++ b/libgfortran/io/write.c
@@ -1421,45 +1421,40 @@  static void
 set_fnode_default (st_parameter_dt *dtp, fnode *f, int length)
 {
   f->format = FMT_G;
+  f->u.real.d = 6;
+
   switch (length)
     {
     case 4:
-      f->u.real.w = 16;
-      f->u.real.d = 9;
       f->u.real.e = 2;
       break;
     case 8:
-      f->u.real.w = 25;
-      f->u.real.d = 17;
       f->u.real.e = 3;
       break;
     case 10:
-      f->u.real.w = 30;
-      f->u.real.d = 21;
-      f->u.real.e = 4;
-      break;
     case 16:
-      f->u.real.w = 45;
-      f->u.real.d = 36;
       f->u.real.e = 4;
       break;
     default:
       internal_error (&dtp->common, "bad real kind");
       break;
     }
+
+  /* 5 extra characters: Initial sign, digit before decimal, decimal,
+     exponent character, exponent sign.  */
+  f->u.real.w = f->u.real.d + f->u.real.e + 5;
 }
 
-/* Output a real number with default format.  To guarantee that a
-   binary -> decimal -> binary roundtrip conversion recovers the
-   original value, IEEE 754-2008 requires 9, 17, 21 and 36 significant
-   digits for REAL kinds 4, 8, 10, and 16, respectively. Thus, we use
-   1PG16.9E2 for REAL(4), 1PG25.17E3 for REAL(8), 1PG30.21E4 for
-   REAL(10) and 1PG45.36E4 for REAL(16). The exception is that the
-   Fortran standard requires outputting an extra digit when the scale
-   factor is 1 and when the magnitude of the value is such that E
-   editing is used. However, gfortran compensates for this, and thus
-   for list formatted the same number of significant digits is
-   generated both when using F and E editing.  */
+
+/* Output a real number with default format, used by list formatted
+   output. We use a scale factor of 1, meaning that when the magnitude
+   is such that E editing is used, there is one digit before the
+   decimal point. The Fortran standard requires outputting an extra
+   digit when the scale factor is 1 and when the magnitude of the
+   value is such that E editing is used. However, gfortran compensates
+   for this, and thus for list formatted the same number of
+   significant digits is generated both when using F and E
+   editing.  */
 
 void
 write_real (st_parameter_dt *dtp, const char *source, int length)