From 5e252b77bb2664f633b61ac62bdfa3da28ccce7a Mon Sep 17 00:00:00 2001 From: wlthr Date: Thu, 13 Jul 2023 16:35:23 +0200 Subject: [PATCH] fixed issues with passing of arrays from fortran to c --- base/serial/impl/psb_d_csr_impl.F90 | 50 +++++---------- base/serial/impl/sp3mm4amg/Makefile | 11 +++- .../impl/sp3mm4amg/fbind/psb_f_spmm_ub.c | 62 ++++++++++++------- .../impl/sp3mm4amg/include/SpMMUtilsGeneric.h | 1 + base/serial/impl/sp3mm4amg/include/config.h | 2 +- .../impl/sp3mm4amg/include/ompChunksDivide.h | 1 + base/serial/impl/sp3mm_impl.f90 | 10 +-- 7 files changed, 71 insertions(+), 66 deletions(-) diff --git a/base/serial/impl/psb_d_csr_impl.F90 b/base/serial/impl/psb_d_csr_impl.F90 index 7476ca9f..db0df5b8 100644 --- a/base/serial/impl/psb_d_csr_impl.F90 +++ b/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 - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: spmm_impl_id + type(psb_d_csr_sparse_mat), intent(out) :: c + integer(psb_ipk_), intent(out) :: info 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 - ! 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 csr_spspmm(a,b,c,info) 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(in) :: spmm_impl_id + integer(psb_ipk_), intent(out) :: info 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 : - ! * 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_) + call dspmm(a, b, c, info, 0) end if end subroutine csr_spspmm end subroutine psb_dcsrspspmm - ! ! ! ld version diff --git a/base/serial/impl/sp3mm4amg/Makefile b/base/serial/impl/sp3mm4amg/Makefile index 978a74fd..9ceb1a75 100644 --- a/base/serial/impl/sp3mm4amg/Makefile +++ b/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 - $(CC) -c -o $@ $(CFLAGS) $^ $(LDFLAGS) +%.o : %.c $(HEADERS) + $(CC) -c -o $@ $(CFLAGS) $< -Iinclude/ $(MACROSDBG) $(LDFLAGS) objs: $(OBJS) diff --git a/base/serial/impl/sp3mm4amg/fbind/psb_f_spmm_ub.c b/base/serial/impl/sp3mm4amg/fbind/psb_f_spmm_ub.c index 0a4a0c8b..1f339bd6 100644 --- a/base/serial/impl/sp3mm4amg/fbind/psb_f_spmm_ub.c +++ b/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 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, - idx_t *a_irp, idx_t a_max_row_nz, + double **a_as_ptr, idx_t **a_ja_ptr, + 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, - idx_t *b_irp, idx_t b_max_row_nz, + double **b_as_ptr, idx_t **b_ja_ptr, + idx_t **b_irp_ptr, idx_t b_max_row_nz, enum impl_types impl_choice, void **accumul, void **rows_sizes, @@ -20,9 +23,17 @@ 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; - CONFIG *cfg; + spmat a, b; + 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; b->RL = b_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->N = a_n; - a->NZ = a_nz; - a->AS = a_as; - a->JA = a_ja; - a->IRP = a_irp; - a->MAX_ROW_NZ = a_max_row_nz; + a.M = a_m; + a.N = a_n; + a.NZ = a_nz; + a.AS = a_as; + a.JA = a_ja; + a.IRP = a_irp; + a.MAX_ROW_NZ = a_max_row_nz; - b->M = b_m; - b->N = b_n; - b->NZ = b_nz; - b->AS = b_as; - b->JA = b_ja; - b->IRP = b_irp; - b->MAX_ROW_NZ = b_max_row_nz; + b.M = b_m; + b.N = b_n; + b.NZ = b_nz; + b.AS = b_as; + b.JA = b_ja; + b.IRP = b_irp; + 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; diff --git a/base/serial/impl/sp3mm4amg/include/SpMMUtilsGeneric.h b/base/serial/impl/sp3mm4amg/include/SpMMUtilsGeneric.h index 99ec9f5f..85ad4e82 100644 --- a/base/serial/impl/sp3mm4amg/include/SpMMUtilsGeneric.h +++ b/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; rM; r++){ diff --git a/base/serial/impl/sp3mm4amg/include/config.h b/base/serial/impl/sp3mm4amg/include/config.h index a11f6d21..c504dfcc 100644 --- a/base/serial/impl/sp3mm4amg/include/config.h +++ b/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" diff --git a/base/serial/impl/sp3mm4amg/include/ompChunksDivide.h b/base/serial/impl/sp3mm4amg/include/ompChunksDivide.h index 5436d1af..6d0ba45c 100644 --- a/base/serial/impl/sp3mm4amg/include/ompChunksDivide.h +++ b/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*); diff --git a/base/serial/impl/sp3mm_impl.f90 b/base/serial/impl/sp3mm_impl.f90 index 1cdee141..972b4530 100644 --- a/base/serial/impl/sp3mm_impl.f90 +++ b/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_ja = c_loc(c%ja) - c_irp = c_loc(c%irp) + ! c_as = c_loc(c%val) + ! c_ja = c_loc(c%ja) + ! c_irp = c_loc(c%irp) ! c%set_nrows(a_m) ! c%set_ncols(b_n)