1! { dg-do run }
2! { dg-options "-fcoarray=single" }
3program rantest
4
5   implicit none
6
7   logical, parameter :: debug = .false.
8   character(len=20) name
9   integer fd, i, n
10   integer, allocatable :: n1(:), n2(:), n3(:)
11   real x(4), y(4), z(4)
12
13   if (debug) then
14      write(name,'(A,I0)') 'dat', this_image()
15      open(newunit=fd, file=name)
16   end if
17
18   call random_seed(size=n)
19   allocate(n1(n), n2(n), n3(n))
20   !
21   ! Setup repeatable sequences (if co-arrays the seeds should be distinct
22   ! are different).  Get the seeds.
23   !
24   call random_init(.true., .true.)
25   call random_seed(get=n1)
26   call random_number(x)               ! This changes internal state.
27   if (debug) then
28      write(fd,'(A,4F12.6)') 'x = ', x
29   end if
30
31   call random_seed(get=n2)            ! Grab current state.
32   !
33   ! Use the gotten seed to reseed PRNG and grab sequence.
34   ! It should be the same sequence.
35   !
36   call random_seed(put=n1)
37   call random_number(y)
38   if (debug) then
39      write(fd,'(A,4F12.6)') 'y = ', y
40   end if
41   !
42   ! Setup repeatable sequences (if co-arrays the seeds should be distinct
43   ! are different).  Get the seeds.  It should be the same sequence.
44   !
45   call random_init(.true., .true.)
46   call random_seed(get=n3)
47   call random_number(z)
48   if (debug) then
49      write(fd,'(A,4F12.6)') 'z = ', z
50   end if
51
52   x = int(1e6*x) ! Convert to integer with at most 6 digits.
53   y = int(1e6*y) ! Convert to integer with at most 6 digits.
54   z = int(1e6*z) ! Convert to integer with at most 6 digits.
55
56   if (any(x /= y)) call abort
57   if (any(x /= z)) call abort
58
59   if (debug) then
60      write(fd,*)
61      do i = 1, n
62         if (n1(i) - n2(i) /= 0) then
63            write(fd,*) 'n1 /= n2', i, n1(i), n2(i)
64         end if
65      end do
66      write(fd,*)
67      do i = 1, n
68         if (n1(i) - n3(i) /= 0) then
69            write(fd,*) 'n1 /= n3', i, n1(i), n3(i)
70         end if
71      end do
72   end if
73
74end program rantest
75