OilfieldToolsNet/opm-upscaling
4
0
Fork 0
mirror of https://github.com/OPM/opm-upscaling.git synced 2026-08-26 13:07:11 -05:00
Code Issues Packages Projects Releases Wiki Activity

setup FCMacros.h through FortranCInterface in the language hook

Browse Source
This commit is contained in:
Arne Morten Kvarving
2026-03-09 14:03:34 +01:00
parent 2fb11ad0aa
commit 12745db458
3 changed files with 59 additions and 90 deletions
Download Patch File Download Diff File Expand all files Collapse all files
CMakeLists.txt
+7 -3
View File
@@ -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)
opm/porsol/common/blas_lapack.cpp
+13 -13
View File
@@ -47,8 +47,8 @@ void GEMV<double>(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<double>(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<double>(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<double>(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<double>(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<double>(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<double>(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);
}
}
opm/porsol/common/blas_lapack.hpp
+39 -74
View File
@@ -36,6 +36,10 @@
#ifndef OPENRS_BLAS_LAPACK_HEADER
#define OPENRS_BLAS_LAPACK_HEADER
#if ! __has_include(<FCMacros.h>)
#error "Need FCMacros.h to be generated through FortranCInterface"
#endif
#include <opm/common/ErrorMacros.hpp>
#include <opm/porsol/common/fortran.hpp>
@@ -43,96 +47,57 @@
extern "C" {
#endif
#ifdef DGEMV
#undef DGEMV
#endif
#define DGEMV F77_NAME(dgemv,DGEMV)
#include <FCMacros.h>
// 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
}