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. ! x - complex,dimension(:,:). The local part of the dense matrix.
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! alpha - complex(optional). Scale factor.
! jx - integer(optional). The starting column of the global matrix. ! jx - integer(optional). The starting column of the global matrix.
! ik - integer(optional). The number of columns to gather. ! ik - integer(optional). The number of columns to gather.
! work - complex(optional). Work area. ! work - complex(optional). Work area.
@ -53,7 +52,7 @@
! psb_comm_mov_ use ovr_mst_idx ! 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 psb_base_mod, psb_protect_name => psb_chalom
use psi_mod use psi_mod
implicit none 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(:,:) complex(psb_spk_), intent(inout), target :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
complex(psb_spk_), intent(in), optional :: alpha
complex(psb_spk_), optional, target, intent(inout) :: work(:) complex(psb_spk_), optional, target, intent(inout) :: work(:)
integer(psb_ipk_), intent(in), optional :: mode,jx,ik,data integer(psb_ipk_), intent(in), optional :: mode,jx,ik,data
character, intent(in), optional :: tran 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) call psb_errcomm(ictxt,err)
if(err /= 0) goto 9999 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 liwork=nrow
if (present(work)) then if (present(work)) then
if(size(work) >= liwork) then if(size(work) >= liwork) then
@ -256,7 +246,6 @@ end subroutine psb_chalom
! x - real,dimension(:). The local part of the dense vector. ! x - real,dimension(:). The local part of the dense vector.
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! alpha - complex(optional). Scale factor.
! jx - integer(optional). The starting column of the global matrix. ! jx - integer(optional). The starting column of the global matrix.
! ik - integer(optional). The number of columns to gather. ! ik - integer(optional). The number of columns to gather.
! work - complex(optional). Work area. ! work - complex(optional). Work area.
@ -270,7 +259,7 @@ end subroutine psb_chalom
! psb_comm_mov_ use ovr_mst_idx ! 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 psb_base_mod, psb_protect_name => psb_chalov
use psi_mod use psi_mod
implicit none implicit none
@ -278,7 +267,6 @@ subroutine psb_chalov(x,desc_a,info,alpha,work,tran,mode,data)
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
complex(psb_spk_), intent(in), optional :: alpha
complex(psb_spk_), target, optional, intent(inout) :: work(:) complex(psb_spk_), target, optional, intent(inout) :: work(:)
integer(psb_ipk_), intent(in), optional :: mode,data integer(psb_ipk_), intent(in), optional :: mode,data
character, intent(in), optional :: tran 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) call psb_errcomm(ictxt,err)
if(err /= 0) goto 9999 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 liwork=nrow
if (present(work)) then if (present(work)) then
if(size(work) >= liwork) 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 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 psb_base_mod, psb_protect_name => psb_chalo_vect
use psi_mod use psi_mod
implicit none 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_c_vect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
complex(psb_spk_), intent(in), optional :: alpha
complex(psb_spk_), target, optional, intent(inout) :: work(:) complex(psb_spk_), target, optional, intent(inout) :: work(:)
integer(psb_ipk_), intent(in), optional :: mode,data integer(psb_ipk_), intent(in), optional :: mode,data
character, intent(in), optional :: tran 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) call psb_errcomm(ictxt,err)
if(err /= 0) goto 9999 if(err /= 0) goto 9999
if(present(alpha)) then
if(alpha /= cone) then
call x%scal(alpha)
end if
end if
liwork=nrow liwork=nrow
if (present(work)) then if (present(work)) then
if(size(work) >= liwork) 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. ! x - real,dimension(:,:). The local part of the dense matrix.
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! alpha - real(optional). Scale factor.
! jx - integer(optional). The starting column of the global matrix. ! jx - integer(optional). The starting column of the global matrix.
! ik - integer(optional). The number of columns to gather. ! ik - integer(optional). The number of columns to gather.
! work - real(optional). Work area. ! work - real(optional). Work area.
@ -53,7 +52,7 @@
! psb_comm_mov_ use ovr_mst_idx ! 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 psb_base_mod, psb_protect_name => psb_dhalom
use psi_mod use psi_mod
implicit none 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(:,:) real(psb_dpk_), intent(inout), target :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_dpk_), intent(in), optional :: alpha
real(psb_dpk_), optional, target, intent(inout) :: work(:) real(psb_dpk_), optional, target, intent(inout) :: work(:)
integer(psb_ipk_), intent(in), optional :: mode,jx,ik,data integer(psb_ipk_), intent(in), optional :: mode,jx,ik,data
character, intent(in), optional :: tran 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) call psb_errcomm(ictxt,err)
if(err /= 0) goto 9999 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 liwork=nrow
if (present(work)) then if (present(work)) then
if(size(work) >= liwork) then if(size(work) >= liwork) then
@ -256,7 +246,6 @@ end subroutine psb_dhalom
! x - real,dimension(:). The local part of the dense vector. ! x - real,dimension(:). The local part of the dense vector.
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! alpha - real(optional). Scale factor.
! jx - integer(optional). The starting column of the global matrix. ! jx - integer(optional). The starting column of the global matrix.
! ik - integer(optional). The number of columns to gather. ! ik - integer(optional). The number of columns to gather.
! work - real(optional). Work area. ! work - real(optional). Work area.
@ -270,7 +259,7 @@ end subroutine psb_dhalom
! psb_comm_mov_ use ovr_mst_idx ! 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 psb_base_mod, psb_protect_name => psb_dhalov
use psi_mod use psi_mod
implicit none implicit none
@ -278,7 +267,6 @@ subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode,data)
real(psb_dpk_), intent(inout) :: x(:) real(psb_dpk_), intent(inout) :: x(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_dpk_), intent(in), optional :: alpha
real(psb_dpk_), target, optional, intent(inout) :: work(:) real(psb_dpk_), target, optional, intent(inout) :: work(:)
integer(psb_ipk_), intent(in), optional :: mode,data integer(psb_ipk_), intent(in), optional :: mode,data
character, intent(in), optional :: tran 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) call psb_errcomm(ictxt,err)
if(err /= 0) goto 9999 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 liwork=nrow
if (present(work)) then if (present(work)) then
if(size(work) >= liwork) 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 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 psb_base_mod, psb_protect_name => psb_dhalo_vect
use psi_mod use psi_mod
implicit none 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_d_vect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_dpk_), intent(in), optional :: alpha
real(psb_dpk_), target, optional, intent(inout) :: work(:) real(psb_dpk_), target, optional, intent(inout) :: work(:)
integer(psb_ipk_), intent(in), optional :: mode,data integer(psb_ipk_), intent(in), optional :: mode,data
character, intent(in), optional :: tran 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) call psb_errcomm(ictxt,err)
if(err /= 0) goto 9999 if(err /= 0) goto 9999
if(present(alpha)) then
if(alpha /= done) then
call x%scal(alpha)
end if
end if
liwork=nrow liwork=nrow
if (present(work)) then if (present(work)) then
if(size(work) >= liwork) 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. ! x - integer,dimension(:,:). The local part of the dense matrix.
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! alpha - integer(optional). Scale factor.
! jx - integer(optional). The starting column of the global matrix. ! jx - integer(optional). The starting column of the global matrix.
! ik - integer(optional). The number of columns to gather. ! ik - integer(optional). The number of columns to gather.
! work - integer(optional). Work area. ! work - integer(optional). Work area.
@ -53,7 +52,7 @@
! psb_comm_mov_ use ovr_mst_idx ! 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 psb_base_mod, psb_protect_name => psb_ihalom
use psi_mod use psi_mod
implicit none 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(:,:) integer(psb_ipk_), intent(inout), target :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: alpha
integer(psb_ipk_), optional, target, intent(inout) :: work(:) integer(psb_ipk_), optional, target, intent(inout) :: work(:)
integer(psb_ipk_), intent(in), optional :: mode,jx,ik,data integer(psb_ipk_), intent(in), optional :: mode,jx,ik,data
character, intent(in), optional :: tran 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) call psb_errcomm(ictxt,err)
if(err /= 0) goto 9999 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 liwork=nrow
if (present(work)) then if (present(work)) then
if(size(work) >= liwork) then if(size(work) >= liwork) then
@ -256,7 +246,6 @@ end subroutine psb_ihalom
! x - real,dimension(:). The local part of the dense vector. ! x - real,dimension(:). The local part of the dense vector.
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! alpha - integer(optional). Scale factor.
! jx - integer(optional). The starting column of the global matrix. ! jx - integer(optional). The starting column of the global matrix.
! ik - integer(optional). The number of columns to gather. ! ik - integer(optional). The number of columns to gather.
! work - integer(optional). Work area. ! work - integer(optional). Work area.
@ -270,7 +259,7 @@ end subroutine psb_ihalom
! psb_comm_mov_ use ovr_mst_idx ! 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 psb_base_mod, psb_protect_name => psb_ihalov
use psi_mod use psi_mod
implicit none implicit none
@ -278,7 +267,6 @@ subroutine psb_ihalov(x,desc_a,info,alpha,work,tran,mode,data)
integer(psb_ipk_), intent(inout) :: x(:) integer(psb_ipk_), intent(inout) :: x(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: alpha
integer(psb_ipk_), target, optional, intent(inout) :: work(:) integer(psb_ipk_), target, optional, intent(inout) :: work(:)
integer(psb_ipk_), intent(in), optional :: mode,data integer(psb_ipk_), intent(in), optional :: mode,data
character, intent(in), optional :: tran 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) call psb_errcomm(ictxt,err)
if(err /= 0) goto 9999 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 liwork=nrow
if (present(work)) then if (present(work)) then
if(size(work) >= liwork) 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 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 psb_base_mod, psb_protect_name => psb_ihalo_vect
use psi_mod use psi_mod
implicit none 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_i_vect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: alpha
integer(psb_ipk_), target, optional, intent(inout) :: work(:) integer(psb_ipk_), target, optional, intent(inout) :: work(:)
integer(psb_ipk_), intent(in), optional :: mode,data integer(psb_ipk_), intent(in), optional :: mode,data
character, intent(in), optional :: tran 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) call psb_errcomm(ictxt,err)
if(err /= 0) goto 9999 if(err /= 0) goto 9999
if(present(alpha)) then
if(alpha /= ione) then
call x%scal(alpha)
end if
end if
liwork=nrow liwork=nrow
if (present(work)) then if (present(work)) then
if(size(work) >= liwork) 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. ! x - real,dimension(:,:). The local part of the dense matrix.
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! alpha - real(optional). Scale factor.
! jx - integer(optional). The starting column of the global matrix. ! jx - integer(optional). The starting column of the global matrix.
! ik - integer(optional). The number of columns to gather. ! ik - integer(optional). The number of columns to gather.
! work - real(optional). Work area. ! work - real(optional). Work area.
@ -53,7 +52,7 @@
! psb_comm_mov_ use ovr_mst_idx ! 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 psb_base_mod, psb_protect_name => psb_shalom
use psi_mod use psi_mod
implicit none 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(:,:) real(psb_spk_), intent(inout), target :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_spk_), intent(in), optional :: alpha
real(psb_spk_), optional, target, intent(inout) :: work(:) real(psb_spk_), optional, target, intent(inout) :: work(:)
integer(psb_ipk_), intent(in), optional :: mode,jx,ik,data integer(psb_ipk_), intent(in), optional :: mode,jx,ik,data
character, intent(in), optional :: tran 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) call psb_errcomm(ictxt,err)
if(err /= 0) goto 9999 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 liwork=nrow
if (present(work)) then if (present(work)) then
if(size(work) >= liwork) then if(size(work) >= liwork) then
@ -256,7 +246,6 @@ end subroutine psb_shalom
! x - real,dimension(:). The local part of the dense vector. ! x - real,dimension(:). The local part of the dense vector.
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! alpha - real(optional). Scale factor.
! jx - integer(optional). The starting column of the global matrix. ! jx - integer(optional). The starting column of the global matrix.
! ik - integer(optional). The number of columns to gather. ! ik - integer(optional). The number of columns to gather.
! work - real(optional). Work area. ! work - real(optional). Work area.
@ -270,7 +259,7 @@ end subroutine psb_shalom
! psb_comm_mov_ use ovr_mst_idx ! 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 psb_base_mod, psb_protect_name => psb_shalov
use psi_mod use psi_mod
implicit none implicit none
@ -278,7 +267,6 @@ subroutine psb_shalov(x,desc_a,info,alpha,work,tran,mode,data)
real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(inout) :: x(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_spk_), intent(in), optional :: alpha
real(psb_spk_), target, optional, intent(inout) :: work(:) real(psb_spk_), target, optional, intent(inout) :: work(:)
integer(psb_ipk_), intent(in), optional :: mode,data integer(psb_ipk_), intent(in), optional :: mode,data
character, intent(in), optional :: tran 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) call psb_errcomm(ictxt,err)
if(err /= 0) goto 9999 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 liwork=nrow
if (present(work)) then if (present(work)) then
if(size(work) >= liwork) 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 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 psb_base_mod, psb_protect_name => psb_shalo_vect
use psi_mod use psi_mod
implicit none 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_s_vect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_spk_), intent(in), optional :: alpha
real(psb_spk_), target, optional, intent(inout) :: work(:) real(psb_spk_), target, optional, intent(inout) :: work(:)
integer(psb_ipk_), intent(in), optional :: mode,data integer(psb_ipk_), intent(in), optional :: mode,data
character, intent(in), optional :: tran 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) call psb_errcomm(ictxt,err)
if(err /= 0) goto 9999 if(err /= 0) goto 9999
if(present(alpha)) then
if(alpha /= sone) then
call x%scal(alpha)
end if
end if
liwork=nrow liwork=nrow
if (present(work)) then if (present(work)) then
if(size(work) >= liwork) 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. ! x - complex,dimension(:,:). The local part of the dense matrix.
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! alpha - complex(optional). Scale factor.
! jx - integer(optional). The starting column of the global matrix. ! jx - integer(optional). The starting column of the global matrix.
! ik - integer(optional). The number of columns to gather. ! ik - integer(optional). The number of columns to gather.
! work - complex(optional). Work area. ! work - complex(optional). Work area.
@ -53,7 +52,7 @@
! psb_comm_mov_ use ovr_mst_idx ! 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 psb_base_mod, psb_protect_name => psb_zhalom
use psi_mod use psi_mod
implicit none 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(:,:) complex(psb_dpk_), intent(inout), target :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
complex(psb_dpk_), intent(in), optional :: alpha
complex(psb_dpk_), optional, target, intent(inout) :: work(:) complex(psb_dpk_), optional, target, intent(inout) :: work(:)
integer(psb_ipk_), intent(in), optional :: mode,jx,ik,data integer(psb_ipk_), intent(in), optional :: mode,jx,ik,data
character, intent(in), optional :: tran 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) call psb_errcomm(ictxt,err)
if(err /= 0) goto 9999 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 liwork=nrow
if (present(work)) then if (present(work)) then
if(size(work) >= liwork) then if(size(work) >= liwork) then
@ -256,7 +246,6 @@ end subroutine psb_zhalom
! x - real,dimension(:). The local part of the dense vector. ! x - real,dimension(:). The local part of the dense vector.
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! alpha - complex(optional). Scale factor.
! jx - integer(optional). The starting column of the global matrix. ! jx - integer(optional). The starting column of the global matrix.
! ik - integer(optional). The number of columns to gather. ! ik - integer(optional). The number of columns to gather.
! work - complex(optional). Work area. ! work - complex(optional). Work area.
@ -270,7 +259,7 @@ end subroutine psb_zhalom
! psb_comm_mov_ use ovr_mst_idx ! 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 psb_base_mod, psb_protect_name => psb_zhalov
use psi_mod use psi_mod
implicit none implicit none
@ -278,7 +267,6 @@ subroutine psb_zhalov(x,desc_a,info,alpha,work,tran,mode,data)
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
complex(psb_dpk_), intent(in), optional :: alpha
complex(psb_dpk_), target, optional, intent(inout) :: work(:) complex(psb_dpk_), target, optional, intent(inout) :: work(:)
integer(psb_ipk_), intent(in), optional :: mode,data integer(psb_ipk_), intent(in), optional :: mode,data
character, intent(in), optional :: tran 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) call psb_errcomm(ictxt,err)
if(err /= 0) goto 9999 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 liwork=nrow
if (present(work)) then if (present(work)) then
if(size(work) >= liwork) 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 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 psb_base_mod, psb_protect_name => psb_zhalo_vect
use psi_mod use psi_mod
implicit none 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_z_vect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
complex(psb_dpk_), intent(in), optional :: alpha
complex(psb_dpk_), target, optional, intent(inout) :: work(:) complex(psb_dpk_), target, optional, intent(inout) :: work(:)
integer(psb_ipk_), intent(in), optional :: mode,data integer(psb_ipk_), intent(in), optional :: mode,data
character, intent(in), optional :: tran 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) call psb_errcomm(ictxt,err)
if(err /= 0) goto 9999 if(err /= 0) goto 9999
if(present(alpha)) then
if(alpha /= zone) then
call x%scal(alpha)
end if
end if
liwork=nrow liwork=nrow
if (present(work)) then if (present(work)) then
if(size(work) >= liwork) 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_const_mod
use psb_error_mod use psb_error_mod
use psb_i_base_vect_mod
use psb_realloc_mod use psb_realloc_mod
use psb_i_base_vect_mod
!> \namespace psb_base_mod \class psb_c_base_vect_type !> \namespace psb_base_mod \class psb_c_base_vect_type
!! The 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_scal => c_base_set_scal
procedure, pass(x) :: set_vect => c_base_set_vect procedure, pass(x) :: set_vect => c_base_set_vect
generic, public :: set => set_vect, set_scal 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 ! Dot product and AXPBY
@ -154,19 +168,7 @@ module psb_c_base_vect_mod
procedure, pass(x) :: nrm2 => c_base_nrm2 procedure, pass(x) :: nrm2 => c_base_nrm2
procedure, pass(x) :: amax => c_base_amax procedure, pass(x) :: amax => c_base_amax
procedure, pass(x) :: asum => c_base_asum 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 end type psb_c_base_vect_type
public :: psb_c_base_vect public :: psb_c_base_vect
@ -668,6 +670,36 @@ contains
end subroutine c_base_set_scal 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 ! Overwrite with absolute value
! !
@ -680,7 +712,7 @@ contains
class(psb_c_base_vect_type), intent(inout) :: x class(psb_c_base_vect_type), intent(inout) :: x
if (allocated(x%v)) then 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) x%v = abs(x%v)
call x%set_host() call x%set_host()
end if end if
@ -693,40 +725,12 @@ contains
if (.not.x%is_host()) call x%sync() if (.not.x%is_host()) call x%sync()
if (allocated(x%v)) then 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%absval()
call y%set_host()
end if end if
end subroutine c_base_absval2 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 ! Dot products
! !
@ -2422,6 +2426,5 @@ contains
!!$ call y%sct(n,idx%v(i:),x,beta) !!$ call y%sct(n,idx%v(i:),x,beta)
!!$ !!$
!!$ end subroutine c_base_mv_sctb_x !!$ end subroutine c_base_mv_sctb_x
end module psb_c_base_multivect_mod 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 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 interface psb_ovrl
subroutine psb_covrlm(x,desc_a,info,jx,ik,work,update,mode) subroutine psb_covrlm(x,desc_a,info,jx,ik,work,update,mode)
use psb_desc_mod import
implicit none
complex(psb_spk_), intent(inout), target :: x(:,:) complex(psb_spk_), intent(inout), target :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
complex(psb_spk_), intent(inout), optional, target :: work(:) complex(psb_spk_), intent(inout), optional, target :: work(:)
integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode
end subroutine psb_covrlm end subroutine psb_covrlm
subroutine psb_covrlv(x,desc_a,info,work,update,mode) subroutine psb_covrlv(x,desc_a,info,work,update,mode)
use psb_desc_mod import
implicit none
complex(psb_spk_), intent(inout), target :: x(:) complex(psb_spk_), intent(inout), target :: x(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
complex(psb_spk_), intent(inout), optional, target :: work(:) complex(psb_spk_), intent(inout), optional, target :: work(:)
integer(psb_ipk_), intent(in), optional :: update,mode integer(psb_ipk_), intent(in), optional :: update,mode
end subroutine psb_covrlv end subroutine psb_covrlv
subroutine psb_covrl_vect(x,desc_a,info,work,update,mode) subroutine psb_covrl_vect(x,desc_a,info,work,update,mode)
use psb_desc_mod import
use psb_c_vect_mod implicit none
type(psb_c_vect_type), intent(inout) :: x type(psb_c_vect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -60,33 +66,32 @@ module psb_c_comm_mod
end interface psb_ovrl end interface psb_ovrl
interface psb_halo interface psb_halo
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_desc_mod import
implicit none
complex(psb_spk_), intent(inout), target :: x(:,:) complex(psb_spk_), intent(inout), target :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
complex(psb_spk_), intent(in), optional :: alpha
complex(psb_spk_), target, optional, intent(inout) :: work(:) complex(psb_spk_), target, optional, intent(inout) :: work(:)
integer(psb_ipk_), intent(in), optional :: mode,jx,ik,data integer(psb_ipk_), intent(in), optional :: mode,jx,ik,data
character, intent(in), optional :: tran character, intent(in), optional :: tran
end subroutine psb_chalom end subroutine psb_chalom
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_desc_mod import
implicit none
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
complex(psb_spk_), intent(in), optional :: alpha
complex(psb_spk_), target, optional, intent(inout) :: work(:) complex(psb_spk_), target, optional, intent(inout) :: work(:)
integer(psb_ipk_), intent(in), optional :: mode,data integer(psb_ipk_), intent(in), optional :: mode,data
character, intent(in), optional :: tran character, intent(in), optional :: tran
end subroutine psb_chalov 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_desc_mod import
use psb_c_vect_mod implicit none
type(psb_c_vect_type), intent(inout) :: x type(psb_c_vect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
complex(psb_spk_), intent(in), optional :: alpha
complex(psb_spk_), target, optional, intent(inout) :: work(:) complex(psb_spk_), target, optional, intent(inout) :: work(:)
integer(psb_ipk_), intent(in), optional :: mode,data integer(psb_ipk_), intent(in), optional :: mode,data
character, intent(in), optional :: tran character, intent(in), optional :: tran
@ -95,16 +100,18 @@ module psb_c_comm_mod
interface psb_scatter interface psb_scatter
subroutine psb_cscatterm(globx, locx, desc_a, info, root) subroutine psb_cscatterm(globx, locx, desc_a, info, root)
use psb_desc_mod import
implicit none
complex(psb_spk_), intent(out) :: locx(:,:) complex(psb_spk_), intent(out) :: locx(:,:)
complex(psb_spk_), intent(in) :: globx(:,:) complex(psb_spk_), intent(in) :: globx(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: root integer(psb_ipk_), intent(in), optional :: root
end subroutine psb_cscatterm end subroutine psb_cscatterm
subroutine psb_cscatterv(globx, locx, desc_a, info, root) subroutine psb_cscatterv(globx, locx, desc_a, info, root)
use psb_desc_mod import
implicit none
complex(psb_spk_), intent(out) :: locx(:) complex(psb_spk_), intent(out) :: locx(:)
complex(psb_spk_), intent(in) :: globx(:) complex(psb_spk_), intent(in) :: globx(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
@ -114,9 +121,8 @@ module psb_c_comm_mod
end interface psb_scatter end interface psb_scatter
interface psb_gather interface psb_gather
subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc) subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
use psb_desc_mod import
use psb_mat_mod
implicit none implicit none
type(psb_cspmat_type), intent(inout) :: loca type(psb_cspmat_type), intent(inout) :: loca
type(psb_cspmat_type), intent(out) :: globa type(psb_cspmat_type), intent(out) :: globa
@ -126,24 +132,26 @@ module psb_c_comm_mod
logical, intent(in), optional :: keepnum,keeploc logical, intent(in), optional :: keepnum,keeploc
end subroutine psb_csp_allgather end subroutine psb_csp_allgather
subroutine psb_cgatherm(globx, locx, desc_a, info, root) 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(in) :: locx(:,:)
complex(psb_spk_), intent(out), allocatable :: globx(:,:) complex(psb_spk_), intent(out), allocatable :: globx(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: root integer(psb_ipk_), intent(in), optional :: root
end subroutine psb_cgatherm end subroutine psb_cgatherm
subroutine psb_cgatherv(globx, locx, desc_a, info, root) subroutine psb_cgatherv(globx, locx, desc_a, info, root)
use psb_desc_mod import
implicit none
complex(psb_spk_), intent(in) :: locx(:) complex(psb_spk_), intent(in) :: locx(:)
complex(psb_spk_), intent(out), allocatable :: globx(:) complex(psb_spk_), intent(out), allocatable :: globx(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: root integer(psb_ipk_), intent(in), optional :: root
end subroutine psb_cgatherv end subroutine psb_cgatherv
subroutine psb_cgather_vect(globx, locx, desc_a, info, root) subroutine psb_cgather_vect(globx, locx, desc_a, info, root)
use psb_desc_mod import
use psb_c_vect_mod implicit none
type(psb_c_vect_type), intent(inout) :: locx type(psb_c_vect_type), intent(inout) :: locx
complex(psb_spk_), intent(out), allocatable :: globx(:) complex(psb_spk_), intent(out), allocatable :: globx(:)
type(psb_desc_type), intent(in) :: desc_a 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 interface psb_geall
subroutine psb_calloc(x, desc_a, info, n, lb) subroutine psb_calloc(x, desc_a, info, n, lb)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_c_base_vect_type, psb_c_vect_type, &
& psb_cspmat_type, psb_c_base_sparse_mat
implicit none implicit none
complex(psb_spk_), allocatable, intent(out) :: x(:,:) complex(psb_spk_), allocatable, intent(out) :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a 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 integer(psb_ipk_), optional, intent(in) :: n, lb
end subroutine psb_calloc end subroutine psb_calloc
subroutine psb_callocv(x, desc_a,info,n) subroutine psb_callocv(x, desc_a,info,n)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_c_base_vect_type, psb_c_vect_type, & implicit none
& psb_cspmat_type, psb_c_base_sparse_mat
complex(psb_spk_), allocatable, intent(out) :: x(:) complex(psb_spk_), allocatable, intent(out) :: x(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: n integer(psb_ipk_), optional, intent(in) :: n
end subroutine psb_callocv end subroutine psb_callocv
subroutine psb_calloc_vect(x, desc_a,info,n) subroutine psb_calloc_vect(x, desc_a,info,n)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_c_base_vect_type, psb_c_vect_type, & implicit none
& psb_cspmat_type, psb_c_base_sparse_mat
type(psb_c_vect_type), intent(out) :: x type(psb_c_vect_type), intent(out) :: x
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: n integer(psb_ipk_), optional, intent(in) :: n
end subroutine psb_calloc_vect end subroutine psb_calloc_vect
subroutine psb_calloc_vect_r2(x, desc_a,info,n,lb) subroutine psb_calloc_vect_r2(x, desc_a,info,n,lb)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_c_base_vect_type, psb_c_vect_type, & implicit none
& psb_cspmat_type, psb_c_base_sparse_mat
type(psb_c_vect_type), allocatable, intent(out) :: x(:) type(psb_c_vect_type), allocatable, intent(out) :: x(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info integer(psb_ipk_),intent(out) :: info
@ -77,25 +72,22 @@ Module psb_c_tools_mod
interface psb_geasb interface psb_geasb
subroutine psb_casb(x, desc_a, info) subroutine psb_casb(x, desc_a, info)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_c_base_vect_type, psb_c_vect_type, & implicit none
& psb_cspmat_type, psb_c_base_sparse_mat
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
complex(psb_spk_), allocatable, intent(inout) :: x(:,:) complex(psb_spk_), allocatable, intent(inout) :: x(:,:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_casb end subroutine psb_casb
subroutine psb_casbv(x, desc_a, info) subroutine psb_casbv(x, desc_a, info)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_c_base_vect_type, psb_c_vect_type, & implicit none
& psb_cspmat_type, psb_c_base_sparse_mat
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
complex(psb_spk_), allocatable, intent(inout) :: x(:) complex(psb_spk_), allocatable, intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_casbv end subroutine psb_casbv
subroutine psb_casb_vect(x, desc_a, info,mold, scratch) subroutine psb_casb_vect(x, desc_a, info,mold, scratch)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_c_base_vect_type, psb_c_vect_type, & implicit none
& psb_cspmat_type, psb_c_base_sparse_mat
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_c_vect_type), intent(inout) :: x type(psb_c_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -103,9 +95,8 @@ Module psb_c_tools_mod
logical, intent(in), optional :: scratch logical, intent(in), optional :: scratch
end subroutine psb_casb_vect end subroutine psb_casb_vect
subroutine psb_casb_vect_r2(x, desc_a, info,mold, scratch) subroutine psb_casb_vect_r2(x, desc_a, info,mold, scratch)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_c_base_vect_type, psb_c_vect_type, & implicit none
& psb_cspmat_type, psb_c_base_sparse_mat
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_c_vect_type), intent(inout) :: x(:) type(psb_c_vect_type), intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -114,51 +105,31 @@ Module psb_c_tools_mod
end subroutine psb_casb_vect_r2 end subroutine psb_casb_vect_r2
end interface 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 interface psb_gefree
subroutine psb_cfree(x, desc_a, info) subroutine psb_cfree(x, desc_a, info)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_c_base_vect_type, psb_c_vect_type, & implicit none
& psb_cspmat_type, psb_c_base_sparse_mat
complex(psb_spk_),allocatable, intent(inout) :: x(:,:) complex(psb_spk_),allocatable, intent(inout) :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_cfree end subroutine psb_cfree
subroutine psb_cfreev(x, desc_a, info) subroutine psb_cfreev(x, desc_a, info)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_c_base_vect_type, psb_c_vect_type, & implicit none
& psb_cspmat_type, psb_c_base_sparse_mat
complex(psb_spk_),allocatable, intent(inout) :: x(:) complex(psb_spk_),allocatable, intent(inout) :: x(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_cfreev end subroutine psb_cfreev
subroutine psb_cfree_vect(x, desc_a, info) subroutine psb_cfree_vect(x, desc_a, info)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_c_base_vect_type, psb_c_vect_type, & implicit none
& psb_cspmat_type, psb_c_base_sparse_mat
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_c_vect_type), intent(inout) :: x type(psb_c_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_cfree_vect end subroutine psb_cfree_vect
subroutine psb_cfree_vect_r2(x, desc_a, info) subroutine psb_cfree_vect_r2(x, desc_a, info)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_c_base_vect_type, psb_c_vect_type, & implicit none
& psb_cspmat_type, psb_c_base_sparse_mat
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_c_vect_type), allocatable, intent(inout) :: x(:) type(psb_c_vect_type), allocatable, intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -168,9 +139,8 @@ Module psb_c_tools_mod
interface psb_geins interface psb_geins
subroutine psb_cinsi(m,irw,val, x, desc_a,info,dupl,local) subroutine psb_cinsi(m,irw,val, x, desc_a,info,dupl,local)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_c_base_vect_type, psb_c_vect_type, & implicit none
& psb_cspmat_type, psb_c_base_sparse_mat
integer(psb_ipk_), intent(in) :: m integer(psb_ipk_), intent(in) :: m
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
complex(psb_spk_),intent(inout) :: x(:,:) complex(psb_spk_),intent(inout) :: x(:,:)
@ -181,9 +151,8 @@ Module psb_c_tools_mod
logical, intent(in), optional :: local logical, intent(in), optional :: local
end subroutine psb_cinsi end subroutine psb_cinsi
subroutine psb_cinsvi(m, irw,val, x,desc_a,info,dupl,local) subroutine psb_cinsvi(m, irw,val, x,desc_a,info,dupl,local)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_c_base_vect_type, psb_c_vect_type, & implicit none
& psb_cspmat_type, psb_c_base_sparse_mat
integer(psb_ipk_), intent(in) :: m integer(psb_ipk_), intent(in) :: m
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
complex(psb_spk_),intent(inout) :: x(:) complex(psb_spk_),intent(inout) :: x(:)
@ -194,9 +163,8 @@ Module psb_c_tools_mod
logical, intent(in), optional :: local logical, intent(in), optional :: local
end subroutine psb_cinsvi end subroutine psb_cinsvi
subroutine psb_cins_vect(m,irw,val,x,desc_a,info,dupl,local) subroutine psb_cins_vect(m,irw,val,x,desc_a,info,dupl,local)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_c_base_vect_type, psb_c_vect_type, & implicit none
& psb_cspmat_type, psb_c_base_sparse_mat
integer(psb_ipk_), intent(in) :: m integer(psb_ipk_), intent(in) :: m
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_c_vect_type), intent(inout) :: x type(psb_c_vect_type), intent(inout) :: x
@ -207,9 +175,8 @@ Module psb_c_tools_mod
logical, intent(in), optional :: local logical, intent(in), optional :: local
end subroutine psb_cins_vect end subroutine psb_cins_vect
subroutine psb_cins_vect_v(m,irw,val,x,desc_a,info,dupl,local) subroutine psb_cins_vect_v(m,irw,val,x,desc_a,info,dupl,local)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_c_base_vect_type, psb_c_vect_type, psb_i_vect_type, & implicit none
& psb_cspmat_type, psb_c_base_sparse_mat
integer(psb_ipk_), intent(in) :: m integer(psb_ipk_), intent(in) :: m
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_c_vect_type), intent(inout) :: x type(psb_c_vect_type), intent(inout) :: x
@ -220,9 +187,8 @@ Module psb_c_tools_mod
logical, intent(in), optional :: local logical, intent(in), optional :: local
end subroutine psb_cins_vect_v end subroutine psb_cins_vect_v
subroutine psb_cins_vect_r2(m,irw,val,x,desc_a,info,dupl,local) subroutine psb_cins_vect_r2(m,irw,val,x,desc_a,info,dupl,local)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_c_base_vect_type, psb_c_vect_type, & implicit none
& psb_cspmat_type, psb_c_base_sparse_mat
integer(psb_ipk_), intent(in) :: m integer(psb_ipk_), intent(in) :: m
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_c_vect_type), intent(inout) :: x(:) type(psb_c_vect_type), intent(inout) :: x(:)
@ -236,9 +202,8 @@ Module psb_c_tools_mod
interface psb_cdbldext interface psb_cdbldext
Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info,extype) Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info,extype)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_c_base_vect_type, psb_c_vect_type, & implicit none
& psb_cspmat_type, psb_c_base_sparse_mat
integer(psb_ipk_), intent(in) :: novr integer(psb_ipk_), intent(in) :: novr
Type(psb_cspmat_type), Intent(in) :: a Type(psb_cspmat_type), Intent(in) :: a
Type(psb_desc_type), Intent(inout), target :: desc_a Type(psb_desc_type), Intent(inout), target :: desc_a
@ -248,11 +213,26 @@ Module psb_c_tools_mod
end Subroutine psb_ccdbldext end Subroutine psb_ccdbldext
end interface 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 interface psb_spall
subroutine psb_cspalloc(a, desc_a, info, nnz) subroutine psb_cspalloc(a, desc_a, info, nnz)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_c_base_vect_type, psb_c_vect_type, & implicit none
& psb_cspmat_type, psb_c_base_sparse_mat
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_cspmat_type), intent(inout) :: a type(psb_cspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -262,9 +242,8 @@ Module psb_c_tools_mod
interface psb_spasb interface psb_spasb
subroutine psb_cspasb(a,desc_a, info, afmt, upd, dupl,mold) subroutine psb_cspasb(a,desc_a, info, afmt, upd, dupl,mold)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_c_base_vect_type, psb_c_vect_type, & implicit none
& psb_cspmat_type, psb_c_base_sparse_mat
type(psb_cspmat_type), intent (inout) :: a type(psb_cspmat_type), intent (inout) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -276,9 +255,8 @@ Module psb_c_tools_mod
interface psb_spfree interface psb_spfree
subroutine psb_cspfree(a, desc_a,info) subroutine psb_cspfree(a, desc_a,info)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_c_base_vect_type, psb_c_vect_type, & implicit none
& psb_cspmat_type, psb_c_base_sparse_mat
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_cspmat_type), intent(inout) ::a type(psb_cspmat_type), intent(inout) ::a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -288,9 +266,8 @@ Module psb_c_tools_mod
interface psb_spins interface psb_spins
subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_c_base_vect_type, psb_c_vect_type, & implicit none
& psb_cspmat_type, psb_c_base_sparse_mat
type(psb_desc_type), intent(inout) :: desc_a type(psb_desc_type), intent(inout) :: desc_a
type(psb_cspmat_type), intent(inout) :: a type(psb_cspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(in) :: nz,ia(:),ja(:) integer(psb_ipk_), intent(in) :: nz,ia(:),ja(:)
@ -301,9 +278,8 @@ Module psb_c_tools_mod
end subroutine psb_cspins end subroutine psb_cspins
subroutine psb_cspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local) subroutine psb_cspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local)
use psb_i_vect_mod, only : psb_i_vect_type use psb_i_vect_mod, only : psb_i_vect_type
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_c_base_vect_type, psb_c_vect_type,& implicit none
& psb_cspmat_type, psb_c_base_sparse_mat
type(psb_desc_type), intent(inout) :: desc_a type(psb_desc_type), intent(inout) :: desc_a
type(psb_cspmat_type), intent(inout) :: a type(psb_cspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(in) :: nz integer(psb_ipk_), intent(in) :: nz
@ -314,9 +290,8 @@ Module psb_c_tools_mod
logical, intent(in), optional :: local logical, intent(in), optional :: local
end subroutine psb_cspins_v end subroutine psb_cspins_v
subroutine psb_cspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) subroutine psb_cspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_c_base_vect_type, psb_c_vect_type, & implicit none
& psb_cspmat_type, psb_c_base_sparse_mat
type(psb_desc_type), intent(in) :: desc_ar type(psb_desc_type), intent(in) :: desc_ar
type(psb_desc_type), intent(inout) :: desc_ac type(psb_desc_type), intent(inout) :: desc_ac
type(psb_cspmat_type), intent(inout) :: a type(psb_cspmat_type), intent(inout) :: a
@ -329,9 +304,8 @@ Module psb_c_tools_mod
interface psb_sprn interface psb_sprn
subroutine psb_csprn(a, desc_a,info,clear) subroutine psb_csprn(a, desc_a,info,clear)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_c_base_vect_type, psb_c_vect_type, & implicit none
& psb_cspmat_type, psb_c_base_sparse_mat
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_cspmat_type), intent(inout) :: a type(psb_cspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info 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) :: get_nrows => c_vect_get_nrows
procedure, pass(x) :: sizeof => c_vect_sizeof procedure, pass(x) :: sizeof => c_vect_sizeof
procedure, pass(x) :: get_fmt => c_vect_get_fmt 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) :: all => c_vect_all
procedure, pass(x) :: reall => c_vect_reall procedure, pass(x) :: reall => c_vect_reall
procedure, pass(x) :: zero => c_vect_zero 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 procedure, pass(x) :: set_vect => c_vect_set_vect
generic, public :: set => set_vect, set_scal generic, public :: set => set_vect, set_scal
procedure, pass(x) :: clone => c_vect_clone 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 end type psb_c_vect_type
public :: psb_c_vect public :: psb_c_vect
@ -296,6 +296,191 @@ contains
res = 'NULL' res = 'NULL'
if (allocated(x%v)) res = x%v%get_fmt() if (allocated(x%v)) res = x%v%get_fmt()
end function c_vect_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) function c_vect_dot_v(n,x,y) result(res)
implicit none implicit none
@ -522,197 +707,12 @@ contains
end function c_vect_asum end function c_vect_asum
subroutine c_vect_all(n, x, info, mold)
implicit none end module psb_c_vect_mod
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) module psb_c_multivect_mod
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
use psb_c_base_multivect_mod use psb_c_base_multivect_mod
use psb_const_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) :: get_ncols => c_vect_get_ncols
procedure, pass(x) :: sizeof => c_vect_sizeof procedure, pass(x) :: sizeof => c_vect_sizeof
procedure, pass(x) :: get_fmt => c_vect_get_fmt 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_v => c_vect_dot_v
!!$ procedure, pass(x) :: dot_a => c_vect_dot_a !!$ procedure, pass(x) :: dot_a => c_vect_dot_a
!!$ generic, public :: dot => dot_v, 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) :: nrm2 => c_vect_nrm2
!!$ procedure, pass(x) :: amax => c_vect_amax !!$ procedure, pass(x) :: amax => c_vect_amax
!!$ procedure, pass(x) :: asum => c_vect_asum !!$ 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 end type psb_c_multivect_type
public :: psb_c_multivect, 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() if (allocated(x%v)) res = x%v%get_fmt()
end function c_vect_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) subroutine c_vect_all(m,n, x, info, mold)
implicit none implicit none
@ -1341,4 +1134,213 @@ contains
end if end if
end subroutine c_vect_cnv 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 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_const_mod
use psb_error_mod use psb_error_mod
use psb_i_base_vect_mod
use psb_realloc_mod use psb_realloc_mod
use psb_i_base_vect_mod
!> \namespace psb_base_mod \class psb_d_base_vect_type !> \namespace psb_base_mod \class psb_d_base_vect_type
!! The 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_scal => d_base_set_scal
procedure, pass(x) :: set_vect => d_base_set_vect procedure, pass(x) :: set_vect => d_base_set_vect
generic, public :: set => set_vect, set_scal 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 ! Dot product and AXPBY
@ -154,19 +168,7 @@ module psb_d_base_vect_mod
procedure, pass(x) :: nrm2 => d_base_nrm2 procedure, pass(x) :: nrm2 => d_base_nrm2
procedure, pass(x) :: amax => d_base_amax procedure, pass(x) :: amax => d_base_amax
procedure, pass(x) :: asum => d_base_asum 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 end type psb_d_base_vect_type
public :: psb_d_base_vect public :: psb_d_base_vect
@ -668,6 +670,36 @@ contains
end subroutine d_base_set_scal 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 ! Overwrite with absolute value
! !
@ -680,7 +712,7 @@ contains
class(psb_d_base_vect_type), intent(inout) :: x class(psb_d_base_vect_type), intent(inout) :: x
if (allocated(x%v)) then 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) x%v = abs(x%v)
call x%set_host() call x%set_host()
end if end if
@ -693,40 +725,12 @@ contains
if (.not.x%is_host()) call x%sync() if (.not.x%is_host()) call x%sync()
if (allocated(x%v)) then 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%absval()
call y%set_host()
end if end if
end subroutine d_base_absval2 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 ! Dot products
! !
@ -2422,6 +2426,5 @@ contains
!!$ call y%sct(n,idx%v(i:),x,beta) !!$ call y%sct(n,idx%v(i:),x,beta)
!!$ !!$
!!$ end subroutine d_base_mv_sctb_x !!$ end subroutine d_base_mv_sctb_x
end module psb_d_base_multivect_mod 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 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 interface psb_ovrl
subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,update,mode) subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,update,mode)
use psb_desc_mod import
implicit none
real(psb_dpk_), intent(inout), target :: x(:,:) real(psb_dpk_), intent(inout), target :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_dpk_), intent(inout), optional, target :: work(:) real(psb_dpk_), intent(inout), optional, target :: work(:)
integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode
end subroutine psb_dovrlm end subroutine psb_dovrlm
subroutine psb_dovrlv(x,desc_a,info,work,update,mode) subroutine psb_dovrlv(x,desc_a,info,work,update,mode)
use psb_desc_mod import
implicit none
real(psb_dpk_), intent(inout), target :: x(:) real(psb_dpk_), intent(inout), target :: x(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_dpk_), intent(inout), optional, target :: work(:) real(psb_dpk_), intent(inout), optional, target :: work(:)
integer(psb_ipk_), intent(in), optional :: update,mode integer(psb_ipk_), intent(in), optional :: update,mode
end subroutine psb_dovrlv end subroutine psb_dovrlv
subroutine psb_dovrl_vect(x,desc_a,info,work,update,mode) subroutine psb_dovrl_vect(x,desc_a,info,work,update,mode)
use psb_desc_mod import
use psb_d_vect_mod implicit none
type(psb_d_vect_type), intent(inout) :: x type(psb_d_vect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -60,33 +66,32 @@ module psb_d_comm_mod
end interface psb_ovrl end interface psb_ovrl
interface psb_halo interface psb_halo
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_desc_mod import
implicit none
real(psb_dpk_), intent(inout), target :: x(:,:) real(psb_dpk_), intent(inout), target :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_dpk_), intent(in), optional :: alpha
real(psb_dpk_), target, optional, intent(inout) :: work(:) real(psb_dpk_), target, optional, intent(inout) :: work(:)
integer(psb_ipk_), intent(in), optional :: mode,jx,ik,data integer(psb_ipk_), intent(in), optional :: mode,jx,ik,data
character, intent(in), optional :: tran character, intent(in), optional :: tran
end subroutine psb_dhalom end subroutine psb_dhalom
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_desc_mod import
implicit none
real(psb_dpk_), intent(inout) :: x(:) real(psb_dpk_), intent(inout) :: x(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_dpk_), intent(in), optional :: alpha
real(psb_dpk_), target, optional, intent(inout) :: work(:) real(psb_dpk_), target, optional, intent(inout) :: work(:)
integer(psb_ipk_), intent(in), optional :: mode,data integer(psb_ipk_), intent(in), optional :: mode,data
character, intent(in), optional :: tran character, intent(in), optional :: tran
end subroutine psb_dhalov 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_desc_mod import
use psb_d_vect_mod implicit none
type(psb_d_vect_type), intent(inout) :: x type(psb_d_vect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_dpk_), intent(in), optional :: alpha
real(psb_dpk_), target, optional, intent(inout) :: work(:) real(psb_dpk_), target, optional, intent(inout) :: work(:)
integer(psb_ipk_), intent(in), optional :: mode,data integer(psb_ipk_), intent(in), optional :: mode,data
character, intent(in), optional :: tran character, intent(in), optional :: tran
@ -95,16 +100,18 @@ module psb_d_comm_mod
interface psb_scatter interface psb_scatter
subroutine psb_dscatterm(globx, locx, desc_a, info, root) subroutine psb_dscatterm(globx, locx, desc_a, info, root)
use psb_desc_mod import
implicit none
real(psb_dpk_), intent(out) :: locx(:,:) real(psb_dpk_), intent(out) :: locx(:,:)
real(psb_dpk_), intent(in) :: globx(:,:) real(psb_dpk_), intent(in) :: globx(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: root integer(psb_ipk_), intent(in), optional :: root
end subroutine psb_dscatterm end subroutine psb_dscatterm
subroutine psb_dscatterv(globx, locx, desc_a, info, root) subroutine psb_dscatterv(globx, locx, desc_a, info, root)
use psb_desc_mod import
implicit none
real(psb_dpk_), intent(out) :: locx(:) real(psb_dpk_), intent(out) :: locx(:)
real(psb_dpk_), intent(in) :: globx(:) real(psb_dpk_), intent(in) :: globx(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
@ -114,9 +121,8 @@ module psb_d_comm_mod
end interface psb_scatter end interface psb_scatter
interface psb_gather interface psb_gather
subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc) subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
use psb_desc_mod import
use psb_mat_mod
implicit none implicit none
type(psb_dspmat_type), intent(inout) :: loca type(psb_dspmat_type), intent(inout) :: loca
type(psb_dspmat_type), intent(out) :: globa type(psb_dspmat_type), intent(out) :: globa
@ -126,24 +132,26 @@ module psb_d_comm_mod
logical, intent(in), optional :: keepnum,keeploc logical, intent(in), optional :: keepnum,keeploc
end subroutine psb_dsp_allgather end subroutine psb_dsp_allgather
subroutine psb_dgatherm(globx, locx, desc_a, info, root) 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(in) :: locx(:,:)
real(psb_dpk_), intent(out), allocatable :: globx(:,:) real(psb_dpk_), intent(out), allocatable :: globx(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: root integer(psb_ipk_), intent(in), optional :: root
end subroutine psb_dgatherm end subroutine psb_dgatherm
subroutine psb_dgatherv(globx, locx, desc_a, info, root) subroutine psb_dgatherv(globx, locx, desc_a, info, root)
use psb_desc_mod import
implicit none
real(psb_dpk_), intent(in) :: locx(:) real(psb_dpk_), intent(in) :: locx(:)
real(psb_dpk_), intent(out), allocatable :: globx(:) real(psb_dpk_), intent(out), allocatable :: globx(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: root integer(psb_ipk_), intent(in), optional :: root
end subroutine psb_dgatherv end subroutine psb_dgatherv
subroutine psb_dgather_vect(globx, locx, desc_a, info, root) subroutine psb_dgather_vect(globx, locx, desc_a, info, root)
use psb_desc_mod import
use psb_d_vect_mod implicit none
type(psb_d_vect_type), intent(inout) :: locx type(psb_d_vect_type), intent(inout) :: locx
real(psb_dpk_), intent(out), allocatable :: globx(:) real(psb_dpk_), intent(out), allocatable :: globx(:)
type(psb_desc_type), intent(in) :: desc_a 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 interface psb_geall
subroutine psb_dalloc(x, desc_a, info, n, lb) subroutine psb_dalloc(x, desc_a, info, n, lb)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_d_base_vect_type, psb_d_vect_type, &
& psb_dspmat_type, psb_d_base_sparse_mat
implicit none implicit none
real(psb_dpk_), allocatable, intent(out) :: x(:,:) real(psb_dpk_), allocatable, intent(out) :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a 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 integer(psb_ipk_), optional, intent(in) :: n, lb
end subroutine psb_dalloc end subroutine psb_dalloc
subroutine psb_dallocv(x, desc_a,info,n) subroutine psb_dallocv(x, desc_a,info,n)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_d_base_vect_type, psb_d_vect_type, & implicit none
& psb_dspmat_type, psb_d_base_sparse_mat
real(psb_dpk_), allocatable, intent(out) :: x(:) real(psb_dpk_), allocatable, intent(out) :: x(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: n integer(psb_ipk_), optional, intent(in) :: n
end subroutine psb_dallocv end subroutine psb_dallocv
subroutine psb_dalloc_vect(x, desc_a,info,n) subroutine psb_dalloc_vect(x, desc_a,info,n)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_d_base_vect_type, psb_d_vect_type, & implicit none
& psb_dspmat_type, psb_d_base_sparse_mat
type(psb_d_vect_type), intent(out) :: x type(psb_d_vect_type), intent(out) :: x
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: n integer(psb_ipk_), optional, intent(in) :: n
end subroutine psb_dalloc_vect end subroutine psb_dalloc_vect
subroutine psb_dalloc_vect_r2(x, desc_a,info,n,lb) subroutine psb_dalloc_vect_r2(x, desc_a,info,n,lb)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_d_base_vect_type, psb_d_vect_type, & implicit none
& psb_dspmat_type, psb_d_base_sparse_mat
type(psb_d_vect_type), allocatable, intent(out) :: x(:) type(psb_d_vect_type), allocatable, intent(out) :: x(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info integer(psb_ipk_),intent(out) :: info
@ -77,25 +72,22 @@ Module psb_d_tools_mod
interface psb_geasb interface psb_geasb
subroutine psb_dasb(x, desc_a, info) subroutine psb_dasb(x, desc_a, info)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_d_base_vect_type, psb_d_vect_type, & implicit none
& psb_dspmat_type, psb_d_base_sparse_mat
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
real(psb_dpk_), allocatable, intent(inout) :: x(:,:) real(psb_dpk_), allocatable, intent(inout) :: x(:,:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_dasb end subroutine psb_dasb
subroutine psb_dasbv(x, desc_a, info) subroutine psb_dasbv(x, desc_a, info)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_d_base_vect_type, psb_d_vect_type, & implicit none
& psb_dspmat_type, psb_d_base_sparse_mat
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
real(psb_dpk_), allocatable, intent(inout) :: x(:) real(psb_dpk_), allocatable, intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_dasbv end subroutine psb_dasbv
subroutine psb_dasb_vect(x, desc_a, info,mold, scratch) subroutine psb_dasb_vect(x, desc_a, info,mold, scratch)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_d_base_vect_type, psb_d_vect_type, & implicit none
& psb_dspmat_type, psb_d_base_sparse_mat
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_d_vect_type), intent(inout) :: x type(psb_d_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -103,9 +95,8 @@ Module psb_d_tools_mod
logical, intent(in), optional :: scratch logical, intent(in), optional :: scratch
end subroutine psb_dasb_vect end subroutine psb_dasb_vect
subroutine psb_dasb_vect_r2(x, desc_a, info,mold, scratch) subroutine psb_dasb_vect_r2(x, desc_a, info,mold, scratch)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_d_base_vect_type, psb_d_vect_type, & implicit none
& psb_dspmat_type, psb_d_base_sparse_mat
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_d_vect_type), intent(inout) :: x(:) type(psb_d_vect_type), intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -114,51 +105,31 @@ Module psb_d_tools_mod
end subroutine psb_dasb_vect_r2 end subroutine psb_dasb_vect_r2
end interface 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 interface psb_gefree
subroutine psb_dfree(x, desc_a, info) subroutine psb_dfree(x, desc_a, info)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_d_base_vect_type, psb_d_vect_type, & implicit none
& psb_dspmat_type, psb_d_base_sparse_mat
real(psb_dpk_),allocatable, intent(inout) :: x(:,:) real(psb_dpk_),allocatable, intent(inout) :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_dfree end subroutine psb_dfree
subroutine psb_dfreev(x, desc_a, info) subroutine psb_dfreev(x, desc_a, info)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_d_base_vect_type, psb_d_vect_type, & implicit none
& psb_dspmat_type, psb_d_base_sparse_mat
real(psb_dpk_),allocatable, intent(inout) :: x(:) real(psb_dpk_),allocatable, intent(inout) :: x(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_dfreev end subroutine psb_dfreev
subroutine psb_dfree_vect(x, desc_a, info) subroutine psb_dfree_vect(x, desc_a, info)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_d_base_vect_type, psb_d_vect_type, & implicit none
& psb_dspmat_type, psb_d_base_sparse_mat
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_d_vect_type), intent(inout) :: x type(psb_d_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_dfree_vect end subroutine psb_dfree_vect
subroutine psb_dfree_vect_r2(x, desc_a, info) subroutine psb_dfree_vect_r2(x, desc_a, info)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_d_base_vect_type, psb_d_vect_type, & implicit none
& psb_dspmat_type, psb_d_base_sparse_mat
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_d_vect_type), allocatable, intent(inout) :: x(:) type(psb_d_vect_type), allocatable, intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -168,9 +139,8 @@ Module psb_d_tools_mod
interface psb_geins interface psb_geins
subroutine psb_dinsi(m,irw,val, x, desc_a,info,dupl,local) subroutine psb_dinsi(m,irw,val, x, desc_a,info,dupl,local)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_d_base_vect_type, psb_d_vect_type, & implicit none
& psb_dspmat_type, psb_d_base_sparse_mat
integer(psb_ipk_), intent(in) :: m integer(psb_ipk_), intent(in) :: m
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
real(psb_dpk_),intent(inout) :: x(:,:) real(psb_dpk_),intent(inout) :: x(:,:)
@ -181,9 +151,8 @@ Module psb_d_tools_mod
logical, intent(in), optional :: local logical, intent(in), optional :: local
end subroutine psb_dinsi end subroutine psb_dinsi
subroutine psb_dinsvi(m, irw,val, x,desc_a,info,dupl,local) subroutine psb_dinsvi(m, irw,val, x,desc_a,info,dupl,local)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_d_base_vect_type, psb_d_vect_type, & implicit none
& psb_dspmat_type, psb_d_base_sparse_mat
integer(psb_ipk_), intent(in) :: m integer(psb_ipk_), intent(in) :: m
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
real(psb_dpk_),intent(inout) :: x(:) real(psb_dpk_),intent(inout) :: x(:)
@ -194,9 +163,8 @@ Module psb_d_tools_mod
logical, intent(in), optional :: local logical, intent(in), optional :: local
end subroutine psb_dinsvi end subroutine psb_dinsvi
subroutine psb_dins_vect(m,irw,val,x,desc_a,info,dupl,local) subroutine psb_dins_vect(m,irw,val,x,desc_a,info,dupl,local)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_d_base_vect_type, psb_d_vect_type, & implicit none
& psb_dspmat_type, psb_d_base_sparse_mat
integer(psb_ipk_), intent(in) :: m integer(psb_ipk_), intent(in) :: m
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_d_vect_type), intent(inout) :: x type(psb_d_vect_type), intent(inout) :: x
@ -207,9 +175,8 @@ Module psb_d_tools_mod
logical, intent(in), optional :: local logical, intent(in), optional :: local
end subroutine psb_dins_vect end subroutine psb_dins_vect
subroutine psb_dins_vect_v(m,irw,val,x,desc_a,info,dupl,local) subroutine psb_dins_vect_v(m,irw,val,x,desc_a,info,dupl,local)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_d_base_vect_type, psb_d_vect_type, psb_i_vect_type, & implicit none
& psb_dspmat_type, psb_d_base_sparse_mat
integer(psb_ipk_), intent(in) :: m integer(psb_ipk_), intent(in) :: m
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_d_vect_type), intent(inout) :: x type(psb_d_vect_type), intent(inout) :: x
@ -220,9 +187,8 @@ Module psb_d_tools_mod
logical, intent(in), optional :: local logical, intent(in), optional :: local
end subroutine psb_dins_vect_v end subroutine psb_dins_vect_v
subroutine psb_dins_vect_r2(m,irw,val,x,desc_a,info,dupl,local) subroutine psb_dins_vect_r2(m,irw,val,x,desc_a,info,dupl,local)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_d_base_vect_type, psb_d_vect_type, & implicit none
& psb_dspmat_type, psb_d_base_sparse_mat
integer(psb_ipk_), intent(in) :: m integer(psb_ipk_), intent(in) :: m
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_d_vect_type), intent(inout) :: x(:) type(psb_d_vect_type), intent(inout) :: x(:)
@ -236,9 +202,8 @@ Module psb_d_tools_mod
interface psb_cdbldext interface psb_cdbldext
Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info,extype) Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info,extype)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_d_base_vect_type, psb_d_vect_type, & implicit none
& psb_dspmat_type, psb_d_base_sparse_mat
integer(psb_ipk_), intent(in) :: novr integer(psb_ipk_), intent(in) :: novr
Type(psb_dspmat_type), Intent(in) :: a Type(psb_dspmat_type), Intent(in) :: a
Type(psb_desc_type), Intent(inout), target :: desc_a Type(psb_desc_type), Intent(inout), target :: desc_a
@ -248,11 +213,26 @@ Module psb_d_tools_mod
end Subroutine psb_dcdbldext end Subroutine psb_dcdbldext
end interface 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 interface psb_spall
subroutine psb_dspalloc(a, desc_a, info, nnz) subroutine psb_dspalloc(a, desc_a, info, nnz)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_d_base_vect_type, psb_d_vect_type, & implicit none
& psb_dspmat_type, psb_d_base_sparse_mat
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_dspmat_type), intent(inout) :: a type(psb_dspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -262,9 +242,8 @@ Module psb_d_tools_mod
interface psb_spasb interface psb_spasb
subroutine psb_dspasb(a,desc_a, info, afmt, upd, dupl,mold) subroutine psb_dspasb(a,desc_a, info, afmt, upd, dupl,mold)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_d_base_vect_type, psb_d_vect_type, & implicit none
& psb_dspmat_type, psb_d_base_sparse_mat
type(psb_dspmat_type), intent (inout) :: a type(psb_dspmat_type), intent (inout) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -276,9 +255,8 @@ Module psb_d_tools_mod
interface psb_spfree interface psb_spfree
subroutine psb_dspfree(a, desc_a,info) subroutine psb_dspfree(a, desc_a,info)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_d_base_vect_type, psb_d_vect_type, & implicit none
& psb_dspmat_type, psb_d_base_sparse_mat
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_dspmat_type), intent(inout) ::a type(psb_dspmat_type), intent(inout) ::a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -288,9 +266,8 @@ Module psb_d_tools_mod
interface psb_spins interface psb_spins
subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_d_base_vect_type, psb_d_vect_type, & implicit none
& psb_dspmat_type, psb_d_base_sparse_mat
type(psb_desc_type), intent(inout) :: desc_a type(psb_desc_type), intent(inout) :: desc_a
type(psb_dspmat_type), intent(inout) :: a type(psb_dspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(in) :: nz,ia(:),ja(:) integer(psb_ipk_), intent(in) :: nz,ia(:),ja(:)
@ -301,9 +278,8 @@ Module psb_d_tools_mod
end subroutine psb_dspins end subroutine psb_dspins
subroutine psb_dspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local) subroutine psb_dspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local)
use psb_i_vect_mod, only : psb_i_vect_type use psb_i_vect_mod, only : psb_i_vect_type
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_d_base_vect_type, psb_d_vect_type,& implicit none
& psb_dspmat_type, psb_d_base_sparse_mat
type(psb_desc_type), intent(inout) :: desc_a type(psb_desc_type), intent(inout) :: desc_a
type(psb_dspmat_type), intent(inout) :: a type(psb_dspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(in) :: nz integer(psb_ipk_), intent(in) :: nz
@ -314,9 +290,8 @@ Module psb_d_tools_mod
logical, intent(in), optional :: local logical, intent(in), optional :: local
end subroutine psb_dspins_v end subroutine psb_dspins_v
subroutine psb_dspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) subroutine psb_dspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_d_base_vect_type, psb_d_vect_type, & implicit none
& psb_dspmat_type, psb_d_base_sparse_mat
type(psb_desc_type), intent(in) :: desc_ar type(psb_desc_type), intent(in) :: desc_ar
type(psb_desc_type), intent(inout) :: desc_ac type(psb_desc_type), intent(inout) :: desc_ac
type(psb_dspmat_type), intent(inout) :: a type(psb_dspmat_type), intent(inout) :: a
@ -329,9 +304,8 @@ Module psb_d_tools_mod
interface psb_sprn interface psb_sprn
subroutine psb_dsprn(a, desc_a,info,clear) subroutine psb_dsprn(a, desc_a,info,clear)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_d_base_vect_type, psb_d_vect_type, & implicit none
& psb_dspmat_type, psb_d_base_sparse_mat
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_dspmat_type), intent(inout) :: a type(psb_dspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info 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) :: get_nrows => d_vect_get_nrows
procedure, pass(x) :: sizeof => d_vect_sizeof procedure, pass(x) :: sizeof => d_vect_sizeof
procedure, pass(x) :: get_fmt => d_vect_get_fmt 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) :: all => d_vect_all
procedure, pass(x) :: reall => d_vect_reall procedure, pass(x) :: reall => d_vect_reall
procedure, pass(x) :: zero => d_vect_zero 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 procedure, pass(x) :: set_vect => d_vect_set_vect
generic, public :: set => set_vect, set_scal generic, public :: set => set_vect, set_scal
procedure, pass(x) :: clone => d_vect_clone 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 end type psb_d_vect_type
public :: psb_d_vect public :: psb_d_vect
@ -296,6 +296,191 @@ contains
res = 'NULL' res = 'NULL'
if (allocated(x%v)) res = x%v%get_fmt() if (allocated(x%v)) res = x%v%get_fmt()
end function d_vect_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) function d_vect_dot_v(n,x,y) result(res)
implicit none implicit none
@ -522,197 +707,12 @@ contains
end function d_vect_asum end function d_vect_asum
subroutine d_vect_all(n, x, info, mold)
implicit none end module psb_d_vect_mod
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) module psb_d_multivect_mod
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
use psb_d_base_multivect_mod use psb_d_base_multivect_mod
use psb_const_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) :: get_ncols => d_vect_get_ncols
procedure, pass(x) :: sizeof => d_vect_sizeof procedure, pass(x) :: sizeof => d_vect_sizeof
procedure, pass(x) :: get_fmt => d_vect_get_fmt 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_v => d_vect_dot_v
!!$ procedure, pass(x) :: dot_a => d_vect_dot_a !!$ procedure, pass(x) :: dot_a => d_vect_dot_a
!!$ generic, public :: dot => dot_v, 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) :: nrm2 => d_vect_nrm2
!!$ procedure, pass(x) :: amax => d_vect_amax !!$ procedure, pass(x) :: amax => d_vect_amax
!!$ procedure, pass(x) :: asum => d_vect_asum !!$ 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 end type psb_d_multivect_type
public :: psb_d_multivect, 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() if (allocated(x%v)) res = x%v%get_fmt()
end function d_vect_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) subroutine d_vect_all(m,n, x, info, mold)
implicit none implicit none
@ -1341,4 +1134,213 @@ contains
end if end if
end subroutine d_vect_cnv 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 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 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 interface psb_ovrl
subroutine psb_iovrlm(x,desc_a,info,jx,ik,work,update,mode) subroutine psb_iovrlm(x,desc_a,info,jx,ik,work,update,mode)
use psb_desc_mod import
implicit none
integer(psb_ipk_), intent(inout), target :: x(:,:) integer(psb_ipk_), intent(inout), target :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(inout), optional, target :: work(:) integer(psb_ipk_), intent(inout), optional, target :: work(:)
integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode
end subroutine psb_iovrlm end subroutine psb_iovrlm
subroutine psb_iovrlv(x,desc_a,info,work,update,mode) subroutine psb_iovrlv(x,desc_a,info,work,update,mode)
use psb_desc_mod import
implicit none
integer(psb_ipk_), intent(inout), target :: x(:) integer(psb_ipk_), intent(inout), target :: x(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(inout), optional, target :: work(:) integer(psb_ipk_), intent(inout), optional, target :: work(:)
integer(psb_ipk_), intent(in), optional :: update,mode integer(psb_ipk_), intent(in), optional :: update,mode
end subroutine psb_iovrlv end subroutine psb_iovrlv
subroutine psb_iovrl_vect(x,desc_a,info,work,update,mode) subroutine psb_iovrl_vect(x,desc_a,info,work,update,mode)
use psb_desc_mod import
use psb_i_vect_mod implicit none
type(psb_i_vect_type), intent(inout) :: x type(psb_i_vect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -60,33 +65,32 @@ module psb_i_comm_mod
end interface psb_ovrl end interface psb_ovrl
interface psb_halo interface psb_halo
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_desc_mod import
implicit none
integer(psb_ipk_), intent(inout), target :: x(:,:) integer(psb_ipk_), intent(inout), target :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: alpha
integer(psb_ipk_), target, optional, intent(inout) :: work(:) integer(psb_ipk_), target, optional, intent(inout) :: work(:)
integer(psb_ipk_), intent(in), optional :: mode,jx,ik,data integer(psb_ipk_), intent(in), optional :: mode,jx,ik,data
character, intent(in), optional :: tran character, intent(in), optional :: tran
end subroutine psb_ihalom end subroutine psb_ihalom
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_desc_mod import
implicit none
integer(psb_ipk_), intent(inout) :: x(:) integer(psb_ipk_), intent(inout) :: x(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: alpha
integer(psb_ipk_), target, optional, intent(inout) :: work(:) integer(psb_ipk_), target, optional, intent(inout) :: work(:)
integer(psb_ipk_), intent(in), optional :: mode,data integer(psb_ipk_), intent(in), optional :: mode,data
character, intent(in), optional :: tran character, intent(in), optional :: tran
end subroutine psb_ihalov 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_desc_mod import
use psb_i_vect_mod implicit none
type(psb_i_vect_type), intent(inout) :: x type(psb_i_vect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: alpha
integer(psb_ipk_), target, optional, intent(inout) :: work(:) integer(psb_ipk_), target, optional, intent(inout) :: work(:)
integer(psb_ipk_), intent(in), optional :: mode,data integer(psb_ipk_), intent(in), optional :: mode,data
character, intent(in), optional :: tran character, intent(in), optional :: tran
@ -95,16 +99,18 @@ module psb_i_comm_mod
interface psb_scatter interface psb_scatter
subroutine psb_iscatterm(globx, locx, desc_a, info, root) subroutine psb_iscatterm(globx, locx, desc_a, info, root)
use psb_desc_mod import
implicit none
integer(psb_ipk_), intent(out) :: locx(:,:) integer(psb_ipk_), intent(out) :: locx(:,:)
integer(psb_ipk_), intent(in) :: globx(:,:) integer(psb_ipk_), intent(in) :: globx(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: root integer(psb_ipk_), intent(in), optional :: root
end subroutine psb_iscatterm end subroutine psb_iscatterm
subroutine psb_iscatterv(globx, locx, desc_a, info, root) subroutine psb_iscatterv(globx, locx, desc_a, info, root)
use psb_desc_mod import
implicit none
integer(psb_ipk_), intent(out) :: locx(:) integer(psb_ipk_), intent(out) :: locx(:)
integer(psb_ipk_), intent(in) :: globx(:) integer(psb_ipk_), intent(in) :: globx(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
@ -114,36 +120,27 @@ module psb_i_comm_mod
end interface psb_scatter end interface psb_scatter
interface psb_gather 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) 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(in) :: locx(:,:)
integer(psb_ipk_), intent(out), allocatable :: globx(:,:) integer(psb_ipk_), intent(out), allocatable :: globx(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: root integer(psb_ipk_), intent(in), optional :: root
end subroutine psb_igatherm end subroutine psb_igatherm
subroutine psb_igatherv(globx, locx, desc_a, info, root) subroutine psb_igatherv(globx, locx, desc_a, info, root)
use psb_desc_mod import
implicit none
integer(psb_ipk_), intent(in) :: locx(:) integer(psb_ipk_), intent(in) :: locx(:)
integer(psb_ipk_), intent(out), allocatable :: globx(:) integer(psb_ipk_), intent(out), allocatable :: globx(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: root integer(psb_ipk_), intent(in), optional :: root
end subroutine psb_igatherv end subroutine psb_igatherv
subroutine psb_igather_vect(globx, locx, desc_a, info, root) subroutine psb_igather_vect(globx, locx, desc_a, info, root)
use psb_desc_mod import
use psb_i_vect_mod implicit none
type(psb_i_vect_type), intent(inout) :: locx type(psb_i_vect_type), intent(inout) :: locx
integer(psb_ipk_), intent(out), allocatable :: globx(:) integer(psb_ipk_), intent(out), allocatable :: globx(:)
type(psb_desc_type), intent(in) :: desc_a 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. !!$ 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_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 use psb_i_vect_mod, only : psb_i_base_vect_type, psb_i_vect_type
interface psb_geall interface psb_geall
subroutine psb_ialloc(x, desc_a, info,n, lb) subroutine psb_ialloc(x, desc_a, info, n, lb)
import :: psb_ipk_, psb_desc_type import
integer(psb_ipk_), allocatable, intent(out) :: x(:,:) implicit none
type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), allocatable, intent(out) :: x(:,:)
integer(psb_ipk_), intent(out) :: info type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), optional, intent(in) :: n, lb integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: n, lb
end subroutine psb_ialloc end subroutine psb_ialloc
subroutine psb_iallocv(x, desc_a,info,n) subroutine psb_iallocv(x, desc_a,info,n)
import :: psb_ipk_, psb_desc_type import
integer(psb_ipk_), allocatable, intent(out) :: x(:) implicit none
type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), allocatable, intent(out) :: x(:)
integer(psb_ipk_), intent(out) :: info type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), optional, intent(in) :: n integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: n
end subroutine psb_iallocv end subroutine psb_iallocv
subroutine psb_ialloc_vect(x, desc_a,info,n) subroutine psb_ialloc_vect(x, desc_a,info,n)
import :: psb_desc_type, psb_ipk_, & import
& psb_i_base_vect_type, psb_i_vect_type implicit none
type(psb_i_vect_type), intent(out) :: x type(psb_i_vect_type), intent(out) :: x
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: n integer(psb_ipk_), optional, intent(in) :: n
end subroutine psb_ialloc_vect end subroutine psb_ialloc_vect
subroutine psb_ialloc_vect_r2(x, desc_a,info,n,lb) subroutine psb_ialloc_vect_r2(x, desc_a,info,n,lb)
import :: psb_desc_type, psb_ipk_, & import
& psb_i_base_vect_type, psb_i_vect_type implicit none
type(psb_i_vect_type), allocatable, intent(out) :: x(:) type(psb_i_vect_type), allocatable, intent(out) :: x(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info integer(psb_ipk_),intent(out) :: info
@ -70,20 +71,22 @@ module psb_i_tools_mod
interface psb_geasb interface psb_geasb
subroutine psb_iasb(x, desc_a, info) subroutine psb_iasb(x, desc_a, info)
import :: psb_ipk_, psb_desc_type import
implicit none
type(psb_desc_type), intent(in) :: desc_a 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 integer(psb_ipk_), intent(out) :: info
end subroutine psb_iasb end subroutine psb_iasb
subroutine psb_iasbv(x, desc_a, info) subroutine psb_iasbv(x, desc_a, info)
import :: psb_ipk_, psb_desc_type import
implicit none
type(psb_desc_type), intent(in) :: desc_a 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 integer(psb_ipk_), intent(out) :: info
end subroutine psb_iasbv end subroutine psb_iasbv
subroutine psb_iasb_vect(x, desc_a, info,mold, scratch) subroutine psb_iasb_vect(x, desc_a, info,mold, scratch)
import :: psb_desc_type, psb_ipk_, & import
& psb_i_base_vect_type, psb_i_vect_type implicit none
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_i_vect_type), intent(inout) :: x type(psb_i_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -91,8 +94,8 @@ module psb_i_tools_mod
logical, intent(in), optional :: scratch logical, intent(in), optional :: scratch
end subroutine psb_iasb_vect end subroutine psb_iasb_vect
subroutine psb_iasb_vect_r2(x, desc_a, info,mold, scratch) subroutine psb_iasb_vect_r2(x, desc_a, info,mold, scratch)
import :: psb_desc_type, psb_ipk_, & import
& psb_i_base_vect_type, psb_i_vect_type implicit none
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_i_vect_type), intent(inout) :: x(:) type(psb_i_vect_type), intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -101,62 +104,66 @@ module psb_i_tools_mod
end subroutine psb_iasb_vect_r2 end subroutine psb_iasb_vect_r2
end interface end interface
interface psb_gefree interface psb_gefree
subroutine psb_ifree(x, desc_a, info) subroutine psb_ifree(x, desc_a, info)
import :: psb_ipk_, psb_desc_type import
integer(psb_ipk_),allocatable, intent(inout) :: x(:,:) implicit none
type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_),allocatable, intent(inout) :: x(:,:)
integer(psb_ipk_), intent(out) :: info type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ifree end subroutine psb_ifree
subroutine psb_ifreev(x, desc_a, info) subroutine psb_ifreev(x, desc_a, info)
import :: psb_ipk_, psb_desc_type import
integer(psb_ipk_), allocatable, intent(inout) :: x(:) implicit none
type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_),allocatable, intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: info type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ifreev end subroutine psb_ifreev
subroutine psb_ifree_vect(x, desc_a, info) subroutine psb_ifree_vect(x, desc_a, info)
import :: psb_desc_type, psb_ipk_, & import
& psb_i_base_vect_type, psb_i_vect_type implicit none
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_i_vect_type), intent(inout) :: x type(psb_i_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_ifree_vect end subroutine psb_ifree_vect
subroutine psb_ifree_vect_r2(x, desc_a, info) subroutine psb_ifree_vect_r2(x, desc_a, info)
import :: psb_desc_type, psb_ipk_, & import
& psb_i_base_vect_type, psb_i_vect_type implicit none
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_i_vect_type), allocatable, intent(inout) :: x(:) type(psb_i_vect_type), allocatable, intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_ifree_vect_r2 end subroutine psb_ifree_vect_r2
end interface end interface
interface psb_geins interface psb_geins
subroutine psb_iinsi(m,irw,val, x,desc_a,info,dupl,local) subroutine psb_iinsi(m,irw,val, x, desc_a,info,dupl,local)
import :: psb_ipk_, psb_desc_type import
implicit none
integer(psb_ipk_), intent(in) :: m integer(psb_ipk_), intent(in) :: m
type(psb_desc_type), intent(in) :: desc_a 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) :: irw(:)
integer(psb_ipk_), intent(in) :: val(:,:) integer(psb_ipk_), intent(in) :: val(:,:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local logical, intent(in), optional :: local
end subroutine psb_iinsi end subroutine psb_iinsi
subroutine psb_iinsvi(m, irw,val, x,desc_a,info,dupl,local) subroutine psb_iinsvi(m, irw,val, x,desc_a,info,dupl,local)
import :: psb_ipk_, psb_desc_type import
integer(psb_ipk_), intent(in) :: m implicit none
type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(in) :: m
integer(psb_ipk_),intent(inout) :: x(:) type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(in) :: irw(:) integer(psb_ipk_),intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: val(:) integer(psb_ipk_), intent(in) :: irw(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in) :: val(:)
integer(psb_ipk_), optional, intent(in) :: dupl integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local logical, intent(in), optional :: local
end subroutine psb_iinsvi end subroutine psb_iinsvi
subroutine psb_iins_vect(m,irw,val,x,desc_a,info,dupl,local) subroutine psb_iins_vect(m,irw,val,x,desc_a,info,dupl,local)
import :: psb_desc_type, psb_ipk_, & import
& psb_i_base_vect_type, psb_i_vect_type implicit none
integer(psb_ipk_), intent(in) :: m integer(psb_ipk_), intent(in) :: m
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_i_vect_type), intent(inout) :: x type(psb_i_vect_type), intent(inout) :: x
@ -167,8 +174,8 @@ module psb_i_tools_mod
logical, intent(in), optional :: local logical, intent(in), optional :: local
end subroutine psb_iins_vect end subroutine psb_iins_vect
subroutine psb_iins_vect_v(m,irw,val,x,desc_a,info,dupl,local) subroutine psb_iins_vect_v(m,irw,val,x,desc_a,info,dupl,local)
import :: psb_desc_type, psb_ipk_, & import
& psb_i_base_vect_type, psb_i_vect_type implicit none
integer(psb_ipk_), intent(in) :: m integer(psb_ipk_), intent(in) :: m
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_i_vect_type), intent(inout) :: x type(psb_i_vect_type), intent(inout) :: x
@ -179,8 +186,8 @@ module psb_i_tools_mod
logical, intent(in), optional :: local logical, intent(in), optional :: local
end subroutine psb_iins_vect_v end subroutine psb_iins_vect_v
subroutine psb_iins_vect_r2(m,irw,val,x,desc_a,info,dupl,local) subroutine psb_iins_vect_r2(m,irw,val,x,desc_a,info,dupl,local)
import :: psb_desc_type, psb_ipk_, & import
& psb_i_base_vect_type, psb_i_vect_type implicit none
integer(psb_ipk_), intent(in) :: m integer(psb_ipk_), intent(in) :: m
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_i_vect_type), intent(inout) :: x(:) type(psb_i_vect_type), intent(inout) :: x(:)
@ -195,7 +202,8 @@ module psb_i_tools_mod
interface psb_glob_to_loc interface psb_glob_to_loc
subroutine psb_glob_to_loc2v(x,y,desc_a,info,iact,owned) 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 type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(in) :: x(:) integer(psb_ipk_),intent(in) :: x(:)
integer(psb_ipk_),intent(out) :: y(:) integer(psb_ipk_),intent(out) :: y(:)
@ -204,7 +212,8 @@ module psb_i_tools_mod
character, intent(in), optional :: iact character, intent(in), optional :: iact
end subroutine psb_glob_to_loc2v end subroutine psb_glob_to_loc2v
subroutine psb_glob_to_loc1v(x,desc_a,info,iact,owned) 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 type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(inout) :: x(:) integer(psb_ipk_),intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -212,7 +221,7 @@ module psb_i_tools_mod
character, intent(in), optional :: iact character, intent(in), optional :: iact
end subroutine psb_glob_to_loc1v end subroutine psb_glob_to_loc1v
subroutine psb_glob_to_loc2s(x,y,desc_a,info,iact,owned) subroutine psb_glob_to_loc2s(x,y,desc_a,info,iact,owned)
import :: psb_ipk_, psb_desc_type import
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(in) :: x integer(psb_ipk_),intent(in) :: x
@ -222,7 +231,7 @@ module psb_i_tools_mod
logical, intent(in), optional :: owned logical, intent(in), optional :: owned
end subroutine psb_glob_to_loc2s end subroutine psb_glob_to_loc2s
subroutine psb_glob_to_loc1s(x,desc_a,info,iact,owned) subroutine psb_glob_to_loc1s(x,desc_a,info,iact,owned)
import :: psb_ipk_, psb_desc_type import
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(inout) :: x integer(psb_ipk_),intent(inout) :: x
@ -234,7 +243,8 @@ module psb_i_tools_mod
interface psb_loc_to_glob interface psb_loc_to_glob
subroutine psb_loc_to_glob2v(x,y,desc_a,info,iact) 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 type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(in) :: x(:) integer(psb_ipk_),intent(in) :: x(:)
integer(psb_ipk_),intent(out) :: y(:) integer(psb_ipk_),intent(out) :: y(:)
@ -242,14 +252,15 @@ module psb_i_tools_mod
character, intent(in), optional :: iact character, intent(in), optional :: iact
end subroutine psb_loc_to_glob2v end subroutine psb_loc_to_glob2v
subroutine psb_loc_to_glob1v(x,desc_a,info,iact) 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 type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(inout) :: x(:) integer(psb_ipk_),intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: iact character, intent(in), optional :: iact
end subroutine psb_loc_to_glob1v end subroutine psb_loc_to_glob1v
subroutine psb_loc_to_glob2s(x,y,desc_a,info,iact) subroutine psb_loc_to_glob2s(x,y,desc_a,info,iact)
import :: psb_ipk_, psb_desc_type import
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(in) :: x integer(psb_ipk_),intent(in) :: x
@ -258,7 +269,8 @@ module psb_i_tools_mod
character, intent(in), optional :: iact character, intent(in), optional :: iact
end subroutine psb_loc_to_glob2s end subroutine psb_loc_to_glob2s
subroutine psb_loc_to_glob1s(x,desc_a,info,iact) 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 type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(inout) :: x integer(psb_ipk_),intent(inout) :: x
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -373,4 +385,3 @@ contains
end subroutine psb_local_index_v end subroutine psb_local_index_v
end module psb_i_tools_mod 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) :: get_nrows => i_vect_get_nrows
procedure, pass(x) :: sizeof => i_vect_sizeof procedure, pass(x) :: sizeof => i_vect_sizeof
procedure, pass(x) :: get_fmt => i_vect_get_fmt 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) :: all => i_vect_all
procedure, pass(x) :: reall => i_vect_reall procedure, pass(x) :: reall => i_vect_reall
procedure, pass(x) :: zero => i_vect_zero procedure, pass(x) :: zero => i_vect_zero
@ -160,11 +142,14 @@ contains
subroutine i_vect_bld_x(x,invect,mold) subroutine i_vect_bld_x(x,invect,mold)
integer(psb_ipk_), intent(in) :: invect(:) 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 class(psb_i_base_vect_type), intent(in), optional :: mold
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
class(psb_i_base_vect_type), pointer :: mld class(psb_i_base_vect_type), pointer :: mld
if (allocated(x%v)) &
& call x%free(info)
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD #ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
@ -187,11 +172,15 @@ contains
subroutine i_vect_bld_n(x,n,mold) subroutine i_vect_bld_n(x,n,mold)
integer(psb_ipk_), intent(in) :: n 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 class(psb_i_base_vect_type), intent(in), optional :: mold
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
class(psb_i_base_vect_type), pointer :: mld class(psb_i_base_vect_type), pointer :: mld
if (allocated(x%v)) &
& call x%free(info)
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD #ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
@ -220,21 +209,23 @@ contains
end if end if
end function i_vect_get_vect 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 class(psb_i_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), optional :: first, last
integer(psb_ipk_) :: info 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 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 class(psb_i_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in) :: val(:) integer(psb_ipk_), intent(in) :: val(:)
integer(psb_ipk_), optional :: first, last
integer(psb_ipk_) :: info 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 end subroutine i_vect_set_vect
@ -283,223 +274,17 @@ contains
res = 'NULL' res = 'NULL'
if (allocated(x%v)) res = x%v%get_fmt() if (allocated(x%v)) res = x%v%get_fmt()
end function i_vect_get_fmt end function i_vect_get_fmt
subroutine i_vect_all(n, x, info, mold)
function i_vect_dot_v(n,x,y) result(res)
implicit none
class(psb_i_vect_type), intent(inout) :: x, y
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: res
res = izero
if (allocated(x%v).and.allocated(y%v)) &
& res = x%v%dot(n,y%v)
end function i_vect_dot_v
function i_vect_dot_a(n,x,y) result(res)
implicit none
class(psb_i_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in) :: y(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: res
res = izero
if (allocated(x%v)) &
& res = x%v%dot(n,y)
end function i_vect_dot_a
subroutine i_vect_axpby_v(m,alpha, x, beta, y, info)
use psi_serial_mod
implicit none
integer(psb_ipk_), intent(in) :: m
class(psb_i_vect_type), intent(inout) :: x
class(psb_i_vect_type), intent(inout) :: y
integer(psb_ipk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info
if (allocated(x%v).and.allocated(y%v)) then
call y%v%axpby(m,alpha,x%v,beta,info)
else
info = psb_err_invalid_vect_state_
end if
end subroutine i_vect_axpby_v
subroutine i_vect_axpby_a(m,alpha, x, beta, y, info)
use psi_serial_mod
implicit none
integer(psb_ipk_), intent(in) :: m
integer(psb_ipk_), intent(in) :: x(:)
class(psb_i_vect_type), intent(inout) :: y
integer(psb_ipk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info
if (allocated(y%v)) &
& call y%v%axpby(m,alpha,x,beta,info)
end subroutine i_vect_axpby_a
subroutine i_vect_mlt_v(x, y, info)
use psi_serial_mod
implicit none
class(psb_i_vect_type), intent(inout) :: x
class(psb_i_vect_type), intent(inout) :: y
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
info = 0
if (allocated(x%v).and.allocated(y%v)) &
& call y%v%mlt(x%v,info)
end subroutine i_vect_mlt_v
subroutine i_vect_mlt_a(x, y, info)
use psi_serial_mod
implicit none
integer(psb_ipk_), intent(in) :: x(:)
class(psb_i_vect_type), intent(inout) :: y
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
info = 0
if (allocated(y%v)) &
& call y%v%mlt(x,info)
end subroutine i_vect_mlt_a
subroutine i_vect_mlt_a_2(alpha,x,y,beta,z,info)
use psi_serial_mod
implicit none
integer(psb_ipk_), intent(in) :: alpha,beta
integer(psb_ipk_), intent(in) :: y(:)
integer(psb_ipk_), intent(in) :: x(:)
class(psb_i_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
info = 0
if (allocated(z%v)) &
& call z%v%mlt(alpha,x,y,beta,info)
end subroutine i_vect_mlt_a_2
subroutine i_vect_mlt_v_2(alpha,x,y,beta,z,info,conjgx,conjgy)
use psi_serial_mod
implicit none
integer(psb_ipk_), intent(in) :: alpha,beta
class(psb_i_vect_type), intent(inout) :: x
class(psb_i_vect_type), intent(inout) :: y
class(psb_i_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
character(len=1), intent(in), optional :: conjgx, conjgy
integer(psb_ipk_) :: i, n
info = 0
if (allocated(x%v).and.allocated(y%v).and.&
& allocated(z%v)) &
& call z%v%mlt(alpha,x%v,y%v,beta,info,conjgx,conjgy)
end subroutine i_vect_mlt_v_2
subroutine i_vect_mlt_av(alpha,x,y,beta,z,info)
use psi_serial_mod
implicit none
integer(psb_ipk_), intent(in) :: alpha,beta
integer(psb_ipk_), intent(in) :: x(:)
class(psb_i_vect_type), intent(inout) :: y
class(psb_i_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
info = 0
if (allocated(z%v).and.allocated(y%v)) &
& call z%v%mlt(alpha,x,y%v,beta,info)
end subroutine i_vect_mlt_av
subroutine i_vect_mlt_va(alpha,x,y,beta,z,info)
use psi_serial_mod
implicit none
integer(psb_ipk_), intent(in) :: alpha,beta
integer(psb_ipk_), intent(in) :: y(:)
class(psb_i_vect_type), intent(inout) :: x
class(psb_i_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
info = 0
if (allocated(z%v).and.allocated(x%v)) &
& call z%v%mlt(alpha,x%v,y,beta,info)
end subroutine i_vect_mlt_va
subroutine i_vect_scal(alpha, x)
use psi_serial_mod
implicit none
class(psb_i_vect_type), intent(inout) :: x
integer(psb_ipk_), intent (in) :: alpha
if (allocated(x%v)) call x%v%scal(alpha)
end subroutine i_vect_scal
function i_vect_nrm2(n,x) result(res)
implicit none
class(psb_i_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: res
if (allocated(x%v)) then
res = x%v%nrm2(n)
else
res = izero
end if
end function i_vect_nrm2
function i_vect_amax(n,x) result(res)
implicit none implicit none
class(psb_i_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in) :: n 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 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 class(psb_i_base_vect_type), intent(in), optional :: mold
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
if (allocated(x%v)) &
& call x%free(info)
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD #ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
@ -653,6 +438,7 @@ contains
end subroutine i_vect_ins_v end subroutine i_vect_ins_v
subroutine i_vect_cnv(x,mold) subroutine i_vect_cnv(x,mold)
class(psb_i_vect_type), intent(inout) :: x class(psb_i_vect_type), intent(inout) :: x
class(psb_i_base_vect_type), intent(in), optional :: mold 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_i_base_multivect_mod
use psb_const_mod use psb_const_mod
private !private
type psb_i_multivect_type type psb_i_multivect_type
class(psb_i_base_multivect_type), allocatable :: v 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) :: get_ncols => i_vect_get_ncols
procedure, pass(x) :: sizeof => i_vect_sizeof procedure, pass(x) :: sizeof => i_vect_sizeof
procedure, pass(x) :: get_fmt => i_vect_get_fmt 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) :: all => i_vect_all
procedure, pass(x) :: reall => i_vect_reall procedure, pass(x) :: reall => i_vect_reall
procedure, pass(x) :: zero => i_vect_zero procedure, pass(x) :: zero => i_vect_zero
procedure, pass(x) :: asb => i_vect_asb procedure, pass(x) :: asb => i_vect_asb
procedure, pass(x) :: sync => i_vect_sync 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) :: free => i_vect_free
procedure, pass(x) :: ins => i_vect_ins procedure, pass(x) :: ins => i_vect_ins
procedure, pass(x) :: bld_x => i_vect_bld_x 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 procedure, pass(x) :: set_vect => i_vect_set_vect
generic, public :: set => set_vect, set_scal generic, public :: set => set_vect, set_scal
procedure, pass(x) :: clone => i_vect_clone 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 end type psb_i_multivect_type
public :: psb_i_multivect, psb_i_multivect_type,& public :: psb_i_multivect, psb_i_multivect_type,&
& psb_set_multivect_default, psb_get_multivect_default & psb_set_multivect_default, psb_get_multivect_default
private
interface psb_i_multivect interface psb_i_multivect
module procedure constructor, size_const module procedure constructor, size_const
end interface end interface
@ -907,7 +677,7 @@ contains
function i_vect_get_nrows(x) result(res) function i_vect_get_nrows(x) result(res)
implicit none implicit none
class(psb_i_multivect_type), intent(in) :: x class(psb_i_multivect_type), intent(in) :: x
integer(psb_ipk_) :: res integer(psb_ipk_) :: res
res = 0 res = 0
if (allocated(x%v)) res = x%v%get_nrows() if (allocated(x%v)) res = x%v%get_nrows()
end function i_vect_get_nrows end function i_vect_get_nrows
@ -936,214 +706,6 @@ contains
if (allocated(x%v)) res = x%v%get_fmt() if (allocated(x%v)) res = x%v%get_fmt()
end function i_vect_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) subroutine i_vect_all(m,n, x, info, mold)
implicit none implicit none
@ -1306,4 +868,5 @@ contains
end if end if
end subroutine i_vect_cnv end subroutine i_vect_cnv
end module psb_i_multivect_mod 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_const_mod
use psb_error_mod use psb_error_mod
use psb_i_base_vect_mod
use psb_realloc_mod use psb_realloc_mod
use psb_i_base_vect_mod
!> \namespace psb_base_mod \class psb_s_base_vect_type !> \namespace psb_base_mod \class psb_s_base_vect_type
!! The 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_scal => s_base_set_scal
procedure, pass(x) :: set_vect => s_base_set_vect procedure, pass(x) :: set_vect => s_base_set_vect
generic, public :: set => set_vect, set_scal 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 ! Dot product and AXPBY
@ -154,19 +168,7 @@ module psb_s_base_vect_mod
procedure, pass(x) :: nrm2 => s_base_nrm2 procedure, pass(x) :: nrm2 => s_base_nrm2
procedure, pass(x) :: amax => s_base_amax procedure, pass(x) :: amax => s_base_amax
procedure, pass(x) :: asum => s_base_asum 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 end type psb_s_base_vect_type
public :: psb_s_base_vect public :: psb_s_base_vect
@ -668,6 +670,36 @@ contains
end subroutine s_base_set_scal 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 ! Overwrite with absolute value
! !
@ -680,7 +712,7 @@ contains
class(psb_s_base_vect_type), intent(inout) :: x class(psb_s_base_vect_type), intent(inout) :: x
if (allocated(x%v)) then 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) x%v = abs(x%v)
call x%set_host() call x%set_host()
end if end if
@ -693,40 +725,12 @@ contains
if (.not.x%is_host()) call x%sync() if (.not.x%is_host()) call x%sync()
if (allocated(x%v)) then 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%absval()
call y%set_host()
end if end if
end subroutine s_base_absval2 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 ! Dot products
! !
@ -2422,6 +2426,5 @@ contains
!!$ call y%sct(n,idx%v(i:),x,beta) !!$ call y%sct(n,idx%v(i:),x,beta)
!!$ !!$
!!$ end subroutine s_base_mv_sctb_x !!$ end subroutine s_base_mv_sctb_x
end module psb_s_base_multivect_mod 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 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 interface psb_ovrl
subroutine psb_sovrlm(x,desc_a,info,jx,ik,work,update,mode) subroutine psb_sovrlm(x,desc_a,info,jx,ik,work,update,mode)
use psb_desc_mod import
implicit none
real(psb_spk_), intent(inout), target :: x(:,:) real(psb_spk_), intent(inout), target :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_spk_), intent(inout), optional, target :: work(:) real(psb_spk_), intent(inout), optional, target :: work(:)
integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode
end subroutine psb_sovrlm end subroutine psb_sovrlm
subroutine psb_sovrlv(x,desc_a,info,work,update,mode) subroutine psb_sovrlv(x,desc_a,info,work,update,mode)
use psb_desc_mod import
implicit none
real(psb_spk_), intent(inout), target :: x(:) real(psb_spk_), intent(inout), target :: x(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_spk_), intent(inout), optional, target :: work(:) real(psb_spk_), intent(inout), optional, target :: work(:)
integer(psb_ipk_), intent(in), optional :: update,mode integer(psb_ipk_), intent(in), optional :: update,mode
end subroutine psb_sovrlv end subroutine psb_sovrlv
subroutine psb_sovrl_vect(x,desc_a,info,work,update,mode) subroutine psb_sovrl_vect(x,desc_a,info,work,update,mode)
use psb_desc_mod import
use psb_s_vect_mod implicit none
type(psb_s_vect_type), intent(inout) :: x type(psb_s_vect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -60,33 +66,32 @@ module psb_s_comm_mod
end interface psb_ovrl end interface psb_ovrl
interface psb_halo interface psb_halo
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_desc_mod import
implicit none
real(psb_spk_), intent(inout), target :: x(:,:) real(psb_spk_), intent(inout), target :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_spk_), intent(in), optional :: alpha
real(psb_spk_), target, optional, intent(inout) :: work(:) real(psb_spk_), target, optional, intent(inout) :: work(:)
integer(psb_ipk_), intent(in), optional :: mode,jx,ik,data integer(psb_ipk_), intent(in), optional :: mode,jx,ik,data
character, intent(in), optional :: tran character, intent(in), optional :: tran
end subroutine psb_shalom end subroutine psb_shalom
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_desc_mod import
implicit none
real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(inout) :: x(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_spk_), intent(in), optional :: alpha
real(psb_spk_), target, optional, intent(inout) :: work(:) real(psb_spk_), target, optional, intent(inout) :: work(:)
integer(psb_ipk_), intent(in), optional :: mode,data integer(psb_ipk_), intent(in), optional :: mode,data
character, intent(in), optional :: tran character, intent(in), optional :: tran
end subroutine psb_shalov 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_desc_mod import
use psb_s_vect_mod implicit none
type(psb_s_vect_type), intent(inout) :: x type(psb_s_vect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_spk_), intent(in), optional :: alpha
real(psb_spk_), target, optional, intent(inout) :: work(:) real(psb_spk_), target, optional, intent(inout) :: work(:)
integer(psb_ipk_), intent(in), optional :: mode,data integer(psb_ipk_), intent(in), optional :: mode,data
character, intent(in), optional :: tran character, intent(in), optional :: tran
@ -95,16 +100,18 @@ module psb_s_comm_mod
interface psb_scatter interface psb_scatter
subroutine psb_sscatterm(globx, locx, desc_a, info, root) subroutine psb_sscatterm(globx, locx, desc_a, info, root)
use psb_desc_mod import
implicit none
real(psb_spk_), intent(out) :: locx(:,:) real(psb_spk_), intent(out) :: locx(:,:)
real(psb_spk_), intent(in) :: globx(:,:) real(psb_spk_), intent(in) :: globx(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: root integer(psb_ipk_), intent(in), optional :: root
end subroutine psb_sscatterm end subroutine psb_sscatterm
subroutine psb_sscatterv(globx, locx, desc_a, info, root) subroutine psb_sscatterv(globx, locx, desc_a, info, root)
use psb_desc_mod import
implicit none
real(psb_spk_), intent(out) :: locx(:) real(psb_spk_), intent(out) :: locx(:)
real(psb_spk_), intent(in) :: globx(:) real(psb_spk_), intent(in) :: globx(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
@ -114,9 +121,8 @@ module psb_s_comm_mod
end interface psb_scatter end interface psb_scatter
interface psb_gather interface psb_gather
subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc) subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
use psb_desc_mod import
use psb_mat_mod
implicit none implicit none
type(psb_sspmat_type), intent(inout) :: loca type(psb_sspmat_type), intent(inout) :: loca
type(psb_sspmat_type), intent(out) :: globa type(psb_sspmat_type), intent(out) :: globa
@ -126,24 +132,26 @@ module psb_s_comm_mod
logical, intent(in), optional :: keepnum,keeploc logical, intent(in), optional :: keepnum,keeploc
end subroutine psb_ssp_allgather end subroutine psb_ssp_allgather
subroutine psb_sgatherm(globx, locx, desc_a, info, root) 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(in) :: locx(:,:)
real(psb_spk_), intent(out), allocatable :: globx(:,:) real(psb_spk_), intent(out), allocatable :: globx(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: root integer(psb_ipk_), intent(in), optional :: root
end subroutine psb_sgatherm end subroutine psb_sgatherm
subroutine psb_sgatherv(globx, locx, desc_a, info, root) subroutine psb_sgatherv(globx, locx, desc_a, info, root)
use psb_desc_mod import
implicit none
real(psb_spk_), intent(in) :: locx(:) real(psb_spk_), intent(in) :: locx(:)
real(psb_spk_), intent(out), allocatable :: globx(:) real(psb_spk_), intent(out), allocatable :: globx(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: root integer(psb_ipk_), intent(in), optional :: root
end subroutine psb_sgatherv end subroutine psb_sgatherv
subroutine psb_sgather_vect(globx, locx, desc_a, info, root) subroutine psb_sgather_vect(globx, locx, desc_a, info, root)
use psb_desc_mod import
use psb_s_vect_mod implicit none
type(psb_s_vect_type), intent(inout) :: locx type(psb_s_vect_type), intent(inout) :: locx
real(psb_spk_), intent(out), allocatable :: globx(:) real(psb_spk_), intent(out), allocatable :: globx(:)
type(psb_desc_type), intent(in) :: desc_a 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 interface psb_geall
subroutine psb_salloc(x, desc_a, info, n, lb) subroutine psb_salloc(x, desc_a, info, n, lb)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_s_base_vect_type, psb_s_vect_type, &
& psb_sspmat_type, psb_s_base_sparse_mat
implicit none implicit none
real(psb_spk_), allocatable, intent(out) :: x(:,:) real(psb_spk_), allocatable, intent(out) :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a 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 integer(psb_ipk_), optional, intent(in) :: n, lb
end subroutine psb_salloc end subroutine psb_salloc
subroutine psb_sallocv(x, desc_a,info,n) subroutine psb_sallocv(x, desc_a,info,n)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_s_base_vect_type, psb_s_vect_type, & implicit none
& psb_sspmat_type, psb_s_base_sparse_mat
real(psb_spk_), allocatable, intent(out) :: x(:) real(psb_spk_), allocatable, intent(out) :: x(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: n integer(psb_ipk_), optional, intent(in) :: n
end subroutine psb_sallocv end subroutine psb_sallocv
subroutine psb_salloc_vect(x, desc_a,info,n) subroutine psb_salloc_vect(x, desc_a,info,n)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_s_base_vect_type, psb_s_vect_type, & implicit none
& psb_sspmat_type, psb_s_base_sparse_mat
type(psb_s_vect_type), intent(out) :: x type(psb_s_vect_type), intent(out) :: x
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: n integer(psb_ipk_), optional, intent(in) :: n
end subroutine psb_salloc_vect end subroutine psb_salloc_vect
subroutine psb_salloc_vect_r2(x, desc_a,info,n,lb) subroutine psb_salloc_vect_r2(x, desc_a,info,n,lb)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_s_base_vect_type, psb_s_vect_type, & implicit none
& psb_sspmat_type, psb_s_base_sparse_mat
type(psb_s_vect_type), allocatable, intent(out) :: x(:) type(psb_s_vect_type), allocatable, intent(out) :: x(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info integer(psb_ipk_),intent(out) :: info
@ -77,25 +72,22 @@ Module psb_s_tools_mod
interface psb_geasb interface psb_geasb
subroutine psb_sasb(x, desc_a, info) subroutine psb_sasb(x, desc_a, info)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_s_base_vect_type, psb_s_vect_type, & implicit none
& psb_sspmat_type, psb_s_base_sparse_mat
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
real(psb_spk_), allocatable, intent(inout) :: x(:,:) real(psb_spk_), allocatable, intent(inout) :: x(:,:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_sasb end subroutine psb_sasb
subroutine psb_sasbv(x, desc_a, info) subroutine psb_sasbv(x, desc_a, info)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_s_base_vect_type, psb_s_vect_type, & implicit none
& psb_sspmat_type, psb_s_base_sparse_mat
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
real(psb_spk_), allocatable, intent(inout) :: x(:) real(psb_spk_), allocatable, intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_sasbv end subroutine psb_sasbv
subroutine psb_sasb_vect(x, desc_a, info,mold, scratch) subroutine psb_sasb_vect(x, desc_a, info,mold, scratch)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_s_base_vect_type, psb_s_vect_type, & implicit none
& psb_sspmat_type, psb_s_base_sparse_mat
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_s_vect_type), intent(inout) :: x type(psb_s_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -103,9 +95,8 @@ Module psb_s_tools_mod
logical, intent(in), optional :: scratch logical, intent(in), optional :: scratch
end subroutine psb_sasb_vect end subroutine psb_sasb_vect
subroutine psb_sasb_vect_r2(x, desc_a, info,mold, scratch) subroutine psb_sasb_vect_r2(x, desc_a, info,mold, scratch)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_s_base_vect_type, psb_s_vect_type, & implicit none
& psb_sspmat_type, psb_s_base_sparse_mat
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_s_vect_type), intent(inout) :: x(:) type(psb_s_vect_type), intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -114,51 +105,31 @@ Module psb_s_tools_mod
end subroutine psb_sasb_vect_r2 end subroutine psb_sasb_vect_r2
end interface 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 interface psb_gefree
subroutine psb_sfree(x, desc_a, info) subroutine psb_sfree(x, desc_a, info)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_s_base_vect_type, psb_s_vect_type, & implicit none
& psb_sspmat_type, psb_s_base_sparse_mat
real(psb_spk_),allocatable, intent(inout) :: x(:,:) real(psb_spk_),allocatable, intent(inout) :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_sfree end subroutine psb_sfree
subroutine psb_sfreev(x, desc_a, info) subroutine psb_sfreev(x, desc_a, info)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_s_base_vect_type, psb_s_vect_type, & implicit none
& psb_sspmat_type, psb_s_base_sparse_mat
real(psb_spk_),allocatable, intent(inout) :: x(:) real(psb_spk_),allocatable, intent(inout) :: x(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_sfreev end subroutine psb_sfreev
subroutine psb_sfree_vect(x, desc_a, info) subroutine psb_sfree_vect(x, desc_a, info)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_s_base_vect_type, psb_s_vect_type, & implicit none
& psb_sspmat_type, psb_s_base_sparse_mat
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_s_vect_type), intent(inout) :: x type(psb_s_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_sfree_vect end subroutine psb_sfree_vect
subroutine psb_sfree_vect_r2(x, desc_a, info) subroutine psb_sfree_vect_r2(x, desc_a, info)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_s_base_vect_type, psb_s_vect_type, & implicit none
& psb_sspmat_type, psb_s_base_sparse_mat
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_s_vect_type), allocatable, intent(inout) :: x(:) type(psb_s_vect_type), allocatable, intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -168,9 +139,8 @@ Module psb_s_tools_mod
interface psb_geins interface psb_geins
subroutine psb_sinsi(m,irw,val, x, desc_a,info,dupl,local) subroutine psb_sinsi(m,irw,val, x, desc_a,info,dupl,local)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_s_base_vect_type, psb_s_vect_type, & implicit none
& psb_sspmat_type, psb_s_base_sparse_mat
integer(psb_ipk_), intent(in) :: m integer(psb_ipk_), intent(in) :: m
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
real(psb_spk_),intent(inout) :: x(:,:) real(psb_spk_),intent(inout) :: x(:,:)
@ -181,9 +151,8 @@ Module psb_s_tools_mod
logical, intent(in), optional :: local logical, intent(in), optional :: local
end subroutine psb_sinsi end subroutine psb_sinsi
subroutine psb_sinsvi(m, irw,val, x,desc_a,info,dupl,local) subroutine psb_sinsvi(m, irw,val, x,desc_a,info,dupl,local)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_s_base_vect_type, psb_s_vect_type, & implicit none
& psb_sspmat_type, psb_s_base_sparse_mat
integer(psb_ipk_), intent(in) :: m integer(psb_ipk_), intent(in) :: m
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
real(psb_spk_),intent(inout) :: x(:) real(psb_spk_),intent(inout) :: x(:)
@ -194,9 +163,8 @@ Module psb_s_tools_mod
logical, intent(in), optional :: local logical, intent(in), optional :: local
end subroutine psb_sinsvi end subroutine psb_sinsvi
subroutine psb_sins_vect(m,irw,val,x,desc_a,info,dupl,local) subroutine psb_sins_vect(m,irw,val,x,desc_a,info,dupl,local)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_s_base_vect_type, psb_s_vect_type, & implicit none
& psb_sspmat_type, psb_s_base_sparse_mat
integer(psb_ipk_), intent(in) :: m integer(psb_ipk_), intent(in) :: m
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_s_vect_type), intent(inout) :: x type(psb_s_vect_type), intent(inout) :: x
@ -207,9 +175,8 @@ Module psb_s_tools_mod
logical, intent(in), optional :: local logical, intent(in), optional :: local
end subroutine psb_sins_vect end subroutine psb_sins_vect
subroutine psb_sins_vect_v(m,irw,val,x,desc_a,info,dupl,local) subroutine psb_sins_vect_v(m,irw,val,x,desc_a,info,dupl,local)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_s_base_vect_type, psb_s_vect_type, psb_i_vect_type, & implicit none
& psb_sspmat_type, psb_s_base_sparse_mat
integer(psb_ipk_), intent(in) :: m integer(psb_ipk_), intent(in) :: m
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_s_vect_type), intent(inout) :: x type(psb_s_vect_type), intent(inout) :: x
@ -220,9 +187,8 @@ Module psb_s_tools_mod
logical, intent(in), optional :: local logical, intent(in), optional :: local
end subroutine psb_sins_vect_v end subroutine psb_sins_vect_v
subroutine psb_sins_vect_r2(m,irw,val,x,desc_a,info,dupl,local) subroutine psb_sins_vect_r2(m,irw,val,x,desc_a,info,dupl,local)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_s_base_vect_type, psb_s_vect_type, & implicit none
& psb_sspmat_type, psb_s_base_sparse_mat
integer(psb_ipk_), intent(in) :: m integer(psb_ipk_), intent(in) :: m
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_s_vect_type), intent(inout) :: x(:) type(psb_s_vect_type), intent(inout) :: x(:)
@ -236,9 +202,8 @@ Module psb_s_tools_mod
interface psb_cdbldext interface psb_cdbldext
Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info,extype) Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info,extype)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_s_base_vect_type, psb_s_vect_type, & implicit none
& psb_sspmat_type, psb_s_base_sparse_mat
integer(psb_ipk_), intent(in) :: novr integer(psb_ipk_), intent(in) :: novr
Type(psb_sspmat_type), Intent(in) :: a Type(psb_sspmat_type), Intent(in) :: a
Type(psb_desc_type), Intent(inout), target :: desc_a Type(psb_desc_type), Intent(inout), target :: desc_a
@ -248,11 +213,26 @@ Module psb_s_tools_mod
end Subroutine psb_scdbldext end Subroutine psb_scdbldext
end interface 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 interface psb_spall
subroutine psb_sspalloc(a, desc_a, info, nnz) subroutine psb_sspalloc(a, desc_a, info, nnz)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_s_base_vect_type, psb_s_vect_type, & implicit none
& psb_sspmat_type, psb_s_base_sparse_mat
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_sspmat_type), intent(inout) :: a type(psb_sspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -262,9 +242,8 @@ Module psb_s_tools_mod
interface psb_spasb interface psb_spasb
subroutine psb_sspasb(a,desc_a, info, afmt, upd, dupl,mold) subroutine psb_sspasb(a,desc_a, info, afmt, upd, dupl,mold)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_s_base_vect_type, psb_s_vect_type, & implicit none
& psb_sspmat_type, psb_s_base_sparse_mat
type(psb_sspmat_type), intent (inout) :: a type(psb_sspmat_type), intent (inout) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -276,9 +255,8 @@ Module psb_s_tools_mod
interface psb_spfree interface psb_spfree
subroutine psb_sspfree(a, desc_a,info) subroutine psb_sspfree(a, desc_a,info)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_s_base_vect_type, psb_s_vect_type, & implicit none
& psb_sspmat_type, psb_s_base_sparse_mat
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_sspmat_type), intent(inout) ::a type(psb_sspmat_type), intent(inout) ::a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -288,9 +266,8 @@ Module psb_s_tools_mod
interface psb_spins interface psb_spins
subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_s_base_vect_type, psb_s_vect_type, & implicit none
& psb_sspmat_type, psb_s_base_sparse_mat
type(psb_desc_type), intent(inout) :: desc_a type(psb_desc_type), intent(inout) :: desc_a
type(psb_sspmat_type), intent(inout) :: a type(psb_sspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(in) :: nz,ia(:),ja(:) integer(psb_ipk_), intent(in) :: nz,ia(:),ja(:)
@ -301,9 +278,8 @@ Module psb_s_tools_mod
end subroutine psb_sspins end subroutine psb_sspins
subroutine psb_sspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local) subroutine psb_sspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local)
use psb_i_vect_mod, only : psb_i_vect_type use psb_i_vect_mod, only : psb_i_vect_type
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_s_base_vect_type, psb_s_vect_type,& implicit none
& psb_sspmat_type, psb_s_base_sparse_mat
type(psb_desc_type), intent(inout) :: desc_a type(psb_desc_type), intent(inout) :: desc_a
type(psb_sspmat_type), intent(inout) :: a type(psb_sspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(in) :: nz integer(psb_ipk_), intent(in) :: nz
@ -314,9 +290,8 @@ Module psb_s_tools_mod
logical, intent(in), optional :: local logical, intent(in), optional :: local
end subroutine psb_sspins_v end subroutine psb_sspins_v
subroutine psb_sspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) subroutine psb_sspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_s_base_vect_type, psb_s_vect_type, & implicit none
& psb_sspmat_type, psb_s_base_sparse_mat
type(psb_desc_type), intent(in) :: desc_ar type(psb_desc_type), intent(in) :: desc_ar
type(psb_desc_type), intent(inout) :: desc_ac type(psb_desc_type), intent(inout) :: desc_ac
type(psb_sspmat_type), intent(inout) :: a type(psb_sspmat_type), intent(inout) :: a
@ -329,9 +304,8 @@ Module psb_s_tools_mod
interface psb_sprn interface psb_sprn
subroutine psb_ssprn(a, desc_a,info,clear) subroutine psb_ssprn(a, desc_a,info,clear)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import
& psb_s_base_vect_type, psb_s_vect_type, & implicit none
& psb_sspmat_type, psb_s_base_sparse_mat
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_sspmat_type), intent(inout) :: a type(psb_sspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info 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) :: get_nrows => s_vect_get_nrows
procedure, pass(x) :: sizeof => s_vect_sizeof procedure, pass(x) :: sizeof => s_vect_sizeof
procedure, pass(x) :: get_fmt => s_vect_get_fmt 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) :: all => s_vect_all
procedure, pass(x) :: reall => s_vect_reall procedure, pass(x) :: reall => s_vect_reall
procedure, pass(x) :: zero => s_vect_zero 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 procedure, pass(x) :: set_vect => s_vect_set_vect
generic, public :: set => set_vect, set_scal generic, public :: set => set_vect, set_scal
procedure, pass(x) :: clone => s_vect_clone 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 end type psb_s_vect_type
public :: psb_s_vect public :: psb_s_vect
@ -296,6 +296,191 @@ contains
res = 'NULL' res = 'NULL'
if (allocated(x%v)) res = x%v%get_fmt() if (allocated(x%v)) res = x%v%get_fmt()
end function s_vect_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) function s_vect_dot_v(n,x,y) result(res)
implicit none implicit none
@ -522,197 +707,12 @@ contains
end function s_vect_asum end function s_vect_asum
subroutine s_vect_all(n, x, info, mold)
implicit none end module psb_s_vect_mod
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) module psb_s_multivect_mod
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
use psb_s_base_multivect_mod use psb_s_base_multivect_mod
use psb_const_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) :: get_ncols => s_vect_get_ncols
procedure, pass(x) :: sizeof => s_vect_sizeof procedure, pass(x) :: sizeof => s_vect_sizeof
procedure, pass(x) :: get_fmt => s_vect_get_fmt 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_v => s_vect_dot_v
!!$ procedure, pass(x) :: dot_a => s_vect_dot_a !!$ procedure, pass(x) :: dot_a => s_vect_dot_a
!!$ generic, public :: dot => dot_v, 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) :: nrm2 => s_vect_nrm2
!!$ procedure, pass(x) :: amax => s_vect_amax !!$ procedure, pass(x) :: amax => s_vect_amax
!!$ procedure, pass(x) :: asum => s_vect_asum !!$ 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 end type psb_s_multivect_type
public :: psb_s_multivect, 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() if (allocated(x%v)) res = x%v%get_fmt()
end function s_vect_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) subroutine s_vect_all(m,n, x, info, mold)
implicit none implicit none
@ -1341,4 +1134,213 @@ contains
end if end if
end subroutine s_vect_cnv 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 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_const_mod
use psb_error_mod use psb_error_mod
use psb_i_base_vect_mod
use psb_realloc_mod use psb_realloc_mod
use psb_i_base_vect_mod
!> \namespace psb_base_mod \class psb_z_base_vect_type !> \namespace psb_base_mod \class psb_z_base_vect_type
!! The 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_scal => z_base_set_scal
procedure, pass(x) :: set_vect => z_base_set_vect procedure, pass(x) :: set_vect => z_base_set_vect
generic, public :: set => set_vect, set_scal 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 ! Dot product and AXPBY
@ -154,19 +168,7 @@ module psb_z_base_vect_mod
procedure, pass(x) :: nrm2 => z_base_nrm2 procedure, pass(x) :: nrm2 => z_base_nrm2
procedure, pass(x) :: amax => z_base_amax procedure, pass(x) :: amax => z_base_amax
procedure, pass(x) :: asum => z_base_asum 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 end type psb_z_base_vect_type
public :: psb_z_base_vect public :: psb_z_base_vect
@ -668,6 +670,36 @@ contains
end subroutine z_base_set_scal 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 ! Overwrite with absolute value
! !
@ -680,7 +712,7 @@ contains
class(psb_z_base_vect_type), intent(inout) :: x class(psb_z_base_vect_type), intent(inout) :: x
if (allocated(x%v)) then 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) x%v = abs(x%v)
call x%set_host() call x%set_host()
end if end if
@ -693,40 +725,12 @@ contains
if (.not.x%is_host()) call x%sync() if (.not.x%is_host()) call x%sync()
if (allocated(x%v)) then 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%absval()
call y%set_host()
end if end if
end subroutine z_base_absval2 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 ! Dot products
! !
@ -2422,6 +2426,5 @@ contains
!!$ call y%sct(n,idx%v(i:),x,beta) !!$ call y%sct(n,idx%v(i:),x,beta)
!!$ !!$
!!$ end subroutine z_base_mv_sctb_x !!$ end subroutine z_base_mv_sctb_x
end module psb_z_base_multivect_mod 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 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 interface psb_ovrl
subroutine psb_zovrlm(x,desc_a,info,jx,ik,work,update,mode) subroutine psb_zovrlm(x,desc_a,info,jx,ik,work,update,mode)
use psb_desc_mod import
implicit none
complex(psb_dpk_), intent(inout), target :: x(:,:) complex(psb_dpk_), intent(inout), target :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
complex(psb_dpk_), intent(inout), optional, target :: work(:) complex(psb_dpk_), intent(inout), optional, target :: work(:)
integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode
end subroutine psb_zovrlm end subroutine psb_zovrlm
subroutine psb_zovrlv(x,desc_a,info,work,update,mode) subroutine psb_zovrlv(x,desc_a,info,work,update,mode)
use psb_desc_mod import
implicit none
complex(psb_dpk_), intent(inout), target :: x(:) complex(psb_dpk_), intent(inout), target :: x(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
complex(psb_dpk_), intent(inout), optional, target :: work(:) complex(psb_dpk_), intent(inout), optional, target :: work(:)
integer(psb_ipk_), intent(in), optional :: update,mode integer(psb_ipk_), intent(in), optional :: update,mode
end subroutine psb_zovrlv end subroutine psb_zovrlv
subroutine psb_zovrl_vect(x,desc_a,info,work,update,mode) subroutine psb_zovrl_vect(x,desc_a,info,work,update,mode)
use psb_desc_mod import
use psb_z_vect_mod implicit none
type(psb_z_vect_type), intent(inout) :: x type(psb_z_vect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -60,33 +66,32 @@ module psb_z_comm_mod
end interface psb_ovrl end interface psb_ovrl
interface psb_halo interface psb_halo
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_desc_mod import
implicit none
complex(psb_dpk_), intent(inout), target :: x(:,:) complex(psb_dpk_), intent(inout), target :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
complex(psb_dpk_), intent(in), optional :: alpha
complex(psb_dpk_), target, optional, intent(inout) :: work(:) complex(psb_dpk_), target, optional, intent(inout) :: work(:)
integer(psb_ipk_), intent(in), optional :: mode,jx,ik,data integer(psb_ipk_), intent(in), optional :: mode,jx,ik,data
character, intent(in), optional :: tran character, intent(in), optional :: tran
end subroutine psb_zhalom end subroutine psb_zhalom
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_desc_mod import
implicit none
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
complex(psb_dpk_), intent(in), optional :: alpha
complex(psb_dpk_), target, optional, intent(inout) :: work(:) complex(psb_dpk_), target, optional, intent(inout) :: work(:)
integer(psb_ipk_), intent(in), optional :: mode,data integer(psb_ipk_), intent(in), optional :: mode,data
character, intent(in), optional :: tran character, intent(in), optional :: tran
end subroutine psb_zhalov 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_desc_mod import
use psb_z_vect_mod implicit none
type(psb_z_vect_type), intent(inout) :: x type(psb_z_vect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
complex(psb_dpk_), intent(in), optional :: alpha
complex(psb_dpk_), target, optional, intent(inout) :: work(:) complex(psb_dpk_), target, optional, intent(inout) :: work(:)
integer(psb_ipk_), intent(in), optional :: mode,data integer(psb_ipk_), intent(in), optional :: mode,data
character, intent(in), optional :: tran character, intent(in), optional :: tran
@ -95,16 +100,18 @@ module psb_z_comm_mod
interface psb_scatter interface psb_scatter
subroutine psb_zscatterm(globx, locx, desc_a, info, root) subroutine psb_zscatterm(globx, locx, desc_a, info, root)
use psb_desc_mod import
implicit none
complex(psb_dpk_), intent(out) :: locx(:,:) complex(psb_dpk_), intent(out) :: locx(:,:)
complex(psb_dpk_), intent(in) :: globx(:,:) complex(psb_dpk_), intent(in) :: globx(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: root integer(psb_ipk_), intent(in), optional :: root
end subroutine psb_zscatterm end subroutine psb_zscatterm
subroutine psb_zscatterv(globx, locx, desc_a, info, root) subroutine psb_zscatterv(globx, locx, desc_a, info, root)
use psb_desc_mod import
implicit none
complex(psb_dpk_), intent(out) :: locx(:) complex(psb_dpk_), intent(out) :: locx(:)
complex(psb_dpk_), intent(in) :: globx(:) complex(psb_dpk_), intent(in) :: globx(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
@ -114,9 +121,8 @@ module psb_z_comm_mod
end interface psb_scatter end interface psb_scatter
interface psb_gather interface psb_gather
subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc) subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
use psb_desc_mod import
use psb_mat_mod
implicit none implicit none
type(psb_zspmat_type), intent(inout) :: loca type(psb_zspmat_type), intent(inout) :: loca
type(psb_zspmat_type), intent(out) :: globa type(psb_zspmat_type), intent(out) :: globa
@ -126,24 +132,26 @@ module psb_z_comm_mod
logical, intent(in), optional :: keepnum,keeploc logical, intent(in), optional :: keepnum,keeploc
end subroutine psb_zsp_allgather end subroutine psb_zsp_allgather
subroutine psb_zgatherm(globx, locx, desc_a, info, root) 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(in) :: locx(:,:)
complex(psb_dpk_), intent(out), allocatable :: globx(:,:) complex(psb_dpk_), intent(out), allocatable :: globx(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: root integer(psb_ipk_), intent(in), optional :: root
end subroutine psb_zgatherm end subroutine psb_zgatherm
subroutine psb_zgatherv(globx, locx, desc_a, info, root) subroutine psb_zgatherv(globx, locx, desc_a, info, root)
use psb_desc_mod import
implicit none
complex(psb_dpk_), intent(in) :: locx(:) complex(psb_dpk_), intent(in) :: locx(:)
complex(psb_dpk_), intent(out), allocatable :: globx(:) complex(psb_dpk_), intent(out), allocatable :: globx(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: root integer(psb_ipk_), intent(in), optional :: root
end subroutine psb_zgatherv end subroutine psb_zgatherv
subroutine psb_zgather_vect(globx, locx, desc_a, info, root) subroutine psb_zgather_vect(globx, locx, desc_a, info, root)
use psb_desc_mod import
use psb_z_vect_mod implicit none
type(psb_z_vect_type), intent(inout) :: locx type(psb_z_vect_type), intent(inout) :: locx
complex(psb_dpk_), intent(out), allocatable :: globx(:) complex(psb_dpk_), intent(out), allocatable :: globx(:)
type(psb_desc_type), intent(in) :: desc_a 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 interface psb_geall
subroutine psb_zalloc(x, desc_a, info, n, lb) subroutine psb_zalloc(x, desc_a, info, n, lb)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_z_base_vect_type, psb_z_vect_type, &
& psb_zspmat_type, psb_z_base_sparse_mat
implicit none implicit none
complex(psb_dpk_), allocatable, intent(out) :: x(:,:) complex(psb_dpk_), allocatable, intent(out) :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a 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 integer(psb_ipk_), optional, intent(in) :: n, lb
end subroutine psb_zalloc end subroutine psb_zalloc
subroutine psb_zallocv(x, desc_a,info,n) subroutine psb_zallocv(x, desc_a,info,n)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_z_base_vect_type, psb_z_vect_type, & implicit none
& psb_zspmat_type, psb_z_base_sparse_mat
complex(psb_dpk_), allocatable, intent(out) :: x(:) complex(psb_dpk_), allocatable, intent(out) :: x(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: n integer(psb_ipk_), optional, intent(in) :: n
end subroutine psb_zallocv end subroutine psb_zallocv
subroutine psb_zalloc_vect(x, desc_a,info,n) subroutine psb_zalloc_vect(x, desc_a,info,n)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_z_base_vect_type, psb_z_vect_type, & implicit none
& psb_zspmat_type, psb_z_base_sparse_mat
type(psb_z_vect_type), intent(out) :: x type(psb_z_vect_type), intent(out) :: x
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: n integer(psb_ipk_), optional, intent(in) :: n
end subroutine psb_zalloc_vect end subroutine psb_zalloc_vect
subroutine psb_zalloc_vect_r2(x, desc_a,info,n,lb) subroutine psb_zalloc_vect_r2(x, desc_a,info,n,lb)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_z_base_vect_type, psb_z_vect_type, & implicit none
& psb_zspmat_type, psb_z_base_sparse_mat
type(psb_z_vect_type), allocatable, intent(out) :: x(:) type(psb_z_vect_type), allocatable, intent(out) :: x(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info integer(psb_ipk_),intent(out) :: info
@ -77,25 +72,22 @@ Module psb_z_tools_mod
interface psb_geasb interface psb_geasb
subroutine psb_zasb(x, desc_a, info) subroutine psb_zasb(x, desc_a, info)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_z_base_vect_type, psb_z_vect_type, & implicit none
& psb_zspmat_type, psb_z_base_sparse_mat
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
complex(psb_dpk_), allocatable, intent(inout) :: x(:,:) complex(psb_dpk_), allocatable, intent(inout) :: x(:,:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_zasb end subroutine psb_zasb
subroutine psb_zasbv(x, desc_a, info) subroutine psb_zasbv(x, desc_a, info)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_z_base_vect_type, psb_z_vect_type, & implicit none
& psb_zspmat_type, psb_z_base_sparse_mat
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
complex(psb_dpk_), allocatable, intent(inout) :: x(:) complex(psb_dpk_), allocatable, intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_zasbv end subroutine psb_zasbv
subroutine psb_zasb_vect(x, desc_a, info,mold, scratch) subroutine psb_zasb_vect(x, desc_a, info,mold, scratch)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_z_base_vect_type, psb_z_vect_type, & implicit none
& psb_zspmat_type, psb_z_base_sparse_mat
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_z_vect_type), intent(inout) :: x type(psb_z_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -103,9 +95,8 @@ Module psb_z_tools_mod
logical, intent(in), optional :: scratch logical, intent(in), optional :: scratch
end subroutine psb_zasb_vect end subroutine psb_zasb_vect
subroutine psb_zasb_vect_r2(x, desc_a, info,mold, scratch) subroutine psb_zasb_vect_r2(x, desc_a, info,mold, scratch)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_z_base_vect_type, psb_z_vect_type, & implicit none
& psb_zspmat_type, psb_z_base_sparse_mat
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_z_vect_type), intent(inout) :: x(:) type(psb_z_vect_type), intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -114,51 +105,31 @@ Module psb_z_tools_mod
end subroutine psb_zasb_vect_r2 end subroutine psb_zasb_vect_r2
end interface 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 interface psb_gefree
subroutine psb_zfree(x, desc_a, info) subroutine psb_zfree(x, desc_a, info)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_z_base_vect_type, psb_z_vect_type, & implicit none
& psb_zspmat_type, psb_z_base_sparse_mat
complex(psb_dpk_),allocatable, intent(inout) :: x(:,:) complex(psb_dpk_),allocatable, intent(inout) :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_zfree end subroutine psb_zfree
subroutine psb_zfreev(x, desc_a, info) subroutine psb_zfreev(x, desc_a, info)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_z_base_vect_type, psb_z_vect_type, & implicit none
& psb_zspmat_type, psb_z_base_sparse_mat
complex(psb_dpk_),allocatable, intent(inout) :: x(:) complex(psb_dpk_),allocatable, intent(inout) :: x(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_zfreev end subroutine psb_zfreev
subroutine psb_zfree_vect(x, desc_a, info) subroutine psb_zfree_vect(x, desc_a, info)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_z_base_vect_type, psb_z_vect_type, & implicit none
& psb_zspmat_type, psb_z_base_sparse_mat
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_z_vect_type), intent(inout) :: x type(psb_z_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_zfree_vect end subroutine psb_zfree_vect
subroutine psb_zfree_vect_r2(x, desc_a, info) subroutine psb_zfree_vect_r2(x, desc_a, info)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_z_base_vect_type, psb_z_vect_type, & implicit none
& psb_zspmat_type, psb_z_base_sparse_mat
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_z_vect_type), allocatable, intent(inout) :: x(:) type(psb_z_vect_type), allocatable, intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -168,9 +139,8 @@ Module psb_z_tools_mod
interface psb_geins interface psb_geins
subroutine psb_zinsi(m,irw,val, x, desc_a,info,dupl,local) subroutine psb_zinsi(m,irw,val, x, desc_a,info,dupl,local)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_z_base_vect_type, psb_z_vect_type, & implicit none
& psb_zspmat_type, psb_z_base_sparse_mat
integer(psb_ipk_), intent(in) :: m integer(psb_ipk_), intent(in) :: m
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
complex(psb_dpk_),intent(inout) :: x(:,:) complex(psb_dpk_),intent(inout) :: x(:,:)
@ -181,9 +151,8 @@ Module psb_z_tools_mod
logical, intent(in), optional :: local logical, intent(in), optional :: local
end subroutine psb_zinsi end subroutine psb_zinsi
subroutine psb_zinsvi(m, irw,val, x,desc_a,info,dupl,local) subroutine psb_zinsvi(m, irw,val, x,desc_a,info,dupl,local)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_z_base_vect_type, psb_z_vect_type, & implicit none
& psb_zspmat_type, psb_z_base_sparse_mat
integer(psb_ipk_), intent(in) :: m integer(psb_ipk_), intent(in) :: m
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
complex(psb_dpk_),intent(inout) :: x(:) complex(psb_dpk_),intent(inout) :: x(:)
@ -194,9 +163,8 @@ Module psb_z_tools_mod
logical, intent(in), optional :: local logical, intent(in), optional :: local
end subroutine psb_zinsvi end subroutine psb_zinsvi
subroutine psb_zins_vect(m,irw,val,x,desc_a,info,dupl,local) subroutine psb_zins_vect(m,irw,val,x,desc_a,info,dupl,local)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_z_base_vect_type, psb_z_vect_type, & implicit none
& psb_zspmat_type, psb_z_base_sparse_mat
integer(psb_ipk_), intent(in) :: m integer(psb_ipk_), intent(in) :: m
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_z_vect_type), intent(inout) :: x type(psb_z_vect_type), intent(inout) :: x
@ -207,9 +175,8 @@ Module psb_z_tools_mod
logical, intent(in), optional :: local logical, intent(in), optional :: local
end subroutine psb_zins_vect end subroutine psb_zins_vect
subroutine psb_zins_vect_v(m,irw,val,x,desc_a,info,dupl,local) subroutine psb_zins_vect_v(m,irw,val,x,desc_a,info,dupl,local)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_z_base_vect_type, psb_z_vect_type, psb_i_vect_type, & implicit none
& psb_zspmat_type, psb_z_base_sparse_mat
integer(psb_ipk_), intent(in) :: m integer(psb_ipk_), intent(in) :: m
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_z_vect_type), intent(inout) :: x type(psb_z_vect_type), intent(inout) :: x
@ -220,9 +187,8 @@ Module psb_z_tools_mod
logical, intent(in), optional :: local logical, intent(in), optional :: local
end subroutine psb_zins_vect_v end subroutine psb_zins_vect_v
subroutine psb_zins_vect_r2(m,irw,val,x,desc_a,info,dupl,local) subroutine psb_zins_vect_r2(m,irw,val,x,desc_a,info,dupl,local)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_z_base_vect_type, psb_z_vect_type, & implicit none
& psb_zspmat_type, psb_z_base_sparse_mat
integer(psb_ipk_), intent(in) :: m integer(psb_ipk_), intent(in) :: m
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_z_vect_type), intent(inout) :: x(:) type(psb_z_vect_type), intent(inout) :: x(:)
@ -236,9 +202,8 @@ Module psb_z_tools_mod
interface psb_cdbldext interface psb_cdbldext
Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info,extype) Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info,extype)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_z_base_vect_type, psb_z_vect_type, & implicit none
& psb_zspmat_type, psb_z_base_sparse_mat
integer(psb_ipk_), intent(in) :: novr integer(psb_ipk_), intent(in) :: novr
Type(psb_zspmat_type), Intent(in) :: a Type(psb_zspmat_type), Intent(in) :: a
Type(psb_desc_type), Intent(inout), target :: desc_a Type(psb_desc_type), Intent(inout), target :: desc_a
@ -248,11 +213,26 @@ Module psb_z_tools_mod
end Subroutine psb_zcdbldext end Subroutine psb_zcdbldext
end interface 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 interface psb_spall
subroutine psb_zspalloc(a, desc_a, info, nnz) subroutine psb_zspalloc(a, desc_a, info, nnz)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_z_base_vect_type, psb_z_vect_type, & implicit none
& psb_zspmat_type, psb_z_base_sparse_mat
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_zspmat_type), intent(inout) :: a type(psb_zspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -262,9 +242,8 @@ Module psb_z_tools_mod
interface psb_spasb interface psb_spasb
subroutine psb_zspasb(a,desc_a, info, afmt, upd, dupl,mold) subroutine psb_zspasb(a,desc_a, info, afmt, upd, dupl,mold)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_z_base_vect_type, psb_z_vect_type, & implicit none
& psb_zspmat_type, psb_z_base_sparse_mat
type(psb_zspmat_type), intent (inout) :: a type(psb_zspmat_type), intent (inout) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -276,9 +255,8 @@ Module psb_z_tools_mod
interface psb_spfree interface psb_spfree
subroutine psb_zspfree(a, desc_a,info) subroutine psb_zspfree(a, desc_a,info)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_z_base_vect_type, psb_z_vect_type, & implicit none
& psb_zspmat_type, psb_z_base_sparse_mat
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_zspmat_type), intent(inout) ::a type(psb_zspmat_type), intent(inout) ::a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -288,9 +266,8 @@ Module psb_z_tools_mod
interface psb_spins interface psb_spins
subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_z_base_vect_type, psb_z_vect_type, & implicit none
& psb_zspmat_type, psb_z_base_sparse_mat
type(psb_desc_type), intent(inout) :: desc_a type(psb_desc_type), intent(inout) :: desc_a
type(psb_zspmat_type), intent(inout) :: a type(psb_zspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(in) :: nz,ia(:),ja(:) integer(psb_ipk_), intent(in) :: nz,ia(:),ja(:)
@ -301,9 +278,8 @@ Module psb_z_tools_mod
end subroutine psb_zspins end subroutine psb_zspins
subroutine psb_zspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local) subroutine psb_zspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local)
use psb_i_vect_mod, only : psb_i_vect_type use psb_i_vect_mod, only : psb_i_vect_type
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_z_base_vect_type, psb_z_vect_type,& implicit none
& psb_zspmat_type, psb_z_base_sparse_mat
type(psb_desc_type), intent(inout) :: desc_a type(psb_desc_type), intent(inout) :: desc_a
type(psb_zspmat_type), intent(inout) :: a type(psb_zspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(in) :: nz integer(psb_ipk_), intent(in) :: nz
@ -314,9 +290,8 @@ Module psb_z_tools_mod
logical, intent(in), optional :: local logical, intent(in), optional :: local
end subroutine psb_zspins_v end subroutine psb_zspins_v
subroutine psb_zspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) subroutine psb_zspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_z_base_vect_type, psb_z_vect_type, & implicit none
& psb_zspmat_type, psb_z_base_sparse_mat
type(psb_desc_type), intent(in) :: desc_ar type(psb_desc_type), intent(in) :: desc_ar
type(psb_desc_type), intent(inout) :: desc_ac type(psb_desc_type), intent(inout) :: desc_ac
type(psb_zspmat_type), intent(inout) :: a type(psb_zspmat_type), intent(inout) :: a
@ -329,9 +304,8 @@ Module psb_z_tools_mod
interface psb_sprn interface psb_sprn
subroutine psb_zsprn(a, desc_a,info,clear) subroutine psb_zsprn(a, desc_a,info,clear)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import
& psb_z_base_vect_type, psb_z_vect_type, & implicit none
& psb_zspmat_type, psb_z_base_sparse_mat
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_zspmat_type), intent(inout) :: a type(psb_zspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info 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) :: get_nrows => z_vect_get_nrows
procedure, pass(x) :: sizeof => z_vect_sizeof procedure, pass(x) :: sizeof => z_vect_sizeof
procedure, pass(x) :: get_fmt => z_vect_get_fmt 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) :: all => z_vect_all
procedure, pass(x) :: reall => z_vect_reall procedure, pass(x) :: reall => z_vect_reall
procedure, pass(x) :: zero => z_vect_zero 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 procedure, pass(x) :: set_vect => z_vect_set_vect
generic, public :: set => set_vect, set_scal generic, public :: set => set_vect, set_scal
procedure, pass(x) :: clone => z_vect_clone 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 end type psb_z_vect_type
public :: psb_z_vect public :: psb_z_vect
@ -296,6 +296,191 @@ contains
res = 'NULL' res = 'NULL'
if (allocated(x%v)) res = x%v%get_fmt() if (allocated(x%v)) res = x%v%get_fmt()
end function z_vect_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) function z_vect_dot_v(n,x,y) result(res)
implicit none implicit none
@ -522,197 +707,12 @@ contains
end function z_vect_asum end function z_vect_asum
subroutine z_vect_all(n, x, info, mold)
implicit none end module psb_z_vect_mod
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) module psb_z_multivect_mod
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
use psb_z_base_multivect_mod use psb_z_base_multivect_mod
use psb_const_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) :: get_ncols => z_vect_get_ncols
procedure, pass(x) :: sizeof => z_vect_sizeof procedure, pass(x) :: sizeof => z_vect_sizeof
procedure, pass(x) :: get_fmt => z_vect_get_fmt 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_v => z_vect_dot_v
!!$ procedure, pass(x) :: dot_a => z_vect_dot_a !!$ procedure, pass(x) :: dot_a => z_vect_dot_a
!!$ generic, public :: dot => dot_v, 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) :: nrm2 => z_vect_nrm2
!!$ procedure, pass(x) :: amax => z_vect_amax !!$ procedure, pass(x) :: amax => z_vect_amax
!!$ procedure, pass(x) :: asum => z_vect_asum !!$ 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 end type psb_z_multivect_type
public :: psb_z_multivect, 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() if (allocated(x%v)) res = x%v%get_fmt()
end function z_vect_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) subroutine z_vect_all(m,n, x, info, mold)
implicit none implicit none
@ -1341,4 +1134,213 @@ contains
end if end if
end subroutine z_vect_cnv 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 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_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 use psb_c_vect_mod, only : psb_c_base_vect_type
interface psi_swapdata interface psi_swapdata
subroutine psi_cswapdatam(flag,n,beta,y,desc_a,work,info,data) 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 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_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 use psb_d_vect_mod, only : psb_d_base_vect_type
interface psi_swapdata interface psi_swapdata
subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data) 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 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 module psi_i_mod
use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_mpik_ 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 interface
subroutine psi_compute_size(desc_data,& subroutine psi_compute_size(desc_data,&
@ -196,63 +196,53 @@ module psi_i_mod
interface psi_swapdata interface psi_swapdata
subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data) 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(in) :: flag, n
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: y(:,:), beta integer(psb_ipk_) :: y(:,:), beta
integer(psb_ipk_), target :: work(:) integer(psb_ipk_),target :: work(:)
type(psb_desc_type), target :: desc_a type(psb_desc_type), target :: desc_a
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
end subroutine psi_iswapdatam end subroutine psi_iswapdatam
subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data) 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(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: y(:), beta integer(psb_ipk_) :: y(:), beta
integer(psb_ipk_), target :: work(:) integer(psb_ipk_),target :: work(:)
type(psb_desc_type), target :: desc_a type(psb_desc_type), target :: desc_a
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
end subroutine psi_iswapdatav end subroutine psi_iswapdatav
subroutine psi_iswapdata_vect(flag,beta,y,desc_a,work,info,data) 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(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
class(psb_i_base_vect_type) :: y class(psb_i_base_vect_type) :: y
integer(psb_ipk_) :: beta integer(psb_ipk_) :: beta
integer(psb_ipk_),target :: work(:) integer(psb_ipk_),target :: work(:)
type(psb_desc_type), target :: desc_a type(psb_desc_type), target :: desc_a
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
end subroutine psi_iswapdata_vect end subroutine psi_iswapdata_vect
subroutine psi_iswapidxm(ictxt,icomm,flag,n,beta,y,idx,& subroutine psi_iswapidxm(ictxt,icomm,flag,n,beta,y,idx,&
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
import :: psb_desc_type, psb_ipk_ 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(in) :: ictxt,icomm,flag, n
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: y(:,:), beta integer(psb_ipk_) :: y(:,:), beta
integer(psb_ipk_),target :: work(:) integer(psb_ipk_),target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv
end subroutine psi_iswapidxm end subroutine psi_iswapidxm
subroutine psi_iswapidxv(ictxt,icomm,flag,beta,y,idx,& subroutine psi_iswapidxv(ictxt,icomm,flag,beta,y,idx,&
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
import :: psb_desc_type, psb_ipk_ 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(in) :: ictxt,icomm,flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: y(:), beta 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
integer(psb_ipk_),target :: work(:) integer(psb_ipk_),target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv
end subroutine psi_iswapidx_vect end subroutine psi_iswapidxv
subroutine psi_iswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info) 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(in) :: iictxt,iicomm,flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
class(psb_i_base_vect_type) :: y class(psb_i_base_vect_type) :: y
@ -266,80 +256,80 @@ module psi_i_mod
interface psi_swaptran interface psi_swaptran
subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data) 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(in) :: flag, n
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: y(:,:), beta integer(psb_ipk_) :: y(:,:), beta
integer(psb_ipk_),target :: work(:) integer(psb_ipk_),target :: work(:)
type(psb_desc_type), target :: desc_a type(psb_desc_type), target :: desc_a
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
end subroutine psi_iswaptranm end subroutine psi_iswaptranm
subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data) 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(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: y(:), beta integer(psb_ipk_) :: y(:), beta
integer(psb_ipk_),target :: work(:) integer(psb_ipk_),target :: work(:)
type(psb_desc_type), target :: desc_a type(psb_desc_type), target :: desc_a
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
end subroutine psi_iswaptranv end subroutine psi_iswaptranv
subroutine psi_iswaptran_vect(flag,beta,y,desc_a,work,info,data) 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(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
class(psb_i_base_vect_type) :: y class(psb_i_base_vect_type) :: y
integer(psb_ipk_) :: beta integer(psb_ipk_) :: beta
integer(psb_ipk_),target :: work(:) integer(psb_ipk_),target :: work(:)
type(psb_desc_type), target :: desc_a type(psb_desc_type), target :: desc_a
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
end subroutine psi_iswaptran_vect end subroutine psi_iswaptran_vect
subroutine psi_itranidxm(ictxt,icomm,flag,n,beta,y,idx,& subroutine psi_itranidxm(ictxt,icomm,flag,n,beta,y,idx,&
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
import :: psb_desc_type, psb_ipk_ 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(in) :: ictxt,icomm,flag, n
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: y(:,:), beta integer(psb_ipk_) :: y(:,:), beta
integer(psb_ipk_), target :: work(:) integer(psb_ipk_),target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv
end subroutine psi_itranidxm end subroutine psi_itranidxm
subroutine psi_itranidxv(ictxt,icomm,flag,beta,y,idx,& subroutine psi_itranidxv(ictxt,icomm,flag,beta,y,idx,&
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
import :: psb_desc_type, psb_ipk_ 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(in) :: ictxt,icomm,flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: y(:), beta integer(psb_ipk_) :: y(:), beta
integer(psb_ipk_), target :: work(:) integer(psb_ipk_),target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv
end subroutine psi_itranidxv end subroutine psi_itranidxv
subroutine psi_itranidx_vect(ictxt,icomm,flag,beta,y,idx,& subroutine psi_itranidx_vect(ictxt,icomm,flag,beta,y,idx,&
& totxch,totsnd,totrcv,work,info) & 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
integer(psb_ipk_), intent(in) :: ictxt,icomm,flag integer(psb_ipk_), intent(in) :: ictxt,icomm,flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
class(psb_i_base_vect_type) :: y class(psb_i_base_vect_type) :: y
integer(psb_ipk_) :: beta integer(psb_ipk_) :: beta
integer(psb_ipk_),target :: work(:) integer(psb_ipk_),target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv
end subroutine psi_itranidx_vect end subroutine psi_itranidx_vect
end interface end interface
interface psi_ovrl_upd interface psi_ovrl_upd
subroutine psi_iovrl_updr1(x,desc_a,update,info) subroutine psi_iovrl_updr1(x,desc_a,update,info)
import :: psb_desc_type, psb_ipk_ import :: psb_desc_type, psb_ipk_, psb_ipk_, psb_i_base_vect_type
integer(psb_ipk_), intent(inout), target :: x(:) integer(psb_ipk_), intent(inout), target :: x(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(in) :: update integer(psb_ipk_), intent(in) :: update
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psi_iovrl_updr1 end subroutine psi_iovrl_updr1
subroutine psi_iovrl_updr2(x,desc_a,update,info) subroutine psi_iovrl_updr2(x,desc_a,update,info)
import :: psb_desc_type, psb_ipk_ import :: psb_desc_type, psb_ipk_, psb_ipk_, psb_i_base_vect_type
integer(psb_ipk_), intent(inout), target :: x(:,:) integer(psb_ipk_), intent(inout), target :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(in) :: update integer(psb_ipk_), intent(in) :: update
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psi_iovrl_updr2 end subroutine psi_iovrl_updr2
subroutine psi_iovrl_upd_vect(x,desc_a,update,info) 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 class(psb_i_base_vect_type) :: x
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(in) :: update integer(psb_ipk_), intent(in) :: update
@ -349,23 +339,23 @@ module psi_i_mod
interface psi_ovrl_save interface psi_ovrl_save
subroutine psi_iovrl_saver1(x,xs,desc_a,info) subroutine psi_iovrl_saver1(x,xs,desc_a,info)
import :: psb_desc_type, psb_ipk_ import :: psb_desc_type, psb_ipk_, psb_ipk_, psb_i_base_vect_type
integer(psb_ipk_), intent(inout) :: x(:) integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), allocatable :: xs(:) integer(psb_ipk_), allocatable :: xs(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psi_iovrl_saver1 end subroutine psi_iovrl_saver1
subroutine psi_iovrl_saver2(x,xs,desc_a,info) subroutine psi_iovrl_saver2(x,xs,desc_a,info)
import :: psb_desc_type, psb_ipk_ import :: psb_desc_type, psb_ipk_, psb_ipk_, psb_i_base_vect_type
integer(psb_ipk_), intent(inout) :: x(:,:) integer(psb_ipk_), intent(inout) :: x(:,:)
integer(psb_ipk_), allocatable :: xs(:,:) integer(psb_ipk_), allocatable :: xs(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psi_iovrl_saver2 end subroutine psi_iovrl_saver2
subroutine psi_iovrl_save_vect(x,xs,desc_a,info) 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 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 type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psi_iovrl_save_vect end subroutine psi_iovrl_save_vect
@ -373,23 +363,23 @@ module psi_i_mod
interface psi_ovrl_restore interface psi_ovrl_restore
subroutine psi_iovrl_restrr1(x,xs,desc_a,info) subroutine psi_iovrl_restrr1(x,xs,desc_a,info)
import :: psb_desc_type, psb_ipk_ import :: psb_desc_type, psb_ipk_, psb_ipk_, psb_i_base_vect_type
integer(psb_ipk_), intent(inout) :: x(:) integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_) :: xs(:) integer(psb_ipk_) :: xs(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psi_iovrl_restrr1 end subroutine psi_iovrl_restrr1
subroutine psi_iovrl_restrr2(x,xs,desc_a,info) subroutine psi_iovrl_restrr2(x,xs,desc_a,info)
import :: psb_desc_type, psb_ipk_ import :: psb_desc_type, psb_ipk_, psb_ipk_, psb_i_base_vect_type
integer(psb_ipk_), intent(inout) :: x(:,:) integer(psb_ipk_), intent(inout) :: x(:,:)
integer(psb_ipk_) :: xs(:,:) integer(psb_ipk_) :: xs(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psi_iovrl_restrr2 end subroutine psi_iovrl_restrr2
subroutine psi_iovrl_restr_vect(x,xs,desc_a,info) 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 class(psb_i_base_vect_type) :: x
integer(psb_ipk_) :: xs(:) integer(psb_ipk_) :: xs(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psi_iovrl_restr_vect 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_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 use psb_s_vect_mod, only : psb_s_base_vect_type
interface psi_swapdata interface psi_swapdata
subroutine psi_sswapdatam(flag,n,beta,y,desc_a,work,info,data) 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 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_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 use psb_z_vect_mod, only : psb_z_base_vect_type
interface psi_swapdata interface psi_swapdata
subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data) 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 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) PS = $(join $(BASEFILE),.ps)
GXS = $(join $(BASEFILE),.gxs) GXS = $(join $(BASEFILE),.gxs)
GLX = $(join $(BASEFILE),.glx) GLX = $(join $(BASEFILE),.glx)
TARGETPDF= ../psblas-3.2.pdf TARGETPDF= ../psblas-3.4.pdf
BASEHTML = $(patsubst %.tex,%,$(HTMLFILE)) BASEHTML = $(patsubst %.tex,%,$(HTMLFILE))
HTML = $(join $(HTMLFILE),.html) HTML = $(join $(HTMLFILE),.html)
HTMLDIR = ../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 These subroutines gathers the values of the halo
elements, and (optionally) scale the result: elements:
\[ x \leftarrow \alpha x \] \[ x \leftarrow x \]
where: where:
\begin{description} \begin{description}
\item[$x$] is a global dense submatrix. \item[$x$] is a global dense submatrix.
@ -40,7 +40,7 @@ Long Precision Complex & psb\_halo \\
\begin{lstlisting} \begin{lstlisting}
call psb_halo(x, desc_a, info) 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} \end{lstlisting}
\begin{description} \begin{description}
@ -58,12 +58,6 @@ Scope: {\bf local} \\
Type: {\bf required}\\ Type: {\bf required}\\
Intent: {\bf in}.\\ Intent: {\bf in}.\\
Specified as: a structured data of type \descdata. 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. \\ \item[work] the work array. \\
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf optional}\\ Type: {\bf optional}\\

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

@ -25,7 +25,7 @@
\relax \relax
\pdfcompresslevel=0 %-- 0 = none, 9 = best \pdfcompresslevel=0 %-- 0 = none, 9 = best
\pdfinfo{ %-- Info dictionary of PDF output /Author (Alfredo Buttari) \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) /Subject (Parallel Sparse Basic Linear Algebra Subroutines)
/Keywords (Computer Science Linear Algebra Fluid Dynamics Parallel Linux MPI PSBLAS Iterative Solvers Preconditioners) /Keywords (Computer Science Linear Algebra Fluid Dynamics Parallel Linux MPI PSBLAS Iterative Solvers Preconditioners)
/Creator (pdfLaTeX) /Creator (pdfLaTeX)
@ -88,7 +88,7 @@
\begin{document} \begin{document}
\pdfbookmark{PSBLAS-v3.2 User's Guide}{title} \pdfbookmark{PSBLAS-v3.4 User's Guide}{title}
\lstset{language=Fortran} \lstset{language=Fortran}
\newlength{\centeroffset} \newlength{\centeroffset}
\setlength{\centeroffset}{-0.5\oddsidemargin} \setlength{\centeroffset}{-0.5\oddsidemargin}
@ -98,7 +98,7 @@
\vspace*{\stretch{1}} \vspace*{\stretch{1}}
\noindent\hspace*{\centeroffset}\makebox[0pt][l]{\begin{minipage}{\textwidth} \noindent\hspace*{\centeroffset}\makebox[0pt][l]{\begin{minipage}{\textwidth}
\flushright \flushright
{\Huge\bfseries PSBLAS 3.2 User's guide {\Huge\bfseries PSBLAS 3.4 User's guide
} }
\noindent\rule[-1ex]{\textwidth}{5pt}\\[2.5ex] \noindent\rule[-1ex]{\textwidth}{5pt}\\[2.5ex]
\hfill\emph{\Large A reference guide for the Parallel Sparse BLAS library} \hfill\emph{\Large A reference guide for the Parallel Sparse BLAS library}
@ -111,7 +111,7 @@
by Salvatore Filippone\\ by Salvatore Filippone\\
and Alfredo Buttari}\\ and Alfredo Buttari}\\
University of Rome ``Tor Vergata''.\\[3ex] University of Rome ``Tor Vergata''.\\[3ex]
March 31st, 2014. April 30, 2015.
\end{minipage}} \end{minipage}}
%\addtolength{\textwidth}{\centeroffset} %\addtolength{\textwidth}{\centeroffset}

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

@ -24,7 +24,7 @@
% \relax % \relax
% \pdfcompresslevel=0 %-- 0 = none, 9 = best % \pdfcompresslevel=0 %-- 0 = none, 9 = best
% \pdfinfo{ %-- Info dictionary of PDF output /Author (Alfredo Buttari) % \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) % /Subject (Parallel Sparse Basic Linear Algebra Subroutines)
% /Keywords (Computer Science Linear Algebra Fluid Dynamics Parallel Linux MPI PSBLAS Iterative Solvers Preconditioners) % /Keywords (Computer Science Linear Algebra Fluid Dynamics Parallel Linux MPI PSBLAS Iterative Solvers Preconditioners)
% /Creator (pdfLaTeX) % /Creator (pdfLaTeX)
@ -94,9 +94,9 @@
University of Rome ``Tor Vergata'', Italy\\[2ex] University of Rome ``Tor Vergata'', Italy\\[2ex]
%\\[10ex] %\\[10ex]
%\today %\today
Software version: 3.2\\ Software version: 3.4\\
%\today %\today
March 31st, 2014. April 30, 2015.
\cleardoublepage \cleardoublepage
\begingroup \begingroup
\renewcommand*{\thepage}{toc} \renewcommand*{\thepage}{toc}

Write Preview
Loading…
Cancel
Save