Support 2D Arrays for Fortran

Examples/test-suite/fortran/fortran_array_typemap_runme.F90

@@ -86,4 +86,25 @@ subroutine test_deferred_2d
 
 end subroutine
 
+! Test three-argument (pointer, rows, cols) -> dynamic 2D array
+subroutine test_2d_dynamic_array
+  use fortran_array_typemap
+  use ISO_C_BINDING
+  implicit none
+  integer(C_INT), dimension(:,:), allocatable :: int_dynamic_matrix
+  real(C_DOUBLE), dimension(:,:), allocatable :: dbl_dynamic_matrix
+
+  allocate(int_dynamic_matrix(6, 3))
+  allocate(dbl_dynamic_matrix(4, 4))
+
+  call set_values_int(int_dynamic_matrix, 2)
+  call set_values_dbl(dbl_dynamic_matrix, 4.25d0)
+
+  ASSERT(all(dbl_dynamic_matrix == 4.25d0))
+  ASSERT(all(int_dynamic_matrix == 2))
+
+  int_dynamic_matrix(:,:) = 3
+  ASSERT(accum(int_dynamic_matrix) == 3 * 6 * 3)
+end subroutine
+
 end program

Examples/test-suite/fortran_array_typemap.i

@@ -101,3 +101,34 @@ void average_points(int count, const double points[][3], double avg[3]) {
 }
 %}
 
+/* Test dynamic 2D arrays with combination pointer/rows/cols arguments */
+
+%apply(SWIGTYPE *DATA, size_t ROWS, size_t COLS) { (int* const data, const uint64_t rows, const uint64_t cols) };
+%apply(SWIGTYPE *DATA, size_t ROWS, size_t COLS) { (double* const data, const uint64_t rows, const uint64_t cols) };
+%apply(const SWIGTYPE *DATA, size_t ROWS, size_t COLS) { (const int* const data, const uint64_t rows, const uint64_t cols) };
+
+%inline %{
+void set_values_int(int* data, const uint64_t rows, const uint64_t cols, int value) {
+  int* end = data + rows * cols;
+  for (int* v = data; v != end; ++v) {
+    *v = value;
+  }
+}
+
+void set_values_dbl(double* data, const uint64_t rows, const uint64_t cols, double value) {
+  double* end = data + rows * cols;
+  for (double* v = data; v != end; ++v) {
+    *v = value;
+  }
+}
+
+int accum(const int* data, const uint64_t rows, const uint64_t cols) {
+  int result = 0;
+  int* end = data + rows * cols;
+  for (const int* v = data; v != end; ++v) {
+    result += *v;
+  }
+  return result;
+}
+
+%}

Lib/fortran/fortranarray.swg

@@ -102,3 +102,88 @@ end subroutine}
   %typemap(fargout, noblock=1) const CPPTYPE& {};
 %enddef
 
+/* -------------------------------------------------------------------------
+ * Additional macros for 2D arrays
+/* -------------------------------------------------------------------------
+/*!
+ * \def %fortran_2d_array
+ *
+ * Use the \c Swig2DArrayWrapper for the ISO C binding layer.
+ *
+ * Based on fortran_array macro.
+ */
+%define %fortran_2d_array(CPPTYPE...)
+  // C wrapper type: pointer to templated array wrapper
+  %typemap(ctype, in="Swig2DArrayWrapper*",
+         null="Swig2DArrayWrapper_uninitialized()",
+         fragment="Swig2DArrayWrapper_uninitialized", noblock=1) CPPTYPE
+    "Swig2DArrayWrapper"
+
+  // Interface type: fortran equivalent of "ctype"
+  // Since the type is declared in the module, it's necessary to use the
+  // fortran "import" statement to bring it into scope.
+  %typemap(imtype, fragment="Swig2DArrayWrapper_f", noblock=1) CPPTYPE
+    "type(Swig2DArrayWrapper)"
+%enddef
+
+/* ------------------------------------------------------------------------- */
+/*!
+ * \def %fortran_2d_array_pointer
+ *
+ * Wrap intermediate data values as array pointers.
+ *
+ * This defines:
+ * - C type interface
+ * - IM type interface
+ * - FIN/FOUT
+ * - FTYPE array pointer
+ */
+%define %fortran_2d_array_pointer(VTYPE, CPPTYPE...)
+  %fortran_2d_array(CPPTYPE)
+
+  // Fortran proxy code: input is target 2D array
+  %typemap(ftype, in="$typemap(imtype, " #VTYPE "), dimension(:,:), target", noblock=1) CPPTYPE {
+    $typemap(imtype, VTYPE), dimension(:,:), pointer
+  }
+
+  // Look up typemaps defined by %fortran_intrinsic
+  %typemap(fin, noblock=1) CPPTYPE {$typemap(fin, VTYPE ARRAY[][])}
+  %typemap(fout, noblock=1) CPPTYPE {$typemap(fout, VTYPE ARRAY[][])}
+%enddef
+
+/* ------------------------------------------------------------------------- */
+/*!
+ * \def %fortran_2d_array_handle
+ *
+ * Convert a C++ input argument to an array pointer.
+ *
+ * For example, the function
+ * \code
+   void f(double** data, size_t* rows, size_t* cols);
+   \endcode
+ * would take a Fortran array pointer as an (INOUT) argument.
+ *
+ * This defines:
+ * - C type interface
+ * - IM type interface
+ * - FIN
+ * - FTYPE array pointer
+ *
+ * which means you still must define the C++ <--> C conversions elsewhere.
+ * Make sure to add the `match="in"` keyword to the `argout` typemap.
+ */
+%define %fortran_2d_array_handle(VTYPE, CPPTYPE...)
+
+  // Input arguments for pointer-by-ref are the same
+  %typemap(ftype, in="$typemap(imtype, " #VTYPE "), dimension(:,:), pointer, intent(inout)", noblock=1) CPPTYPE& {
+    $typemap(imtype, VTYPE), dimension(:,:), pointer
+  }
+  %typemap(fin, match="ftype", noblock=1) CPPTYPE& {$typemap(fin, VTYPE ARRAY[][])}
+  %typemap(imtype) CPPTYPE& = CPPTYPE;
+  %typemap(ctype) CPPTYPE& = CPPTYPE;
+
+  // Update the resulting Fortran pointer, but only by reference (not const ref)
+  %typemap(fargout, match="fin", noblock=1) CPPTYPE& = VTYPE ARRAY[][];
+  %typemap(fargout, noblock=1) const CPPTYPE& {};
+%enddef
+

Lib/fortran/fundamental.swg

@@ -36,6 +36,8 @@ subroutine %fortrantm(fout, bool)(imout, fout)
 end subroutine
 }
 
+/* Structure to hold a reference to a 1D array */
+
 #ifdef __cplusplus
 %fragment("SwigArrayWrapper", "header", fragment="<stdlib.h>") %{
 struct SwigArrayWrapper {
@@ -68,6 +70,44 @@ SWIGINTERN SwigArrayWrapper SwigArrayWrapper_uninitialized() {
   integer(C_SIZE_T), public :: size = 0
  end type}
 
+/* Structure to hold a reference to a 2D array in contiguous memory */
+
+#ifdef __cplusplus
+%fragment("Swig2DArrayWrapper", "header", fragment="<stdlib.h>") %{
+struct Swig2DArrayWrapper {
+    void* data;
+    size_t rows;
+    size_t cols;
+};
+%}
+#else
+%fragment("Swig2DArrayWrapper", "header", fragment="<stdlib.h>") %{
+typedef struct {
+    void* data;
+    size_t rows;
+    size_t cols;
+} Swig2DArrayWrapper;
+%}
+#endif
+
+%fragment("Swig2DArrayWrapper_uninitialized", "header", fragment="Swig2DArrayWrapper") %{
+SWIGINTERN Swig2DArrayWrapper Swig2DArrayWrapper_uninitialized() {
+  Swig2DArrayWrapper result;
+  result.data = NULL;
+  result.rows = 0;
+  result.cols = 0;
+  return result;
+}
+%}
+
+// Add 2D array wrapper to Fortran types when used
+%fragment("Swig2DArrayWrapper_f", "fdecl", noblock=1)
+{ type, bind(C) :: Swig2DArrayWrapper
+  type(C_PTR), public :: data = C_NULL_PTR
+  integer(C_SIZE_T), public :: rows = 0
+  integer(C_SIZE_T), public :: cols = 0
+ end type}
+
 
 /* -------------------------------------------------------------------------
  * MACROS
@@ -155,6 +195,9 @@ SWIGINTERN SwigArrayWrapper SwigArrayWrapper_uninitialized() {
 
   %typemap(bindc) CTYPE* = FORTRAN_INTRINSIC_TYPE*;
 
+  ////////////////////////////////////////////////////////////////////////////////////////////////
+  // 1D Arrays 
+
   // Fragment for converting array to array wrapper. This needs the intermediate step of assigning the first element to an array pointer to be compatible with
   // ISO C.
   %fragment("SWIG_fin"{CTYPE[]}, "fsubprograms", fragment="SwigArrayWrapper_f", noblock=1)
@@ -195,6 +238,54 @@ end subroutine}
   call %fortrantm(fout, CTYPE[])($1, $input)
   }
   %typemap(fargout) CTYPE const ARRAY[] = CTYPE ARRAY[];
+
+  ////////////////////////////////////////////////////////////////////////////////////////////////
+  // 2D Arrays 
+
+  // Fragment for converting a 2D array to a 2D array wrapper. This needs the intermediate step of assigning the first element to an array pointer to be compatible with
+  // ISO C.
+  %fragment("SWIG_fin"{CTYPE[][]}, "fsubprograms", fragment="Swig2DArrayWrapper_f", noblock=1)
+{subroutine %fortrantm(fin, CTYPE[][])(finp, iminp)
+  use, intrinsic :: ISO_C_BINDING
+  FTYPE(FKIND), dimension(:,:), intent(in), target :: finp
+  type(Swig2DArrayWrapper), intent(out) :: iminp
+  integer(C_SIZE_T) :: sz
+  FTYPE(FKIND), pointer :: imtemp
+
+  sz = size(finp, kind=C_SIZE_T)
+  if (sz > 0_c_size_t) then
+    imtemp => finp(1,1)
+    iminp%data = c_loc(imtemp)
+    iminp%rows = size(finp, 1, kind=C_SIZE_T)
+    iminp%cols = size(finp, 2, kind=C_SIZE_T)
+  else
+    iminp%data = c_null_ptr
+    iminp%rows = 0
+    iminp%cols = 0
+  end if
+end subroutine}
+
+  // Fragment for converting 2D array wrapper to a Fortran 2D array
+  %fragment("SWIG_fout"{CTYPE[][]}, "fsubprograms", noblock=1)
+  {subroutine %fortrantm(fout, CTYPE[][])(imout, fout)
+  use, intrinsic :: ISO_C_BINDING
+  type(Swig2DArrayWrapper), intent(in) :: imout
+  FTYPE(FKIND), dimension(:,:), pointer, intent(out) :: fout
+
+  if (imout%size > 0) then
+    call c_f_pointer(imout%data, fout, [imout%rows, imout%cols])
+  else
+    fout => NULL()
+  endif
+end subroutine}
+
+  // Define proxy code typemaps for a 2D array of this type
+  %fortran_typemap_finout(CTYPE[][], CTYPE ARRAY[][])
+  %typemap(fargout, fragment="SWIG_fout"{CTYPE[][]}, noblock=1) CTYPE ARRAY[][] {
+  call %fortrantm(fout, CTYPE[][])($1, $input)
+  }
+  %typemap(fargout) CTYPE const ARRAY[][] = CTYPE ARRAY[][];
+
 %enddef
 
 /*!

Lib/fortran/typemaps.i

@@ -30,6 +30,34 @@ $2 = $input->size;
   $typemap(imtype, $*1_ltype), dimension(:), pointer
 }
 
+/* -------------------------------------------------------------------------
+ * Enable seamless translation of consecutive pointer/size1/size2 arguments
+ * to Fortran 2D array views.
+ *
+ * To apply these to a function `void foo(double* x, int x_rows, int x_cols);`:
+ *
+ * %apply (SWIGTYPE *DATA, size_t ROWS, size_t COLS) { (double *x, int x_rows, int x_cols) };
+ */
+
+
+/* Transform the two-argument typemap into an array pointer */
+%fortran_2d_array_pointer($*1_ltype, %arg((SWIGTYPE *DATA, size_t ROWS, size_t COLS)))
+
+/* Transform (Swig2DArrayWrapper *$input) -> (SWIGTYPE *DATA, size_t ROWS, size_t COLS) */
+%typemap(in, noblock=1) (SWIGTYPE *DATA, size_t ROWS, size_t COLS) {
+$1 = ($1_ltype)$input->data;
+$2 = $input->rows;
+$3 = $input->cols;
+}
+
+/* Apply the typemaps to const versions as well */
+%apply (SWIGTYPE *DATA, size_t ROWS, size_t COLS) { (const SWIGTYPE *DATA, size_t ROWS, size_t COLS) };
+
+/* Add 'intent(in)' for const arrays */
+%typemap(ftype, in="$typemap(imtype, $*1_ltype), dimension(:,:), intent(in), target", noblock=1) (const SWIGTYPE *DATA, size_t ROWS, size_t COLS) {
+  $typemap(imtype, $*1_ltype), dimension(:,:), pointer
+}
+
 /* -------------------------------------------------------------------------
  * Interact natively with Fortran fixed-size arrays.
  *