1! { dg-do run } 2! 3! I/O test for REAL(16) 4! 5! Contributed by Dominique d'Humieres 6! 7program test_qp 8 use iso_fortran_env, only: real_kinds 9 implicit none 10 integer, parameter :: QP = real_kinds(ubound(real_kinds,dim=1)) 11 real(kind=qp) :: a,b(2), c 12 integer :: exponent, i 13 character(len=180) :: tmp 14 15 ! Run this only with libquadmath; assume that all those systems 16 ! have also kind=10. 17 if (size (real_kinds) >= 4 .and. qp == 16) then 18 i = 3 19 if (real_kinds(i) /= 10) stop 20 21 exponent = 4000 22 b(:) = huge (1.0_qp)/10.0_qp**exponent 23! print *, 'real(16) big value: ', b(1) 24 write (tmp, *) b 25 read (tmp, *) a, c 26! print *, 'same value read again: ', a, c 27! print *, 'difference: looks OK now ', a-b(1) 28 if (abs (a-b(1))/a > epsilon(0.0_qp) & 29 .or. abs (c-b(1))/c > epsilon (0.0_qp)) STOP 1 30 end if 31end program test_qp 32