Commit f821c41e authored by Thomas Jahns's avatar Thomas Jahns 🤸
Browse files

Removal part of C/Fortran glue code separation.

parent d73c5415
......@@ -47,6 +47,7 @@
#include "core/ppm_visibility.h"
#include "cfortran.h"
#include "core/bsearch.h"
static int
......@@ -59,8 +60,7 @@ PPM_bsearch_r_f(const void *key, const void *a, int n, int es,
#undef ROUTINE_6
#define ROUTINE_6 (PPM_CompareWithData)(void (*)(void))
FCALLSCFUN6(INT,PPM_bsearch_r_f, PPM_BSEARCH_R,
ppm_bsearch_r,
FCALLSCFUN6(INT,PPM_bsearch_r_f, PPM_BSEARCH_R, ppm_bsearch_r,
PVOID, PVOID, INT, INT, PVOID, ROUTINE)
static int
......
......@@ -45,7 +45,6 @@
#include <stdlib.h>
#include <mpi.h>
#include "cfortran.h"
#include "core/core.h"
#include "core/errhandler.h"
......@@ -63,22 +62,6 @@ PPM_set_mpi_abort_handler(MPI_Comm comm)
PPM_abort(comm, "Error handler setup failed.", __FILE__, __LINE__);
}
static void
PPM_set_mpi_abort_handler_f(MPI_Fint *comm_f)
{
#ifdef USE_MPI
MPI_Comm comm_c = MPI_Comm_f2c((MPI_Fint)*comm_f);
#else
MPI_Comm comm_c = *comm_f;
#endif
PPM_set_mpi_abort_handler(comm_c);
}
FCALLSCSUB1(PPM_set_mpi_abort_handler_f, PPM_SET_MPI_ABORT_HANDLER,
ppm_set_mpi_abort_handler, PVOID)
/*
* Local Variables:
* license-project-url: "https://www.dkrz.de/redmine/projects/scales-ppm"
......
......@@ -41,6 +41,7 @@
#include <stdlib.h>
#include "cfortran.h"
#include "core/heap.h"
static void
......@@ -52,8 +53,7 @@ PPM_heapify_wrapper(void *a, int n, int es, int i,
#undef ROUTINE_6
#define ROUTINE_6 (PPM_CompareWithData)(void (*)(void))
FCALLSCSUB6(PPM_heapify_wrapper, PPM_HEAPIFY,
ppm_heapify,
FCALLSCSUB6(PPM_heapify_wrapper, PPM_HEAPIFY, ppm_heapify,
PVOID, INT, INT, INT, PVOID, ROUTINE)
......@@ -67,8 +67,7 @@ PPM_is_heap_wrapper(void *a, int n, int es,
#undef ROUTINE_5
#define ROUTINE_5 (PPM_CompareWithData)(void (*)(void))
FCALLSCFUN5(LOGICAL,PPM_is_heap_wrapper, PPM_IS_HEAP,
ppm_is_heap,
FCALLSCFUN5(LOGICAL,PPM_is_heap_wrapper, PPM_IS_HEAP, ppm_is_heap,
PVOID, INT, INT, PVOID, ROUTINE)
static void
......@@ -78,8 +77,7 @@ PPM_build_heap_wrapper(void *a, int n, int es,
PPM_build_heap(a, (size_t)n, (size_t)es, data, cmp);
}
FCALLSCSUB5(PPM_build_heap_wrapper, PPM_BUILD_HEAP,
ppm_build_heap,
FCALLSCSUB5(PPM_build_heap_wrapper, PPM_BUILD_HEAP, ppm_build_heap,
PVOID, INT, INT, PVOID, ROUTINE)
......
......@@ -48,8 +48,6 @@
#include <mpi.h>
#include "core/ppm_visibility.h"
#define FCALLSC_QUALIFIER PPM_DSO_INTERNAL
#include "cfortran.h"
#include "core/ppm_extents_mp.h"
#include "core/ppm_xfuncs.h"
......@@ -89,8 +87,6 @@ PPM_create_extents_mp(void)
}
}
FCALLSCSUB0(PPM_create_extents_mp,PPM_CREATE_EXTENTS_MP,ppm_create_extents_mp)
void
PPM_destroy_extents_mp(void)
{
......@@ -99,12 +95,9 @@ PPM_destroy_extents_mp(void)
MPI_Type_free(&PPM_extent_mp);
}
FCALLSCSUB0(PPM_destroy_extents_mp,PPM_DESTROY_EXTENTS_MP,
ppm_destroy_extents_mp)
/*
* Local Variables:
* license-project-url: "https://www.dkrz.de/redmine/projects/scales-ppm"
* license-markup: "doxygen"
* license-default: "bsd"
* End:
*/
......@@ -49,7 +49,6 @@
#endif
#include <inttypes.h>
#include <math.h>
#include <stdbool.h>
#include "ppm_math_extensions.h"
......@@ -63,14 +62,6 @@ PPM_fpu_save_cw(uint32_t *fpu_cw)
xpfpa_save(fpu_cw);
}
static inline void
PPM_fpu_save_cw_f(int *fpu_cw)
{
PPM_fpu_save_cw((uint32_t *)fpu_cw);
}
FCALLSCSUB1(PPM_fpu_save_cw_f,PPM_FPU_SAVE_CW,ppm_fpu_save_cw,PINT)
void
PPM_fpu_set_precision(enum precision fpu_precision, uint32_t *old_fpu_cw)
{
......@@ -88,29 +79,12 @@ PPM_fpu_set_precision(enum precision fpu_precision, uint32_t *old_fpu_cw)
}
}
static inline void
PPM_fpu_set_precision_f(int fpu_precision, int *old_fpu_cw)
{
PPM_fpu_set_precision((enum precision)fpu_precision, (uint32_t *)old_fpu_cw);
}
FCALLSCSUB2(PPM_fpu_set_precision_f,PPM_FPU_SET_PRECISION_C,ppm_fpu_set_precision_c,INT,PINT)
void
PPM_fpu_restore_cw(const uint32_t fpu_cw)
{
xpfpa_restore(fpu_cw);
}
static inline void
PPM_fpu_restore_cw_f(const int fpu_cw)
{
PPM_fpu_restore_cw((uint32_t)fpu_cw);
}
FCALLSCSUB1(PPM_fpu_restore_cw_f,PPM_FPU_RESTORE_CW,ppm_fpu_restore_cw,INT)
void
PPM_fpu_set_abrupt_underflow(uint32_t *old_mxcsr, bool abrupt_underflow)
{
......@@ -122,65 +96,18 @@ PPM_fpu_set_abrupt_underflow(uint32_t *old_mxcsr, bool abrupt_underflow)
PPM_ADJUST_MXCSR(old_mxcsr, clear_flags, set_flags);
}
static inline void
PPM_fpu_set_abrupt_underflow_f(int *old_mxcsr, int abrupt_underflow)
{
PPM_fpu_set_abrupt_underflow((uint32_t *)old_mxcsr, abrupt_underflow);
}
FCALLSCSUB2(PPM_fpu_set_abrupt_underflow_f,PPM_FPU_SET_APRUPT_UNDERFLOW_C,
ppm_fpu_set_abrupt_underflow_c,PINT,LOGICAL)
void
PPM_fpu_save_mxcsr(uint32_t *old_mxcsr)
{
PPM_SAVE_MXCSR(&old_mxcsr);
}
static inline void
PPM_fpu_save_mxcsr_f(int *old_mxcsr)
{
PPM_fpu_save_mxcsr((uint32_t *)old_mxcsr);
}
FCALLSCSUB1(PPM_fpu_save_mxcsr_f,PPM_FPU_SAVE_MXCSR,
ppm_fpu_save_mxcsr,PINT)
void
PPM_fpu_restore_mxcsr(uint32_t old_mxcsr)
{
PPM_RESTORE_MXCSR(&old_mxcsr);
}
static inline void
PPM_fpu_restore_mxcsr_f(int old_mxcsr)
{
PPM_fpu_restore_mxcsr((uint32_t)old_mxcsr);
}
FCALLSCSUB1(PPM_fpu_restore_mxcsr_f,PPM_FPU_RESTORE_MXCSR,
ppm_fpu_restore_mxcsr,INT)
static inline void
PPM_assign_nan_dp(double *v)
{
*v = NAN;
}
FCALLSCSUB1(PPM_assign_nan_dp,PPM_PPM_ASSIGN_NAN_DP,
ppm_assign_nan_dp,PDOUBLE)
static inline void
PPM_assign_nan_sp(float *v)
{
*v = NAN;
}
FCALLSCSUB1(PPM_assign_nan_sp,PPM_PPM_ASSIGN_NAN_SP,
ppm_assign_nan_sp,PFLOAT)
/*
* Local Variables:
......
......@@ -92,15 +92,6 @@ PPM_ddp_sum_dp(size_t n, const double *a)
return s;
}
static inline void
PPM_ddp_sum_dp_f2c(int n, const double *a, double *s)
{
*(double complex *)s = PPM_ddp_sum_dp((size_t)n, a);
}
FCALLSCSUB3(PPM_ddp_sum_dp_f2c,PPM_DDP_SUM_DP,ppm_ddp_sum_dp,
INT,DOUBLEV,DOUBLEV)
double complex PPM_DSO_API_EXPORT
PPM_ddp_add_dp_dp(double a, double b)
{
......@@ -127,15 +118,6 @@ PPM_ddp_add_dp_dp(double a, double b)
return s;
}
static inline void
PPM_ddp_add_dp_dp_f2c(double a, double b, double *s)
{
*(double complex *)s = PPM_ddp_add_dp_dp(a, b);
}
FCALLSCSUB3(PPM_ddp_add_dp_dp_f2c,PPM_DDP_ADD_DP_DP,ppm_ddp_add_dp_dp,
DOUBLE,DOUBLE,DOUBLEV)
double complex PPM_DSO_API_EXPORT
PPM_ddp_add_ddp_ddp(double complex a, double complex b)
{
......@@ -163,16 +145,6 @@ PPM_ddp_add_ddp_ddp(double complex a, double complex b)
return s;
}
static inline void
PPM_ddp_add_ddp_ddp_f2c(const double *a, const double *b, double *s)
{
*(double complex *)s
= PPM_ddp_add_ddp_ddp(*(double complex *)a, *(double complex *)b);
}
FCALLSCSUB3(PPM_ddp_add_ddp_ddp_f2c,PPM_DDP_ADD_DDP_DDP,ppm_ddp_add_ddp_ddp,
DOUBLEV,DOUBLEV,DOUBLEV)
/*
......
......@@ -51,24 +51,11 @@
#endif
#include <stdio.h>
#include <stdlib.h>
#include <cfortran.h>
#include "core.h"
#include "yarandom.h"
#include "ppm_random.h"
#include "ppm_extents.h"
#ifdef INT64_T_IS_LONG_LONG
#define INT64 LONGLONG
#define INT64V LONGLONGV
#define INT64VV LONGLONGVV
#define INT64VVV LONGLONGVVV
#elif defined INT64_T_IS_LONG
#define INT64 LONG
#define INT64V LONGV
#define INT64VV LONGVV
#define INT64VVV LONGVVV
#endif
int
PPM_irand(void)
{
......@@ -78,7 +65,6 @@ PPM_irand(void)
return (int)i;
}
FCALLSCFUN0(INT,PPM_irand,PPM_IRAND,ppm_irand)
int
PPM_irandp(void)
......@@ -87,8 +73,6 @@ PPM_irandp(void)
return (int)i;
}
FCALLSCFUN0(INT,PPM_irandp,PPM_IRANDP,ppm_irandp)
int
PPM_irandr(struct PPM_iinterval range)
{
......@@ -104,13 +88,7 @@ PPM_irandr(struct PPM_iinterval range)
return (int)i;
}
static inline int
PPM_irandr_f(struct PPM_iinterval *range)
{
return PPM_irandr(*range);
}
FCALLSCFUN1(INT,PPM_irandr_f,PPM_IRANDR,ppm_irandr,PVOID)
void
PPM_irand_a(int *a, size_t n)
......@@ -120,16 +98,6 @@ PPM_irand_a(int *a, size_t n)
a[i] = PPM_irand();
}
static inline void
PPM_irand_a_f(int *a, int n)
{
assert(n >= 0);
PPM_irand_a(a, (size_t)n);
}
FCALLSCSUB2(PPM_irand_a_f,PPM_IRAND_A,ppm_irand_a,INTV,INT)
FCALLSCSUB2(PPM_irand_a_f,PPM_IRAND_A_2D,ppm_irand_a_2d,INTVV,INT)
FCALLSCSUB2(PPM_irand_a_f,PPM_IRAND_A_3D,ppm_irand_a_3d,INTVVV,INT)
void
PPM_irandp_a(int *a, size_t n)
......@@ -139,16 +107,6 @@ PPM_irandp_a(int *a, size_t n)
a[i] = PPM_irandp();
}
static inline void
PPM_irandp_a_f(int *a, int n)
{
assert(n >= 0);
PPM_irandp_a(a, (size_t)n);
}
FCALLSCSUB2(PPM_irandp_a_f,PPM_IRANDP_A,ppm_irandp_a,INTV,INT)
FCALLSCSUB2(PPM_irandp_a_f,PPM_IRANDP_A_2D,ppm_irandp_a_2d,INTVV,INT)
FCALLSCSUB2(PPM_irandp_a_f,PPM_IRANDP_A_3D,ppm_irandp_a_3d,INTVVV,INT)
void
PPM_irandr_a(int *a, size_t n, struct PPM_iinterval range)
......@@ -158,17 +116,6 @@ PPM_irandr_a(int *a, size_t n, struct PPM_iinterval range)
a[i] = PPM_irandr(range);
}
static inline void
PPM_irandr_a_f(int *a, int n, struct PPM_iinterval *range)
{
assert(n >= 0);
PPM_irandr_a(a, (size_t)n, *range);
}
FCALLSCSUB3(PPM_irandr_a_f,PPM_IRANDR_A,ppm_irandr_a,INTV,INT,PVOID)
FCALLSCSUB3(PPM_irandr_a_f,PPM_IRANDR_A_2D,ppm_irandr_a_2d,INTVV,INT,PVOID)
FCALLSCSUB3(PPM_irandr_a_f,PPM_IRANDR_A_3D,ppm_irandr_a_3d,INTVVV,INT,PVOID)
int64_t
PPM_irand8(void)
{
......@@ -178,8 +125,6 @@ PPM_irand8(void)
return (int64_t)i;
}
FCALLSCFUN0(INT64,PPM_irand8,PPM_IRAND8,ppm_irand8)
int64_t
PPM_irandp8(void)
{
......@@ -187,7 +132,6 @@ PPM_irandp8(void)
return (int64_t)i;
}
FCALLSCFUN0(INT64,PPM_irandp8,PPM_IRANDP8,ppm_irandp8)
int64_t
PPM_irandr8(struct PPM_iinterval64 range)
......@@ -204,14 +148,6 @@ PPM_irandr8(struct PPM_iinterval64 range)
return (int)i;
}
static inline int64_t
PPM_irandr8_f(struct PPM_iinterval64 *range)
{
return PPM_irandr8(*range);
}
FCALLSCFUN1(INT64,PPM_irandr8_f,PPM_IRANDR8,ppm_irandr8,PVOID)
void
PPM_irand8_a(int64_t *a, size_t n)
{
......@@ -220,17 +156,6 @@ PPM_irand8_a(int64_t *a, size_t n)
a[i] = PPM_irand8();
}
static inline void
PPM_irand8_a_f(int64_t *a, int n)
{
assert(n >= 0);
PPM_irand8_a(a, (size_t)n);
}
FCALLSCSUB2(PPM_irand8_a_f,PPM_IRAND8_A,ppm_irand8_a,INT64V,INT)
FCALLSCSUB2(PPM_irand8_a_f,PPM_IRAND8_A_2D,ppm_irand8_a_2d,INT64VV,INT)
FCALLSCSUB2(PPM_irand8_a_f,PPM_IRAND8_A_3D,ppm_irand8_a_3d,INT64VVV,INT)
void
PPM_irandp8_a(int64_t *a, size_t n)
{
......@@ -239,17 +164,6 @@ PPM_irandp8_a(int64_t *a, size_t n)
a[i] = PPM_irandp8();
}
static inline void
PPM_irandp8_a_f(int64_t *a, int n)
{
assert(n >= 0);
PPM_irandp8_a(a, (size_t)n);
}
FCALLSCSUB2(PPM_irandp8_a_f,PPM_IRANDP8_A,ppm_irandp8_a,INT64V,INT)
FCALLSCSUB2(PPM_irandp8_a_f,PPM_IRANDP8_A_2D,ppm_irandp8_a_2d,INT64VV,INT)
FCALLSCSUB2(PPM_irandp8_a_f,PPM_IRANDP8_A_3D,ppm_irandp8_a_3d,INT64VVV,INT)
void
PPM_irandr8_a(int64_t *a, size_t n, struct PPM_iinterval64 range)
{
......@@ -258,33 +172,18 @@ PPM_irandr8_a(int64_t *a, size_t n, struct PPM_iinterval64 range)
a[i] = PPM_irandr8(range);
}
static inline void
PPM_irandr8_a_f(int64_t *a, int n, struct PPM_iinterval64 *range)
{
assert(n >= 0);
PPM_irandr8_a(a, (size_t)n, *range);
}
FCALLSCSUB3(PPM_irandr8_a_f,PPM_IRANDR8_A,ppm_irandr8_a,INT64V,INT,PVOID)
FCALLSCSUB3(PPM_irandr8_a_f,PPM_IRANDR8_A_2D,ppm_irandr8_a_2d,INT64VV,INT,PVOID)
FCALLSCSUB3(PPM_irandr8_a_f,PPM_IRANDR8_A_3D,ppm_irandr8_a_3d,INT64VVV,INT,PVOID)
double
PPM_drand(void)
{
return PPM_ya_fsgrandom();
}
FCALLSCFUN0(DOUBLE,PPM_ya_fsgrandom,PPM_DRAND,ppm_drand)
double
PPM_drandp(void)
{
return PPM_ya_frandom();
}
FCALLSCFUN0(DOUBLE,PPM_ya_frandom,PPM_DRANDP,ppm_drandp)
double
PPM_drandr(struct PPM_iinterval_dp range)
{
......@@ -297,14 +196,6 @@ PPM_drandr(struct PPM_iinterval_dp range)
return x;
}
static inline double
PPM_drandr_f(struct PPM_iinterval_dp *range)
{
return PPM_drandr(*range);
}
FCALLSCFUN1(DOUBLE,PPM_drandr_f,PPM_DRANDR,ppm_drandr,PVOID)
void
PPM_drand_a(double *a, size_t n)
{
......@@ -313,17 +204,6 @@ PPM_drand_a(double *a, size_t n)
a[i] = PPM_ya_fsgrandom();
}
static inline void
PPM_drand_a_f(double *a, int n)
{
assert(n >= 0);
PPM_drand_a(a, (size_t)n);
}
FCALLSCSUB2(PPM_drand_a_f,PPM_DRAND_A,ppm_drand_a,DOUBLEV,INT)
FCALLSCSUB2(PPM_drand_a_f,PPM_DRAND_A_2D,ppm_drand_a_2d,DOUBLEVV,INT)
FCALLSCSUB2(PPM_drand_a_f,PPM_DRAND_A_3D,ppm_drand_a_3d,DOUBLEVVV,INT)
void
PPM_drandp_a(double *a, size_t n)
{
......@@ -332,17 +212,6 @@ PPM_drandp_a(double *a, size_t n)
a[i] = PPM_ya_frandom();
}
static inline void
PPM_drandp_a_f(double *a, int n)
{
assert(n >= 0);
PPM_drandp_a(a, (size_t)n);
}
FCALLSCSUB2(PPM_drandp_a_f,PPM_DRANDP_A,ppm_drandp_a,DOUBLEV,INT)
FCALLSCSUB2(PPM_drandp_a_f,PPM_DRANDP_A_2D,ppm_drandp_a_2d,DOUBLEVV,INT)
FCALLSCSUB2(PPM_drandp_a_f,PPM_DRANDP_A_3D,ppm_drandp_a_3d,DOUBLEVVV,INT)
void
PPM_drandr_a(double *a, size_t n, struct PPM_iinterval_dp range)
{
......@@ -351,33 +220,18 @@ PPM_drandr_a(double *a, size_t n, struct PPM_iinterval_dp range)
a[i] = PPM_drandr(range);
}
static inline void
PPM_drandr_a_f(double *a, int n, struct PPM_iinterval_dp *range)
{
assert(n >= 0);
PPM_drandr_a(a, (size_t)n, *range);
}
FCALLSCSUB3(PPM_drandr_a_f,PPM_DRANDR_A,ppm_drandr_a,DOUBLEV,INT,PVOID)
FCALLSCSUB3(PPM_drandr_a_f,PPM_DRANDR_A_2D,ppm_drandr_a_2d,DOUBLEVV,INT,PVOID)
FCALLSCSUB3(PPM_drandr_a_f,PPM_DRANDR_A_3D,ppm_drandr_a_3d,DOUBLEVVV,INT,PVOID)
float
PPM_frand(void)
{
return PPM_ya_fsgrandomf();
}
FCALLSCFUN0(FLOAT,PPM_frand,PPM_FRAND,ppm_frand)
float
PPM_frandp(void)
{
return PPM_ya_frandomf();
}
FCALLSCFUN0(FLOAT,PPM_frandp,PPM_FRANDP,ppm_frandp)
float
PPM_frandr(struct PPM_iinterval_sp range)
{
......@@ -390,14 +244,6 @@ PPM_frandr(struct PPM_iinterval_sp range)
return x;
}
static inline float
PPM_frandr_f(struct PPM_iinterval_sp *range)
{
return PPM_frandr(*range);
}
FCALLSCFUN1(DOUBLE,PPM_frandr_f,PPM_FRANDR,ppm_frandr,PVOID)
void
PPM_frand_a(float *a, size_t n)
{
......@@ -406,17 +252,6 @@ PPM_frand_a(float *a, size_t n)
a[i] = PPM_ya_fsgrandomf();
}
static inline void
PPM_frand_a_f(float *a, int n)
{
assert(n >= 0);
PPM_frand_a(a, (size_t)n);
}
FCALLSCSUB2(PPM_frand_a_f,PPM_FRAND_A,ppm_frand_a,FLOATV,INT)
FCALLSCSUB2(PPM_frand_a_f,PPM_FRAND_A_2D,ppm_frand_a_2d,FLOATVV,INT)
FCALLSCSUB2(PPM_frand_a_f,PPM_FRAND_A_3D,ppm_frand_a_3d,FLOATVVV,INT)
void
PPM_frandp_a(float *a, size_t n)
{
......@@ -425,17 +260,6 @@ PPM_frandp_a(float *a, size_t n)
a[i] = PPM_ya_frandomf();
}
static inline void
PPM_frandp_a_f(float *a, int n)
{
assert(n >= 0);
PPM_frandp_a(a, (size_t)n);
}
FCALLSCSUB2(PPM_frandp_a_f,PPM_FRANDP_A,ppm_frandp_a,FLOATV,INT)
FCALLSCSUB2(PPM_frandp_a_f,PPM_FRANDP_A_2D,ppm_frandp_a_2d,FLOATVV,INT)
FCALLSCSUB2(PPM_frandp_a_f,PPM_FRANDP_A_3D,ppm_frandp_a_3d,FLOATVVV,INT)
void
PPM_frandr_a(float *a, size_t n, struct PPM_iinterval_sp range)
{
......@@ -444,37 +268,6 @@ PPM_frandr_a(float *a, size_t n, struct PPM_iinterval_sp range)
a[i] = PPM_frandr(range);
}
static inline void
PPM_frandr_a_f(float *a, int n, struct PPM_iinterval_sp *range)
{
assert(n >= 0);
PPM_frandr_a(a, (size_t)n, *range);
}
FCALLSCSUB3(PPM_frandr_a_f,PPM_FRANDR_A,ppm_frandr_a,FLOATV,INT,PVOID)
FCALLSCSUB3(PPM_frandr_a_f,PPM_FRANDR_A_2D,ppm_frandr_a_2d,FLOATVV,INT,PVOID)
FCALLSCSUB3(PPM_frandr_a_f,PPM_FRANDR_A_3D,ppm_frandr_a_3d,FLOATVVV,INT,PVOID)
static void
initIRand_f(MPI_Fint *comm_f, int *random_seed)
{