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))) STOP 1 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))) STOP 2 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))) STOP 3 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