fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-07 07:04:57 +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/modules/psb_c_linmap_mod.f90
+7 -1
View File
@@ -159,17 +159,23 @@ contains
end function c_is_asb
subroutine psb_c_map_cscnv(map,info,type,mold)
subroutine psb_c_map_cscnv(map,info,type,mold,imold)
use psb_i_vect_mod
use psb_c_mat_mod
implicit none
type(psb_clinmap_type), intent(inout) :: map
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: type
class(psb_c_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_c_map_cscnv
base/modules/psb_c_vect_mod.F90
-1
View File
@@ -564,7 +564,6 @@ contains
class(psb_c_vect_type), intent(inout) :: x
class(psb_c_base_vect_type), intent(in) :: mold
class(psb_c_base_vect_type), allocatable :: tmp
complex(psb_spk_), allocatable :: invect(:)
integer(psb_ipk_) :: info
#ifdef HAVE_MOLD
base/modules/psb_s_linmap_mod.f90
+7 -1
View File
@@ -159,17 +159,23 @@ contains
end function s_is_asb
subroutine psb_s_map_cscnv(map,info,type,mold)
subroutine psb_s_map_cscnv(map,info,type,mold,imold)
use psb_i_vect_mod
use psb_s_mat_mod
implicit none
type(psb_slinmap_type), intent(inout) :: map
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: type
class(psb_s_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_s_map_cscnv
base/modules/psb_s_vect_mod.F90
-1
View File
@@ -564,7 +564,6 @@ contains
class(psb_s_vect_type), intent(inout) :: x
class(psb_s_base_vect_type), intent(in) :: mold
class(psb_s_base_vect_type), allocatable :: tmp
real(psb_spk_), allocatable :: invect(:)
integer(psb_ipk_) :: info
#ifdef HAVE_MOLD
base/modules/psb_z_linmap_mod.f90
+7 -1
View File
@@ -159,17 +159,23 @@ contains
end function z_is_asb
subroutine psb_z_map_cscnv(map,info,type,mold)
subroutine psb_z_map_cscnv(map,info,type,mold,imold)
use psb_i_vect_mod
use psb_z_mat_mod
implicit none
type(psb_zlinmap_type), intent(inout) :: map
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: type
class(psb_z_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_z_map_cscnv
base/modules/psb_z_vect_mod.F90
-1
View File
@@ -564,7 +564,6 @@ contains
class(psb_z_vect_type), intent(inout) :: x
class(psb_z_base_vect_type), intent(in) :: mold
class(psb_z_base_vect_type), allocatable :: tmp
complex(psb_dpk_), allocatable :: invect(:)
integer(psb_ipk_) :: info
#ifdef HAVE_MOLD
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'
test/pargen/Makefile
+5 -1
View File
@@ -21,6 +21,10 @@ ppde3d: ppde3d.o
$(F90LINK) ppde3d.o -o ppde3d $(PSBLAS_LIB) $(LDLIBS)
/bin/mv ppde3d $(EXEDIR)
ppde3d_ext: ppde3d_ext.o
$(F90LINK) ppde3d_ext.o -o ppde3d_ext $(PSBLAS_LIB) $(LDLIBS)
/bin/mv ppde3d_ext $(EXEDIR)
spde3d: spde3d.o
$(F90LINK) spde3d.o -o spde3d $(PSBLAS_LIB) $(LDLIBS)
@@ -37,7 +41,7 @@ spde2d: spde2d.o
clean:
/bin/rm -f ppde3d.o spde3d.o ppde2d.o spde2d.o \
/bin/rm -f ppde3d.o spde3d.o ppde2d.o spde2d.o ppde3d_ext.o \
$(EXEDIR)/ppde3d $(EXEDIR)/spde3d $(EXEDIR)/ppde2d $(EXEDIR)/spde2d
verycleanlib:
(cd ../..; make veryclean)