Added a Fortran callback.

Will try to revise so that the same callback works for Fortran and C.

git-svn-id: svn://136.177.114.72/svn_GW/IPhreeqc/trunk@7883 1feff8c3-07ed-0310-ac33-dd36852eb9cd

IPhreeqc.cpp

@@ -800,6 +800,10 @@ void IPhreeqc::SetOutputFileOn(bool bValue)
 {
 	this->OutputFileOn = bValue;
 }
+void IPhreeqc::SetFortranBasicCallback(double (*cookie)(double *x1, double *x2, char *str, int l))
+{
+	this->PhreeqcPtr->register_fortran_basic_callback(cookie);
+}
 
 void IPhreeqc::SetSelectedOutputFileName(const char *filename)
 {

IPhreeqc.f90.inc

@@ -447,6 +447,21 @@
        END INTERFACE
 
 
+       INTERFACE
+        FUNCTION SetFortranBasicCallback(ID,COOKIE)
+         INTEGER(KIND=4),  INTENT(IN) :: ID
+        INTERFACE
+          DOUBLE PRECISION FUNCTION cookie(x1, x2, str)
+            DOUBLE PRECISION, INTENT(in) :: x1
+            DOUBLE PRECISION, INTENT(in) :: x2
+            CHARACTER(*), INTENT(in)                   :: str
+          END FUNCTION 
+        END INTERFACE
+         INTEGER(KIND=4)              :: SetFortranBasicCallback
+        END FUNCTION SetFortranBasicCallback
+       END INTERFACE
+
+
        INTERFACE
         FUNCTION SetOutputStringOn(ID,OUT_STRING_ON)
          INTEGER(KIND=4),  INTENT(IN) :: ID

IPhreeqc.h

@@ -1808,6 +1808,27 @@ Headings
  */
 	IPQ_DLL_EXPORT IPQ_RESULT  SetOutputFileOn(int id, int output_on);
 
+/**
+ *  Sets Fortran callback function for the Basic interpreter.  
+ *  @param id               The instance id returned from \ref CreateIPhreeqc.
+ *  @param cookie           The name of a double precision Fortran function with three arguments (two double precision, and one character).
+ *  @retval IPQ_OK          Success.
+ *  @retval IPQ_BADINSTANCE The given id is invalid.
+ *  @par Fortran90 Interface:
+ *  @htmlonly
+ *  <CODE>
+ *  <PRE>
+ *  FUNCTION SetFortranBasicCallback(ID,COOKIE)
+ *    INTEGER(KIND=4),  INTENT(IN)  :: ID
+ *    FUNCTION POINTER,  INTENT(IN) :: COOKIE
+ *    INTEGER(KIND=4)               :: SetFortranBasicCallback
+ *  END FUNCTION SetFortranBasicCallback
+ *  </PRE>
+ *  </CODE>
+ *  @endhtmlonly
+ */
+	IPQ_DLL_EXPORT IPQ_RESULT  SetFortranBasicCallback(int id, double (*cookie)(double *x1, double *x2, char *str, int l));
+
 /**
  *  Sets the output string switch on or off.  This switch controls whether or not the data normally sent
  *  to the output file are stored in a buffer for retrieval.  The initial setting after calling

IPhreeqc.hpp

@@ -756,6 +756,16 @@ public:
 	 */
 	void                     SetOutputFileOn(bool bValue);
 
+	/**
+	 *  Sets a Fortran callback function for Basic programs. The syntax for the Basic command is
+	 *  10 result = CALLBACK(x1, x2, string$)
+	 *  The syntax for the Fortran function is
+	 *  double precision my_callback(x1, x2, string), where x1 and x2 are double precision and string is a character variable.
+	 *  @param cookie           The name of a user-defined double precision function with three arguments (two double precision, one character).
+	 *  @see                    GetOutputFileOn
+	 */
+	void                     SetFortranBasicCallback(double (*cookie)(double *x1, double *x2, char *str, int l));
+
 	/**
 	 *  Sets the output string switch on or off.  This switch controls whether or not the data normally sent
 	 *  to the output file are stored in a buffer for retrieval.  The initial setting is false.

IPhreeqcF.f

@@ -532,6 +532,21 @@
         INTEGER(KIND=4) :: SetOutputFileOnF
         SetOutputFileOn = SetOutputFileOnF(ID,OUTPUT_FILE_ON)
       END FUNCTION SetOutputFileOn
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      FUNCTION SetFortranBasicCallback(ID,COOKIE)
+        IMPLICIT NONE
+        INTEGER(KIND=4) :: ID
+        INTERFACE 
+          DOUBLE PRECISION FUNCTION cookie(x1, x2, str)
+            DOUBLE PRECISION, INTENT(in) :: x1
+            DOUBLE PRECISION, INTENT(in) :: x2
+            CHARACTER(*), INTENT(in)                   :: str
+          END FUNCTION 
+        END INTERFACE 
+        INTEGER(KIND=4) :: SetFortranBasicCallback
+        INTEGER(KIND=4) :: SetFortranBasicCallbackF
+        SetFortranBasicCallback = SetFortranBasicCallbackF(ID,COOKIE)
+      END FUNCTION SetFortranBasicCallback      
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
       FUNCTION SetOutputStringOn(ID,OUTPUT_STRING_ON)
         IMPLICIT NONE

IPhreeqcLib.cpp

@@ -846,6 +846,18 @@ SetOutputFileOn(int id, int value)
 	return IPQ_BADINSTANCE;
 }
 
+IPQ_RESULT
+SetFortranBasicCallback(int id, double (*cookie)(double *x1, double *x2, char *str, int l))
+{
+	IPhreeqc* IPhreeqcPtr = IPhreeqcLib::GetInstance(id);
+	if (IPhreeqcPtr)
+	{
+		IPhreeqcPtr->SetFortranBasicCallback(cookie);
+		return IPQ_OK;
+	}
+	return IPQ_BADINSTANCE;
+}
+
 IPQ_RESULT
 SetOutputStringOn(int id, int value)
 {

fwrap.cpp

@@ -559,6 +559,11 @@ SetOutputFileOnF(int *id, int* output_on)
 	return ::SetOutputFileOn(*id, *output_on);
 }
 
+IPQ_RESULT
+SetFortranBasicCallbackF(int *id, double (*cookie)(double *x1, double *x2, char *str, int l))
+{
+	return ::SetFortranBasicCallback(*id, cookie);
+}
 IPQ_RESULT
 SetOutputStringOnF(int *id, int* output_string_on)
 {
@@ -837,6 +842,10 @@ IPQ_DLL_EXPORT int  __stdcall SETOUTPUTFILEON(int *id, int *output_on)
 {
 	return SetOutputFileOnF(id, output_on);
 }
+IPQ_DLL_EXPORT int  __stdcall SETFORTRANBASICCALBACK(int *id, double (*cookie)(double *x1, double *x2, char *str, int l))
+{
+	return SetFortranBasicCallbackF(id, cookie);
+}
 IPQ_DLL_EXPORT int  __stdcall SETOUTPUTSTRINGON(int *id, int *output_on)
 {
 	return SetOutputStringOnF(id, output_on);

fwrap.h

@@ -69,6 +69,7 @@
 #define SetSelectedOutputFileNameF        FC_FUNC (setselectedoutputfilenamef,        SETSELECTEDOUTPUTFILENAMEF)
 #define SetSelectedOutputFileOnF          FC_FUNC (setselectedoutputfileonf,          SETSELECTEDOUTPUTFILEONF)
 #define SetSelectedOutputStringOnF        FC_FUNC (setselectedoutputstringonf,        SETSELECTEDOUTPUTSTRINGONF)
+#define SetFortranBasicCallbackF          FC_FUNC (setfortranbasiccallbackf,          SETFOTRANBASICCALLBACKF)
 #endif /* FC_FUNC */
 
 #if defined(__cplusplus)
@@ -136,6 +137,7 @@ extern "C" {
   IPQ_RESULT SetSelectedOutputFileNameF(int *id, char* fname, unsigned int fname_length);
   IPQ_RESULT SetSelectedOutputFileOnF(int *id, int* selected_output_file_on);
   IPQ_RESULT SetSelectedOutputStringOnF(int *id, int* selected_output_string_on);
+  IPQ_RESULT SetFortranBasicCallbackF(int *id, double (*cookie)(double *x1, double *x2, char *str, int l));
 
 #if defined(__cplusplus)
 }

fwrap2.cpp

@@ -243,6 +243,10 @@ IPQ_DLL_EXPORT int  SETOUTPUTFILEON(int *id, int *output_on)
 {
 	return SetOutputFileOnF(id, output_on);
 }
+IPQ_DLL_EXPORT int  SETFORTRANBASICCALLBACK(int *id, double (*cookie)(double *x1, double *x2, char *str, int l))
+{
+	return SetFortranBasicCallbackF(id, cookie);
+}
 IPQ_DLL_EXPORT int  SETOUTPUTSTRINGON(int *id, int *output_on)
 {
 	return SetOutputStringOnF(id, output_on);

fwrap3.cpp

@@ -244,6 +244,10 @@ IPQ_DLL_EXPORT int  setoutputfileon_(int *id, int *output_on)
 {
 	return SetOutputFileOnF(id, output_on);
 }
+IPQ_DLL_EXPORT int  setfortranbasiccallback_(int *id, double (*cookie)(double *x1, double *x2, char *str, int l))
+{
+	return SetFortranBasicCallbackF(id, cookie);
+}
 IPQ_DLL_EXPORT int  setoutputstringon_(int *id, int *output_on)
 {
 	return SetOutputStringOnF(id, output_on);

fwrap4.cpp

@@ -244,6 +244,10 @@ IPQ_DLL_EXPORT int  setoutputfileon(int *id, int *output_on)
 {
 	return SetOutputFileOnF(id, output_on);
 }
+IPQ_DLL_EXPORT int  setfortranbasiccallback(int *id, double (*cookie)(double *x1, double *x2, char *str, int l))
+{
+	return SetFortranBasicCallbackF(id, cookie);
+}
 IPQ_DLL_EXPORT int  setoutputstringon(int *id, int *output_on)
 {
 	return SetOutputStringOnF(id, output_on);

fwrap5.cpp

@@ -244,6 +244,10 @@ IPQ_DLL_EXPORT int  SETOUTPUTFILEON_(int *id, int *output_on)
 {
 	return SetOutputFileOnF(id, output_on);
 }
+IPQ_DLL_EXPORT int  SETFORTRANBASICCALLBACK_(int *id, double (*cookie)(double *x1, double *x2, char *str, int l))
+{
+	return SetFortranBasicCallbackF(id, cookie);
+}
 IPQ_DLL_EXPORT int  SETOUTPUTSTRINGON_(int *id, int *output_on)
 {
 	return SetOutputStringOnF(id, output_on);

fwrap6.cpp

@@ -245,6 +245,10 @@ IPQ_DLL_EXPORT int  __stdcall SETOUTPUTFILEON_(int *id, int *output_on)
 {
 	return SetOutputFileOnF(id, output_on);
 }
+IPQ_DLL_EXPORT int  __stdcall SETFORTRANBASICCALLBACK_(int *id, double (*cookie)(double *x1, double *x2, char *str, int l))
+{
+	return SetFortranBasicCallbackF(id, cookie);
+}
 IPQ_DLL_EXPORT int  __stdcall SETOUTPUTSTRINGON_(int *id, int *output_on)
 {
 	return SetOutputStringOnF(id, output_on);

fwrap7.cpp

@@ -244,6 +244,10 @@ IPQ_DLL_EXPORT int  __stdcall setoutputfileon_(int *id, int *output_on)
 {
 	return SetOutputFileOnF(id, output_on);
 }
+IPQ_DLL_EXPORT int  __stdcall setfortranbasiccallback_(int *id, double (*cookie)(double *x1, double *x2, char *str, int l))
+{
+	return SetFortranBasicCallbackF(id, cookie);
+}
 IPQ_DLL_EXPORT int  __stdcall setoutputstringon_(int *id, int *output_on)
 {
 	return SetOutputStringOnF(id, output_on);

fwrap8.cpp

@@ -244,6 +244,10 @@ IPQ_DLL_EXPORT int  __stdcall setoutputfileon(int *id, int *output_on)
 {
 	return SetOutputFileOnF(id, output_on);
 }
+IPQ_DLL_EXPORT int  __stdcall setfortranbasiccallback(int *id, double (*cookie)(double *x1, double *x2, char *str, int l))
+{
+	return SetFortranBasicCallbackF(id, cookie);
+}
 IPQ_DLL_EXPORT int  __stdcall setoutputstringon(int *id, int *output_on)
 {
 	return SetOutputStringOnF(id, output_on);