TREX/qmckl
1
0
Fork 0
mirror of https://github.com/TREX-CoE/qmckl.git synced 2024-07-16 08:00:43 +02:00
Code Issues Projects Releases Wiki Activity

All tests fixed

Browse Source
This commit is contained in:
Anthony Scemama 2021-03-19 00:10:35 +01:00
parent 676d5867bd
commit 8c7a1df382
2 changed files with 45 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
src/qmckl_ao.org
View File

@ -485,7 +485,6 @@ integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C)
Y(:) = X(:) - R(:) Y(:) = X(:) - R(:)
lmax = 4; lmax = 4;
n = 0;
ldl = 3; ldl = 3;
ldv = 100; ldv = 100;
@ -495,23 +494,26 @@ integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C)
test_qmckl_ao_polynomial_vgl = & test_qmckl_ao_polynomial_vgl = &
qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv) qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv)
if (test_qmckl_ao_polynomial_vgl /= 0) return
test_qmckl_ao_polynomial_vgl = -1 if (test_qmckl_ao_polynomial_vgl /= QMCKL_INVALID_ARG_5) return
if (n /= d) return n=d
test_qmckl_ao_polynomial_vgl = &
qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv)
if (test_qmckl_ao_polynomial_vgl /= QMCKL_SUCCESS) return
do j=1,n do j=1,n
test_qmckl_ao_polynomial_vgl = -11 test_qmckl_ao_polynomial_vgl = QMCKL_FAILURE
do i=1,3 do i=1,3
if (L(i,j) < 0) return if (L(i,j) < 0) return
end do end do
test_qmckl_ao_polynomial_vgl = -12 test_qmckl_ao_polynomial_vgl = QMCKL_FAILURE
if (dabs(1.d0 - VGL(1,j) / (& if (dabs(1.d0 - VGL(1,j) / (&
Y(1)**L(1,j) * Y(2)**L(2,j) * Y(3)**L(3,j) & Y(1)**L(1,j) * Y(2)**L(2,j) * Y(3)**L(3,j) &
)) > epsilon ) return )) > epsilon ) return
test_qmckl_ao_polynomial_vgl = -13 test_qmckl_ao_polynomial_vgl = QMCKL_FAILURE
if (L(1,j) < 1) then if (L(1,j) < 1) then
if (VGL(2,j) /= 0.d0) return if (VGL(2,j) /= 0.d0) return
else else
@ -520,7 +522,7 @@ integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C)
)) > epsilon ) return )) > epsilon ) return
end if end if
test_qmckl_ao_polynomial_vgl = -14 test_qmckl_ao_polynomial_vgl = QMCKL_FAILURE
if (L(2,j) < 1) then if (L(2,j) < 1) then
if (VGL(3,j) /= 0.d0) return if (VGL(3,j) /= 0.d0) return
else else
@ -529,7 +531,7 @@ integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C)
)) > epsilon ) return )) > epsilon ) return
end if end if
test_qmckl_ao_polynomial_vgl = -15 test_qmckl_ao_polynomial_vgl = QMCKL_FAILURE
if (L(3,j) < 1) then if (L(3,j) < 1) then
if (VGL(4,j) /= 0.d0) return if (VGL(4,j) /= 0.d0) return
else else
@ -538,7 +540,7 @@ integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C)
)) > epsilon ) return )) > epsilon ) return
end if end if
test_qmckl_ao_polynomial_vgl = -16 test_qmckl_ao_polynomial_vgl = QMCKL_FAILURE
w = 0.d0 w = 0.d0
if (L(1,j) > 1) then if (L(1,j) > 1) then
w = w + L(1,j) * (L(1,j)-1) * Y(1)**(L(1,j)-2) * Y(2)**L(2,j) * Y(3)**L(3,j) w = w + L(1,j) * (L(1,j)-1) * Y(1)**(L(1,j)-2) * Y(2)**L(2,j) * Y(3)**L(3,j)
@ -552,7 +554,7 @@ integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C)
if (dabs(1.d0 - VGL(5,j) / w) > epsilon ) return if (dabs(1.d0 - VGL(5,j) / w) > epsilon ) return
end do end do
test_qmckl_ao_polynomial_vgl = 0 test_qmckl_ao_polynomial_vgl = QMCKL_SUCCESS
deallocate(L,VGL) deallocate(L,VGL)
end function test_qmckl_ao_polynomial_vgl end function test_qmckl_ao_polynomial_vgl

50
src/qmckl_distance.org
View File

@ -21,16 +21,13 @@ MunitResult test_<<filename()>>() {
* Squared distance * Squared distance
** ~qmckl_distance_sq~ ~qmckl_distance_sq~ computes the matrix of the squared distances
between all pairs of points in two sets, one point within each set:
Computes the matrix of the squared distances between all pairs of
points in two sets, one point within each set:
\[ \[
C_{ij} = \sum_{k=1}^3 (A_{k,i}-B_{k,j})^2 C_{ij} = \sum_{k=1}^3 (A_{k,i}-B_{k,j})^2
\] \]
*** Arguments
| ~context~ | input | Global state | | ~context~ | input | Global state |
| ~transa~ | input | Array ~A~ is ~N~: Normal, ~T~: Transposed | | ~transa~ | input | Array ~A~ is ~N~: Normal, ~T~: Transposed |
| ~transb~ | input | Array ~B~ is ~N~: Normal, ~T~: Transposed | | ~transb~ | input | Array ~B~ is ~N~: Normal, ~T~: Transposed |
@ -74,6 +71,7 @@ qmckl_exit_code qmckl_distance_sq(const qmckl_context context,
*** Source *** Source
#+begin_src f90 :tangle (eval f) #+begin_src f90 :tangle (eval f)
integer function qmckl_distance_sq_f(context, transa, transb, m, n, A, LDA, B, LDB, C, LDC) result(info) integer function qmckl_distance_sq_f(context, transa, transb, m, n, A, LDA, B, LDB, C, LDC) result(info)
use qmckl
implicit none implicit none
integer*8 , intent(in) :: context integer*8 , intent(in) :: context
character , intent(in) :: transa, transb character , intent(in) :: transa, transb
@ -91,18 +89,18 @@ integer function qmckl_distance_sq_f(context, transa, transb, m, n, A, LDA, B, L
info = 0 info = 0
if (context == 0_8) then if (context == QMCKL_NULL_CONTEXT) then
info = -1 info = QMCKL_INVALID_CONTEXT
return return
endif endif
if (m <= 0_8) then if (m <= 0_8) then
info = -2 info = QMCKL_INVALID_ARG_4
return return
endif endif
if (n <= 0_8) then if (n <= 0_8) then
info = -3 info = QMCKL_INVALID_ARG_5
return return
endif endif
@ -123,27 +121,27 @@ integer function qmckl_distance_sq_f(context, transa, transb, m, n, A, LDA, B, L
endif endif
if (transab < 0) then if (transab < 0) then
info = -4 info = QMCKL_INVALID_ARG_1
return return
endif endif
if (iand(transab,1) == 0 .and. LDA < 3) then if (iand(transab,1) == 0 .and. LDA < 3) then
info = -5 info = QMCKL_INVALID_ARG_7
return return
endif endif
if (iand(transab,1) == 1 .and. LDA < m) then if (iand(transab,1) == 1 .and. LDA < m) then
info = -6 info = QMCKL_INVALID_ARG_7
return return
endif endif
if (iand(transab,2) == 0 .and. LDA < 3) then if (iand(transab,2) == 0 .and. LDA < 3) then
info = -6 info = QMCKL_INVALID_ARG_7
return return
endif endif
if (iand(transab,2) == 2 .and. LDA < m) then if (iand(transab,2) == 2 .and. LDA < m) then
info = -7 info = QMCKL_INVALID_ARG_7
return return
endif endif
@ -270,13 +268,19 @@ integer(c_int32_t) function test_qmckl_distance_sq(context) bind(C)
end do end do
end do end do
test_qmckl_distance_sq = qmckl_distance_sq(context, 'X', 't', m, n, A, LDA, B, LDB, C, LDC) test_qmckl_distance_sq = &
qmckl_distance_sq(context, 'X', 't', m, n, A, LDA, B, LDB, C, LDC)
if (test_qmckl_distance_sq == 0) return if (test_qmckl_distance_sq == 0) return
test_qmckl_distance_sq = qmckl_distance_sq(context, 't', 'X', m, n, A, LDA, B, LDB, C, LDC) test_qmckl_distance_sq = &
qmckl_distance_sq(context, 't', 'X', m, n, A, LDA, B, LDB, C, LDC)
if (test_qmckl_distance_sq == 0) return if (test_qmckl_distance_sq == 0) return
test_qmckl_distance_sq = qmckl_distance_sq(context, 'T', 't', m, n, A, LDA, B, LDB, C, LDC) test_qmckl_distance_sq = &
qmckl_distance_sq(context, 'T', 't', m, n, A, LDA, B, LDB, C, LDC)
if (test_qmckl_distance_sq /= 0) return if (test_qmckl_distance_sq /= 0) return
test_qmckl_distance_sq = -1 test_qmckl_distance_sq = -1
@ -290,7 +294,9 @@ integer(c_int32_t) function test_qmckl_distance_sq(context) bind(C)
end do end do
end do end do
test_qmckl_distance_sq = qmckl_distance_sq(context, 'n', 'T', m, n, A, LDA, B, LDB, C, LDC) test_qmckl_distance_sq = &
qmckl_distance_sq(context, 'n', 'T', m, n, A, LDA, B, LDB, C, LDC)
if (test_qmckl_distance_sq /= 0) return if (test_qmckl_distance_sq /= 0) return
test_qmckl_distance_sq = -1 test_qmckl_distance_sq = -1
@ -304,7 +310,9 @@ integer(c_int32_t) function test_qmckl_distance_sq(context) bind(C)
end do end do
end do end do
test_qmckl_distance_sq = qmckl_distance_sq(context, 'T', 'n', m, n, A, LDA, B, LDB, C, LDC) test_qmckl_distance_sq = &
qmckl_distance_sq(context, 'T', 'n', m, n, A, LDA, B, LDB, C, LDC)
if (test_qmckl_distance_sq /= 0) return if (test_qmckl_distance_sq /= 0) return
test_qmckl_distance_sq = -1 test_qmckl_distance_sq = -1
@ -318,7 +326,9 @@ integer(c_int32_t) function test_qmckl_distance_sq(context) bind(C)
end do end do
end do end do
test_qmckl_distance_sq = qmckl_distance_sq(context, 'n', 'N', m, n, A, LDA, B, LDB, C, LDC) test_qmckl_distance_sq = &
qmckl_distance_sq(context, 'n', 'N', m, n, A, LDA, B, LDB, C, LDC)
if (test_qmckl_distance_sq /= 0) return if (test_qmckl_distance_sq /= 0) return
test_qmckl_distance_sq = -1 test_qmckl_distance_sq = -1