From 42521ba34043fe2aa226e6a53a054296528446cb Mon Sep 17 00:00:00 2001 From: Jose Alves Date: Thu, 17 Jul 2025 13:39:29 +0200 Subject: [PATCH 1/3] fix complex dot_product formulation --- src/stdlib_intrinsics_dot_product.fypp | 8 ++++---- test/intrinsics/test_intrinsics.fypp | 22 ++++++++++++++++++++++ 2 files changed, 26 insertions(+), 4 deletions(-) diff --git a/src/stdlib_intrinsics_dot_product.fypp b/src/stdlib_intrinsics_dot_product.fypp index ce6188c8a..74bb4b4de 100644 --- a/src/stdlib_intrinsics_dot_product.fypp +++ b/src/stdlib_intrinsics_dot_product.fypp @@ -34,10 +34,10 @@ pure module function stdlib_dot_product_${s}$(a,b) result(p) n = size(a,kind=ilp) r = mod(n,chunk) - abatch(1:r) = a(1:r)*${cnjg(t,'b(1:r)')}$ + abatch(1:r) = ${cnjg(t,'a(1:r)')}$*b(1:r) abatch(r+1:chunk) = zero_${s}$ do i = r+1, n-r, chunk - abatch(1:chunk) = abatch(1:chunk) + a(i:i+chunk-1)*${cnjg(t,'b(i:i+chunk-1)')}$ + abatch(1:chunk) = abatch(1:chunk) + ${cnjg(t,'a(i:i+chunk-1)')}$*b(i:i+chunk-1) end do p = zero_${s}$ @@ -60,11 +60,11 @@ pure module function stdlib_dot_product_kahan_${s}$(a,b) result(p) n = size(a,kind=ilp) r = mod(n,chunk) - abatch(1:r) = a(1:r)*${cnjg(t,'b(1:r)')}$ + abatch(1:r) = ${cnjg(t,'a(1:r)')}$*b(1:r) abatch(r+1:chunk) = zero_${s}$ cbatch = zero_${s}$ do i = r+1, n-r, chunk - call kahan_kernel( a(i:i+chunk-1)*${cnjg(t,'b(i:i+chunk-1)')}$ , abatch(1:chunk) , cbatch(1:chunk) ) + call kahan_kernel( ${cnjg(t,'a(i:i+chunk-1)')}$*b(i:i+chunk-1) , abatch(1:chunk) , cbatch(1:chunk) ) end do p = zero_${s}$ diff --git a/test/intrinsics/test_intrinsics.fypp b/test/intrinsics/test_intrinsics.fypp index 8aefe09d3..021e91bda 100644 --- a/test/intrinsics/test_intrinsics.fypp +++ b/test/intrinsics/test_intrinsics.fypp @@ -246,6 +246,28 @@ subroutine test_dot_product(error) call check(error, all(err(:) Date: Thu, 17 Jul 2025 14:02:18 +0200 Subject: [PATCH 2/3] smaller array and wider tolerance --- test/intrinsics/test_intrinsics.fypp | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/test/intrinsics/test_intrinsics.fypp b/test/intrinsics/test_intrinsics.fypp index 021e91bda..76f5b4387 100644 --- a/test/intrinsics/test_intrinsics.fypp +++ b/test/intrinsics/test_intrinsics.fypp @@ -248,13 +248,12 @@ subroutine test_dot_product(error) end block block ! test for https://github.com/fortran-lang/stdlib/issues/1016 - ${t}$, allocatable :: x(:), y(:) - real(${k}$), allocatable :: z(:,:) - real(${k}$), parameter :: tolerance = epsilon(1._${k}$)*10000 + ${t}$ :: x(128), y(128) + real(${k}$) :: z(128,2) + real(${k}$), parameter :: tolerance = epsilon(1._${k}$)*100000 real(${k}$) :: err(2) ${t}$ :: p(3) - allocate(x(n),y(n),z(n,2)) call random_number(z) x%re = z(:, 1); x%im = z(:, 2) call random_number(z) From 8dec603c786e0eea65babbd1d2dbd18183514f6d Mon Sep 17 00:00:00 2001 From: jalvesz <102541118+jalvesz@users.noreply.github.com> Date: Sat, 19 Jul 2025 14:48:11 +0200 Subject: [PATCH 3/3] Update test/intrinsics/test_intrinsics.fypp Co-authored-by: Copilot <175728472+Copilot@users.noreply.github.com> --- test/intrinsics/test_intrinsics.fypp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/intrinsics/test_intrinsics.fypp b/test/intrinsics/test_intrinsics.fypp index 76f5b4387..11cf32fdc 100644 --- a/test/intrinsics/test_intrinsics.fypp +++ b/test/intrinsics/test_intrinsics.fypp @@ -262,7 +262,7 @@ subroutine test_dot_product(error) p(1) = dot_product(x,y) ! compiler intrinsic p(2) = stdlib_dot_product_kahan(x,y) ! chunked Kahan dot_product p(3) = stdlib_dot_product(x,y) ! chunked dot_product - err(1:2) = ( abs( p(2:3)%re - p(1)%re ) + abs( p(2:3)%im - p(1)%im ) ) / 2 + err(1:2) = sqrt((p(2:3)%re - p(1)%re)**2 + (p(2:3)%im - p(1)%im)**2) call check(error, all(err(:)