mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-06 22:55:08 +00:00
psblas3:
base/comm/psb_chalo.f90 base/comm/psb_dhalo.f90 base/comm/psb_ihalo.f90 base/comm/psb_shalo.f90 base/comm/psb_zhalo.f90 base/modules/psb_c_base_vect_mod.f90 base/modules/psb_c_comm_mod.f90 base/modules/psb_c_tools_mod.f90 base/modules/psb_c_vect_mod.F90 base/modules/psb_d_base_vect_mod.f90 base/modules/psb_d_comm_mod.f90 base/modules/psb_d_tools_mod.f90 base/modules/psb_d_vect_mod.F90 base/modules/psb_i_base_vect_mod.f90 base/modules/psb_i_comm_mod.f90 base/modules/psb_i_tools_mod.f90 base/modules/psb_i_vect_mod.F90 base/modules/psb_s_base_vect_mod.f90 base/modules/psb_s_comm_mod.f90 base/modules/psb_s_tools_mod.f90 base/modules/psb_s_vect_mod.F90 base/modules/psb_z_base_vect_mod.f90 base/modules/psb_z_comm_mod.f90 base/modules/psb_z_tools_mod.f90 base/modules/psb_z_vect_mod.F90 base/modules/psi_c_mod.f90 base/modules/psi_d_mod.f90 base/modules/psi_i_mod.f90 base/modules/psi_s_mod.f90 base/modules/psi_z_mod.f90 docs/psblas-3.2.pdf docs/psblas-3.4.pdf docs/src/Makefile docs/src/commrout.tex docs/src/userguide.tex docs/src/userhtml.tex Regenerate some of the modules. Take out alpha from psb_halo, update docs accordingly.
This commit is contained in:
Salvatore Filippone
+3
-28
@@ -39,7 +39,6 @@
|
||||
! x - complex,dimension(:,:). The local part of the dense matrix.
|
||||
! desc_a - type(psb_desc_type). The communication descriptor.
|
||||
! info - integer. Return code
|
||||
! alpha - complex(optional). Scale factor.
|
||||
! jx - integer(optional). The starting column of the global matrix.
|
||||
! ik - integer(optional). The number of columns to gather.
|
||||
! work - complex(optional). Work area.
|
||||
@@ -53,7 +52,7 @@
|
||||
! psb_comm_mov_ use ovr_mst_idx
|
||||
!
|
||||
!
|
||||
subroutine psb_chalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
|
||||
subroutine psb_chalom(x,desc_a,info,jx,ik,work,tran,mode,data)
|
||||
use psb_base_mod, psb_protect_name => psb_chalom
|
||||
use psi_mod
|
||||
implicit none
|
||||
@@ -61,7 +60,6 @@ subroutine psb_chalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
|
||||
complex(psb_spk_), intent(inout), target :: x(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
complex(psb_spk_), intent(in), optional :: alpha
|
||||
complex(psb_spk_), optional, target, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(in), optional :: mode,jx,ik,data
|
||||
character, intent(in), optional :: tran
|
||||
@@ -147,14 +145,6 @@ subroutine psb_chalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
|
||||
call psb_errcomm(ictxt,err)
|
||||
if(err /= 0) goto 9999
|
||||
|
||||
if(present(alpha)) then
|
||||
if(alpha /= cone) then
|
||||
do i=0, k-1
|
||||
call cscal(int(nrow,kind=psb_mpik_),alpha,x(:,jjx+i),1)
|
||||
end do
|
||||
end if
|
||||
end if
|
||||
|
||||
liwork=nrow
|
||||
if (present(work)) then
|
||||
if(size(work) >= liwork) then
|
||||
@@ -256,7 +246,6 @@ end subroutine psb_chalom
|
||||
! x - real,dimension(:). The local part of the dense vector.
|
||||
! desc_a - type(psb_desc_type). The communication descriptor.
|
||||
! info - integer. Return code
|
||||
! alpha - complex(optional). Scale factor.
|
||||
! jx - integer(optional). The starting column of the global matrix.
|
||||
! ik - integer(optional). The number of columns to gather.
|
||||
! work - complex(optional). Work area.
|
||||
@@ -270,7 +259,7 @@ end subroutine psb_chalom
|
||||
! psb_comm_mov_ use ovr_mst_idx
|
||||
!
|
||||
!
|
||||
subroutine psb_chalov(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
subroutine psb_chalov(x,desc_a,info,work,tran,mode,data)
|
||||
use psb_base_mod, psb_protect_name => psb_chalov
|
||||
use psi_mod
|
||||
implicit none
|
||||
@@ -278,7 +267,6 @@ subroutine psb_chalov(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
complex(psb_spk_), intent(inout) :: x(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
complex(psb_spk_), intent(in), optional :: alpha
|
||||
complex(psb_spk_), target, optional, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(in), optional :: mode,data
|
||||
character, intent(in), optional :: tran
|
||||
@@ -347,12 +335,6 @@ subroutine psb_chalov(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
call psb_errcomm(ictxt,err)
|
||||
if(err /= 0) goto 9999
|
||||
|
||||
if(present(alpha)) then
|
||||
if(alpha /= cone) then
|
||||
call cscal(int(nrow,kind=psb_mpik_),alpha,x,ione)
|
||||
end if
|
||||
end if
|
||||
|
||||
liwork=nrow
|
||||
if (present(work)) then
|
||||
if(size(work) >= liwork) then
|
||||
@@ -410,7 +392,7 @@ subroutine psb_chalov(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
end subroutine psb_chalov
|
||||
|
||||
|
||||
subroutine psb_chalo_vect(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
subroutine psb_chalo_vect(x,desc_a,info,work,tran,mode,data)
|
||||
use psb_base_mod, psb_protect_name => psb_chalo_vect
|
||||
use psi_mod
|
||||
implicit none
|
||||
@@ -418,7 +400,6 @@ subroutine psb_chalo_vect(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
type(psb_c_vect_type), intent(inout) :: x
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
complex(psb_spk_), intent(in), optional :: alpha
|
||||
complex(psb_spk_), target, optional, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(in), optional :: mode,data
|
||||
character, intent(in), optional :: tran
|
||||
@@ -493,12 +474,6 @@ subroutine psb_chalo_vect(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
call psb_errcomm(ictxt,err)
|
||||
if(err /= 0) goto 9999
|
||||
|
||||
if(present(alpha)) then
|
||||
if(alpha /= cone) then
|
||||
call x%scal(alpha)
|
||||
end if
|
||||
end if
|
||||
|
||||
liwork=nrow
|
||||
if (present(work)) then
|
||||
if(size(work) >= liwork) then
|
||||
|
||||
+3
-28
@@ -39,7 +39,6 @@
|
||||
! x - real,dimension(:,:). The local part of the dense matrix.
|
||||
! desc_a - type(psb_desc_type). The communication descriptor.
|
||||
! info - integer. Return code
|
||||
! alpha - real(optional). Scale factor.
|
||||
! jx - integer(optional). The starting column of the global matrix.
|
||||
! ik - integer(optional). The number of columns to gather.
|
||||
! work - real(optional). Work area.
|
||||
@@ -53,7 +52,7 @@
|
||||
! psb_comm_mov_ use ovr_mst_idx
|
||||
!
|
||||
!
|
||||
subroutine psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
|
||||
subroutine psb_dhalom(x,desc_a,info,jx,ik,work,tran,mode,data)
|
||||
use psb_base_mod, psb_protect_name => psb_dhalom
|
||||
use psi_mod
|
||||
implicit none
|
||||
@@ -61,7 +60,6 @@ subroutine psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
|
||||
real(psb_dpk_), intent(inout), target :: x(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
real(psb_dpk_), intent(in), optional :: alpha
|
||||
real(psb_dpk_), optional, target, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(in), optional :: mode,jx,ik,data
|
||||
character, intent(in), optional :: tran
|
||||
@@ -147,14 +145,6 @@ subroutine psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
|
||||
call psb_errcomm(ictxt,err)
|
||||
if(err /= 0) goto 9999
|
||||
|
||||
if(present(alpha)) then
|
||||
if(alpha /= done) then
|
||||
do i=0, k-1
|
||||
call dscal(int(nrow,kind=psb_mpik_),alpha,x(:,jjx+i),1)
|
||||
end do
|
||||
end if
|
||||
end if
|
||||
|
||||
liwork=nrow
|
||||
if (present(work)) then
|
||||
if(size(work) >= liwork) then
|
||||
@@ -256,7 +246,6 @@ end subroutine psb_dhalom
|
||||
! x - real,dimension(:). The local part of the dense vector.
|
||||
! desc_a - type(psb_desc_type). The communication descriptor.
|
||||
! info - integer. Return code
|
||||
! alpha - real(optional). Scale factor.
|
||||
! jx - integer(optional). The starting column of the global matrix.
|
||||
! ik - integer(optional). The number of columns to gather.
|
||||
! work - real(optional). Work area.
|
||||
@@ -270,7 +259,7 @@ end subroutine psb_dhalom
|
||||
! psb_comm_mov_ use ovr_mst_idx
|
||||
!
|
||||
!
|
||||
subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
subroutine psb_dhalov(x,desc_a,info,work,tran,mode,data)
|
||||
use psb_base_mod, psb_protect_name => psb_dhalov
|
||||
use psi_mod
|
||||
implicit none
|
||||
@@ -278,7 +267,6 @@ subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
real(psb_dpk_), intent(inout) :: x(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
real(psb_dpk_), intent(in), optional :: alpha
|
||||
real(psb_dpk_), target, optional, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(in), optional :: mode,data
|
||||
character, intent(in), optional :: tran
|
||||
@@ -347,12 +335,6 @@ subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
call psb_errcomm(ictxt,err)
|
||||
if(err /= 0) goto 9999
|
||||
|
||||
if(present(alpha)) then
|
||||
if(alpha /= done) then
|
||||
call dscal(int(nrow,kind=psb_mpik_),alpha,x,ione)
|
||||
end if
|
||||
end if
|
||||
|
||||
liwork=nrow
|
||||
if (present(work)) then
|
||||
if(size(work) >= liwork) then
|
||||
@@ -410,7 +392,7 @@ subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
end subroutine psb_dhalov
|
||||
|
||||
|
||||
subroutine psb_dhalo_vect(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
subroutine psb_dhalo_vect(x,desc_a,info,work,tran,mode,data)
|
||||
use psb_base_mod, psb_protect_name => psb_dhalo_vect
|
||||
use psi_mod
|
||||
implicit none
|
||||
@@ -418,7 +400,6 @@ subroutine psb_dhalo_vect(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
type(psb_d_vect_type), intent(inout) :: x
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
real(psb_dpk_), intent(in), optional :: alpha
|
||||
real(psb_dpk_), target, optional, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(in), optional :: mode,data
|
||||
character, intent(in), optional :: tran
|
||||
@@ -493,12 +474,6 @@ subroutine psb_dhalo_vect(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
call psb_errcomm(ictxt,err)
|
||||
if(err /= 0) goto 9999
|
||||
|
||||
if(present(alpha)) then
|
||||
if(alpha /= done) then
|
||||
call x%scal(alpha)
|
||||
end if
|
||||
end if
|
||||
|
||||
liwork=nrow
|
||||
if (present(work)) then
|
||||
if(size(work) >= liwork) then
|
||||
|
||||
+3
-28
@@ -39,7 +39,6 @@
|
||||
! x - integer,dimension(:,:). The local part of the dense matrix.
|
||||
! desc_a - type(psb_desc_type). The communication descriptor.
|
||||
! info - integer. Return code
|
||||
! alpha - integer(optional). Scale factor.
|
||||
! jx - integer(optional). The starting column of the global matrix.
|
||||
! ik - integer(optional). The number of columns to gather.
|
||||
! work - integer(optional). Work area.
|
||||
@@ -53,7 +52,7 @@
|
||||
! psb_comm_mov_ use ovr_mst_idx
|
||||
!
|
||||
!
|
||||
subroutine psb_ihalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
|
||||
subroutine psb_ihalom(x,desc_a,info,jx,ik,work,tran,mode,data)
|
||||
use psb_base_mod, psb_protect_name => psb_ihalom
|
||||
use psi_mod
|
||||
implicit none
|
||||
@@ -61,7 +60,6 @@ subroutine psb_ihalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
|
||||
integer(psb_ipk_), intent(inout), target :: x(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: alpha
|
||||
integer(psb_ipk_), optional, target, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(in), optional :: mode,jx,ik,data
|
||||
character, intent(in), optional :: tran
|
||||
@@ -147,14 +145,6 @@ subroutine psb_ihalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
|
||||
call psb_errcomm(ictxt,err)
|
||||
if(err /= 0) goto 9999
|
||||
|
||||
if(present(alpha)) then
|
||||
if(alpha /= ione) then
|
||||
do i=0, k-1
|
||||
call iscal(int(nrow,kind=psb_mpik_),alpha,x(:,jjx+i),1)
|
||||
end do
|
||||
end if
|
||||
end if
|
||||
|
||||
liwork=nrow
|
||||
if (present(work)) then
|
||||
if(size(work) >= liwork) then
|
||||
@@ -256,7 +246,6 @@ end subroutine psb_ihalom
|
||||
! x - real,dimension(:). The local part of the dense vector.
|
||||
! desc_a - type(psb_desc_type). The communication descriptor.
|
||||
! info - integer. Return code
|
||||
! alpha - integer(optional). Scale factor.
|
||||
! jx - integer(optional). The starting column of the global matrix.
|
||||
! ik - integer(optional). The number of columns to gather.
|
||||
! work - integer(optional). Work area.
|
||||
@@ -270,7 +259,7 @@ end subroutine psb_ihalom
|
||||
! psb_comm_mov_ use ovr_mst_idx
|
||||
!
|
||||
!
|
||||
subroutine psb_ihalov(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
subroutine psb_ihalov(x,desc_a,info,work,tran,mode,data)
|
||||
use psb_base_mod, psb_protect_name => psb_ihalov
|
||||
use psi_mod
|
||||
implicit none
|
||||
@@ -278,7 +267,6 @@ subroutine psb_ihalov(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
integer(psb_ipk_), intent(inout) :: x(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: alpha
|
||||
integer(psb_ipk_), target, optional, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(in), optional :: mode,data
|
||||
character, intent(in), optional :: tran
|
||||
@@ -347,12 +335,6 @@ subroutine psb_ihalov(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
call psb_errcomm(ictxt,err)
|
||||
if(err /= 0) goto 9999
|
||||
|
||||
if(present(alpha)) then
|
||||
if(alpha /= ione) then
|
||||
call iscal(int(nrow,kind=psb_mpik_),alpha,x,ione)
|
||||
end if
|
||||
end if
|
||||
|
||||
liwork=nrow
|
||||
if (present(work)) then
|
||||
if(size(work) >= liwork) then
|
||||
@@ -410,7 +392,7 @@ subroutine psb_ihalov(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
end subroutine psb_ihalov
|
||||
|
||||
|
||||
subroutine psb_ihalo_vect(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
subroutine psb_ihalo_vect(x,desc_a,info,work,tran,mode,data)
|
||||
use psb_base_mod, psb_protect_name => psb_ihalo_vect
|
||||
use psi_mod
|
||||
implicit none
|
||||
@@ -418,7 +400,6 @@ subroutine psb_ihalo_vect(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
type(psb_i_vect_type), intent(inout) :: x
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: alpha
|
||||
integer(psb_ipk_), target, optional, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(in), optional :: mode,data
|
||||
character, intent(in), optional :: tran
|
||||
@@ -493,12 +474,6 @@ subroutine psb_ihalo_vect(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
call psb_errcomm(ictxt,err)
|
||||
if(err /= 0) goto 9999
|
||||
|
||||
if(present(alpha)) then
|
||||
if(alpha /= ione) then
|
||||
call x%scal(alpha)
|
||||
end if
|
||||
end if
|
||||
|
||||
liwork=nrow
|
||||
if (present(work)) then
|
||||
if(size(work) >= liwork) then
|
||||
|
||||
+3
-28
@@ -39,7 +39,6 @@
|
||||
! x - real,dimension(:,:). The local part of the dense matrix.
|
||||
! desc_a - type(psb_desc_type). The communication descriptor.
|
||||
! info - integer. Return code
|
||||
! alpha - real(optional). Scale factor.
|
||||
! jx - integer(optional). The starting column of the global matrix.
|
||||
! ik - integer(optional). The number of columns to gather.
|
||||
! work - real(optional). Work area.
|
||||
@@ -53,7 +52,7 @@
|
||||
! psb_comm_mov_ use ovr_mst_idx
|
||||
!
|
||||
!
|
||||
subroutine psb_shalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
|
||||
subroutine psb_shalom(x,desc_a,info,jx,ik,work,tran,mode,data)
|
||||
use psb_base_mod, psb_protect_name => psb_shalom
|
||||
use psi_mod
|
||||
implicit none
|
||||
@@ -61,7 +60,6 @@ subroutine psb_shalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
|
||||
real(psb_spk_), intent(inout), target :: x(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
real(psb_spk_), intent(in), optional :: alpha
|
||||
real(psb_spk_), optional, target, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(in), optional :: mode,jx,ik,data
|
||||
character, intent(in), optional :: tran
|
||||
@@ -147,14 +145,6 @@ subroutine psb_shalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
|
||||
call psb_errcomm(ictxt,err)
|
||||
if(err /= 0) goto 9999
|
||||
|
||||
if(present(alpha)) then
|
||||
if(alpha /= sone) then
|
||||
do i=0, k-1
|
||||
call sscal(int(nrow,kind=psb_mpik_),alpha,x(:,jjx+i),1)
|
||||
end do
|
||||
end if
|
||||
end if
|
||||
|
||||
liwork=nrow
|
||||
if (present(work)) then
|
||||
if(size(work) >= liwork) then
|
||||
@@ -256,7 +246,6 @@ end subroutine psb_shalom
|
||||
! x - real,dimension(:). The local part of the dense vector.
|
||||
! desc_a - type(psb_desc_type). The communication descriptor.
|
||||
! info - integer. Return code
|
||||
! alpha - real(optional). Scale factor.
|
||||
! jx - integer(optional). The starting column of the global matrix.
|
||||
! ik - integer(optional). The number of columns to gather.
|
||||
! work - real(optional). Work area.
|
||||
@@ -270,7 +259,7 @@ end subroutine psb_shalom
|
||||
! psb_comm_mov_ use ovr_mst_idx
|
||||
!
|
||||
!
|
||||
subroutine psb_shalov(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
subroutine psb_shalov(x,desc_a,info,work,tran,mode,data)
|
||||
use psb_base_mod, psb_protect_name => psb_shalov
|
||||
use psi_mod
|
||||
implicit none
|
||||
@@ -278,7 +267,6 @@ subroutine psb_shalov(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
real(psb_spk_), intent(inout) :: x(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
real(psb_spk_), intent(in), optional :: alpha
|
||||
real(psb_spk_), target, optional, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(in), optional :: mode,data
|
||||
character, intent(in), optional :: tran
|
||||
@@ -347,12 +335,6 @@ subroutine psb_shalov(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
call psb_errcomm(ictxt,err)
|
||||
if(err /= 0) goto 9999
|
||||
|
||||
if(present(alpha)) then
|
||||
if(alpha /= sone) then
|
||||
call sscal(int(nrow,kind=psb_mpik_),alpha,x,ione)
|
||||
end if
|
||||
end if
|
||||
|
||||
liwork=nrow
|
||||
if (present(work)) then
|
||||
if(size(work) >= liwork) then
|
||||
@@ -410,7 +392,7 @@ subroutine psb_shalov(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
end subroutine psb_shalov
|
||||
|
||||
|
||||
subroutine psb_shalo_vect(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
subroutine psb_shalo_vect(x,desc_a,info,work,tran,mode,data)
|
||||
use psb_base_mod, psb_protect_name => psb_shalo_vect
|
||||
use psi_mod
|
||||
implicit none
|
||||
@@ -418,7 +400,6 @@ subroutine psb_shalo_vect(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
type(psb_s_vect_type), intent(inout) :: x
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
real(psb_spk_), intent(in), optional :: alpha
|
||||
real(psb_spk_), target, optional, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(in), optional :: mode,data
|
||||
character, intent(in), optional :: tran
|
||||
@@ -493,12 +474,6 @@ subroutine psb_shalo_vect(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
call psb_errcomm(ictxt,err)
|
||||
if(err /= 0) goto 9999
|
||||
|
||||
if(present(alpha)) then
|
||||
if(alpha /= sone) then
|
||||
call x%scal(alpha)
|
||||
end if
|
||||
end if
|
||||
|
||||
liwork=nrow
|
||||
if (present(work)) then
|
||||
if(size(work) >= liwork) then
|
||||
|
||||
+3
-28
@@ -39,7 +39,6 @@
|
||||
! x - complex,dimension(:,:). The local part of the dense matrix.
|
||||
! desc_a - type(psb_desc_type). The communication descriptor.
|
||||
! info - integer. Return code
|
||||
! alpha - complex(optional). Scale factor.
|
||||
! jx - integer(optional). The starting column of the global matrix.
|
||||
! ik - integer(optional). The number of columns to gather.
|
||||
! work - complex(optional). Work area.
|
||||
@@ -53,7 +52,7 @@
|
||||
! psb_comm_mov_ use ovr_mst_idx
|
||||
!
|
||||
!
|
||||
subroutine psb_zhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
|
||||
subroutine psb_zhalom(x,desc_a,info,jx,ik,work,tran,mode,data)
|
||||
use psb_base_mod, psb_protect_name => psb_zhalom
|
||||
use psi_mod
|
||||
implicit none
|
||||
@@ -61,7 +60,6 @@ subroutine psb_zhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
|
||||
complex(psb_dpk_), intent(inout), target :: x(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
complex(psb_dpk_), intent(in), optional :: alpha
|
||||
complex(psb_dpk_), optional, target, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(in), optional :: mode,jx,ik,data
|
||||
character, intent(in), optional :: tran
|
||||
@@ -147,14 +145,6 @@ subroutine psb_zhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
|
||||
call psb_errcomm(ictxt,err)
|
||||
if(err /= 0) goto 9999
|
||||
|
||||
if(present(alpha)) then
|
||||
if(alpha /= zone) then
|
||||
do i=0, k-1
|
||||
call zscal(int(nrow,kind=psb_mpik_),alpha,x(:,jjx+i),1)
|
||||
end do
|
||||
end if
|
||||
end if
|
||||
|
||||
liwork=nrow
|
||||
if (present(work)) then
|
||||
if(size(work) >= liwork) then
|
||||
@@ -256,7 +246,6 @@ end subroutine psb_zhalom
|
||||
! x - real,dimension(:). The local part of the dense vector.
|
||||
! desc_a - type(psb_desc_type). The communication descriptor.
|
||||
! info - integer. Return code
|
||||
! alpha - complex(optional). Scale factor.
|
||||
! jx - integer(optional). The starting column of the global matrix.
|
||||
! ik - integer(optional). The number of columns to gather.
|
||||
! work - complex(optional). Work area.
|
||||
@@ -270,7 +259,7 @@ end subroutine psb_zhalom
|
||||
! psb_comm_mov_ use ovr_mst_idx
|
||||
!
|
||||
!
|
||||
subroutine psb_zhalov(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
subroutine psb_zhalov(x,desc_a,info,work,tran,mode,data)
|
||||
use psb_base_mod, psb_protect_name => psb_zhalov
|
||||
use psi_mod
|
||||
implicit none
|
||||
@@ -278,7 +267,6 @@ subroutine psb_zhalov(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
complex(psb_dpk_), intent(inout) :: x(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
complex(psb_dpk_), intent(in), optional :: alpha
|
||||
complex(psb_dpk_), target, optional, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(in), optional :: mode,data
|
||||
character, intent(in), optional :: tran
|
||||
@@ -347,12 +335,6 @@ subroutine psb_zhalov(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
call psb_errcomm(ictxt,err)
|
||||
if(err /= 0) goto 9999
|
||||
|
||||
if(present(alpha)) then
|
||||
if(alpha /= zone) then
|
||||
call zscal(int(nrow,kind=psb_mpik_),alpha,x,ione)
|
||||
end if
|
||||
end if
|
||||
|
||||
liwork=nrow
|
||||
if (present(work)) then
|
||||
if(size(work) >= liwork) then
|
||||
@@ -410,7 +392,7 @@ subroutine psb_zhalov(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
end subroutine psb_zhalov
|
||||
|
||||
|
||||
subroutine psb_zhalo_vect(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
subroutine psb_zhalo_vect(x,desc_a,info,work,tran,mode,data)
|
||||
use psb_base_mod, psb_protect_name => psb_zhalo_vect
|
||||
use psi_mod
|
||||
implicit none
|
||||
@@ -418,7 +400,6 @@ subroutine psb_zhalo_vect(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
type(psb_z_vect_type), intent(inout) :: x
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
complex(psb_dpk_), intent(in), optional :: alpha
|
||||
complex(psb_dpk_), target, optional, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(in), optional :: mode,data
|
||||
character, intent(in), optional :: tran
|
||||
@@ -493,12 +474,6 @@ subroutine psb_zhalo_vect(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
call psb_errcomm(ictxt,err)
|
||||
if(err /= 0) goto 9999
|
||||
|
||||
if(present(alpha)) then
|
||||
if(alpha /= zone) then
|
||||
call x%scal(alpha)
|
||||
end if
|
||||
end if
|
||||
|
||||
liwork=nrow
|
||||
if (present(work)) then
|
||||
if(size(work) >= liwork) then
|
||||
|
||||
@@ -46,8 +46,8 @@ module psb_c_base_vect_mod
|
||||
|
||||
use psb_const_mod
|
||||
use psb_error_mod
|
||||
use psb_i_base_vect_mod
|
||||
use psb_realloc_mod
|
||||
use psb_i_base_vect_mod
|
||||
|
||||
!> \namespace psb_base_mod \class psb_c_base_vect_type
|
||||
!! The psb_c_base_vect_type
|
||||
@@ -123,6 +123,20 @@ module psb_c_base_vect_mod
|
||||
procedure, pass(x) :: set_scal => c_base_set_scal
|
||||
procedure, pass(x) :: set_vect => c_base_set_vect
|
||||
generic, public :: set => set_vect, set_scal
|
||||
!
|
||||
! Gather/scatter. These are needed for MPI interfacing.
|
||||
! May have to be reworked.
|
||||
!
|
||||
procedure, pass(x) :: gthab => c_base_gthab
|
||||
procedure, pass(x) :: gthzv => c_base_gthzv
|
||||
procedure, pass(x) :: gthzv_x => c_base_gthzv_x
|
||||
procedure, pass(x) :: gthzbuf => c_base_gthzbuf
|
||||
generic, public :: gth => gthab, gthzv, gthzv_x, gthzbuf
|
||||
procedure, pass(y) :: sctb => c_base_sctb
|
||||
procedure, pass(y) :: sctb_x => c_base_sctb_x
|
||||
procedure, pass(y) :: sctb_buf => c_base_sctb_buf
|
||||
generic, public :: sct => sctb, sctb_x, sctb_buf
|
||||
|
||||
|
||||
!
|
||||
! Dot product and AXPBY
|
||||
@@ -154,19 +168,7 @@ module psb_c_base_vect_mod
|
||||
procedure, pass(x) :: nrm2 => c_base_nrm2
|
||||
procedure, pass(x) :: amax => c_base_amax
|
||||
procedure, pass(x) :: asum => c_base_asum
|
||||
!
|
||||
! Gather/scatter. These are needed for MPI interfacing.
|
||||
! May have to be reworked.
|
||||
!
|
||||
procedure, pass(x) :: gthab => c_base_gthab
|
||||
procedure, pass(x) :: gthzv => c_base_gthzv
|
||||
procedure, pass(x) :: gthzv_x => c_base_gthzv_x
|
||||
procedure, pass(x) :: gthzbuf => c_base_gthzbuf
|
||||
generic, public :: gth => gthab, gthzv, gthzv_x, gthzbuf
|
||||
procedure, pass(y) :: sctb => c_base_sctb
|
||||
procedure, pass(y) :: sctb_x => c_base_sctb_x
|
||||
procedure, pass(y) :: sctb_buf => c_base_sctb_buf
|
||||
generic, public :: sct => sctb, sctb_x, sctb_buf
|
||||
|
||||
end type psb_c_base_vect_type
|
||||
|
||||
public :: psb_c_base_vect
|
||||
@@ -668,37 +670,6 @@ contains
|
||||
|
||||
end subroutine c_base_set_scal
|
||||
|
||||
!
|
||||
! Overwrite with absolute value
|
||||
!
|
||||
!
|
||||
!> Function base_set_scal
|
||||
!! \memberof psb_c_base_vect_type
|
||||
!! \brief Set all entries to their respective absolute values.
|
||||
!!
|
||||
subroutine c_base_absval1(x)
|
||||
class(psb_c_base_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) then
|
||||
if (.not.x%is_host()) call x%sync()
|
||||
x%v = abs(x%v)
|
||||
call x%set_host()
|
||||
end if
|
||||
|
||||
end subroutine c_base_absval1
|
||||
|
||||
subroutine c_base_absval2(x,y)
|
||||
class(psb_c_base_vect_type), intent(inout) :: x
|
||||
class(psb_c_base_vect_type), intent(inout) :: y
|
||||
|
||||
if (.not.x%is_host()) call x%sync()
|
||||
if (allocated(x%v)) then
|
||||
call y%bld(x%v)
|
||||
call y%absval()
|
||||
call y%set_host()
|
||||
end if
|
||||
|
||||
end subroutine c_base_absval2
|
||||
|
||||
!
|
||||
!> Function base_set_vect
|
||||
@@ -719,6 +690,7 @@ contains
|
||||
if (present(last)) last_ = min(last,last_)
|
||||
|
||||
if (allocated(x%v)) then
|
||||
if (x%is_dev()) call x%sync()
|
||||
x%v(first_:last_) = val(1:last_-first_+1)
|
||||
else
|
||||
x%v = val
|
||||
@@ -727,6 +699,38 @@ contains
|
||||
|
||||
end subroutine c_base_set_vect
|
||||
|
||||
|
||||
!
|
||||
! Overwrite with absolute value
|
||||
!
|
||||
!
|
||||
!> Function base_set_scal
|
||||
!! \memberof psb_c_base_vect_type
|
||||
!! \brief Set all entries to their respective absolute values.
|
||||
!!
|
||||
subroutine c_base_absval1(x)
|
||||
class(psb_c_base_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) then
|
||||
if (x%is_dev()) call x%sync()
|
||||
x%v = abs(x%v)
|
||||
call x%set_host()
|
||||
end if
|
||||
|
||||
end subroutine c_base_absval1
|
||||
|
||||
subroutine c_base_absval2(x,y)
|
||||
class(psb_c_base_vect_type), intent(inout) :: x
|
||||
class(psb_c_base_vect_type), intent(inout) :: y
|
||||
|
||||
if (.not.x%is_host()) call x%sync()
|
||||
if (allocated(x%v)) then
|
||||
call y%axpby(min(x%get_nrows(),y%get_nrows()),cone,x,czero,info)
|
||||
call y%absval()
|
||||
end if
|
||||
|
||||
end subroutine c_base_absval2
|
||||
|
||||
!
|
||||
! Dot products
|
||||
!
|
||||
@@ -2422,6 +2426,5 @@ contains
|
||||
!!$ call y%sct(n,idx%v(i:),x,beta)
|
||||
!!$
|
||||
!!$ end subroutine c_base_mv_sctb_x
|
||||
|
||||
end module psb_c_base_multivect_mod
|
||||
|
||||
|
||||
@@ -30,27 +30,33 @@
|
||||
!!$
|
||||
!!$
|
||||
module psb_c_comm_mod
|
||||
use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_spk_
|
||||
use psb_mat_mod, only : psb_cspmat_type
|
||||
|
||||
use psb_c_vect_mod, only : psb_c_vect_type, psb_c_base_vect_type
|
||||
|
||||
interface psb_ovrl
|
||||
subroutine psb_covrlm(x,desc_a,info,jx,ik,work,update,mode)
|
||||
use psb_desc_mod
|
||||
subroutine psb_covrlm(x,desc_a,info,jx,ik,work,update,mode)
|
||||
import
|
||||
implicit none
|
||||
complex(psb_spk_), intent(inout), target :: x(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
complex(psb_spk_), intent(inout), optional, target :: work(:)
|
||||
integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode
|
||||
end subroutine psb_covrlm
|
||||
subroutine psb_covrlv(x,desc_a,info,work,update,mode)
|
||||
use psb_desc_mod
|
||||
subroutine psb_covrlv(x,desc_a,info,work,update,mode)
|
||||
import
|
||||
implicit none
|
||||
complex(psb_spk_), intent(inout), target :: x(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
complex(psb_spk_), intent(inout), optional, target :: work(:)
|
||||
integer(psb_ipk_), intent(in), optional :: update,mode
|
||||
end subroutine psb_covrlv
|
||||
subroutine psb_covrl_vect(x,desc_a,info,work,update,mode)
|
||||
use psb_desc_mod
|
||||
use psb_c_vect_mod
|
||||
subroutine psb_covrl_vect(x,desc_a,info,work,update,mode)
|
||||
import
|
||||
implicit none
|
||||
type(psb_c_vect_type), intent(inout) :: x
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -60,33 +66,32 @@ module psb_c_comm_mod
|
||||
end interface psb_ovrl
|
||||
|
||||
interface psb_halo
|
||||
subroutine psb_chalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
|
||||
use psb_desc_mod
|
||||
subroutine psb_chalom(x,desc_a,info,jx,ik,work,tran,mode,data)
|
||||
import
|
||||
implicit none
|
||||
complex(psb_spk_), intent(inout), target :: x(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
complex(psb_spk_), intent(in), optional :: alpha
|
||||
complex(psb_spk_), target, optional, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(in), optional :: mode,jx,ik,data
|
||||
character, intent(in), optional :: tran
|
||||
end subroutine psb_chalom
|
||||
subroutine psb_chalov(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
use psb_desc_mod
|
||||
subroutine psb_chalov(x,desc_a,info,work,tran,mode,data)
|
||||
import
|
||||
implicit none
|
||||
complex(psb_spk_), intent(inout) :: x(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
complex(psb_spk_), intent(in), optional :: alpha
|
||||
complex(psb_spk_), target, optional, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(in), optional :: mode,data
|
||||
character, intent(in), optional :: tran
|
||||
end subroutine psb_chalov
|
||||
subroutine psb_chalo_vect(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
use psb_desc_mod
|
||||
use psb_c_vect_mod
|
||||
subroutine psb_chalo_vect(x,desc_a,info,work,tran,mode,data)
|
||||
import
|
||||
implicit none
|
||||
type(psb_c_vect_type), intent(inout) :: x
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
complex(psb_spk_), intent(in), optional :: alpha
|
||||
complex(psb_spk_), target, optional, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(in), optional :: mode,data
|
||||
character, intent(in), optional :: tran
|
||||
@@ -95,16 +100,18 @@ module psb_c_comm_mod
|
||||
|
||||
|
||||
interface psb_scatter
|
||||
subroutine psb_cscatterm(globx, locx, desc_a, info, root)
|
||||
use psb_desc_mod
|
||||
subroutine psb_cscatterm(globx, locx, desc_a, info, root)
|
||||
import
|
||||
implicit none
|
||||
complex(psb_spk_), intent(out) :: locx(:,:)
|
||||
complex(psb_spk_), intent(in) :: globx(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: root
|
||||
end subroutine psb_cscatterm
|
||||
subroutine psb_cscatterv(globx, locx, desc_a, info, root)
|
||||
use psb_desc_mod
|
||||
subroutine psb_cscatterv(globx, locx, desc_a, info, root)
|
||||
import
|
||||
implicit none
|
||||
complex(psb_spk_), intent(out) :: locx(:)
|
||||
complex(psb_spk_), intent(in) :: globx(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
@@ -114,9 +121,8 @@ module psb_c_comm_mod
|
||||
end interface psb_scatter
|
||||
|
||||
interface psb_gather
|
||||
subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
|
||||
use psb_desc_mod
|
||||
use psb_mat_mod
|
||||
subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
|
||||
import
|
||||
implicit none
|
||||
type(psb_cspmat_type), intent(inout) :: loca
|
||||
type(psb_cspmat_type), intent(out) :: globa
|
||||
@@ -126,24 +132,26 @@ module psb_c_comm_mod
|
||||
logical, intent(in), optional :: keepnum,keeploc
|
||||
end subroutine psb_csp_allgather
|
||||
subroutine psb_cgatherm(globx, locx, desc_a, info, root)
|
||||
use psb_desc_mod
|
||||
import
|
||||
implicit none
|
||||
complex(psb_spk_), intent(in) :: locx(:,:)
|
||||
complex(psb_spk_), intent(out), allocatable :: globx(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: root
|
||||
end subroutine psb_cgatherm
|
||||
subroutine psb_cgatherv(globx, locx, desc_a, info, root)
|
||||
use psb_desc_mod
|
||||
subroutine psb_cgatherv(globx, locx, desc_a, info, root)
|
||||
import
|
||||
implicit none
|
||||
complex(psb_spk_), intent(in) :: locx(:)
|
||||
complex(psb_spk_), intent(out), allocatable :: globx(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: root
|
||||
end subroutine psb_cgatherv
|
||||
subroutine psb_cgather_vect(globx, locx, desc_a, info, root)
|
||||
use psb_desc_mod
|
||||
use psb_c_vect_mod
|
||||
subroutine psb_cgather_vect(globx, locx, desc_a, info, root)
|
||||
import
|
||||
implicit none
|
||||
type(psb_c_vect_type), intent(inout) :: locx
|
||||
complex(psb_spk_), intent(out), allocatable :: globx(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
|
||||
@@ -36,9 +36,7 @@ Module psb_c_tools_mod
|
||||
|
||||
interface psb_geall
|
||||
subroutine psb_calloc(x, desc_a, info, n, lb)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_c_base_vect_type, psb_c_vect_type, &
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
complex(psb_spk_), allocatable, intent(out) :: x(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
@@ -46,27 +44,24 @@ Module psb_c_tools_mod
|
||||
integer(psb_ipk_), optional, intent(in) :: n, lb
|
||||
end subroutine psb_calloc
|
||||
subroutine psb_callocv(x, desc_a,info,n)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_c_base_vect_type, psb_c_vect_type, &
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
complex(psb_spk_), allocatable, intent(out) :: x(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: n
|
||||
end subroutine psb_callocv
|
||||
subroutine psb_calloc_vect(x, desc_a,info,n)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_c_base_vect_type, psb_c_vect_type, &
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_c_vect_type), intent(out) :: x
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_),intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: n
|
||||
end subroutine psb_calloc_vect
|
||||
subroutine psb_calloc_vect_r2(x, desc_a,info,n,lb)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_c_base_vect_type, psb_c_vect_type, &
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_c_vect_type), allocatable, intent(out) :: x(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_),intent(out) :: info
|
||||
@@ -77,25 +72,22 @@ Module psb_c_tools_mod
|
||||
|
||||
interface psb_geasb
|
||||
subroutine psb_casb(x, desc_a, info)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_c_base_vect_type, psb_c_vect_type, &
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
complex(psb_spk_), allocatable, intent(inout) :: x(:,:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_casb
|
||||
subroutine psb_casbv(x, desc_a, info)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_c_base_vect_type, psb_c_vect_type, &
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
complex(psb_spk_), allocatable, intent(inout) :: x(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_casbv
|
||||
subroutine psb_casb_vect(x, desc_a, info,mold, scratch)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_c_base_vect_type, psb_c_vect_type, &
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_c_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -103,9 +95,8 @@ Module psb_c_tools_mod
|
||||
logical, intent(in), optional :: scratch
|
||||
end subroutine psb_casb_vect
|
||||
subroutine psb_casb_vect_r2(x, desc_a, info,mold, scratch)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_c_base_vect_type, psb_c_vect_type, &
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_c_vect_type), intent(inout) :: x(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -114,51 +105,31 @@ Module psb_c_tools_mod
|
||||
end subroutine psb_casb_vect_r2
|
||||
end interface
|
||||
|
||||
interface psb_sphalo
|
||||
Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,&
|
||||
& rowscale,colscale,outfmt,data)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_c_base_vect_type, psb_c_vect_type, &
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat
|
||||
Type(psb_cspmat_type),Intent(in) :: a
|
||||
Type(psb_cspmat_type),Intent(inout) :: blk
|
||||
Type(psb_desc_type),Intent(in), target :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
logical, optional, intent(in) :: rowcnv,colcnv,rowscale,colscale
|
||||
character(len=5), optional :: outfmt
|
||||
integer(psb_ipk_), intent(in), optional :: data
|
||||
end Subroutine psb_csphalo
|
||||
end interface
|
||||
|
||||
interface psb_gefree
|
||||
subroutine psb_cfree(x, desc_a, info)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_c_base_vect_type, psb_c_vect_type, &
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
complex(psb_spk_),allocatable, intent(inout) :: x(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_cfree
|
||||
subroutine psb_cfreev(x, desc_a, info)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_c_base_vect_type, psb_c_vect_type, &
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
complex(psb_spk_),allocatable, intent(inout) :: x(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_cfreev
|
||||
subroutine psb_cfree_vect(x, desc_a, info)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_c_base_vect_type, psb_c_vect_type, &
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_c_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_cfree_vect
|
||||
subroutine psb_cfree_vect_r2(x, desc_a, info)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_c_base_vect_type, psb_c_vect_type, &
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_c_vect_type), allocatable, intent(inout) :: x(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -168,9 +139,8 @@ Module psb_c_tools_mod
|
||||
|
||||
interface psb_geins
|
||||
subroutine psb_cinsi(m,irw,val, x, desc_a,info,dupl,local)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_c_base_vect_type, psb_c_vect_type, &
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
complex(psb_spk_),intent(inout) :: x(:,:)
|
||||
@@ -181,9 +151,8 @@ Module psb_c_tools_mod
|
||||
logical, intent(in), optional :: local
|
||||
end subroutine psb_cinsi
|
||||
subroutine psb_cinsvi(m, irw,val, x,desc_a,info,dupl,local)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_c_base_vect_type, psb_c_vect_type, &
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
complex(psb_spk_),intent(inout) :: x(:)
|
||||
@@ -194,9 +163,8 @@ Module psb_c_tools_mod
|
||||
logical, intent(in), optional :: local
|
||||
end subroutine psb_cinsvi
|
||||
subroutine psb_cins_vect(m,irw,val,x,desc_a,info,dupl,local)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_c_base_vect_type, psb_c_vect_type, &
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_c_vect_type), intent(inout) :: x
|
||||
@@ -207,9 +175,8 @@ Module psb_c_tools_mod
|
||||
logical, intent(in), optional :: local
|
||||
end subroutine psb_cins_vect
|
||||
subroutine psb_cins_vect_v(m,irw,val,x,desc_a,info,dupl,local)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_c_base_vect_type, psb_c_vect_type, psb_i_vect_type, &
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_c_vect_type), intent(inout) :: x
|
||||
@@ -220,9 +187,8 @@ Module psb_c_tools_mod
|
||||
logical, intent(in), optional :: local
|
||||
end subroutine psb_cins_vect_v
|
||||
subroutine psb_cins_vect_r2(m,irw,val,x,desc_a,info,dupl,local)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_c_base_vect_type, psb_c_vect_type, &
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_c_vect_type), intent(inout) :: x(:)
|
||||
@@ -236,9 +202,8 @@ Module psb_c_tools_mod
|
||||
|
||||
interface psb_cdbldext
|
||||
Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info,extype)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_c_base_vect_type, psb_c_vect_type, &
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: novr
|
||||
Type(psb_cspmat_type), Intent(in) :: a
|
||||
Type(psb_desc_type), Intent(inout), target :: desc_a
|
||||
@@ -248,11 +213,26 @@ Module psb_c_tools_mod
|
||||
end Subroutine psb_ccdbldext
|
||||
end interface
|
||||
|
||||
interface psb_sphalo
|
||||
Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,&
|
||||
& rowscale,colscale,outfmt,data)
|
||||
import
|
||||
implicit none
|
||||
Type(psb_cspmat_type),Intent(in) :: a
|
||||
Type(psb_cspmat_type),Intent(inout) :: blk
|
||||
Type(psb_desc_type),Intent(in), target :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
logical, optional, intent(in) :: rowcnv,colcnv,rowscale,colscale
|
||||
character(len=5), optional :: outfmt
|
||||
integer(psb_ipk_), intent(in), optional :: data
|
||||
end Subroutine psb_csphalo
|
||||
end interface
|
||||
|
||||
|
||||
interface psb_spall
|
||||
subroutine psb_cspalloc(a, desc_a, info, nnz)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_c_base_vect_type, psb_c_vect_type, &
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_cspmat_type), intent(inout) :: a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -262,9 +242,8 @@ Module psb_c_tools_mod
|
||||
|
||||
interface psb_spasb
|
||||
subroutine psb_cspasb(a,desc_a, info, afmt, upd, dupl,mold)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_c_base_vect_type, psb_c_vect_type, &
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_cspmat_type), intent (inout) :: a
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -276,9 +255,8 @@ Module psb_c_tools_mod
|
||||
|
||||
interface psb_spfree
|
||||
subroutine psb_cspfree(a, desc_a,info)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_c_base_vect_type, psb_c_vect_type, &
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_cspmat_type), intent(inout) ::a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -288,9 +266,8 @@ Module psb_c_tools_mod
|
||||
|
||||
interface psb_spins
|
||||
subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_c_base_vect_type, psb_c_vect_type, &
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
type(psb_cspmat_type), intent(inout) :: a
|
||||
integer(psb_ipk_), intent(in) :: nz,ia(:),ja(:)
|
||||
@@ -301,9 +278,8 @@ Module psb_c_tools_mod
|
||||
end subroutine psb_cspins
|
||||
subroutine psb_cspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local)
|
||||
use psb_i_vect_mod, only : psb_i_vect_type
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_c_base_vect_type, psb_c_vect_type,&
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
type(psb_cspmat_type), intent(inout) :: a
|
||||
integer(psb_ipk_), intent(in) :: nz
|
||||
@@ -314,9 +290,8 @@ Module psb_c_tools_mod
|
||||
logical, intent(in), optional :: local
|
||||
end subroutine psb_cspins_v
|
||||
subroutine psb_cspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_c_base_vect_type, psb_c_vect_type, &
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_ar
|
||||
type(psb_desc_type), intent(inout) :: desc_ac
|
||||
type(psb_cspmat_type), intent(inout) :: a
|
||||
@@ -329,9 +304,8 @@ Module psb_c_tools_mod
|
||||
|
||||
interface psb_sprn
|
||||
subroutine psb_csprn(a, desc_a,info,clear)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_c_base_vect_type, psb_c_vect_type, &
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_cspmat_type), intent(inout) :: a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
+391
-389
@@ -48,27 +48,6 @@ module psb_c_vect_mod
|
||||
procedure, pass(x) :: get_nrows => c_vect_get_nrows
|
||||
procedure, pass(x) :: sizeof => c_vect_sizeof
|
||||
procedure, pass(x) :: get_fmt => c_vect_get_fmt
|
||||
procedure, pass(x) :: dot_v => c_vect_dot_v
|
||||
procedure, pass(x) :: dot_a => c_vect_dot_a
|
||||
generic, public :: dot => dot_v, dot_a
|
||||
procedure, pass(y) :: axpby_v => c_vect_axpby_v
|
||||
procedure, pass(y) :: axpby_a => c_vect_axpby_a
|
||||
generic, public :: axpby => axpby_v, axpby_a
|
||||
procedure, pass(y) :: mlt_v => c_vect_mlt_v
|
||||
procedure, pass(y) :: mlt_a => c_vect_mlt_a
|
||||
procedure, pass(z) :: mlt_a_2 => c_vect_mlt_a_2
|
||||
procedure, pass(z) :: mlt_v_2 => c_vect_mlt_v_2
|
||||
procedure, pass(z) :: mlt_va => c_vect_mlt_va
|
||||
procedure, pass(z) :: mlt_av => c_vect_mlt_av
|
||||
generic, public :: mlt => mlt_v, mlt_a, mlt_a_2,&
|
||||
& mlt_v_2, mlt_av, mlt_va
|
||||
procedure, pass(x) :: scal => c_vect_scal
|
||||
procedure, pass(x) :: absval1 => c_vect_absval1
|
||||
procedure, pass(x) :: absval2 => c_vect_absval2
|
||||
generic, public :: absval => absval1, absval2
|
||||
procedure, pass(x) :: nrm2 => c_vect_nrm2
|
||||
procedure, pass(x) :: amax => c_vect_amax
|
||||
procedure, pass(x) :: asum => c_vect_asum
|
||||
procedure, pass(x) :: all => c_vect_all
|
||||
procedure, pass(x) :: reall => c_vect_reall
|
||||
procedure, pass(x) :: zero => c_vect_zero
|
||||
@@ -92,6 +71,27 @@ module psb_c_vect_mod
|
||||
procedure, pass(x) :: set_vect => c_vect_set_vect
|
||||
generic, public :: set => set_vect, set_scal
|
||||
procedure, pass(x) :: clone => c_vect_clone
|
||||
procedure, pass(x) :: dot_v => c_vect_dot_v
|
||||
procedure, pass(x) :: dot_a => c_vect_dot_a
|
||||
generic, public :: dot => dot_v, dot_a
|
||||
procedure, pass(y) :: axpby_v => c_vect_axpby_v
|
||||
procedure, pass(y) :: axpby_a => c_vect_axpby_a
|
||||
generic, public :: axpby => axpby_v, axpby_a
|
||||
procedure, pass(y) :: mlt_v => c_vect_mlt_v
|
||||
procedure, pass(y) :: mlt_a => c_vect_mlt_a
|
||||
procedure, pass(z) :: mlt_a_2 => c_vect_mlt_a_2
|
||||
procedure, pass(z) :: mlt_v_2 => c_vect_mlt_v_2
|
||||
procedure, pass(z) :: mlt_va => c_vect_mlt_va
|
||||
procedure, pass(z) :: mlt_av => c_vect_mlt_av
|
||||
generic, public :: mlt => mlt_v, mlt_a, mlt_a_2,&
|
||||
& mlt_v_2, mlt_av, mlt_va
|
||||
procedure, pass(x) :: scal => c_vect_scal
|
||||
procedure, pass(x) :: absval1 => c_vect_absval1
|
||||
procedure, pass(x) :: absval2 => c_vect_absval2
|
||||
generic, public :: absval => absval1, absval2
|
||||
procedure, pass(x) :: nrm2 => c_vect_nrm2
|
||||
procedure, pass(x) :: amax => c_vect_amax
|
||||
procedure, pass(x) :: asum => c_vect_asum
|
||||
end type psb_c_vect_type
|
||||
|
||||
public :: psb_c_vect
|
||||
@@ -296,6 +296,191 @@ contains
|
||||
res = 'NULL'
|
||||
if (allocated(x%v)) res = x%v%get_fmt()
|
||||
end function c_vect_get_fmt
|
||||
subroutine c_vect_all(n, x, info, mold)
|
||||
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: n
|
||||
class(psb_c_vect_type), intent(inout) :: x
|
||||
class(psb_c_base_vect_type), intent(in), optional :: mold
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%free(info)
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
allocate(psb_c_base_vect_type :: x%v,stat=info)
|
||||
endif
|
||||
if (info == 0) then
|
||||
call x%v%all(n,info)
|
||||
else
|
||||
info = psb_err_alloc_dealloc_
|
||||
end if
|
||||
|
||||
end subroutine c_vect_all
|
||||
|
||||
subroutine c_vect_reall(n, x, info)
|
||||
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: n
|
||||
class(psb_c_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = 0
|
||||
if (.not.allocated(x%v)) &
|
||||
& call x%all(n,info)
|
||||
if (info == 0) &
|
||||
& call x%asb(n,info)
|
||||
|
||||
end subroutine c_vect_reall
|
||||
|
||||
subroutine c_vect_zero(x)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_c_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) call x%v%zero()
|
||||
|
||||
end subroutine c_vect_zero
|
||||
|
||||
subroutine c_vect_asb(n, x, info)
|
||||
use psi_serial_mod
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: n
|
||||
class(psb_c_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%asb(n,info)
|
||||
|
||||
end subroutine c_vect_asb
|
||||
|
||||
subroutine c_vect_sync(x)
|
||||
implicit none
|
||||
class(psb_c_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%sync()
|
||||
|
||||
end subroutine c_vect_sync
|
||||
|
||||
subroutine c_vect_gthab(n,idx,alpha,x,beta,y)
|
||||
use psi_serial_mod
|
||||
integer(psb_ipk_) :: n, idx(:)
|
||||
complex(psb_spk_) :: alpha, beta, y(:)
|
||||
class(psb_c_vect_type) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%gth(n,idx,alpha,beta,y)
|
||||
|
||||
end subroutine c_vect_gthab
|
||||
|
||||
subroutine c_vect_gthzv(n,idx,x,y)
|
||||
use psi_serial_mod
|
||||
integer(psb_ipk_) :: n, idx(:)
|
||||
complex(psb_spk_) :: y(:)
|
||||
class(psb_c_vect_type) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%gth(n,idx,y)
|
||||
|
||||
end subroutine c_vect_gthzv
|
||||
|
||||
subroutine c_vect_sctb(n,idx,x,beta,y)
|
||||
use psi_serial_mod
|
||||
integer(psb_ipk_) :: n, idx(:)
|
||||
complex(psb_spk_) :: beta, x(:)
|
||||
class(psb_c_vect_type) :: y
|
||||
|
||||
if (allocated(y%v)) &
|
||||
& call y%v%sct(n,idx,x,beta)
|
||||
|
||||
end subroutine c_vect_sctb
|
||||
|
||||
subroutine c_vect_free(x, info)
|
||||
use psi_serial_mod
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(psb_c_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = 0
|
||||
if (allocated(x%v)) then
|
||||
call x%v%free(info)
|
||||
if (info == 0) deallocate(x%v,stat=info)
|
||||
end if
|
||||
|
||||
end subroutine c_vect_free
|
||||
|
||||
subroutine c_vect_ins_a(n,irl,val,dupl,x,info)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_c_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: n, dupl
|
||||
integer(psb_ipk_), intent(in) :: irl(:)
|
||||
complex(psb_spk_), intent(in) :: val(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
info = 0
|
||||
if (.not.allocated(x%v)) then
|
||||
info = psb_err_invalid_vect_state_
|
||||
return
|
||||
end if
|
||||
|
||||
call x%v%ins(n,irl,val,dupl,info)
|
||||
|
||||
end subroutine c_vect_ins_a
|
||||
|
||||
subroutine c_vect_ins_v(n,irl,val,dupl,x,info)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_c_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: n, dupl
|
||||
class(psb_i_vect_type), intent(inout) :: irl
|
||||
class(psb_c_vect_type), intent(inout) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
info = 0
|
||||
if (.not.(allocated(x%v).and.allocated(irl%v).and.allocated(val%v))) then
|
||||
info = psb_err_invalid_vect_state_
|
||||
return
|
||||
end if
|
||||
|
||||
call x%v%ins(n,irl%v,val%v,dupl,info)
|
||||
|
||||
end subroutine c_vect_ins_v
|
||||
|
||||
|
||||
subroutine c_vect_cnv(x,mold)
|
||||
class(psb_c_vect_type), intent(inout) :: x
|
||||
class(psb_c_base_vect_type), intent(in), optional :: mold
|
||||
class(psb_c_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
|
||||
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 c_vect_cnv
|
||||
|
||||
function c_vect_dot_v(n,x,y) result(res)
|
||||
implicit none
|
||||
@@ -522,191 +707,6 @@ contains
|
||||
|
||||
end function c_vect_asum
|
||||
|
||||
subroutine c_vect_all(n, x, info, mold)
|
||||
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: n
|
||||
class(psb_c_vect_type), intent(inout) :: x
|
||||
class(psb_c_base_vect_type), intent(in), optional :: mold
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%free(info)
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
allocate(psb_c_base_vect_type :: x%v,stat=info)
|
||||
endif
|
||||
if (info == 0) then
|
||||
call x%v%all(n,info)
|
||||
else
|
||||
info = psb_err_alloc_dealloc_
|
||||
end if
|
||||
|
||||
end subroutine c_vect_all
|
||||
|
||||
subroutine c_vect_reall(n, x, info)
|
||||
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: n
|
||||
class(psb_c_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = 0
|
||||
if (.not.allocated(x%v)) &
|
||||
& call x%all(n,info)
|
||||
if (info == 0) &
|
||||
& call x%asb(n,info)
|
||||
|
||||
end subroutine c_vect_reall
|
||||
|
||||
subroutine c_vect_zero(x)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_c_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) call x%v%zero()
|
||||
|
||||
end subroutine c_vect_zero
|
||||
|
||||
subroutine c_vect_asb(n, x, info)
|
||||
use psi_serial_mod
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: n
|
||||
class(psb_c_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%asb(n,info)
|
||||
|
||||
end subroutine c_vect_asb
|
||||
|
||||
subroutine c_vect_sync(x)
|
||||
implicit none
|
||||
class(psb_c_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%sync()
|
||||
|
||||
end subroutine c_vect_sync
|
||||
|
||||
subroutine c_vect_gthab(n,idx,alpha,x,beta,y)
|
||||
use psi_serial_mod
|
||||
integer(psb_ipk_) :: n, idx(:)
|
||||
complex(psb_spk_) :: alpha, beta, y(:)
|
||||
class(psb_c_vect_type) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%gth(n,idx,alpha,beta,y)
|
||||
|
||||
end subroutine c_vect_gthab
|
||||
|
||||
subroutine c_vect_gthzv(n,idx,x,y)
|
||||
use psi_serial_mod
|
||||
integer(psb_ipk_) :: n, idx(:)
|
||||
complex(psb_spk_) :: y(:)
|
||||
class(psb_c_vect_type) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%gth(n,idx,y)
|
||||
|
||||
end subroutine c_vect_gthzv
|
||||
|
||||
subroutine c_vect_sctb(n,idx,x,beta,y)
|
||||
use psi_serial_mod
|
||||
integer(psb_ipk_) :: n, idx(:)
|
||||
complex(psb_spk_) :: beta, x(:)
|
||||
class(psb_c_vect_type) :: y
|
||||
|
||||
if (allocated(y%v)) &
|
||||
& call y%v%sct(n,idx,x,beta)
|
||||
|
||||
end subroutine c_vect_sctb
|
||||
|
||||
subroutine c_vect_free(x, info)
|
||||
use psi_serial_mod
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(psb_c_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = 0
|
||||
if (allocated(x%v)) then
|
||||
call x%v%free(info)
|
||||
if (info == 0) deallocate(x%v,stat=info)
|
||||
end if
|
||||
|
||||
end subroutine c_vect_free
|
||||
|
||||
subroutine c_vect_ins_a(n,irl,val,dupl,x,info)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_c_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: n, dupl
|
||||
integer(psb_ipk_), intent(in) :: irl(:)
|
||||
complex(psb_spk_), intent(in) :: val(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
info = 0
|
||||
if (.not.allocated(x%v)) then
|
||||
info = psb_err_invalid_vect_state_
|
||||
return
|
||||
end if
|
||||
|
||||
call x%v%ins(n,irl,val,dupl,info)
|
||||
|
||||
end subroutine c_vect_ins_a
|
||||
|
||||
subroutine c_vect_ins_v(n,irl,val,dupl,x,info)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_c_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: n, dupl
|
||||
class(psb_i_vect_type), intent(inout) :: irl
|
||||
class(psb_c_vect_type), intent(inout) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
info = 0
|
||||
if (.not.(allocated(x%v).and.allocated(irl%v).and.allocated(val%v))) then
|
||||
info = psb_err_invalid_vect_state_
|
||||
return
|
||||
end if
|
||||
|
||||
call x%v%ins(n,irl%v,val%v,dupl,info)
|
||||
|
||||
end subroutine c_vect_ins_v
|
||||
|
||||
|
||||
subroutine c_vect_cnv(x,mold)
|
||||
class(psb_c_vect_type), intent(inout) :: x
|
||||
class(psb_c_base_vect_type), intent(in), optional :: mold
|
||||
class(psb_c_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
|
||||
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 c_vect_cnv
|
||||
|
||||
end module psb_c_vect_mod
|
||||
|
||||
@@ -726,6 +726,28 @@ module psb_c_multivect_mod
|
||||
procedure, pass(x) :: get_ncols => c_vect_get_ncols
|
||||
procedure, pass(x) :: sizeof => c_vect_sizeof
|
||||
procedure, pass(x) :: get_fmt => c_vect_get_fmt
|
||||
|
||||
procedure, pass(x) :: all => c_vect_all
|
||||
procedure, pass(x) :: reall => c_vect_reall
|
||||
procedure, pass(x) :: zero => c_vect_zero
|
||||
procedure, pass(x) :: asb => c_vect_asb
|
||||
procedure, pass(x) :: sync => c_vect_sync
|
||||
procedure, pass(x) :: free => c_vect_free
|
||||
procedure, pass(x) :: ins => c_vect_ins
|
||||
procedure, pass(x) :: bld_x => c_vect_bld_x
|
||||
procedure, pass(x) :: bld_n => c_vect_bld_n
|
||||
generic, public :: bld => bld_x, bld_n
|
||||
procedure, pass(x) :: get_vect => c_vect_get_vect
|
||||
procedure, pass(x) :: cnv => c_vect_cnv
|
||||
procedure, pass(x) :: set_scal => c_vect_set_scal
|
||||
procedure, pass(x) :: set_vect => c_vect_set_vect
|
||||
generic, public :: set => set_vect, set_scal
|
||||
procedure, pass(x) :: clone => c_vect_clone
|
||||
!!$ procedure, pass(x) :: gthab => c_vect_gthab
|
||||
!!$ procedure, pass(x) :: gthzv => c_vect_gthzv
|
||||
!!$ generic, public :: gth => gthab, gthzv
|
||||
!!$ procedure, pass(y) :: sctb => c_vect_sctb
|
||||
!!$ generic, public :: sct => sctb
|
||||
!!$ procedure, pass(x) :: dot_v => c_vect_dot_v
|
||||
!!$ procedure, pass(x) :: dot_a => c_vect_dot_a
|
||||
!!$ generic, public :: dot => dot_v, dot_a
|
||||
@@ -744,27 +766,6 @@ module psb_c_multivect_mod
|
||||
!!$ procedure, pass(x) :: nrm2 => c_vect_nrm2
|
||||
!!$ procedure, pass(x) :: amax => c_vect_amax
|
||||
!!$ procedure, pass(x) :: asum => c_vect_asum
|
||||
procedure, pass(x) :: all => c_vect_all
|
||||
procedure, pass(x) :: reall => c_vect_reall
|
||||
procedure, pass(x) :: zero => c_vect_zero
|
||||
procedure, pass(x) :: asb => c_vect_asb
|
||||
procedure, pass(x) :: sync => c_vect_sync
|
||||
!!$ procedure, pass(x) :: gthab => c_vect_gthab
|
||||
!!$ procedure, pass(x) :: gthzv => c_vect_gthzv
|
||||
!!$ generic, public :: gth => gthab, gthzv
|
||||
!!$ procedure, pass(y) :: sctb => c_vect_sctb
|
||||
!!$ generic, public :: sct => sctb
|
||||
procedure, pass(x) :: free => c_vect_free
|
||||
procedure, pass(x) :: ins => c_vect_ins
|
||||
procedure, pass(x) :: bld_x => c_vect_bld_x
|
||||
procedure, pass(x) :: bld_n => c_vect_bld_n
|
||||
generic, public :: bld => bld_x, bld_n
|
||||
procedure, pass(x) :: get_vect => c_vect_get_vect
|
||||
procedure, pass(x) :: cnv => c_vect_cnv
|
||||
procedure, pass(x) :: set_scal => c_vect_set_scal
|
||||
procedure, pass(x) :: set_vect => c_vect_set_vect
|
||||
generic, public :: set => set_vect, set_scal
|
||||
procedure, pass(x) :: clone => c_vect_clone
|
||||
end type psb_c_multivect_type
|
||||
|
||||
public :: psb_c_multivect, psb_c_multivect_type,&
|
||||
@@ -971,6 +972,169 @@ contains
|
||||
if (allocated(x%v)) res = x%v%get_fmt()
|
||||
end function c_vect_get_fmt
|
||||
|
||||
subroutine c_vect_all(m,n, x, info, mold)
|
||||
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m,n
|
||||
class(psb_c_multivect_type), intent(out) :: x
|
||||
class(psb_c_base_multivect_type), intent(in), optional :: mold
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
allocate(psb_c_base_multivect_type :: x%v,stat=info)
|
||||
endif
|
||||
if (info == 0) then
|
||||
call x%v%all(m,n,info)
|
||||
else
|
||||
info = psb_err_alloc_dealloc_
|
||||
end if
|
||||
|
||||
end subroutine c_vect_all
|
||||
|
||||
subroutine c_vect_reall(m,n, x, info)
|
||||
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m,n
|
||||
class(psb_c_multivect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = 0
|
||||
if (.not.allocated(x%v)) &
|
||||
& call x%all(m,n,info)
|
||||
if (info == 0) &
|
||||
& call x%asb(m,n,info)
|
||||
|
||||
end subroutine c_vect_reall
|
||||
|
||||
subroutine c_vect_zero(x)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_c_multivect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) call x%v%zero()
|
||||
|
||||
end subroutine c_vect_zero
|
||||
|
||||
subroutine c_vect_asb(m,n, x, info)
|
||||
use psi_serial_mod
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m,n
|
||||
class(psb_c_multivect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%asb(m,n,info)
|
||||
|
||||
end subroutine c_vect_asb
|
||||
|
||||
subroutine c_vect_sync(x)
|
||||
implicit none
|
||||
class(psb_c_multivect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%sync()
|
||||
|
||||
end subroutine c_vect_sync
|
||||
|
||||
!!$ subroutine c_vect_gthab(n,idx,alpha,x,beta,y)
|
||||
!!$ use psi_serial_mod
|
||||
!!$ integer(psb_ipk_) :: n, idx(:)
|
||||
!!$ complex(psb_spk_) :: alpha, beta, y(:)
|
||||
!!$ class(psb_c_multivect_type) :: x
|
||||
!!$
|
||||
!!$ if (allocated(x%v)) &
|
||||
!!$ & call x%v%gth(n,idx,alpha,beta,y)
|
||||
!!$
|
||||
!!$ end subroutine c_vect_gthab
|
||||
!!$
|
||||
!!$ subroutine c_vect_gthzv(n,idx,x,y)
|
||||
!!$ use psi_serial_mod
|
||||
!!$ integer(psb_ipk_) :: n, idx(:)
|
||||
!!$ complex(psb_spk_) :: y(:)
|
||||
!!$ class(psb_c_multivect_type) :: x
|
||||
!!$
|
||||
!!$ if (allocated(x%v)) &
|
||||
!!$ & call x%v%gth(n,idx,y)
|
||||
!!$
|
||||
!!$ end subroutine c_vect_gthzv
|
||||
!!$
|
||||
!!$ subroutine c_vect_sctb(n,idx,x,beta,y)
|
||||
!!$ use psi_serial_mod
|
||||
!!$ integer(psb_ipk_) :: n, idx(:)
|
||||
!!$ complex(psb_spk_) :: beta, x(:)
|
||||
!!$ class(psb_c_multivect_type) :: y
|
||||
!!$
|
||||
!!$ if (allocated(y%v)) &
|
||||
!!$ & call y%v%sct(n,idx,x,beta)
|
||||
!!$
|
||||
!!$ end subroutine c_vect_sctb
|
||||
|
||||
subroutine c_vect_free(x, info)
|
||||
use psi_serial_mod
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(psb_c_multivect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = 0
|
||||
if (allocated(x%v)) then
|
||||
call x%v%free(info)
|
||||
if (info == 0) deallocate(x%v,stat=info)
|
||||
end if
|
||||
|
||||
end subroutine c_vect_free
|
||||
|
||||
subroutine c_vect_ins(n,irl,val,dupl,x,info)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_c_multivect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: n, dupl
|
||||
integer(psb_ipk_), intent(in) :: irl(:)
|
||||
complex(psb_spk_), intent(in) :: val(:,:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
info = 0
|
||||
if (.not.allocated(x%v)) then
|
||||
info = psb_err_invalid_vect_state_
|
||||
return
|
||||
end if
|
||||
|
||||
call x%v%ins(n,irl,val,dupl,info)
|
||||
|
||||
end subroutine c_vect_ins
|
||||
|
||||
|
||||
subroutine c_vect_cnv(x,mold)
|
||||
class(psb_c_multivect_type), intent(inout) :: x
|
||||
class(psb_c_base_multivect_type), intent(in), optional :: mold
|
||||
class(psb_c_base_multivect_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
|
||||
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 c_vect_cnv
|
||||
|
||||
|
||||
!!$ function c_vect_dot_v(n,x,y) result(res)
|
||||
!!$ implicit none
|
||||
!!$ class(psb_c_multivect_type), intent(inout) :: x, y
|
||||
@@ -1178,167 +1342,5 @@ contains
|
||||
!!$ end if
|
||||
!!$
|
||||
!!$ end function c_vect_asum
|
||||
|
||||
subroutine c_vect_all(m,n, x, info, mold)
|
||||
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m,n
|
||||
class(psb_c_multivect_type), intent(out) :: x
|
||||
class(psb_c_base_multivect_type), intent(in), optional :: mold
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
allocate(psb_c_base_multivect_type :: x%v,stat=info)
|
||||
endif
|
||||
if (info == 0) then
|
||||
call x%v%all(m,n,info)
|
||||
else
|
||||
info = psb_err_alloc_dealloc_
|
||||
end if
|
||||
|
||||
end subroutine c_vect_all
|
||||
|
||||
subroutine c_vect_reall(m,n, x, info)
|
||||
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m,n
|
||||
class(psb_c_multivect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = 0
|
||||
if (.not.allocated(x%v)) &
|
||||
& call x%all(m,n,info)
|
||||
if (info == 0) &
|
||||
& call x%asb(m,n,info)
|
||||
|
||||
end subroutine c_vect_reall
|
||||
|
||||
subroutine c_vect_zero(x)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_c_multivect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) call x%v%zero()
|
||||
|
||||
end subroutine c_vect_zero
|
||||
|
||||
subroutine c_vect_asb(m,n, x, info)
|
||||
use psi_serial_mod
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m,n
|
||||
class(psb_c_multivect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%asb(m,n,info)
|
||||
|
||||
end subroutine c_vect_asb
|
||||
|
||||
subroutine c_vect_sync(x)
|
||||
implicit none
|
||||
class(psb_c_multivect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%sync()
|
||||
|
||||
end subroutine c_vect_sync
|
||||
|
||||
!!$ subroutine c_vect_gthab(n,idx,alpha,x,beta,y)
|
||||
!!$ use psi_serial_mod
|
||||
!!$ integer(psb_ipk_) :: n, idx(:)
|
||||
!!$ complex(psb_spk_) :: alpha, beta, y(:)
|
||||
!!$ class(psb_c_multivect_type) :: x
|
||||
!!$
|
||||
!!$ if (allocated(x%v)) &
|
||||
!!$ & call x%v%gth(n,idx,alpha,beta,y)
|
||||
!!$
|
||||
!!$ end subroutine c_vect_gthab
|
||||
!!$
|
||||
!!$ subroutine c_vect_gthzv(n,idx,x,y)
|
||||
!!$ use psi_serial_mod
|
||||
!!$ integer(psb_ipk_) :: n, idx(:)
|
||||
!!$ complex(psb_spk_) :: y(:)
|
||||
!!$ class(psb_c_multivect_type) :: x
|
||||
!!$
|
||||
!!$ if (allocated(x%v)) &
|
||||
!!$ & call x%v%gth(n,idx,y)
|
||||
!!$
|
||||
!!$ end subroutine c_vect_gthzv
|
||||
!!$
|
||||
!!$ subroutine c_vect_sctb(n,idx,x,beta,y)
|
||||
!!$ use psi_serial_mod
|
||||
!!$ integer(psb_ipk_) :: n, idx(:)
|
||||
!!$ complex(psb_spk_) :: beta, x(:)
|
||||
!!$ class(psb_c_multivect_type) :: y
|
||||
!!$
|
||||
!!$ if (allocated(y%v)) &
|
||||
!!$ & call y%v%sct(n,idx,x,beta)
|
||||
!!$
|
||||
!!$ end subroutine c_vect_sctb
|
||||
|
||||
subroutine c_vect_free(x, info)
|
||||
use psi_serial_mod
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(psb_c_multivect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = 0
|
||||
if (allocated(x%v)) then
|
||||
call x%v%free(info)
|
||||
if (info == 0) deallocate(x%v,stat=info)
|
||||
end if
|
||||
|
||||
end subroutine c_vect_free
|
||||
|
||||
subroutine c_vect_ins(n,irl,val,dupl,x,info)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_c_multivect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: n, dupl
|
||||
integer(psb_ipk_), intent(in) :: irl(:)
|
||||
complex(psb_spk_), intent(in) :: val(:,:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
info = 0
|
||||
if (.not.allocated(x%v)) then
|
||||
info = psb_err_invalid_vect_state_
|
||||
return
|
||||
end if
|
||||
|
||||
call x%v%ins(n,irl,val,dupl,info)
|
||||
|
||||
end subroutine c_vect_ins
|
||||
|
||||
|
||||
subroutine c_vect_cnv(x,mold)
|
||||
class(psb_c_multivect_type), intent(inout) :: x
|
||||
class(psb_c_base_multivect_type), intent(in), optional :: mold
|
||||
class(psb_c_base_multivect_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
|
||||
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 c_vect_cnv
|
||||
|
||||
end module psb_c_multivect_mod
|
||||
|
||||
@@ -46,8 +46,8 @@ module psb_d_base_vect_mod
|
||||
|
||||
use psb_const_mod
|
||||
use psb_error_mod
|
||||
use psb_i_base_vect_mod
|
||||
use psb_realloc_mod
|
||||
use psb_i_base_vect_mod
|
||||
|
||||
!> \namespace psb_base_mod \class psb_d_base_vect_type
|
||||
!! The psb_d_base_vect_type
|
||||
@@ -123,6 +123,20 @@ module psb_d_base_vect_mod
|
||||
procedure, pass(x) :: set_scal => d_base_set_scal
|
||||
procedure, pass(x) :: set_vect => d_base_set_vect
|
||||
generic, public :: set => set_vect, set_scal
|
||||
!
|
||||
! Gather/scatter. These are needed for MPI interfacing.
|
||||
! May have to be reworked.
|
||||
!
|
||||
procedure, pass(x) :: gthab => d_base_gthab
|
||||
procedure, pass(x) :: gthzv => d_base_gthzv
|
||||
procedure, pass(x) :: gthzv_x => d_base_gthzv_x
|
||||
procedure, pass(x) :: gthzbuf => d_base_gthzbuf
|
||||
generic, public :: gth => gthab, gthzv, gthzv_x, gthzbuf
|
||||
procedure, pass(y) :: sctb => d_base_sctb
|
||||
procedure, pass(y) :: sctb_x => d_base_sctb_x
|
||||
procedure, pass(y) :: sctb_buf => d_base_sctb_buf
|
||||
generic, public :: sct => sctb, sctb_x, sctb_buf
|
||||
|
||||
|
||||
!
|
||||
! Dot product and AXPBY
|
||||
@@ -154,19 +168,7 @@ module psb_d_base_vect_mod
|
||||
procedure, pass(x) :: nrm2 => d_base_nrm2
|
||||
procedure, pass(x) :: amax => d_base_amax
|
||||
procedure, pass(x) :: asum => d_base_asum
|
||||
!
|
||||
! Gather/scatter. These are needed for MPI interfacing.
|
||||
! May have to be reworked.
|
||||
!
|
||||
procedure, pass(x) :: gthab => d_base_gthab
|
||||
procedure, pass(x) :: gthzv => d_base_gthzv
|
||||
procedure, pass(x) :: gthzv_x => d_base_gthzv_x
|
||||
procedure, pass(x) :: gthzbuf => d_base_gthzbuf
|
||||
generic, public :: gth => gthab, gthzv, gthzv_x, gthzbuf
|
||||
procedure, pass(y) :: sctb => d_base_sctb
|
||||
procedure, pass(y) :: sctb_x => d_base_sctb_x
|
||||
procedure, pass(y) :: sctb_buf => d_base_sctb_buf
|
||||
generic, public :: sct => sctb, sctb_x, sctb_buf
|
||||
|
||||
end type psb_d_base_vect_type
|
||||
|
||||
public :: psb_d_base_vect
|
||||
@@ -668,37 +670,6 @@ contains
|
||||
|
||||
end subroutine d_base_set_scal
|
||||
|
||||
!
|
||||
! Overwrite with absolute value
|
||||
!
|
||||
!
|
||||
!> Function base_set_scal
|
||||
!! \memberof psb_d_base_vect_type
|
||||
!! \brief Set all entries to their respective absolute values.
|
||||
!!
|
||||
subroutine d_base_absval1(x)
|
||||
class(psb_d_base_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) then
|
||||
if (.not.x%is_host()) call x%sync()
|
||||
x%v = abs(x%v)
|
||||
call x%set_host()
|
||||
end if
|
||||
|
||||
end subroutine d_base_absval1
|
||||
|
||||
subroutine d_base_absval2(x,y)
|
||||
class(psb_d_base_vect_type), intent(inout) :: x
|
||||
class(psb_d_base_vect_type), intent(inout) :: y
|
||||
|
||||
if (.not.x%is_host()) call x%sync()
|
||||
if (allocated(x%v)) then
|
||||
call y%bld(x%v)
|
||||
call y%absval()
|
||||
call y%set_host()
|
||||
end if
|
||||
|
||||
end subroutine d_base_absval2
|
||||
|
||||
!
|
||||
!> Function base_set_vect
|
||||
@@ -719,6 +690,7 @@ contains
|
||||
if (present(last)) last_ = min(last,last_)
|
||||
|
||||
if (allocated(x%v)) then
|
||||
if (x%is_dev()) call x%sync()
|
||||
x%v(first_:last_) = val(1:last_-first_+1)
|
||||
else
|
||||
x%v = val
|
||||
@@ -727,6 +699,38 @@ contains
|
||||
|
||||
end subroutine d_base_set_vect
|
||||
|
||||
|
||||
!
|
||||
! Overwrite with absolute value
|
||||
!
|
||||
!
|
||||
!> Function base_set_scal
|
||||
!! \memberof psb_d_base_vect_type
|
||||
!! \brief Set all entries to their respective absolute values.
|
||||
!!
|
||||
subroutine d_base_absval1(x)
|
||||
class(psb_d_base_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) then
|
||||
if (x%is_dev()) call x%sync()
|
||||
x%v = abs(x%v)
|
||||
call x%set_host()
|
||||
end if
|
||||
|
||||
end subroutine d_base_absval1
|
||||
|
||||
subroutine d_base_absval2(x,y)
|
||||
class(psb_d_base_vect_type), intent(inout) :: x
|
||||
class(psb_d_base_vect_type), intent(inout) :: y
|
||||
|
||||
if (.not.x%is_host()) call x%sync()
|
||||
if (allocated(x%v)) then
|
||||
call y%axpby(min(x%get_nrows(),y%get_nrows()),done,x,dzero,info)
|
||||
call y%absval()
|
||||
end if
|
||||
|
||||
end subroutine d_base_absval2
|
||||
|
||||
!
|
||||
! Dot products
|
||||
!
|
||||
@@ -2422,6 +2426,5 @@ contains
|
||||
!!$ call y%sct(n,idx%v(i:),x,beta)
|
||||
!!$
|
||||
!!$ end subroutine d_base_mv_sctb_x
|
||||
|
||||
end module psb_d_base_multivect_mod
|
||||
|
||||
|
||||
@@ -30,27 +30,33 @@
|
||||
!!$
|
||||
!!$
|
||||
module psb_d_comm_mod
|
||||
use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_dpk_
|
||||
use psb_mat_mod, only : psb_dspmat_type
|
||||
|
||||
use psb_d_vect_mod, only : psb_d_vect_type, psb_d_base_vect_type
|
||||
|
||||
interface psb_ovrl
|
||||
subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,update,mode)
|
||||
use psb_desc_mod
|
||||
subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,update,mode)
|
||||
import
|
||||
implicit none
|
||||
real(psb_dpk_), intent(inout), target :: x(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
real(psb_dpk_), intent(inout), optional, target :: work(:)
|
||||
integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode
|
||||
end subroutine psb_dovrlm
|
||||
subroutine psb_dovrlv(x,desc_a,info,work,update,mode)
|
||||
use psb_desc_mod
|
||||
subroutine psb_dovrlv(x,desc_a,info,work,update,mode)
|
||||
import
|
||||
implicit none
|
||||
real(psb_dpk_), intent(inout), target :: x(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
real(psb_dpk_), intent(inout), optional, target :: work(:)
|
||||
integer(psb_ipk_), intent(in), optional :: update,mode
|
||||
end subroutine psb_dovrlv
|
||||
subroutine psb_dovrl_vect(x,desc_a,info,work,update,mode)
|
||||
use psb_desc_mod
|
||||
use psb_d_vect_mod
|
||||
subroutine psb_dovrl_vect(x,desc_a,info,work,update,mode)
|
||||
import
|
||||
implicit none
|
||||
type(psb_d_vect_type), intent(inout) :: x
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -60,33 +66,32 @@ module psb_d_comm_mod
|
||||
end interface psb_ovrl
|
||||
|
||||
interface psb_halo
|
||||
subroutine psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
|
||||
use psb_desc_mod
|
||||
subroutine psb_dhalom(x,desc_a,info,jx,ik,work,tran,mode,data)
|
||||
import
|
||||
implicit none
|
||||
real(psb_dpk_), intent(inout), target :: x(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
real(psb_dpk_), intent(in), optional :: alpha
|
||||
real(psb_dpk_), target, optional, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(in), optional :: mode,jx,ik,data
|
||||
character, intent(in), optional :: tran
|
||||
end subroutine psb_dhalom
|
||||
subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
use psb_desc_mod
|
||||
subroutine psb_dhalov(x,desc_a,info,work,tran,mode,data)
|
||||
import
|
||||
implicit none
|
||||
real(psb_dpk_), intent(inout) :: x(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
real(psb_dpk_), intent(in), optional :: alpha
|
||||
real(psb_dpk_), target, optional, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(in), optional :: mode,data
|
||||
character, intent(in), optional :: tran
|
||||
end subroutine psb_dhalov
|
||||
subroutine psb_dhalo_vect(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
use psb_desc_mod
|
||||
use psb_d_vect_mod
|
||||
subroutine psb_dhalo_vect(x,desc_a,info,work,tran,mode,data)
|
||||
import
|
||||
implicit none
|
||||
type(psb_d_vect_type), intent(inout) :: x
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
real(psb_dpk_), intent(in), optional :: alpha
|
||||
real(psb_dpk_), target, optional, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(in), optional :: mode,data
|
||||
character, intent(in), optional :: tran
|
||||
@@ -95,16 +100,18 @@ module psb_d_comm_mod
|
||||
|
||||
|
||||
interface psb_scatter
|
||||
subroutine psb_dscatterm(globx, locx, desc_a, info, root)
|
||||
use psb_desc_mod
|
||||
subroutine psb_dscatterm(globx, locx, desc_a, info, root)
|
||||
import
|
||||
implicit none
|
||||
real(psb_dpk_), intent(out) :: locx(:,:)
|
||||
real(psb_dpk_), intent(in) :: globx(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: root
|
||||
end subroutine psb_dscatterm
|
||||
subroutine psb_dscatterv(globx, locx, desc_a, info, root)
|
||||
use psb_desc_mod
|
||||
subroutine psb_dscatterv(globx, locx, desc_a, info, root)
|
||||
import
|
||||
implicit none
|
||||
real(psb_dpk_), intent(out) :: locx(:)
|
||||
real(psb_dpk_), intent(in) :: globx(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
@@ -114,9 +121,8 @@ module psb_d_comm_mod
|
||||
end interface psb_scatter
|
||||
|
||||
interface psb_gather
|
||||
subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
|
||||
use psb_desc_mod
|
||||
use psb_mat_mod
|
||||
subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
|
||||
import
|
||||
implicit none
|
||||
type(psb_dspmat_type), intent(inout) :: loca
|
||||
type(psb_dspmat_type), intent(out) :: globa
|
||||
@@ -126,24 +132,26 @@ module psb_d_comm_mod
|
||||
logical, intent(in), optional :: keepnum,keeploc
|
||||
end subroutine psb_dsp_allgather
|
||||
subroutine psb_dgatherm(globx, locx, desc_a, info, root)
|
||||
use psb_desc_mod
|
||||
import
|
||||
implicit none
|
||||
real(psb_dpk_), intent(in) :: locx(:,:)
|
||||
real(psb_dpk_), intent(out), allocatable :: globx(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: root
|
||||
end subroutine psb_dgatherm
|
||||
subroutine psb_dgatherv(globx, locx, desc_a, info, root)
|
||||
use psb_desc_mod
|
||||
subroutine psb_dgatherv(globx, locx, desc_a, info, root)
|
||||
import
|
||||
implicit none
|
||||
real(psb_dpk_), intent(in) :: locx(:)
|
||||
real(psb_dpk_), intent(out), allocatable :: globx(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: root
|
||||
end subroutine psb_dgatherv
|
||||
subroutine psb_dgather_vect(globx, locx, desc_a, info, root)
|
||||
use psb_desc_mod
|
||||
use psb_d_vect_mod
|
||||
subroutine psb_dgather_vect(globx, locx, desc_a, info, root)
|
||||
import
|
||||
implicit none
|
||||
type(psb_d_vect_type), intent(inout) :: locx
|
||||
real(psb_dpk_), intent(out), allocatable :: globx(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
|
||||
@@ -36,9 +36,7 @@ Module psb_d_tools_mod
|
||||
|
||||
interface psb_geall
|
||||
subroutine psb_dalloc(x, desc_a, info, n, lb)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_d_base_vect_type, psb_d_vect_type, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
real(psb_dpk_), allocatable, intent(out) :: x(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
@@ -46,27 +44,24 @@ Module psb_d_tools_mod
|
||||
integer(psb_ipk_), optional, intent(in) :: n, lb
|
||||
end subroutine psb_dalloc
|
||||
subroutine psb_dallocv(x, desc_a,info,n)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_d_base_vect_type, psb_d_vect_type, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
real(psb_dpk_), allocatable, intent(out) :: x(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: n
|
||||
end subroutine psb_dallocv
|
||||
subroutine psb_dalloc_vect(x, desc_a,info,n)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_d_base_vect_type, psb_d_vect_type, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_d_vect_type), intent(out) :: x
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_),intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: n
|
||||
end subroutine psb_dalloc_vect
|
||||
subroutine psb_dalloc_vect_r2(x, desc_a,info,n,lb)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_d_base_vect_type, psb_d_vect_type, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_d_vect_type), allocatable, intent(out) :: x(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_),intent(out) :: info
|
||||
@@ -77,25 +72,22 @@ Module psb_d_tools_mod
|
||||
|
||||
interface psb_geasb
|
||||
subroutine psb_dasb(x, desc_a, info)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_d_base_vect_type, psb_d_vect_type, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
real(psb_dpk_), allocatable, intent(inout) :: x(:,:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_dasb
|
||||
subroutine psb_dasbv(x, desc_a, info)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_d_base_vect_type, psb_d_vect_type, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
real(psb_dpk_), allocatable, intent(inout) :: x(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_dasbv
|
||||
subroutine psb_dasb_vect(x, desc_a, info,mold, scratch)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_d_base_vect_type, psb_d_vect_type, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_d_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -103,9 +95,8 @@ Module psb_d_tools_mod
|
||||
logical, intent(in), optional :: scratch
|
||||
end subroutine psb_dasb_vect
|
||||
subroutine psb_dasb_vect_r2(x, desc_a, info,mold, scratch)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_d_base_vect_type, psb_d_vect_type, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_d_vect_type), intent(inout) :: x(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -114,51 +105,31 @@ Module psb_d_tools_mod
|
||||
end subroutine psb_dasb_vect_r2
|
||||
end interface
|
||||
|
||||
interface psb_sphalo
|
||||
Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
|
||||
& rowscale,colscale,outfmt,data)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_d_base_vect_type, psb_d_vect_type, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat
|
||||
Type(psb_dspmat_type),Intent(in) :: a
|
||||
Type(psb_dspmat_type),Intent(inout) :: blk
|
||||
Type(psb_desc_type),Intent(in), target :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
logical, optional, intent(in) :: rowcnv,colcnv,rowscale,colscale
|
||||
character(len=5), optional :: outfmt
|
||||
integer(psb_ipk_), intent(in), optional :: data
|
||||
end Subroutine psb_dsphalo
|
||||
end interface
|
||||
|
||||
interface psb_gefree
|
||||
subroutine psb_dfree(x, desc_a, info)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_d_base_vect_type, psb_d_vect_type, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
real(psb_dpk_),allocatable, intent(inout) :: x(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_dfree
|
||||
subroutine psb_dfreev(x, desc_a, info)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_d_base_vect_type, psb_d_vect_type, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
real(psb_dpk_),allocatable, intent(inout) :: x(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_dfreev
|
||||
subroutine psb_dfree_vect(x, desc_a, info)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_d_base_vect_type, psb_d_vect_type, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_d_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_dfree_vect
|
||||
subroutine psb_dfree_vect_r2(x, desc_a, info)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_d_base_vect_type, psb_d_vect_type, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_d_vect_type), allocatable, intent(inout) :: x(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -168,9 +139,8 @@ Module psb_d_tools_mod
|
||||
|
||||
interface psb_geins
|
||||
subroutine psb_dinsi(m,irw,val, x, desc_a,info,dupl,local)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_d_base_vect_type, psb_d_vect_type, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
real(psb_dpk_),intent(inout) :: x(:,:)
|
||||
@@ -181,9 +151,8 @@ Module psb_d_tools_mod
|
||||
logical, intent(in), optional :: local
|
||||
end subroutine psb_dinsi
|
||||
subroutine psb_dinsvi(m, irw,val, x,desc_a,info,dupl,local)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_d_base_vect_type, psb_d_vect_type, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
real(psb_dpk_),intent(inout) :: x(:)
|
||||
@@ -194,9 +163,8 @@ Module psb_d_tools_mod
|
||||
logical, intent(in), optional :: local
|
||||
end subroutine psb_dinsvi
|
||||
subroutine psb_dins_vect(m,irw,val,x,desc_a,info,dupl,local)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_d_base_vect_type, psb_d_vect_type, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_d_vect_type), intent(inout) :: x
|
||||
@@ -207,9 +175,8 @@ Module psb_d_tools_mod
|
||||
logical, intent(in), optional :: local
|
||||
end subroutine psb_dins_vect
|
||||
subroutine psb_dins_vect_v(m,irw,val,x,desc_a,info,dupl,local)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_d_base_vect_type, psb_d_vect_type, psb_i_vect_type, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_d_vect_type), intent(inout) :: x
|
||||
@@ -220,9 +187,8 @@ Module psb_d_tools_mod
|
||||
logical, intent(in), optional :: local
|
||||
end subroutine psb_dins_vect_v
|
||||
subroutine psb_dins_vect_r2(m,irw,val,x,desc_a,info,dupl,local)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_d_base_vect_type, psb_d_vect_type, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_d_vect_type), intent(inout) :: x(:)
|
||||
@@ -236,9 +202,8 @@ Module psb_d_tools_mod
|
||||
|
||||
interface psb_cdbldext
|
||||
Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info,extype)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_d_base_vect_type, psb_d_vect_type, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: novr
|
||||
Type(psb_dspmat_type), Intent(in) :: a
|
||||
Type(psb_desc_type), Intent(inout), target :: desc_a
|
||||
@@ -248,11 +213,26 @@ Module psb_d_tools_mod
|
||||
end Subroutine psb_dcdbldext
|
||||
end interface
|
||||
|
||||
interface psb_sphalo
|
||||
Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
|
||||
& rowscale,colscale,outfmt,data)
|
||||
import
|
||||
implicit none
|
||||
Type(psb_dspmat_type),Intent(in) :: a
|
||||
Type(psb_dspmat_type),Intent(inout) :: blk
|
||||
Type(psb_desc_type),Intent(in), target :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
logical, optional, intent(in) :: rowcnv,colcnv,rowscale,colscale
|
||||
character(len=5), optional :: outfmt
|
||||
integer(psb_ipk_), intent(in), optional :: data
|
||||
end Subroutine psb_dsphalo
|
||||
end interface
|
||||
|
||||
|
||||
interface psb_spall
|
||||
subroutine psb_dspalloc(a, desc_a, info, nnz)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_d_base_vect_type, psb_d_vect_type, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_dspmat_type), intent(inout) :: a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -262,9 +242,8 @@ Module psb_d_tools_mod
|
||||
|
||||
interface psb_spasb
|
||||
subroutine psb_dspasb(a,desc_a, info, afmt, upd, dupl,mold)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_d_base_vect_type, psb_d_vect_type, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_dspmat_type), intent (inout) :: a
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -276,9 +255,8 @@ Module psb_d_tools_mod
|
||||
|
||||
interface psb_spfree
|
||||
subroutine psb_dspfree(a, desc_a,info)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_d_base_vect_type, psb_d_vect_type, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_dspmat_type), intent(inout) ::a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -288,9 +266,8 @@ Module psb_d_tools_mod
|
||||
|
||||
interface psb_spins
|
||||
subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_d_base_vect_type, psb_d_vect_type, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
type(psb_dspmat_type), intent(inout) :: a
|
||||
integer(psb_ipk_), intent(in) :: nz,ia(:),ja(:)
|
||||
@@ -301,9 +278,8 @@ Module psb_d_tools_mod
|
||||
end subroutine psb_dspins
|
||||
subroutine psb_dspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local)
|
||||
use psb_i_vect_mod, only : psb_i_vect_type
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_d_base_vect_type, psb_d_vect_type,&
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
type(psb_dspmat_type), intent(inout) :: a
|
||||
integer(psb_ipk_), intent(in) :: nz
|
||||
@@ -314,9 +290,8 @@ Module psb_d_tools_mod
|
||||
logical, intent(in), optional :: local
|
||||
end subroutine psb_dspins_v
|
||||
subroutine psb_dspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_d_base_vect_type, psb_d_vect_type, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_ar
|
||||
type(psb_desc_type), intent(inout) :: desc_ac
|
||||
type(psb_dspmat_type), intent(inout) :: a
|
||||
@@ -329,9 +304,8 @@ Module psb_d_tools_mod
|
||||
|
||||
interface psb_sprn
|
||||
subroutine psb_dsprn(a, desc_a,info,clear)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_d_base_vect_type, psb_d_vect_type, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_dspmat_type), intent(inout) :: a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
+391
-389
@@ -48,27 +48,6 @@ module psb_d_vect_mod
|
||||
procedure, pass(x) :: get_nrows => d_vect_get_nrows
|
||||
procedure, pass(x) :: sizeof => d_vect_sizeof
|
||||
procedure, pass(x) :: get_fmt => d_vect_get_fmt
|
||||
procedure, pass(x) :: dot_v => d_vect_dot_v
|
||||
procedure, pass(x) :: dot_a => d_vect_dot_a
|
||||
generic, public :: dot => dot_v, dot_a
|
||||
procedure, pass(y) :: axpby_v => d_vect_axpby_v
|
||||
procedure, pass(y) :: axpby_a => d_vect_axpby_a
|
||||
generic, public :: axpby => axpby_v, axpby_a
|
||||
procedure, pass(y) :: mlt_v => d_vect_mlt_v
|
||||
procedure, pass(y) :: mlt_a => d_vect_mlt_a
|
||||
procedure, pass(z) :: mlt_a_2 => d_vect_mlt_a_2
|
||||
procedure, pass(z) :: mlt_v_2 => d_vect_mlt_v_2
|
||||
procedure, pass(z) :: mlt_va => d_vect_mlt_va
|
||||
procedure, pass(z) :: mlt_av => d_vect_mlt_av
|
||||
generic, public :: mlt => mlt_v, mlt_a, mlt_a_2,&
|
||||
& mlt_v_2, mlt_av, mlt_va
|
||||
procedure, pass(x) :: scal => d_vect_scal
|
||||
procedure, pass(x) :: absval1 => d_vect_absval1
|
||||
procedure, pass(x) :: absval2 => d_vect_absval2
|
||||
generic, public :: absval => absval1, absval2
|
||||
procedure, pass(x) :: nrm2 => d_vect_nrm2
|
||||
procedure, pass(x) :: amax => d_vect_amax
|
||||
procedure, pass(x) :: asum => d_vect_asum
|
||||
procedure, pass(x) :: all => d_vect_all
|
||||
procedure, pass(x) :: reall => d_vect_reall
|
||||
procedure, pass(x) :: zero => d_vect_zero
|
||||
@@ -92,6 +71,27 @@ module psb_d_vect_mod
|
||||
procedure, pass(x) :: set_vect => d_vect_set_vect
|
||||
generic, public :: set => set_vect, set_scal
|
||||
procedure, pass(x) :: clone => d_vect_clone
|
||||
procedure, pass(x) :: dot_v => d_vect_dot_v
|
||||
procedure, pass(x) :: dot_a => d_vect_dot_a
|
||||
generic, public :: dot => dot_v, dot_a
|
||||
procedure, pass(y) :: axpby_v => d_vect_axpby_v
|
||||
procedure, pass(y) :: axpby_a => d_vect_axpby_a
|
||||
generic, public :: axpby => axpby_v, axpby_a
|
||||
procedure, pass(y) :: mlt_v => d_vect_mlt_v
|
||||
procedure, pass(y) :: mlt_a => d_vect_mlt_a
|
||||
procedure, pass(z) :: mlt_a_2 => d_vect_mlt_a_2
|
||||
procedure, pass(z) :: mlt_v_2 => d_vect_mlt_v_2
|
||||
procedure, pass(z) :: mlt_va => d_vect_mlt_va
|
||||
procedure, pass(z) :: mlt_av => d_vect_mlt_av
|
||||
generic, public :: mlt => mlt_v, mlt_a, mlt_a_2,&
|
||||
& mlt_v_2, mlt_av, mlt_va
|
||||
procedure, pass(x) :: scal => d_vect_scal
|
||||
procedure, pass(x) :: absval1 => d_vect_absval1
|
||||
procedure, pass(x) :: absval2 => d_vect_absval2
|
||||
generic, public :: absval => absval1, absval2
|
||||
procedure, pass(x) :: nrm2 => d_vect_nrm2
|
||||
procedure, pass(x) :: amax => d_vect_amax
|
||||
procedure, pass(x) :: asum => d_vect_asum
|
||||
end type psb_d_vect_type
|
||||
|
||||
public :: psb_d_vect
|
||||
@@ -296,6 +296,191 @@ contains
|
||||
res = 'NULL'
|
||||
if (allocated(x%v)) res = x%v%get_fmt()
|
||||
end function d_vect_get_fmt
|
||||
subroutine d_vect_all(n, x, info, mold)
|
||||
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: n
|
||||
class(psb_d_vect_type), intent(inout) :: x
|
||||
class(psb_d_base_vect_type), intent(in), optional :: mold
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%free(info)
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
allocate(psb_d_base_vect_type :: x%v,stat=info)
|
||||
endif
|
||||
if (info == 0) then
|
||||
call x%v%all(n,info)
|
||||
else
|
||||
info = psb_err_alloc_dealloc_
|
||||
end if
|
||||
|
||||
end subroutine d_vect_all
|
||||
|
||||
subroutine d_vect_reall(n, x, info)
|
||||
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: n
|
||||
class(psb_d_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = 0
|
||||
if (.not.allocated(x%v)) &
|
||||
& call x%all(n,info)
|
||||
if (info == 0) &
|
||||
& call x%asb(n,info)
|
||||
|
||||
end subroutine d_vect_reall
|
||||
|
||||
subroutine d_vect_zero(x)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_d_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) call x%v%zero()
|
||||
|
||||
end subroutine d_vect_zero
|
||||
|
||||
subroutine d_vect_asb(n, x, info)
|
||||
use psi_serial_mod
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: n
|
||||
class(psb_d_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%asb(n,info)
|
||||
|
||||
end subroutine d_vect_asb
|
||||
|
||||
subroutine d_vect_sync(x)
|
||||
implicit none
|
||||
class(psb_d_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%sync()
|
||||
|
||||
end subroutine d_vect_sync
|
||||
|
||||
subroutine d_vect_gthab(n,idx,alpha,x,beta,y)
|
||||
use psi_serial_mod
|
||||
integer(psb_ipk_) :: n, idx(:)
|
||||
real(psb_dpk_) :: alpha, beta, y(:)
|
||||
class(psb_d_vect_type) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%gth(n,idx,alpha,beta,y)
|
||||
|
||||
end subroutine d_vect_gthab
|
||||
|
||||
subroutine d_vect_gthzv(n,idx,x,y)
|
||||
use psi_serial_mod
|
||||
integer(psb_ipk_) :: n, idx(:)
|
||||
real(psb_dpk_) :: y(:)
|
||||
class(psb_d_vect_type) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%gth(n,idx,y)
|
||||
|
||||
end subroutine d_vect_gthzv
|
||||
|
||||
subroutine d_vect_sctb(n,idx,x,beta,y)
|
||||
use psi_serial_mod
|
||||
integer(psb_ipk_) :: n, idx(:)
|
||||
real(psb_dpk_) :: beta, x(:)
|
||||
class(psb_d_vect_type) :: y
|
||||
|
||||
if (allocated(y%v)) &
|
||||
& call y%v%sct(n,idx,x,beta)
|
||||
|
||||
end subroutine d_vect_sctb
|
||||
|
||||
subroutine d_vect_free(x, info)
|
||||
use psi_serial_mod
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(psb_d_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = 0
|
||||
if (allocated(x%v)) then
|
||||
call x%v%free(info)
|
||||
if (info == 0) deallocate(x%v,stat=info)
|
||||
end if
|
||||
|
||||
end subroutine d_vect_free
|
||||
|
||||
subroutine d_vect_ins_a(n,irl,val,dupl,x,info)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_d_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: n, dupl
|
||||
integer(psb_ipk_), intent(in) :: irl(:)
|
||||
real(psb_dpk_), intent(in) :: val(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
info = 0
|
||||
if (.not.allocated(x%v)) then
|
||||
info = psb_err_invalid_vect_state_
|
||||
return
|
||||
end if
|
||||
|
||||
call x%v%ins(n,irl,val,dupl,info)
|
||||
|
||||
end subroutine d_vect_ins_a
|
||||
|
||||
subroutine d_vect_ins_v(n,irl,val,dupl,x,info)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_d_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: n, dupl
|
||||
class(psb_i_vect_type), intent(inout) :: irl
|
||||
class(psb_d_vect_type), intent(inout) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
info = 0
|
||||
if (.not.(allocated(x%v).and.allocated(irl%v).and.allocated(val%v))) then
|
||||
info = psb_err_invalid_vect_state_
|
||||
return
|
||||
end if
|
||||
|
||||
call x%v%ins(n,irl%v,val%v,dupl,info)
|
||||
|
||||
end subroutine d_vect_ins_v
|
||||
|
||||
|
||||
subroutine d_vect_cnv(x,mold)
|
||||
class(psb_d_vect_type), intent(inout) :: x
|
||||
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
|
||||
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
|
||||
|
||||
function d_vect_dot_v(n,x,y) result(res)
|
||||
implicit none
|
||||
@@ -522,191 +707,6 @@ contains
|
||||
|
||||
end function d_vect_asum
|
||||
|
||||
subroutine d_vect_all(n, x, info, mold)
|
||||
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: n
|
||||
class(psb_d_vect_type), intent(inout) :: x
|
||||
class(psb_d_base_vect_type), intent(in), optional :: mold
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%free(info)
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
allocate(psb_d_base_vect_type :: x%v,stat=info)
|
||||
endif
|
||||
if (info == 0) then
|
||||
call x%v%all(n,info)
|
||||
else
|
||||
info = psb_err_alloc_dealloc_
|
||||
end if
|
||||
|
||||
end subroutine d_vect_all
|
||||
|
||||
subroutine d_vect_reall(n, x, info)
|
||||
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: n
|
||||
class(psb_d_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = 0
|
||||
if (.not.allocated(x%v)) &
|
||||
& call x%all(n,info)
|
||||
if (info == 0) &
|
||||
& call x%asb(n,info)
|
||||
|
||||
end subroutine d_vect_reall
|
||||
|
||||
subroutine d_vect_zero(x)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_d_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) call x%v%zero()
|
||||
|
||||
end subroutine d_vect_zero
|
||||
|
||||
subroutine d_vect_asb(n, x, info)
|
||||
use psi_serial_mod
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: n
|
||||
class(psb_d_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%asb(n,info)
|
||||
|
||||
end subroutine d_vect_asb
|
||||
|
||||
subroutine d_vect_sync(x)
|
||||
implicit none
|
||||
class(psb_d_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%sync()
|
||||
|
||||
end subroutine d_vect_sync
|
||||
|
||||
subroutine d_vect_gthab(n,idx,alpha,x,beta,y)
|
||||
use psi_serial_mod
|
||||
integer(psb_ipk_) :: n, idx(:)
|
||||
real(psb_dpk_) :: alpha, beta, y(:)
|
||||
class(psb_d_vect_type) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%gth(n,idx,alpha,beta,y)
|
||||
|
||||
end subroutine d_vect_gthab
|
||||
|
||||
subroutine d_vect_gthzv(n,idx,x,y)
|
||||
use psi_serial_mod
|
||||
integer(psb_ipk_) :: n, idx(:)
|
||||
real(psb_dpk_) :: y(:)
|
||||
class(psb_d_vect_type) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%gth(n,idx,y)
|
||||
|
||||
end subroutine d_vect_gthzv
|
||||
|
||||
subroutine d_vect_sctb(n,idx,x,beta,y)
|
||||
use psi_serial_mod
|
||||
integer(psb_ipk_) :: n, idx(:)
|
||||
real(psb_dpk_) :: beta, x(:)
|
||||
class(psb_d_vect_type) :: y
|
||||
|
||||
if (allocated(y%v)) &
|
||||
& call y%v%sct(n,idx,x,beta)
|
||||
|
||||
end subroutine d_vect_sctb
|
||||
|
||||
subroutine d_vect_free(x, info)
|
||||
use psi_serial_mod
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(psb_d_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = 0
|
||||
if (allocated(x%v)) then
|
||||
call x%v%free(info)
|
||||
if (info == 0) deallocate(x%v,stat=info)
|
||||
end if
|
||||
|
||||
end subroutine d_vect_free
|
||||
|
||||
subroutine d_vect_ins_a(n,irl,val,dupl,x,info)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_d_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: n, dupl
|
||||
integer(psb_ipk_), intent(in) :: irl(:)
|
||||
real(psb_dpk_), intent(in) :: val(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
info = 0
|
||||
if (.not.allocated(x%v)) then
|
||||
info = psb_err_invalid_vect_state_
|
||||
return
|
||||
end if
|
||||
|
||||
call x%v%ins(n,irl,val,dupl,info)
|
||||
|
||||
end subroutine d_vect_ins_a
|
||||
|
||||
subroutine d_vect_ins_v(n,irl,val,dupl,x,info)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_d_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: n, dupl
|
||||
class(psb_i_vect_type), intent(inout) :: irl
|
||||
class(psb_d_vect_type), intent(inout) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
info = 0
|
||||
if (.not.(allocated(x%v).and.allocated(irl%v).and.allocated(val%v))) then
|
||||
info = psb_err_invalid_vect_state_
|
||||
return
|
||||
end if
|
||||
|
||||
call x%v%ins(n,irl%v,val%v,dupl,info)
|
||||
|
||||
end subroutine d_vect_ins_v
|
||||
|
||||
|
||||
subroutine d_vect_cnv(x,mold)
|
||||
class(psb_d_vect_type), intent(inout) :: x
|
||||
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
|
||||
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
|
||||
|
||||
end module psb_d_vect_mod
|
||||
|
||||
@@ -726,6 +726,28 @@ module psb_d_multivect_mod
|
||||
procedure, pass(x) :: get_ncols => d_vect_get_ncols
|
||||
procedure, pass(x) :: sizeof => d_vect_sizeof
|
||||
procedure, pass(x) :: get_fmt => d_vect_get_fmt
|
||||
|
||||
procedure, pass(x) :: all => d_vect_all
|
||||
procedure, pass(x) :: reall => d_vect_reall
|
||||
procedure, pass(x) :: zero => d_vect_zero
|
||||
procedure, pass(x) :: asb => d_vect_asb
|
||||
procedure, pass(x) :: sync => d_vect_sync
|
||||
procedure, pass(x) :: free => d_vect_free
|
||||
procedure, pass(x) :: ins => d_vect_ins
|
||||
procedure, pass(x) :: bld_x => d_vect_bld_x
|
||||
procedure, pass(x) :: bld_n => d_vect_bld_n
|
||||
generic, public :: bld => bld_x, bld_n
|
||||
procedure, pass(x) :: get_vect => d_vect_get_vect
|
||||
procedure, pass(x) :: cnv => d_vect_cnv
|
||||
procedure, pass(x) :: set_scal => d_vect_set_scal
|
||||
procedure, pass(x) :: set_vect => d_vect_set_vect
|
||||
generic, public :: set => set_vect, set_scal
|
||||
procedure, pass(x) :: clone => d_vect_clone
|
||||
!!$ procedure, pass(x) :: gthab => d_vect_gthab
|
||||
!!$ procedure, pass(x) :: gthzv => d_vect_gthzv
|
||||
!!$ generic, public :: gth => gthab, gthzv
|
||||
!!$ procedure, pass(y) :: sctb => d_vect_sctb
|
||||
!!$ generic, public :: sct => sctb
|
||||
!!$ procedure, pass(x) :: dot_v => d_vect_dot_v
|
||||
!!$ procedure, pass(x) :: dot_a => d_vect_dot_a
|
||||
!!$ generic, public :: dot => dot_v, dot_a
|
||||
@@ -744,27 +766,6 @@ module psb_d_multivect_mod
|
||||
!!$ procedure, pass(x) :: nrm2 => d_vect_nrm2
|
||||
!!$ procedure, pass(x) :: amax => d_vect_amax
|
||||
!!$ procedure, pass(x) :: asum => d_vect_asum
|
||||
procedure, pass(x) :: all => d_vect_all
|
||||
procedure, pass(x) :: reall => d_vect_reall
|
||||
procedure, pass(x) :: zero => d_vect_zero
|
||||
procedure, pass(x) :: asb => d_vect_asb
|
||||
procedure, pass(x) :: sync => d_vect_sync
|
||||
!!$ procedure, pass(x) :: gthab => d_vect_gthab
|
||||
!!$ procedure, pass(x) :: gthzv => d_vect_gthzv
|
||||
!!$ generic, public :: gth => gthab, gthzv
|
||||
!!$ procedure, pass(y) :: sctb => d_vect_sctb
|
||||
!!$ generic, public :: sct => sctb
|
||||
procedure, pass(x) :: free => d_vect_free
|
||||
procedure, pass(x) :: ins => d_vect_ins
|
||||
procedure, pass(x) :: bld_x => d_vect_bld_x
|
||||
procedure, pass(x) :: bld_n => d_vect_bld_n
|
||||
generic, public :: bld => bld_x, bld_n
|
||||
procedure, pass(x) :: get_vect => d_vect_get_vect
|
||||
procedure, pass(x) :: cnv => d_vect_cnv
|
||||
procedure, pass(x) :: set_scal => d_vect_set_scal
|
||||
procedure, pass(x) :: set_vect => d_vect_set_vect
|
||||
generic, public :: set => set_vect, set_scal
|
||||
procedure, pass(x) :: clone => d_vect_clone
|
||||
end type psb_d_multivect_type
|
||||
|
||||
public :: psb_d_multivect, psb_d_multivect_type,&
|
||||
@@ -971,6 +972,169 @@ contains
|
||||
if (allocated(x%v)) res = x%v%get_fmt()
|
||||
end function d_vect_get_fmt
|
||||
|
||||
subroutine d_vect_all(m,n, x, info, mold)
|
||||
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m,n
|
||||
class(psb_d_multivect_type), intent(out) :: x
|
||||
class(psb_d_base_multivect_type), intent(in), optional :: mold
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
allocate(psb_d_base_multivect_type :: x%v,stat=info)
|
||||
endif
|
||||
if (info == 0) then
|
||||
call x%v%all(m,n,info)
|
||||
else
|
||||
info = psb_err_alloc_dealloc_
|
||||
end if
|
||||
|
||||
end subroutine d_vect_all
|
||||
|
||||
subroutine d_vect_reall(m,n, x, info)
|
||||
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m,n
|
||||
class(psb_d_multivect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = 0
|
||||
if (.not.allocated(x%v)) &
|
||||
& call x%all(m,n,info)
|
||||
if (info == 0) &
|
||||
& call x%asb(m,n,info)
|
||||
|
||||
end subroutine d_vect_reall
|
||||
|
||||
subroutine d_vect_zero(x)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_d_multivect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) call x%v%zero()
|
||||
|
||||
end subroutine d_vect_zero
|
||||
|
||||
subroutine d_vect_asb(m,n, x, info)
|
||||
use psi_serial_mod
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m,n
|
||||
class(psb_d_multivect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%asb(m,n,info)
|
||||
|
||||
end subroutine d_vect_asb
|
||||
|
||||
subroutine d_vect_sync(x)
|
||||
implicit none
|
||||
class(psb_d_multivect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%sync()
|
||||
|
||||
end subroutine d_vect_sync
|
||||
|
||||
!!$ subroutine d_vect_gthab(n,idx,alpha,x,beta,y)
|
||||
!!$ use psi_serial_mod
|
||||
!!$ integer(psb_ipk_) :: n, idx(:)
|
||||
!!$ real(psb_dpk_) :: alpha, beta, y(:)
|
||||
!!$ class(psb_d_multivect_type) :: x
|
||||
!!$
|
||||
!!$ if (allocated(x%v)) &
|
||||
!!$ & call x%v%gth(n,idx,alpha,beta,y)
|
||||
!!$
|
||||
!!$ end subroutine d_vect_gthab
|
||||
!!$
|
||||
!!$ subroutine d_vect_gthzv(n,idx,x,y)
|
||||
!!$ use psi_serial_mod
|
||||
!!$ integer(psb_ipk_) :: n, idx(:)
|
||||
!!$ real(psb_dpk_) :: y(:)
|
||||
!!$ class(psb_d_multivect_type) :: x
|
||||
!!$
|
||||
!!$ if (allocated(x%v)) &
|
||||
!!$ & call x%v%gth(n,idx,y)
|
||||
!!$
|
||||
!!$ end subroutine d_vect_gthzv
|
||||
!!$
|
||||
!!$ subroutine d_vect_sctb(n,idx,x,beta,y)
|
||||
!!$ use psi_serial_mod
|
||||
!!$ integer(psb_ipk_) :: n, idx(:)
|
||||
!!$ real(psb_dpk_) :: beta, x(:)
|
||||
!!$ class(psb_d_multivect_type) :: y
|
||||
!!$
|
||||
!!$ if (allocated(y%v)) &
|
||||
!!$ & call y%v%sct(n,idx,x,beta)
|
||||
!!$
|
||||
!!$ end subroutine d_vect_sctb
|
||||
|
||||
subroutine d_vect_free(x, info)
|
||||
use psi_serial_mod
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(psb_d_multivect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = 0
|
||||
if (allocated(x%v)) then
|
||||
call x%v%free(info)
|
||||
if (info == 0) deallocate(x%v,stat=info)
|
||||
end if
|
||||
|
||||
end subroutine d_vect_free
|
||||
|
||||
subroutine d_vect_ins(n,irl,val,dupl,x,info)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_d_multivect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: n, dupl
|
||||
integer(psb_ipk_), intent(in) :: irl(:)
|
||||
real(psb_dpk_), intent(in) :: val(:,:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
info = 0
|
||||
if (.not.allocated(x%v)) then
|
||||
info = psb_err_invalid_vect_state_
|
||||
return
|
||||
end if
|
||||
|
||||
call x%v%ins(n,irl,val,dupl,info)
|
||||
|
||||
end subroutine d_vect_ins
|
||||
|
||||
|
||||
subroutine d_vect_cnv(x,mold)
|
||||
class(psb_d_multivect_type), intent(inout) :: x
|
||||
class(psb_d_base_multivect_type), intent(in), optional :: mold
|
||||
class(psb_d_base_multivect_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
|
||||
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
|
||||
|
||||
|
||||
!!$ function d_vect_dot_v(n,x,y) result(res)
|
||||
!!$ implicit none
|
||||
!!$ class(psb_d_multivect_type), intent(inout) :: x, y
|
||||
@@ -1178,167 +1342,5 @@ contains
|
||||
!!$ end if
|
||||
!!$
|
||||
!!$ end function d_vect_asum
|
||||
|
||||
subroutine d_vect_all(m,n, x, info, mold)
|
||||
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m,n
|
||||
class(psb_d_multivect_type), intent(out) :: x
|
||||
class(psb_d_base_multivect_type), intent(in), optional :: mold
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
allocate(psb_d_base_multivect_type :: x%v,stat=info)
|
||||
endif
|
||||
if (info == 0) then
|
||||
call x%v%all(m,n,info)
|
||||
else
|
||||
info = psb_err_alloc_dealloc_
|
||||
end if
|
||||
|
||||
end subroutine d_vect_all
|
||||
|
||||
subroutine d_vect_reall(m,n, x, info)
|
||||
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m,n
|
||||
class(psb_d_multivect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = 0
|
||||
if (.not.allocated(x%v)) &
|
||||
& call x%all(m,n,info)
|
||||
if (info == 0) &
|
||||
& call x%asb(m,n,info)
|
||||
|
||||
end subroutine d_vect_reall
|
||||
|
||||
subroutine d_vect_zero(x)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_d_multivect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) call x%v%zero()
|
||||
|
||||
end subroutine d_vect_zero
|
||||
|
||||
subroutine d_vect_asb(m,n, x, info)
|
||||
use psi_serial_mod
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m,n
|
||||
class(psb_d_multivect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%asb(m,n,info)
|
||||
|
||||
end subroutine d_vect_asb
|
||||
|
||||
subroutine d_vect_sync(x)
|
||||
implicit none
|
||||
class(psb_d_multivect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%sync()
|
||||
|
||||
end subroutine d_vect_sync
|
||||
|
||||
!!$ subroutine d_vect_gthab(n,idx,alpha,x,beta,y)
|
||||
!!$ use psi_serial_mod
|
||||
!!$ integer(psb_ipk_) :: n, idx(:)
|
||||
!!$ real(psb_dpk_) :: alpha, beta, y(:)
|
||||
!!$ class(psb_d_multivect_type) :: x
|
||||
!!$
|
||||
!!$ if (allocated(x%v)) &
|
||||
!!$ & call x%v%gth(n,idx,alpha,beta,y)
|
||||
!!$
|
||||
!!$ end subroutine d_vect_gthab
|
||||
!!$
|
||||
!!$ subroutine d_vect_gthzv(n,idx,x,y)
|
||||
!!$ use psi_serial_mod
|
||||
!!$ integer(psb_ipk_) :: n, idx(:)
|
||||
!!$ real(psb_dpk_) :: y(:)
|
||||
!!$ class(psb_d_multivect_type) :: x
|
||||
!!$
|
||||
!!$ if (allocated(x%v)) &
|
||||
!!$ & call x%v%gth(n,idx,y)
|
||||
!!$
|
||||
!!$ end subroutine d_vect_gthzv
|
||||
!!$
|
||||
!!$ subroutine d_vect_sctb(n,idx,x,beta,y)
|
||||
!!$ use psi_serial_mod
|
||||
!!$ integer(psb_ipk_) :: n, idx(:)
|
||||
!!$ real(psb_dpk_) :: beta, x(:)
|
||||
!!$ class(psb_d_multivect_type) :: y
|
||||
!!$
|
||||
!!$ if (allocated(y%v)) &
|
||||
!!$ & call y%v%sct(n,idx,x,beta)
|
||||
!!$
|
||||
!!$ end subroutine d_vect_sctb
|
||||
|
||||
subroutine d_vect_free(x, info)
|
||||
use psi_serial_mod
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(psb_d_multivect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = 0
|
||||
if (allocated(x%v)) then
|
||||
call x%v%free(info)
|
||||
if (info == 0) deallocate(x%v,stat=info)
|
||||
end if
|
||||
|
||||
end subroutine d_vect_free
|
||||
|
||||
subroutine d_vect_ins(n,irl,val,dupl,x,info)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_d_multivect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: n, dupl
|
||||
integer(psb_ipk_), intent(in) :: irl(:)
|
||||
real(psb_dpk_), intent(in) :: val(:,:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
info = 0
|
||||
if (.not.allocated(x%v)) then
|
||||
info = psb_err_invalid_vect_state_
|
||||
return
|
||||
end if
|
||||
|
||||
call x%v%ins(n,irl,val,dupl,info)
|
||||
|
||||
end subroutine d_vect_ins
|
||||
|
||||
|
||||
subroutine d_vect_cnv(x,mold)
|
||||
class(psb_d_multivect_type), intent(inout) :: x
|
||||
class(psb_d_base_multivect_type), intent(in), optional :: mold
|
||||
class(psb_d_base_multivect_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
|
||||
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
|
||||
|
||||
end module psb_d_multivect_mod
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -30,27 +30,32 @@
|
||||
!!$
|
||||
!!$
|
||||
module psb_i_comm_mod
|
||||
use psb_desc_mod, only : psb_desc_type, psb_ipk_
|
||||
|
||||
use psb_i_vect_mod, only : psb_i_vect_type, psb_i_base_vect_type
|
||||
|
||||
interface psb_ovrl
|
||||
subroutine psb_iovrlm(x,desc_a,info,jx,ik,work,update,mode)
|
||||
use psb_desc_mod
|
||||
subroutine psb_iovrlm(x,desc_a,info,jx,ik,work,update,mode)
|
||||
import
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(inout), target :: x(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(inout), optional, target :: work(:)
|
||||
integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode
|
||||
end subroutine psb_iovrlm
|
||||
subroutine psb_iovrlv(x,desc_a,info,work,update,mode)
|
||||
use psb_desc_mod
|
||||
subroutine psb_iovrlv(x,desc_a,info,work,update,mode)
|
||||
import
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(inout), target :: x(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(inout), optional, target :: work(:)
|
||||
integer(psb_ipk_), intent(in), optional :: update,mode
|
||||
end subroutine psb_iovrlv
|
||||
subroutine psb_iovrl_vect(x,desc_a,info,work,update,mode)
|
||||
use psb_desc_mod
|
||||
use psb_i_vect_mod
|
||||
subroutine psb_iovrl_vect(x,desc_a,info,work,update,mode)
|
||||
import
|
||||
implicit none
|
||||
type(psb_i_vect_type), intent(inout) :: x
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -60,33 +65,32 @@ module psb_i_comm_mod
|
||||
end interface psb_ovrl
|
||||
|
||||
interface psb_halo
|
||||
subroutine psb_ihalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
|
||||
use psb_desc_mod
|
||||
subroutine psb_ihalom(x,desc_a,info,jx,ik,work,tran,mode,data)
|
||||
import
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(inout), target :: x(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: alpha
|
||||
integer(psb_ipk_), target, optional, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(in), optional :: mode,jx,ik,data
|
||||
character, intent(in), optional :: tran
|
||||
end subroutine psb_ihalom
|
||||
subroutine psb_ihalov(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
use psb_desc_mod
|
||||
subroutine psb_ihalov(x,desc_a,info,work,tran,mode,data)
|
||||
import
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(inout) :: x(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: alpha
|
||||
integer(psb_ipk_), target, optional, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(in), optional :: mode,data
|
||||
character, intent(in), optional :: tran
|
||||
end subroutine psb_ihalov
|
||||
subroutine psb_ihalo_vect(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
use psb_desc_mod
|
||||
use psb_i_vect_mod
|
||||
subroutine psb_ihalo_vect(x,desc_a,info,work,tran,mode,data)
|
||||
import
|
||||
implicit none
|
||||
type(psb_i_vect_type), intent(inout) :: x
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: alpha
|
||||
integer(psb_ipk_), target, optional, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(in), optional :: mode,data
|
||||
character, intent(in), optional :: tran
|
||||
@@ -95,16 +99,18 @@ module psb_i_comm_mod
|
||||
|
||||
|
||||
interface psb_scatter
|
||||
subroutine psb_iscatterm(globx, locx, desc_a, info, root)
|
||||
use psb_desc_mod
|
||||
subroutine psb_iscatterm(globx, locx, desc_a, info, root)
|
||||
import
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(out) :: locx(:,:)
|
||||
integer(psb_ipk_), intent(in) :: globx(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: root
|
||||
end subroutine psb_iscatterm
|
||||
subroutine psb_iscatterv(globx, locx, desc_a, info, root)
|
||||
use psb_desc_mod
|
||||
subroutine psb_iscatterv(globx, locx, desc_a, info, root)
|
||||
import
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(out) :: locx(:)
|
||||
integer(psb_ipk_), intent(in) :: globx(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
@@ -114,36 +120,27 @@ module psb_i_comm_mod
|
||||
end interface psb_scatter
|
||||
|
||||
interface psb_gather
|
||||
!!$ subroutine psb_isp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
|
||||
!!$ use psb_desc_mod
|
||||
!!$ use psb_mat_mod
|
||||
!!$ implicit none
|
||||
!!$ type(psb_ispmat_type), intent(inout) :: loca
|
||||
!!$ type(psb_ispmat_type), intent(out) :: globa
|
||||
!!$ type(psb_desc_type), intent(in) :: desc_a
|
||||
!!$ integer(psb_ipk_), intent(out) :: info
|
||||
!!$ integer(psb_ipk_), intent(in), optional :: root,dupl
|
||||
!!$ logical, intent(in), optional :: keepnum,keeploc
|
||||
!!$ end subroutine psb_isp_allgather
|
||||
subroutine psb_igatherm(globx, locx, desc_a, info, root)
|
||||
use psb_desc_mod
|
||||
import
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: locx(:,:)
|
||||
integer(psb_ipk_), intent(out), allocatable :: globx(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: root
|
||||
end subroutine psb_igatherm
|
||||
subroutine psb_igatherv(globx, locx, desc_a, info, root)
|
||||
use psb_desc_mod
|
||||
subroutine psb_igatherv(globx, locx, desc_a, info, root)
|
||||
import
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: locx(:)
|
||||
integer(psb_ipk_), intent(out), allocatable :: globx(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: root
|
||||
end subroutine psb_igatherv
|
||||
subroutine psb_igather_vect(globx, locx, desc_a, info, root)
|
||||
use psb_desc_mod
|
||||
use psb_i_vect_mod
|
||||
subroutine psb_igather_vect(globx, locx, desc_a, info, root)
|
||||
import
|
||||
implicit none
|
||||
type(psb_i_vect_type), intent(inout) :: locx
|
||||
integer(psb_ipk_), intent(out), allocatable :: globx(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
|
||||
@@ -29,37 +29,38 @@
|
||||
!!$ POSSIBILITY OF SUCH DAMAGE.
|
||||
!!$
|
||||
!!$
|
||||
module psb_i_tools_mod
|
||||
Module psb_i_tools_mod
|
||||
use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_success_
|
||||
use psb_i_vect_mod, only : psb_i_base_vect_type, psb_i_vect_type
|
||||
|
||||
|
||||
interface psb_geall
|
||||
subroutine psb_ialloc(x, desc_a, info,n, lb)
|
||||
import :: psb_ipk_, psb_desc_type
|
||||
integer(psb_ipk_), allocatable, intent(out) :: x(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: n, lb
|
||||
subroutine psb_ialloc(x, desc_a, info, n, lb)
|
||||
import
|
||||
implicit none
|
||||
integer(psb_ipk_), allocatable, intent(out) :: x(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: n, lb
|
||||
end subroutine psb_ialloc
|
||||
subroutine psb_iallocv(x, desc_a,info,n)
|
||||
import :: psb_ipk_, psb_desc_type
|
||||
integer(psb_ipk_), allocatable, intent(out) :: x(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: n
|
||||
import
|
||||
implicit none
|
||||
integer(psb_ipk_), allocatable, intent(out) :: x(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: n
|
||||
end subroutine psb_iallocv
|
||||
subroutine psb_ialloc_vect(x, desc_a,info,n)
|
||||
import :: psb_desc_type, psb_ipk_, &
|
||||
& psb_i_base_vect_type, psb_i_vect_type
|
||||
import
|
||||
implicit none
|
||||
type(psb_i_vect_type), intent(out) :: x
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_),intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: n
|
||||
end subroutine psb_ialloc_vect
|
||||
subroutine psb_ialloc_vect_r2(x, desc_a,info,n,lb)
|
||||
import :: psb_desc_type, psb_ipk_, &
|
||||
& psb_i_base_vect_type, psb_i_vect_type
|
||||
import
|
||||
implicit none
|
||||
type(psb_i_vect_type), allocatable, intent(out) :: x(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_),intent(out) :: info
|
||||
@@ -70,20 +71,22 @@ module psb_i_tools_mod
|
||||
|
||||
interface psb_geasb
|
||||
subroutine psb_iasb(x, desc_a, info)
|
||||
import :: psb_ipk_, psb_desc_type
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), allocatable, intent(inout) :: x(:,:)
|
||||
integer(psb_ipk_), allocatable, intent(inout) :: x(:,:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_iasb
|
||||
subroutine psb_iasbv(x, desc_a, info)
|
||||
import :: psb_ipk_, psb_desc_type
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), allocatable, intent(inout) :: x(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_iasbv
|
||||
subroutine psb_iasb_vect(x, desc_a, info,mold, scratch)
|
||||
import :: psb_desc_type, psb_ipk_, &
|
||||
& psb_i_base_vect_type, psb_i_vect_type
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_i_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -91,8 +94,8 @@ module psb_i_tools_mod
|
||||
logical, intent(in), optional :: scratch
|
||||
end subroutine psb_iasb_vect
|
||||
subroutine psb_iasb_vect_r2(x, desc_a, info,mold, scratch)
|
||||
import :: psb_desc_type, psb_ipk_, &
|
||||
& psb_i_base_vect_type, psb_i_vect_type
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_i_vect_type), intent(inout) :: x(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -101,62 +104,66 @@ module psb_i_tools_mod
|
||||
end subroutine psb_iasb_vect_r2
|
||||
end interface
|
||||
|
||||
|
||||
interface psb_gefree
|
||||
subroutine psb_ifree(x, desc_a, info)
|
||||
import :: psb_ipk_, psb_desc_type
|
||||
integer(psb_ipk_),allocatable, intent(inout) :: x(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
import
|
||||
implicit none
|
||||
integer(psb_ipk_),allocatable, intent(inout) :: x(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_ifree
|
||||
subroutine psb_ifreev(x, desc_a, info)
|
||||
import :: psb_ipk_, psb_desc_type
|
||||
integer(psb_ipk_), allocatable, intent(inout) :: x(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
import
|
||||
implicit none
|
||||
integer(psb_ipk_),allocatable, intent(inout) :: x(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_ifreev
|
||||
subroutine psb_ifree_vect(x, desc_a, info)
|
||||
import :: psb_desc_type, psb_ipk_, &
|
||||
& psb_i_base_vect_type, psb_i_vect_type
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_i_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_ifree_vect
|
||||
subroutine psb_ifree_vect_r2(x, desc_a, info)
|
||||
import :: psb_desc_type, psb_ipk_, &
|
||||
& psb_i_base_vect_type, psb_i_vect_type
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_i_vect_type), allocatable, intent(inout) :: x(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_ifree_vect_r2
|
||||
end interface
|
||||
|
||||
|
||||
interface psb_geins
|
||||
subroutine psb_iinsi(m,irw,val, x,desc_a,info,dupl,local)
|
||||
import :: psb_ipk_, psb_desc_type
|
||||
subroutine psb_iinsi(m,irw,val, x, desc_a,info,dupl,local)
|
||||
import
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_),intent(inout) :: x(:,:)
|
||||
integer(psb_ipk_),intent(inout) :: x(:,:)
|
||||
integer(psb_ipk_), intent(in) :: irw(:)
|
||||
integer(psb_ipk_), intent(in) :: val(:,:)
|
||||
integer(psb_ipk_), intent(in) :: val(:,:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: dupl
|
||||
logical, intent(in), optional :: local
|
||||
end subroutine psb_iinsi
|
||||
subroutine psb_iinsvi(m, irw,val, x,desc_a,info,dupl,local)
|
||||
import :: psb_ipk_, psb_desc_type
|
||||
integer(psb_ipk_), intent(in) :: m
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_),intent(inout) :: x(:)
|
||||
integer(psb_ipk_), intent(in) :: irw(:)
|
||||
integer(psb_ipk_), intent(in) :: val(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: dupl
|
||||
import
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_),intent(inout) :: x(:)
|
||||
integer(psb_ipk_), intent(in) :: irw(:)
|
||||
integer(psb_ipk_), intent(in) :: val(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: dupl
|
||||
logical, intent(in), optional :: local
|
||||
end subroutine psb_iinsvi
|
||||
subroutine psb_iins_vect(m,irw,val,x,desc_a,info,dupl,local)
|
||||
import :: psb_desc_type, psb_ipk_, &
|
||||
& psb_i_base_vect_type, psb_i_vect_type
|
||||
import
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_i_vect_type), intent(inout) :: x
|
||||
@@ -167,8 +174,8 @@ module psb_i_tools_mod
|
||||
logical, intent(in), optional :: local
|
||||
end subroutine psb_iins_vect
|
||||
subroutine psb_iins_vect_v(m,irw,val,x,desc_a,info,dupl,local)
|
||||
import :: psb_desc_type, psb_ipk_, &
|
||||
& psb_i_base_vect_type, psb_i_vect_type
|
||||
import
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_i_vect_type), intent(inout) :: x
|
||||
@@ -179,8 +186,8 @@ module psb_i_tools_mod
|
||||
logical, intent(in), optional :: local
|
||||
end subroutine psb_iins_vect_v
|
||||
subroutine psb_iins_vect_r2(m,irw,val,x,desc_a,info,dupl,local)
|
||||
import :: psb_desc_type, psb_ipk_, &
|
||||
& psb_i_base_vect_type, psb_i_vect_type
|
||||
import
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_i_vect_type), intent(inout) :: x(:)
|
||||
@@ -195,7 +202,8 @@ module psb_i_tools_mod
|
||||
|
||||
interface psb_glob_to_loc
|
||||
subroutine psb_glob_to_loc2v(x,y,desc_a,info,iact,owned)
|
||||
import :: psb_ipk_, psb_desc_type
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_),intent(in) :: x(:)
|
||||
integer(psb_ipk_),intent(out) :: y(:)
|
||||
@@ -204,7 +212,8 @@ module psb_i_tools_mod
|
||||
character, intent(in), optional :: iact
|
||||
end subroutine psb_glob_to_loc2v
|
||||
subroutine psb_glob_to_loc1v(x,desc_a,info,iact,owned)
|
||||
import :: psb_ipk_, psb_desc_type
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_),intent(inout) :: x(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -212,7 +221,7 @@ module psb_i_tools_mod
|
||||
character, intent(in), optional :: iact
|
||||
end subroutine psb_glob_to_loc1v
|
||||
subroutine psb_glob_to_loc2s(x,y,desc_a,info,iact,owned)
|
||||
import :: psb_ipk_, psb_desc_type
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_),intent(in) :: x
|
||||
@@ -222,7 +231,7 @@ module psb_i_tools_mod
|
||||
logical, intent(in), optional :: owned
|
||||
end subroutine psb_glob_to_loc2s
|
||||
subroutine psb_glob_to_loc1s(x,desc_a,info,iact,owned)
|
||||
import :: psb_ipk_, psb_desc_type
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_),intent(inout) :: x
|
||||
@@ -234,7 +243,8 @@ module psb_i_tools_mod
|
||||
|
||||
interface psb_loc_to_glob
|
||||
subroutine psb_loc_to_glob2v(x,y,desc_a,info,iact)
|
||||
import :: psb_ipk_, psb_desc_type
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_),intent(in) :: x(:)
|
||||
integer(psb_ipk_),intent(out) :: y(:)
|
||||
@@ -242,14 +252,15 @@ module psb_i_tools_mod
|
||||
character, intent(in), optional :: iact
|
||||
end subroutine psb_loc_to_glob2v
|
||||
subroutine psb_loc_to_glob1v(x,desc_a,info,iact)
|
||||
import :: psb_ipk_, psb_desc_type
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_),intent(inout) :: x(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: iact
|
||||
end subroutine psb_loc_to_glob1v
|
||||
subroutine psb_loc_to_glob2s(x,y,desc_a,info,iact)
|
||||
import :: psb_ipk_, psb_desc_type
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_),intent(in) :: x
|
||||
@@ -258,7 +269,8 @@ module psb_i_tools_mod
|
||||
character, intent(in), optional :: iact
|
||||
end subroutine psb_loc_to_glob2s
|
||||
subroutine psb_loc_to_glob1s(x,desc_a,info,iact)
|
||||
import :: psb_ipk_, psb_desc_type
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_),intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -373,4 +385,3 @@ contains
|
||||
end subroutine psb_local_index_v
|
||||
|
||||
end module psb_i_tools_mod
|
||||
|
||||
|
||||
+31
-468
@@ -47,24 +47,6 @@ module psb_i_vect_mod
|
||||
procedure, pass(x) :: get_nrows => i_vect_get_nrows
|
||||
procedure, pass(x) :: sizeof => i_vect_sizeof
|
||||
procedure, pass(x) :: get_fmt => i_vect_get_fmt
|
||||
procedure, pass(x) :: dot_v => i_vect_dot_v
|
||||
procedure, pass(x) :: dot_a => i_vect_dot_a
|
||||
generic, public :: dot => dot_v, dot_a
|
||||
procedure, pass(y) :: axpby_v => i_vect_axpby_v
|
||||
procedure, pass(y) :: axpby_a => i_vect_axpby_a
|
||||
generic, public :: axpby => axpby_v, axpby_a
|
||||
procedure, pass(y) :: mlt_v => i_vect_mlt_v
|
||||
procedure, pass(y) :: mlt_a => i_vect_mlt_a
|
||||
procedure, pass(z) :: mlt_a_2 => i_vect_mlt_a_2
|
||||
procedure, pass(z) :: mlt_v_2 => i_vect_mlt_v_2
|
||||
procedure, pass(z) :: mlt_va => i_vect_mlt_va
|
||||
procedure, pass(z) :: mlt_av => i_vect_mlt_av
|
||||
generic, public :: mlt => mlt_v, mlt_a, mlt_a_2,&
|
||||
& mlt_v_2, mlt_av, mlt_va
|
||||
procedure, pass(x) :: scal => i_vect_scal
|
||||
procedure, pass(x) :: nrm2 => i_vect_nrm2
|
||||
procedure, pass(x) :: amax => i_vect_amax
|
||||
procedure, pass(x) :: asum => i_vect_asum
|
||||
procedure, pass(x) :: all => i_vect_all
|
||||
procedure, pass(x) :: reall => i_vect_reall
|
||||
procedure, pass(x) :: zero => i_vect_zero
|
||||
@@ -160,11 +142,14 @@ contains
|
||||
|
||||
subroutine i_vect_bld_x(x,invect,mold)
|
||||
integer(psb_ipk_), intent(in) :: invect(:)
|
||||
class(psb_i_vect_type), intent(out) :: x
|
||||
class(psb_i_vect_type), intent(inout) :: x
|
||||
class(psb_i_base_vect_type), intent(in), optional :: mold
|
||||
integer(psb_ipk_) :: info
|
||||
class(psb_i_base_vect_type), pointer :: mld
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%free(info)
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
@@ -187,11 +172,15 @@ contains
|
||||
|
||||
subroutine i_vect_bld_n(x,n,mold)
|
||||
integer(psb_ipk_), intent(in) :: n
|
||||
class(psb_i_vect_type), intent(out) :: x
|
||||
class(psb_i_vect_type), intent(inout) :: x
|
||||
class(psb_i_base_vect_type), intent(in), optional :: mold
|
||||
integer(psb_ipk_) :: info
|
||||
class(psb_i_base_vect_type), pointer :: mld
|
||||
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%free(info)
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
@@ -220,21 +209,23 @@ contains
|
||||
end if
|
||||
end function i_vect_get_vect
|
||||
|
||||
subroutine i_vect_set_scal(x,val)
|
||||
subroutine i_vect_set_scal(x,val,first,last)
|
||||
class(psb_i_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), optional :: first, last
|
||||
|
||||
integer(psb_ipk_) :: info
|
||||
if (allocated(x%v)) call x%v%set(val)
|
||||
if (allocated(x%v)) call x%v%set(val,first,last)
|
||||
|
||||
end subroutine i_vect_set_scal
|
||||
|
||||
subroutine i_vect_set_vect(x,val)
|
||||
subroutine i_vect_set_vect(x,val,first,last)
|
||||
class(psb_i_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: val(:)
|
||||
integer(psb_ipk_), optional :: first, last
|
||||
|
||||
integer(psb_ipk_) :: info
|
||||
if (allocated(x%v)) call x%v%set(val)
|
||||
if (allocated(x%v)) call x%v%set(val,first,last)
|
||||
|
||||
end subroutine i_vect_set_vect
|
||||
|
||||
@@ -283,223 +274,17 @@ contains
|
||||
res = 'NULL'
|
||||
if (allocated(x%v)) res = x%v%get_fmt()
|
||||
end function i_vect_get_fmt
|
||||
|
||||
function i_vect_dot_v(n,x,y) result(res)
|
||||
implicit none
|
||||
class(psb_i_vect_type), intent(inout) :: x, y
|
||||
integer(psb_ipk_), intent(in) :: n
|
||||
integer(psb_ipk_) :: res
|
||||
|
||||
res = izero
|
||||
if (allocated(x%v).and.allocated(y%v)) &
|
||||
& res = x%v%dot(n,y%v)
|
||||
|
||||
end function i_vect_dot_v
|
||||
|
||||
function i_vect_dot_a(n,x,y) result(res)
|
||||
implicit none
|
||||
class(psb_i_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: y(:)
|
||||
integer(psb_ipk_), intent(in) :: n
|
||||
integer(psb_ipk_) :: res
|
||||
|
||||
res = izero
|
||||
if (allocated(x%v)) &
|
||||
& res = x%v%dot(n,y)
|
||||
|
||||
end function i_vect_dot_a
|
||||
|
||||
subroutine i_vect_axpby_v(m,alpha, x, beta, y, info)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m
|
||||
class(psb_i_vect_type), intent(inout) :: x
|
||||
class(psb_i_vect_type), intent(inout) :: y
|
||||
integer(psb_ipk_), intent (in) :: alpha, beta
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (allocated(x%v).and.allocated(y%v)) then
|
||||
call y%v%axpby(m,alpha,x%v,beta,info)
|
||||
else
|
||||
info = psb_err_invalid_vect_state_
|
||||
end if
|
||||
|
||||
end subroutine i_vect_axpby_v
|
||||
|
||||
subroutine i_vect_axpby_a(m,alpha, x, beta, y, info)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m
|
||||
integer(psb_ipk_), intent(in) :: x(:)
|
||||
class(psb_i_vect_type), intent(inout) :: y
|
||||
integer(psb_ipk_), intent (in) :: alpha, beta
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (allocated(y%v)) &
|
||||
& call y%v%axpby(m,alpha,x,beta,info)
|
||||
|
||||
end subroutine i_vect_axpby_a
|
||||
|
||||
|
||||
subroutine i_vect_mlt_v(x, y, info)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_i_vect_type), intent(inout) :: x
|
||||
class(psb_i_vect_type), intent(inout) :: y
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: i, n
|
||||
|
||||
info = 0
|
||||
if (allocated(x%v).and.allocated(y%v)) &
|
||||
& call y%v%mlt(x%v,info)
|
||||
|
||||
end subroutine i_vect_mlt_v
|
||||
|
||||
subroutine i_vect_mlt_a(x, y, info)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: x(:)
|
||||
class(psb_i_vect_type), intent(inout) :: y
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: i, n
|
||||
|
||||
|
||||
info = 0
|
||||
if (allocated(y%v)) &
|
||||
& call y%v%mlt(x,info)
|
||||
|
||||
end subroutine i_vect_mlt_a
|
||||
|
||||
|
||||
subroutine i_vect_mlt_a_2(alpha,x,y,beta,z,info)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: alpha,beta
|
||||
integer(psb_ipk_), intent(in) :: y(:)
|
||||
integer(psb_ipk_), intent(in) :: x(:)
|
||||
class(psb_i_vect_type), intent(inout) :: z
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: i, n
|
||||
|
||||
info = 0
|
||||
if (allocated(z%v)) &
|
||||
& call z%v%mlt(alpha,x,y,beta,info)
|
||||
|
||||
end subroutine i_vect_mlt_a_2
|
||||
|
||||
subroutine i_vect_mlt_v_2(alpha,x,y,beta,z,info,conjgx,conjgy)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: alpha,beta
|
||||
class(psb_i_vect_type), intent(inout) :: x
|
||||
class(psb_i_vect_type), intent(inout) :: y
|
||||
class(psb_i_vect_type), intent(inout) :: z
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=1), intent(in), optional :: conjgx, conjgy
|
||||
|
||||
integer(psb_ipk_) :: i, n
|
||||
|
||||
info = 0
|
||||
if (allocated(x%v).and.allocated(y%v).and.&
|
||||
& allocated(z%v)) &
|
||||
& call z%v%mlt(alpha,x%v,y%v,beta,info,conjgx,conjgy)
|
||||
|
||||
end subroutine i_vect_mlt_v_2
|
||||
|
||||
subroutine i_vect_mlt_av(alpha,x,y,beta,z,info)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: alpha,beta
|
||||
integer(psb_ipk_), intent(in) :: x(:)
|
||||
class(psb_i_vect_type), intent(inout) :: y
|
||||
class(psb_i_vect_type), intent(inout) :: z
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: i, n
|
||||
|
||||
info = 0
|
||||
if (allocated(z%v).and.allocated(y%v)) &
|
||||
& call z%v%mlt(alpha,x,y%v,beta,info)
|
||||
|
||||
end subroutine i_vect_mlt_av
|
||||
|
||||
subroutine i_vect_mlt_va(alpha,x,y,beta,z,info)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: alpha,beta
|
||||
integer(psb_ipk_), intent(in) :: y(:)
|
||||
class(psb_i_vect_type), intent(inout) :: x
|
||||
class(psb_i_vect_type), intent(inout) :: z
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: i, n
|
||||
|
||||
info = 0
|
||||
|
||||
if (allocated(z%v).and.allocated(x%v)) &
|
||||
& call z%v%mlt(alpha,x%v,y,beta,info)
|
||||
|
||||
end subroutine i_vect_mlt_va
|
||||
|
||||
subroutine i_vect_scal(alpha, x)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_i_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent (in) :: alpha
|
||||
|
||||
if (allocated(x%v)) call x%v%scal(alpha)
|
||||
|
||||
end subroutine i_vect_scal
|
||||
|
||||
|
||||
function i_vect_nrm2(n,x) result(res)
|
||||
implicit none
|
||||
class(psb_i_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: n
|
||||
integer(psb_ipk_) :: res
|
||||
|
||||
if (allocated(x%v)) then
|
||||
res = x%v%nrm2(n)
|
||||
else
|
||||
res = izero
|
||||
end if
|
||||
|
||||
end function i_vect_nrm2
|
||||
|
||||
function i_vect_amax(n,x) result(res)
|
||||
implicit none
|
||||
class(psb_i_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: n
|
||||
integer(psb_ipk_) :: res
|
||||
|
||||
if (allocated(x%v)) then
|
||||
res = x%v%amax(n)
|
||||
else
|
||||
res = izero
|
||||
end if
|
||||
|
||||
end function i_vect_amax
|
||||
|
||||
function i_vect_asum(n,x) result(res)
|
||||
implicit none
|
||||
class(psb_i_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: n
|
||||
integer(psb_ipk_) :: res
|
||||
|
||||
if (allocated(x%v)) then
|
||||
res = x%v%asum(n)
|
||||
else
|
||||
res = izero
|
||||
end if
|
||||
|
||||
end function i_vect_asum
|
||||
|
||||
subroutine i_vect_all(n, x, info, mold)
|
||||
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: n
|
||||
class(psb_i_vect_type), intent(out) :: x
|
||||
integer(psb_ipk_), intent(in) :: n
|
||||
class(psb_i_vect_type), intent(inout) :: x
|
||||
class(psb_i_base_vect_type), intent(in), optional :: mold
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%free(info)
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
@@ -653,6 +438,7 @@ contains
|
||||
|
||||
end subroutine i_vect_ins_v
|
||||
|
||||
|
||||
subroutine i_vect_cnv(x,mold)
|
||||
class(psb_i_vect_type), intent(inout) :: x
|
||||
class(psb_i_base_vect_type), intent(in), optional :: mold
|
||||
@@ -683,7 +469,7 @@ module psb_i_multivect_mod
|
||||
use psb_i_base_multivect_mod
|
||||
use psb_const_mod
|
||||
|
||||
private
|
||||
!private
|
||||
|
||||
type psb_i_multivect_type
|
||||
class(psb_i_base_multivect_type), allocatable :: v
|
||||
@@ -692,34 +478,12 @@ module psb_i_multivect_mod
|
||||
procedure, pass(x) :: get_ncols => i_vect_get_ncols
|
||||
procedure, pass(x) :: sizeof => i_vect_sizeof
|
||||
procedure, pass(x) :: get_fmt => i_vect_get_fmt
|
||||
!!$ procedure, pass(x) :: dot_v => i_vect_dot_v
|
||||
!!$ procedure, pass(x) :: dot_a => i_vect_dot_a
|
||||
!!$ generic, public :: dot => dot_v, dot_a
|
||||
!!$ procedure, pass(y) :: axpby_v => i_vect_axpby_v
|
||||
!!$ procedure, pass(y) :: axpby_a => i_vect_axpby_a
|
||||
!!$ generic, public :: axpby => axpby_v, axpby_a
|
||||
!!$ procedure, pass(y) :: mlt_v => i_vect_mlt_v
|
||||
!!$ procedure, pass(y) :: mlt_a => i_vect_mlt_a
|
||||
!!$ procedure, pass(z) :: mlt_a_2 => i_vect_mlt_a_2
|
||||
!!$ procedure, pass(z) :: mlt_v_2 => i_vect_mlt_v_2
|
||||
!!$ procedure, pass(z) :: mlt_va => i_vect_mlt_va
|
||||
!!$ procedure, pass(z) :: mlt_av => i_vect_mlt_av
|
||||
!!$ generic, public :: mlt => mlt_v, mlt_a, mlt_a_2,&
|
||||
!!$ & mlt_v_2, mlt_av, mlt_va
|
||||
!!$ procedure, pass(x) :: scal => i_vect_scal
|
||||
!!$ procedure, pass(x) :: nrm2 => i_vect_nrm2
|
||||
!!$ procedure, pass(x) :: amax => i_vect_amax
|
||||
!!$ procedure, pass(x) :: asum => i_vect_asum
|
||||
|
||||
procedure, pass(x) :: all => i_vect_all
|
||||
procedure, pass(x) :: reall => i_vect_reall
|
||||
procedure, pass(x) :: zero => i_vect_zero
|
||||
procedure, pass(x) :: asb => i_vect_asb
|
||||
procedure, pass(x) :: sync => i_vect_sync
|
||||
!!$ procedure, pass(x) :: gthab => i_vect_gthab
|
||||
!!$ procedure, pass(x) :: gthzv => i_vect_gthzv
|
||||
!!$ generic, public :: gth => gthab, gthzv
|
||||
!!$ procedure, pass(y) :: sctb => i_vect_sctb
|
||||
!!$ generic, public :: sct => sctb
|
||||
procedure, pass(x) :: free => i_vect_free
|
||||
procedure, pass(x) :: ins => i_vect_ins
|
||||
procedure, pass(x) :: bld_x => i_vect_bld_x
|
||||
@@ -731,11 +495,17 @@ module psb_i_multivect_mod
|
||||
procedure, pass(x) :: set_vect => i_vect_set_vect
|
||||
generic, public :: set => set_vect, set_scal
|
||||
procedure, pass(x) :: clone => i_vect_clone
|
||||
!!$ procedure, pass(x) :: gthab => i_vect_gthab
|
||||
!!$ procedure, pass(x) :: gthzv => i_vect_gthzv
|
||||
!!$ generic, public :: gth => gthab, gthzv
|
||||
!!$ procedure, pass(y) :: sctb => i_vect_sctb
|
||||
!!$ generic, public :: sct => sctb
|
||||
end type psb_i_multivect_type
|
||||
|
||||
public :: psb_i_multivect, psb_i_multivect_type,&
|
||||
& psb_set_multivect_default, psb_get_multivect_default
|
||||
|
||||
private
|
||||
interface psb_i_multivect
|
||||
module procedure constructor, size_const
|
||||
end interface
|
||||
@@ -907,7 +677,7 @@ contains
|
||||
function i_vect_get_nrows(x) result(res)
|
||||
implicit none
|
||||
class(psb_i_multivect_type), intent(in) :: x
|
||||
integer(psb_ipk_) :: res
|
||||
integer(psb_ipk_) :: res
|
||||
res = 0
|
||||
if (allocated(x%v)) res = x%v%get_nrows()
|
||||
end function i_vect_get_nrows
|
||||
@@ -936,214 +706,6 @@ contains
|
||||
if (allocated(x%v)) res = x%v%get_fmt()
|
||||
end function i_vect_get_fmt
|
||||
|
||||
!!$ function i_vect_dot_v(n,x,y) result(res)
|
||||
!!$ implicit none
|
||||
!!$ class(psb_i_multivect_type), intent(inout) :: x, y
|
||||
!!$ integer(psb_ipk_), intent(in) :: n
|
||||
!!$ integer(psb_ipk_) :: res
|
||||
!!$
|
||||
!!$ res = izero
|
||||
!!$ if (allocated(x%v).and.allocated(y%v)) &
|
||||
!!$ & res = x%v%dot(n,y%v)
|
||||
!!$
|
||||
!!$ end function i_vect_dot_v
|
||||
!!$
|
||||
!!$ function i_vect_dot_a(n,x,y) result(res)
|
||||
!!$ implicit none
|
||||
!!$ class(psb_i_multivect_type), intent(inout) :: x
|
||||
!!$ integer(psb_ipk_), intent(in) :: y(:)
|
||||
!!$ integer(psb_ipk_), intent(in) :: n
|
||||
!!$ integer(psb_ipk_) :: res
|
||||
!!$
|
||||
!!$ res = izero
|
||||
!!$ if (allocated(x%v)) &
|
||||
!!$ & res = x%v%dot(n,y)
|
||||
!!$
|
||||
!!$ end function i_vect_dot_a
|
||||
!!$
|
||||
!!$ subroutine i_vect_axpby_v(m,alpha, x, beta, y, info)
|
||||
!!$ use psi_serial_mod
|
||||
!!$ implicit none
|
||||
!!$ integer(psb_ipk_), intent(in) :: m
|
||||
!!$ class(psb_i_multivect_type), intent(inout) :: x
|
||||
!!$ class(psb_i_multivect_type), intent(inout) :: y
|
||||
!!$ integer(psb_ipk_), intent (in) :: alpha, beta
|
||||
!!$ integer(psb_ipk_), intent(out) :: info
|
||||
!!$
|
||||
!!$ if (allocated(x%v).and.allocated(y%v)) then
|
||||
!!$ call y%v%axpby(m,alpha,x%v,beta,info)
|
||||
!!$ else
|
||||
!!$ info = psb_err_invalid_vect_state_
|
||||
!!$ end if
|
||||
!!$
|
||||
!!$ end subroutine i_vect_axpby_v
|
||||
!!$
|
||||
!!$ subroutine i_vect_axpby_a(m,alpha, x, beta, y, info)
|
||||
!!$ use psi_serial_mod
|
||||
!!$ implicit none
|
||||
!!$ integer(psb_ipk_), intent(in) :: m
|
||||
!!$ integer(psb_ipk_), intent(in) :: x(:)
|
||||
!!$ class(psb_i_multivect_type), intent(inout) :: y
|
||||
!!$ integer(psb_ipk_), intent (in) :: alpha, beta
|
||||
!!$ integer(psb_ipk_), intent(out) :: info
|
||||
!!$
|
||||
!!$ if (allocated(y%v)) &
|
||||
!!$ & call y%v%axpby(m,alpha,x,beta,info)
|
||||
!!$
|
||||
!!$ end subroutine i_vect_axpby_a
|
||||
!!$
|
||||
!!$
|
||||
!!$ subroutine i_vect_mlt_v(x, y, info)
|
||||
!!$ use psi_serial_mod
|
||||
!!$ implicit none
|
||||
!!$ class(psb_i_multivect_type), intent(inout) :: x
|
||||
!!$ class(psb_i_multivect_type), intent(inout) :: y
|
||||
!!$ integer(psb_ipk_), intent(out) :: info
|
||||
!!$ integer(psb_ipk_) :: i, n
|
||||
!!$
|
||||
!!$ info = 0
|
||||
!!$ if (allocated(x%v).and.allocated(y%v)) &
|
||||
!!$ & call y%v%mlt(x%v,info)
|
||||
!!$
|
||||
!!$ end subroutine i_vect_mlt_v
|
||||
!!$
|
||||
!!$ subroutine i_vect_mlt_a(x, y, info)
|
||||
!!$ use psi_serial_mod
|
||||
!!$ implicit none
|
||||
!!$ integer(psb_ipk_), intent(in) :: x(:)
|
||||
!!$ class(psb_i_multivect_type), intent(inout) :: y
|
||||
!!$ integer(psb_ipk_), intent(out) :: info
|
||||
!!$ integer(psb_ipk_) :: i, n
|
||||
!!$
|
||||
!!$
|
||||
!!$ info = 0
|
||||
!!$ if (allocated(y%v)) &
|
||||
!!$ & call y%v%mlt(x,info)
|
||||
!!$
|
||||
!!$ end subroutine i_vect_mlt_a
|
||||
!!$
|
||||
!!$
|
||||
!!$ subroutine i_vect_mlt_a_2(alpha,x,y,beta,z,info)
|
||||
!!$ use psi_serial_mod
|
||||
!!$ implicit none
|
||||
!!$ integer(psb_ipk_), intent(in) :: alpha,beta
|
||||
!!$ integer(psb_ipk_), intent(in) :: y(:)
|
||||
!!$ integer(psb_ipk_), intent(in) :: x(:)
|
||||
!!$ class(psb_i_multivect_type), intent(inout) :: z
|
||||
!!$ integer(psb_ipk_), intent(out) :: info
|
||||
!!$ integer(psb_ipk_) :: i, n
|
||||
!!$
|
||||
!!$ info = 0
|
||||
!!$ if (allocated(z%v)) &
|
||||
!!$ & call z%v%mlt(alpha,x,y,beta,info)
|
||||
!!$
|
||||
!!$ end subroutine i_vect_mlt_a_2
|
||||
!!$
|
||||
!!$ subroutine i_vect_mlt_v_2(alpha,x,y,beta,z,info,conjgx,conjgy)
|
||||
!!$ use psi_serial_mod
|
||||
!!$ implicit none
|
||||
!!$ integer(psb_ipk_), intent(in) :: alpha,beta
|
||||
!!$ class(psb_i_multivect_type), intent(inout) :: x
|
||||
!!$ class(psb_i_multivect_type), intent(inout) :: y
|
||||
!!$ class(psb_i_multivect_type), intent(inout) :: z
|
||||
!!$ integer(psb_ipk_), intent(out) :: info
|
||||
!!$ character(len=1), intent(in), optional :: conjgx, conjgy
|
||||
!!$
|
||||
!!$ integer(psb_ipk_) :: i, n
|
||||
!!$
|
||||
!!$ info = 0
|
||||
!!$ if (allocated(x%v).and.allocated(y%v).and.&
|
||||
!!$ & allocated(z%v)) &
|
||||
!!$ & call z%v%mlt(alpha,x%v,y%v,beta,info,conjgx,conjgy)
|
||||
!!$
|
||||
!!$ end subroutine i_vect_mlt_v_2
|
||||
!!$
|
||||
!!$ subroutine i_vect_mlt_av(alpha,x,y,beta,z,info)
|
||||
!!$ use psi_serial_mod
|
||||
!!$ implicit none
|
||||
!!$ integer(psb_ipk_), intent(in) :: alpha,beta
|
||||
!!$ integer(psb_ipk_), intent(in) :: x(:)
|
||||
!!$ class(psb_i_multivect_type), intent(inout) :: y
|
||||
!!$ class(psb_i_multivect_type), intent(inout) :: z
|
||||
!!$ integer(psb_ipk_), intent(out) :: info
|
||||
!!$ integer(psb_ipk_) :: i, n
|
||||
!!$
|
||||
!!$ info = 0
|
||||
!!$ if (allocated(z%v).and.allocated(y%v)) &
|
||||
!!$ & call z%v%mlt(alpha,x,y%v,beta,info)
|
||||
!!$
|
||||
!!$ end subroutine i_vect_mlt_av
|
||||
!!$
|
||||
!!$ subroutine i_vect_mlt_va(alpha,x,y,beta,z,info)
|
||||
!!$ use psi_serial_mod
|
||||
!!$ implicit none
|
||||
!!$ integer(psb_ipk_), intent(in) :: alpha,beta
|
||||
!!$ integer(psb_ipk_), intent(in) :: y(:)
|
||||
!!$ class(psb_i_multivect_type), intent(inout) :: x
|
||||
!!$ class(psb_i_multivect_type), intent(inout) :: z
|
||||
!!$ integer(psb_ipk_), intent(out) :: info
|
||||
!!$ integer(psb_ipk_) :: i, n
|
||||
!!$
|
||||
!!$ info = 0
|
||||
!!$
|
||||
!!$ if (allocated(z%v).and.allocated(x%v)) &
|
||||
!!$ & call z%v%mlt(alpha,x%v,y,beta,info)
|
||||
!!$
|
||||
!!$ end subroutine i_vect_mlt_va
|
||||
!!$
|
||||
!!$ subroutine i_vect_scal(alpha, x)
|
||||
!!$ use psi_serial_mod
|
||||
!!$ implicit none
|
||||
!!$ class(psb_i_multivect_type), intent(inout) :: x
|
||||
!!$ integer(psb_ipk_), intent (in) :: alpha
|
||||
!!$
|
||||
!!$ if (allocated(x%v)) call x%v%scal(alpha)
|
||||
!!$
|
||||
!!$ end subroutine i_vect_scal
|
||||
!!$
|
||||
!!$
|
||||
!!$ function i_vect_nrm2(n,x) result(res)
|
||||
!!$ implicit none
|
||||
!!$ class(psb_i_multivect_type), intent(inout) :: x
|
||||
!!$ integer(psb_ipk_), intent(in) :: n
|
||||
!!$ integer(psb_ipk_) :: res
|
||||
!!$
|
||||
!!$ if (allocated(x%v)) then
|
||||
!!$ res = x%v%nrm2(n)
|
||||
!!$ else
|
||||
!!$ res = izero
|
||||
!!$ end if
|
||||
!!$
|
||||
!!$ end function i_vect_nrm2
|
||||
!!$
|
||||
!!$ function i_vect_amax(n,x) result(res)
|
||||
!!$ implicit none
|
||||
!!$ class(psb_i_multivect_type), intent(inout) :: x
|
||||
!!$ integer(psb_ipk_), intent(in) :: n
|
||||
!!$ integer(psb_ipk_) :: res
|
||||
!!$
|
||||
!!$ if (allocated(x%v)) then
|
||||
!!$ res = x%v%amax(n)
|
||||
!!$ else
|
||||
!!$ res = izero
|
||||
!!$ end if
|
||||
!!$
|
||||
!!$ end function i_vect_amax
|
||||
!!$
|
||||
!!$ function i_vect_asum(n,x) result(res)
|
||||
!!$ implicit none
|
||||
!!$ class(psb_i_multivect_type), intent(inout) :: x
|
||||
!!$ integer(psb_ipk_), intent(in) :: n
|
||||
!!$ integer(psb_ipk_) :: res
|
||||
!!$
|
||||
!!$ if (allocated(x%v)) then
|
||||
!!$ res = x%v%asum(n)
|
||||
!!$ else
|
||||
!!$ res = izero
|
||||
!!$ end if
|
||||
!!$
|
||||
!!$ end function i_vect_asum
|
||||
|
||||
subroutine i_vect_all(m,n, x, info, mold)
|
||||
|
||||
implicit none
|
||||
@@ -1306,4 +868,5 @@ contains
|
||||
end if
|
||||
end subroutine i_vect_cnv
|
||||
|
||||
|
||||
end module psb_i_multivect_mod
|
||||
|
||||
@@ -46,8 +46,8 @@ module psb_s_base_vect_mod
|
||||
|
||||
use psb_const_mod
|
||||
use psb_error_mod
|
||||
use psb_i_base_vect_mod
|
||||
use psb_realloc_mod
|
||||
use psb_i_base_vect_mod
|
||||
|
||||
!> \namespace psb_base_mod \class psb_s_base_vect_type
|
||||
!! The psb_s_base_vect_type
|
||||
@@ -123,6 +123,20 @@ module psb_s_base_vect_mod
|
||||
procedure, pass(x) :: set_scal => s_base_set_scal
|
||||
procedure, pass(x) :: set_vect => s_base_set_vect
|
||||
generic, public :: set => set_vect, set_scal
|
||||
!
|
||||
! Gather/scatter. These are needed for MPI interfacing.
|
||||
! May have to be reworked.
|
||||
!
|
||||
procedure, pass(x) :: gthab => s_base_gthab
|
||||
procedure, pass(x) :: gthzv => s_base_gthzv
|
||||
procedure, pass(x) :: gthzv_x => s_base_gthzv_x
|
||||
procedure, pass(x) :: gthzbuf => s_base_gthzbuf
|
||||
generic, public :: gth => gthab, gthzv, gthzv_x, gthzbuf
|
||||
procedure, pass(y) :: sctb => s_base_sctb
|
||||
procedure, pass(y) :: sctb_x => s_base_sctb_x
|
||||
procedure, pass(y) :: sctb_buf => s_base_sctb_buf
|
||||
generic, public :: sct => sctb, sctb_x, sctb_buf
|
||||
|
||||
|
||||
!
|
||||
! Dot product and AXPBY
|
||||
@@ -154,19 +168,7 @@ module psb_s_base_vect_mod
|
||||
procedure, pass(x) :: nrm2 => s_base_nrm2
|
||||
procedure, pass(x) :: amax => s_base_amax
|
||||
procedure, pass(x) :: asum => s_base_asum
|
||||
!
|
||||
! Gather/scatter. These are needed for MPI interfacing.
|
||||
! May have to be reworked.
|
||||
!
|
||||
procedure, pass(x) :: gthab => s_base_gthab
|
||||
procedure, pass(x) :: gthzv => s_base_gthzv
|
||||
procedure, pass(x) :: gthzv_x => s_base_gthzv_x
|
||||
procedure, pass(x) :: gthzbuf => s_base_gthzbuf
|
||||
generic, public :: gth => gthab, gthzv, gthzv_x, gthzbuf
|
||||
procedure, pass(y) :: sctb => s_base_sctb
|
||||
procedure, pass(y) :: sctb_x => s_base_sctb_x
|
||||
procedure, pass(y) :: sctb_buf => s_base_sctb_buf
|
||||
generic, public :: sct => sctb, sctb_x, sctb_buf
|
||||
|
||||
end type psb_s_base_vect_type
|
||||
|
||||
public :: psb_s_base_vect
|
||||
@@ -668,37 +670,6 @@ contains
|
||||
|
||||
end subroutine s_base_set_scal
|
||||
|
||||
!
|
||||
! Overwrite with absolute value
|
||||
!
|
||||
!
|
||||
!> Function base_set_scal
|
||||
!! \memberof psb_s_base_vect_type
|
||||
!! \brief Set all entries to their respective absolute values.
|
||||
!!
|
||||
subroutine s_base_absval1(x)
|
||||
class(psb_s_base_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) then
|
||||
if (.not.x%is_host()) call x%sync()
|
||||
x%v = abs(x%v)
|
||||
call x%set_host()
|
||||
end if
|
||||
|
||||
end subroutine s_base_absval1
|
||||
|
||||
subroutine s_base_absval2(x,y)
|
||||
class(psb_s_base_vect_type), intent(inout) :: x
|
||||
class(psb_s_base_vect_type), intent(inout) :: y
|
||||
|
||||
if (.not.x%is_host()) call x%sync()
|
||||
if (allocated(x%v)) then
|
||||
call y%bld(x%v)
|
||||
call y%absval()
|
||||
call y%set_host()
|
||||
end if
|
||||
|
||||
end subroutine s_base_absval2
|
||||
|
||||
!
|
||||
!> Function base_set_vect
|
||||
@@ -719,6 +690,7 @@ contains
|
||||
if (present(last)) last_ = min(last,last_)
|
||||
|
||||
if (allocated(x%v)) then
|
||||
if (x%is_dev()) call x%sync()
|
||||
x%v(first_:last_) = val(1:last_-first_+1)
|
||||
else
|
||||
x%v = val
|
||||
@@ -727,6 +699,38 @@ contains
|
||||
|
||||
end subroutine s_base_set_vect
|
||||
|
||||
|
||||
!
|
||||
! Overwrite with absolute value
|
||||
!
|
||||
!
|
||||
!> Function base_set_scal
|
||||
!! \memberof psb_s_base_vect_type
|
||||
!! \brief Set all entries to their respective absolute values.
|
||||
!!
|
||||
subroutine s_base_absval1(x)
|
||||
class(psb_s_base_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) then
|
||||
if (x%is_dev()) call x%sync()
|
||||
x%v = abs(x%v)
|
||||
call x%set_host()
|
||||
end if
|
||||
|
||||
end subroutine s_base_absval1
|
||||
|
||||
subroutine s_base_absval2(x,y)
|
||||
class(psb_s_base_vect_type), intent(inout) :: x
|
||||
class(psb_s_base_vect_type), intent(inout) :: y
|
||||
|
||||
if (.not.x%is_host()) call x%sync()
|
||||
if (allocated(x%v)) then
|
||||
call y%axpby(min(x%get_nrows(),y%get_nrows()),sone,x,szero,info)
|
||||
call y%absval()
|
||||
end if
|
||||
|
||||
end subroutine s_base_absval2
|
||||
|
||||
!
|
||||
! Dot products
|
||||
!
|
||||
@@ -2422,6 +2426,5 @@ contains
|
||||
!!$ call y%sct(n,idx%v(i:),x,beta)
|
||||
!!$
|
||||
!!$ end subroutine s_base_mv_sctb_x
|
||||
|
||||
end module psb_s_base_multivect_mod
|
||||
|
||||
|
||||
@@ -30,27 +30,33 @@
|
||||
!!$
|
||||
!!$
|
||||
module psb_s_comm_mod
|
||||
use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_spk_
|
||||
use psb_mat_mod, only : psb_sspmat_type
|
||||
|
||||
use psb_s_vect_mod, only : psb_s_vect_type, psb_s_base_vect_type
|
||||
|
||||
interface psb_ovrl
|
||||
subroutine psb_sovrlm(x,desc_a,info,jx,ik,work,update,mode)
|
||||
use psb_desc_mod
|
||||
subroutine psb_sovrlm(x,desc_a,info,jx,ik,work,update,mode)
|
||||
import
|
||||
implicit none
|
||||
real(psb_spk_), intent(inout), target :: x(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
real(psb_spk_), intent(inout), optional, target :: work(:)
|
||||
integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode
|
||||
end subroutine psb_sovrlm
|
||||
subroutine psb_sovrlv(x,desc_a,info,work,update,mode)
|
||||
use psb_desc_mod
|
||||
subroutine psb_sovrlv(x,desc_a,info,work,update,mode)
|
||||
import
|
||||
implicit none
|
||||
real(psb_spk_), intent(inout), target :: x(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
real(psb_spk_), intent(inout), optional, target :: work(:)
|
||||
integer(psb_ipk_), intent(in), optional :: update,mode
|
||||
end subroutine psb_sovrlv
|
||||
subroutine psb_sovrl_vect(x,desc_a,info,work,update,mode)
|
||||
use psb_desc_mod
|
||||
use psb_s_vect_mod
|
||||
subroutine psb_sovrl_vect(x,desc_a,info,work,update,mode)
|
||||
import
|
||||
implicit none
|
||||
type(psb_s_vect_type), intent(inout) :: x
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -60,33 +66,32 @@ module psb_s_comm_mod
|
||||
end interface psb_ovrl
|
||||
|
||||
interface psb_halo
|
||||
subroutine psb_shalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
|
||||
use psb_desc_mod
|
||||
subroutine psb_shalom(x,desc_a,info,jx,ik,work,tran,mode,data)
|
||||
import
|
||||
implicit none
|
||||
real(psb_spk_), intent(inout), target :: x(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
real(psb_spk_), intent(in), optional :: alpha
|
||||
real(psb_spk_), target, optional, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(in), optional :: mode,jx,ik,data
|
||||
character, intent(in), optional :: tran
|
||||
end subroutine psb_shalom
|
||||
subroutine psb_shalov(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
use psb_desc_mod
|
||||
subroutine psb_shalov(x,desc_a,info,work,tran,mode,data)
|
||||
import
|
||||
implicit none
|
||||
real(psb_spk_), intent(inout) :: x(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
real(psb_spk_), intent(in), optional :: alpha
|
||||
real(psb_spk_), target, optional, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(in), optional :: mode,data
|
||||
character, intent(in), optional :: tran
|
||||
end subroutine psb_shalov
|
||||
subroutine psb_shalo_vect(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
use psb_desc_mod
|
||||
use psb_s_vect_mod
|
||||
subroutine psb_shalo_vect(x,desc_a,info,work,tran,mode,data)
|
||||
import
|
||||
implicit none
|
||||
type(psb_s_vect_type), intent(inout) :: x
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
real(psb_spk_), intent(in), optional :: alpha
|
||||
real(psb_spk_), target, optional, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(in), optional :: mode,data
|
||||
character, intent(in), optional :: tran
|
||||
@@ -95,16 +100,18 @@ module psb_s_comm_mod
|
||||
|
||||
|
||||
interface psb_scatter
|
||||
subroutine psb_sscatterm(globx, locx, desc_a, info, root)
|
||||
use psb_desc_mod
|
||||
subroutine psb_sscatterm(globx, locx, desc_a, info, root)
|
||||
import
|
||||
implicit none
|
||||
real(psb_spk_), intent(out) :: locx(:,:)
|
||||
real(psb_spk_), intent(in) :: globx(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: root
|
||||
end subroutine psb_sscatterm
|
||||
subroutine psb_sscatterv(globx, locx, desc_a, info, root)
|
||||
use psb_desc_mod
|
||||
subroutine psb_sscatterv(globx, locx, desc_a, info, root)
|
||||
import
|
||||
implicit none
|
||||
real(psb_spk_), intent(out) :: locx(:)
|
||||
real(psb_spk_), intent(in) :: globx(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
@@ -114,9 +121,8 @@ module psb_s_comm_mod
|
||||
end interface psb_scatter
|
||||
|
||||
interface psb_gather
|
||||
subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
|
||||
use psb_desc_mod
|
||||
use psb_mat_mod
|
||||
subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
|
||||
import
|
||||
implicit none
|
||||
type(psb_sspmat_type), intent(inout) :: loca
|
||||
type(psb_sspmat_type), intent(out) :: globa
|
||||
@@ -126,24 +132,26 @@ module psb_s_comm_mod
|
||||
logical, intent(in), optional :: keepnum,keeploc
|
||||
end subroutine psb_ssp_allgather
|
||||
subroutine psb_sgatherm(globx, locx, desc_a, info, root)
|
||||
use psb_desc_mod
|
||||
import
|
||||
implicit none
|
||||
real(psb_spk_), intent(in) :: locx(:,:)
|
||||
real(psb_spk_), intent(out), allocatable :: globx(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: root
|
||||
end subroutine psb_sgatherm
|
||||
subroutine psb_sgatherv(globx, locx, desc_a, info, root)
|
||||
use psb_desc_mod
|
||||
subroutine psb_sgatherv(globx, locx, desc_a, info, root)
|
||||
import
|
||||
implicit none
|
||||
real(psb_spk_), intent(in) :: locx(:)
|
||||
real(psb_spk_), intent(out), allocatable :: globx(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: root
|
||||
end subroutine psb_sgatherv
|
||||
subroutine psb_sgather_vect(globx, locx, desc_a, info, root)
|
||||
use psb_desc_mod
|
||||
use psb_s_vect_mod
|
||||
subroutine psb_sgather_vect(globx, locx, desc_a, info, root)
|
||||
import
|
||||
implicit none
|
||||
type(psb_s_vect_type), intent(inout) :: locx
|
||||
real(psb_spk_), intent(out), allocatable :: globx(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
|
||||
@@ -36,9 +36,7 @@ Module psb_s_tools_mod
|
||||
|
||||
interface psb_geall
|
||||
subroutine psb_salloc(x, desc_a, info, n, lb)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_s_base_vect_type, psb_s_vect_type, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
real(psb_spk_), allocatable, intent(out) :: x(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
@@ -46,27 +44,24 @@ Module psb_s_tools_mod
|
||||
integer(psb_ipk_), optional, intent(in) :: n, lb
|
||||
end subroutine psb_salloc
|
||||
subroutine psb_sallocv(x, desc_a,info,n)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_s_base_vect_type, psb_s_vect_type, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
real(psb_spk_), allocatable, intent(out) :: x(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: n
|
||||
end subroutine psb_sallocv
|
||||
subroutine psb_salloc_vect(x, desc_a,info,n)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_s_base_vect_type, psb_s_vect_type, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_s_vect_type), intent(out) :: x
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_),intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: n
|
||||
end subroutine psb_salloc_vect
|
||||
subroutine psb_salloc_vect_r2(x, desc_a,info,n,lb)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_s_base_vect_type, psb_s_vect_type, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_s_vect_type), allocatable, intent(out) :: x(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_),intent(out) :: info
|
||||
@@ -77,25 +72,22 @@ Module psb_s_tools_mod
|
||||
|
||||
interface psb_geasb
|
||||
subroutine psb_sasb(x, desc_a, info)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_s_base_vect_type, psb_s_vect_type, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
real(psb_spk_), allocatable, intent(inout) :: x(:,:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_sasb
|
||||
subroutine psb_sasbv(x, desc_a, info)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_s_base_vect_type, psb_s_vect_type, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
real(psb_spk_), allocatable, intent(inout) :: x(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_sasbv
|
||||
subroutine psb_sasb_vect(x, desc_a, info,mold, scratch)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_s_base_vect_type, psb_s_vect_type, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_s_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -103,9 +95,8 @@ Module psb_s_tools_mod
|
||||
logical, intent(in), optional :: scratch
|
||||
end subroutine psb_sasb_vect
|
||||
subroutine psb_sasb_vect_r2(x, desc_a, info,mold, scratch)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_s_base_vect_type, psb_s_vect_type, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_s_vect_type), intent(inout) :: x(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -114,51 +105,31 @@ Module psb_s_tools_mod
|
||||
end subroutine psb_sasb_vect_r2
|
||||
end interface
|
||||
|
||||
interface psb_sphalo
|
||||
Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,&
|
||||
& rowscale,colscale,outfmt,data)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_s_base_vect_type, psb_s_vect_type, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat
|
||||
Type(psb_sspmat_type),Intent(in) :: a
|
||||
Type(psb_sspmat_type),Intent(inout) :: blk
|
||||
Type(psb_desc_type),Intent(in), target :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
logical, optional, intent(in) :: rowcnv,colcnv,rowscale,colscale
|
||||
character(len=5), optional :: outfmt
|
||||
integer(psb_ipk_), intent(in), optional :: data
|
||||
end Subroutine psb_ssphalo
|
||||
end interface
|
||||
|
||||
interface psb_gefree
|
||||
subroutine psb_sfree(x, desc_a, info)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_s_base_vect_type, psb_s_vect_type, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
real(psb_spk_),allocatable, intent(inout) :: x(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_sfree
|
||||
subroutine psb_sfreev(x, desc_a, info)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_s_base_vect_type, psb_s_vect_type, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
real(psb_spk_),allocatable, intent(inout) :: x(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_sfreev
|
||||
subroutine psb_sfree_vect(x, desc_a, info)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_s_base_vect_type, psb_s_vect_type, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_s_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_sfree_vect
|
||||
subroutine psb_sfree_vect_r2(x, desc_a, info)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_s_base_vect_type, psb_s_vect_type, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_s_vect_type), allocatable, intent(inout) :: x(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -168,9 +139,8 @@ Module psb_s_tools_mod
|
||||
|
||||
interface psb_geins
|
||||
subroutine psb_sinsi(m,irw,val, x, desc_a,info,dupl,local)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_s_base_vect_type, psb_s_vect_type, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
real(psb_spk_),intent(inout) :: x(:,:)
|
||||
@@ -181,9 +151,8 @@ Module psb_s_tools_mod
|
||||
logical, intent(in), optional :: local
|
||||
end subroutine psb_sinsi
|
||||
subroutine psb_sinsvi(m, irw,val, x,desc_a,info,dupl,local)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_s_base_vect_type, psb_s_vect_type, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
real(psb_spk_),intent(inout) :: x(:)
|
||||
@@ -194,9 +163,8 @@ Module psb_s_tools_mod
|
||||
logical, intent(in), optional :: local
|
||||
end subroutine psb_sinsvi
|
||||
subroutine psb_sins_vect(m,irw,val,x,desc_a,info,dupl,local)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_s_base_vect_type, psb_s_vect_type, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_s_vect_type), intent(inout) :: x
|
||||
@@ -207,9 +175,8 @@ Module psb_s_tools_mod
|
||||
logical, intent(in), optional :: local
|
||||
end subroutine psb_sins_vect
|
||||
subroutine psb_sins_vect_v(m,irw,val,x,desc_a,info,dupl,local)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_s_base_vect_type, psb_s_vect_type, psb_i_vect_type, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_s_vect_type), intent(inout) :: x
|
||||
@@ -220,9 +187,8 @@ Module psb_s_tools_mod
|
||||
logical, intent(in), optional :: local
|
||||
end subroutine psb_sins_vect_v
|
||||
subroutine psb_sins_vect_r2(m,irw,val,x,desc_a,info,dupl,local)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_s_base_vect_type, psb_s_vect_type, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_s_vect_type), intent(inout) :: x(:)
|
||||
@@ -236,9 +202,8 @@ Module psb_s_tools_mod
|
||||
|
||||
interface psb_cdbldext
|
||||
Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info,extype)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_s_base_vect_type, psb_s_vect_type, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: novr
|
||||
Type(psb_sspmat_type), Intent(in) :: a
|
||||
Type(psb_desc_type), Intent(inout), target :: desc_a
|
||||
@@ -248,11 +213,26 @@ Module psb_s_tools_mod
|
||||
end Subroutine psb_scdbldext
|
||||
end interface
|
||||
|
||||
interface psb_sphalo
|
||||
Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,&
|
||||
& rowscale,colscale,outfmt,data)
|
||||
import
|
||||
implicit none
|
||||
Type(psb_sspmat_type),Intent(in) :: a
|
||||
Type(psb_sspmat_type),Intent(inout) :: blk
|
||||
Type(psb_desc_type),Intent(in), target :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
logical, optional, intent(in) :: rowcnv,colcnv,rowscale,colscale
|
||||
character(len=5), optional :: outfmt
|
||||
integer(psb_ipk_), intent(in), optional :: data
|
||||
end Subroutine psb_ssphalo
|
||||
end interface
|
||||
|
||||
|
||||
interface psb_spall
|
||||
subroutine psb_sspalloc(a, desc_a, info, nnz)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_s_base_vect_type, psb_s_vect_type, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_sspmat_type), intent(inout) :: a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -262,9 +242,8 @@ Module psb_s_tools_mod
|
||||
|
||||
interface psb_spasb
|
||||
subroutine psb_sspasb(a,desc_a, info, afmt, upd, dupl,mold)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_s_base_vect_type, psb_s_vect_type, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_sspmat_type), intent (inout) :: a
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -276,9 +255,8 @@ Module psb_s_tools_mod
|
||||
|
||||
interface psb_spfree
|
||||
subroutine psb_sspfree(a, desc_a,info)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_s_base_vect_type, psb_s_vect_type, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_sspmat_type), intent(inout) ::a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -288,9 +266,8 @@ Module psb_s_tools_mod
|
||||
|
||||
interface psb_spins
|
||||
subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_s_base_vect_type, psb_s_vect_type, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
type(psb_sspmat_type), intent(inout) :: a
|
||||
integer(psb_ipk_), intent(in) :: nz,ia(:),ja(:)
|
||||
@@ -301,9 +278,8 @@ Module psb_s_tools_mod
|
||||
end subroutine psb_sspins
|
||||
subroutine psb_sspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local)
|
||||
use psb_i_vect_mod, only : psb_i_vect_type
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_s_base_vect_type, psb_s_vect_type,&
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
type(psb_sspmat_type), intent(inout) :: a
|
||||
integer(psb_ipk_), intent(in) :: nz
|
||||
@@ -314,9 +290,8 @@ Module psb_s_tools_mod
|
||||
logical, intent(in), optional :: local
|
||||
end subroutine psb_sspins_v
|
||||
subroutine psb_sspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_s_base_vect_type, psb_s_vect_type, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_ar
|
||||
type(psb_desc_type), intent(inout) :: desc_ac
|
||||
type(psb_sspmat_type), intent(inout) :: a
|
||||
@@ -329,9 +304,8 @@ Module psb_s_tools_mod
|
||||
|
||||
interface psb_sprn
|
||||
subroutine psb_ssprn(a, desc_a,info,clear)
|
||||
import :: psb_desc_type, psb_spk_, psb_ipk_, &
|
||||
& psb_s_base_vect_type, psb_s_vect_type, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_sspmat_type), intent(inout) :: a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
+391
-389
@@ -48,27 +48,6 @@ module psb_s_vect_mod
|
||||
procedure, pass(x) :: get_nrows => s_vect_get_nrows
|
||||
procedure, pass(x) :: sizeof => s_vect_sizeof
|
||||
procedure, pass(x) :: get_fmt => s_vect_get_fmt
|
||||
procedure, pass(x) :: dot_v => s_vect_dot_v
|
||||
procedure, pass(x) :: dot_a => s_vect_dot_a
|
||||
generic, public :: dot => dot_v, dot_a
|
||||
procedure, pass(y) :: axpby_v => s_vect_axpby_v
|
||||
procedure, pass(y) :: axpby_a => s_vect_axpby_a
|
||||
generic, public :: axpby => axpby_v, axpby_a
|
||||
procedure, pass(y) :: mlt_v => s_vect_mlt_v
|
||||
procedure, pass(y) :: mlt_a => s_vect_mlt_a
|
||||
procedure, pass(z) :: mlt_a_2 => s_vect_mlt_a_2
|
||||
procedure, pass(z) :: mlt_v_2 => s_vect_mlt_v_2
|
||||
procedure, pass(z) :: mlt_va => s_vect_mlt_va
|
||||
procedure, pass(z) :: mlt_av => s_vect_mlt_av
|
||||
generic, public :: mlt => mlt_v, mlt_a, mlt_a_2,&
|
||||
& mlt_v_2, mlt_av, mlt_va
|
||||
procedure, pass(x) :: scal => s_vect_scal
|
||||
procedure, pass(x) :: absval1 => s_vect_absval1
|
||||
procedure, pass(x) :: absval2 => s_vect_absval2
|
||||
generic, public :: absval => absval1, absval2
|
||||
procedure, pass(x) :: nrm2 => s_vect_nrm2
|
||||
procedure, pass(x) :: amax => s_vect_amax
|
||||
procedure, pass(x) :: asum => s_vect_asum
|
||||
procedure, pass(x) :: all => s_vect_all
|
||||
procedure, pass(x) :: reall => s_vect_reall
|
||||
procedure, pass(x) :: zero => s_vect_zero
|
||||
@@ -92,6 +71,27 @@ module psb_s_vect_mod
|
||||
procedure, pass(x) :: set_vect => s_vect_set_vect
|
||||
generic, public :: set => set_vect, set_scal
|
||||
procedure, pass(x) :: clone => s_vect_clone
|
||||
procedure, pass(x) :: dot_v => s_vect_dot_v
|
||||
procedure, pass(x) :: dot_a => s_vect_dot_a
|
||||
generic, public :: dot => dot_v, dot_a
|
||||
procedure, pass(y) :: axpby_v => s_vect_axpby_v
|
||||
procedure, pass(y) :: axpby_a => s_vect_axpby_a
|
||||
generic, public :: axpby => axpby_v, axpby_a
|
||||
procedure, pass(y) :: mlt_v => s_vect_mlt_v
|
||||
procedure, pass(y) :: mlt_a => s_vect_mlt_a
|
||||
procedure, pass(z) :: mlt_a_2 => s_vect_mlt_a_2
|
||||
procedure, pass(z) :: mlt_v_2 => s_vect_mlt_v_2
|
||||
procedure, pass(z) :: mlt_va => s_vect_mlt_va
|
||||
procedure, pass(z) :: mlt_av => s_vect_mlt_av
|
||||
generic, public :: mlt => mlt_v, mlt_a, mlt_a_2,&
|
||||
& mlt_v_2, mlt_av, mlt_va
|
||||
procedure, pass(x) :: scal => s_vect_scal
|
||||
procedure, pass(x) :: absval1 => s_vect_absval1
|
||||
procedure, pass(x) :: absval2 => s_vect_absval2
|
||||
generic, public :: absval => absval1, absval2
|
||||
procedure, pass(x) :: nrm2 => s_vect_nrm2
|
||||
procedure, pass(x) :: amax => s_vect_amax
|
||||
procedure, pass(x) :: asum => s_vect_asum
|
||||
end type psb_s_vect_type
|
||||
|
||||
public :: psb_s_vect
|
||||
@@ -296,6 +296,191 @@ contains
|
||||
res = 'NULL'
|
||||
if (allocated(x%v)) res = x%v%get_fmt()
|
||||
end function s_vect_get_fmt
|
||||
subroutine s_vect_all(n, x, info, mold)
|
||||
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: n
|
||||
class(psb_s_vect_type), intent(inout) :: x
|
||||
class(psb_s_base_vect_type), intent(in), optional :: mold
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%free(info)
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
allocate(psb_s_base_vect_type :: x%v,stat=info)
|
||||
endif
|
||||
if (info == 0) then
|
||||
call x%v%all(n,info)
|
||||
else
|
||||
info = psb_err_alloc_dealloc_
|
||||
end if
|
||||
|
||||
end subroutine s_vect_all
|
||||
|
||||
subroutine s_vect_reall(n, x, info)
|
||||
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: n
|
||||
class(psb_s_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = 0
|
||||
if (.not.allocated(x%v)) &
|
||||
& call x%all(n,info)
|
||||
if (info == 0) &
|
||||
& call x%asb(n,info)
|
||||
|
||||
end subroutine s_vect_reall
|
||||
|
||||
subroutine s_vect_zero(x)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_s_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) call x%v%zero()
|
||||
|
||||
end subroutine s_vect_zero
|
||||
|
||||
subroutine s_vect_asb(n, x, info)
|
||||
use psi_serial_mod
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: n
|
||||
class(psb_s_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%asb(n,info)
|
||||
|
||||
end subroutine s_vect_asb
|
||||
|
||||
subroutine s_vect_sync(x)
|
||||
implicit none
|
||||
class(psb_s_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%sync()
|
||||
|
||||
end subroutine s_vect_sync
|
||||
|
||||
subroutine s_vect_gthab(n,idx,alpha,x,beta,y)
|
||||
use psi_serial_mod
|
||||
integer(psb_ipk_) :: n, idx(:)
|
||||
real(psb_spk_) :: alpha, beta, y(:)
|
||||
class(psb_s_vect_type) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%gth(n,idx,alpha,beta,y)
|
||||
|
||||
end subroutine s_vect_gthab
|
||||
|
||||
subroutine s_vect_gthzv(n,idx,x,y)
|
||||
use psi_serial_mod
|
||||
integer(psb_ipk_) :: n, idx(:)
|
||||
real(psb_spk_) :: y(:)
|
||||
class(psb_s_vect_type) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%gth(n,idx,y)
|
||||
|
||||
end subroutine s_vect_gthzv
|
||||
|
||||
subroutine s_vect_sctb(n,idx,x,beta,y)
|
||||
use psi_serial_mod
|
||||
integer(psb_ipk_) :: n, idx(:)
|
||||
real(psb_spk_) :: beta, x(:)
|
||||
class(psb_s_vect_type) :: y
|
||||
|
||||
if (allocated(y%v)) &
|
||||
& call y%v%sct(n,idx,x,beta)
|
||||
|
||||
end subroutine s_vect_sctb
|
||||
|
||||
subroutine s_vect_free(x, info)
|
||||
use psi_serial_mod
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(psb_s_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = 0
|
||||
if (allocated(x%v)) then
|
||||
call x%v%free(info)
|
||||
if (info == 0) deallocate(x%v,stat=info)
|
||||
end if
|
||||
|
||||
end subroutine s_vect_free
|
||||
|
||||
subroutine s_vect_ins_a(n,irl,val,dupl,x,info)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_s_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: n, dupl
|
||||
integer(psb_ipk_), intent(in) :: irl(:)
|
||||
real(psb_spk_), intent(in) :: val(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
info = 0
|
||||
if (.not.allocated(x%v)) then
|
||||
info = psb_err_invalid_vect_state_
|
||||
return
|
||||
end if
|
||||
|
||||
call x%v%ins(n,irl,val,dupl,info)
|
||||
|
||||
end subroutine s_vect_ins_a
|
||||
|
||||
subroutine s_vect_ins_v(n,irl,val,dupl,x,info)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_s_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: n, dupl
|
||||
class(psb_i_vect_type), intent(inout) :: irl
|
||||
class(psb_s_vect_type), intent(inout) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
info = 0
|
||||
if (.not.(allocated(x%v).and.allocated(irl%v).and.allocated(val%v))) then
|
||||
info = psb_err_invalid_vect_state_
|
||||
return
|
||||
end if
|
||||
|
||||
call x%v%ins(n,irl%v,val%v,dupl,info)
|
||||
|
||||
end subroutine s_vect_ins_v
|
||||
|
||||
|
||||
subroutine s_vect_cnv(x,mold)
|
||||
class(psb_s_vect_type), intent(inout) :: x
|
||||
class(psb_s_base_vect_type), intent(in), optional :: mold
|
||||
class(psb_s_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
|
||||
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 s_vect_cnv
|
||||
|
||||
function s_vect_dot_v(n,x,y) result(res)
|
||||
implicit none
|
||||
@@ -522,191 +707,6 @@ contains
|
||||
|
||||
end function s_vect_asum
|
||||
|
||||
subroutine s_vect_all(n, x, info, mold)
|
||||
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: n
|
||||
class(psb_s_vect_type), intent(inout) :: x
|
||||
class(psb_s_base_vect_type), intent(in), optional :: mold
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%free(info)
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
allocate(psb_s_base_vect_type :: x%v,stat=info)
|
||||
endif
|
||||
if (info == 0) then
|
||||
call x%v%all(n,info)
|
||||
else
|
||||
info = psb_err_alloc_dealloc_
|
||||
end if
|
||||
|
||||
end subroutine s_vect_all
|
||||
|
||||
subroutine s_vect_reall(n, x, info)
|
||||
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: n
|
||||
class(psb_s_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = 0
|
||||
if (.not.allocated(x%v)) &
|
||||
& call x%all(n,info)
|
||||
if (info == 0) &
|
||||
& call x%asb(n,info)
|
||||
|
||||
end subroutine s_vect_reall
|
||||
|
||||
subroutine s_vect_zero(x)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_s_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) call x%v%zero()
|
||||
|
||||
end subroutine s_vect_zero
|
||||
|
||||
subroutine s_vect_asb(n, x, info)
|
||||
use psi_serial_mod
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: n
|
||||
class(psb_s_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%asb(n,info)
|
||||
|
||||
end subroutine s_vect_asb
|
||||
|
||||
subroutine s_vect_sync(x)
|
||||
implicit none
|
||||
class(psb_s_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%sync()
|
||||
|
||||
end subroutine s_vect_sync
|
||||
|
||||
subroutine s_vect_gthab(n,idx,alpha,x,beta,y)
|
||||
use psi_serial_mod
|
||||
integer(psb_ipk_) :: n, idx(:)
|
||||
real(psb_spk_) :: alpha, beta, y(:)
|
||||
class(psb_s_vect_type) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%gth(n,idx,alpha,beta,y)
|
||||
|
||||
end subroutine s_vect_gthab
|
||||
|
||||
subroutine s_vect_gthzv(n,idx,x,y)
|
||||
use psi_serial_mod
|
||||
integer(psb_ipk_) :: n, idx(:)
|
||||
real(psb_spk_) :: y(:)
|
||||
class(psb_s_vect_type) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%gth(n,idx,y)
|
||||
|
||||
end subroutine s_vect_gthzv
|
||||
|
||||
subroutine s_vect_sctb(n,idx,x,beta,y)
|
||||
use psi_serial_mod
|
||||
integer(psb_ipk_) :: n, idx(:)
|
||||
real(psb_spk_) :: beta, x(:)
|
||||
class(psb_s_vect_type) :: y
|
||||
|
||||
if (allocated(y%v)) &
|
||||
& call y%v%sct(n,idx,x,beta)
|
||||
|
||||
end subroutine s_vect_sctb
|
||||
|
||||
subroutine s_vect_free(x, info)
|
||||
use psi_serial_mod
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(psb_s_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = 0
|
||||
if (allocated(x%v)) then
|
||||
call x%v%free(info)
|
||||
if (info == 0) deallocate(x%v,stat=info)
|
||||
end if
|
||||
|
||||
end subroutine s_vect_free
|
||||
|
||||
subroutine s_vect_ins_a(n,irl,val,dupl,x,info)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_s_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: n, dupl
|
||||
integer(psb_ipk_), intent(in) :: irl(:)
|
||||
real(psb_spk_), intent(in) :: val(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
info = 0
|
||||
if (.not.allocated(x%v)) then
|
||||
info = psb_err_invalid_vect_state_
|
||||
return
|
||||
end if
|
||||
|
||||
call x%v%ins(n,irl,val,dupl,info)
|
||||
|
||||
end subroutine s_vect_ins_a
|
||||
|
||||
subroutine s_vect_ins_v(n,irl,val,dupl,x,info)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_s_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: n, dupl
|
||||
class(psb_i_vect_type), intent(inout) :: irl
|
||||
class(psb_s_vect_type), intent(inout) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
info = 0
|
||||
if (.not.(allocated(x%v).and.allocated(irl%v).and.allocated(val%v))) then
|
||||
info = psb_err_invalid_vect_state_
|
||||
return
|
||||
end if
|
||||
|
||||
call x%v%ins(n,irl%v,val%v,dupl,info)
|
||||
|
||||
end subroutine s_vect_ins_v
|
||||
|
||||
|
||||
subroutine s_vect_cnv(x,mold)
|
||||
class(psb_s_vect_type), intent(inout) :: x
|
||||
class(psb_s_base_vect_type), intent(in), optional :: mold
|
||||
class(psb_s_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
|
||||
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 s_vect_cnv
|
||||
|
||||
end module psb_s_vect_mod
|
||||
|
||||
@@ -726,6 +726,28 @@ module psb_s_multivect_mod
|
||||
procedure, pass(x) :: get_ncols => s_vect_get_ncols
|
||||
procedure, pass(x) :: sizeof => s_vect_sizeof
|
||||
procedure, pass(x) :: get_fmt => s_vect_get_fmt
|
||||
|
||||
procedure, pass(x) :: all => s_vect_all
|
||||
procedure, pass(x) :: reall => s_vect_reall
|
||||
procedure, pass(x) :: zero => s_vect_zero
|
||||
procedure, pass(x) :: asb => s_vect_asb
|
||||
procedure, pass(x) :: sync => s_vect_sync
|
||||
procedure, pass(x) :: free => s_vect_free
|
||||
procedure, pass(x) :: ins => s_vect_ins
|
||||
procedure, pass(x) :: bld_x => s_vect_bld_x
|
||||
procedure, pass(x) :: bld_n => s_vect_bld_n
|
||||
generic, public :: bld => bld_x, bld_n
|
||||
procedure, pass(x) :: get_vect => s_vect_get_vect
|
||||
procedure, pass(x) :: cnv => s_vect_cnv
|
||||
procedure, pass(x) :: set_scal => s_vect_set_scal
|
||||
procedure, pass(x) :: set_vect => s_vect_set_vect
|
||||
generic, public :: set => set_vect, set_scal
|
||||
procedure, pass(x) :: clone => s_vect_clone
|
||||
!!$ procedure, pass(x) :: gthab => s_vect_gthab
|
||||
!!$ procedure, pass(x) :: gthzv => s_vect_gthzv
|
||||
!!$ generic, public :: gth => gthab, gthzv
|
||||
!!$ procedure, pass(y) :: sctb => s_vect_sctb
|
||||
!!$ generic, public :: sct => sctb
|
||||
!!$ procedure, pass(x) :: dot_v => s_vect_dot_v
|
||||
!!$ procedure, pass(x) :: dot_a => s_vect_dot_a
|
||||
!!$ generic, public :: dot => dot_v, dot_a
|
||||
@@ -744,27 +766,6 @@ module psb_s_multivect_mod
|
||||
!!$ procedure, pass(x) :: nrm2 => s_vect_nrm2
|
||||
!!$ procedure, pass(x) :: amax => s_vect_amax
|
||||
!!$ procedure, pass(x) :: asum => s_vect_asum
|
||||
procedure, pass(x) :: all => s_vect_all
|
||||
procedure, pass(x) :: reall => s_vect_reall
|
||||
procedure, pass(x) :: zero => s_vect_zero
|
||||
procedure, pass(x) :: asb => s_vect_asb
|
||||
procedure, pass(x) :: sync => s_vect_sync
|
||||
!!$ procedure, pass(x) :: gthab => s_vect_gthab
|
||||
!!$ procedure, pass(x) :: gthzv => s_vect_gthzv
|
||||
!!$ generic, public :: gth => gthab, gthzv
|
||||
!!$ procedure, pass(y) :: sctb => s_vect_sctb
|
||||
!!$ generic, public :: sct => sctb
|
||||
procedure, pass(x) :: free => s_vect_free
|
||||
procedure, pass(x) :: ins => s_vect_ins
|
||||
procedure, pass(x) :: bld_x => s_vect_bld_x
|
||||
procedure, pass(x) :: bld_n => s_vect_bld_n
|
||||
generic, public :: bld => bld_x, bld_n
|
||||
procedure, pass(x) :: get_vect => s_vect_get_vect
|
||||
procedure, pass(x) :: cnv => s_vect_cnv
|
||||
procedure, pass(x) :: set_scal => s_vect_set_scal
|
||||
procedure, pass(x) :: set_vect => s_vect_set_vect
|
||||
generic, public :: set => set_vect, set_scal
|
||||
procedure, pass(x) :: clone => s_vect_clone
|
||||
end type psb_s_multivect_type
|
||||
|
||||
public :: psb_s_multivect, psb_s_multivect_type,&
|
||||
@@ -971,6 +972,169 @@ contains
|
||||
if (allocated(x%v)) res = x%v%get_fmt()
|
||||
end function s_vect_get_fmt
|
||||
|
||||
subroutine s_vect_all(m,n, x, info, mold)
|
||||
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m,n
|
||||
class(psb_s_multivect_type), intent(out) :: x
|
||||
class(psb_s_base_multivect_type), intent(in), optional :: mold
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
allocate(psb_s_base_multivect_type :: x%v,stat=info)
|
||||
endif
|
||||
if (info == 0) then
|
||||
call x%v%all(m,n,info)
|
||||
else
|
||||
info = psb_err_alloc_dealloc_
|
||||
end if
|
||||
|
||||
end subroutine s_vect_all
|
||||
|
||||
subroutine s_vect_reall(m,n, x, info)
|
||||
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m,n
|
||||
class(psb_s_multivect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = 0
|
||||
if (.not.allocated(x%v)) &
|
||||
& call x%all(m,n,info)
|
||||
if (info == 0) &
|
||||
& call x%asb(m,n,info)
|
||||
|
||||
end subroutine s_vect_reall
|
||||
|
||||
subroutine s_vect_zero(x)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_s_multivect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) call x%v%zero()
|
||||
|
||||
end subroutine s_vect_zero
|
||||
|
||||
subroutine s_vect_asb(m,n, x, info)
|
||||
use psi_serial_mod
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m,n
|
||||
class(psb_s_multivect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%asb(m,n,info)
|
||||
|
||||
end subroutine s_vect_asb
|
||||
|
||||
subroutine s_vect_sync(x)
|
||||
implicit none
|
||||
class(psb_s_multivect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%sync()
|
||||
|
||||
end subroutine s_vect_sync
|
||||
|
||||
!!$ subroutine s_vect_gthab(n,idx,alpha,x,beta,y)
|
||||
!!$ use psi_serial_mod
|
||||
!!$ integer(psb_ipk_) :: n, idx(:)
|
||||
!!$ real(psb_spk_) :: alpha, beta, y(:)
|
||||
!!$ class(psb_s_multivect_type) :: x
|
||||
!!$
|
||||
!!$ if (allocated(x%v)) &
|
||||
!!$ & call x%v%gth(n,idx,alpha,beta,y)
|
||||
!!$
|
||||
!!$ end subroutine s_vect_gthab
|
||||
!!$
|
||||
!!$ subroutine s_vect_gthzv(n,idx,x,y)
|
||||
!!$ use psi_serial_mod
|
||||
!!$ integer(psb_ipk_) :: n, idx(:)
|
||||
!!$ real(psb_spk_) :: y(:)
|
||||
!!$ class(psb_s_multivect_type) :: x
|
||||
!!$
|
||||
!!$ if (allocated(x%v)) &
|
||||
!!$ & call x%v%gth(n,idx,y)
|
||||
!!$
|
||||
!!$ end subroutine s_vect_gthzv
|
||||
!!$
|
||||
!!$ subroutine s_vect_sctb(n,idx,x,beta,y)
|
||||
!!$ use psi_serial_mod
|
||||
!!$ integer(psb_ipk_) :: n, idx(:)
|
||||
!!$ real(psb_spk_) :: beta, x(:)
|
||||
!!$ class(psb_s_multivect_type) :: y
|
||||
!!$
|
||||
!!$ if (allocated(y%v)) &
|
||||
!!$ & call y%v%sct(n,idx,x,beta)
|
||||
!!$
|
||||
!!$ end subroutine s_vect_sctb
|
||||
|
||||
subroutine s_vect_free(x, info)
|
||||
use psi_serial_mod
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(psb_s_multivect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = 0
|
||||
if (allocated(x%v)) then
|
||||
call x%v%free(info)
|
||||
if (info == 0) deallocate(x%v,stat=info)
|
||||
end if
|
||||
|
||||
end subroutine s_vect_free
|
||||
|
||||
subroutine s_vect_ins(n,irl,val,dupl,x,info)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_s_multivect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: n, dupl
|
||||
integer(psb_ipk_), intent(in) :: irl(:)
|
||||
real(psb_spk_), intent(in) :: val(:,:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
info = 0
|
||||
if (.not.allocated(x%v)) then
|
||||
info = psb_err_invalid_vect_state_
|
||||
return
|
||||
end if
|
||||
|
||||
call x%v%ins(n,irl,val,dupl,info)
|
||||
|
||||
end subroutine s_vect_ins
|
||||
|
||||
|
||||
subroutine s_vect_cnv(x,mold)
|
||||
class(psb_s_multivect_type), intent(inout) :: x
|
||||
class(psb_s_base_multivect_type), intent(in), optional :: mold
|
||||
class(psb_s_base_multivect_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
|
||||
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 s_vect_cnv
|
||||
|
||||
|
||||
!!$ function s_vect_dot_v(n,x,y) result(res)
|
||||
!!$ implicit none
|
||||
!!$ class(psb_s_multivect_type), intent(inout) :: x, y
|
||||
@@ -1178,167 +1342,5 @@ contains
|
||||
!!$ end if
|
||||
!!$
|
||||
!!$ end function s_vect_asum
|
||||
|
||||
subroutine s_vect_all(m,n, x, info, mold)
|
||||
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m,n
|
||||
class(psb_s_multivect_type), intent(out) :: x
|
||||
class(psb_s_base_multivect_type), intent(in), optional :: mold
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
allocate(psb_s_base_multivect_type :: x%v,stat=info)
|
||||
endif
|
||||
if (info == 0) then
|
||||
call x%v%all(m,n,info)
|
||||
else
|
||||
info = psb_err_alloc_dealloc_
|
||||
end if
|
||||
|
||||
end subroutine s_vect_all
|
||||
|
||||
subroutine s_vect_reall(m,n, x, info)
|
||||
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m,n
|
||||
class(psb_s_multivect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = 0
|
||||
if (.not.allocated(x%v)) &
|
||||
& call x%all(m,n,info)
|
||||
if (info == 0) &
|
||||
& call x%asb(m,n,info)
|
||||
|
||||
end subroutine s_vect_reall
|
||||
|
||||
subroutine s_vect_zero(x)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_s_multivect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) call x%v%zero()
|
||||
|
||||
end subroutine s_vect_zero
|
||||
|
||||
subroutine s_vect_asb(m,n, x, info)
|
||||
use psi_serial_mod
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m,n
|
||||
class(psb_s_multivect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%asb(m,n,info)
|
||||
|
||||
end subroutine s_vect_asb
|
||||
|
||||
subroutine s_vect_sync(x)
|
||||
implicit none
|
||||
class(psb_s_multivect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%sync()
|
||||
|
||||
end subroutine s_vect_sync
|
||||
|
||||
!!$ subroutine s_vect_gthab(n,idx,alpha,x,beta,y)
|
||||
!!$ use psi_serial_mod
|
||||
!!$ integer(psb_ipk_) :: n, idx(:)
|
||||
!!$ real(psb_spk_) :: alpha, beta, y(:)
|
||||
!!$ class(psb_s_multivect_type) :: x
|
||||
!!$
|
||||
!!$ if (allocated(x%v)) &
|
||||
!!$ & call x%v%gth(n,idx,alpha,beta,y)
|
||||
!!$
|
||||
!!$ end subroutine s_vect_gthab
|
||||
!!$
|
||||
!!$ subroutine s_vect_gthzv(n,idx,x,y)
|
||||
!!$ use psi_serial_mod
|
||||
!!$ integer(psb_ipk_) :: n, idx(:)
|
||||
!!$ real(psb_spk_) :: y(:)
|
||||
!!$ class(psb_s_multivect_type) :: x
|
||||
!!$
|
||||
!!$ if (allocated(x%v)) &
|
||||
!!$ & call x%v%gth(n,idx,y)
|
||||
!!$
|
||||
!!$ end subroutine s_vect_gthzv
|
||||
!!$
|
||||
!!$ subroutine s_vect_sctb(n,idx,x,beta,y)
|
||||
!!$ use psi_serial_mod
|
||||
!!$ integer(psb_ipk_) :: n, idx(:)
|
||||
!!$ real(psb_spk_) :: beta, x(:)
|
||||
!!$ class(psb_s_multivect_type) :: y
|
||||
!!$
|
||||
!!$ if (allocated(y%v)) &
|
||||
!!$ & call y%v%sct(n,idx,x,beta)
|
||||
!!$
|
||||
!!$ end subroutine s_vect_sctb
|
||||
|
||||
subroutine s_vect_free(x, info)
|
||||
use psi_serial_mod
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(psb_s_multivect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = 0
|
||||
if (allocated(x%v)) then
|
||||
call x%v%free(info)
|
||||
if (info == 0) deallocate(x%v,stat=info)
|
||||
end if
|
||||
|
||||
end subroutine s_vect_free
|
||||
|
||||
subroutine s_vect_ins(n,irl,val,dupl,x,info)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_s_multivect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: n, dupl
|
||||
integer(psb_ipk_), intent(in) :: irl(:)
|
||||
real(psb_spk_), intent(in) :: val(:,:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
info = 0
|
||||
if (.not.allocated(x%v)) then
|
||||
info = psb_err_invalid_vect_state_
|
||||
return
|
||||
end if
|
||||
|
||||
call x%v%ins(n,irl,val,dupl,info)
|
||||
|
||||
end subroutine s_vect_ins
|
||||
|
||||
|
||||
subroutine s_vect_cnv(x,mold)
|
||||
class(psb_s_multivect_type), intent(inout) :: x
|
||||
class(psb_s_base_multivect_type), intent(in), optional :: mold
|
||||
class(psb_s_base_multivect_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
|
||||
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 s_vect_cnv
|
||||
|
||||
end module psb_s_multivect_mod
|
||||
|
||||
@@ -46,8 +46,8 @@ module psb_z_base_vect_mod
|
||||
|
||||
use psb_const_mod
|
||||
use psb_error_mod
|
||||
use psb_i_base_vect_mod
|
||||
use psb_realloc_mod
|
||||
use psb_i_base_vect_mod
|
||||
|
||||
!> \namespace psb_base_mod \class psb_z_base_vect_type
|
||||
!! The psb_z_base_vect_type
|
||||
@@ -123,6 +123,20 @@ module psb_z_base_vect_mod
|
||||
procedure, pass(x) :: set_scal => z_base_set_scal
|
||||
procedure, pass(x) :: set_vect => z_base_set_vect
|
||||
generic, public :: set => set_vect, set_scal
|
||||
!
|
||||
! Gather/scatter. These are needed for MPI interfacing.
|
||||
! May have to be reworked.
|
||||
!
|
||||
procedure, pass(x) :: gthab => z_base_gthab
|
||||
procedure, pass(x) :: gthzv => z_base_gthzv
|
||||
procedure, pass(x) :: gthzv_x => z_base_gthzv_x
|
||||
procedure, pass(x) :: gthzbuf => z_base_gthzbuf
|
||||
generic, public :: gth => gthab, gthzv, gthzv_x, gthzbuf
|
||||
procedure, pass(y) :: sctb => z_base_sctb
|
||||
procedure, pass(y) :: sctb_x => z_base_sctb_x
|
||||
procedure, pass(y) :: sctb_buf => z_base_sctb_buf
|
||||
generic, public :: sct => sctb, sctb_x, sctb_buf
|
||||
|
||||
|
||||
!
|
||||
! Dot product and AXPBY
|
||||
@@ -154,19 +168,7 @@ module psb_z_base_vect_mod
|
||||
procedure, pass(x) :: nrm2 => z_base_nrm2
|
||||
procedure, pass(x) :: amax => z_base_amax
|
||||
procedure, pass(x) :: asum => z_base_asum
|
||||
!
|
||||
! Gather/scatter. These are needed for MPI interfacing.
|
||||
! May have to be reworked.
|
||||
!
|
||||
procedure, pass(x) :: gthab => z_base_gthab
|
||||
procedure, pass(x) :: gthzv => z_base_gthzv
|
||||
procedure, pass(x) :: gthzv_x => z_base_gthzv_x
|
||||
procedure, pass(x) :: gthzbuf => z_base_gthzbuf
|
||||
generic, public :: gth => gthab, gthzv, gthzv_x, gthzbuf
|
||||
procedure, pass(y) :: sctb => z_base_sctb
|
||||
procedure, pass(y) :: sctb_x => z_base_sctb_x
|
||||
procedure, pass(y) :: sctb_buf => z_base_sctb_buf
|
||||
generic, public :: sct => sctb, sctb_x, sctb_buf
|
||||
|
||||
end type psb_z_base_vect_type
|
||||
|
||||
public :: psb_z_base_vect
|
||||
@@ -668,37 +670,6 @@ contains
|
||||
|
||||
end subroutine z_base_set_scal
|
||||
|
||||
!
|
||||
! Overwrite with absolute value
|
||||
!
|
||||
!
|
||||
!> Function base_set_scal
|
||||
!! \memberof psb_z_base_vect_type
|
||||
!! \brief Set all entries to their respective absolute values.
|
||||
!!
|
||||
subroutine z_base_absval1(x)
|
||||
class(psb_z_base_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) then
|
||||
if (.not.x%is_host()) call x%sync()
|
||||
x%v = abs(x%v)
|
||||
call x%set_host()
|
||||
end if
|
||||
|
||||
end subroutine z_base_absval1
|
||||
|
||||
subroutine z_base_absval2(x,y)
|
||||
class(psb_z_base_vect_type), intent(inout) :: x
|
||||
class(psb_z_base_vect_type), intent(inout) :: y
|
||||
|
||||
if (.not.x%is_host()) call x%sync()
|
||||
if (allocated(x%v)) then
|
||||
call y%bld(x%v)
|
||||
call y%absval()
|
||||
call y%set_host()
|
||||
end if
|
||||
|
||||
end subroutine z_base_absval2
|
||||
|
||||
!
|
||||
!> Function base_set_vect
|
||||
@@ -719,6 +690,7 @@ contains
|
||||
if (present(last)) last_ = min(last,last_)
|
||||
|
||||
if (allocated(x%v)) then
|
||||
if (x%is_dev()) call x%sync()
|
||||
x%v(first_:last_) = val(1:last_-first_+1)
|
||||
else
|
||||
x%v = val
|
||||
@@ -727,6 +699,38 @@ contains
|
||||
|
||||
end subroutine z_base_set_vect
|
||||
|
||||
|
||||
!
|
||||
! Overwrite with absolute value
|
||||
!
|
||||
!
|
||||
!> Function base_set_scal
|
||||
!! \memberof psb_z_base_vect_type
|
||||
!! \brief Set all entries to their respective absolute values.
|
||||
!!
|
||||
subroutine z_base_absval1(x)
|
||||
class(psb_z_base_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) then
|
||||
if (x%is_dev()) call x%sync()
|
||||
x%v = abs(x%v)
|
||||
call x%set_host()
|
||||
end if
|
||||
|
||||
end subroutine z_base_absval1
|
||||
|
||||
subroutine z_base_absval2(x,y)
|
||||
class(psb_z_base_vect_type), intent(inout) :: x
|
||||
class(psb_z_base_vect_type), intent(inout) :: y
|
||||
|
||||
if (.not.x%is_host()) call x%sync()
|
||||
if (allocated(x%v)) then
|
||||
call y%axpby(min(x%get_nrows(),y%get_nrows()),zone,x,zzero,info)
|
||||
call y%absval()
|
||||
end if
|
||||
|
||||
end subroutine z_base_absval2
|
||||
|
||||
!
|
||||
! Dot products
|
||||
!
|
||||
@@ -2422,6 +2426,5 @@ contains
|
||||
!!$ call y%sct(n,idx%v(i:),x,beta)
|
||||
!!$
|
||||
!!$ end subroutine z_base_mv_sctb_x
|
||||
|
||||
end module psb_z_base_multivect_mod
|
||||
|
||||
|
||||
@@ -30,27 +30,33 @@
|
||||
!!$
|
||||
!!$
|
||||
module psb_z_comm_mod
|
||||
use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_dpk_
|
||||
use psb_mat_mod, only : psb_zspmat_type
|
||||
|
||||
use psb_z_vect_mod, only : psb_z_vect_type, psb_z_base_vect_type
|
||||
|
||||
interface psb_ovrl
|
||||
subroutine psb_zovrlm(x,desc_a,info,jx,ik,work,update,mode)
|
||||
use psb_desc_mod
|
||||
subroutine psb_zovrlm(x,desc_a,info,jx,ik,work,update,mode)
|
||||
import
|
||||
implicit none
|
||||
complex(psb_dpk_), intent(inout), target :: x(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
complex(psb_dpk_), intent(inout), optional, target :: work(:)
|
||||
integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode
|
||||
end subroutine psb_zovrlm
|
||||
subroutine psb_zovrlv(x,desc_a,info,work,update,mode)
|
||||
use psb_desc_mod
|
||||
subroutine psb_zovrlv(x,desc_a,info,work,update,mode)
|
||||
import
|
||||
implicit none
|
||||
complex(psb_dpk_), intent(inout), target :: x(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
complex(psb_dpk_), intent(inout), optional, target :: work(:)
|
||||
integer(psb_ipk_), intent(in), optional :: update,mode
|
||||
end subroutine psb_zovrlv
|
||||
subroutine psb_zovrl_vect(x,desc_a,info,work,update,mode)
|
||||
use psb_desc_mod
|
||||
use psb_z_vect_mod
|
||||
subroutine psb_zovrl_vect(x,desc_a,info,work,update,mode)
|
||||
import
|
||||
implicit none
|
||||
type(psb_z_vect_type), intent(inout) :: x
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -60,33 +66,32 @@ module psb_z_comm_mod
|
||||
end interface psb_ovrl
|
||||
|
||||
interface psb_halo
|
||||
subroutine psb_zhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
|
||||
use psb_desc_mod
|
||||
subroutine psb_zhalom(x,desc_a,info,jx,ik,work,tran,mode,data)
|
||||
import
|
||||
implicit none
|
||||
complex(psb_dpk_), intent(inout), target :: x(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
complex(psb_dpk_), intent(in), optional :: alpha
|
||||
complex(psb_dpk_), target, optional, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(in), optional :: mode,jx,ik,data
|
||||
character, intent(in), optional :: tran
|
||||
end subroutine psb_zhalom
|
||||
subroutine psb_zhalov(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
use psb_desc_mod
|
||||
subroutine psb_zhalov(x,desc_a,info,work,tran,mode,data)
|
||||
import
|
||||
implicit none
|
||||
complex(psb_dpk_), intent(inout) :: x(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
complex(psb_dpk_), intent(in), optional :: alpha
|
||||
complex(psb_dpk_), target, optional, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(in), optional :: mode,data
|
||||
character, intent(in), optional :: tran
|
||||
end subroutine psb_zhalov
|
||||
subroutine psb_zhalo_vect(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
use psb_desc_mod
|
||||
use psb_z_vect_mod
|
||||
subroutine psb_zhalo_vect(x,desc_a,info,work,tran,mode,data)
|
||||
import
|
||||
implicit none
|
||||
type(psb_z_vect_type), intent(inout) :: x
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
complex(psb_dpk_), intent(in), optional :: alpha
|
||||
complex(psb_dpk_), target, optional, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(in), optional :: mode,data
|
||||
character, intent(in), optional :: tran
|
||||
@@ -95,16 +100,18 @@ module psb_z_comm_mod
|
||||
|
||||
|
||||
interface psb_scatter
|
||||
subroutine psb_zscatterm(globx, locx, desc_a, info, root)
|
||||
use psb_desc_mod
|
||||
subroutine psb_zscatterm(globx, locx, desc_a, info, root)
|
||||
import
|
||||
implicit none
|
||||
complex(psb_dpk_), intent(out) :: locx(:,:)
|
||||
complex(psb_dpk_), intent(in) :: globx(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: root
|
||||
end subroutine psb_zscatterm
|
||||
subroutine psb_zscatterv(globx, locx, desc_a, info, root)
|
||||
use psb_desc_mod
|
||||
subroutine psb_zscatterv(globx, locx, desc_a, info, root)
|
||||
import
|
||||
implicit none
|
||||
complex(psb_dpk_), intent(out) :: locx(:)
|
||||
complex(psb_dpk_), intent(in) :: globx(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
@@ -114,9 +121,8 @@ module psb_z_comm_mod
|
||||
end interface psb_scatter
|
||||
|
||||
interface psb_gather
|
||||
subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
|
||||
use psb_desc_mod
|
||||
use psb_mat_mod
|
||||
subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
|
||||
import
|
||||
implicit none
|
||||
type(psb_zspmat_type), intent(inout) :: loca
|
||||
type(psb_zspmat_type), intent(out) :: globa
|
||||
@@ -126,24 +132,26 @@ module psb_z_comm_mod
|
||||
logical, intent(in), optional :: keepnum,keeploc
|
||||
end subroutine psb_zsp_allgather
|
||||
subroutine psb_zgatherm(globx, locx, desc_a, info, root)
|
||||
use psb_desc_mod
|
||||
import
|
||||
implicit none
|
||||
complex(psb_dpk_), intent(in) :: locx(:,:)
|
||||
complex(psb_dpk_), intent(out), allocatable :: globx(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: root
|
||||
end subroutine psb_zgatherm
|
||||
subroutine psb_zgatherv(globx, locx, desc_a, info, root)
|
||||
use psb_desc_mod
|
||||
subroutine psb_zgatherv(globx, locx, desc_a, info, root)
|
||||
import
|
||||
implicit none
|
||||
complex(psb_dpk_), intent(in) :: locx(:)
|
||||
complex(psb_dpk_), intent(out), allocatable :: globx(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: root
|
||||
end subroutine psb_zgatherv
|
||||
subroutine psb_zgather_vect(globx, locx, desc_a, info, root)
|
||||
use psb_desc_mod
|
||||
use psb_z_vect_mod
|
||||
subroutine psb_zgather_vect(globx, locx, desc_a, info, root)
|
||||
import
|
||||
implicit none
|
||||
type(psb_z_vect_type), intent(inout) :: locx
|
||||
complex(psb_dpk_), intent(out), allocatable :: globx(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
|
||||
@@ -36,9 +36,7 @@ Module psb_z_tools_mod
|
||||
|
||||
interface psb_geall
|
||||
subroutine psb_zalloc(x, desc_a, info, n, lb)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_z_base_vect_type, psb_z_vect_type, &
|
||||
& psb_zspmat_type, psb_z_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
complex(psb_dpk_), allocatable, intent(out) :: x(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
@@ -46,27 +44,24 @@ Module psb_z_tools_mod
|
||||
integer(psb_ipk_), optional, intent(in) :: n, lb
|
||||
end subroutine psb_zalloc
|
||||
subroutine psb_zallocv(x, desc_a,info,n)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_z_base_vect_type, psb_z_vect_type, &
|
||||
& psb_zspmat_type, psb_z_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
complex(psb_dpk_), allocatable, intent(out) :: x(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: n
|
||||
end subroutine psb_zallocv
|
||||
subroutine psb_zalloc_vect(x, desc_a,info,n)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_z_base_vect_type, psb_z_vect_type, &
|
||||
& psb_zspmat_type, psb_z_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_z_vect_type), intent(out) :: x
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_),intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: n
|
||||
end subroutine psb_zalloc_vect
|
||||
subroutine psb_zalloc_vect_r2(x, desc_a,info,n,lb)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_z_base_vect_type, psb_z_vect_type, &
|
||||
& psb_zspmat_type, psb_z_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_z_vect_type), allocatable, intent(out) :: x(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_),intent(out) :: info
|
||||
@@ -77,25 +72,22 @@ Module psb_z_tools_mod
|
||||
|
||||
interface psb_geasb
|
||||
subroutine psb_zasb(x, desc_a, info)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_z_base_vect_type, psb_z_vect_type, &
|
||||
& psb_zspmat_type, psb_z_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
complex(psb_dpk_), allocatable, intent(inout) :: x(:,:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_zasb
|
||||
subroutine psb_zasbv(x, desc_a, info)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_z_base_vect_type, psb_z_vect_type, &
|
||||
& psb_zspmat_type, psb_z_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
complex(psb_dpk_), allocatable, intent(inout) :: x(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_zasbv
|
||||
subroutine psb_zasb_vect(x, desc_a, info,mold, scratch)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_z_base_vect_type, psb_z_vect_type, &
|
||||
& psb_zspmat_type, psb_z_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_z_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -103,9 +95,8 @@ Module psb_z_tools_mod
|
||||
logical, intent(in), optional :: scratch
|
||||
end subroutine psb_zasb_vect
|
||||
subroutine psb_zasb_vect_r2(x, desc_a, info,mold, scratch)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_z_base_vect_type, psb_z_vect_type, &
|
||||
& psb_zspmat_type, psb_z_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_z_vect_type), intent(inout) :: x(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -114,51 +105,31 @@ Module psb_z_tools_mod
|
||||
end subroutine psb_zasb_vect_r2
|
||||
end interface
|
||||
|
||||
interface psb_sphalo
|
||||
Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
|
||||
& rowscale,colscale,outfmt,data)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_z_base_vect_type, psb_z_vect_type, &
|
||||
& psb_zspmat_type, psb_z_base_sparse_mat
|
||||
Type(psb_zspmat_type),Intent(in) :: a
|
||||
Type(psb_zspmat_type),Intent(inout) :: blk
|
||||
Type(psb_desc_type),Intent(in), target :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
logical, optional, intent(in) :: rowcnv,colcnv,rowscale,colscale
|
||||
character(len=5), optional :: outfmt
|
||||
integer(psb_ipk_), intent(in), optional :: data
|
||||
end Subroutine psb_zsphalo
|
||||
end interface
|
||||
|
||||
interface psb_gefree
|
||||
subroutine psb_zfree(x, desc_a, info)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_z_base_vect_type, psb_z_vect_type, &
|
||||
& psb_zspmat_type, psb_z_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
complex(psb_dpk_),allocatable, intent(inout) :: x(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_zfree
|
||||
subroutine psb_zfreev(x, desc_a, info)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_z_base_vect_type, psb_z_vect_type, &
|
||||
& psb_zspmat_type, psb_z_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
complex(psb_dpk_),allocatable, intent(inout) :: x(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_zfreev
|
||||
subroutine psb_zfree_vect(x, desc_a, info)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_z_base_vect_type, psb_z_vect_type, &
|
||||
& psb_zspmat_type, psb_z_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_z_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_zfree_vect
|
||||
subroutine psb_zfree_vect_r2(x, desc_a, info)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_z_base_vect_type, psb_z_vect_type, &
|
||||
& psb_zspmat_type, psb_z_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_z_vect_type), allocatable, intent(inout) :: x(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -168,9 +139,8 @@ Module psb_z_tools_mod
|
||||
|
||||
interface psb_geins
|
||||
subroutine psb_zinsi(m,irw,val, x, desc_a,info,dupl,local)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_z_base_vect_type, psb_z_vect_type, &
|
||||
& psb_zspmat_type, psb_z_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
complex(psb_dpk_),intent(inout) :: x(:,:)
|
||||
@@ -181,9 +151,8 @@ Module psb_z_tools_mod
|
||||
logical, intent(in), optional :: local
|
||||
end subroutine psb_zinsi
|
||||
subroutine psb_zinsvi(m, irw,val, x,desc_a,info,dupl,local)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_z_base_vect_type, psb_z_vect_type, &
|
||||
& psb_zspmat_type, psb_z_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
complex(psb_dpk_),intent(inout) :: x(:)
|
||||
@@ -194,9 +163,8 @@ Module psb_z_tools_mod
|
||||
logical, intent(in), optional :: local
|
||||
end subroutine psb_zinsvi
|
||||
subroutine psb_zins_vect(m,irw,val,x,desc_a,info,dupl,local)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_z_base_vect_type, psb_z_vect_type, &
|
||||
& psb_zspmat_type, psb_z_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_z_vect_type), intent(inout) :: x
|
||||
@@ -207,9 +175,8 @@ Module psb_z_tools_mod
|
||||
logical, intent(in), optional :: local
|
||||
end subroutine psb_zins_vect
|
||||
subroutine psb_zins_vect_v(m,irw,val,x,desc_a,info,dupl,local)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_z_base_vect_type, psb_z_vect_type, psb_i_vect_type, &
|
||||
& psb_zspmat_type, psb_z_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_z_vect_type), intent(inout) :: x
|
||||
@@ -220,9 +187,8 @@ Module psb_z_tools_mod
|
||||
logical, intent(in), optional :: local
|
||||
end subroutine psb_zins_vect_v
|
||||
subroutine psb_zins_vect_r2(m,irw,val,x,desc_a,info,dupl,local)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_z_base_vect_type, psb_z_vect_type, &
|
||||
& psb_zspmat_type, psb_z_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_z_vect_type), intent(inout) :: x(:)
|
||||
@@ -236,9 +202,8 @@ Module psb_z_tools_mod
|
||||
|
||||
interface psb_cdbldext
|
||||
Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info,extype)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_z_base_vect_type, psb_z_vect_type, &
|
||||
& psb_zspmat_type, psb_z_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: novr
|
||||
Type(psb_zspmat_type), Intent(in) :: a
|
||||
Type(psb_desc_type), Intent(inout), target :: desc_a
|
||||
@@ -248,11 +213,26 @@ Module psb_z_tools_mod
|
||||
end Subroutine psb_zcdbldext
|
||||
end interface
|
||||
|
||||
interface psb_sphalo
|
||||
Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
|
||||
& rowscale,colscale,outfmt,data)
|
||||
import
|
||||
implicit none
|
||||
Type(psb_zspmat_type),Intent(in) :: a
|
||||
Type(psb_zspmat_type),Intent(inout) :: blk
|
||||
Type(psb_desc_type),Intent(in), target :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
logical, optional, intent(in) :: rowcnv,colcnv,rowscale,colscale
|
||||
character(len=5), optional :: outfmt
|
||||
integer(psb_ipk_), intent(in), optional :: data
|
||||
end Subroutine psb_zsphalo
|
||||
end interface
|
||||
|
||||
|
||||
interface psb_spall
|
||||
subroutine psb_zspalloc(a, desc_a, info, nnz)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_z_base_vect_type, psb_z_vect_type, &
|
||||
& psb_zspmat_type, psb_z_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_zspmat_type), intent(inout) :: a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -262,9 +242,8 @@ Module psb_z_tools_mod
|
||||
|
||||
interface psb_spasb
|
||||
subroutine psb_zspasb(a,desc_a, info, afmt, upd, dupl,mold)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_z_base_vect_type, psb_z_vect_type, &
|
||||
& psb_zspmat_type, psb_z_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_zspmat_type), intent (inout) :: a
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -276,9 +255,8 @@ Module psb_z_tools_mod
|
||||
|
||||
interface psb_spfree
|
||||
subroutine psb_zspfree(a, desc_a,info)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_z_base_vect_type, psb_z_vect_type, &
|
||||
& psb_zspmat_type, psb_z_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_zspmat_type), intent(inout) ::a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -288,9 +266,8 @@ Module psb_z_tools_mod
|
||||
|
||||
interface psb_spins
|
||||
subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_z_base_vect_type, psb_z_vect_type, &
|
||||
& psb_zspmat_type, psb_z_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
type(psb_zspmat_type), intent(inout) :: a
|
||||
integer(psb_ipk_), intent(in) :: nz,ia(:),ja(:)
|
||||
@@ -301,9 +278,8 @@ Module psb_z_tools_mod
|
||||
end subroutine psb_zspins
|
||||
subroutine psb_zspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local)
|
||||
use psb_i_vect_mod, only : psb_i_vect_type
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_z_base_vect_type, psb_z_vect_type,&
|
||||
& psb_zspmat_type, psb_z_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
type(psb_zspmat_type), intent(inout) :: a
|
||||
integer(psb_ipk_), intent(in) :: nz
|
||||
@@ -314,9 +290,8 @@ Module psb_z_tools_mod
|
||||
logical, intent(in), optional :: local
|
||||
end subroutine psb_zspins_v
|
||||
subroutine psb_zspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_z_base_vect_type, psb_z_vect_type, &
|
||||
& psb_zspmat_type, psb_z_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_ar
|
||||
type(psb_desc_type), intent(inout) :: desc_ac
|
||||
type(psb_zspmat_type), intent(inout) :: a
|
||||
@@ -329,9 +304,8 @@ Module psb_z_tools_mod
|
||||
|
||||
interface psb_sprn
|
||||
subroutine psb_zsprn(a, desc_a,info,clear)
|
||||
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
|
||||
& psb_z_base_vect_type, psb_z_vect_type, &
|
||||
& psb_zspmat_type, psb_z_base_sparse_mat
|
||||
import
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_zspmat_type), intent(inout) :: a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
+391
-389
@@ -48,27 +48,6 @@ module psb_z_vect_mod
|
||||
procedure, pass(x) :: get_nrows => z_vect_get_nrows
|
||||
procedure, pass(x) :: sizeof => z_vect_sizeof
|
||||
procedure, pass(x) :: get_fmt => z_vect_get_fmt
|
||||
procedure, pass(x) :: dot_v => z_vect_dot_v
|
||||
procedure, pass(x) :: dot_a => z_vect_dot_a
|
||||
generic, public :: dot => dot_v, dot_a
|
||||
procedure, pass(y) :: axpby_v => z_vect_axpby_v
|
||||
procedure, pass(y) :: axpby_a => z_vect_axpby_a
|
||||
generic, public :: axpby => axpby_v, axpby_a
|
||||
procedure, pass(y) :: mlt_v => z_vect_mlt_v
|
||||
procedure, pass(y) :: mlt_a => z_vect_mlt_a
|
||||
procedure, pass(z) :: mlt_a_2 => z_vect_mlt_a_2
|
||||
procedure, pass(z) :: mlt_v_2 => z_vect_mlt_v_2
|
||||
procedure, pass(z) :: mlt_va => z_vect_mlt_va
|
||||
procedure, pass(z) :: mlt_av => z_vect_mlt_av
|
||||
generic, public :: mlt => mlt_v, mlt_a, mlt_a_2,&
|
||||
& mlt_v_2, mlt_av, mlt_va
|
||||
procedure, pass(x) :: scal => z_vect_scal
|
||||
procedure, pass(x) :: absval1 => z_vect_absval1
|
||||
procedure, pass(x) :: absval2 => z_vect_absval2
|
||||
generic, public :: absval => absval1, absval2
|
||||
procedure, pass(x) :: nrm2 => z_vect_nrm2
|
||||
procedure, pass(x) :: amax => z_vect_amax
|
||||
procedure, pass(x) :: asum => z_vect_asum
|
||||
procedure, pass(x) :: all => z_vect_all
|
||||
procedure, pass(x) :: reall => z_vect_reall
|
||||
procedure, pass(x) :: zero => z_vect_zero
|
||||
@@ -92,6 +71,27 @@ module psb_z_vect_mod
|
||||
procedure, pass(x) :: set_vect => z_vect_set_vect
|
||||
generic, public :: set => set_vect, set_scal
|
||||
procedure, pass(x) :: clone => z_vect_clone
|
||||
procedure, pass(x) :: dot_v => z_vect_dot_v
|
||||
procedure, pass(x) :: dot_a => z_vect_dot_a
|
||||
generic, public :: dot => dot_v, dot_a
|
||||
procedure, pass(y) :: axpby_v => z_vect_axpby_v
|
||||
procedure, pass(y) :: axpby_a => z_vect_axpby_a
|
||||
generic, public :: axpby => axpby_v, axpby_a
|
||||
procedure, pass(y) :: mlt_v => z_vect_mlt_v
|
||||
procedure, pass(y) :: mlt_a => z_vect_mlt_a
|
||||
procedure, pass(z) :: mlt_a_2 => z_vect_mlt_a_2
|
||||
procedure, pass(z) :: mlt_v_2 => z_vect_mlt_v_2
|
||||
procedure, pass(z) :: mlt_va => z_vect_mlt_va
|
||||
procedure, pass(z) :: mlt_av => z_vect_mlt_av
|
||||
generic, public :: mlt => mlt_v, mlt_a, mlt_a_2,&
|
||||
& mlt_v_2, mlt_av, mlt_va
|
||||
procedure, pass(x) :: scal => z_vect_scal
|
||||
procedure, pass(x) :: absval1 => z_vect_absval1
|
||||
procedure, pass(x) :: absval2 => z_vect_absval2
|
||||
generic, public :: absval => absval1, absval2
|
||||
procedure, pass(x) :: nrm2 => z_vect_nrm2
|
||||
procedure, pass(x) :: amax => z_vect_amax
|
||||
procedure, pass(x) :: asum => z_vect_asum
|
||||
end type psb_z_vect_type
|
||||
|
||||
public :: psb_z_vect
|
||||
@@ -296,6 +296,191 @@ contains
|
||||
res = 'NULL'
|
||||
if (allocated(x%v)) res = x%v%get_fmt()
|
||||
end function z_vect_get_fmt
|
||||
subroutine z_vect_all(n, x, info, mold)
|
||||
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: n
|
||||
class(psb_z_vect_type), intent(inout) :: x
|
||||
class(psb_z_base_vect_type), intent(in), optional :: mold
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%free(info)
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
allocate(psb_z_base_vect_type :: x%v,stat=info)
|
||||
endif
|
||||
if (info == 0) then
|
||||
call x%v%all(n,info)
|
||||
else
|
||||
info = psb_err_alloc_dealloc_
|
||||
end if
|
||||
|
||||
end subroutine z_vect_all
|
||||
|
||||
subroutine z_vect_reall(n, x, info)
|
||||
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: n
|
||||
class(psb_z_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = 0
|
||||
if (.not.allocated(x%v)) &
|
||||
& call x%all(n,info)
|
||||
if (info == 0) &
|
||||
& call x%asb(n,info)
|
||||
|
||||
end subroutine z_vect_reall
|
||||
|
||||
subroutine z_vect_zero(x)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_z_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) call x%v%zero()
|
||||
|
||||
end subroutine z_vect_zero
|
||||
|
||||
subroutine z_vect_asb(n, x, info)
|
||||
use psi_serial_mod
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: n
|
||||
class(psb_z_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%asb(n,info)
|
||||
|
||||
end subroutine z_vect_asb
|
||||
|
||||
subroutine z_vect_sync(x)
|
||||
implicit none
|
||||
class(psb_z_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%sync()
|
||||
|
||||
end subroutine z_vect_sync
|
||||
|
||||
subroutine z_vect_gthab(n,idx,alpha,x,beta,y)
|
||||
use psi_serial_mod
|
||||
integer(psb_ipk_) :: n, idx(:)
|
||||
complex(psb_dpk_) :: alpha, beta, y(:)
|
||||
class(psb_z_vect_type) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%gth(n,idx,alpha,beta,y)
|
||||
|
||||
end subroutine z_vect_gthab
|
||||
|
||||
subroutine z_vect_gthzv(n,idx,x,y)
|
||||
use psi_serial_mod
|
||||
integer(psb_ipk_) :: n, idx(:)
|
||||
complex(psb_dpk_) :: y(:)
|
||||
class(psb_z_vect_type) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%gth(n,idx,y)
|
||||
|
||||
end subroutine z_vect_gthzv
|
||||
|
||||
subroutine z_vect_sctb(n,idx,x,beta,y)
|
||||
use psi_serial_mod
|
||||
integer(psb_ipk_) :: n, idx(:)
|
||||
complex(psb_dpk_) :: beta, x(:)
|
||||
class(psb_z_vect_type) :: y
|
||||
|
||||
if (allocated(y%v)) &
|
||||
& call y%v%sct(n,idx,x,beta)
|
||||
|
||||
end subroutine z_vect_sctb
|
||||
|
||||
subroutine z_vect_free(x, info)
|
||||
use psi_serial_mod
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(psb_z_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = 0
|
||||
if (allocated(x%v)) then
|
||||
call x%v%free(info)
|
||||
if (info == 0) deallocate(x%v,stat=info)
|
||||
end if
|
||||
|
||||
end subroutine z_vect_free
|
||||
|
||||
subroutine z_vect_ins_a(n,irl,val,dupl,x,info)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_z_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: n, dupl
|
||||
integer(psb_ipk_), intent(in) :: irl(:)
|
||||
complex(psb_dpk_), intent(in) :: val(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
info = 0
|
||||
if (.not.allocated(x%v)) then
|
||||
info = psb_err_invalid_vect_state_
|
||||
return
|
||||
end if
|
||||
|
||||
call x%v%ins(n,irl,val,dupl,info)
|
||||
|
||||
end subroutine z_vect_ins_a
|
||||
|
||||
subroutine z_vect_ins_v(n,irl,val,dupl,x,info)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_z_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: n, dupl
|
||||
class(psb_i_vect_type), intent(inout) :: irl
|
||||
class(psb_z_vect_type), intent(inout) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
info = 0
|
||||
if (.not.(allocated(x%v).and.allocated(irl%v).and.allocated(val%v))) then
|
||||
info = psb_err_invalid_vect_state_
|
||||
return
|
||||
end if
|
||||
|
||||
call x%v%ins(n,irl%v,val%v,dupl,info)
|
||||
|
||||
end subroutine z_vect_ins_v
|
||||
|
||||
|
||||
subroutine z_vect_cnv(x,mold)
|
||||
class(psb_z_vect_type), intent(inout) :: x
|
||||
class(psb_z_base_vect_type), intent(in), optional :: mold
|
||||
class(psb_z_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
|
||||
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 z_vect_cnv
|
||||
|
||||
function z_vect_dot_v(n,x,y) result(res)
|
||||
implicit none
|
||||
@@ -522,191 +707,6 @@ contains
|
||||
|
||||
end function z_vect_asum
|
||||
|
||||
subroutine z_vect_all(n, x, info, mold)
|
||||
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: n
|
||||
class(psb_z_vect_type), intent(inout) :: x
|
||||
class(psb_z_base_vect_type), intent(in), optional :: mold
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%free(info)
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
allocate(psb_z_base_vect_type :: x%v,stat=info)
|
||||
endif
|
||||
if (info == 0) then
|
||||
call x%v%all(n,info)
|
||||
else
|
||||
info = psb_err_alloc_dealloc_
|
||||
end if
|
||||
|
||||
end subroutine z_vect_all
|
||||
|
||||
subroutine z_vect_reall(n, x, info)
|
||||
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: n
|
||||
class(psb_z_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = 0
|
||||
if (.not.allocated(x%v)) &
|
||||
& call x%all(n,info)
|
||||
if (info == 0) &
|
||||
& call x%asb(n,info)
|
||||
|
||||
end subroutine z_vect_reall
|
||||
|
||||
subroutine z_vect_zero(x)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_z_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) call x%v%zero()
|
||||
|
||||
end subroutine z_vect_zero
|
||||
|
||||
subroutine z_vect_asb(n, x, info)
|
||||
use psi_serial_mod
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: n
|
||||
class(psb_z_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%asb(n,info)
|
||||
|
||||
end subroutine z_vect_asb
|
||||
|
||||
subroutine z_vect_sync(x)
|
||||
implicit none
|
||||
class(psb_z_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%sync()
|
||||
|
||||
end subroutine z_vect_sync
|
||||
|
||||
subroutine z_vect_gthab(n,idx,alpha,x,beta,y)
|
||||
use psi_serial_mod
|
||||
integer(psb_ipk_) :: n, idx(:)
|
||||
complex(psb_dpk_) :: alpha, beta, y(:)
|
||||
class(psb_z_vect_type) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%gth(n,idx,alpha,beta,y)
|
||||
|
||||
end subroutine z_vect_gthab
|
||||
|
||||
subroutine z_vect_gthzv(n,idx,x,y)
|
||||
use psi_serial_mod
|
||||
integer(psb_ipk_) :: n, idx(:)
|
||||
complex(psb_dpk_) :: y(:)
|
||||
class(psb_z_vect_type) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%gth(n,idx,y)
|
||||
|
||||
end subroutine z_vect_gthzv
|
||||
|
||||
subroutine z_vect_sctb(n,idx,x,beta,y)
|
||||
use psi_serial_mod
|
||||
integer(psb_ipk_) :: n, idx(:)
|
||||
complex(psb_dpk_) :: beta, x(:)
|
||||
class(psb_z_vect_type) :: y
|
||||
|
||||
if (allocated(y%v)) &
|
||||
& call y%v%sct(n,idx,x,beta)
|
||||
|
||||
end subroutine z_vect_sctb
|
||||
|
||||
subroutine z_vect_free(x, info)
|
||||
use psi_serial_mod
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(psb_z_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = 0
|
||||
if (allocated(x%v)) then
|
||||
call x%v%free(info)
|
||||
if (info == 0) deallocate(x%v,stat=info)
|
||||
end if
|
||||
|
||||
end subroutine z_vect_free
|
||||
|
||||
subroutine z_vect_ins_a(n,irl,val,dupl,x,info)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_z_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: n, dupl
|
||||
integer(psb_ipk_), intent(in) :: irl(:)
|
||||
complex(psb_dpk_), intent(in) :: val(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
info = 0
|
||||
if (.not.allocated(x%v)) then
|
||||
info = psb_err_invalid_vect_state_
|
||||
return
|
||||
end if
|
||||
|
||||
call x%v%ins(n,irl,val,dupl,info)
|
||||
|
||||
end subroutine z_vect_ins_a
|
||||
|
||||
subroutine z_vect_ins_v(n,irl,val,dupl,x,info)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_z_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: n, dupl
|
||||
class(psb_i_vect_type), intent(inout) :: irl
|
||||
class(psb_z_vect_type), intent(inout) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
info = 0
|
||||
if (.not.(allocated(x%v).and.allocated(irl%v).and.allocated(val%v))) then
|
||||
info = psb_err_invalid_vect_state_
|
||||
return
|
||||
end if
|
||||
|
||||
call x%v%ins(n,irl%v,val%v,dupl,info)
|
||||
|
||||
end subroutine z_vect_ins_v
|
||||
|
||||
|
||||
subroutine z_vect_cnv(x,mold)
|
||||
class(psb_z_vect_type), intent(inout) :: x
|
||||
class(psb_z_base_vect_type), intent(in), optional :: mold
|
||||
class(psb_z_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
|
||||
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 z_vect_cnv
|
||||
|
||||
end module psb_z_vect_mod
|
||||
|
||||
@@ -726,6 +726,28 @@ module psb_z_multivect_mod
|
||||
procedure, pass(x) :: get_ncols => z_vect_get_ncols
|
||||
procedure, pass(x) :: sizeof => z_vect_sizeof
|
||||
procedure, pass(x) :: get_fmt => z_vect_get_fmt
|
||||
|
||||
procedure, pass(x) :: all => z_vect_all
|
||||
procedure, pass(x) :: reall => z_vect_reall
|
||||
procedure, pass(x) :: zero => z_vect_zero
|
||||
procedure, pass(x) :: asb => z_vect_asb
|
||||
procedure, pass(x) :: sync => z_vect_sync
|
||||
procedure, pass(x) :: free => z_vect_free
|
||||
procedure, pass(x) :: ins => z_vect_ins
|
||||
procedure, pass(x) :: bld_x => z_vect_bld_x
|
||||
procedure, pass(x) :: bld_n => z_vect_bld_n
|
||||
generic, public :: bld => bld_x, bld_n
|
||||
procedure, pass(x) :: get_vect => z_vect_get_vect
|
||||
procedure, pass(x) :: cnv => z_vect_cnv
|
||||
procedure, pass(x) :: set_scal => z_vect_set_scal
|
||||
procedure, pass(x) :: set_vect => z_vect_set_vect
|
||||
generic, public :: set => set_vect, set_scal
|
||||
procedure, pass(x) :: clone => z_vect_clone
|
||||
!!$ procedure, pass(x) :: gthab => z_vect_gthab
|
||||
!!$ procedure, pass(x) :: gthzv => z_vect_gthzv
|
||||
!!$ generic, public :: gth => gthab, gthzv
|
||||
!!$ procedure, pass(y) :: sctb => z_vect_sctb
|
||||
!!$ generic, public :: sct => sctb
|
||||
!!$ procedure, pass(x) :: dot_v => z_vect_dot_v
|
||||
!!$ procedure, pass(x) :: dot_a => z_vect_dot_a
|
||||
!!$ generic, public :: dot => dot_v, dot_a
|
||||
@@ -744,27 +766,6 @@ module psb_z_multivect_mod
|
||||
!!$ procedure, pass(x) :: nrm2 => z_vect_nrm2
|
||||
!!$ procedure, pass(x) :: amax => z_vect_amax
|
||||
!!$ procedure, pass(x) :: asum => z_vect_asum
|
||||
procedure, pass(x) :: all => z_vect_all
|
||||
procedure, pass(x) :: reall => z_vect_reall
|
||||
procedure, pass(x) :: zero => z_vect_zero
|
||||
procedure, pass(x) :: asb => z_vect_asb
|
||||
procedure, pass(x) :: sync => z_vect_sync
|
||||
!!$ procedure, pass(x) :: gthab => z_vect_gthab
|
||||
!!$ procedure, pass(x) :: gthzv => z_vect_gthzv
|
||||
!!$ generic, public :: gth => gthab, gthzv
|
||||
!!$ procedure, pass(y) :: sctb => z_vect_sctb
|
||||
!!$ generic, public :: sct => sctb
|
||||
procedure, pass(x) :: free => z_vect_free
|
||||
procedure, pass(x) :: ins => z_vect_ins
|
||||
procedure, pass(x) :: bld_x => z_vect_bld_x
|
||||
procedure, pass(x) :: bld_n => z_vect_bld_n
|
||||
generic, public :: bld => bld_x, bld_n
|
||||
procedure, pass(x) :: get_vect => z_vect_get_vect
|
||||
procedure, pass(x) :: cnv => z_vect_cnv
|
||||
procedure, pass(x) :: set_scal => z_vect_set_scal
|
||||
procedure, pass(x) :: set_vect => z_vect_set_vect
|
||||
generic, public :: set => set_vect, set_scal
|
||||
procedure, pass(x) :: clone => z_vect_clone
|
||||
end type psb_z_multivect_type
|
||||
|
||||
public :: psb_z_multivect, psb_z_multivect_type,&
|
||||
@@ -971,6 +972,169 @@ contains
|
||||
if (allocated(x%v)) res = x%v%get_fmt()
|
||||
end function z_vect_get_fmt
|
||||
|
||||
subroutine z_vect_all(m,n, x, info, mold)
|
||||
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m,n
|
||||
class(psb_z_multivect_type), intent(out) :: x
|
||||
class(psb_z_base_multivect_type), intent(in), optional :: mold
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
allocate(psb_z_base_multivect_type :: x%v,stat=info)
|
||||
endif
|
||||
if (info == 0) then
|
||||
call x%v%all(m,n,info)
|
||||
else
|
||||
info = psb_err_alloc_dealloc_
|
||||
end if
|
||||
|
||||
end subroutine z_vect_all
|
||||
|
||||
subroutine z_vect_reall(m,n, x, info)
|
||||
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m,n
|
||||
class(psb_z_multivect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = 0
|
||||
if (.not.allocated(x%v)) &
|
||||
& call x%all(m,n,info)
|
||||
if (info == 0) &
|
||||
& call x%asb(m,n,info)
|
||||
|
||||
end subroutine z_vect_reall
|
||||
|
||||
subroutine z_vect_zero(x)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_z_multivect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) call x%v%zero()
|
||||
|
||||
end subroutine z_vect_zero
|
||||
|
||||
subroutine z_vect_asb(m,n, x, info)
|
||||
use psi_serial_mod
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m,n
|
||||
class(psb_z_multivect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%asb(m,n,info)
|
||||
|
||||
end subroutine z_vect_asb
|
||||
|
||||
subroutine z_vect_sync(x)
|
||||
implicit none
|
||||
class(psb_z_multivect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%sync()
|
||||
|
||||
end subroutine z_vect_sync
|
||||
|
||||
!!$ subroutine z_vect_gthab(n,idx,alpha,x,beta,y)
|
||||
!!$ use psi_serial_mod
|
||||
!!$ integer(psb_ipk_) :: n, idx(:)
|
||||
!!$ complex(psb_dpk_) :: alpha, beta, y(:)
|
||||
!!$ class(psb_z_multivect_type) :: x
|
||||
!!$
|
||||
!!$ if (allocated(x%v)) &
|
||||
!!$ & call x%v%gth(n,idx,alpha,beta,y)
|
||||
!!$
|
||||
!!$ end subroutine z_vect_gthab
|
||||
!!$
|
||||
!!$ subroutine z_vect_gthzv(n,idx,x,y)
|
||||
!!$ use psi_serial_mod
|
||||
!!$ integer(psb_ipk_) :: n, idx(:)
|
||||
!!$ complex(psb_dpk_) :: y(:)
|
||||
!!$ class(psb_z_multivect_type) :: x
|
||||
!!$
|
||||
!!$ if (allocated(x%v)) &
|
||||
!!$ & call x%v%gth(n,idx,y)
|
||||
!!$
|
||||
!!$ end subroutine z_vect_gthzv
|
||||
!!$
|
||||
!!$ subroutine z_vect_sctb(n,idx,x,beta,y)
|
||||
!!$ use psi_serial_mod
|
||||
!!$ integer(psb_ipk_) :: n, idx(:)
|
||||
!!$ complex(psb_dpk_) :: beta, x(:)
|
||||
!!$ class(psb_z_multivect_type) :: y
|
||||
!!$
|
||||
!!$ if (allocated(y%v)) &
|
||||
!!$ & call y%v%sct(n,idx,x,beta)
|
||||
!!$
|
||||
!!$ end subroutine z_vect_sctb
|
||||
|
||||
subroutine z_vect_free(x, info)
|
||||
use psi_serial_mod
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(psb_z_multivect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = 0
|
||||
if (allocated(x%v)) then
|
||||
call x%v%free(info)
|
||||
if (info == 0) deallocate(x%v,stat=info)
|
||||
end if
|
||||
|
||||
end subroutine z_vect_free
|
||||
|
||||
subroutine z_vect_ins(n,irl,val,dupl,x,info)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_z_multivect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: n, dupl
|
||||
integer(psb_ipk_), intent(in) :: irl(:)
|
||||
complex(psb_dpk_), intent(in) :: val(:,:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
info = 0
|
||||
if (.not.allocated(x%v)) then
|
||||
info = psb_err_invalid_vect_state_
|
||||
return
|
||||
end if
|
||||
|
||||
call x%v%ins(n,irl,val,dupl,info)
|
||||
|
||||
end subroutine z_vect_ins
|
||||
|
||||
|
||||
subroutine z_vect_cnv(x,mold)
|
||||
class(psb_z_multivect_type), intent(inout) :: x
|
||||
class(psb_z_base_multivect_type), intent(in), optional :: mold
|
||||
class(psb_z_base_multivect_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
|
||||
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 z_vect_cnv
|
||||
|
||||
|
||||
!!$ function z_vect_dot_v(n,x,y) result(res)
|
||||
!!$ implicit none
|
||||
!!$ class(psb_z_multivect_type), intent(inout) :: x, y
|
||||
@@ -1178,167 +1342,5 @@ contains
|
||||
!!$ end if
|
||||
!!$
|
||||
!!$ end function z_vect_asum
|
||||
|
||||
subroutine z_vect_all(m,n, x, info, mold)
|
||||
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m,n
|
||||
class(psb_z_multivect_type), intent(out) :: x
|
||||
class(psb_z_base_multivect_type), intent(in), optional :: mold
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
allocate(psb_z_base_multivect_type :: x%v,stat=info)
|
||||
endif
|
||||
if (info == 0) then
|
||||
call x%v%all(m,n,info)
|
||||
else
|
||||
info = psb_err_alloc_dealloc_
|
||||
end if
|
||||
|
||||
end subroutine z_vect_all
|
||||
|
||||
subroutine z_vect_reall(m,n, x, info)
|
||||
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m,n
|
||||
class(psb_z_multivect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = 0
|
||||
if (.not.allocated(x%v)) &
|
||||
& call x%all(m,n,info)
|
||||
if (info == 0) &
|
||||
& call x%asb(m,n,info)
|
||||
|
||||
end subroutine z_vect_reall
|
||||
|
||||
subroutine z_vect_zero(x)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_z_multivect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) call x%v%zero()
|
||||
|
||||
end subroutine z_vect_zero
|
||||
|
||||
subroutine z_vect_asb(m,n, x, info)
|
||||
use psi_serial_mod
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m,n
|
||||
class(psb_z_multivect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%asb(m,n,info)
|
||||
|
||||
end subroutine z_vect_asb
|
||||
|
||||
subroutine z_vect_sync(x)
|
||||
implicit none
|
||||
class(psb_z_multivect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%sync()
|
||||
|
||||
end subroutine z_vect_sync
|
||||
|
||||
!!$ subroutine z_vect_gthab(n,idx,alpha,x,beta,y)
|
||||
!!$ use psi_serial_mod
|
||||
!!$ integer(psb_ipk_) :: n, idx(:)
|
||||
!!$ complex(psb_dpk_) :: alpha, beta, y(:)
|
||||
!!$ class(psb_z_multivect_type) :: x
|
||||
!!$
|
||||
!!$ if (allocated(x%v)) &
|
||||
!!$ & call x%v%gth(n,idx,alpha,beta,y)
|
||||
!!$
|
||||
!!$ end subroutine z_vect_gthab
|
||||
!!$
|
||||
!!$ subroutine z_vect_gthzv(n,idx,x,y)
|
||||
!!$ use psi_serial_mod
|
||||
!!$ integer(psb_ipk_) :: n, idx(:)
|
||||
!!$ complex(psb_dpk_) :: y(:)
|
||||
!!$ class(psb_z_multivect_type) :: x
|
||||
!!$
|
||||
!!$ if (allocated(x%v)) &
|
||||
!!$ & call x%v%gth(n,idx,y)
|
||||
!!$
|
||||
!!$ end subroutine z_vect_gthzv
|
||||
!!$
|
||||
!!$ subroutine z_vect_sctb(n,idx,x,beta,y)
|
||||
!!$ use psi_serial_mod
|
||||
!!$ integer(psb_ipk_) :: n, idx(:)
|
||||
!!$ complex(psb_dpk_) :: beta, x(:)
|
||||
!!$ class(psb_z_multivect_type) :: y
|
||||
!!$
|
||||
!!$ if (allocated(y%v)) &
|
||||
!!$ & call y%v%sct(n,idx,x,beta)
|
||||
!!$
|
||||
!!$ end subroutine z_vect_sctb
|
||||
|
||||
subroutine z_vect_free(x, info)
|
||||
use psi_serial_mod
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(psb_z_multivect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = 0
|
||||
if (allocated(x%v)) then
|
||||
call x%v%free(info)
|
||||
if (info == 0) deallocate(x%v,stat=info)
|
||||
end if
|
||||
|
||||
end subroutine z_vect_free
|
||||
|
||||
subroutine z_vect_ins(n,irl,val,dupl,x,info)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_z_multivect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: n, dupl
|
||||
integer(psb_ipk_), intent(in) :: irl(:)
|
||||
complex(psb_dpk_), intent(in) :: val(:,:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
info = 0
|
||||
if (.not.allocated(x%v)) then
|
||||
info = psb_err_invalid_vect_state_
|
||||
return
|
||||
end if
|
||||
|
||||
call x%v%ins(n,irl,val,dupl,info)
|
||||
|
||||
end subroutine z_vect_ins
|
||||
|
||||
|
||||
subroutine z_vect_cnv(x,mold)
|
||||
class(psb_z_multivect_type), intent(inout) :: x
|
||||
class(psb_z_base_multivect_type), intent(in), optional :: mold
|
||||
class(psb_z_base_multivect_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
|
||||
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 z_vect_cnv
|
||||
|
||||
end module psb_z_multivect_mod
|
||||
|
||||
@@ -33,6 +33,7 @@ module psi_c_mod
|
||||
use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_spk_, psb_i_base_vect_type
|
||||
use psb_c_vect_mod, only : psb_c_base_vect_type
|
||||
|
||||
|
||||
interface psi_swapdata
|
||||
subroutine psi_cswapdatam(flag,n,beta,y,desc_a,work,info,data)
|
||||
import :: psb_desc_type, psb_ipk_, psb_spk_, psb_c_base_vect_type
|
||||
|
||||
@@ -33,6 +33,7 @@ module psi_d_mod
|
||||
use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_dpk_, psb_i_base_vect_type
|
||||
use psb_d_vect_mod, only : psb_d_base_vect_type
|
||||
|
||||
|
||||
interface psi_swapdata
|
||||
subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
|
||||
import :: psb_desc_type, psb_ipk_, psb_dpk_, psb_d_base_vect_type
|
||||
|
||||
+77
-87
@@ -31,7 +31,7 @@
|
||||
!!$
|
||||
module psi_i_mod
|
||||
use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_mpik_
|
||||
use psb_i_vect_mod, only : psb_i_base_vect_type
|
||||
use psb_i_vect_mod, only : psb_i_base_vect_type
|
||||
|
||||
interface
|
||||
subroutine psi_compute_size(desc_data,&
|
||||
@@ -196,63 +196,53 @@ module psi_i_mod
|
||||
|
||||
interface psi_swapdata
|
||||
subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data)
|
||||
import :: psb_desc_type, psb_ipk_
|
||||
import :: psb_desc_type, psb_ipk_, psb_ipk_, psb_i_base_vect_type
|
||||
integer(psb_ipk_), intent(in) :: flag, n
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: y(:,:), beta
|
||||
integer(psb_ipk_), target :: work(:)
|
||||
integer(psb_ipk_) :: y(:,:), beta
|
||||
integer(psb_ipk_),target :: work(:)
|
||||
type(psb_desc_type), target :: desc_a
|
||||
integer(psb_ipk_), optional :: data
|
||||
end subroutine psi_iswapdatam
|
||||
subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data)
|
||||
import :: psb_desc_type, psb_ipk_
|
||||
import :: psb_desc_type, psb_ipk_, psb_ipk_, psb_i_base_vect_type
|
||||
integer(psb_ipk_), intent(in) :: flag
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: y(:), beta
|
||||
integer(psb_ipk_), target :: work(:)
|
||||
integer(psb_ipk_) :: y(:), beta
|
||||
integer(psb_ipk_),target :: work(:)
|
||||
type(psb_desc_type), target :: desc_a
|
||||
integer(psb_ipk_), optional :: data
|
||||
end subroutine psi_iswapdatav
|
||||
subroutine psi_iswapdata_vect(flag,beta,y,desc_a,work,info,data)
|
||||
import :: psb_desc_type, psb_ipk_, psb_i_base_vect_type
|
||||
import :: psb_desc_type, psb_ipk_, psb_ipk_, psb_i_base_vect_type
|
||||
integer(psb_ipk_), intent(in) :: flag
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_i_base_vect_type) :: y
|
||||
integer(psb_ipk_) :: beta
|
||||
integer(psb_ipk_),target :: work(:)
|
||||
integer(psb_ipk_) :: beta
|
||||
integer(psb_ipk_),target :: work(:)
|
||||
type(psb_desc_type), target :: desc_a
|
||||
integer(psb_ipk_), optional :: data
|
||||
end subroutine psi_iswapdata_vect
|
||||
subroutine psi_iswapidxm(ictxt,icomm,flag,n,beta,y,idx,&
|
||||
& totxch,totsnd,totrcv,work,info)
|
||||
import :: psb_desc_type, psb_ipk_
|
||||
integer(psb_ipk_), intent(in) :: ictxt,icomm,flag, n
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: y(:,:), beta
|
||||
integer(psb_ipk_),target :: work(:)
|
||||
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv
|
||||
import :: psb_desc_type, psb_ipk_, psb_ipk_, psb_i_base_vect_type
|
||||
integer(psb_ipk_), intent(in) :: ictxt,icomm,flag, n
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: y(:,:), beta
|
||||
integer(psb_ipk_),target :: work(:)
|
||||
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv
|
||||
end subroutine psi_iswapidxm
|
||||
subroutine psi_iswapidxv(ictxt,icomm,flag,beta,y,idx,&
|
||||
& totxch,totsnd,totrcv,work,info)
|
||||
import :: psb_desc_type, psb_ipk_
|
||||
integer(psb_ipk_), intent(in) :: ictxt,icomm,flag
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: y(:), beta
|
||||
integer(psb_ipk_),target :: work(:)
|
||||
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv
|
||||
end subroutine psi_iswapidxv
|
||||
subroutine psi_iswapidx_vect(ictxt,icomm,flag,beta,y,idx,&
|
||||
& totxch,totsnd,totrcv,work,info)
|
||||
import :: psb_desc_type, psb_ipk_, psb_i_base_vect_type
|
||||
integer(psb_ipk_), intent(in) :: ictxt,icomm,flag
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_i_base_vect_type) :: y
|
||||
integer(psb_ipk_) :: beta
|
||||
import :: psb_desc_type, psb_ipk_, psb_ipk_, psb_i_base_vect_type
|
||||
integer(psb_ipk_), intent(in) :: ictxt,icomm,flag
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: y(:), beta
|
||||
integer(psb_ipk_),target :: work(:)
|
||||
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv
|
||||
end subroutine psi_iswapidx_vect
|
||||
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv
|
||||
end subroutine psi_iswapidxv
|
||||
subroutine psi_iswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info)
|
||||
import :: psb_desc_type, psb_ipk_, psb_i_base_vect_type
|
||||
import :: psb_desc_type, psb_ipk_, psb_ipk_, psb_i_base_vect_type, psb_i_base_vect_type
|
||||
integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_i_base_vect_type) :: y
|
||||
@@ -266,80 +256,80 @@ module psi_i_mod
|
||||
|
||||
interface psi_swaptran
|
||||
subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data)
|
||||
import :: psb_desc_type, psb_ipk_
|
||||
import :: psb_desc_type, psb_ipk_, psb_ipk_, psb_i_base_vect_type
|
||||
integer(psb_ipk_), intent(in) :: flag, n
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: y(:,:), beta
|
||||
integer(psb_ipk_),target :: work(:)
|
||||
integer(psb_ipk_) :: y(:,:), beta
|
||||
integer(psb_ipk_),target :: work(:)
|
||||
type(psb_desc_type), target :: desc_a
|
||||
integer(psb_ipk_), optional :: data
|
||||
end subroutine psi_iswaptranm
|
||||
subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data)
|
||||
import :: psb_desc_type, psb_ipk_
|
||||
import :: psb_desc_type, psb_ipk_, psb_ipk_, psb_i_base_vect_type
|
||||
integer(psb_ipk_), intent(in) :: flag
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: y(:), beta
|
||||
integer(psb_ipk_),target :: work(:)
|
||||
integer(psb_ipk_) :: y(:), beta
|
||||
integer(psb_ipk_),target :: work(:)
|
||||
type(psb_desc_type), target :: desc_a
|
||||
integer(psb_ipk_), optional :: data
|
||||
end subroutine psi_iswaptranv
|
||||
subroutine psi_iswaptran_vect(flag,beta,y,desc_a,work,info,data)
|
||||
import :: psb_desc_type, psb_ipk_, psb_i_base_vect_type
|
||||
import :: psb_desc_type, psb_ipk_, psb_ipk_, psb_i_base_vect_type
|
||||
integer(psb_ipk_), intent(in) :: flag
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_i_base_vect_type) :: y
|
||||
integer(psb_ipk_) :: beta
|
||||
integer(psb_ipk_),target :: work(:)
|
||||
integer(psb_ipk_) :: beta
|
||||
integer(psb_ipk_),target :: work(:)
|
||||
type(psb_desc_type), target :: desc_a
|
||||
integer(psb_ipk_), optional :: data
|
||||
end subroutine psi_iswaptran_vect
|
||||
subroutine psi_itranidxm(ictxt,icomm,flag,n,beta,y,idx,&
|
||||
& totxch,totsnd,totrcv,work,info)
|
||||
import :: psb_desc_type, psb_ipk_
|
||||
integer(psb_ipk_), intent(in) :: ictxt,icomm,flag, n
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: y(:,:), beta
|
||||
integer(psb_ipk_), target :: work(:)
|
||||
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv
|
||||
import :: psb_desc_type, psb_ipk_, psb_ipk_, psb_i_base_vect_type
|
||||
integer(psb_ipk_), intent(in) :: ictxt,icomm,flag, n
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: y(:,:), beta
|
||||
integer(psb_ipk_),target :: work(:)
|
||||
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv
|
||||
end subroutine psi_itranidxm
|
||||
subroutine psi_itranidxv(ictxt,icomm,flag,beta,y,idx,&
|
||||
& totxch,totsnd,totrcv,work,info)
|
||||
import :: psb_desc_type, psb_ipk_
|
||||
integer(psb_ipk_), intent(in) :: ictxt,icomm,flag
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: y(:), beta
|
||||
integer(psb_ipk_), target :: work(:)
|
||||
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv
|
||||
import :: psb_desc_type, psb_ipk_, psb_ipk_, psb_i_base_vect_type
|
||||
integer(psb_ipk_), intent(in) :: ictxt,icomm,flag
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: y(:), beta
|
||||
integer(psb_ipk_),target :: work(:)
|
||||
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv
|
||||
end subroutine psi_itranidxv
|
||||
subroutine psi_itranidx_vect(ictxt,icomm,flag,beta,y,idx,&
|
||||
& totxch,totsnd,totrcv,work,info)
|
||||
import :: psb_desc_type, psb_ipk_, psb_i_base_vect_type
|
||||
integer(psb_ipk_), intent(in) :: ictxt,icomm,flag
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
import :: psb_desc_type, psb_ipk_, psb_ipk_, psb_i_base_vect_type
|
||||
integer(psb_ipk_), intent(in) :: ictxt,icomm,flag
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_i_base_vect_type) :: y
|
||||
integer(psb_ipk_) :: beta
|
||||
integer(psb_ipk_),target :: work(:)
|
||||
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv
|
||||
integer(psb_ipk_) :: beta
|
||||
integer(psb_ipk_),target :: work(:)
|
||||
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv
|
||||
end subroutine psi_itranidx_vect
|
||||
end interface
|
||||
|
||||
interface psi_ovrl_upd
|
||||
subroutine psi_iovrl_updr1(x,desc_a,update,info)
|
||||
import :: psb_desc_type, psb_ipk_
|
||||
integer(psb_ipk_), intent(inout), target :: x(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(in) :: update
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
import :: psb_desc_type, psb_ipk_, psb_ipk_, psb_i_base_vect_type
|
||||
integer(psb_ipk_), intent(inout), target :: x(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(in) :: update
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psi_iovrl_updr1
|
||||
subroutine psi_iovrl_updr2(x,desc_a,update,info)
|
||||
import :: psb_desc_type, psb_ipk_
|
||||
integer(psb_ipk_), intent(inout), target :: x(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(in) :: update
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
import :: psb_desc_type, psb_ipk_, psb_ipk_, psb_i_base_vect_type
|
||||
integer(psb_ipk_), intent(inout), target :: x(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(in) :: update
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psi_iovrl_updr2
|
||||
subroutine psi_iovrl_upd_vect(x,desc_a,update,info)
|
||||
import :: psb_desc_type, psb_ipk_, psb_i_base_vect_type
|
||||
import :: psb_desc_type, psb_ipk_, psb_ipk_, psb_i_base_vect_type
|
||||
class(psb_i_base_vect_type) :: x
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(in) :: update
|
||||
@@ -349,23 +339,23 @@ module psi_i_mod
|
||||
|
||||
interface psi_ovrl_save
|
||||
subroutine psi_iovrl_saver1(x,xs,desc_a,info)
|
||||
import :: psb_desc_type, psb_ipk_
|
||||
integer(psb_ipk_), intent(inout) :: x(:)
|
||||
integer(psb_ipk_), allocatable :: xs(:)
|
||||
import :: psb_desc_type, psb_ipk_, psb_ipk_, psb_i_base_vect_type
|
||||
integer(psb_ipk_), intent(inout) :: x(:)
|
||||
integer(psb_ipk_), allocatable :: xs(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psi_iovrl_saver1
|
||||
subroutine psi_iovrl_saver2(x,xs,desc_a,info)
|
||||
import :: psb_desc_type, psb_ipk_
|
||||
integer(psb_ipk_), intent(inout) :: x(:,:)
|
||||
integer(psb_ipk_), allocatable :: xs(:,:)
|
||||
import :: psb_desc_type, psb_ipk_, psb_ipk_, psb_i_base_vect_type
|
||||
integer(psb_ipk_), intent(inout) :: x(:,:)
|
||||
integer(psb_ipk_), allocatable :: xs(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psi_iovrl_saver2
|
||||
subroutine psi_iovrl_save_vect(x,xs,desc_a,info)
|
||||
import :: psb_desc_type, psb_ipk_, psb_i_base_vect_type
|
||||
import :: psb_desc_type, psb_ipk_, psb_ipk_, psb_i_base_vect_type
|
||||
class(psb_i_base_vect_type) :: x
|
||||
integer(psb_ipk_), allocatable :: xs(:)
|
||||
integer(psb_ipk_), allocatable :: xs(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psi_iovrl_save_vect
|
||||
@@ -373,23 +363,23 @@ module psi_i_mod
|
||||
|
||||
interface psi_ovrl_restore
|
||||
subroutine psi_iovrl_restrr1(x,xs,desc_a,info)
|
||||
import :: psb_desc_type, psb_ipk_
|
||||
integer(psb_ipk_), intent(inout) :: x(:)
|
||||
integer(psb_ipk_) :: xs(:)
|
||||
import :: psb_desc_type, psb_ipk_, psb_ipk_, psb_i_base_vect_type
|
||||
integer(psb_ipk_), intent(inout) :: x(:)
|
||||
integer(psb_ipk_) :: xs(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psi_iovrl_restrr1
|
||||
subroutine psi_iovrl_restrr2(x,xs,desc_a,info)
|
||||
import :: psb_desc_type, psb_ipk_
|
||||
integer(psb_ipk_), intent(inout) :: x(:,:)
|
||||
integer(psb_ipk_) :: xs(:,:)
|
||||
import :: psb_desc_type, psb_ipk_, psb_ipk_, psb_i_base_vect_type
|
||||
integer(psb_ipk_), intent(inout) :: x(:,:)
|
||||
integer(psb_ipk_) :: xs(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psi_iovrl_restrr2
|
||||
subroutine psi_iovrl_restr_vect(x,xs,desc_a,info)
|
||||
import :: psb_desc_type, psb_ipk_, psb_i_base_vect_type
|
||||
import :: psb_desc_type, psb_ipk_, psb_ipk_, psb_i_base_vect_type
|
||||
class(psb_i_base_vect_type) :: x
|
||||
integer(psb_ipk_) :: xs(:)
|
||||
integer(psb_ipk_) :: xs(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psi_iovrl_restr_vect
|
||||
|
||||
@@ -33,6 +33,7 @@ module psi_s_mod
|
||||
use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_spk_, psb_i_base_vect_type
|
||||
use psb_s_vect_mod, only : psb_s_base_vect_type
|
||||
|
||||
|
||||
interface psi_swapdata
|
||||
subroutine psi_sswapdatam(flag,n,beta,y,desc_a,work,info,data)
|
||||
import :: psb_desc_type, psb_ipk_, psb_spk_, psb_s_base_vect_type
|
||||
|
||||
@@ -33,6 +33,7 @@ module psi_z_mod
|
||||
use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_dpk_, psb_i_base_vect_type
|
||||
use psb_z_vect_mod, only : psb_z_base_vect_type
|
||||
|
||||
|
||||
interface psi_swapdata
|
||||
subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data)
|
||||
import :: psb_desc_type, psb_ipk_, psb_dpk_, psb_z_base_vect_type
|
||||
|
||||
+3303
-3309
File diff suppressed because it is too large
Load Diff
+1
-1
@@ -138,7 +138,7 @@ PDF = $(join $(BASEFILE),.pdf)
|
||||
PS = $(join $(BASEFILE),.ps)
|
||||
GXS = $(join $(BASEFILE),.gxs)
|
||||
GLX = $(join $(BASEFILE),.glx)
|
||||
TARGETPDF= ../psblas-3.2.pdf
|
||||
TARGETPDF= ../psblas-3.4.pdf
|
||||
BASEHTML = $(patsubst %.tex,%,$(HTMLFILE))
|
||||
HTML = $(join $(HTMLFILE),.html)
|
||||
HTMLDIR = ../html
|
||||
|
||||
@@ -13,9 +13,9 @@ routines not tied to a discretization space see~\ref{sec:toolsrout}.
|
||||
|
||||
|
||||
These subroutines gathers the values of the halo
|
||||
elements, and (optionally) scale the result:
|
||||
elements:
|
||||
|
||||
\[ x \leftarrow \alpha x \]
|
||||
\[ x \leftarrow x \]
|
||||
where:
|
||||
\begin{description}
|
||||
\item[$x$] is a global dense submatrix.
|
||||
@@ -40,7 +40,7 @@ Long Precision Complex & psb\_halo \\
|
||||
|
||||
\begin{lstlisting}
|
||||
call psb_halo(x, desc_a, info)
|
||||
call psb_halo(x, desc_a, info, alpha, work, data)
|
||||
call psb_halo(x, desc_a, info, work, data)
|
||||
\end{lstlisting}
|
||||
|
||||
\begin{description}
|
||||
@@ -58,12 +58,6 @@ Scope: {\bf local} \\
|
||||
Type: {\bf required}\\
|
||||
Intent: {\bf in}.\\
|
||||
Specified as: a structured data of type \descdata.
|
||||
\item[alpha] the scalar $\alpha$.\\
|
||||
Scope: {\bf global} \\
|
||||
Type: {\bf optional} \\
|
||||
Intent: {\bf in}.\\
|
||||
Default: $alpha = 1 $\\
|
||||
Specified as: a number of the data type indicated in Table~\ref{tab:f90halo}.
|
||||
\item[work] the work array. \\
|
||||
Scope: {\bf local} \\
|
||||
Type: {\bf optional}\\
|
||||
|
||||
@@ -25,7 +25,7 @@
|
||||
\relax
|
||||
\pdfcompresslevel=0 %-- 0 = none, 9 = best
|
||||
\pdfinfo{ %-- Info dictionary of PDF output /Author (Alfredo Buttari)
|
||||
/Title (Parallel Sparse BLAS V. 3.2)
|
||||
/Title (Parallel Sparse BLAS V. 3.4)
|
||||
/Subject (Parallel Sparse Basic Linear Algebra Subroutines)
|
||||
/Keywords (Computer Science Linear Algebra Fluid Dynamics Parallel Linux MPI PSBLAS Iterative Solvers Preconditioners)
|
||||
/Creator (pdfLaTeX)
|
||||
@@ -88,7 +88,7 @@
|
||||
|
||||
\begin{document}
|
||||
|
||||
\pdfbookmark{PSBLAS-v3.2 User's Guide}{title}
|
||||
\pdfbookmark{PSBLAS-v3.4 User's Guide}{title}
|
||||
\lstset{language=Fortran}
|
||||
\newlength{\centeroffset}
|
||||
\setlength{\centeroffset}{-0.5\oddsidemargin}
|
||||
@@ -98,7 +98,7 @@
|
||||
\vspace*{\stretch{1}}
|
||||
\noindent\hspace*{\centeroffset}\makebox[0pt][l]{\begin{minipage}{\textwidth}
|
||||
\flushright
|
||||
{\Huge\bfseries PSBLAS 3.2 User's guide
|
||||
{\Huge\bfseries PSBLAS 3.4 User's guide
|
||||
}
|
||||
\noindent\rule[-1ex]{\textwidth}{5pt}\\[2.5ex]
|
||||
\hfill\emph{\Large A reference guide for the Parallel Sparse BLAS library}
|
||||
@@ -111,7 +111,7 @@
|
||||
by Salvatore Filippone\\
|
||||
and Alfredo Buttari}\\
|
||||
University of Rome ``Tor Vergata''.\\[3ex]
|
||||
March 31st, 2014.
|
||||
April 30, 2015.
|
||||
\end{minipage}}
|
||||
|
||||
%\addtolength{\textwidth}{\centeroffset}
|
||||
|
||||
@@ -24,7 +24,7 @@
|
||||
% \relax
|
||||
% \pdfcompresslevel=0 %-- 0 = none, 9 = best
|
||||
% \pdfinfo{ %-- Info dictionary of PDF output /Author (Alfredo Buttari)
|
||||
% /Title (Parallel Sparse BLAS V. 3.2)
|
||||
% /Title (Parallel Sparse BLAS V. 3.4)
|
||||
% /Subject (Parallel Sparse Basic Linear Algebra Subroutines)
|
||||
% /Keywords (Computer Science Linear Algebra Fluid Dynamics Parallel Linux MPI PSBLAS Iterative Solvers Preconditioners)
|
||||
% /Creator (pdfLaTeX)
|
||||
@@ -94,9 +94,9 @@
|
||||
University of Rome ``Tor Vergata'', Italy\\[2ex]
|
||||
%\\[10ex]
|
||||
%\today
|
||||
Software version: 3.2\\
|
||||
Software version: 3.4\\
|
||||
%\today
|
||||
March 31st, 2014.
|
||||
April 30, 2015.
|
||||
\cleardoublepage
|
||||
\begingroup
|
||||
\renewcommand*{\thepage}{toc}
|
||||
|
||||
Reference in New Issue
Block a user