1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
|
! { dg-do run }
! { dg-options "-fdump-tree-original" }
! Test that minloc and maxloc using KINDs return the right
! kind, by using unformatted I/O for a specific kind.
program main
implicit none
real, dimension(3) :: a
integer :: r1, r2, r4, r8
integer :: k
character(len=30) :: l1, l2
! Check via I/O if the KIND is used correctly
a = [ 1.0, 3.0, 2.0]
write (unit=l1,fmt=*) 2_1
write (unit=l2,fmt=*) maxloc(a,kind=1)
if (l1 /= l2) STOP 1
write (unit=l1,fmt=*) 2_2
write (unit=l2,fmt=*) maxloc(a,kind=2)
if (l1 /= l2) STOP 2
write (unit=l1,fmt=*) 2_4
write (unit=l2,fmt=*) maxloc(a,kind=4)
if (l1 /= l2) STOP 3
write (unit=l1,fmt=*) 2_8
write (unit=l2,fmt=*) maxloc(a,kind=8)
if (l1 /= l2) STOP 4
a = [ 3.0, -1.0, 2.0]
write (unit=l1,fmt=*) 2_1
write (unit=l2,fmt=*) minloc(a,kind=1)
if (l1 /= l2) STOP 5
write (unit=l1,fmt=*) 2_2
write (unit=l2,fmt=*) minloc(a,kind=2)
if (l1 /= l2) STOP 6
write (unit=l1,fmt=*) 2_4
write (unit=l2,fmt=*) minloc(a,kind=4)
if (l1 /= l2) STOP 7
write (unit=l1,fmt=*) 2_8
write (unit=l2,fmt=*) minloc(a,kind=8)
if (l1 /= l2) STOP 8
end program main
|
