mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-17 19:32:08 +00:00
psblas-3.99:
First shot at new IMOLD stuff.
This commit is contained in:
@@ -50,6 +50,7 @@ module psb_d_linmap_mod
|
||||
procedure, pass(map) :: is_asb => d_is_asb
|
||||
procedure, pass(map) :: free => d_free
|
||||
procedure, pass(map) :: clone => d_clone
|
||||
procedure, pass(map) :: cnv => psb_d_map_cscnv
|
||||
end type psb_dlinmap_type
|
||||
|
||||
|
||||
@@ -163,7 +164,7 @@ contains
|
||||
use psb_i_vect_mod
|
||||
use psb_d_mat_mod
|
||||
implicit none
|
||||
type(psb_dlinmap_type), intent(inout) :: map
|
||||
class(psb_dlinmap_type), intent(inout) :: map
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: type
|
||||
class(psb_d_base_sparse_mat), intent(in), optional :: mold
|
||||
|
||||
@@ -562,19 +562,23 @@ contains
|
||||
|
||||
subroutine d_vect_cnv(x,mold)
|
||||
class(psb_d_vect_type), intent(inout) :: x
|
||||
class(psb_d_base_vect_type), intent(in) :: mold
|
||||
class(psb_d_base_vect_type), intent(in), optional :: mold
|
||||
class(psb_d_base_vect_type), allocatable :: tmp
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(tmp,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(tmp,info)
|
||||
#endif
|
||||
call x%v%sync()
|
||||
if (info == psb_success_) call tmp%bld(x%v%v)
|
||||
call x%v%free(info)
|
||||
call move_alloc(tmp,x%v)
|
||||
if (allocated(x%v)) then
|
||||
call x%v%sync()
|
||||
if (info == psb_success_) call tmp%bld(x%v%v)
|
||||
call x%v%free(info)
|
||||
end if
|
||||
call move_alloc(tmp,x%v)
|
||||
end if
|
||||
|
||||
end subroutine d_vect_cnv
|
||||
|
||||
|
||||
@@ -137,11 +137,12 @@ subroutine psb_d_map_X2Y_vect(alpha,x,beta,y,map,info,work)
|
||||
|
||||
select case(map_kind)
|
||||
case(psb_map_aggr_)
|
||||
|
||||
|
||||
ictxt = map%p_desc_Y%get_context()
|
||||
nr2 = map%p_desc_Y%get_global_rows()
|
||||
nc2 = map%p_desc_Y%get_local_cols()
|
||||
call yt%bld(nc2,mold=x%v)
|
||||
!!$ write(0,*)'From map_aggr_X2Y apply: ',map%p_desc_X%v_halo_index%get_fmt()
|
||||
if (info == psb_success_) call psb_halo(x,map%p_desc_X,info,work=work)
|
||||
if (info == psb_success_) call psb_csmm(done,map%map_X2Y,x,dzero,yt,info)
|
||||
if ((info == psb_success_) .and. map%p_desc_Y%is_repl()) then
|
||||
@@ -307,6 +308,7 @@ subroutine psb_d_map_Y2X_vect(alpha,x,beta,y,map,info,work)
|
||||
nr2 = map%p_desc_X%get_global_rows()
|
||||
nc2 = map%p_desc_X%get_local_cols()
|
||||
call yt%bld(nc2,mold=y%v)
|
||||
!!$ write(0,*)'From map_aggr_Y2X apply: ',map%p_desc_Y%v_halo_index%get_fmt()
|
||||
if (info == psb_success_) call psb_halo(x,map%p_desc_Y,info,work=work)
|
||||
if (info == psb_success_) call psb_csmm(done,map%map_Y2X,x,dzero,yt,info)
|
||||
if ((info == psb_success_) .and. map%p_desc_X%is_repl()) then
|
||||
|
||||
Reference in New Issue
Block a user