2020-10-22 00:50:07 +02:00
|
|
|
# -*- mode: org -*-
|
|
|
|
# vim: syntax=c
|
|
|
|
#+TITLE: Computation of distances
|
|
|
|
|
2020-10-22 01:24:14 +02:00
|
|
|
#+HTML_HEAD: <link rel="stylesheet" type="text/css" href="http://www.pirilampo.org/styles/readtheorg/css/htmlize.css"/>
|
|
|
|
#+HTML_HEAD: <link rel="stylesheet" type="text/css" href="http://www.pirilampo.org/styles/readtheorg/css/readtheorg.css"/>
|
|
|
|
#+HTML_HEAD: <script src="https://ajax.googleapis.com/ajax/libs/jquery/2.1.3/jquery.min.js"></script>
|
|
|
|
#+HTML_HEAD: <script src="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.4/js/bootstrap.min.js"></script>
|
|
|
|
#+HTML_HEAD: <script type="text/javascript" src="http://www.pirilampo.org/styles/lib/js/jquery.stickytableheaders.js"></script>
|
|
|
|
#+HTML_HEAD: <script type="text/javascript" src="http://www.pirilampo.org/styles/readtheorg/js/readtheorg.js"></script>
|
|
|
|
|
2020-10-22 00:50:07 +02:00
|
|
|
Function for the computation of distances between particles.
|
|
|
|
|
|
|
|
3 files are produced:
|
2020-10-22 01:24:14 +02:00
|
|
|
- a header file : =qmckl_distance.h=
|
|
|
|
- a source file : =qmckl_distance.f90=
|
|
|
|
- a test file : =test_qmckl_distance.c=
|
2020-10-22 00:50:07 +02:00
|
|
|
|
2020-10-25 15:16:02 +01:00
|
|
|
*** Header :noexport:
|
2020-10-22 00:50:07 +02:00
|
|
|
#+BEGIN_SRC C :comments link :tangle qmckl_distance.h
|
|
|
|
#ifndef QMCKL_DISTANCE_H
|
|
|
|
#define QMCKL_DISTANCE_H
|
|
|
|
#include "qmckl_context.h"
|
|
|
|
#+END_SRC
|
|
|
|
|
2020-10-25 15:16:02 +01:00
|
|
|
*** Source :noexport:
|
2020-10-22 00:50:07 +02:00
|
|
|
#+BEGIN_SRC f90 :comments link :tangle qmckl_distance.f90
|
|
|
|
#+END_SRC
|
|
|
|
|
2020-10-25 15:16:02 +01:00
|
|
|
*** Test :noexport:
|
2020-10-22 00:50:07 +02:00
|
|
|
#+BEGIN_SRC C :comments link :tangle test_qmckl_distance.c
|
|
|
|
#include <math.h>
|
|
|
|
#include "qmckl.h"
|
|
|
|
#include "munit.h"
|
|
|
|
MunitResult test_qmckl_distance() {
|
|
|
|
qmckl_context context;
|
|
|
|
context = qmckl_context_create();
|
|
|
|
|
|
|
|
#+END_SRC
|
|
|
|
|
|
|
|
|
|
|
|
* Squared distance
|
|
|
|
|
|
|
|
** =qmckl_distance_sq=
|
2020-10-22 01:24:14 +02:00
|
|
|
|
2020-10-22 00:50:07 +02:00
|
|
|
Computes the matrix of the squared distances between all pairs of
|
|
|
|
points in two sets, one point within each set:
|
|
|
|
\[
|
2020-10-22 01:24:14 +02:00
|
|
|
C_{ij} = \sum_{k=1}^3 (A_{i,k}-B_{j,k})^2
|
2020-10-22 00:50:07 +02:00
|
|
|
\]
|
2020-10-22 01:24:14 +02:00
|
|
|
|
2020-10-22 00:50:07 +02:00
|
|
|
*** Arguments
|
|
|
|
|
2020-10-25 15:02:37 +01:00
|
|
|
| =context= | input | Global state |
|
|
|
|
| =m= | input | Number of points in the first set |
|
|
|
|
| =n= | input | Number of points in the second set |
|
|
|
|
| =A(lda,3)= | input | Array containing the $m \times 3$ matrix $A$ |
|
|
|
|
| =lda= | input | Leading dimension of array =A= |
|
|
|
|
| =B(ldb,3)= | input | Array containing the $n \times 3$ matrix $B$ |
|
|
|
|
| =ldb= | input | Leading dimension of array =B= |
|
|
|
|
| =C(ldc,n)= | output | Array containing the $m \times n$ matrix $C$ |
|
|
|
|
| =ldc= | input | Leading dimension of array =C= |
|
2020-10-22 00:50:07 +02:00
|
|
|
|
|
|
|
*** Requirements
|
|
|
|
|
|
|
|
- =context= is not 0
|
|
|
|
- =m= > 0
|
|
|
|
- =n= > 0
|
2020-10-25 15:02:37 +01:00
|
|
|
- =lda= >= m
|
|
|
|
- =ldb= >= n
|
|
|
|
- =ldc= >= m
|
2020-10-22 00:50:07 +02:00
|
|
|
- =A= is allocated with at least $3 \times m \times 8$ bytes
|
|
|
|
- =B= is allocated with at least $3 \times n \times 8$ bytes
|
|
|
|
- =C= is allocated with at least $m \times n \times 8$ bytes
|
|
|
|
|
|
|
|
*** Header
|
|
|
|
#+BEGIN_SRC C :comments link :tangle qmckl_distance.h
|
2020-10-22 01:24:14 +02:00
|
|
|
qmckl_exit_code qmckl_distance_sq(qmckl_context context,
|
2020-10-22 00:50:07 +02:00
|
|
|
int64_t m, int64_t n,
|
2020-10-25 15:02:37 +01:00
|
|
|
double *A, int64_t lda,
|
|
|
|
double *B, int64_t ldb,
|
|
|
|
double *C, int64_t ldc);
|
2020-10-22 00:50:07 +02:00
|
|
|
#+END_SRC
|
|
|
|
|
|
|
|
*** Source
|
|
|
|
#+BEGIN_SRC f90 :comments link :tangle qmckl_distance.f90
|
2020-10-25 15:02:37 +01:00
|
|
|
integer function qmckl_distance_sq_f(context, m, n, A, LDA, B, LDB, C, LDC) result(info)
|
2020-10-22 00:50:07 +02:00
|
|
|
implicit none
|
2020-10-25 15:02:37 +01:00
|
|
|
integer*8 , intent(in) :: context
|
|
|
|
integer*8 , intent(in) :: m, n
|
|
|
|
integer*8 , intent(in) :: lda
|
|
|
|
real*8 , intent(in) :: A(lda,3)
|
|
|
|
integer*8 , intent(in) :: ldb
|
|
|
|
real*8 , intent(in) :: B(ldb,3)
|
|
|
|
integer*8 , intent(in) :: ldc
|
|
|
|
real*8 , intent(out) :: C(ldc,n)
|
|
|
|
|
|
|
|
integer*8 :: i,j
|
|
|
|
real*8 :: x, y, z
|
2020-10-22 01:24:14 +02:00
|
|
|
|
2020-10-22 00:50:07 +02:00
|
|
|
info = 0
|
2020-10-22 01:24:14 +02:00
|
|
|
|
2020-10-22 00:50:07 +02:00
|
|
|
if (context == 0_8) then
|
|
|
|
info = -1
|
|
|
|
return
|
|
|
|
endif
|
2020-10-22 01:24:14 +02:00
|
|
|
|
2020-10-22 00:50:07 +02:00
|
|
|
if (m <= 0_8) then
|
|
|
|
info = -2
|
|
|
|
return
|
|
|
|
endif
|
2020-10-22 01:24:14 +02:00
|
|
|
|
2020-10-22 00:50:07 +02:00
|
|
|
if (n <= 0_8) then
|
|
|
|
info = -3
|
|
|
|
return
|
|
|
|
endif
|
2020-10-22 01:24:14 +02:00
|
|
|
|
2020-10-22 00:50:07 +02:00
|
|
|
if (LDA < m) then
|
|
|
|
info = -4
|
|
|
|
return
|
|
|
|
endif
|
2020-10-22 01:24:14 +02:00
|
|
|
|
2020-10-22 00:50:07 +02:00
|
|
|
if (LDB < n) then
|
|
|
|
info = -5
|
|
|
|
return
|
|
|
|
endif
|
2020-10-22 01:24:14 +02:00
|
|
|
|
2020-10-22 00:50:07 +02:00
|
|
|
if (LDC < m) then
|
|
|
|
info = -6
|
|
|
|
return
|
|
|
|
endif
|
2020-10-22 01:24:14 +02:00
|
|
|
|
2020-10-22 00:50:07 +02:00
|
|
|
do j=1,n
|
|
|
|
do i=1,m
|
|
|
|
x = A(i,1) - B(j,1)
|
|
|
|
y = A(i,2) - B(j,2)
|
|
|
|
z = A(i,3) - B(j,3)
|
|
|
|
C(i,j) = x*x + y*y + z*z
|
|
|
|
end do
|
|
|
|
end do
|
2020-10-22 01:24:14 +02:00
|
|
|
|
2020-10-25 15:02:37 +01:00
|
|
|
end function qmckl_distance_sq_f
|
2020-10-25 15:25:15 +01:00
|
|
|
#+END_SRC
|
2020-10-25 15:02:37 +01:00
|
|
|
|
2020-10-26 18:24:23 +01:00
|
|
|
*** C interface :noexport:
|
2020-10-25 15:25:15 +01:00
|
|
|
#+BEGIN_SRC f90 :comments link :tangle qmckl_distance.f90
|
2020-10-25 15:02:37 +01:00
|
|
|
integer(c_int32_t) function qmckl_distance_sq(context, m, n, A, LDA, B, LDB, C, LDC) &
|
|
|
|
bind(C) result(info)
|
|
|
|
use, intrinsic :: iso_c_binding
|
|
|
|
implicit none
|
|
|
|
integer (c_int64_t) , intent(in) , value :: context
|
|
|
|
integer (c_int64_t) , intent(in) , value :: m, n
|
|
|
|
integer (c_int64_t) , intent(in) , value :: lda
|
|
|
|
real (c_double) , intent(in) :: A(lda,3)
|
|
|
|
integer (c_int64_t) , intent(in) , value :: ldb
|
|
|
|
real (c_double) , intent(in) :: B(ldb,3)
|
|
|
|
integer (c_int64_t) , intent(in) , value :: ldc
|
|
|
|
real (c_double) , intent(out) :: C(ldc,n)
|
|
|
|
|
|
|
|
integer, external :: qmckl_distance_sq_f
|
|
|
|
info = qmckl_distance_sq_f(context, m, n, A, LDA, B, LDB, C, LDC)
|
2020-10-22 00:50:07 +02:00
|
|
|
end function qmckl_distance_sq
|
|
|
|
#+END_SRC
|
|
|
|
|
2020-10-25 15:16:02 +01:00
|
|
|
*** Test :noexport:
|
2020-10-26 18:24:23 +01:00
|
|
|
#+BEGIN_SRC f90 :comments link :tangle test_qmckl_distance_f.f90
|
|
|
|
integer(c_int32_t) function test_qmckl_distance_sq(context) bind(C)
|
|
|
|
use iso_c_binding
|
|
|
|
implicit none
|
|
|
|
integer(c_int64_t), intent(in), value :: context
|
|
|
|
|
|
|
|
double precision, allocatable :: A(:,:), B(:,:), C(:,:)
|
|
|
|
integer*8 :: m, n, LDA, LDB, LDC
|
|
|
|
double precision :: x
|
|
|
|
integer*8 :: i,j
|
|
|
|
|
|
|
|
integer, external :: qmckl_distance_sq_f
|
|
|
|
|
|
|
|
m = 5
|
|
|
|
n = 6
|
|
|
|
LDA = 6
|
|
|
|
LDB = 10
|
|
|
|
LDC = 5
|
|
|
|
|
|
|
|
allocate( A(LDA,3), B(LDB,3), C(LDC,n) )
|
|
|
|
|
|
|
|
do j=1,3
|
|
|
|
do i=1,m
|
|
|
|
A(i,j) = -10.d0 + dble(i+j)
|
|
|
|
end do
|
|
|
|
do i=1,n
|
|
|
|
B(i,j) = -1.d0 + dble(i*j)
|
|
|
|
end do
|
|
|
|
end do
|
|
|
|
|
|
|
|
test_qmckl_distance_sq = qmckl_distance_sq_f(context, m, n, A, LDA, B, LDB, C, LDC)
|
|
|
|
if (test_qmckl_distance_sq /= 0) return
|
|
|
|
|
|
|
|
test_qmckl_distance_sq = -1
|
|
|
|
|
|
|
|
do j=1,n
|
|
|
|
do i=1,m
|
|
|
|
x = (A(i,1)-B(j,1))**2 + &
|
|
|
|
(A(i,2)-B(j,2))**2 + &
|
|
|
|
(A(i,3)-B(j,3))**2
|
|
|
|
if ( dabs(1.d0 - C(i,j)/x) > 1.d-12 ) return
|
|
|
|
end do
|
|
|
|
end do
|
|
|
|
test_qmckl_distance_sq = 0
|
|
|
|
|
|
|
|
deallocate(A,B,C)
|
|
|
|
end function test_qmckl_distance_sq
|
|
|
|
#+END_SRC
|
2020-10-22 00:50:07 +02:00
|
|
|
|
2020-10-26 18:24:23 +01:00
|
|
|
#+BEGIN_SRC C :comments link :tangle test_qmckl_distance.c
|
|
|
|
int test_qmckl_distance_sq(qmckl_context context);
|
|
|
|
munit_assert_int(0, ==, test_qmckl_distance_sq(context));
|
2020-10-22 00:50:07 +02:00
|
|
|
#+END_SRC
|
|
|
|
* End of files
|
|
|
|
|
2020-10-25 15:16:02 +01:00
|
|
|
*** Header :noexport:
|
2020-10-22 00:50:07 +02:00
|
|
|
#+BEGIN_SRC C :comments link :tangle qmckl_distance.h
|
|
|
|
#endif
|
|
|
|
#+END_SRC
|
|
|
|
|
2020-10-25 15:16:02 +01:00
|
|
|
*** Test :noexport:
|
2020-10-22 00:50:07 +02:00
|
|
|
#+BEGIN_SRC C :comments link :tangle test_qmckl_distance.c
|
2020-10-22 01:24:14 +02:00
|
|
|
if (qmckl_context_destroy(context) != QMCKL_SUCCESS)
|
2020-10-22 00:50:07 +02:00
|
|
|
return QMCKL_FAILURE;
|
|
|
|
return MUNIT_OK;
|
2020-10-22 01:24:14 +02:00
|
|
|
}
|
2020-10-22 00:50:07 +02:00
|
|
|
|
|
|
|
#+END_SRC
|