fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-19 12:22:10 +00:00
Code Issues Packages Projects Releases Wiki Activity

psblas-3.99

Browse Source 
Fixes for integer vecors in DESC (even inside maps)
This commit is contained in:
Salvatore Filippone
2013-08-31 15:23:22 +00:00
parent 7a175dd859
commit 641e933716
11 changed files with 69 additions and 45 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/tools/psb_c_map.f90
+12 -9
View File
@@ -124,7 +124,7 @@ subroutine psb_c_map_X2Y_vect(alpha,x,beta,y,map,info,work)
complex(psb_spk_), 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
@@ -153,8 +153,9 @@ subroutine psb_c_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_)
@@ -180,10 +181,11 @@ subroutine psb_c_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', &
@@ -287,7 +289,7 @@ subroutine psb_c_map_Y2X_vect(alpha,x,beta,y,map,info,work)
complex(psb_spk_), 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
@@ -316,8 +318,9 @@ subroutine psb_c_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_)
@@ -342,10 +345,10 @@ subroutine psb_c_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'
base/tools/psb_d_map.f90
+7 -11
View File
@@ -137,8 +137,7 @@ 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()
@@ -159,7 +158,7 @@ subroutine psb_d_map_X2Y_vect(alpha,x,beta,y,map,info,work)
end if
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()
@@ -267,7 +266,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'
@@ -303,7 +302,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()
@@ -324,7 +323,7 @@ subroutine psb_d_map_Y2X_vect(alpha,x,beta,y,map,info,work)
end if
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()
@@ -377,7 +376,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
@@ -388,9 +387,6 @@ 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
@@ -407,7 +403,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
base/tools/psb_s_map.f90
+12 -9
View File
@@ -124,7 +124,7 @@ subroutine psb_s_map_X2Y_vect(alpha,x,beta,y,map,info,work)
real(psb_spk_), 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
@@ -153,8 +153,9 @@ subroutine psb_s_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_)
@@ -180,10 +181,11 @@ subroutine psb_s_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', &
@@ -287,7 +289,7 @@ subroutine psb_s_map_Y2X_vect(alpha,x,beta,y,map,info,work)
real(psb_spk_), 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
@@ -316,8 +318,9 @@ subroutine psb_s_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_)
@@ -342,10 +345,10 @@ subroutine psb_s_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'
base/tools/psb_z_map.f90
+12 -9
View File
@@ -124,7 +124,7 @@ subroutine psb_z_map_X2Y_vect(alpha,x,beta,y,map,info,work)
complex(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
@@ -153,8 +153,9 @@ subroutine psb_z_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_)
@@ -180,10 +181,11 @@ subroutine psb_z_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', &
@@ -287,7 +289,7 @@ subroutine psb_z_map_Y2X_vect(alpha,x,beta,y,map,info,work)
complex(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
@@ -316,8 +318,9 @@ subroutine psb_z_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_)
@@ -342,10 +345,10 @@ subroutine psb_z_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'