From 392ae64e6c89e7abaa689bc8b23d7ea277b4c0ab Mon Sep 17 00:00:00 2001 From: Michele Martone Date: Tue, 30 Nov 2010 13:43:38 +0000 Subject: [PATCH] psblas3: passing relevant flags to the RSB constructor. --- opt/psb_d_rsb_mat_mod.F03 | 43 +++++++++++++++++++++++---------------- 1 file changed, 26 insertions(+), 17 deletions(-) diff --git a/opt/psb_d_rsb_mat_mod.F03 b/opt/psb_d_rsb_mat_mod.F03 index f5a0e25f..bf17975f 100644 --- a/opt/psb_d_rsb_mat_mod.F03 +++ b/opt/psb_d_rsb_mat_mod.F03 @@ -26,6 +26,9 @@ module psb_d_rsb_mat_mod integer :: c_own_flags =2 ! flags if rsb input shall not be freed by rsb integer :: c_upd_flags =c_f_index ! flags for when updating the assembled rsb matrix integer :: c_tri_flags =16777216 ! flags for specifying a triangle + integer :: c_low_flags =16384 ! flags for specifying a lower triangle/symmetry + integer :: c_upp_flags =33554432 ! flags for specifying a lower triangle/symmetry + integer :: c_idi_flags =262144 ! flags for specifying diagonal implicit type, extends(psb_d_base_sparse_mat) :: psb_d_rsb_sparse_mat #ifdef HAVE_LIBRSB type(c_ptr) :: rsbmptr=c_null_ptr @@ -98,6 +101,19 @@ module psb_d_rsb_mat_mod res=info end function d_rsb_to_psb_info + function d_rsb_get_flags(a) result(flags) + implicit none + integer :: flags + class(psb_d_base_sparse_mat), intent(in) :: a + !PSBRSB_DEBUG('') + flags=c_def_flags + if(a%is_sorted()) flags=flags+c_srt_flags + if(a%is_triangle()) flags=flags+c_tri_flags + if(a%is_upper()) flags=flags+c_upp_flags + if(a%is_unit()) flags=flags+c_idi_flags + if(a%is_lower()) flags=flags+c_low_flags + end function d_rsb_get_flags + function d_rsb_get_nzeros(a) result(res) implicit none class(psb_d_rsb_sparse_mat), intent(in) :: a @@ -155,7 +171,7 @@ subroutine psb_d_rsb_csmv(alpha,a,x,beta,y,info,trans) integer, intent(out) :: info character, optional, intent(in) :: trans character :: trans_ - PSBRSB_DEBUG('') +! PSBRSB_DEBUG('') info = psb_success_ if (present(trans)) then @@ -184,7 +200,7 @@ subroutine psb_d_rsb_cssv(alpha,a,x,beta,y,info,trans) info = psb_success_ call psb_erractionsave(err_act) - PSBRSB_DEBUG('') +! PSBRSB_DEBUG('') if (present(trans)) then trans_ = trans @@ -433,7 +449,7 @@ subroutine psb_d_cp_rsb_to_coo(a,b,info) Integer :: nza, nr, nc,i,j,irw, idl,err_act integer :: debug_level, debug_unit character(len=20) :: name - PSBRSB_DEBUG('') + ! PSBRSB_DEBUG('') info = psb_success_ nr = a%get_nrows() nc = a%get_ncols() @@ -504,17 +520,13 @@ subroutine psb_d_cp_rsb_from_coo(a,b,info) integer :: debug_level, debug_unit integer :: flags character(len=20) :: name - PSBRSB_DEBUG('') + ! PSBRSB_DEBUG('') - flags=c_def_flags + flags=d_rsb_get_flags(b) + info = psb_success_ call a%psb_d_base_sparse_mat%cp_from(b%psb_d_base_sparse_mat) - if(b%is_sorted()) flags=flags+c_srt_flags - if(b%is_triangle()) flags=flags+c_tri_flags - if(b%is_lower()) write (*,*) 'LOWER' - if(b%is_triangle()) write (*,*) 'TRIANGLE' - if(b%is_upper()) write (*,*) 'UPPER' !write (*,*) b%val ! FIXME: and if sorted ? the process could be speeded up ! a%rsbmptr=rsb_allocate_rsb_sparse_matrix_const& @@ -541,9 +553,7 @@ subroutine psb_d_cp_rsb_from_fmt(a,b,info) PSBRSB_DEBUG('') info = psb_success_ - flags=c_def_flags - if(b%is_sorted()) flags=flags+c_srt_flags - if(b%is_triangle()) flags=flags+c_tri_flags + flags=d_rsb_get_flags(b) select type (b) type is (psb_d_coo_sparse_mat) @@ -551,7 +561,6 @@ subroutine psb_d_cp_rsb_from_fmt(a,b,info) type is (psb_d_csr_sparse_mat) call a%psb_d_base_sparse_mat%cp_from(b%psb_d_base_sparse_mat) - flags=flags+c_srt_flags a%rsbmptr=rsb_allocate_rsb_sparse_matrix_from_csr_const& &(b%val,b%irp,b%ja,b%get_nzeros(),c_d_typecode,b%get_nrows(),b%get_ncols(),1,1,flags,info) info=d_rsb_to_psb_info(info) @@ -588,7 +597,7 @@ subroutine psb_d_rsb_csgetrow(imin,imax,a,nz,ia,ja,val,info,& character(len=20) :: name='csget' logical, parameter :: debug=.false. ! FIXME: MISSING THE HANDLING OF OPTIONS, HERE - PSBRSB_DEBUG('') + ! PSBRSB_DEBUG('') call psb_erractionsave(err_act) info = psb_success_ @@ -759,7 +768,7 @@ subroutine psb_d_mv_rsb_from_fmt(a,b,info) ! FIXME: could use here rsb_allocate_rsb_sparse_matrix_from_csr_inplace !if(b%is_sorted()) flags=flags+c_srt_flags type(psb_d_coo_sparse_mat) :: tmp - PSBRSB_DEBUG('') + ! PSBRSB_DEBUG('') info = psb_success_ select type (b) class default @@ -774,7 +783,7 @@ subroutine psb_d_mv_rsb_from_coo(a,b,info) class(psb_d_rsb_sparse_mat), intent(inout) :: a class(psb_d_coo_sparse_mat), intent(inout) :: b integer, intent(out) :: info - PSBRSB_DEBUG('') + ! PSBRSB_DEBUG('') ! FIXME: should use rsb_allocate_rsb_sparse_matrix_inplace !if(b%is_sorted()) flags=flags+c_srt_flags !if(b%is_triangle()) flags=flags+c_tri_flags