From 150518aef09729bc2de0a7e4de5e91cc1d7da3a3 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 22 Oct 2020 00:50:07 +0200 Subject: [PATCH] Added f90 example file --- src/.gitignore | 1 + src/Makefile | 4 +- src/README.org | 9 ++ src/create_makefile.sh | 4 +- src/qmckl.org | 10 +- src/qmckl_context.org | 112 +++++++++++------------ src/qmckl_distance.org | 201 +++++++++++++++++++++++++++++++++++++++++ src/qmckl_memory.org | 12 ++- src/test_qmckl.org | 7 +- 9 files changed, 291 insertions(+), 69 deletions(-) create mode 100644 src/qmckl_distance.org diff --git a/src/.gitignore b/src/.gitignore index 2cb97cf..1ce56e6 100644 --- a/src/.gitignore +++ b/src/.gitignore @@ -1,5 +1,6 @@ *.o *.c +*.f90 *.h *~ *.so diff --git a/src/Makefile b/src/Makefile index 8b58bd5..8aa37d5 100644 --- a/src/Makefile +++ b/src/Makefile @@ -4,8 +4,10 @@ CFLAGS=-fPIC -fexceptions -Wall -Werror -Wpedantic -Wextra -g FC=gfortran FFLAGS=-fcheck=all -Waliasing -Wampersand -Wconversion -Wsurprising -Wintrinsics-std -Wno-tabs -Wintrinsic-shadow -Wline-truncation -Wreal-q-constant -Wuninitialized -fbacktrace -ffpe-trap=zero,overflow,underflow -finit-real=nan +LIBS=-lgfortran -lm -export CC CFLAGS FC FFLAGS + +export CC CFLAGS FC FFLAGS LIBS ORG_SOURCE_FILES=$(wildcard qmckl*.org) test_qmckl.org OBJECT_FILES=$(filter-out $(EXCLUDED_OBJECTS), $(patsubst %.org,%.o,$(ORG_SOURCE_FILES))) diff --git a/src/README.org b/src/README.org index 07d3de5..59666a7 100644 --- a/src/README.org +++ b/src/README.org @@ -179,11 +179,20 @@ rm ${nb}.md As QMCkl is a general purpose library, multiple algorithms should be implemented adapted to different problem sizes. + +** Rules for the API + + - =stdint= should be used for integers (=int32_t=, =int64_t=) + - integers used for counting should always be =int64_t= + - floats should be by default =double=, unless explicitly mentioned + - pointers are converted to =int64_t= to increase portability + ** Documentation - [[qmckl.org][Main QMCkl header file]] - [[qmckl_memory.org][Memory management]] - [[qmckl_context.org][Context]] +- [[qmckldistance.org][Distance]] ** Acknowledgments diff --git a/src/create_makefile.sh b/src/create_makefile.sh index e70f160..959fdc8 100755 --- a/src/create_makefile.sh +++ b/src/create_makefile.sh @@ -53,6 +53,8 @@ FFLAGS=$FFLAGS OBJECT_FILES=$OBJECTS TESTS=$TESTS +LIBS=$LIBS + libqmckl.so: \$(OBJECT_FILES) \$(CC) -shared \$(OBJECT_FILES) -o libqmckl.so @@ -65,7 +67,7 @@ libqmckl.so: \$(OBJECT_FILES) test_qmckl: test_qmckl.c libqmckl.so \$(TESTS) echo \$(TESTS) \$(CC) \$(CFLAGS) -Wl,-rpath,$PWD -L. \ - ../munit/munit.c \$(TESTS) -lqmckl test_qmckl.c -o test_qmckl + ../munit/munit.c \$(TESTS) -lqmckl \$(LIBS) test_qmckl.c -o test_qmckl test: test_qmckl ./test_qmckl diff --git a/src/qmckl.org b/src/qmckl.org index c5dedc8..f1065f5 100644 --- a/src/qmckl.org +++ b/src/qmckl.org @@ -8,6 +8,8 @@ other C header files. It is the main entry point to the library. #+BEGIN_SRC C :tangle qmckl.h #ifndef QMCKL_H #define QMCKL_H +#include +#include #+END_SRC * Constants @@ -21,7 +23,9 @@ other C header files. It is the main entry point to the library. #define QMCKL_SUCCESS 0 #define QMCKL_FAILURE 1 -typedef int qmckl_exit_code; +typedef int32_t qmckl_exit_code; +typedef int64_t qmckl_context ; + #+END_SRC @@ -42,9 +46,11 @@ typedef int qmckl_exit_code; header files. #+BEGIN_SRC C :tangle qmckl.h -#include + #include "qmckl_memory.h" #include "qmckl_context.h" + +#include "qmckl_distance.h" #+END_SRC * End of header diff --git a/src/qmckl_context.org b/src/qmckl_context.org index 37de324..a2ea884 100644 --- a/src/qmckl_context.org +++ b/src/qmckl_context.org @@ -6,11 +6,11 @@ This file is written in C because it is more natural to express the context in C than in Fortran. 3 files are produced: -- a header file : =qmckl_context.h= -- a source file : =qmckl_context.c= -- a test file : =test_qmckl_context.c= +- a header file : =qmckl_context.h= +- a source file : =qmckl_context.c= +- a test file : =test_qmckl_context.c= -*** Header +*** Header #+BEGIN_SRC C :comments link :tangle qmckl_context.h #ifndef QMCKL_CONTEXT_H #define QMCKL_CONTEXT_H @@ -24,9 +24,9 @@ C than in Fortran. *** Test #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c -#include "qmckl.h" -#include "munit.h" -MunitResult test_qmckl_context() { +#include "qmckl.h" +#include "munit.h" +MunitResult test_qmckl_context() { #+END_SRC * Context @@ -38,25 +38,19 @@ MunitResult test_qmckl_context() { into a 64-bit signed integer, defined in the =qmckl_context= type. A value of 0 for the context is equivalent to a NULL pointer. -*** Header - #+BEGIN_SRC C :comments link :tangle qmckl_context.h -/* 64-bit integer */ -typedef long long int qmckl_context ; - #+END_SRC - *** Source #+BEGIN_SRC C :comments link :tangle qmckl_context.c typedef struct qmckl_context_struct { struct qmckl_context_struct * prev; - unsigned int tag; - int precision; - int range; + uint32_t tag; + int32_t precision; + int32_t range; } qmckl_context_struct; #define VALID_TAG 0xBEEFFACE #define INVALID_TAG 0xDEADBEEF #+END_SRC - + The tag is used internally to check if the memory domain pointed by a pointer is a valid context. @@ -67,20 +61,20 @@ typedef struct qmckl_context_struct { qmckl_context new_context; #+END_SRC - + ** =qmckl_context_check= - + Checks if the domain pointed by the pointer is a valid context. Returns the input =qmckl_context= if the context is valid, 0 otherwise. *** Header #+BEGIN_SRC C :comments link :tangle qmckl_context.h -qmckl_context qmckl_context_check(qmckl_context context) ; +qmckl_context qmckl_context_check(const qmckl_context context) ; #+END_SRC - + *** Source #+BEGIN_SRC C :comments link :tangle qmckl_context.c -qmckl_context qmckl_context_check(qmckl_context context) { +qmckl_context qmckl_context_check(const qmckl_context context) { qmckl_context_struct * ctx; if (context == (qmckl_context) 0) return (qmckl_context) 0; @@ -88,10 +82,10 @@ qmckl_context qmckl_context_check(qmckl_context context) { ctx = (qmckl_context_struct*) context; if (ctx->tag != VALID_TAG) return (qmckl_context) 0; - return context; + return context; } #+END_SRC - + ** =qmckl_context_create= To create a new context, use =qmckl_context_create()=. @@ -109,7 +103,7 @@ qmckl_context qmckl_context_create() { qmckl_context_struct* context; - context = (qmckl_context_struct*) qmckl_malloc (sizeof(qmckl_context_struct)); + context = (qmckl_context_struct*) qmckl_malloc ((qmckl_context) 0, sizeof(qmckl_context_struct)); if (context == NULL) { return (qmckl_context) 0; } @@ -122,12 +116,12 @@ qmckl_context qmckl_context_create() { return (qmckl_context) context; } #+END_SRC - + *** Test #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c context = qmckl_context_create(); - munit_assert_long( context, !=, (qmckl_context) 0); - munit_assert_long( qmckl_context_check(context), ==, context); + munit_assert_int64( context, !=, (qmckl_context) 0); + munit_assert_int64( qmckl_context_check(context), ==, context); #+END_SRC ** =qmckl_context_copy= @@ -157,7 +151,7 @@ qmckl_context qmckl_context_copy(const qmckl_context context) { return (qmckl_context) 0; } - new_context = (qmckl_context_struct*) qmckl_malloc (sizeof(qmckl_context_struct)); + new_context = (qmckl_context_struct*) qmckl_malloc (context, sizeof(qmckl_context_struct)); if (new_context == NULL) { return (qmckl_context) 0; } @@ -177,13 +171,13 @@ qmckl_context qmckl_context_copy(const qmckl_context context) { *** Test #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c new_context = qmckl_context_copy(context); - munit_assert_long(new_context, !=, (qmckl_context) 0); - munit_assert_long(new_context, !=, context); - munit_assert_long(qmckl_context_check(new_context), ==, new_context); + munit_assert_int64(new_context, !=, (qmckl_context) 0); + munit_assert_int64(new_context, !=, context); + munit_assert_int64(qmckl_context_check(new_context), ==, new_context); #+END_SRC ** =qmckl_context_previous= - + Returns the previous context - On success, returns the ancestor of the current context - Returns 0 for the initial context @@ -213,20 +207,20 @@ qmckl_context qmckl_context_previous(const qmckl_context context) { *** Test #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c - munit_assert_long(qmckl_context_previous(new_context), !=, (qmckl_context) 0); - munit_assert_long(qmckl_context_previous(new_context), ==, context); - munit_assert_long(qmckl_context_previous(context), ==, (qmckl_context) 0); - munit_assert_long(qmckl_context_previous((qmckl_context) 0), ==, (qmckl_context) 0); + munit_assert_int64(qmckl_context_previous(new_context), !=, (qmckl_context) 0); + munit_assert_int64(qmckl_context_previous(new_context), ==, context); + munit_assert_int64(qmckl_context_previous(context), ==, (qmckl_context) 0); + munit_assert_int64(qmckl_context_previous((qmckl_context) 0), ==, (qmckl_context) 0); #+END_SRC ** =qmckl_context_destroy= - + Destroys the current context, leaving the ancestors untouched. - Succeeds if the current context is properly destroyed - Fails otherwise - Fails if the 0-valued context is given in argument - Fails if the the pointer is not a valid context - + *** Header #+BEGIN_SRC C :comments link :tangle qmckl_context.h qmckl_exit_code qmckl_context_destroy(qmckl_context context); @@ -238,7 +232,7 @@ qmckl_exit_code qmckl_context_destroy(qmckl_context context) { qmckl_context_struct* ctx; qmckl_context checked_context; - + checked_context = qmckl_context_check(context); if (checked_context == (qmckl_context) 0) return QMCKL_FAILURE; @@ -253,15 +247,15 @@ qmckl_exit_code qmckl_context_destroy(qmckl_context context) { *** Test #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c - munit_assert_long(qmckl_context_check(new_context), ==, new_context); - munit_assert_long(new_context, !=, (qmckl_context) 0); - munit_assert_int(qmckl_context_destroy(new_context), ==, QMCKL_SUCCESS); - munit_assert_long(qmckl_context_check(new_context), !=, new_context); - munit_assert_long(qmckl_context_check(new_context), ==, (qmckl_context) 0); - munit_assert_long(qmckl_context_destroy((qmckl_context) 0), ==, QMCKL_FAILURE); + munit_assert_int64(qmckl_context_check(new_context), ==, new_context); + munit_assert_int64(new_context, !=, (qmckl_context) 0); + munit_assert_int32(qmckl_context_destroy(new_context), ==, QMCKL_SUCCESS); + munit_assert_int64(qmckl_context_check(new_context), !=, new_context); + munit_assert_int64(qmckl_context_check(new_context), ==, (qmckl_context) 0); + munit_assert_int64(qmckl_context_destroy((qmckl_context) 0), ==, QMCKL_FAILURE); #+END_SRC - + * Precision The following functions set and get the expected required precision @@ -275,11 +269,11 @@ qmckl_exit_code qmckl_context_destroy(qmckl_context context) { ** =qmckl_context_update_precision= #+BEGIN_SRC C :comments link :tangle qmckl_context.h -qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, int precision); +qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, const int precision); #+END_SRC #+BEGIN_SRC C :comments link :tangle qmckl_context.c -qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, int precision) { +qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, const int precision) { qmckl_context_struct* ctx; if (precision < 2) return QMCKL_FAILURE; @@ -295,11 +289,11 @@ qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, int ** =qmckl_context_update_range= #+BEGIN_SRC C :comments link :tangle qmckl_context.h -qmckl_exit_code qmckl_context_update_range(const qmckl_context context, int range); +qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const int range); #+END_SRC - + #+BEGIN_SRC C :comments link :tangle qmckl_context.c -qmckl_exit_code qmckl_context_update_range(const qmckl_context context, int range) { +qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const int range) { qmckl_context_struct* ctx; if (range < 2) return QMCKL_FAILURE; @@ -318,7 +312,7 @@ qmckl_exit_code qmckl_context_update_range(const qmckl_context context, int rang ** =qmckl_context_set_precision= #+BEGIN_SRC C :comments link :tangle qmckl_context.h -qmckl_context qmckl_context_set_precision(const qmckl_context context, int precision); +qmckl_context qmckl_context_set_precision(const qmckl_context context, const int precision); #+END_SRC #+BEGIN_SRC C :comments link :tangle qmckl_context.c @@ -336,11 +330,11 @@ qmckl_context qmckl_context_set_precision(const qmckl_context context, const int ** =qmckl_context_set_range= #+BEGIN_SRC C :comments link :tangle qmckl_context.h -qmckl_context qmckl_context_set_range(const qmckl_context context, int range); +qmckl_context qmckl_context_set_range(const qmckl_context context, const int range); #+END_SRC #+BEGIN_SRC C :comments link :tangle qmckl_context.c -qmckl_context qmckl_context_set_range(const qmckl_context context, int range) { +qmckl_context qmckl_context_set_range(const qmckl_context context, const int range) { qmckl_context new_context; new_context = qmckl_context_copy(context); @@ -353,7 +347,7 @@ qmckl_context qmckl_context_set_range(const qmckl_context context, int range) { #+END_SRC - + ** =qmckl_context_get_precision= #+BEGIN_SRC C :comments link :tangle qmckl_context.h @@ -382,7 +376,7 @@ int qmckl_context_get_range(const qmckl_context context) { } #+END_SRC - + * End of files @@ -393,7 +387,7 @@ int qmckl_context_get_range(const qmckl_context context) { *** Test #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c - return MUNIT_OK; -} + return MUNIT_OK; +} #+END_SRC diff --git a/src/qmckl_distance.org b/src/qmckl_distance.org new file mode 100644 index 0000000..d3d76e2 --- /dev/null +++ b/src/qmckl_distance.org @@ -0,0 +1,201 @@ +# -*- mode: org -*- +# vim: syntax=c +#+TITLE: Computation of distances + +Function for the computation of distances between particles. + +3 files are produced: +- a header file : =qmckl_distance.h= +- a source file : =qmckl_distance.f90= +- a test file : =test_qmckl_distance.c= + +*** Header + #+BEGIN_SRC C :comments link :tangle qmckl_distance.h +#ifndef QMCKL_DISTANCE_H +#define QMCKL_DISTANCE_H +#include "qmckl_context.h" + #+END_SRC + +*** Source + #+BEGIN_SRC f90 :comments link :tangle qmckl_distance.f90 + #+END_SRC + +*** Test + #+BEGIN_SRC C :comments link :tangle test_qmckl_distance.c +#include +#include "qmckl.h" +#include "munit.h" +MunitResult test_qmckl_distance() { + qmckl_context context; + int64_t m, n, LDA, LDB, LDC; + double *A, *B, *C ; + int i, j; + + context = qmckl_context_create(); + + m = 5; + n = 6; + LDA = 6; + LDB = 10; + LDC = 5; + + A = (double*) qmckl_malloc (context, LDA*4*sizeof(double)); + B = (double*) qmckl_malloc (context, LDB*3*sizeof(double)); + C = (double*) qmckl_malloc (context, LDC*n*sizeof(double)); + + for (j=0 ; j<3 ; j++) { + for (i=0 ; i 0 + - =n= > 0 + - =LDA= >= m + - =LDB= >= n + - =LDC= >= m + - =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 +qmckl_exit_code qmckl_distance_sq(qmckl_context context, + int64_t m, int64_t n, + double *A, int64_t LDA, + double *B, int64_t LDB, + double *C, int64_t LDC); + #+END_SRC + +*** Source + #+BEGIN_SRC f90 :comments link :tangle qmckl_distance.f90 +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 (c_int64_t) :: i,j + real (c_double) :: x, y, z + + info = 0 + + if (context == 0_8) then + info = -1 + return + endif + + if (m <= 0_8) then + info = -2 + return + endif + + if (n <= 0_8) then + info = -3 + return + endif + + if (LDA < m) then + info = -4 + return + endif + + if (LDB < n) then + info = -5 + return + endif + + if (LDC < m) then + info = -6 + return + endif + + 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 + +end function qmckl_distance_sq + #+END_SRC + +*** Test + #+BEGIN_SRC C :comments link :tangle test_qmckl_distance.c + + munit_assert_int64(QMCKL_SUCCESS, ==, + qmckl_distance_sq(context, m, n, A, LDA, B, LDB, C, LDC) ); + + for (j=0 ; j