|
111
|
1 ! { dg-do run }
|
|
|
2 ! { dg-require-effective-target fortran_large_real }
|
|
|
3
|
|
|
4 module testmod
|
|
|
5 integer,parameter :: k = selected_real_kind (precision (0.0_8) + 1)
|
|
|
6 contains
|
|
|
7 subroutine testoutput (a,b,length,f)
|
|
|
8 real(kind=k),intent(in) :: a
|
|
|
9 real(kind=8),intent(in) :: b
|
|
|
10 integer,intent(in) :: length
|
|
|
11 character(len=*),intent(in) :: f
|
|
|
12
|
|
|
13 character(len=length) :: ca
|
|
|
14 character(len=length) :: cb
|
|
|
15
|
|
|
16 write (ca,f) a
|
|
|
17 write (cb,f) b
|
|
131
|
18 if (ca /= cb) STOP 1
|
|
111
|
19 end subroutine testoutput
|
|
|
20
|
|
|
21 subroutine outputstring (a,f,s)
|
|
|
22 real(kind=k),intent(in) :: a
|
|
|
23 character(len=*),intent(in) :: f
|
|
|
24 character(len=*),intent(in) :: s
|
|
|
25
|
|
|
26 character(len=len(s)) :: c
|
|
|
27
|
|
|
28 write (c,f) a
|
|
131
|
29 if (c /= s) STOP 2
|
|
111
|
30 end subroutine outputstring
|
|
|
31 end module testmod
|
|
|
32
|
|
|
33
|
|
|
34 ! Testing I/O of large real kinds (larger than kind=8)
|
|
|
35 program test
|
|
|
36 use testmod
|
|
|
37 implicit none
|
|
|
38
|
|
|
39 real(kind=k) :: x
|
|
|
40 character(len=20) :: c1, c2
|
|
|
41
|
|
|
42 call testoutput (0.0_k,0.0_8,40,'(F40.35)')
|
|
|
43
|
|
|
44 call testoutput (1.0_k,1.0_8,40,'(F40.35)')
|
|
|
45 call testoutput (0.1_k,0.1_8,15,'(F15.10)')
|
|
|
46 call testoutput (1e10_k,1e10_8,15,'(F15.10)')
|
|
|
47 call testoutput (7.51e100_k,7.51e100_8,15,'(F15.10)')
|
|
|
48 call testoutput (1e-10_k,1e-10_8,15,'(F15.10)')
|
|
|
49 call testoutput (7.51e-100_k,7.51e-100_8,15,'(F15.10)')
|
|
|
50
|
|
|
51 call testoutput (-1.0_k,-1.0_8,40,'(F40.35)')
|
|
|
52 call testoutput (-0.1_k,-0.1_8,15,'(F15.10)')
|
|
|
53 call testoutput (-1e10_k,-1e10_8,15,'(F15.10)')
|
|
|
54 call testoutput (-7.51e100_k,-7.51e100_8,15,'(F15.10)')
|
|
|
55 call testoutput (-1e-10_k,-1e-10_8,15,'(F15.10)')
|
|
|
56 call testoutput (-7.51e-100_k,-7.51e-100_8,15,'(F15.10)')
|
|
|
57
|
|
|
58 x = huge(x)
|
|
|
59 call outputstring (2*x,'(F20.15)',' Infinity')
|
|
|
60 call outputstring (-2*x,'(F20.15)',' -Infinity')
|
|
|
61
|
|
|
62 write (c1,'(G20.10E5)') x
|
|
|
63 write (c2,'(G20.10E5)') -x
|
|
131
|
64 if (c2(1:1) /= '-') STOP 3
|
|
111
|
65 c2(1:1) = ' '
|
|
131
|
66 if (c1 /= c2) STOP 4
|
|
111
|
67
|
|
|
68 x = tiny(x)
|
|
|
69 call outputstring (x,'(F20.15)',' 0.000000000000000')
|
|
|
70 call outputstring (-x,'(F20.15)',' -0.000000000000000')
|
|
|
71
|
|
|
72 write (c1,'(G20.10E5)') x
|
|
|
73 write (c2,'(G20.10E5)') -x
|
|
131
|
74 if (c2(1:1) /= '-') STOP 5
|
|
111
|
75 c2(1:1) = ' '
|
|
131
|
76 if (c1 /= c2) STOP 6
|
|
111
|
77 end program test
|
