fixed issues with passing of arrays from fortran to c

sp3mm-interface
wlthr 3 years ago
parent c252f16fd0
commit 5e252b77bb

@ -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

@ -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)

@ -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,
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;

@ -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++){

@ -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"

@ -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*);

@ -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)

Loading…
Cancel
Save