From 28e2eefe78ce9f3c3c9feb4e37f3d593e0d81714 Mon Sep 17 00:00:00 2001 From: David L Parkhurst Date: Fri, 27 Mar 2015 22:03:36 +0000 Subject: [PATCH] Working on IPhreeqc Basic callback. Compiles with ISO_C_BINDING, but may need some more debugging. Need to merge this change with PhreeqcRM-trunk. git-svn-id: svn://136.177.114.72/svn_GW/IPhreeqc/trunk@9424 1feff8c3-07ed-0310-ac33-dd36852eb9cd --- src/IPhreeqc.cpp | 9 +++++++-- src/IPhreeqc.h | 4 ++++ src/IPhreeqc.hpp | 4 ++++ src/IPhreeqcLib.cpp | 16 +++++++++++++-- src/IPhreeqc_interface.F90 | 38 +++++++++++++++++++++++++++++++----- src/IPhreeqc_interface_F.cpp | 9 ++++++++- src/IPhreeqc_interface_F.h | 4 ++++ 7 files changed, 74 insertions(+), 10 deletions(-) diff --git a/src/IPhreeqc.cpp b/src/IPhreeqc.cpp index 3e6a7c97..0f201060 100644 --- a/src/IPhreeqc.cpp +++ b/src/IPhreeqc.cpp @@ -873,12 +873,17 @@ void IPhreeqc::SetBasicCallback(double (*fcn)(double x1, double x2, const char * { this->PhreeqcPtr->register_basic_callback(fcn, cookie1); } - +#ifdef IPHREEQC_NO_FORTRAN_MODULE void IPhreeqc::SetBasicFortranCallback(double (*fcn)(double *x1, double *x2, char *str, size_t l)) { this->PhreeqcPtr->register_fortran_basic_callback(fcn); } - +#else +void IPhreeqc::SetBasicFortranCallback(double (*fcn)(double *x1, double *x2, char *str)) +{ + this->PhreeqcPtr->register_fortran_basic_callback(fcn); +} +#endif VRESULT IPhreeqc::SetCurrentSelectedOutputUserNumber(int n) { if (0 <= n) diff --git a/src/IPhreeqc.h b/src/IPhreeqc.h index 14e7cfde..f2758f51 100644 --- a/src/IPhreeqc.h +++ b/src/IPhreeqc.h @@ -1663,7 +1663,11 @@ Headings * @par File ic : * @include ic */ +#ifdef IPHREEQC_NO_FORTRAN_MODULE IPQ_DLL_EXPORT IPQ_RESULT SetBasicFortranCallback(int id, double (*fcn)(double *x1, double *x2, char *str, size_t l)); +#else + IPQ_DLL_EXPORT IPQ_RESULT SetBasicFortranCallback(int id, double (*fcn)(double *x1, double *x2, char *str)); +#endif /** diff --git a/src/IPhreeqc.hpp b/src/IPhreeqc.hpp index 05181551..cbd4efe8 100644 --- a/src/IPhreeqc.hpp +++ b/src/IPhreeqc.hpp @@ -710,7 +710,11 @@ public: * @param fcn The name of a user-defined function. * @see SetBasicCallback */ +#ifdef IPHREEQC_NO_FORTRAN_MODULE void SetBasicFortranCallback(double (*fcn)(double *x1, double *x2, char *str, size_t l)); +#else + void SetBasicFortranCallback(double (*fcn)(double *x1, double *x2, char *str)); +#endif /** * Sets the current SELECTED_OUTPUT user number for use in subsequent calls to (@ref GetSelectedOutputColumnCount, diff --git a/src/IPhreeqcLib.cpp b/src/IPhreeqcLib.cpp index cd5d66bd..13fbe98a 100644 --- a/src/IPhreeqcLib.cpp +++ b/src/IPhreeqcLib.cpp @@ -781,7 +781,7 @@ SetBasicCallback(int id, double (*fcn)(double x1, double x2, const char *str, vo } return IPQ_BADINSTANCE; } - +#ifdef IPHREEQC_NO_FORTRAN_MODULE IPQ_RESULT SetBasicFortranCallback(int id, double (*fcn)(double *x1, double *x2, char *str, size_t l)) { @@ -793,7 +793,19 @@ SetBasicFortranCallback(int id, double (*fcn)(double *x1, double *x2, char *str, } return IPQ_BADINSTANCE; } - +#else +IPQ_RESULT +SetBasicFortranCallback(int id, double (*fcn)(double *x1, double *x2, char *str)) +{ + IPhreeqc* IPhreeqcPtr = IPhreeqcLib::GetInstance(id); + if (IPhreeqcPtr) + { + IPhreeqcPtr->SetBasicFortranCallback(fcn); + return IPQ_OK; + } + return IPQ_BADINSTANCE; +} +#endif IPQ_RESULT SetCurrentSelectedOutputUserNumber(int id, int n) { diff --git a/src/IPhreeqc_interface.F90 b/src/IPhreeqc_interface.F90 index 94d4ab7b..61fe2609 100644 --- a/src/IPhreeqc_interface.F90 +++ b/src/IPhreeqc_interface.F90 @@ -816,9 +816,36 @@ INTEGER FUNCTION RunString(id, input) RunString = RunStringF(id, trim(input)//C_NULL_CHAR) return END FUNCTION RunString - +#ifdef IPHREEQC_NO_FORTRAN_MODULE +INTEGER FUNCTION SetBasicFortranCallback(id, fcn) + INTERFACE + INTEGER FUNCTION SetBasicFortranCallbackF(id, fcn) + IMPLICIT NONE + INTEGER, INTENT(in) :: id + INTERFACE + DOUBLE PRECISION FUNCTION fcn(x1, x2, str, l) + INTEGER, INTENT(in) :: l + DOUBLE PRECISION, INTENT(in) :: x1, x2 + CHARACTER, INTENT(in) :: str(*) + END FUNCTION fcn + END INTERFACE + END FUNCTION SetBasicFortranCallbackF + END INTERFACE + INTEGER, INTENT(in) :: id + INTERFACE + DOUBLE PRECISION FUNCTION fcn(x1, x2, str, l) + INTEGER, INTENT(in) :: l + REAL, INTENT(in) :: x1, x2 + CHARACTER, INTENT(in) :: str(*) + END FUNCTION fcn + END INTERFACE + SetBasicFortranCallback = SetBasicFortranCallbackF(id, fcn) + return +END FUNCTION SetBasicFortranCallback +#else INTEGER FUNCTION SetBasicFortranCallback(id, fcn) USE ISO_C_BINDING + IMPLICIT none INTERFACE INTEGER(KIND=C_INT) FUNCTION SetBasicFortranCallbackF(id, fcn) & BIND(C, NAME='SetBasicFortranCallbackF') @@ -826,9 +853,9 @@ INTEGER FUNCTION SetBasicFortranCallback(id, fcn) IMPLICIT NONE INTEGER(KIND=C_INT), INTENT(in) :: id INTERFACE - REAL(KIND=C_DOUBLE) FUNCTION fcn(x1, x2, str, l) BIND(C) + REAL(KIND=C_DOUBLE) FUNCTION fcn(x1, x2, str) BIND(C) USE ISO_C_BINDING - INTEGER(KIND=C_INT), INTENT(in) :: l + IMPLICIT none REAL(KIND=C_DOUBLE), INTENT(in) :: x1, x2 CHARACTER(KIND=C_CHAR), INTENT(in) :: str(*) END FUNCTION fcn @@ -837,9 +864,9 @@ INTEGER FUNCTION SetBasicFortranCallback(id, fcn) END INTERFACE INTEGER, INTENT(in) :: id INTERFACE - REAL(KIND=C_DOUBLE) FUNCTION fcn(x1, x2, str, l) BIND(C) + REAL(KIND=C_DOUBLE) FUNCTION fcn(x1, x2, str) BIND(C) USE ISO_C_BINDING - INTEGER(KIND=C_INT), INTENT(in) :: l + IMPLICIT none REAL(KIND=C_DOUBLE), INTENT(in) :: x1, x2 CHARACTER(KIND=C_CHAR), INTENT(in) :: str(*) END FUNCTION fcn @@ -847,6 +874,7 @@ INTEGER FUNCTION SetBasicFortranCallback(id, fcn) SetBasicFortranCallback = SetBasicFortranCallbackF(id, fcn) return END FUNCTION SetBasicFortranCallback +#endif INTEGER FUNCTION SetCurrentSelectedOutputUserNumber(id, n) USE ISO_C_BINDING diff --git a/src/IPhreeqc_interface_F.cpp b/src/IPhreeqc_interface_F.cpp index 1d967c07..b40b5ed8 100644 --- a/src/IPhreeqc_interface_F.cpp +++ b/src/IPhreeqc_interface_F.cpp @@ -402,12 +402,19 @@ RunStringF(int *id, char* input) int n = ::RunString(*id, input); return n; } - +#ifdef IPHREEQC_NO_FORTRAN_MODULE IPQ_RESULT SetBasicFortranCallbackF(int *id, double (*fcn)(double *x1, double *x2, char *str, size_t l)) { return ::SetBasicFortranCallback(*id, fcn); } +#else +IPQ_RESULT +SetBasicFortranCallbackF(int *id, double (*fcn)(double *x1, double *x2, char *str)) +{ + return ::SetBasicFortranCallback(*id, fcn); +} +#endif IPQ_RESULT SetCurrentSelectedOutputUserNumberF(int *id, int *n) diff --git a/src/IPhreeqc_interface_F.h b/src/IPhreeqc_interface_F.h index dfd1c162..f594f956 100644 --- a/src/IPhreeqc_interface_F.h +++ b/src/IPhreeqc_interface_F.h @@ -133,7 +133,11 @@ extern "C" { IPQ_DLL_EXPORT int RunAccumulatedF(int *id); IPQ_DLL_EXPORT int RunFileF(int *id, char* filename); IPQ_DLL_EXPORT int RunStringF(int *id, char* input); +#ifdef IPHREEQC_NO_FORTRAN_MODULE IPQ_DLL_EXPORT IPQ_RESULT SetBasicFortranCallbackF(int *id, double (*fcn)(double *x1, double *x2, char *str, size_t l)); +#else + IPQ_DLL_EXPORT IPQ_RESULT SetBasicFortranCallbackF(int *id, double (*fcn)(double *x1, double *x2, char *str)); +#endif IPQ_DLL_EXPORT IPQ_RESULT SetCurrentSelectedOutputUserNumberF(int *id, int *n); IPQ_DLL_EXPORT IPQ_RESULT SetDumpFileNameF(int *id, char* fname); IPQ_DLL_EXPORT IPQ_RESULT SetDumpFileOnF(int *id, int* dump_on);