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

psblas3:

Browse Source 
test/fileread/psb_cf_sample.f90
 test/fileread/psb_df_sample.f90
 test/fileread/psb_sf_sample.f90
 test/fileread/psb_zf_sample.f90
 util/psb_c_mat_dist_impl.f90
 util/psb_c_mat_dist_mod.f90
 util/psb_d_mat_dist_impl.f90
 util/psb_d_mat_dist_mod.f90
 util/psb_s_mat_dist_impl.f90
 util/psb_s_mat_dist_mod.f90
 util/psb_z_mat_dist_impl.f90
 util/psb_z_mat_dist_mod.f90


Modified mat_dist and df_sample.
This commit is contained in:
Salvatore Filippone
2017-02-12 20:28:53 +00:00
parent 001aa819fa
commit 240efbc338
12 changed files with 97 additions and 407 deletions
Download Patch File Download Diff File Expand all files Collapse all files
util/psb_c_mat_dist_impl.f90
+1 -50
View File
@@ -30,7 +30,7 @@
!!$
!!$
subroutine psb_cmatdist(a_glob, a, ictxt, desc_a,&
& info, b_glob, b, x_glob, x, parts, v, inroot,fmt,mold)
& info, parts, v, inroot,fmt,mold)
!
! an utility subroutine to distribute a matrix among processors
! according to a user defined data distribution, using
@@ -65,18 +65,6 @@ subroutine psb_cmatdist(a_glob, a, ictxt, desc_a,&
! type (desc_type) :: desc_a
! on exit : the updated array descriptor
!
! complex(psb_spk_), optional :: b_glob(:)
! on entry: RHS
!
! type(psb_c_vect_type), optional :: b
! on exit : this will contain the local right hand side.
!
! complex(psb_spk_), optional :: x_glob(:)
! on entry: initial guess
!
! type(psb_c_vect_type), optional :: x
! on exit : this will contain the local right hand side.
!
! integer(psb_ipk_), optional :: inroot
! on entry: specifies processor holding a_glob. default: 0
! on exit : unchanged.
@@ -91,10 +79,6 @@ subroutine psb_cmatdist(a_glob, a, ictxt, desc_a,&
type(psb_cspmat_type) :: a
type(psb_desc_type) :: desc_a
integer(psb_ipk_), intent(out) :: info
complex(psb_spk_), optional :: b_glob(:)
type(psb_c_vect_type), optional :: b
complex(psb_spk_), optional :: x_glob(:)
type(psb_c_vect_type), optional :: x
integer(psb_ipk_), optional :: inroot
character(len=*), optional :: fmt
class(psb_c_base_sparse_mat), optional :: mold
@@ -146,18 +130,6 @@ subroutine psb_cmatdist(a_glob, a, ictxt, desc_a,&
call psb_errpush(info,name,a_err=" v, parts")
goto 9999
endif
if ( count((/present(b_glob),present(b)/)) == 1 ) then
info=psb_err_optional_arg_pair_
call psb_errpush(info,name,a_err=" b_glob, b")
goto 9999
endif
if ( count((/present(x_glob),present(x)/)) == 1 ) then
info=psb_err_optional_arg_pair_
call psb_errpush(info,name,a_err=" x_glob, x")
goto 9999
endif
! broadcast informations to other processors
call psb_bcast(ictxt,nrow, root)
@@ -357,27 +329,6 @@ subroutine psb_cmatdist(a_glob, a, ictxt, desc_a,&
goto 9999
end if
if (present(b_glob).and.present(b)) then
call psb_scatter(b_glob,b,desc_a,info,root=root)
if (info /= 0) then
info=psb_err_from_subroutine_
ch_err='psb_scatter'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
end if
if (present(x_glob).and.present(x)) then
call psb_scatter(x_glob,x,desc_a,info,root=root)
if (info /= 0) then
info=psb_err_from_subroutine_
ch_err='psb_scatter'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
end if
deallocate(iwork)
if (iam == root) write (*, fmt = *) 'end matdist'
util/psb_c_mat_dist_mod.f90
+1 -16
View File
@@ -35,7 +35,7 @@ module psb_c_mat_dist_mod
interface psb_matdist
subroutine psb_cmatdist(a_glob, a, ictxt, desc_a,&
& info, b_glob, b, x_glob, x, parts, v, inroot,fmt,mold)
& info, parts, v, inroot,fmt,mold)
!
! an utility subroutine to distribute a matrix among processors
! according to a user defined data distribution, using
@@ -70,17 +70,6 @@ module psb_c_mat_dist_mod
! type (desc_type) :: desc_a
! on exit : the updated array descriptor
!
! complex(psb_spk_), optional :: b_glob(:)
! on entry: RHS
!
! type(psb_c_vect_type), optional :: b
! on exit : this will contain the local right hand side.
!
! complex(psb_spk_), optional :: x_glob(:)
! on entry: initial guess
!
! type(psb_c_vect_type), optional :: x
! on exit : this will contain the local right hand side.
!
! integer(psb_ipk_), optional :: inroot
! on entry: specifies processor holding a_glob. default: 0
@@ -96,10 +85,6 @@ module psb_c_mat_dist_mod
type(psb_cspmat_type) :: a
type(psb_desc_type) :: desc_a
integer(psb_ipk_), intent(out) :: info
complex(psb_spk_), optional :: b_glob(:)
type(psb_c_vect_type), optional :: b
complex(psb_spk_), optional :: x_glob(:)
type(psb_c_vect_type), optional :: x
integer(psb_ipk_), optional :: inroot
character(len=*), optional :: fmt
class(psb_c_base_sparse_mat), optional :: mold
util/psb_d_mat_dist_impl.f90
+1 -50
View File
@@ -30,7 +30,7 @@
!!$
!!$
subroutine psb_dmatdist(a_glob, a, ictxt, desc_a,&
& info, b_glob, b, x_glob, x, parts, v, inroot,fmt,mold)
& info, parts, v, inroot,fmt,mold)
!
! an utility subroutine to distribute a matrix among processors
! according to a user defined data distribution, using
@@ -65,18 +65,6 @@ subroutine psb_dmatdist(a_glob, a, ictxt, desc_a,&
! type (desc_type) :: desc_a
! on exit : the updated array descriptor
!
! real(psb_dpk_), optional :: b_glob(:)
! on entry: RHS
!
! type(psb_d_vect_type), optional :: b
! on exit : this will contain the local right hand side.
!
! real(psb_dpk_), optional :: x_glob(:)
! on entry: initial guess
!
! type(psb_d_vect_type), optional :: x
! on exit : this will contain the local right hand side.
!
! integer(psb_ipk_), optional :: inroot
! on entry: specifies processor holding a_glob. default: 0
! on exit : unchanged.
@@ -91,10 +79,6 @@ subroutine psb_dmatdist(a_glob, a, ictxt, desc_a,&
type(psb_dspmat_type) :: a
type(psb_desc_type) :: desc_a
integer(psb_ipk_), intent(out) :: info
real(psb_dpk_), optional :: b_glob(:)
type(psb_d_vect_type), optional :: b
real(psb_dpk_), optional :: x_glob(:)
type(psb_d_vect_type), optional :: x
integer(psb_ipk_), optional :: inroot
character(len=*), optional :: fmt
class(psb_d_base_sparse_mat), optional :: mold
@@ -146,18 +130,6 @@ subroutine psb_dmatdist(a_glob, a, ictxt, desc_a,&
call psb_errpush(info,name,a_err=" v, parts")
goto 9999
endif
if ( count((/present(b_glob),present(b)/)) == 1 ) then
info=psb_err_optional_arg_pair_
call psb_errpush(info,name,a_err=" b_glob, b")
goto 9999
endif
if ( count((/present(x_glob),present(x)/)) == 1 ) then
info=psb_err_optional_arg_pair_
call psb_errpush(info,name,a_err=" x_glob, x")
goto 9999
endif
! broadcast informations to other processors
call psb_bcast(ictxt,nrow, root)
@@ -357,27 +329,6 @@ subroutine psb_dmatdist(a_glob, a, ictxt, desc_a,&
goto 9999
end if
if (present(b_glob).and.present(b)) then
call psb_scatter(b_glob,b,desc_a,info,root=root)
if (info /= 0) then
info=psb_err_from_subroutine_
ch_err='psb_scatter'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
end if
if (present(x_glob).and.present(x)) then
call psb_scatter(x_glob,x,desc_a,info,root=root)
if (info /= 0) then
info=psb_err_from_subroutine_
ch_err='psb_scatter'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
end if
deallocate(iwork)
if (iam == root) write (*, fmt = *) 'end matdist'
util/psb_d_mat_dist_mod.f90
+1 -16
View File
@@ -35,7 +35,7 @@ module psb_d_mat_dist_mod
interface psb_matdist
subroutine psb_dmatdist(a_glob, a, ictxt, desc_a,&
& info, b_glob, b, x_glob, x, parts, v, inroot,fmt,mold)
& info, parts, v, inroot,fmt,mold)
!
! an utility subroutine to distribute a matrix among processors
! according to a user defined data distribution, using
@@ -70,17 +70,6 @@ module psb_d_mat_dist_mod
! type (desc_type) :: desc_a
! on exit : the updated array descriptor
!
! real(psb_dpk_), optional :: b_glob(:)
! on entry: RHS
!
! type(psb_d_vect_type), optional :: b
! on exit : this will contain the local right hand side.
!
! real(psb_dpk_), optional :: x_glob(:)
! on entry: initial guess
!
! type(psb_d_vect_type), optional :: x
! on exit : this will contain the local right hand side.
!
! integer(psb_ipk_), optional :: inroot
! on entry: specifies processor holding a_glob. default: 0
@@ -96,10 +85,6 @@ module psb_d_mat_dist_mod
type(psb_dspmat_type) :: a
type(psb_desc_type) :: desc_a
integer(psb_ipk_), intent(out) :: info
real(psb_dpk_), optional :: b_glob(:)
type(psb_d_vect_type), optional :: b
real(psb_dpk_), optional :: x_glob(:)
type(psb_d_vect_type), optional :: x
integer(psb_ipk_), optional :: inroot
character(len=*), optional :: fmt
class(psb_d_base_sparse_mat), optional :: mold
util/psb_s_mat_dist_impl.f90
+1 -50
View File
@@ -30,7 +30,7 @@
!!$
!!$
subroutine psb_smatdist(a_glob, a, ictxt, desc_a,&
& info, b_glob, b, x_glob, x, parts, v, inroot,fmt,mold)
& info, parts, v, inroot,fmt,mold)
!
! an utility subroutine to distribute a matrix among processors
! according to a user defined data distribution, using
@@ -65,18 +65,6 @@ subroutine psb_smatdist(a_glob, a, ictxt, desc_a,&
! type (desc_type) :: desc_a
! on exit : the updated array descriptor
!
! real(psb_spk_), optional :: b_glob(:)
! on entry: RHS
!
! type(psb_s_vect_type), optional :: b
! on exit : this will contain the local right hand side.
!
! real(psb_spk_), optional :: x_glob(:)
! on entry: initial guess
!
! type(psb_s_vect_type), optional :: x
! on exit : this will contain the local right hand side.
!
! integer(psb_ipk_), optional :: inroot
! on entry: specifies processor holding a_glob. default: 0
! on exit : unchanged.
@@ -91,10 +79,6 @@ subroutine psb_smatdist(a_glob, a, ictxt, desc_a,&
type(psb_sspmat_type) :: a
type(psb_desc_type) :: desc_a
integer(psb_ipk_), intent(out) :: info
real(psb_spk_), optional :: b_glob(:)
type(psb_s_vect_type), optional :: b
real(psb_spk_), optional :: x_glob(:)
type(psb_s_vect_type), optional :: x
integer(psb_ipk_), optional :: inroot
character(len=*), optional :: fmt
class(psb_s_base_sparse_mat), optional :: mold
@@ -146,18 +130,6 @@ subroutine psb_smatdist(a_glob, a, ictxt, desc_a,&
call psb_errpush(info,name,a_err=" v, parts")
goto 9999
endif
if ( count((/present(b_glob),present(b)/)) == 1 ) then
info=psb_err_optional_arg_pair_
call psb_errpush(info,name,a_err=" b_glob, b")
goto 9999
endif
if ( count((/present(x_glob),present(x)/)) == 1 ) then
info=psb_err_optional_arg_pair_
call psb_errpush(info,name,a_err=" x_glob, x")
goto 9999
endif
! broadcast informations to other processors
call psb_bcast(ictxt,nrow, root)
@@ -357,27 +329,6 @@ subroutine psb_smatdist(a_glob, a, ictxt, desc_a,&
goto 9999
end if
if (present(b_glob).and.present(b)) then
call psb_scatter(b_glob,b,desc_a,info,root=root)
if (info /= 0) then
info=psb_err_from_subroutine_
ch_err='psb_scatter'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
end if
if (present(x_glob).and.present(x)) then
call psb_scatter(x_glob,x,desc_a,info,root=root)
if (info /= 0) then
info=psb_err_from_subroutine_
ch_err='psb_scatter'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
end if
deallocate(iwork)
if (iam == root) write (*, fmt = *) 'end matdist'
util/psb_s_mat_dist_mod.f90
+1 -16
View File
@@ -35,7 +35,7 @@ module psb_s_mat_dist_mod
interface psb_matdist
subroutine psb_smatdist(a_glob, a, ictxt, desc_a,&
& info, b_glob, b, x_glob, x, parts, v, inroot,fmt,mold)
& info, parts, v, inroot,fmt,mold)
!
! an utility subroutine to distribute a matrix among processors
! according to a user defined data distribution, using
@@ -70,17 +70,6 @@ module psb_s_mat_dist_mod
! type (desc_type) :: desc_a
! on exit : the updated array descriptor
!
! real(psb_spk_), optional :: b_glob(:)
! on entry: RHS
!
! type(psb_s_vect_type), optional :: b
! on exit : this will contain the local right hand side.
!
! real(psb_spk_), optional :: x_glob(:)
! on entry: initial guess
!
! type(psb_s_vect_type), optional :: x
! on exit : this will contain the local right hand side.
!
! integer(psb_ipk_), optional :: inroot
! on entry: specifies processor holding a_glob. default: 0
@@ -96,10 +85,6 @@ module psb_s_mat_dist_mod
type(psb_sspmat_type) :: a
type(psb_desc_type) :: desc_a
integer(psb_ipk_), intent(out) :: info
real(psb_spk_), optional :: b_glob(:)
type(psb_s_vect_type), optional :: b
real(psb_spk_), optional :: x_glob(:)
type(psb_s_vect_type), optional :: x
integer(psb_ipk_), optional :: inroot
character(len=*), optional :: fmt
class(psb_s_base_sparse_mat), optional :: mold
util/psb_z_mat_dist_impl.f90
+1 -50
View File
@@ -30,7 +30,7 @@
!!$
!!$
subroutine psb_zmatdist(a_glob, a, ictxt, desc_a,&
& info, b_glob, b, x_glob, x, parts, v, inroot,fmt,mold)
& info, parts, v, inroot,fmt,mold)
!
! an utility subroutine to distribute a matrix among processors
! according to a user defined data distribution, using
@@ -65,18 +65,6 @@ subroutine psb_zmatdist(a_glob, a, ictxt, desc_a,&
! type (desc_type) :: desc_a
! on exit : the updated array descriptor
!
! complex(psb_dpk_), optional :: b_glob(:)
! on entry: RHS
!
! type(psb_z_vect_type), optional :: b
! on exit : this will contain the local right hand side.
!
! complex(psb_dpk_), optional :: x_glob(:)
! on entry: initial guess
!
! type(psb_z_vect_type), optional :: x
! on exit : this will contain the local right hand side.
!
! integer(psb_ipk_), optional :: inroot
! on entry: specifies processor holding a_glob. default: 0
! on exit : unchanged.
@@ -91,10 +79,6 @@ subroutine psb_zmatdist(a_glob, a, ictxt, desc_a,&
type(psb_zspmat_type) :: a
type(psb_desc_type) :: desc_a
integer(psb_ipk_), intent(out) :: info
complex(psb_dpk_), optional :: b_glob(:)
type(psb_z_vect_type), optional :: b
complex(psb_dpk_), optional :: x_glob(:)
type(psb_z_vect_type), optional :: x
integer(psb_ipk_), optional :: inroot
character(len=*), optional :: fmt
class(psb_z_base_sparse_mat), optional :: mold
@@ -146,18 +130,6 @@ subroutine psb_zmatdist(a_glob, a, ictxt, desc_a,&
call psb_errpush(info,name,a_err=" v, parts")
goto 9999
endif
if ( count((/present(b_glob),present(b)/)) == 1 ) then
info=psb_err_optional_arg_pair_
call psb_errpush(info,name,a_err=" b_glob, b")
goto 9999
endif
if ( count((/present(x_glob),present(x)/)) == 1 ) then
info=psb_err_optional_arg_pair_
call psb_errpush(info,name,a_err=" x_glob, x")
goto 9999
endif
! broadcast informations to other processors
call psb_bcast(ictxt,nrow, root)
@@ -357,27 +329,6 @@ subroutine psb_zmatdist(a_glob, a, ictxt, desc_a,&
goto 9999
end if
if (present(b_glob).and.present(b)) then
call psb_scatter(b_glob,b,desc_a,info,root=root)
if (info /= 0) then
info=psb_err_from_subroutine_
ch_err='psb_scatter'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
end if
if (present(x_glob).and.present(x)) then
call psb_scatter(x_glob,x,desc_a,info,root=root)
if (info /= 0) then
info=psb_err_from_subroutine_
ch_err='psb_scatter'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
end if
deallocate(iwork)
if (iam == root) write (*, fmt = *) 'end matdist'
util/psb_z_mat_dist_mod.f90
+1 -16
View File
@@ -35,7 +35,7 @@ module psb_z_mat_dist_mod
interface psb_matdist
subroutine psb_zmatdist(a_glob, a, ictxt, desc_a,&
& info, b_glob, b, x_glob, x, parts, v, inroot,fmt,mold)
& info, parts, v, inroot,fmt,mold)
!
! an utility subroutine to distribute a matrix among processors
! according to a user defined data distribution, using
@@ -70,17 +70,6 @@ module psb_z_mat_dist_mod
! type (desc_type) :: desc_a
! on exit : the updated array descriptor
!
! complex(psb_dpk_), optional :: b_glob(:)
! on entry: RHS
!
! type(psb_z_vect_type), optional :: b
! on exit : this will contain the local right hand side.
!
! complex(psb_dpk_), optional :: x_glob(:)
! on entry: initial guess
!
! type(psb_z_vect_type), optional :: x
! on exit : this will contain the local right hand side.
!
! integer(psb_ipk_), optional :: inroot
! on entry: specifies processor holding a_glob. default: 0
@@ -96,10 +85,6 @@ module psb_z_mat_dist_mod
type(psb_zspmat_type) :: a
type(psb_desc_type) :: desc_a
integer(psb_ipk_), intent(out) :: info
complex(psb_dpk_), optional :: b_glob(:)
type(psb_z_vect_type), optional :: b
complex(psb_dpk_), optional :: x_glob(:)
type(psb_z_vect_type), optional :: x
integer(psb_ipk_), optional :: inroot
character(len=*), optional :: fmt
class(psb_z_base_sparse_mat), optional :: mold