Add bml_get_deep_type function

src/C-interface/bml_introspection.c

@@ -35,6 +35,31 @@ bml_get_type(
 
 }
 
+/** Return the matrix type for the data storage
+ *  For distributed2 matrices, return the matrix type
+ *  for the local submatrices
+ *
+ * \param A The matrix.
+ * \return The matrix type
+ */
+bml_matrix_type_t
+bml_get_deep_type(
+    bml_matrix_t * A)
+{
+    switch (bml_get_type(A))
+    {
+#ifdef DO_MPI
+        case distributed2d:
+            return bml_get_type(bml_get_local_matrix(A));
+            break;
+#endif
+        default:
+            return bml_get_type(A);
+            break;
+    }
+    return -1;
+}
+
 /** Return the matrix precision.
  *
  * \param A The matrix.

src/C-interface/bml_introspection.h

@@ -8,6 +8,9 @@
 bml_matrix_type_t bml_get_type(
     bml_matrix_t * A);
 
+bml_matrix_type_t bml_get_deep_type(
+    bml_matrix_t * A);
+
 bml_matrix_precision_t bml_get_precision(
     bml_matrix_t * A);
 

src/Fortran-interface/bml_c_interface_m.F90

@@ -236,6 +236,12 @@ function bml_get_type_C(a) bind(C, name="bml_get_type")
       integer(C_INT) :: bml_get_type_C
     end function bml_get_type_C
 
+    function bml_get_deep_type_C(a) bind(C, name="bml_get_deep_type")
+      import :: C_PTR, C_INT
+      type(C_PTR), value, intent(in) :: a
+      integer(C_INT) :: bml_get_deep_type_C
+    end function bml_get_deep_type_C
+
     function bml_get_precision_C(a) bind(C, name="bml_get_precision")
       import :: C_PTR, C_INT
       type(C_PTR), value, intent(in) :: a

src/Fortran-interface/bml_introspection_m.F90

@@ -10,6 +10,7 @@ module bml_introspection_m
   public :: bml_get_N
   public :: bml_get_M
   public :: bml_get_type
+  public :: bml_get_deep_type
   public :: bml_get_element_precision
   public :: bml_get_precision
   public :: bml_get_element_type
@@ -105,6 +106,37 @@ function bml_get_type(a)
 
   end function bml_get_type
 
+  !> Get the type of a local matrix.
+  !!
+  !! @param a The matrix.
+  !! @returns The bml format type of the matrix.
+  function bml_get_deep_type(a)
+
+    type(bml_matrix_t), intent(in) :: a
+    integer :: bml_get_type_num
+    character(20) :: bml_get_deep_type
+
+    bml_get_type_num = bml_get_deep_type_C(a%ptr)
+
+    select case(bml_get_type_num)
+    case(0)
+      bml_get_deep_type = "Unformatted"
+    case(1)
+      bml_get_deep_type = "dense"
+    case(2)
+      bml_get_deep_type = "ellpack"
+    case(3)
+      bml_get_deep_type = "ellblock"
+    case(4)
+      bml_get_deep_type = "ellsort"
+    case(5)
+      bml_get_deep_type = "csr"
+    case default
+      stop 'Unknown matrix type in bml_get_deep_type'
+    end select
+
+  end function bml_get_deep_type
+
   !> Get the precision/type index of the elements of a matrix.
   !!
   !! @param a The matrix.

tests/C-tests/CMakeLists.txt

@@ -12,6 +12,7 @@ set(SOURCES_TYPED
   get_set_diagonal_typed.c
   get_sparsity_typed.c
   import_export_matrix_typed.c
+  introspection_typed.c
   inverse_matrix_typed.c
   io_matrix_typed.c
   mpi_sendrecv_typed.c
@@ -59,6 +60,7 @@ add_executable(bml-test
   get_set_diagonal.c
   get_sparsity.c
   import_export_matrix.c
+  introspection.c
   inverse_matrix.c
   io_matrix.c
   mpi_sendrecv.c
@@ -127,6 +129,7 @@ set(testlist-mpi
     copy
     diagonalize
     import_export
+    introspection
     io_matrix
     scale
     mpi_sendrecv
@@ -152,6 +155,7 @@ set(testlist
   get_set_diagonal
   get_sparsity
   import_export
+  introspection
   inverse
   io_matrix
   multiply

tests/C-tests/bml_test.c

@@ -9,9 +9,9 @@
 #include "bml_test.h"
 
 #ifdef DO_MPI
-const int NUM_TESTS = 29;
+const int NUM_TESTS = 30;
 #else
-const int NUM_TESTS = 28;
+const int NUM_TESTS = 29;
 #endif
 
 typedef struct
@@ -34,6 +34,7 @@ const char *test_name[] = {
     "get_element",
     "get_set_diagonal",
     "get_sparsity",
+    "introspection",
     "inverse",
     "io_matrix",
 #ifdef DO_MPI
@@ -68,6 +69,7 @@ const char *test_description[] = {
     "Get an element from a bml matrix",
     "Set the diagonal elements of bml matrices",
     "Get the sparsity",
+    "Query matrix properties",
     "Matrix inverse",
     "Read and write an mtx matrix",
 #ifdef DO_MPI
@@ -102,6 +104,7 @@ const test_function_t testers[] = {
     test_get_element,
     test_get_set_diagonal,
     test_get_sparsity,
+    test_introspection,
     test_inverse,
     test_io_matrix,
 #ifdef DO_MPI

tests/C-tests/bml_test.h

@@ -21,6 +21,7 @@ typedef int (
 #include "get_set_diagonal.h"
 #include "get_sparsity.h"
 #include "import_export_matrix.h"
+#include "introspection.h"
 #include "inverse_matrix.h"
 #include "io_matrix.h"
 #include "mpi_sendrecv.h"

tests/C-tests/introspection.c

@@ -0,0 +1,36 @@
+#include "bml.h"
+#include "bml_test.h"
+
+#include <stdio.h>
+
+int
+test_introspection(
+    const int N,
+    const bml_matrix_type_t matrix_type,
+    const bml_matrix_precision_t matrix_precision,
+    const int M)
+{
+    switch (matrix_precision)
+    {
+        case single_real:
+            return test_introspection_single_real(N, matrix_type,
+                                                  matrix_precision, M);
+            break;
+        case double_real:
+            return test_introspection_double_real(N, matrix_type,
+                                                  matrix_precision, M);
+            break;
+        case single_complex:
+            return test_introspection_single_complex(N, matrix_type,
+                                                     matrix_precision, M);
+            break;
+        case double_complex:
+            return test_introspection_double_complex(N, matrix_type,
+                                                     matrix_precision, M);
+            break;
+        default:
+            fprintf(stderr, "unknown matrix precision\n");
+            return -1;
+            break;
+    }
+}

tests/C-tests/introspection.h

@@ -0,0 +1,36 @@
+#ifndef __INTROSPECTION_H
+#define __INTROSPECTION_H
+
+#include <bml.h>
+
+int test_introspection(
+    const int N,
+    const bml_matrix_type_t matrix_type,
+    const bml_matrix_precision_t matrix_precision,
+    const int M);
+
+int test_introspection_single_real(
+    const int N,
+    const bml_matrix_type_t matrix_type,
+    const bml_matrix_precision_t matrix_precision,
+    const int M);
+
+int test_introspection_double_real(
+    const int N,
+    const bml_matrix_type_t matrix_type,
+    const bml_matrix_precision_t matrix_precision,
+    const int M);
+
+int test_introspection_single_complex(
+    const int N,
+    const bml_matrix_type_t matrix_type,
+    const bml_matrix_precision_t matrix_precision,
+    const int M);
+
+int test_introspection_double_complex(
+    const int N,
+    const bml_matrix_type_t matrix_type,
+    const bml_matrix_precision_t matrix_precision,
+    const int M);
+
+#endif

tests/C-tests/introspection_typed.c

@@ -0,0 +1,73 @@
+#include "bml.h"
+#include "../typed.h"
+#include "bml_introspection.h"
+
+#include <stdlib.h>
+#include <stdio.h>
+
+int TYPED_FUNC(
+    test_introspection) (
+    const int N,
+    const bml_matrix_type_t matrix_type,
+    const bml_matrix_precision_t matrix_precision,
+    const int M)
+{
+    bml_matrix_t *A = NULL;
+
+    bml_distribution_mode_t distrib_mode = sequential;
+#ifdef DO_MPI
+    if (bml_getNRanks() > 1)
+    {
+        LOG_INFO("Use distributed matrix\n");
+        distrib_mode = distributed;
+    }
+#endif
+
+    A = bml_random_matrix(matrix_type, matrix_precision, N, M, distrib_mode);
+
+    bml_matrix_type_t deep_type = bml_get_deep_type(A);
+
+    bml_matrix_type_t type = bml_get_type(A);
+
+#ifdef DO_MPI
+    switch (deep_type)
+    {
+        case dense:
+            LOG_INFO("deep type is dense\n");
+            break;
+        case ellpack:
+            LOG_INFO("deep type is ellpack\n");
+            break;
+        case ellsort:
+            LOG_INFO("deep type is ellsort\n");
+            break;
+        case ellblock:
+            LOG_INFO("deep type is ellblock\n");
+            break;
+        case csr:
+            LOG_INFO("deep type is csr\n");
+            break;
+        case distributed2d:
+            LOG_ERROR("deep type should not be distributed2d\n");
+            return -1;
+            break;
+        default:
+            LOG_ERROR("unknown deep type\n");
+            return -1;
+            break;
+    }
+
+#else
+    if (deep_type != type)
+    {
+        LOG_ERROR("type and deep_type not equal!\n");
+        return -1;
+    }
+#endif
+
+    LOG_INFO("bml_introspection passed for task %d\n", bml_getMyRank());
+
+    bml_deallocate(&A);
+
+    return 0;
+}