Based on the times for the code below, it appears that gfortran -O3 evaluates all(x==y)
very fast for large arrays and is smart enough to not evaluate the full expressions x==y
or sin(x)==sin(y)
. My loop equivalent to all(x==y)
is slower. Generating random x(:)
and setting y(:)
with merge
takes the most time. I am a little surprised at the speed of all()
, and I may need to amend a tip I posted.
module m
implicit none
private
public :: wp, all_equal
integer, parameter :: wp = kind(1.0d0)
contains
pure function all_equal(x,y) result(x_eq_y)
real(kind=wp), intent(in) :: x(:),y(:)
logical :: x_eq_y
integer :: i,n
x_eq_y = .false.
n = size(x)
if (size(y) /= n) return
do i=1,n
if (x(i) /= y(i)) return
end do
x_eq_y = .true.
end function all_equal
end module m
!
program xall_equal
use m, only: wp, all_equal
implicit none
integer, parameter :: n = 10**8, niter = 10, nt = 6
real(kind=wp) :: x(n),y(n),t(nt),dt(nt-1)
integer :: iter
logical :: tf_1,tf_2,tf_3
real(kind=wp), parameter :: frac_diff = 1.0d-5
dt = 0.0_wp
do iter=1,niter
call cpu_time(t(1))
call random_number(x) ; call cpu_time(t(2))
! set y equal to x except for the fraction frac_diff of elements
y = merge(x,2.0_wp,x>frac_diff) ; call cpu_time(t(3))
tf_1 = all_equal(x,y) ; call cpu_time(t(4))
tf_2 = all(x == y) ; call cpu_time(t(5))
! see if the compiler fully evaluates sin(x) and sin(y), which would be slow
tf_3 = all(sin(x) == sin(y)) ; call cpu_time(t(6))
if (tf_1 .neqv. tf_2 .or. tf_2 .neqv. tf_3) error stop "tf_1, tf_2, tf_3 should be equal"
dt = dt + t(2:nt) - t(1:nt-1)
end do
print "(/,'times',/,*(a12,1x))","RNG","merge","all_equal","all(x==y)","all_sin"
print "(*(f12.8,1x))",dt
end program xall_equal
output:
times
RNG merge all_equal all(x==y) all_sin
12.75000000 7.51562500 0.00000000 0.01562500 0.10937500