fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

psblas-3.99

Browse Source 
Bug fixes: the new ivect desc components were not copied properly
 on move_alloc.
psblas-3.2.0
Salvatore Filippone 12 years ago
parent 15a92d2f61
commit 7a175dd859
6 changed files with 82 additions and 28 deletions
Show Stats Download Patch File Download Diff File

8
base/modules/psb_d_linmap_mod.f90
Unescape Escape View File

@ -159,17 +159,23 @@ contains
end function d_is_asb
subroutine psb_d_map_cscnv(map,info,type,mold)
subroutine psb_d_map_cscnv(map,info,type,mold,imold)
use psb_i_vect_mod
use psb_d_mat_mod
implicit none
type(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
class(psb_i_base_vect_type), intent(in), optional :: imold
call map%map_X2Y%cscnv(info,type=type,mold=mold)
if (info == psb_success_)&
& call map%map_Y2X%cscnv(info,type=type,mold=mold)
if (present(imold)) then
call map%desc_X%cnv(mold=imold)
call map%desc_Y%cnv(mold=imold)
end if
end subroutine psb_d_map_cscnv

1
base/modules/psb_d_vect_mod.F90
Unescape Escape View File

@ -564,7 +564,6 @@ contains
class(psb_d_vect_type), intent(inout) :: x
class(psb_d_base_vect_type), intent(in) :: mold
class(psb_d_base_vect_type), allocatable :: tmp
real(psb_dpk_), allocatable :: invect(:)
integer(psb_ipk_) :: info
#ifdef HAVE_MOLD

41
base/modules/psb_desc_mod.f90
Unescape Escape View File

@ -238,6 +238,7 @@ module psb_desc_mod
generic, public :: get_list => a_get_list, v_get_list
procedure, pass(desc) :: sizeof => psb_cd_sizeof
procedure, pass(desc) :: clone => psb_cd_clone
procedure, pass(desc) :: cnv => psb_cd_cnv
procedure, pass(desc) :: free => psb_cdfree
procedure, pass(desc) :: destroy => psb_cd_destroy
procedure, pass(desc) :: nullify => nullify_desc
@ -670,10 +671,16 @@ contains
select case(data)
case(psb_comm_halo_)
ipnt => desc%v_halo_index%v
if (.not.allocated(desc%v_halo_index%v)) &
& info = psb_err_inconsistent_index_lists_
case(psb_comm_ovr_)
ipnt => desc%v_ovrlap_index%v
if (.not.allocated(desc%v_ovrlap_index%v)) &
& info = psb_err_inconsistent_index_lists_
case(psb_comm_ext_)
ipnt => desc%v_ext_index%v
if (.not.allocated(desc%v_ext_index%v)) &
& info = psb_err_inconsistent_index_lists_
if (debug_level >= psb_debug_ext_) then
if (.not.associated(desc%base_desc)) then
write(debug_unit,*) trim(name),&
@ -688,11 +695,17 @@ contains
end if
case(psb_comm_mov_)
ipnt => desc%v_ovr_mst_idx%v
if (.not.allocated(desc%v_ovr_mst_idx%v)) &
& info = psb_err_inconsistent_index_lists_
case default
info=psb_err_from_subroutine_
end select
if (info /= psb_success_) then
call psb_errpush(info,name,a_err='wrong Data selector')
goto 9999
end select
end if
call psb_get_v_xch_idx(ipnt,totxch,idxs,idxr)
@ -796,6 +809,10 @@ contains
call desc%indxmap%free()
deallocate(desc%indxmap, stat=info)
end if
call desc%v_halo_index%free(info)
call desc%v_ovrlap_index%free(info)
call desc%v_ext_index%free(info)
call desc%v_ovr_mst_idx%free(info)
call desc%nullify()
@ -864,6 +881,15 @@ contains
& call psb_move_alloc( desc_in%idx_space , desc_out%idx_space , info)
if (info == psb_success_) &
& call move_alloc(desc_in%indxmap, desc_out%indxmap)
if (info == psb_success_) &
& call desc_in%v_halo_index%clone(desc_out%v_halo_index,info)
if (info == psb_success_) &
& call desc_in%v_ext_index%clone(desc_out%v_ext_index,info)
if (info == psb_success_) &
& call desc_in%v_ovrlap_index%clone(desc_out%v_ovrlap_index,info)
if (info == psb_success_) &
& call desc_in%v_ovr_mst_idx%clone(desc_out%v_ovr_mst_idx,info)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name)
@ -995,6 +1021,19 @@ contains
end Subroutine psb_cd_get_recv_idx
subroutine psb_cd_cnv(desc, mold)
class(psb_desc_type), intent(inout), target :: desc
class(psb_i_base_vect_type), intent(in) :: mold
call desc%v_halo_index%cnv(mold)
call desc%v_ext_index%cnv(mold)
call desc%v_ovrlap_index%cnv(mold)
call desc%v_ovr_mst_idx%cnv(mold)
end subroutine psb_cd_cnv
subroutine psb_cd_clone(desc, desc_out, info)
use psb_error_mod

18
base/modules/psb_i_vect_mod.F90
Unescape Escape View File

@ -542,10 +542,10 @@ contains
use psi_serial_mod
implicit none
class(psb_i_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in) :: n, dupl
integer(psb_ipk_), intent(in) :: irl(:)
integer(psb_ipk_), intent(in) :: val(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in) :: n, dupl
integer(psb_ipk_), intent(in) :: irl(:)
integer(psb_ipk_), intent(in) :: val(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i
@ -562,15 +562,15 @@ contains
subroutine i_vect_cnv(x,mold)
class(psb_i_vect_type), intent(inout) :: x
class(psb_i_base_vect_type), intent(in) :: mold
class(psb_i_base_vect_type), intent(in) :: mold
class(psb_i_base_vect_type), allocatable :: tmp
integer(psb_ipk_), allocatable :: invect(:)
integer(psb_ipk_) :: info
integer(psb_ipk_) :: info
if (.not.allocated(x%v)) return
#ifdef HAVE_MOLD
allocate(tmp,stat=info,mold=mold)
allocate(tmp,stat=info,mold=mold)
#else
call mold%mold(tmp,info)
call mold%mold(tmp,info)
#endif
call x%v%sync()
if (info == psb_success_) call tmp%bld(x%v%v)

39
base/tools/psb_d_map.f90
Unescape Escape View File

@ -124,7 +124,7 @@ subroutine psb_d_map_X2Y_vect(alpha,x,beta,y,map,info,work)
real(psb_dpk_), allocatable :: xta(:), yta(:)
integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2 ,&
& map_kind, nr, ictxt
character(len=20), parameter :: name='psb_map_X2Y'
character(len=20), parameter :: name='psb_map_X2Yv'
info = psb_success_
if (.not.map%is_asb()) then
@ -137,7 +137,8 @@ subroutine psb_d_map_X2Y_vect(alpha,x,beta,y,map,info,work)
select case(map_kind)
case(psb_map_aggr_)
!!$ write(0,*) 'Using a map_aggr_ map',allocated(map%p_desc_X%v_halo_index%v),&
!!$ & allocated(map%p_desc_Y%v_halo_index%v)
ictxt = map%p_desc_Y%get_context()
nr2 = map%p_desc_Y%get_global_rows()
nc2 = map%p_desc_Y%get_local_cols()
@ -153,11 +154,12 @@ subroutine psb_d_map_X2Y_vect(alpha,x,beta,y,map,info,work)
if (info /= psb_success_) then
write(psb_err_unit,*) trim(name),' Error from inner routines',info
info = -1
else
call yt%free(info)
end if
call yt%free(info)
case(psb_map_gen_linear_)
!!$ write(0,*) 'Using a gen_linear_ map'
ictxt = map%desc_Y%get_context()
nr1 = map%desc_X%get_local_rows()
nc1 = map%desc_X%get_local_cols()
@ -180,10 +182,11 @@ subroutine psb_d_map_X2Y_vect(alpha,x,beta,y,map,info,work)
if (info /= psb_success_) then
write(psb_err_unit,*) trim(name),' Error from inner routines',info
info = -1
else
call xt%free(info)
call yt%free(info)
end if
call xt%free(info)
call yt%free(info)
case default
write(psb_err_unit,*) trim(name),' Invalid descriptor input', &
@ -264,7 +267,7 @@ subroutine psb_d_map_Y2X(alpha,x,beta,y,map,info,work)
write(psb_err_unit,*) trim(name),' Error from inner routines',info
info = -1
end if
case default
write(psb_err_unit,*) trim(name),' Invalid descriptor input'
@ -287,7 +290,7 @@ subroutine psb_d_map_Y2X_vect(alpha,x,beta,y,map,info,work)
real(psb_dpk_), allocatable :: xta(:), yta(:)
integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2,&
& map_kind, nr, ictxt
character(len=20), parameter :: name='psb_map_Y2X'
character(len=20), parameter :: name='psb_map_Y2Xv'
info = psb_success_
if (.not.map%is_asb()) then
@ -300,7 +303,7 @@ subroutine psb_d_map_Y2X_vect(alpha,x,beta,y,map,info,work)
select case(map_kind)
case(psb_map_aggr_)
!!$ write(0,*) 'Using a map_aggr_ map'
ictxt = map%p_desc_X%get_context()
nr2 = map%p_desc_X%get_global_rows()
nc2 = map%p_desc_X%get_local_cols()
@ -316,11 +319,12 @@ subroutine psb_d_map_Y2X_vect(alpha,x,beta,y,map,info,work)
if (info /= psb_success_) then
write(psb_err_unit,*) trim(name),' Error from inner routines',info
info = -1
else
call yt%free(info)
end if
call yt%free(info)
case(psb_map_gen_linear_)
!!$ write(0,*) 'Using a gen_linear_ map'
ictxt = map%desc_X%get_context()
nr1 = map%desc_Y%get_local_rows()
nc1 = map%desc_Y%get_local_cols()
@ -342,10 +346,10 @@ subroutine psb_d_map_Y2X_vect(alpha,x,beta,y,map,info,work)
if (info /= psb_success_) then
write(psb_err_unit,*) trim(name),' Error from inner routines',info
info = -1
else
call xt%free(info)
call yt%free(info)
end if
call xt%free(info)
call yt%free(info)
case default
write(psb_err_unit,*) trim(name),' Invalid descriptor input'
@ -373,7 +377,7 @@ function psb_d_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) &
select case(map_kind)
case (psb_map_aggr_)
! OK
!!$ write(0,*) 'Creating a map_aggr_ map'
if (psb_is_ok_desc(desc_X)) then
this%p_desc_X=>desc_X
else
@ -384,6 +388,9 @@ function psb_d_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) &
else
info = psb_err_invalid_ovr_num_
endif
!!$ write(0,*) 'Creating a map_aggr_ map 2:',allocated(this%p_desc_X%v_halo_index%v),&
!!$ & allocated(this%p_desc_Y%v_halo_index%v)
if (present(iaggr)) then
if (.not.present(naggr)) then
info = 7
@ -400,7 +407,7 @@ function psb_d_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) &
end if
case(psb_map_gen_linear_)
!!$ write(0,*) 'Creating a gen_linear_ map'
if (desc_X%is_ok()) then
call psb_cdcpy(desc_X, this%desc_X,info)
else

3
base/tools/psb_icdasb.F90
Unescape Escape View File

@ -159,6 +159,9 @@ subroutine psb_icdasb(desc,info,ext_hv,mold)
goto 9999
endif
if (present(mold)) &
& call desc%cnv(mold)
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': Done'

Write Preview
Loading…
Cancel
Save