max/iphreeqc
1
0
Fork 0
mirror of https://git.gfz-potsdam.de/naaice/iphreeqc.git synced 2025-12-15 16:18:22 +01:00
Code Issues Packages Projects Releases Wiki Activity

Working on IPhreeqc Basic callback. Compiles with ISO_C_BINDING, but may need some more debugging.

Browse Source 
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
This commit is contained in:
David L Parkhurst 2015-03-27 22:03:36 +00:00
parent 666c533ada
commit 28e2eefe78
7 changed files with 74 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
src/IPhreeqc.cpp
View File

@ -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)

4
src/IPhreeqc.h
View File

@ -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
/**

4
src/IPhreeqc.hpp
View File

@ -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 <B>SELECTED_OUTPUT</B> user number for use in subsequent calls to (@ref GetSelectedOutputColumnCount,

16
src/IPhreeqcLib.cpp
View File

@ -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)
{

38
src/IPhreeqc_interface.F90
View File

@ -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

9
src/IPhreeqc_interface_F.cpp
View File

@ -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)

4
src/IPhreeqc_interface_F.h
View File

@ -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);