1! Program to test MOD and MODULO intrinsics
2subroutine integertest (ops, res)
3   implicit none
4   integer, dimension(2) :: ops
5   integer, dimension(2) :: res
6
7   if ((mod(ops(1), ops(2)) .ne. res(1)) .or. &
8       (modulo(ops(1), ops(2)) .ne. res(2))) call abort
9end subroutine
10
11subroutine real4test (ops, res)
12   implicit none
13   real(kind=4), dimension(2) :: ops
14   real(kind=4), dimension(2) :: res
15
16   if (diff(mod(ops(1), ops(2)), res(1)) .or. &
17       diff(modulo(ops(1), ops(2)), res(2))) call abort
18contains
19function diff(a, b)
20  real(kind=4) :: a, b
21  logical diff
22
23  diff = (abs (a - b) .gt. abs(a * 1e-6))
24end function
25end subroutine
26
27subroutine real8test (ops, res)
28   implicit none
29   real(kind=8), dimension(2) :: ops
30   real(kind=8), dimension(2) :: res
31
32   if (diff(mod(ops(1), ops(2)), res(1)) .or. &
33       diff(modulo(ops(1), ops(2)), res(2))) call abort
34contains
35function diff(a, b)
36  real(kind=8) :: a, b
37  logical diff
38
39  diff = (abs(a - b) .gt. abs(a * 1e-6))
40end function
41end subroutine
42
43program mod_modulotest
44   implicit none
45
46   call integertest ((/8, 5/), (/3, 3/))
47   call integertest ((/-8, 5/), (/-3, 2/))
48   call integertest ((/8, -5/), (/3, -2/))
49   call integertest ((/-8, -5/), (/-3, -3/))
50   call integertest ((/ 2, -1/), (/0, 0/))
51
52   call real4test ((/3.0, 2.5/), (/0.5, 0.5/))
53   call real4test ((/-3.0, 2.5/), (/-0.5, 2.0/))
54   call real4test ((/3.0, -2.5/), (/0.5, -2.0/))
55   call real4test ((/-3.0, -2.5/), (/-0.5, -0.5/))
56   call real4test ((/ 2.0, -1.0/), (/ 0.0, 0.0 /))
57
58   call real8test ((/3.0_8, 2.5_8/), (/0.5_8, 0.5_8/))
59   call real8test ((/-3.0_8, 2.5_8/), (/-0.5_8, 2.0_8/))
60   call real8test ((/3.0_8, -2.5_8/), (/0.5_8, -2.0_8/))
61   call real8test ((/-3.0_8, -2.5_8/), (/-0.5_8, -0.5_8/))
62   call real8test ((/ 2.0_8, -1.0_8/), (/ 0.0_8, 0.0_8 /))
63
64   ! Check large numbers
65   call real4test ((/2e34, 1.0/), (/0.0, 0.0/))
66   call real4test ((/2e34, 1.5e34/), (/0.5e34, 0.5e34/))
67end program
68