From 12745db458ffdf61f355060b4cdf8fc2af3ee416 Mon Sep 17 00:00:00 2001 From: Arne Morten Kvarving Date: Mon, 9 Mar 2026 14:03:14 +0100 Subject: [PATCH] setup FCMacros.h through FortranCInterface in the language hook --- CMakeLists.txt | 10 ++- opm/porsol/common/blas_lapack.cpp | 26 +++---- opm/porsol/common/blas_lapack.hpp | 113 +++++++++++------------------- 3 files changed, 59 insertions(+), 90 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 4923e35..250af7d 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -22,6 +22,11 @@ project(opm-upscaling C CXX Fortran) option(SIBLING_SEARCH "Search for other modules in sibling directories?" ON) option(INSTALL_BENCHMARKS "Install benchmark applications?" OFF) +macro(opm-upscaling_language_hook) + include(FortranCInterface) + fortrancinterface_header(${PROJECT_BINARY_DIR}/FCMacros.h MACRO_NAMESPACE FC_) +endmacro() + macro(opm-upscaling_config_hook) opm_need_version_of ("dune-common") opm_need_version_of ("dune-geometry") @@ -34,9 +39,8 @@ macro(opm-upscaling_tests_hook) endmacro() macro(opm-upscaling_targets_hook) - # Abuse target hook. will be improved soon - include(UseFortranWrappers) - define_fc_func(APPEND ${PROJECT_BINARY_DIR}/config.h) + target_include_directories(opmupscaling PRIVATE ${PROJECT_BINARY_DIR}) + # pack these cases which are alternatives in the code # cannot build boost::iostreams 1.66 as c++-20. if(TARGET Boost::iostreams AND Boost_VERSION VERSION_GREATER 1.66) diff --git a/opm/porsol/common/blas_lapack.cpp b/opm/porsol/common/blas_lapack.cpp index 334d1cc..48acdf5 100644 --- a/opm/porsol/common/blas_lapack.cpp +++ b/opm/porsol/common/blas_lapack.cpp @@ -47,8 +47,8 @@ void GEMV(const char* transA, { assert((transA[0] == 'N') || (transA[0] == 'T')); - DGEMV(F77_CHARACTER(transA[0]), - &m, &n, &a1, A, &ldA, x, &incX, &a2, y, &incY); + FC_GLOBAL(dgemv,DGEMV)(F77_CHARACTER(transA[0]), + &m, &n, &a1, A, &ldA, x, &incX, &a2, y, &incY); } template<> @@ -61,8 +61,8 @@ void GEMM(const char* transA, const char* transB, assert((transA[0] == 'N') || (transA[0] == 'T')); assert((transB[0] == 'N') || (transB[0] == 'T')); - DGEMM(F77_CHARACTER(transA[0]), F77_CHARACTER(transB[0]), - &m, &n, &k, &a1, A, &ldA, B, &ldB, &a2, C, &ldC); + FC_GLOBAL(dgemm,DGEMM)(F77_CHARACTER(transA[0]), F77_CHARACTER(transB[0]), + &m, &n, &k, &a1, A, &ldA, B, &ldB, &a2, C, &ldC); } template<> @@ -74,8 +74,8 @@ void SYRK(const char* uplo, const char* trans, assert((uplo[0] == 'U') || (uplo[0] == 'L')); assert((trans[0] == 'N') || (trans[0] == 'T')); - DSYRK(F77_CHARACTER(uplo[0]), F77_CHARACTER(trans[0]), - &n, &k, &a1, A, &ldA, &a2, C, &ldC); + FC_GLOBAL(dsyrk,DSYRK)(F77_CHARACTER(uplo[0]), F77_CHARACTER(trans[0]), + &n, &k, &a1, A, &ldA, &a2, C, &ldC); } template<> @@ -90,9 +90,9 @@ void TRMM(const char* side , const char* uplo, assert((transA[0] == 'N') || (transA[0] == 'T')); assert((diag[0] == 'N') || (diag[0] == 'U')); - DTRMM(F77_CHARACTER(side[0]) , F77_CHARACTER(uplo[0]), - F77_CHARACTER(transA[0]), F77_CHARACTER(diag[0]), - &m, &n, &a, A, &ldA, B, &ldB); + FC_GLOBAL(dtrmm,DTRMM)(F77_CHARACTER(side[0]) , F77_CHARACTER(uplo[0]), + F77_CHARACTER(transA[0]), F77_CHARACTER(diag[0]), + &m, &n, &a, A, &ldA, B, &ldB); } template<> @@ -101,7 +101,7 @@ void GEQRF(const int m , const int n , double* tau , double* work, const int lwork, int& info) { - DGEQRF(&m, &n, A, &ld, tau, work, &lwork, &info); + FC_GLOBAL(dgeqrf,DGEQRF)(&m, &n, A, &ld, tau, work, &lwork, &info); } template<> @@ -109,21 +109,21 @@ void ORGQR(const int m , const int n , const int k , double* A , const int ld , const double* tau, double* work, const int lwork, int& info) { - DORGQR(&m, &n, &k, A, &ld, tau, work, &lwork, &info); + FC_GLOBAL(dorgqr,DORGQR)(&m, &n, &k, A, &ld, tau, work, &lwork, &info); } template<> void GETRF(const int m, const int n , double* A, const int ld, int* ipiv, int& info) { - DGETRF(&m, &n, A, &ld, ipiv, &info); + FC_GLOBAL(dgetrf,DGETRF)(&m, &n, A, &ld, ipiv, &info); } template<> void GETRI(const int n , double* A , const int ld, const int* ipiv, double* work, int lwork, int& info) { - DGETRI(&n, A, &ld, ipiv, work, &lwork, &info); + FC_GLOBAL(dgetri,DGETRI)(&n, A, &ld, ipiv, work, &lwork, &info); } } diff --git a/opm/porsol/common/blas_lapack.hpp b/opm/porsol/common/blas_lapack.hpp index 7954159..ea8649d 100644 --- a/opm/porsol/common/blas_lapack.hpp +++ b/opm/porsol/common/blas_lapack.hpp @@ -36,6 +36,10 @@ #ifndef OPENRS_BLAS_LAPACK_HEADER #define OPENRS_BLAS_LAPACK_HEADER +#if ! __has_include() +#error "Need FCMacros.h to be generated through FortranCInterface" +#endif + #include #include @@ -43,96 +47,57 @@ extern "C" { #endif -#ifdef DGEMV -#undef DGEMV -#endif -#define DGEMV F77_NAME(dgemv,DGEMV) +#include - // y <- a1*op(A)*x + a2*y where op(X) in {X, X.'} - void DGEMV(F77_CHARACTER_TYPE, - const int* m , const int* n, - const double* a1 , const double* A, const int* ldA , - const double* x, const int* incX, - const double* a2 , double* y, const int* incY); +#define F77_CHARACTER_TYPE const char* +// y <- a1*op(A)*x + a2*y where op(X) in {X, X.'} +void FC_GLOBAL(dgemv,DGEMV)(F77_CHARACTER_TYPE, + const int* m , const int* n, + const double* a1 , const double* A, const int* ldA , + const double* x, const int* incX, + const double* a2 , double* y, const int* incY); -#ifdef DGEMM -#undef DGEMM -#endif -#define DGEMM F77_NAME(dgemm,DGEMM) // C <- a1*op(A)*op(B) + a2*C where op(X) in {X, X.'} - void DGEMM(F77_CHARACTER_TYPE, F77_CHARACTER_TYPE, +void FC_GLOBAL(dgemm,DGEMM)(F77_CHARACTER_TYPE, F77_CHARACTER_TYPE, const int* m , const int* n , const int* k , const double* a1 , const double* A , const int* ldA, const double* B , const int* ldB, const double* a2 , double* C , const int* ldC); +// C <- a1*A*A' + a2*C *or* C <- a1*A'*A + a2*C +void FC_GLOBAL(dsyrk,DSYRK)(F77_CHARACTER_TYPE, F77_CHARACTER_TYPE, + const int* n , const int* k , + const double* a1 , const double* A , const int* ldA, + const double* a2 , double* C , const int* ldC); -#ifdef DSYRK -#undef DSYRK -#endif -#define DSYRK F77_NAME(dsyrk,DSYRK) - - // C <- a1*A*A' + a2*C *or* C <- a1*A'*A + a2*C - void DSYRK(F77_CHARACTER_TYPE, F77_CHARACTER_TYPE, - const int* n , const int* k , - const double* a1 , const double* A , const int* ldA, - const double* a2 , double* C , const int* ldC); +// B <- a*op(A)*B *or* B <- a*B*op(A) where op(X) \in {X, X.', X'} +void FC_GLOBAL(dtrmm,DTRMM)(F77_CHARACTER_TYPE, F77_CHARACTER_TYPE, + F77_CHARACTER_TYPE, F77_CHARACTER_TYPE, + const int* m , const int* n , + const double* a , + const double* A , const int* ldA , + double* B , const int* ldB); -#ifdef DTRMM -#undef DTRMM -#endif -#define DTRMM F77_NAME(dtrmm,DTRMM) +void FC_GLOBAL(dgeqrf,DGEQRF)(const int* m , const int* n , + double* A , const int* ld , + double* tau , double* work, + const int* lwork, int* info); - // B <- a*op(A)*B *or* B <- a*B*op(A) where op(X) \in {X, X.', X'} - void DTRMM(F77_CHARACTER_TYPE, F77_CHARACTER_TYPE, - F77_CHARACTER_TYPE, F77_CHARACTER_TYPE, - const int* m , const int* n , - const double* a , - const double* A , const int* ldA , - double* B , const int* ldB); +void FC_GLOBAL(dorgqr,DORGQR)(const int* m , const int* n , const int* k , + double* A , const int* ld , const double* tau, + double* work, const int* lwork, int* info); +void FC_GLOBAL(dgetrf,DGETRF)(const int* m , const int* n , + double* A , const int* ld, + int* ipiv, int* info); -#ifdef DGEQRF -#undef DGEQRF -#endif -#define DGEQRF F77_NAME(dgeqrf,DGEQRF) - - void DGEQRF(const int* m , const int* n , - double* A , const int* ld , - double* tau , double* work, - const int* lwork, int* info); - - -#ifdef DORGQR -#undef DORGQR -#endif -#define DORGQR F77_NAME(dorgqr,DORGQR) - - void DORGQR(const int* m , const int* n , const int* k , - double* A , const int* ld , const double* tau, - double* work, const int* lwork, int* info); - -#ifdef DGETRF -#undef DGETRF -#endif -#define DGETRF F77_NAME(dgetrf,DGETRF) - - void DGETRF(const int* m , const int* n , - double* A , const int* ld, - int* ipiv, int* info); - -#ifdef DGETRI -#undef DGETRI -#endif -#define DGETRI F77_NAME(dgetri,DGETRI) - - void DGETRI(const int* n , - double* A , const int* ld, - const int* ipiv, - double* work, int* lwork, int* info); +void FC_GLOBAL(dgetri,DGETRI)(const int* n , + double* A , const int* ld, + const int* ipiv, + double* work, int* lwork, int* info); #ifdef __cplusplus }