From 73399e24ec4a09059fe090abc4b2c39cbe5c5a6a Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 18 Feb 2022 01:24:37 +0100 Subject: [PATCH] Fix fortran strings in trexio interface --- .github/workflows/test-build.yml | 28 +++++++++++++- org/qmckl_ao.org | 66 ++++++++++++++++++++++++++++++++ org/qmckl_nucleus.org | 6 +-- org/qmckl_trexio.org | 17 +++++--- 4 files changed, 106 insertions(+), 11 deletions(-) diff --git a/.github/workflows/test-build.yml b/.github/workflows/test-build.yml index a4dd421..41b59e0 100644 --- a/.github/workflows/test-build.yml +++ b/.github/workflows/test-build.yml @@ -40,7 +40,9 @@ jobs: - name: Build QMCkl run: | ./autogen.sh - ./configure --enable-silent-rules --enable-debug + mkdir _build + cd _build + ../configure --enable-silent-rules --enable-debug make -j 4 - name: Run test @@ -72,7 +74,7 @@ jobs: - uses: actions/checkout@v2 - name: install dependencies run: brew install emacs hdf5 automake pkg-config - + - name: Symlink gfortran (macOS) if: runner.os == 'macOS' run: | @@ -89,6 +91,28 @@ jobs: git clone https://github.com/TREX-CoE/trexio.git cd trexio ./autogen.sh + mkdir _build + cd _build + ../configure --enable-silent-rules + make -j 4 + + - name: Run test + run: make -j 4 check + + - name: Archive test log file + if: failure() + uses: actions/upload-artifact@v2 + with: + name: test-report-ubuntu + path: test-suite.log + + - name: Dist test + run: make distcheck + + - name: Archive test log file + if: failure() + uses: actions/upload-artifact@v2 + with: ./configure --prefix=${PWD}/_install --enable-silent-rules make -j 4 make install diff --git a/org/qmckl_ao.org b/org/qmckl_ao.org index 1202117..a982379 100644 --- a/org/qmckl_ao.org +++ b/org/qmckl_ao.org @@ -2822,6 +2822,72 @@ qmckl_get_ao_basis_ao_vgl (qmckl_context context, end interface #+end_src + Uses the give array to compute the VGL. + + #+begin_src c :comments org :tangle (eval h_func) :noweb yes +qmckl_exit_code +qmckl_get_ao_basis_ao_vgl_inplace (qmckl_context context, + double* const ao_vgl, + const int64_t size_max); + #+end_src + + #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none +qmckl_exit_code +qmckl_get_ao_basis_ao_vgl_inplace (qmckl_context context, + double* const ao_vgl, + const int64_t size_max) +{ + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return qmckl_failwith( context, + QMCKL_INVALID_CONTEXT, + "qmckl_get_ao_basis_ao_vgl", + NULL); + } + + qmckl_exit_code rc; + + qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; + assert (ctx != NULL); + + int64_t sze = ctx->ao_basis.ao_num * 5 * ctx->point.num; + if (size_max < sze) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_3, + "qmckl_get_ao_basis_ao_vgl", + "input array too small"); + } + + rc = qmckl_context_touch(context); + if (rc != QMCKL_SUCCESS) return rc; + + double* old_array = ctx->ao_basis.ao_vgl; + + ctx->ao_basis.ao_vgl = ao_vgl; + + rc = qmckl_provide_ao_vgl(context); + if (rc != QMCKL_SUCCESS) return rc; + + ctx->ao_basis.ao_vgl = old_array; + + return QMCKL_SUCCESS; +} + #+end_src + + #+begin_src f90 :tangle (eval fh_func) :comments org :exports none + interface + integer(c_int32_t) function qmckl_get_ao_basis_ao_vgl_inplace (context, & + ao_vgl, size_max) bind(C) + use, intrinsic :: iso_c_binding + import + implicit none + integer (c_int64_t) , intent(in) , value :: context + double precision, intent(out) :: ao_vgl(*) + integer (c_int64_t) , intent(in) , value :: size_max + end function qmckl_get_ao_basis_ao_vgl_inplace + end interface + #+end_src + * Radial part ** General functions for Gaussian basis functions diff --git a/org/qmckl_nucleus.org b/org/qmckl_nucleus.org index da003b5..0191afe 100644 --- a/org/qmckl_nucleus.org +++ b/org/qmckl_nucleus.org @@ -668,14 +668,14 @@ assert(!qmckl_nucleus_provided(context)); rc = qmckl_get_nucleus_coord (context, 'N', nucl_coord2, 3*nucl_num); assert(rc == QMCKL_SUCCESS); for (size_t k=0 ; k<3 ; ++k) { - for (size_t i=0 ; i