Reduction works from fortran with variable argument lists now

git-svn-id: http://svn.cactuscode.org/flesh/trunk@643 17b73243-c579-4c4c-a9d2-2d5706c11dac

1 files changed, 38 insertions, 6 deletions

diff --git a/src/comm/Reduction.c b/src/comm/Reduction.c
index 4984680a..b9ff43a1 100644
--- a/src/comm/Reduction.c
+++ b/src/comm/Reduction.c
@@ -192,13 +192,45 @@ void FMODIFIER FORTRAN_NAME(CCTK_Reduce)(cGH *GH,
 		  int *type_out_vals,
 		  void *out_vals,
 		  int *num_in_fields,
-		  int *index )
+		  ... )
 { 
-  int retval;
-  retval = CCTK_Reduce(GH,*proc,*operation_handle,
-			      *num_out_vals,*type_out_vals,
-			      out_vals,*num_in_fields,*index);
-  fortranreturn = &retval;
+  va_list indices;
+  int i;
+  int *in_fields = malloc(*num_in_fields*sizeof(int));
+  void (*function)(REGISTER_ARGLIST)=NULL; 
+
+  /* Get the pointer to the reduction operator */
+
+
+  if (*operation_handle < 0)
+
+    CCTK_WARN(3,"Invalid handle passed to CCTK_Reduce");
+
+  else
+  {
+    function = (void (*)(REGISTER_ARGLIST))
+      CCTK_GetHandledData(ReductionOperators,*operation_handle);
+    
+    if (function)
+      {
+	
+	/* Fill in the array of variable indices from the variable argument list */
+	va_start(indices, *num_in_fields);
+	for (i=0; i<*num_in_fields; i++)
+	  in_fields[i] = *va_arg(indices,int *);
+	va_end(indices);
+	
+	function(GH,*proc,*num_out_vals,*type_out_vals,out_vals,*num_in_fields,in_fields);
+	
+	if (in_fields) free(in_fields);
+	
+      }
+    else
+      CCTK_WARN(3,"Reduction operation is not registered and cannot be called");
+  }
+
+  *fortranreturn= 1;
+
 }