Commit 2552c36

jalveszCopilot

and

authored

fix: complex dot_product formulation (#1017)

* fix complex dot_product formulation * smaller array and wider tolerance * Update test/intrinsics/test_intrinsics.fypp Co-authored-by: Copilot <175728472+Copilot@users.noreply.github.com> --------- Co-authored-by: Copilot <175728472+Copilot@users.noreply.github.com>

1 parent a2fadac commit 2552c36Copy full SHA for 2552c36

File tree

2 files changed

+25

-4

lines changed

src
- stdlib_intrinsics_dot_product.fypp
test/intrinsics
- test_intrinsics.fypp

2 files changed

+25

-4

lines changed

`‎src/stdlib_intrinsics_dot_product.fypp`

Lines changed: 4 additions & 4 deletions

Original file line number	Diff line number	Diff line change
`@@ -34,10 +34,10 @@ pure module function stdlib_dot_product_${s}$(a,b) result(p)`
`34`	`34`	`n = size(a,kind=ilp)`
`35`	`35`	`r = mod(n,chunk)`
`36`	`36`
`37`		`- abatch(1:r) = a(1:r)*${cnjg(t,'b(1:r)')}$`
	`37`	`+ abatch(1:r) = ${cnjg(t,'a(1:r)')}$*b(1:r)`
`38`	`38`	`abatch(r+1:chunk) = zero_${s}$`
`39`	`39`	`do i = r+1, n-r, chunk`
`40`		`- abatch(1:chunk) = abatch(1:chunk) + a(i:i+chunk-1)*${cnjg(t,'b(i:i+chunk-1)')}$`
	`40`	`+ abatch(1:chunk) = abatch(1:chunk) + ${cnjg(t,'a(i:i+chunk-1)')}$*b(i:i+chunk-1)`
`41`	`41`	`end do`
`42`	`42`
`43`	`43`	`p = zero_${s}$`
`@@ -60,11 +60,11 @@ pure module function stdlib_dot_product_kahan_${s}$(a,b) result(p)`
`60`	`60`	`n = size(a,kind=ilp)`
`61`	`61`	`r = mod(n,chunk)`
`62`	`62`
`63`		`- abatch(1:r) = a(1:r)*${cnjg(t,'b(1:r)')}$`
	`63`	`+ abatch(1:r) = ${cnjg(t,'a(1:r)')}$*b(1:r)`
`64`	`64`	`abatch(r+1:chunk) = zero_${s}$`
`65`	`65`	`cbatch = zero_${s}$`
`66`	`66`	`do i = r+1, n-r, chunk`
`67`		`- call kahan_kernel( a(i:i+chunk-1)*${cnjg(t,'b(i:i+chunk-1)')}$ , abatch(1:chunk) , cbatch(1:chunk) )`
	`67`	`+ call kahan_kernel( ${cnjg(t,'a(i:i+chunk-1)')}$*b(i:i+chunk-1) , abatch(1:chunk) , cbatch(1:chunk) )`
`68`	`68`	`end do`
`69`	`69`
`70`	`70`	`p = zero_${s}$`

`‎test/intrinsics/test_intrinsics.fypp`

Lines changed: 21 additions & 0 deletions

Original file line number	Diff line number	Diff line change
`@@ -246,6 +246,27 @@ subroutine test_dot_product(error)`
`246`	`246`	`call check(error, all(err(:)<tolerance) , "complex dot_product is not accurate" )`
`247`	`247`	`if (allocated(error)) return`
`248`	`248`	`end block`
	`249`	`+`
	`250`	`+ block ! test for https://github.com/fortran-lang/stdlib/issues/1016`
	`251`	`+ ${t}$ :: x(128), y(128)`
	`252`	`+ real(${k}$) :: z(128,2)`
	`253`	`+ real(${k}$), parameter :: tolerance = epsilon(1._${k}$)*100000`
	`254`	`+ real(${k}$) :: err(2)`
	`255`	`+ ${t}$ :: p(3)`
	`256`	`+`
	`257`	`+ call random_number(z)`
	`258`	`+ x%re = z(:, 1); x%im = z(:, 2)`
	`259`	`+ call random_number(z)`
	`260`	`+ y%re = z(:, 1); y%im = z(:, 2)`
	`261`	`+`
	`262`	`+ p(1) = dot_product(x,y) ! compiler intrinsic`
	`263`	`+ p(2) = stdlib_dot_product_kahan(x,y) ! chunked Kahan dot_product`
	`264`	`+ p(3) = stdlib_dot_product(x,y) ! chunked dot_product`
	`265`	`+ err(1:2) = sqrt((p(2:3)%re - p(1)%re)2 + (p(2:3)%im - p(1)%im)2)`
	`266`	`+`
	`267`	`+ call check(error, all(err(:)<tolerance) , "complex dot_product does not conform to the standard" )`
	`268`	`+ if (allocated(error)) return`
	`269`	`+ end block`
`249`	`270`	`#:endfor`
`250`	`271`
`251`	`272`	`end subroutine`

0 commit comments

Comments

(0)

Navigation Menu

Search code, repositories, users, issues, pull requests...

Provide feedback

Saved searches

Use saved searches to filter your results more quickly

Uh oh!

Commit 2552c36

File tree

2 files changed

2 files changed

`‎src/stdlib_intrinsics_dot_product.fypp`

`‎test/intrinsics/test_intrinsics.fypp`

0 commit comments