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

psblas3:

Browse Source 
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.
psblas-3.4-maint
Salvatore Filippone 11 years ago
parent 41bd66df18
commit 25aa88d358
35 changed files with 5912 additions and 7508 deletions
Show Stats Download Patch File Download Diff File

31
base/comm/psb_chalo.f90
Unescape Escape View File

@ -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

31
base/comm/psb_dhalo.f90
Unescape Escape View File

@ -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

31
base/comm/psb_ihalo.f90
Unescape Escape View File

@ -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

31
base/comm/psb_shalo.f90
Unescape Escape View File

@ -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

31
base/comm/psb_zhalo.f90
Unescape Escape View File

@ -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

93
base/modules/psb_c_base_vect_mod.f90
Unescape Escape View File

@ -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,6 +670,36 @@ contains
end subroutine c_base_set_scal
!
!> Function base_set_vect
!! \memberof psb_c_base_vect_type
!! \brief Set all entries
!! \param val(:) The vector to be copied in
!!
subroutine c_base_set_vect(x,val,first,last)
class(psb_c_base_vect_type), intent(inout) :: x
complex(psb_spk_), intent(in) :: val(:)
integer(psb_ipk_), optional :: first, last
integer(psb_ipk_) :: info, first_, last_, nr
first_=1
last_=min(psb_size(x%v),size(val))
if (present(first)) first_ = max(1,first)
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
end if
call x%set_host()
end subroutine c_base_set_vect
!
! Overwrite with absolute value
!
@ -680,7 +712,7 @@ contains
class(psb_c_base_vect_type), intent(inout) :: x
if (allocated(x%v)) then
if (.not.x%is_host()) call x%sync()
if (x%is_dev()) call x%sync()
x%v = abs(x%v)
call x%set_host()
end if
@ -693,40 +725,12 @@ contains
if (.not.x%is_host()) call x%sync()
if (allocated(x%v)) then
call y%bld(x%v)
call y%axpby(min(x%get_nrows(),y%get_nrows()),cone,x,czero,info)
call y%absval()
call y%set_host()
end if
end subroutine c_base_absval2
!
!> Function base_set_vect
!! \memberof psb_c_base_vect_type
!! \brief Set all entries
!! \param val(:) The vector to be copied in
!!
subroutine c_base_set_vect(x,val,first,last)
class(psb_c_base_vect_type), intent(inout) :: x
complex(psb_spk_), intent(in) :: val(:)
integer(psb_ipk_), optional :: first, last
integer(psb_ipk_) :: info, first_, last_, nr
first_=1
last_=min(psb_size(x%v),size(val))
if (present(first)) first_ = max(1,first)
if (present(last)) last_ = min(last,last_)
if (allocated(x%v)) then
x%v(first_:last_) = val(1:last_-first_+1)
else
x%v = val
end if
call x%set_host()
end subroutine c_base_set_vect
!
! 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

68
base/modules/psb_c_comm_mod.f90
Unescape Escape View File

@ -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

156
base/modules/psb_c_tools_mod.f90
Unescape Escape View File

@ -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

876
base/modules/psb_c_vect_mod.F90
Unescape Escape View File

@ -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,197 +707,12 @@ 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)
end module psb_c_vect_mod
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
module psb_c_multivect_mod
module psb_c_multivect_mod
use psb_c_base_multivect_mod
use psb_const_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,214 +972,6 @@ contains
if (allocated(x%v)) res = x%v%get_fmt()
end function c_vect_get_fmt
!!$ function c_vect_dot_v(n,x,y) result(res)
!!$ implicit none
!!$ class(psb_c_multivect_type), intent(inout) :: x, y
!!$ integer(psb_ipk_), intent(in) :: n
!!$ complex(psb_spk_) :: res
!!$
!!$ res = czero
!!$ if (allocated(x%v).and.allocated(y%v)) &
!!$ & res = x%v%dot(n,y%v)
!!$
!!$ end function c_vect_dot_v
!!$
!!$ function c_vect_dot_a(n,x,y) result(res)
!!$ implicit none
!!$ class(psb_c_multivect_type), intent(inout) :: x
!!$ complex(psb_spk_), intent(in) :: y(:)
!!$ integer(psb_ipk_), intent(in) :: n
!!$ complex(psb_spk_) :: res
!!$
!!$ res = czero
!!$ if (allocated(x%v)) &
!!$ & res = x%v%dot(n,y)
!!$
!!$ end function c_vect_dot_a
!!$
!!$ subroutine c_vect_axpby_v(m,alpha, x, beta, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ integer(psb_ipk_), intent(in) :: m
!!$ class(psb_c_multivect_type), intent(inout) :: x
!!$ class(psb_c_multivect_type), intent(inout) :: y
!!$ complex(psb_spk_), 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 c_vect_axpby_v
!!$
!!$ subroutine c_vect_axpby_a(m,alpha, x, beta, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ integer(psb_ipk_), intent(in) :: m
!!$ complex(psb_spk_), intent(in) :: x(:)
!!$ class(psb_c_multivect_type), intent(inout) :: y
!!$ complex(psb_spk_), 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 c_vect_axpby_a
!!$
!!$
!!$ subroutine c_vect_mlt_v(x, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ class(psb_c_multivect_type), intent(inout) :: x
!!$ class(psb_c_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 c_vect_mlt_v
!!$
!!$ subroutine c_vect_mlt_a(x, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ complex(psb_spk_), intent(in) :: x(:)
!!$ class(psb_c_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 c_vect_mlt_a
!!$
!!$
!!$ subroutine c_vect_mlt_a_2(alpha,x,y,beta,z,info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ complex(psb_spk_), intent(in) :: alpha,beta
!!$ complex(psb_spk_), intent(in) :: y(:)
!!$ complex(psb_spk_), intent(in) :: x(:)
!!$ class(psb_c_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 c_vect_mlt_a_2
!!$
!!$ subroutine c_vect_mlt_v_2(alpha,x,y,beta,z,info,conjgx,conjgy)
!!$ use psi_serial_mod
!!$ implicit none
!!$ complex(psb_spk_), intent(in) :: alpha,beta
!!$ class(psb_c_multivect_type), intent(inout) :: x
!!$ class(psb_c_multivect_type), intent(inout) :: y
!!$ class(psb_c_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 c_vect_mlt_v_2
!!$
!!$ subroutine c_vect_mlt_av(alpha,x,y,beta,z,info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ complex(psb_spk_), intent(in) :: alpha,beta
!!$ complex(psb_spk_), intent(in) :: x(:)
!!$ class(psb_c_multivect_type), intent(inout) :: y
!!$ class(psb_c_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 c_vect_mlt_av
!!$
!!$ subroutine c_vect_mlt_va(alpha,x,y,beta,z,info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ complex(psb_spk_), intent(in) :: alpha,beta
!!$ complex(psb_spk_), intent(in) :: y(:)
!!$ class(psb_c_multivect_type), intent(inout) :: x
!!$ class(psb_c_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 c_vect_mlt_va
!!$
!!$ subroutine c_vect_scal(alpha, x)
!!$ use psi_serial_mod
!!$ implicit none
!!$ class(psb_c_multivect_type), intent(inout) :: x
!!$ complex(psb_spk_), intent (in) :: alpha
!!$
!!$ if (allocated(x%v)) call x%v%scal(alpha)
!!$
!!$ end subroutine c_vect_scal
!!$
!!$
!!$ function c_vect_nrm2(n,x) result(res)
!!$ implicit none
!!$ class(psb_c_multivect_type), intent(inout) :: x
!!$ integer(psb_ipk_), intent(in) :: n
!!$ real(psb_spk_) :: res
!!$
!!$ if (allocated(x%v)) then
!!$ res = x%v%nrm2(n)
!!$ else
!!$ res = szero
!!$ end if
!!$
!!$ end function c_vect_nrm2
!!$
!!$ function c_vect_amax(n,x) result(res)
!!$ implicit none
!!$ class(psb_c_multivect_type), intent(inout) :: x
!!$ integer(psb_ipk_), intent(in) :: n
!!$ real(psb_spk_) :: res
!!$
!!$ if (allocated(x%v)) then
!!$ res = x%v%amax(n)
!!$ else
!!$ res = szero
!!$ end if
!!$
!!$ end function c_vect_amax
!!$
!!$ function c_vect_asum(n,x) result(res)
!!$ implicit none
!!$ class(psb_c_multivect_type), intent(inout) :: x
!!$ integer(psb_ipk_), intent(in) :: n
!!$ real(psb_spk_) :: res
!!$
!!$ if (allocated(x%v)) then
!!$ res = x%v%asum(n)
!!$ else
!!$ res = szero
!!$ end if
!!$
!!$ end function c_vect_asum
subroutine c_vect_all(m,n, x, info, mold)
implicit none
@ -1341,4 +1134,213 @@ contains
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
!!$ integer(psb_ipk_), intent(in) :: n
!!$ complex(psb_spk_) :: res
!!$
!!$ res = czero
!!$ if (allocated(x%v).and.allocated(y%v)) &
!!$ & res = x%v%dot(n,y%v)
!!$
!!$ end function c_vect_dot_v
!!$
!!$ function c_vect_dot_a(n,x,y) result(res)
!!$ implicit none
!!$ class(psb_c_multivect_type), intent(inout) :: x
!!$ complex(psb_spk_), intent(in) :: y(:)
!!$ integer(psb_ipk_), intent(in) :: n
!!$ complex(psb_spk_) :: res
!!$
!!$ res = czero
!!$ if (allocated(x%v)) &
!!$ & res = x%v%dot(n,y)
!!$
!!$ end function c_vect_dot_a
!!$
!!$ subroutine c_vect_axpby_v(m,alpha, x, beta, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ integer(psb_ipk_), intent(in) :: m
!!$ class(psb_c_multivect_type), intent(inout) :: x
!!$ class(psb_c_multivect_type), intent(inout) :: y
!!$ complex(psb_spk_), 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 c_vect_axpby_v
!!$
!!$ subroutine c_vect_axpby_a(m,alpha, x, beta, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ integer(psb_ipk_), intent(in) :: m
!!$ complex(psb_spk_), intent(in) :: x(:)
!!$ class(psb_c_multivect_type), intent(inout) :: y
!!$ complex(psb_spk_), 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 c_vect_axpby_a
!!$
!!$
!!$ subroutine c_vect_mlt_v(x, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ class(psb_c_multivect_type), intent(inout) :: x
!!$ class(psb_c_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 c_vect_mlt_v
!!$
!!$ subroutine c_vect_mlt_a(x, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ complex(psb_spk_), intent(in) :: x(:)
!!$ class(psb_c_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 c_vect_mlt_a
!!$
!!$
!!$ subroutine c_vect_mlt_a_2(alpha,x,y,beta,z,info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ complex(psb_spk_), intent(in) :: alpha,beta
!!$ complex(psb_spk_), intent(in) :: y(:)
!!$ complex(psb_spk_), intent(in) :: x(:)
!!$ class(psb_c_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 c_vect_mlt_a_2
!!$
!!$ subroutine c_vect_mlt_v_2(alpha,x,y,beta,z,info,conjgx,conjgy)
!!$ use psi_serial_mod
!!$ implicit none
!!$ complex(psb_spk_), intent(in) :: alpha,beta
!!$ class(psb_c_multivect_type), intent(inout) :: x
!!$ class(psb_c_multivect_type), intent(inout) :: y
!!$ class(psb_c_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 c_vect_mlt_v_2
!!$
!!$ subroutine c_vect_mlt_av(alpha,x,y,beta,z,info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ complex(psb_spk_), intent(in) :: alpha,beta
!!$ complex(psb_spk_), intent(in) :: x(:)
!!$ class(psb_c_multivect_type), intent(inout) :: y
!!$ class(psb_c_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 c_vect_mlt_av
!!$
!!$ subroutine c_vect_mlt_va(alpha,x,y,beta,z,info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ complex(psb_spk_), intent(in) :: alpha,beta
!!$ complex(psb_spk_), intent(in) :: y(:)
!!$ class(psb_c_multivect_type), intent(inout) :: x
!!$ class(psb_c_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 c_vect_mlt_va
!!$
!!$ subroutine c_vect_scal(alpha, x)
!!$ use psi_serial_mod
!!$ implicit none
!!$ class(psb_c_multivect_type), intent(inout) :: x
!!$ complex(psb_spk_), intent (in) :: alpha
!!$
!!$ if (allocated(x%v)) call x%v%scal(alpha)
!!$
!!$ end subroutine c_vect_scal
!!$
!!$
!!$ function c_vect_nrm2(n,x) result(res)
!!$ implicit none
!!$ class(psb_c_multivect_type), intent(inout) :: x
!!$ integer(psb_ipk_), intent(in) :: n
!!$ real(psb_spk_) :: res
!!$
!!$ if (allocated(x%v)) then
!!$ res = x%v%nrm2(n)
!!$ else
!!$ res = szero
!!$ end if
!!$
!!$ end function c_vect_nrm2
!!$
!!$ function c_vect_amax(n,x) result(res)
!!$ implicit none
!!$ class(psb_c_multivect_type), intent(inout) :: x
!!$ integer(psb_ipk_), intent(in) :: n
!!$ real(psb_spk_) :: res
!!$
!!$ if (allocated(x%v)) then
!!$ res = x%v%amax(n)
!!$ else
!!$ res = szero
!!$ end if
!!$
!!$ end function c_vect_amax
!!$
!!$ function c_vect_asum(n,x) result(res)
!!$ implicit none
!!$ class(psb_c_multivect_type), intent(inout) :: x
!!$ integer(psb_ipk_), intent(in) :: n
!!$ real(psb_spk_) :: res
!!$
!!$ if (allocated(x%v)) then
!!$ res = x%v%asum(n)
!!$ else
!!$ res = szero
!!$ end if
!!$
!!$ end function c_vect_asum
end module psb_c_multivect_mod

93
base/modules/psb_d_base_vect_mod.f90
Unescape Escape View File

@ -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,6 +670,36 @@ contains
end subroutine d_base_set_scal
!
!> Function base_set_vect
!! \memberof psb_d_base_vect_type
!! \brief Set all entries
!! \param val(:) The vector to be copied in
!!
subroutine d_base_set_vect(x,val,first,last)
class(psb_d_base_vect_type), intent(inout) :: x
real(psb_dpk_), intent(in) :: val(:)
integer(psb_ipk_), optional :: first, last
integer(psb_ipk_) :: info, first_, last_, nr
first_=1
last_=min(psb_size(x%v),size(val))
if (present(first)) first_ = max(1,first)
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
end if
call x%set_host()
end subroutine d_base_set_vect
!
! Overwrite with absolute value
!
@ -680,7 +712,7 @@ contains
class(psb_d_base_vect_type), intent(inout) :: x
if (allocated(x%v)) then
if (.not.x%is_host()) call x%sync()
if (x%is_dev()) call x%sync()
x%v = abs(x%v)
call x%set_host()
end if
@ -693,40 +725,12 @@ contains
if (.not.x%is_host()) call x%sync()
if (allocated(x%v)) then
call y%bld(x%v)
call y%axpby(min(x%get_nrows(),y%get_nrows()),done,x,dzero,info)
call y%absval()
call y%set_host()
end if
end subroutine d_base_absval2
!
!> Function base_set_vect
!! \memberof psb_d_base_vect_type
!! \brief Set all entries
!! \param val(:) The vector to be copied in
!!
subroutine d_base_set_vect(x,val,first,last)
class(psb_d_base_vect_type), intent(inout) :: x
real(psb_dpk_), intent(in) :: val(:)
integer(psb_ipk_), optional :: first, last
integer(psb_ipk_) :: info, first_, last_, nr
first_=1
last_=min(psb_size(x%v),size(val))
if (present(first)) first_ = max(1,first)
if (present(last)) last_ = min(last,last_)
if (allocated(x%v)) then
x%v(first_:last_) = val(1:last_-first_+1)
else
x%v = val
end if
call x%set_host()
end subroutine d_base_set_vect
!
! 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

68
base/modules/psb_d_comm_mod.f90
Unescape Escape View File

@ -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

156
base/modules/psb_d_tools_mod.f90
Unescape Escape View File

@ -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

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

@ -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,197 +707,12 @@ 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)
end module psb_d_vect_mod
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
module psb_d_multivect_mod
module psb_d_multivect_mod
use psb_d_base_multivect_mod
use psb_const_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,214 +972,6 @@ contains
if (allocated(x%v)) res = x%v%get_fmt()
end function d_vect_get_fmt
!!$ function d_vect_dot_v(n,x,y) result(res)
!!$ implicit none
!!$ class(psb_d_multivect_type), intent(inout) :: x, y
!!$ integer(psb_ipk_), intent(in) :: n
!!$ real(psb_dpk_) :: res
!!$
!!$ res = dzero
!!$ if (allocated(x%v).and.allocated(y%v)) &
!!$ & res = x%v%dot(n,y%v)
!!$
!!$ end function d_vect_dot_v
!!$
!!$ function d_vect_dot_a(n,x,y) result(res)
!!$ implicit none
!!$ class(psb_d_multivect_type), intent(inout) :: x
!!$ real(psb_dpk_), intent(in) :: y(:)
!!$ integer(psb_ipk_), intent(in) :: n
!!$ real(psb_dpk_) :: res
!!$
!!$ res = dzero
!!$ if (allocated(x%v)) &
!!$ & res = x%v%dot(n,y)
!!$
!!$ end function d_vect_dot_a
!!$
!!$ subroutine d_vect_axpby_v(m,alpha, x, beta, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ integer(psb_ipk_), intent(in) :: m
!!$ class(psb_d_multivect_type), intent(inout) :: x
!!$ class(psb_d_multivect_type), intent(inout) :: y
!!$ real(psb_dpk_), 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 d_vect_axpby_v
!!$
!!$ subroutine d_vect_axpby_a(m,alpha, x, beta, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ integer(psb_ipk_), intent(in) :: m
!!$ real(psb_dpk_), intent(in) :: x(:)
!!$ class(psb_d_multivect_type), intent(inout) :: y
!!$ real(psb_dpk_), 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 d_vect_axpby_a
!!$
!!$
!!$ subroutine d_vect_mlt_v(x, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ class(psb_d_multivect_type), intent(inout) :: x
!!$ class(psb_d_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 d_vect_mlt_v
!!$
!!$ subroutine d_vect_mlt_a(x, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ real(psb_dpk_), intent(in) :: x(:)
!!$ class(psb_d_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 d_vect_mlt_a
!!$
!!$
!!$ subroutine d_vect_mlt_a_2(alpha,x,y,beta,z,info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ real(psb_dpk_), intent(in) :: alpha,beta
!!$ real(psb_dpk_), intent(in) :: y(:)
!!$ real(psb_dpk_), intent(in) :: x(:)
!!$ class(psb_d_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 d_vect_mlt_a_2
!!$
!!$ subroutine d_vect_mlt_v_2(alpha,x,y,beta,z,info,conjgx,conjgy)
!!$ use psi_serial_mod
!!$ implicit none
!!$ real(psb_dpk_), intent(in) :: alpha,beta
!!$ class(psb_d_multivect_type), intent(inout) :: x
!!$ class(psb_d_multivect_type), intent(inout) :: y
!!$ class(psb_d_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 d_vect_mlt_v_2
!!$
!!$ subroutine d_vect_mlt_av(alpha,x,y,beta,z,info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ real(psb_dpk_), intent(in) :: alpha,beta
!!$ real(psb_dpk_), intent(in) :: x(:)
!!$ class(psb_d_multivect_type), intent(inout) :: y
!!$ class(psb_d_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 d_vect_mlt_av
!!$
!!$ subroutine d_vect_mlt_va(alpha,x,y,beta,z,info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ real(psb_dpk_), intent(in) :: alpha,beta
!!$ real(psb_dpk_), intent(in) :: y(:)
!!$ class(psb_d_multivect_type), intent(inout) :: x
!!$ class(psb_d_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 d_vect_mlt_va
!!$
!!$ subroutine d_vect_scal(alpha, x)
!!$ use psi_serial_mod
!!$ implicit none
!!$ class(psb_d_multivect_type), intent(inout) :: x
!!$ real(psb_dpk_), intent (in) :: alpha
!!$
!!$ if (allocated(x%v)) call x%v%scal(alpha)
!!$
!!$ end subroutine d_vect_scal
!!$
!!$
!!$ function d_vect_nrm2(n,x) result(res)
!!$ implicit none
!!$ class(psb_d_multivect_type), intent(inout) :: x
!!$ integer(psb_ipk_), intent(in) :: n
!!$ real(psb_dpk_) :: res
!!$
!!$ if (allocated(x%v)) then
!!$ res = x%v%nrm2(n)
!!$ else
!!$ res = dzero
!!$ end if
!!$
!!$ end function d_vect_nrm2
!!$
!!$ function d_vect_amax(n,x) result(res)
!!$ implicit none
!!$ class(psb_d_multivect_type), intent(inout) :: x
!!$ integer(psb_ipk_), intent(in) :: n
!!$ real(psb_dpk_) :: res
!!$
!!$ if (allocated(x%v)) then
!!$ res = x%v%amax(n)
!!$ else
!!$ res = dzero
!!$ end if
!!$
!!$ end function d_vect_amax
!!$
!!$ function d_vect_asum(n,x) result(res)
!!$ implicit none
!!$ class(psb_d_multivect_type), intent(inout) :: x
!!$ integer(psb_ipk_), intent(in) :: n
!!$ real(psb_dpk_) :: res
!!$
!!$ if (allocated(x%v)) then
!!$ res = x%v%asum(n)
!!$ else
!!$ res = dzero
!!$ end if
!!$
!!$ end function d_vect_asum
subroutine d_vect_all(m,n, x, info, mold)
implicit none
@ -1341,4 +1134,213 @@ contains
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
!!$ integer(psb_ipk_), intent(in) :: n
!!$ real(psb_dpk_) :: res
!!$
!!$ res = dzero
!!$ if (allocated(x%v).and.allocated(y%v)) &
!!$ & res = x%v%dot(n,y%v)
!!$
!!$ end function d_vect_dot_v
!!$
!!$ function d_vect_dot_a(n,x,y) result(res)
!!$ implicit none
!!$ class(psb_d_multivect_type), intent(inout) :: x
!!$ real(psb_dpk_), intent(in) :: y(:)
!!$ integer(psb_ipk_), intent(in) :: n
!!$ real(psb_dpk_) :: res
!!$
!!$ res = dzero
!!$ if (allocated(x%v)) &
!!$ & res = x%v%dot(n,y)
!!$
!!$ end function d_vect_dot_a
!!$
!!$ subroutine d_vect_axpby_v(m,alpha, x, beta, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ integer(psb_ipk_), intent(in) :: m
!!$ class(psb_d_multivect_type), intent(inout) :: x
!!$ class(psb_d_multivect_type), intent(inout) :: y
!!$ real(psb_dpk_), 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 d_vect_axpby_v
!!$
!!$ subroutine d_vect_axpby_a(m,alpha, x, beta, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ integer(psb_ipk_), intent(in) :: m
!!$ real(psb_dpk_), intent(in) :: x(:)
!!$ class(psb_d_multivect_type), intent(inout) :: y
!!$ real(psb_dpk_), 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 d_vect_axpby_a
!!$
!!$
!!$ subroutine d_vect_mlt_v(x, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ class(psb_d_multivect_type), intent(inout) :: x
!!$ class(psb_d_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 d_vect_mlt_v
!!$
!!$ subroutine d_vect_mlt_a(x, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ real(psb_dpk_), intent(in) :: x(:)
!!$ class(psb_d_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 d_vect_mlt_a
!!$
!!$
!!$ subroutine d_vect_mlt_a_2(alpha,x,y,beta,z,info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ real(psb_dpk_), intent(in) :: alpha,beta
!!$ real(psb_dpk_), intent(in) :: y(:)
!!$ real(psb_dpk_), intent(in) :: x(:)
!!$ class(psb_d_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 d_vect_mlt_a_2
!!$
!!$ subroutine d_vect_mlt_v_2(alpha,x,y,beta,z,info,conjgx,conjgy)
!!$ use psi_serial_mod
!!$ implicit none
!!$ real(psb_dpk_), intent(in) :: alpha,beta
!!$ class(psb_d_multivect_type), intent(inout) :: x
!!$ class(psb_d_multivect_type), intent(inout) :: y
!!$ class(psb_d_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 d_vect_mlt_v_2
!!$
!!$ subroutine d_vect_mlt_av(alpha,x,y,beta,z,info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ real(psb_dpk_), intent(in) :: alpha,beta
!!$ real(psb_dpk_), intent(in) :: x(:)
!!$ class(psb_d_multivect_type), intent(inout) :: y
!!$ class(psb_d_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 d_vect_mlt_av
!!$
!!$ subroutine d_vect_mlt_va(alpha,x,y,beta,z,info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ real(psb_dpk_), intent(in) :: alpha,beta
!!$ real(psb_dpk_), intent(in) :: y(:)
!!$ class(psb_d_multivect_type), intent(inout) :: x
!!$ class(psb_d_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 d_vect_mlt_va
!!$
!!$ subroutine d_vect_scal(alpha, x)
!!$ use psi_serial_mod
!!$ implicit none
!!$ class(psb_d_multivect_type), intent(inout) :: x
!!$ real(psb_dpk_), intent (in) :: alpha
!!$
!!$ if (allocated(x%v)) call x%v%scal(alpha)
!!$
!!$ end subroutine d_vect_scal
!!$
!!$
!!$ function d_vect_nrm2(n,x) result(res)
!!$ implicit none
!!$ class(psb_d_multivect_type), intent(inout) :: x
!!$ integer(psb_ipk_), intent(in) :: n
!!$ real(psb_dpk_) :: res
!!$
!!$ if (allocated(x%v)) then
!!$ res = x%v%nrm2(n)
!!$ else
!!$ res = dzero
!!$ end if
!!$
!!$ end function d_vect_nrm2
!!$
!!$ function d_vect_amax(n,x) result(res)
!!$ implicit none
!!$ class(psb_d_multivect_type), intent(inout) :: x
!!$ integer(psb_ipk_), intent(in) :: n
!!$ real(psb_dpk_) :: res
!!$
!!$ if (allocated(x%v)) then
!!$ res = x%v%amax(n)
!!$ else
!!$ res = dzero
!!$ end if
!!$
!!$ end function d_vect_amax
!!$
!!$ function d_vect_asum(n,x) result(res)
!!$ implicit none
!!$ class(psb_d_multivect_type), intent(inout) :: x
!!$ integer(psb_ipk_), intent(in) :: n
!!$ real(psb_dpk_) :: res
!!$
!!$ if (allocated(x%v)) then
!!$ res = x%v%asum(n)
!!$ else
!!$ res = dzero
!!$ end if
!!$
!!$ end function d_vect_asum
end module psb_d_multivect_mod

1022
base/modules/psb_i_base_vect_mod.f90
View File

File diff suppressed because it is too large Load Diff

73
base/modules/psb_i_comm_mod.f90
Unescape Escape View File

@ -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

139
base/modules/psb_i_tools_mod.f90
Unescape Escape View File

@ -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

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

@ -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
subroutine i_vect_all(n, x, info, mold)
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
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

93
base/modules/psb_s_base_vect_mod.f90
Unescape Escape View File

@ -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,6 +670,36 @@ contains
end subroutine s_base_set_scal
!
!> Function base_set_vect
!! \memberof psb_s_base_vect_type
!! \brief Set all entries
!! \param val(:) The vector to be copied in
!!
subroutine s_base_set_vect(x,val,first,last)
class(psb_s_base_vect_type), intent(inout) :: x
real(psb_spk_), intent(in) :: val(:)
integer(psb_ipk_), optional :: first, last
integer(psb_ipk_) :: info, first_, last_, nr
first_=1
last_=min(psb_size(x%v),size(val))
if (present(first)) first_ = max(1,first)
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
end if
call x%set_host()
end subroutine s_base_set_vect
!
! Overwrite with absolute value
!
@ -680,7 +712,7 @@ contains
class(psb_s_base_vect_type), intent(inout) :: x
if (allocated(x%v)) then
if (.not.x%is_host()) call x%sync()
if (x%is_dev()) call x%sync()
x%v = abs(x%v)
call x%set_host()
end if
@ -693,40 +725,12 @@ contains
if (.not.x%is_host()) call x%sync()
if (allocated(x%v)) then
call y%bld(x%v)
call y%axpby(min(x%get_nrows(),y%get_nrows()),sone,x,szero,info)
call y%absval()
call y%set_host()
end if
end subroutine s_base_absval2
!
!> Function base_set_vect
!! \memberof psb_s_base_vect_type
!! \brief Set all entries
!! \param val(:) The vector to be copied in
!!
subroutine s_base_set_vect(x,val,first,last)
class(psb_s_base_vect_type), intent(inout) :: x
real(psb_spk_), intent(in) :: val(:)
integer(psb_ipk_), optional :: first, last
integer(psb_ipk_) :: info, first_, last_, nr
first_=1
last_=min(psb_size(x%v),size(val))
if (present(first)) first_ = max(1,first)
if (present(last)) last_ = min(last,last_)
if (allocated(x%v)) then
x%v(first_:last_) = val(1:last_-first_+1)
else
x%v = val
end if
call x%set_host()
end subroutine s_base_set_vect
!
! 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

68
base/modules/psb_s_comm_mod.f90
Unescape Escape View File

@ -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

156
base/modules/psb_s_tools_mod.f90
Unescape Escape View File

@ -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

876
base/modules/psb_s_vect_mod.F90
Unescape Escape View File

@ -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,197 +707,12 @@ 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)
end module psb_s_vect_mod
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
module psb_s_multivect_mod
module psb_s_multivect_mod
use psb_s_base_multivect_mod
use psb_const_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,214 +972,6 @@ contains
if (allocated(x%v)) res = x%v%get_fmt()
end function s_vect_get_fmt
!!$ function s_vect_dot_v(n,x,y) result(res)
!!$ implicit none
!!$ class(psb_s_multivect_type), intent(inout) :: x, y
!!$ integer(psb_ipk_), intent(in) :: n
!!$ real(psb_spk_) :: res
!!$
!!$ res = szero
!!$ if (allocated(x%v).and.allocated(y%v)) &
!!$ & res = x%v%dot(n,y%v)
!!$
!!$ end function s_vect_dot_v
!!$
!!$ function s_vect_dot_a(n,x,y) result(res)
!!$ implicit none
!!$ class(psb_s_multivect_type), intent(inout) :: x
!!$ real(psb_spk_), intent(in) :: y(:)
!!$ integer(psb_ipk_), intent(in) :: n
!!$ real(psb_spk_) :: res
!!$
!!$ res = szero
!!$ if (allocated(x%v)) &
!!$ & res = x%v%dot(n,y)
!!$
!!$ end function s_vect_dot_a
!!$
!!$ subroutine s_vect_axpby_v(m,alpha, x, beta, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ integer(psb_ipk_), intent(in) :: m
!!$ class(psb_s_multivect_type), intent(inout) :: x
!!$ class(psb_s_multivect_type), intent(inout) :: y
!!$ real(psb_spk_), 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 s_vect_axpby_v
!!$
!!$ subroutine s_vect_axpby_a(m,alpha, x, beta, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ integer(psb_ipk_), intent(in) :: m
!!$ real(psb_spk_), intent(in) :: x(:)
!!$ class(psb_s_multivect_type), intent(inout) :: y
!!$ real(psb_spk_), 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 s_vect_axpby_a
!!$
!!$
!!$ subroutine s_vect_mlt_v(x, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ class(psb_s_multivect_type), intent(inout) :: x
!!$ class(psb_s_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 s_vect_mlt_v
!!$
!!$ subroutine s_vect_mlt_a(x, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ real(psb_spk_), intent(in) :: x(:)
!!$ class(psb_s_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 s_vect_mlt_a
!!$
!!$
!!$ subroutine s_vect_mlt_a_2(alpha,x,y,beta,z,info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ real(psb_spk_), intent(in) :: alpha,beta
!!$ real(psb_spk_), intent(in) :: y(:)
!!$ real(psb_spk_), intent(in) :: x(:)
!!$ class(psb_s_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 s_vect_mlt_a_2
!!$
!!$ subroutine s_vect_mlt_v_2(alpha,x,y,beta,z,info,conjgx,conjgy)
!!$ use psi_serial_mod
!!$ implicit none
!!$ real(psb_spk_), intent(in) :: alpha,beta
!!$ class(psb_s_multivect_type), intent(inout) :: x
!!$ class(psb_s_multivect_type), intent(inout) :: y
!!$ class(psb_s_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 s_vect_mlt_v_2
!!$
!!$ subroutine s_vect_mlt_av(alpha,x,y,beta,z,info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ real(psb_spk_), intent(in) :: alpha,beta
!!$ real(psb_spk_), intent(in) :: x(:)
!!$ class(psb_s_multivect_type), intent(inout) :: y
!!$ class(psb_s_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 s_vect_mlt_av
!!$
!!$ subroutine s_vect_mlt_va(alpha,x,y,beta,z,info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ real(psb_spk_), intent(in) :: alpha,beta
!!$ real(psb_spk_), intent(in) :: y(:)
!!$ class(psb_s_multivect_type), intent(inout) :: x
!!$ class(psb_s_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 s_vect_mlt_va
!!$
!!$ subroutine s_vect_scal(alpha, x)
!!$ use psi_serial_mod
!!$ implicit none
!!$ class(psb_s_multivect_type), intent(inout) :: x
!!$ real(psb_spk_), intent (in) :: alpha
!!$
!!$ if (allocated(x%v)) call x%v%scal(alpha)
!!$
!!$ end subroutine s_vect_scal
!!$
!!$
!!$ function s_vect_nrm2(n,x) result(res)
!!$ implicit none
!!$ class(psb_s_multivect_type), intent(inout) :: x
!!$ integer(psb_ipk_), intent(in) :: n
!!$ real(psb_spk_) :: res
!!$
!!$ if (allocated(x%v)) then
!!$ res = x%v%nrm2(n)
!!$ else
!!$ res = szero
!!$ end if
!!$
!!$ end function s_vect_nrm2
!!$
!!$ function s_vect_amax(n,x) result(res)
!!$ implicit none
!!$ class(psb_s_multivect_type), intent(inout) :: x
!!$ integer(psb_ipk_), intent(in) :: n
!!$ real(psb_spk_) :: res
!!$
!!$ if (allocated(x%v)) then
!!$ res = x%v%amax(n)
!!$ else
!!$ res = szero
!!$ end if
!!$
!!$ end function s_vect_amax
!!$
!!$ function s_vect_asum(n,x) result(res)
!!$ implicit none
!!$ class(psb_s_multivect_type), intent(inout) :: x
!!$ integer(psb_ipk_), intent(in) :: n
!!$ real(psb_spk_) :: res
!!$
!!$ if (allocated(x%v)) then
!!$ res = x%v%asum(n)
!!$ else
!!$ res = szero
!!$ end if
!!$
!!$ end function s_vect_asum
subroutine s_vect_all(m,n, x, info, mold)
implicit none
@ -1341,4 +1134,213 @@ contains
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
!!$ integer(psb_ipk_), intent(in) :: n
!!$ real(psb_spk_) :: res
!!$
!!$ res = szero
!!$ if (allocated(x%v).and.allocated(y%v)) &
!!$ & res = x%v%dot(n,y%v)
!!$
!!$ end function s_vect_dot_v
!!$
!!$ function s_vect_dot_a(n,x,y) result(res)
!!$ implicit none
!!$ class(psb_s_multivect_type), intent(inout) :: x
!!$ real(psb_spk_), intent(in) :: y(:)
!!$ integer(psb_ipk_), intent(in) :: n
!!$ real(psb_spk_) :: res
!!$
!!$ res = szero
!!$ if (allocated(x%v)) &
!!$ & res = x%v%dot(n,y)
!!$
!!$ end function s_vect_dot_a
!!$
!!$ subroutine s_vect_axpby_v(m,alpha, x, beta, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ integer(psb_ipk_), intent(in) :: m
!!$ class(psb_s_multivect_type), intent(inout) :: x
!!$ class(psb_s_multivect_type), intent(inout) :: y
!!$ real(psb_spk_), 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 s_vect_axpby_v
!!$
!!$ subroutine s_vect_axpby_a(m,alpha, x, beta, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ integer(psb_ipk_), intent(in) :: m
!!$ real(psb_spk_), intent(in) :: x(:)
!!$ class(psb_s_multivect_type), intent(inout) :: y
!!$ real(psb_spk_), 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 s_vect_axpby_a
!!$
!!$
!!$ subroutine s_vect_mlt_v(x, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ class(psb_s_multivect_type), intent(inout) :: x
!!$ class(psb_s_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 s_vect_mlt_v
!!$
!!$ subroutine s_vect_mlt_a(x, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ real(psb_spk_), intent(in) :: x(:)
!!$ class(psb_s_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 s_vect_mlt_a
!!$
!!$
!!$ subroutine s_vect_mlt_a_2(alpha,x,y,beta,z,info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ real(psb_spk_), intent(in) :: alpha,beta
!!$ real(psb_spk_), intent(in) :: y(:)
!!$ real(psb_spk_), intent(in) :: x(:)
!!$ class(psb_s_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 s_vect_mlt_a_2
!!$
!!$ subroutine s_vect_mlt_v_2(alpha,x,y,beta,z,info,conjgx,conjgy)
!!$ use psi_serial_mod
!!$ implicit none
!!$ real(psb_spk_), intent(in) :: alpha,beta
!!$ class(psb_s_multivect_type), intent(inout) :: x
!!$ class(psb_s_multivect_type), intent(inout) :: y
!!$ class(psb_s_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 s_vect_mlt_v_2
!!$
!!$ subroutine s_vect_mlt_av(alpha,x,y,beta,z,info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ real(psb_spk_), intent(in) :: alpha,beta
!!$ real(psb_spk_), intent(in) :: x(:)
!!$ class(psb_s_multivect_type), intent(inout) :: y
!!$ class(psb_s_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 s_vect_mlt_av
!!$
!!$ subroutine s_vect_mlt_va(alpha,x,y,beta,z,info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ real(psb_spk_), intent(in) :: alpha,beta
!!$ real(psb_spk_), intent(in) :: y(:)
!!$ class(psb_s_multivect_type), intent(inout) :: x
!!$ class(psb_s_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 s_vect_mlt_va
!!$
!!$ subroutine s_vect_scal(alpha, x)
!!$ use psi_serial_mod
!!$ implicit none
!!$ class(psb_s_multivect_type), intent(inout) :: x
!!$ real(psb_spk_), intent (in) :: alpha
!!$
!!$ if (allocated(x%v)) call x%v%scal(alpha)
!!$
!!$ end subroutine s_vect_scal
!!$
!!$
!!$ function s_vect_nrm2(n,x) result(res)
!!$ implicit none
!!$ class(psb_s_multivect_type), intent(inout) :: x
!!$ integer(psb_ipk_), intent(in) :: n
!!$ real(psb_spk_) :: res
!!$
!!$ if (allocated(x%v)) then
!!$ res = x%v%nrm2(n)
!!$ else
!!$ res = szero
!!$ end if
!!$
!!$ end function s_vect_nrm2
!!$
!!$ function s_vect_amax(n,x) result(res)
!!$ implicit none
!!$ class(psb_s_multivect_type), intent(inout) :: x
!!$ integer(psb_ipk_), intent(in) :: n
!!$ real(psb_spk_) :: res
!!$
!!$ if (allocated(x%v)) then
!!$ res = x%v%amax(n)
!!$ else
!!$ res = szero
!!$ end if
!!$
!!$ end function s_vect_amax
!!$
!!$ function s_vect_asum(n,x) result(res)
!!$ implicit none
!!$ class(psb_s_multivect_type), intent(inout) :: x
!!$ integer(psb_ipk_), intent(in) :: n
!!$ real(psb_spk_) :: res
!!$
!!$ if (allocated(x%v)) then
!!$ res = x%v%asum(n)
!!$ else
!!$ res = szero
!!$ end if
!!$
!!$ end function s_vect_asum
end module psb_s_multivect_mod

93
base/modules/psb_z_base_vect_mod.f90
Unescape Escape View File

@ -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,6 +670,36 @@ contains
end subroutine z_base_set_scal
!
!> Function base_set_vect
!! \memberof psb_z_base_vect_type
!! \brief Set all entries
!! \param val(:) The vector to be copied in
!!
subroutine z_base_set_vect(x,val,first,last)
class(psb_z_base_vect_type), intent(inout) :: x
complex(psb_dpk_), intent(in) :: val(:)
integer(psb_ipk_), optional :: first, last
integer(psb_ipk_) :: info, first_, last_, nr
first_=1
last_=min(psb_size(x%v),size(val))
if (present(first)) first_ = max(1,first)
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
end if
call x%set_host()
end subroutine z_base_set_vect
!
! Overwrite with absolute value
!
@ -680,7 +712,7 @@ contains
class(psb_z_base_vect_type), intent(inout) :: x
if (allocated(x%v)) then
if (.not.x%is_host()) call x%sync()
if (x%is_dev()) call x%sync()
x%v = abs(x%v)
call x%set_host()
end if
@ -693,40 +725,12 @@ contains
if (.not.x%is_host()) call x%sync()
if (allocated(x%v)) then
call y%bld(x%v)
call y%axpby(min(x%get_nrows(),y%get_nrows()),zone,x,zzero,info)
call y%absval()
call y%set_host()
end if
end subroutine z_base_absval2
!
!> Function base_set_vect
!! \memberof psb_z_base_vect_type
!! \brief Set all entries
!! \param val(:) The vector to be copied in
!!
subroutine z_base_set_vect(x,val,first,last)
class(psb_z_base_vect_type), intent(inout) :: x
complex(psb_dpk_), intent(in) :: val(:)
integer(psb_ipk_), optional :: first, last
integer(psb_ipk_) :: info, first_, last_, nr
first_=1
last_=min(psb_size(x%v),size(val))
if (present(first)) first_ = max(1,first)
if (present(last)) last_ = min(last,last_)
if (allocated(x%v)) then
x%v(first_:last_) = val(1:last_-first_+1)
else
x%v = val
end if
call x%set_host()
end subroutine z_base_set_vect
!
! 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

68
base/modules/psb_z_comm_mod.f90
Unescape Escape View File

@ -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

156
base/modules/psb_z_tools_mod.f90
Unescape Escape View File

@ -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

876
base/modules/psb_z_vect_mod.F90
Unescape Escape View File

@ -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,197 +707,12 @@ 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)
end module psb_z_vect_mod
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
module psb_z_multivect_mod
module psb_z_multivect_mod
use psb_z_base_multivect_mod
use psb_const_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,214 +972,6 @@ contains
if (allocated(x%v)) res = x%v%get_fmt()
end function z_vect_get_fmt
!!$ function z_vect_dot_v(n,x,y) result(res)
!!$ implicit none
!!$ class(psb_z_multivect_type), intent(inout) :: x, y
!!$ integer(psb_ipk_), intent(in) :: n
!!$ complex(psb_dpk_) :: res
!!$
!!$ res = zzero
!!$ if (allocated(x%v).and.allocated(y%v)) &
!!$ & res = x%v%dot(n,y%v)
!!$
!!$ end function z_vect_dot_v
!!$
!!$ function z_vect_dot_a(n,x,y) result(res)
!!$ implicit none
!!$ class(psb_z_multivect_type), intent(inout) :: x
!!$ complex(psb_dpk_), intent(in) :: y(:)
!!$ integer(psb_ipk_), intent(in) :: n
!!$ complex(psb_dpk_) :: res
!!$
!!$ res = zzero
!!$ if (allocated(x%v)) &
!!$ & res = x%v%dot(n,y)
!!$
!!$ end function z_vect_dot_a
!!$
!!$ subroutine z_vect_axpby_v(m,alpha, x, beta, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ integer(psb_ipk_), intent(in) :: m
!!$ class(psb_z_multivect_type), intent(inout) :: x
!!$ class(psb_z_multivect_type), intent(inout) :: y
!!$ complex(psb_dpk_), 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 z_vect_axpby_v
!!$
!!$ subroutine z_vect_axpby_a(m,alpha, x, beta, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ integer(psb_ipk_), intent(in) :: m
!!$ complex(psb_dpk_), intent(in) :: x(:)
!!$ class(psb_z_multivect_type), intent(inout) :: y
!!$ complex(psb_dpk_), 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 z_vect_axpby_a
!!$
!!$
!!$ subroutine z_vect_mlt_v(x, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ class(psb_z_multivect_type), intent(inout) :: x
!!$ class(psb_z_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 z_vect_mlt_v
!!$
!!$ subroutine z_vect_mlt_a(x, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ complex(psb_dpk_), intent(in) :: x(:)
!!$ class(psb_z_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 z_vect_mlt_a
!!$
!!$
!!$ subroutine z_vect_mlt_a_2(alpha,x,y,beta,z,info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ complex(psb_dpk_), intent(in) :: alpha,beta
!!$ complex(psb_dpk_), intent(in) :: y(:)
!!$ complex(psb_dpk_), intent(in) :: x(:)
!!$ class(psb_z_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 z_vect_mlt_a_2
!!$
!!$ subroutine z_vect_mlt_v_2(alpha,x,y,beta,z,info,conjgx,conjgy)
!!$ use psi_serial_mod
!!$ implicit none
!!$ complex(psb_dpk_), intent(in) :: alpha,beta
!!$ class(psb_z_multivect_type), intent(inout) :: x
!!$ class(psb_z_multivect_type), intent(inout) :: y
!!$ class(psb_z_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 z_vect_mlt_v_2
!!$
!!$ subroutine z_vect_mlt_av(alpha,x,y,beta,z,info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ complex(psb_dpk_), intent(in) :: alpha,beta
!!$ complex(psb_dpk_), intent(in) :: x(:)
!!$ class(psb_z_multivect_type), intent(inout) :: y
!!$ class(psb_z_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 z_vect_mlt_av
!!$
!!$ subroutine z_vect_mlt_va(alpha,x,y,beta,z,info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ complex(psb_dpk_), intent(in) :: alpha,beta
!!$ complex(psb_dpk_), intent(in) :: y(:)
!!$ class(psb_z_multivect_type), intent(inout) :: x
!!$ class(psb_z_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 z_vect_mlt_va
!!$
!!$ subroutine z_vect_scal(alpha, x)
!!$ use psi_serial_mod
!!$ implicit none
!!$ class(psb_z_multivect_type), intent(inout) :: x
!!$ complex(psb_dpk_), intent (in) :: alpha
!!$
!!$ if (allocated(x%v)) call x%v%scal(alpha)
!!$
!!$ end subroutine z_vect_scal
!!$
!!$
!!$ function z_vect_nrm2(n,x) result(res)
!!$ implicit none
!!$ class(psb_z_multivect_type), intent(inout) :: x
!!$ integer(psb_ipk_), intent(in) :: n
!!$ real(psb_dpk_) :: res
!!$
!!$ if (allocated(x%v)) then
!!$ res = x%v%nrm2(n)
!!$ else
!!$ res = dzero
!!$ end if
!!$
!!$ end function z_vect_nrm2
!!$
!!$ function z_vect_amax(n,x) result(res)
!!$ implicit none
!!$ class(psb_z_multivect_type), intent(inout) :: x
!!$ integer(psb_ipk_), intent(in) :: n
!!$ real(psb_dpk_) :: res
!!$
!!$ if (allocated(x%v)) then
!!$ res = x%v%amax(n)
!!$ else
!!$ res = dzero
!!$ end if
!!$
!!$ end function z_vect_amax
!!$
!!$ function z_vect_asum(n,x) result(res)
!!$ implicit none
!!$ class(psb_z_multivect_type), intent(inout) :: x
!!$ integer(psb_ipk_), intent(in) :: n
!!$ real(psb_dpk_) :: res
!!$
!!$ if (allocated(x%v)) then
!!$ res = x%v%asum(n)
!!$ else
!!$ res = dzero
!!$ end if
!!$
!!$ end function z_vect_asum
subroutine z_vect_all(m,n, x, info, mold)
implicit none
@ -1341,4 +1134,213 @@ contains
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
!!$ integer(psb_ipk_), intent(in) :: n
!!$ complex(psb_dpk_) :: res
!!$
!!$ res = zzero
!!$ if (allocated(x%v).and.allocated(y%v)) &
!!$ & res = x%v%dot(n,y%v)
!!$
!!$ end function z_vect_dot_v
!!$
!!$ function z_vect_dot_a(n,x,y) result(res)
!!$ implicit none
!!$ class(psb_z_multivect_type), intent(inout) :: x
!!$ complex(psb_dpk_), intent(in) :: y(:)
!!$ integer(psb_ipk_), intent(in) :: n
!!$ complex(psb_dpk_) :: res
!!$
!!$ res = zzero
!!$ if (allocated(x%v)) &
!!$ & res = x%v%dot(n,y)
!!$
!!$ end function z_vect_dot_a
!!$
!!$ subroutine z_vect_axpby_v(m,alpha, x, beta, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ integer(psb_ipk_), intent(in) :: m
!!$ class(psb_z_multivect_type), intent(inout) :: x
!!$ class(psb_z_multivect_type), intent(inout) :: y
!!$ complex(psb_dpk_), 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 z_vect_axpby_v
!!$
!!$ subroutine z_vect_axpby_a(m,alpha, x, beta, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ integer(psb_ipk_), intent(in) :: m
!!$ complex(psb_dpk_), intent(in) :: x(:)
!!$ class(psb_z_multivect_type), intent(inout) :: y
!!$ complex(psb_dpk_), 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 z_vect_axpby_a
!!$
!!$
!!$ subroutine z_vect_mlt_v(x, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ class(psb_z_multivect_type), intent(inout) :: x
!!$ class(psb_z_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 z_vect_mlt_v
!!$
!!$ subroutine z_vect_mlt_a(x, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ complex(psb_dpk_), intent(in) :: x(:)
!!$ class(psb_z_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 z_vect_mlt_a
!!$
!!$
!!$ subroutine z_vect_mlt_a_2(alpha,x,y,beta,z,info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ complex(psb_dpk_), intent(in) :: alpha,beta
!!$ complex(psb_dpk_), intent(in) :: y(:)
!!$ complex(psb_dpk_), intent(in) :: x(:)
!!$ class(psb_z_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 z_vect_mlt_a_2
!!$
!!$ subroutine z_vect_mlt_v_2(alpha,x,y,beta,z,info,conjgx,conjgy)
!!$ use psi_serial_mod
!!$ implicit none
!!$ complex(psb_dpk_), intent(in) :: alpha,beta
!!$ class(psb_z_multivect_type), intent(inout) :: x
!!$ class(psb_z_multivect_type), intent(inout) :: y
!!$ class(psb_z_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 z_vect_mlt_v_2
!!$
!!$ subroutine z_vect_mlt_av(alpha,x,y,beta,z,info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ complex(psb_dpk_), intent(in) :: alpha,beta
!!$ complex(psb_dpk_), intent(in) :: x(:)
!!$ class(psb_z_multivect_type), intent(inout) :: y
!!$ class(psb_z_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 z_vect_mlt_av
!!$
!!$ subroutine z_vect_mlt_va(alpha,x,y,beta,z,info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ complex(psb_dpk_), intent(in) :: alpha,beta
!!$ complex(psb_dpk_), intent(in) :: y(:)
!!$ class(psb_z_multivect_type), intent(inout) :: x
!!$ class(psb_z_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 z_vect_mlt_va
!!$
!!$ subroutine z_vect_scal(alpha, x)
!!$ use psi_serial_mod
!!$ implicit none
!!$ class(psb_z_multivect_type), intent(inout) :: x
!!$ complex(psb_dpk_), intent (in) :: alpha
!!$
!!$ if (allocated(x%v)) call x%v%scal(alpha)
!!$
!!$ end subroutine z_vect_scal
!!$
!!$
!!$ function z_vect_nrm2(n,x) result(res)
!!$ implicit none
!!$ class(psb_z_multivect_type), intent(inout) :: x
!!$ integer(psb_ipk_), intent(in) :: n
!!$ real(psb_dpk_) :: res
!!$
!!$ if (allocated(x%v)) then
!!$ res = x%v%nrm2(n)
!!$ else
!!$ res = dzero
!!$ end if
!!$
!!$ end function z_vect_nrm2
!!$
!!$ function z_vect_amax(n,x) result(res)
!!$ implicit none
!!$ class(psb_z_multivect_type), intent(inout) :: x
!!$ integer(psb_ipk_), intent(in) :: n
!!$ real(psb_dpk_) :: res
!!$
!!$ if (allocated(x%v)) then
!!$ res = x%v%amax(n)
!!$ else
!!$ res = dzero
!!$ end if
!!$
!!$ end function z_vect_amax
!!$
!!$ function z_vect_asum(n,x) result(res)
!!$ implicit none
!!$ class(psb_z_multivect_type), intent(inout) :: x
!!$ integer(psb_ipk_), intent(in) :: n
!!$ real(psb_dpk_) :: res
!!$
!!$ if (allocated(x%v)) then
!!$ res = x%v%asum(n)
!!$ else
!!$ res = dzero
!!$ end if
!!$
!!$ end function z_vect_asum
end module psb_z_multivect_mod

1
base/modules/psi_c_mod.f90
Unescape Escape View File

@ -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

1
base/modules/psi_d_mod.f90
Unescape Escape View File

@ -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

164
base/modules/psi_i_mod.f90
Unescape Escape View File

@ -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

1
base/modules/psi_s_mod.f90
Unescape Escape View File

@ -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

1
base/modules/psi_z_mod.f90
Unescape Escape View File

@ -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

6566
docs/psblas-3.2.pdf → docs/psblas-3.4.pdf
View File

File diff suppressed because it is too large Load Diff

2
docs/src/Makefile
Unescape Escape View File

@ -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

12
docs/src/commrout.tex
Unescape Escape View File

@ -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}\\

8
docs/src/userguide.tex
Unescape Escape View File

@ -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}

6
docs/src/userhtml.tex
Unescape Escape View File

@ -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}

Write Preview
Loading…
Cancel
Save