From 723200a4e3de00f6e6a9a7245441d4284176fbe8 Mon Sep 17 00:00:00 2001 From: Michele Martone Date: Fri, 19 Nov 2010 09:33:51 +0000 Subject: [PATCH] psblas3: more fixwork towards RSB integration. --- test/serial/Makefile | 3 ++- test/serial/d_matgen.f03 | 4 ++- test/serial/psb_d_rsb_mat_mod.F03 | 45 +++++++++++++++++-------------- test/serial/rsb_mod.f03 | 6 ++--- 4 files changed, 33 insertions(+), 25 deletions(-) diff --git a/test/serial/Makefile b/test/serial/Makefile index ae033309..de31366f 100644 --- a/test/serial/Makefile +++ b/test/serial/Makefile @@ -42,7 +42,8 @@ clean: psb_d_czz_mat_mod.o \ psb_d_rsb_mat_mod.o \ psb_d_cyy_mat_mod.o psb_d_cyy_impl.o \ - psb_d_cxx_mat_mod.o psb_d_cxx_impl.o *$(.mod) + psb_d_cxx_mat_mod.o psb_d_cxx_impl.o *$(.mod) \ + rsb_mod.o verycleanlib: (cd ../..; make veryclean) lib: diff --git a/test/serial/d_matgen.f03 b/test/serial/d_matgen.f03 index 1a5342de..7e7cce9d 100644 --- a/test/serial/d_matgen.f03 +++ b/test/serial/d_matgen.f03 @@ -384,7 +384,7 @@ contains !!$ call a_n%print(19) t1 = psb_wtime() call a_n%cscnv(info,mold=mold) - stop + if(info /= psb_success_) then info=psb_err_from_subroutine_ @@ -424,6 +424,8 @@ contains call a_n%get_diag(diag,info) end if !!$ + !write (*,*) acxx%val + !write (*,*) diag t1 = psb_wtime() call a_n%cscnv(info,mold=acsr) diff --git a/test/serial/psb_d_rsb_mat_mod.F03 b/test/serial/psb_d_rsb_mat_mod.F03 index 4f30be89..36658942 100644 --- a/test/serial/psb_d_rsb_mat_mod.F03 +++ b/test/serial/psb_d_rsb_mat_mod.F03 @@ -10,6 +10,7 @@ module psb_d_rsb_mat_mod use psb_d_base_mat_mod use rsb_mod +#define HAVE_LIBRSB 1 #ifdef HAVE_LIBRSB use iso_c_binding #endif @@ -20,8 +21,8 @@ module psb_d_rsb_mat_mod #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=0 ! FIXME: here should use .. - integer :: c_def_flags =0 ! FIXME: here should use .. + integer :: c_d_typecode=68 ! FIXME: here should use .. + integer :: c_def_flags =-2080358268+4096 ! 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 @@ -59,7 +60,7 @@ module psb_d_rsb_mat_mod procedure, pass(a) :: d_csgetrow => psb_d_rsb_csgetrow procedure, pass(a) :: get_nz_row => d_rsb_get_nz_row procedure, pass(a) :: reinit => psb_d_rsb_reinit - procedure, pass(a) :: trim => psb_d_rsb_trim + procedure, pass(a) :: trim => psb_d_rsb_trim ! evil procedure, pass(a) :: print => psb_d_rsb_print procedure, pass(a) :: free => d_rsb_free procedure, pass(a) :: mold => psb_d_rsb_mold @@ -79,7 +80,7 @@ module psb_d_rsb_mat_mod function d_rsb_to_psb_info(info) result(res) implicit none integer :: res,info - PSBRSB_DEBUG('') + !PSBRSB_DEBUG('') res=info end function d_rsb_to_psb_info @@ -87,7 +88,7 @@ module psb_d_rsb_mat_mod implicit none class(psb_d_rsb_sparse_mat), intent(in) :: a integer :: res - PSBRSB_DEBUG('') + !PSBRSB_DEBUG('') res=rsb_get_matrix_nnz(a%rsbmptr) end function d_rsb_get_nzeros @@ -95,15 +96,16 @@ module psb_d_rsb_mat_mod implicit none class(psb_d_rsb_sparse_mat), intent(in) :: a character(len=5) :: res - PSBRSB_DEBUG('') - res = 'RSB' + !the following printout is harmful, here, if happening during a write :) (causes a deadlock) + !PSBRSB_DEBUG('') + res = 'RSB ' end function d_rsb_get_fmt function d_rsb_get_size(a) result(res) implicit none class(psb_d_rsb_sparse_mat), intent(in) :: a integer :: res - PSBRSB_DEBUG('') + !PSBRSB_DEBUG('') res = d_rsb_get_nzeros(a) end function d_rsb_get_size @@ -111,7 +113,7 @@ module psb_d_rsb_mat_mod implicit none class(psb_d_rsb_sparse_mat), intent(in) :: a integer(psb_long_int_k_) :: res - PSBRSB_DEBUG('') + !PSBRSB_DEBUG('') res=rsb_sizeof(a%rsbmptr) end function d_rsb_sizeof @@ -179,14 +181,14 @@ end subroutine psb_d_rsb_scal implicit none class(psb_d_rsb_sparse_mat), intent(inout) :: a type(c_ptr) :: dummy - PSBRSB_DEBUG('') + !PSBRSB_DEBUG('freeing RSB matrix') dummy=rsb_free_sparse_matrix(a%rsbmptr) end subroutine d_rsb_free subroutine psb_d_rsb_trim(a) implicit none class(psb_d_rsb_sparse_mat), intent(inout) :: a - PSBRSB_DEBUG('') + !PSBRSB_DEBUG('') ! FIXME: this is supposed to remain empty for RSB end subroutine psb_d_rsb_trim @@ -207,26 +209,31 @@ end subroutine psb_d_rsb_trim class(psb_d_rsb_sparse_mat), intent(in) :: a real(psb_dpk_), intent(out) :: d(:) integer, intent(out) :: info - PSBRSB_DEBUG('') + !PSBRSB_DEBUG('') info=rsb_getdiag(a%rsbmptr,d) end subroutine psb_d_rsb_get_diag function psb_d_rsb_csnmi(a) result(res) implicit none class(psb_d_rsb_sparse_mat), intent(in) :: a - real(psb_dpk_) :: res + real(psb_dpk_),target :: res + real(psb_dpk_) :: resa(1) integer :: info PSBRSB_DEBUG('') - info=rsb_infinity_norm(a%rsbmptr,res,rsb_psblas_trans_to_rsb_trans('N')) + info=rsb_infinity_norm(a%rsbmptr,resa,rsb_psblas_trans_to_rsb_trans('N')) + !info=rsb_infinity_norm(a%rsbmptr,c_loc(res),rsb_psblas_trans_to_rsb_trans('N')) + res=resa(1) end function psb_d_rsb_csnmi function psb_d_rsb_csnm1(a) result(res) implicit none class(psb_d_rsb_sparse_mat), intent(in) :: a real(psb_dpk_) :: res + real(psb_dpk_) :: resa(1) integer :: info PSBRSB_DEBUG('') - info=rsb_one_norm(a%rsbmptr,res,rsb_psblas_trans_to_rsb_trans('N')) + info=rsb_one_norm(a%rsbmptr,resa,rsb_psblas_trans_to_rsb_trans('N')) + !info=rsb_one_norm(a%rsbmptr,res,rsb_psblas_trans_to_rsb_trans('N')) end function psb_d_rsb_csnm1 subroutine psb_d_rsb_aclsum(d,a) @@ -423,7 +430,6 @@ subroutine psb_d_cp_rsb_from_coo(a,b,info) class(psb_d_coo_sparse_mat), intent(in) :: b integer, intent(out) :: info - type(psb_d_coo_sparse_mat) :: tmp integer, allocatable :: itemp(:) !locals logical :: rwshr_ @@ -434,10 +440,9 @@ subroutine psb_d_cp_rsb_from_coo(a,b,info) info = psb_success_ ! This is to have fix_coo called behind the scenes - call b%cp_to_coo(tmp,info) - if (info == psb_success_) call a%mv_from_coo(tmp,info) + !write (*,*) b%val a%rsbmptr=rsb_allocate_rsb_sparse_matrix_const& - &(tmp%val,tmp%ia,tmp%ja,tmp%get_nzeros(),c_d_typecode,tmp%get_nrows(),tmp%get_ncols(),1,1,c_def_flags,info) + &(b%val,b%ia,b%ja,b%get_nzeros(),c_d_typecode,b%get_nrows(),b%get_ncols(),1,1,c_def_flags,info) info=d_rsb_to_psb_info(info) ! FIXME: should destroy tmp ? end subroutine psb_d_cp_rsb_from_coo @@ -639,7 +644,7 @@ subroutine psb_d_mv_rsb_to_coo(a,b,info) integer, intent(out) :: info PSBRSB_DEBUG('') call psb_d_cp_rsb_to_coo(a,b,info) - call d_rsb_free(a) + call a%free() end subroutine psb_d_mv_rsb_to_coo subroutine psb_d_mv_rsb_to_fmt(a,b,info) diff --git a/test/serial/rsb_mod.f03 b/test/serial/rsb_mod.f03 index ee1105e5..9a4834b0 100644 --- a/test/serial/rsb_mod.f03 +++ b/test/serial/rsb_mod.f03 @@ -207,7 +207,7 @@ integer(c_int) function & &bind(c,name='rsb_infinity_norm') use iso_c_binding type(c_ptr), value :: matrix - real(c_double) :: infinity_norm + real(c_double) :: infinity_norm(*) integer(c_int), value :: transa end function rsb_infinity_norm end interface @@ -215,11 +215,11 @@ end interface interface integer(c_int) function & &rsb_one_norm& - &(matrix,infinity_norm,transa)& + &(matrix,one_norm,transa)& &bind(c,name='rsb_one_norm') use iso_c_binding type(c_ptr), value :: matrix - real(c_double) :: infinity_norm + real(c_double) :: one_norm(*) integer(c_int), value :: transa end function rsb_one_norm end interface