From 7eb4a4d1d0d78aaf1cd150ec89805ab865663fcc Mon Sep 17 00:00:00 2001 From: Michele Martone Date: Fri, 19 Nov 2010 13:28:04 +0000 Subject: [PATCH] psblas3: more interface fixes on the RSB side. --- test/serial/d_matgen.f03 | 10 +------ test/serial/psb_d_rsb_mat_mod.F03 | 49 +++++++++++++++++++++++++++---- test/serial/rsb_mod.f03 | 20 +++++++++++++ 3 files changed, 65 insertions(+), 14 deletions(-) diff --git a/test/serial/d_matgen.f03 b/test/serial/d_matgen.f03 index 4b6f59f3..77ebb504 100644 --- a/test/serial/d_matgen.f03 +++ b/test/serial/d_matgen.f03 @@ -7,9 +7,7 @@ program d_matgen use psb_d_cxx_mat_mod use psb_d_cyy_mat_mod use psb_d_czz_mat_mod -#ifdef HAVE_LIBRSB use psb_d_rsb_mat_mod -#endif implicit none ! input parameters @@ -35,9 +33,7 @@ program d_matgen integer :: iter, itmax,itrace, istopc, irst integer(psb_long_int_k_) :: amatsize, precsize, descsize real(psb_dpk_) :: err, eps -#ifdef HAVE_LIBRSB type(psb_d_rsb_sparse_mat) :: arsb -#endif type(psb_d_cyy_sparse_mat) :: acyy type(psb_d_czz_sparse_mat) :: aczz type(psb_d_cxx_sparse_mat) :: acxx @@ -48,9 +44,7 @@ program d_matgen info=psb_success_ -#ifdef HAVE_LIBRSB - info=rsb_init() -#endif + info=psv_rsb_mat_init() if(info/=psb_success_)info=psb_err_from_subroutine_ if(info/=psb_success_)goto 9999 @@ -79,9 +73,7 @@ program d_matgen !call create_matrix(idim,a,b,x,desc_a,ictxt,afmt,info,acyy) !call create_matrix(idim,a,b,x,desc_a,ictxt,afmt,info,aczz) !call create_matrix(idim,a,b,x,desc_a,ictxt,afmt,info,acxx) -#ifdef HAVE_LIBRSB call create_matrix(idim,a,b,x,desc_a,ictxt,afmt,info,arsb) -#endif call psb_barrier(ictxt) t2 = psb_wtime() - t1 if(info /= psb_success_) then diff --git a/test/serial/psb_d_rsb_mat_mod.F03 b/test/serial/psb_d_rsb_mat_mod.F03 index da4774de..a49c5ff5 100644 --- a/test/serial/psb_d_rsb_mat_mod.F03 +++ b/test/serial/psb_d_rsb_mat_mod.F03 @@ -19,9 +19,9 @@ module psb_d_rsb_mat_mod #define PSBRSB_DEBUG(MSG) #endif integer :: c_f_order=2 ! FIXME: here should use RSB_FLAG_WANT_COLUMN_MAJOR_ORDER - integer :: c_f_index=256*16 ! 0x001000 ! FIXME: here should use RSB_FLAG_FORTRAN_INDICES_INTERFACE - integer :: c_d_typecode=68 ! FIXME: here should use .. - integer :: c_def_flags =-2080358268+4096 ! FIXME: here should use .. + integer,parameter :: c_f_index=256*16 ! 0x001000 ! FIXME: here should use RSB_FLAG_FORTRAN_INDICES_INTERFACE + integer,parameter :: c_d_typecode=68 ! FIXME: here should use .. + integer,parameter :: c_def_flags =-2080358268+c_f_index ! FIXME: here should use .. integer :: c_upd_flags =0 ! FIXME: here should use .. type, extends(psb_d_base_sparse_mat) :: psb_d_rsb_sparse_mat #ifdef HAVE_LIBRSB @@ -29,6 +29,8 @@ module psb_d_rsb_mat_mod contains procedure, pass(a) :: get_size => d_rsb_get_size procedure, pass(a) :: get_nzeros => d_rsb_get_nzeros + procedure, pass(a) :: get_ncols => d_rsb_get_ncols + procedure, pass(a) :: get_nrows => d_rsb_get_nrows procedure, pass(a) :: get_fmt => d_rsb_get_fmt procedure, pass(a) :: sizeof => d_rsb_sizeof procedure, pass(a) :: d_csmm => psb_d_rsb_csmm @@ -76,7 +78,17 @@ module psb_d_rsb_mat_mod #ifdef HAVE_LIBRSB contains - function d_rsb_to_psb_info(info) result(res) + function psv_rsb_mat_init() result(res) + implicit none + integer :: res + !PSBRSB_DEBUG('') + res=-1 ! FIXME +#ifdef HAVE_LIBRSB + res=d_rsb_to_psb_info(rsb_init()) +#endif + end function psv_rsb_mat_init + + function d_rsb_to_psb_info(info) result(res) implicit none integer :: res,info !PSBRSB_DEBUG('') @@ -91,13 +103,29 @@ module psb_d_rsb_mat_mod res=rsb_get_matrix_nnz(a%rsbmptr) end function d_rsb_get_nzeros + function d_rsb_get_nrows(a) result(res) + implicit none + class(psb_d_rsb_sparse_mat), intent(in) :: a + integer :: res + !PSBRSB_DEBUG('') + res=rsb_get_matrix_n_rows(a%rsbmptr) + end function d_rsb_get_nrows + + function d_rsb_get_ncols(a) result(res) + implicit none + class(psb_d_rsb_sparse_mat), intent(in) :: a + integer :: res + !PSBRSB_DEBUG('') + res=rsb_get_matrix_n_columns(a%rsbmptr) + end function d_rsb_get_ncols + function d_rsb_get_fmt(a) result(res) implicit none class(psb_d_rsb_sparse_mat), intent(in) :: a character(len=5) :: res !the following printout is harmful, here, if happening during a write :) (causes a deadlock) !PSBRSB_DEBUG('') - res = 'RSB ' + res = 'RSB' end function d_rsb_get_fmt function d_rsb_get_size(a) result(res) @@ -385,7 +413,18 @@ subroutine psb_d_cp_rsb_to_coo(a,b,info) call b%psb_d_base_sparse_mat%cp_from(a%psb_d_base_sparse_mat) info=d_rsb_to_psb_info(rsb_get_coo(a%rsbmptr,b%val,b%ia,b%ja,c_f_index)) call b%set_nzeros(a%get_nzeros()) + call b%set_nrows(a%get_nrows()) + call b%set_ncols(a%get_ncols()) call b%fix(info) + !write(*,*)b%val + !write(*,*)b%ia + !write(*,*)b%ja + !write(*,*)b%get_nrows() + !write(*,*)b%get_ncols() + !write(*,*)b%get_nzeros() + !write(*,*)a%get_nrows() + !write(*,*)a%get_ncols() + !write(*,*)a%get_nzeros() end subroutine psb_d_cp_rsb_to_coo subroutine psb_d_cp_rsb_to_fmt(a,b,info) diff --git a/test/serial/rsb_mod.f03 b/test/serial/rsb_mod.f03 index 9a4834b0..f29751ff 100644 --- a/test/serial/rsb_mod.f03 +++ b/test/serial/rsb_mod.f03 @@ -704,6 +704,26 @@ use iso_c_binding end function rsb_get_matrix_nnz end interface +interface +integer(c_int) function & + &rsb_get_matrix_n_rows& + &(matrix)& + &bind(c,name='rsb_get_matrix_n_rows') +use iso_c_binding + type(c_ptr), value :: matrix + end function rsb_get_matrix_n_rows +end interface + +interface +integer(c_int) function & + &rsb_get_matrix_n_columns& + &(matrix)& + &bind(c,name='rsb_get_matrix_n_columns') +use iso_c_binding + type(c_ptr), value :: matrix + end function rsb_get_matrix_n_columns +end interface + interface integer(c_int) function & &rsb_elemental_scale&