fixed issues with passing of arrays from fortran to c

base/serial/impl/psb_d_csr_impl.F90

@@ -3317,20 +3317,18 @@ subroutine  psb_d_csr_clean_zeros(a, info)
   call a%set_host()
 end subroutine psb_d_csr_clean_zeros
 
-subroutine psb_dcsrspspmm(a,b,c,info, spmm_impl_id)
+subroutine psb_dcsrspspmm(a,b,c,info)
   use psb_d_mat_mod
   use psb_serial_mod, psb_protect_name => psb_dcsrspspmm
 
   implicit none
 
   class(psb_d_csr_sparse_mat), intent(in) :: a,b
-  type(psb_d_csr_sparse_mat), intent(out) :: c
+  type(psb_d_csr_sparse_mat), intent(out)  :: c
-  integer(psb_ipk_), intent(out)          :: info
+  integer(psb_ipk_), intent(out)                     :: info
-  integer(psb_ipk_), intent(in), optional :: spmm_impl_id
   integer(psb_ipk_) :: ma,na,mb,nb, nzc, nza, nzb
   character(len=20) :: name
   integer(psb_ipk_) :: err_act
-  integer(psb_ipk_) :: spmm_impl_id_
   name='psb_csrspspmm'
   call psb_erractionsave(err_act)
   info = psb_success_
@@ -3357,17 +3355,7 @@ subroutine psb_dcsrspspmm(a,b,c,info, spmm_impl_id)
   nzc = 2*(nza+nzb)
   call c%allocate(ma,nb,nzc)
 
-  ! Uses optional argument to choose c 
+  call csr_spspmm(a,b,c,info)
-  ! implementation of spmm or sets default
-  ! choice if argument is missing
-  if (present(spmm_impl_id)) then
-    spmm_impl_id_ = spmm_impl_id
-  else
-    spmm_impl_id_ = 0
-  end if
-
-  ! CSR matrix multiplication
-  call csr_spspmm(a,b,c,info,spmm_impl_id_)
 
   call c%set_asb()
   call c%set_host()
@@ -3381,13 +3369,11 @@ subroutine psb_dcsrspspmm(a,b,c,info, spmm_impl_id)
 
 contains
 
-  subroutine csr_spspmm(a,b,c,info,spmm_impl_id)
+  subroutine csr_spspmm(a,b,c,info)
     implicit none
-    type(psb_d_csr_sparse_mat), intent(in)    :: a,b
+    type(psb_d_csr_sparse_mat), intent(in)  :: a,b
     type(psb_d_csr_sparse_mat), intent(inout) :: c
-    ! choice of spmm implementation from c code
+    integer(psb_ipk_), intent(out)          :: info
-    integer(psb_ipk_), intent(out)            :: info
-    integer(psb_ipk_), intent(in)             :: spmm_impl_id
     integer(psb_ipk_)              :: ma,na,mb,nb
     integer(psb_ipk_), allocatable :: irow(:), idxs(:)
     real(psb_dpk_), allocatable    :: row(:)
@@ -3395,13 +3381,14 @@ contains
          & nzc,nnzre, isz, ipb, irwsz, nrc, nze
     real(psb_dpk_)                 :: cfb
 
-    info = psb_success_
-    ma = a%get_nrows()
-    na = a%get_ncols()
-    mb = b%get_nrows()
-    nb = b%get_ncols()
 
-    if (.true.) then
+    if (.false.) then
+      info = psb_success_
+      ma = a%get_nrows()
+      na = a%get_ncols()
+      mb = b%get_nrows()
+      nb = b%get_ncols()
+
       nze = min(size(c%val),size(c%ja))
       isz = max(ma,na,mb,nb)
       call psb_realloc(isz,row,info)
@@ -3449,20 +3436,13 @@ contains
 
       c%irp(ma+1) = nzc
     else
-      !! TODO :
+      call dspmm(a, b, c, info, 0)
-      ! * convert psb_d_csr_sparse_mat a and b to spmat_t
-      ! * choice of implementation
-      ! * code interfaces for sp3mm code
-      ! * call wanted interface
-      ! * convert result from spmat_t to psb_d_csr_sparse_mat c
-      call dspmm(a,b,c,info,spmm_impl_id_)
     end if
 
   end subroutine csr_spspmm
 
 end subroutine psb_dcsrspspmm
 
-
 !
 !
 !  ld  version

base/serial/impl/sp3mm4amg/Makefile

@@ -1,6 +1,6 @@
 include ../../../../Make.inc
 
-CC=gcc
+CC=mpicc
 CWALL =-Wall -Wextra
 #extra to reduce useless warnings
 CWALL+=-Wno-pointer-sign -Wno-unused-parameter -Wno-unused-but-set-variable -Wno-switch
@@ -9,6 +9,8 @@ CWALL+=-Wno-unused-label -Wfatal-errors
 
 CINCL   = -Iinclude/ 
 CFLAGS  = -g -O3 $(CWALL) $(CINCL) -fopenmp $(RUNTIME)
+MACROS = -DDEBUGPRINT="if(FALSE)" -DDEBUG="if(FALSE)" -DCONSISTENCY_CHECKS="if(FALSE)" -DVERBOSE="if(FALSE)"  -DDEBUGCHECKS="if(FALSE)" 
+MACROSDBG = -DCONSISTENCY_CHECKS="if(TRUE)"  -DDEBUGCHECKS="if(TRUE)" -DVERBOSE="if(TRUE)" -DDEBUG="if(TRUE)"
 LDFLAGS = -lm
 
 LIBDIR=../../../
@@ -19,16 +21,19 @@ SP3MM_CORE_OBJS=Sp3MM_CSR_OMP_Multi.o \
 				commons/ompGetICV.o \
 				commons/sparseUtilsMulti.o \
 				commons/utils.o \
+				commons/ompi_dims_create/ompi_dims_create.o \
 				lib/linuxK_rbtree_minimalized.o \
 				lib/mmio.o \
 				lib/parser.o
 
 CBIND_OBJS=fbind/psb_f_spmm_ub.o
 
+HEADERS = $(wildcard include/*.h)
+
 OBJS= $(SP3MM_CORE_OBJS) $(CBIND_OBJS)
 
-%.o : %.c
+%.o : %.c $(HEADERS)
-	$(CC) -c -o $@ $(CFLAGS) $^ $(LDFLAGS)
+	$(CC) -c -o $@ $(CFLAGS) $< -Iinclude/ $(MACROSDBG) $(LDFLAGS)
 
 objs: $(OBJS)
 

base/serial/impl/sp3mm4amg/fbind/psb_f_spmm_ub.c

@@ -1,5 +1,6 @@
 #include "../include/Sp3MM_CSR_OMP_Multi.h"
 #include "../include/utils.h"
+#include "../include/ompChunksDivide.h"
 #include <stdio.h>
 
 enum impl_types
@@ -7,12 +8,14 @@ enum impl_types
     ROW_BY_ROW_UB
 };
 
+CHUNKS_DISTR chunksFair;
+
 void psb_f_spmm_build_spacc(idx_t a_m, idx_t a_n, idx_t a_nz,
-                             double *a_as, idx_t *a_ja,
+                             double **a_as_ptr, idx_t **a_ja_ptr,
-                             idx_t *a_irp, idx_t a_max_row_nz,
+                             idx_t **a_irp_ptr, idx_t a_max_row_nz,
                              idx_t b_m, idx_t b_n, idx_t b_nz,
-                             double *b_as, idx_t *b_ja,
+                             double **b_as_ptr, idx_t **b_ja_ptr,
-                             idx_t *b_irp, idx_t b_max_row_nz,
+                             idx_t **b_irp_ptr, idx_t b_max_row_nz,
                              enum impl_types impl_choice,
                              void **accumul,
                              void **rows_sizes,
@@ -20,8 +23,16 @@ void psb_f_spmm_build_spacc(idx_t a_m, idx_t a_n, idx_t a_nz,
                              idx_t *nnz)
 {
     int rc;
-    spmat *a, *b, *c;
+    spmat a, b;
-    CONFIG *cfg;
+    CONFIG cfg;
+
+    double *a_as = *a_as_ptr;
+    idx_t *a_ja = *a_ja_ptr;
+    idx_t *a_irp = *a_irp_ptr;
+
+    double *b_as = *b_as_ptr;
+    idx_t *b_ja = *b_ja_ptr;
+    idx_t *b_irp = *b_irp_ptr;
     
 #ifdef ROWLENS
     a->RL = a_rl;
@@ -30,30 +41,35 @@ void psb_f_spmm_build_spacc(idx_t a_m, idx_t a_n, idx_t a_nz,
 
     // setting up cfg
     // TODO : CHECK THAT THIS IS COMPATIBLE WITH PSB
-    rc = getConfig(cfg);
+    rc = getConfig(&cfg);
+
+    // TODO : change chunk distribution with a choice ?
+    cfg.chunkDistrbFunc = &chunksFair;
+    cfg.threadNum = 1;
 
+    printf("irp %d %d %d %d %d\n", a_irp[0], a_irp[1], a_irp[2], a_irp[3], a_irp[4]);
     // setting up spmat type matrices
-    a->M = a_m;
+    a.M = a_m;
-    a->N = a_n;
+    a.N = a_n;
-    a->NZ = a_nz;
+    a.NZ = a_nz;
-    a->AS = a_as;
+    a.AS = a_as;
-    a->JA = a_ja;
+    a.JA = a_ja;
-    a->IRP = a_irp;
+    a.IRP = a_irp;
-    a->MAX_ROW_NZ = a_max_row_nz;
+    a.MAX_ROW_NZ = a_max_row_nz;
 
-    b->M = b_m;
+    b.M = b_m;
-    b->N = b_n;
+    b.N = b_n;
-    b->NZ = b_nz;
+    b.NZ = b_nz;
-    b->AS = b_as;
+    b.AS = b_as;
-    b->JA = b_ja;
+    b.JA = b_ja;
-    b->IRP = b_irp;
+    b.IRP = b_irp;
-    b->MAX_ROW_NZ = b_max_row_nz;
+    b.MAX_ROW_NZ = b_max_row_nz;
 
     // computing the size
     switch (impl_choice)
     {
     case ROW_BY_ROW_UB:
-        *nnz = spmmRowByRowCalculateSize_0(a, b, cfg, accumul, rows_sizes, tmp_matrix);
+        *nnz = spmmRowByRowCalculateSize_1(&a, &b, &cfg, accumul, rows_sizes, tmp_matrix);
     default:
         break;
     }
@@ -72,7 +88,7 @@ void psb_f_spmm_merge_spacc(void **accumul,
     switch (impl_choice)
     {
     case ROW_BY_ROW_UB:
-        spmmRowByRowPopulate_0(accumul, rows_sizes, tmp_matrix, c_as, c_ja, c_irp);
+        spmmRowByRowPopulate_1(accumul, rows_sizes, tmp_matrix, c_as, c_ja, c_irp);
         break;
     default:
         break;

base/serial/impl/sp3mm4amg/include/SpMMUtilsGeneric.h

@@ -116,6 +116,7 @@ inline idx_t* CAT(spMMSizeUpperbound_,OFF_F)(spmat* A,spmat* B){
 		ERRPRINT("spMMSizeUpperbound: rowSizes calloc errd\n");
 		return NULL;
 	}
+	printf("A->IRP %ld %ld %ld %ld %ld\n", A->IRP[0], A->IRP[1], A->IRP[2], A->IRP[3], A->IRP[4]);
 	idx_t fullMatBound = 0;
 	#pragma omp parallel for schedule(static) reduction(+:fullMatBound)
 	for (idx_t r=0;  r<A->M; r++){

base/serial/impl/sp3mm4amg/include/config.h

@@ -48,7 +48,7 @@ typedef struct{
 	void* chunkDistrbFunc;  //CHUNKS_DISTR_INTERF func pntr
 } CONFIG;  
 ///Smart controls
-typedef size_t 		idx_t;	//spmat indexes
+typedef int 		idx_t;	//spmat indexes
 typedef unsigned __int128	uint128;
 
 #include "macros.h"

base/serial/impl/sp3mm4amg/include/ompChunksDivide.h

@@ -38,6 +38,7 @@
  * configuration is expected to have a valid number of threadNum setted
  */
 #include "config.h"
+#include "omp.h"
 //distribution of @rows|blocks of @matrix, exploiting @config
 typedef void (CHUNKS_DISTR )           (ulong,spmat*,CONFIG*);
 typedef void (*CHUNKS_DISTR_INTERF )   (ulong,spmat*,CONFIG*);

base/serial/impl/sp3mm_impl.f90

@@ -74,10 +74,12 @@ subroutine dspmm(a,b,c,info, impl_choice)
     a_m = a%get_nrows()
     a_n = a%get_ncols()
     a_nz = a%get_nzeros()
+    write(*,*) 'IRP(1:5) ',a%irp(1:5)
     a_as = c_loc(a%val)
     a_ja = c_loc(a%ja)
     a_irp = c_loc(a%irp)
-    ! ! a_max_row_nz
+    ! a_max_row_nz
+
     b_m = b%get_nrows()
     b_n = b%get_ncols()
     b_nz = b%get_nzeros()
@@ -99,9 +101,9 @@ subroutine dspmm(a,b,c,info, impl_choice)
     allocate(c%ja(nnz))
     allocate(c%irp(a_m + 1))
     
-    c_as = c_loc(c%val)
+    ! c_as = c_loc(c%val)
-    c_ja = c_loc(c%ja)
+    ! c_ja = c_loc(c%ja)
-    c_irp = c_loc(c%irp)
+    ! c_irp = c_loc(c%irp)
 
     ! c%set_nrows(a_m)
     ! c%set_ncols(b_n)