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

merge with merge-paraggr-newops

Browse Source
This commit is contained in:
Cirdans-Home
2020-04-25 17:14:25 +02:00
parent 2a6107a937 c0ccbe14f7
commit 6777e57d37
139 changed files with 52719 additions and 27954 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/modules/auxil/psi_c_serial_mod.f90
+27 -17
View File
@@ -1,9 +1,9 @@
!
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006-2018
! Salvatore Filippone
! Alfredo Buttari
!
! Salvatore Filippone
! Alfredo Buttari
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
@@ -15,7 +15,7 @@
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@@ -27,8 +27,8 @@
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
!
!
module psi_c_serial_mod
use psb_const_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_, psb_spk_
@@ -36,7 +36,7 @@ module psi_c_serial_mod
! 2-D version
subroutine psb_cgelp(trans,iperm,x,info)
import :: psb_ipk_, psb_spk_
implicit none
implicit none
complex(psb_spk_), intent(inout) :: x(:,:)
integer(psb_ipk_), intent(in) :: iperm(:)
integer(psb_ipk_), intent(out) :: info
@@ -44,18 +44,18 @@ module psi_c_serial_mod
end subroutine psb_cgelp
subroutine psb_cgelpv(trans,iperm,x,info)
import :: psb_ipk_, psb_spk_
implicit none
implicit none
complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: iperm(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in) :: trans
end subroutine psb_cgelpv
end interface psb_gelp
interface psb_geaxpby
interface psb_geaxpby
subroutine psi_caxpby(m,n,alpha, x, beta, y, info)
import :: psb_ipk_, psb_spk_
implicit none
implicit none
integer(psb_ipk_), intent(in) :: m, n
complex(psb_spk_), intent (in) :: x(:,:)
complex(psb_spk_), intent (inout) :: y(:,:)
@@ -64,13 +64,23 @@ module psi_c_serial_mod
end subroutine psi_caxpby
subroutine psi_caxpbyv(m,alpha, x, beta, y, info)
import :: psb_ipk_, psb_spk_
implicit none
implicit none
integer(psb_ipk_), intent(in) :: m
complex(psb_spk_), intent (in) :: x(:)
complex(psb_spk_), intent (inout) :: y(:)
complex(psb_spk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info
end subroutine psi_caxpbyv
subroutine psi_caxpbyv2(m,alpha, x, beta, y, z, info)
import :: psb_ipk_, psb_spk_
implicit none
integer(psb_ipk_), intent(in) :: m
complex(psb_spk_), intent (in) :: x(:)
complex(psb_spk_), intent (in) :: y(:)
complex(psb_spk_), intent (in) :: z(:)
complex(psb_spk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info
end subroutine psi_caxpbyv2
end interface psb_geaxpby
interface psi_gth
@@ -91,18 +101,18 @@ module psi_c_serial_mod
implicit none
integer(psb_ipk_) :: n, k, idx(:)
complex(psb_spk_) :: x(:,:), y(:)
end subroutine psi_cgthzmv
subroutine psi_cgthzmm(n,k,idx,x,y)
import :: psb_ipk_, psb_spk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
complex(psb_spk_) :: x(:,:), y(:,:)
end subroutine psi_cgthzmm
subroutine psi_cgthzv(n,idx,x,y)
import :: psb_ipk_, psb_spk_
implicit none
implicit none
integer(psb_ipk_) :: n, idx(:)
complex(psb_spk_) :: x(:), y(:)
end subroutine psi_cgthzv
@@ -124,7 +134,7 @@ module psi_c_serial_mod
subroutine psi_csctv(n,idx,x,beta,y)
import :: psb_ipk_, psb_spk_
implicit none
integer(psb_ipk_) :: n, idx(:)
complex(psb_spk_) :: beta, x(:), y(:)
end subroutine psi_csctv
base/modules/auxil/psi_d_serial_mod.f90
+27 -17
View File
@@ -1,9 +1,9 @@
!
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006-2018
! Salvatore Filippone
! Alfredo Buttari
!
! Salvatore Filippone
! Alfredo Buttari
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
@@ -15,7 +15,7 @@
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@@ -27,8 +27,8 @@
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
!
!
module psi_d_serial_mod
use psb_const_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_, psb_dpk_
@@ -36,7 +36,7 @@ module psi_d_serial_mod
! 2-D version
subroutine psb_dgelp(trans,iperm,x,info)
import :: psb_ipk_, psb_dpk_
implicit none
implicit none
real(psb_dpk_), intent(inout) :: x(:,:)
integer(psb_ipk_), intent(in) :: iperm(:)
integer(psb_ipk_), intent(out) :: info
@@ -44,18 +44,18 @@ module psi_d_serial_mod
end subroutine psb_dgelp
subroutine psb_dgelpv(trans,iperm,x,info)
import :: psb_ipk_, psb_dpk_
implicit none
implicit none
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: iperm(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in) :: trans
end subroutine psb_dgelpv
end interface psb_gelp
interface psb_geaxpby
interface psb_geaxpby
subroutine psi_daxpby(m,n,alpha, x, beta, y, info)
import :: psb_ipk_, psb_dpk_
implicit none
implicit none
integer(psb_ipk_), intent(in) :: m, n
real(psb_dpk_), intent (in) :: x(:,:)
real(psb_dpk_), intent (inout) :: y(:,:)
@@ -64,13 +64,23 @@ module psi_d_serial_mod
end subroutine psi_daxpby
subroutine psi_daxpbyv(m,alpha, x, beta, y, info)
import :: psb_ipk_, psb_dpk_
implicit none
implicit none
integer(psb_ipk_), intent(in) :: m
real(psb_dpk_), intent (in) :: x(:)
real(psb_dpk_), intent (inout) :: y(:)
real(psb_dpk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info
end subroutine psi_daxpbyv
subroutine psi_daxpbyv2(m,alpha, x, beta, y, z, info)
import :: psb_ipk_, psb_dpk_
implicit none
integer(psb_ipk_), intent(in) :: m
real(psb_dpk_), intent (in) :: x(:)
real(psb_dpk_), intent (in) :: y(:)
real(psb_dpk_), intent (in) :: z(:)
real(psb_dpk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info
end subroutine psi_daxpbyv2
end interface psb_geaxpby
interface psi_gth
@@ -91,18 +101,18 @@ module psi_d_serial_mod
implicit none
integer(psb_ipk_) :: n, k, idx(:)
real(psb_dpk_) :: x(:,:), y(:)
end subroutine psi_dgthzmv
subroutine psi_dgthzmm(n,k,idx,x,y)
import :: psb_ipk_, psb_dpk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
real(psb_dpk_) :: x(:,:), y(:,:)
end subroutine psi_dgthzmm
subroutine psi_dgthzv(n,idx,x,y)
import :: psb_ipk_, psb_dpk_
implicit none
implicit none
integer(psb_ipk_) :: n, idx(:)
real(psb_dpk_) :: x(:), y(:)
end subroutine psi_dgthzv
@@ -124,7 +134,7 @@ module psi_d_serial_mod
subroutine psi_dsctv(n,idx,x,beta,y)
import :: psb_ipk_, psb_dpk_
implicit none
integer(psb_ipk_) :: n, idx(:)
real(psb_dpk_) :: beta, x(:), y(:)
end subroutine psi_dsctv
base/modules/auxil/psi_e_serial_mod.f90
+27 -17
View File
@@ -1,9 +1,9 @@
!
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006-2018
! Salvatore Filippone
! Alfredo Buttari
!
! Salvatore Filippone
! Alfredo Buttari
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
@@ -15,7 +15,7 @@
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@@ -27,8 +27,8 @@
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
!
!
module psi_e_serial_mod
use psb_const_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_
@@ -36,7 +36,7 @@ module psi_e_serial_mod
! 2-D version
subroutine psb_egelp(trans,iperm,x,info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
implicit none
integer(psb_epk_), intent(inout) :: x(:,:)
integer(psb_ipk_), intent(in) :: iperm(:)
integer(psb_ipk_), intent(out) :: info
@@ -44,18 +44,18 @@ module psi_e_serial_mod
end subroutine psb_egelp
subroutine psb_egelpv(trans,iperm,x,info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
implicit none
integer(psb_epk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: iperm(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in) :: trans
end subroutine psb_egelpv
end interface psb_gelp
interface psb_geaxpby
interface psb_geaxpby
subroutine psi_eaxpby(m,n,alpha, x, beta, y, info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
implicit none
integer(psb_ipk_), intent(in) :: m, n
integer(psb_epk_), intent (in) :: x(:,:)
integer(psb_epk_), intent (inout) :: y(:,:)
@@ -64,13 +64,23 @@ module psi_e_serial_mod
end subroutine psi_eaxpby
subroutine psi_eaxpbyv(m,alpha, x, beta, y, info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
implicit none
integer(psb_ipk_), intent(in) :: m
integer(psb_epk_), intent (in) :: x(:)
integer(psb_epk_), intent (inout) :: y(:)
integer(psb_epk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info
end subroutine psi_eaxpbyv
subroutine psi_eaxpbyv2(m,alpha, x, beta, y, z, info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_), intent(in) :: m
integer(psb_epk_), intent (in) :: x(:)
integer(psb_epk_), intent (in) :: y(:)
integer(psb_epk_), intent (in) :: z(:)
integer(psb_epk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info
end subroutine psi_eaxpbyv2
end interface psb_geaxpby
interface psi_gth
@@ -91,18 +101,18 @@ module psi_e_serial_mod
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_epk_) :: x(:,:), y(:)
end subroutine psi_egthzmv
subroutine psi_egthzmm(n,k,idx,x,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_epk_) :: x(:,:), y(:,:)
end subroutine psi_egthzmm
subroutine psi_egthzv(n,idx,x,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
implicit none
integer(psb_ipk_) :: n, idx(:)
integer(psb_epk_) :: x(:), y(:)
end subroutine psi_egthzv
@@ -124,7 +134,7 @@ module psi_e_serial_mod
subroutine psi_esctv(n,idx,x,beta,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, idx(:)
integer(psb_epk_) :: beta, x(:), y(:)
end subroutine psi_esctv
base/modules/auxil/psi_i2_serial_mod.f90
+27 -17
View File
@@ -1,9 +1,9 @@
!
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006-2018
! Salvatore Filippone
! Alfredo Buttari
!
! Salvatore Filippone
! Alfredo Buttari
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
@@ -15,7 +15,7 @@
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@@ -27,8 +27,8 @@
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
!
!
module psi_i2_serial_mod
use psb_const_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_
@@ -36,7 +36,7 @@ module psi_i2_serial_mod
! 2-D version
subroutine psb_i2gelp(trans,iperm,x,info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
implicit none
integer(psb_i2pk_), intent(inout) :: x(:,:)
integer(psb_ipk_), intent(in) :: iperm(:)
integer(psb_ipk_), intent(out) :: info
@@ -44,18 +44,18 @@ module psi_i2_serial_mod
end subroutine psb_i2gelp
subroutine psb_i2gelpv(trans,iperm,x,info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
implicit none
integer(psb_i2pk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: iperm(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in) :: trans
end subroutine psb_i2gelpv
end interface psb_gelp
interface psb_geaxpby
interface psb_geaxpby
subroutine psi_i2axpby(m,n,alpha, x, beta, y, info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
implicit none
integer(psb_ipk_), intent(in) :: m, n
integer(psb_i2pk_), intent (in) :: x(:,:)
integer(psb_i2pk_), intent (inout) :: y(:,:)
@@ -64,13 +64,23 @@ module psi_i2_serial_mod
end subroutine psi_i2axpby
subroutine psi_i2axpbyv(m,alpha, x, beta, y, info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
implicit none
integer(psb_ipk_), intent(in) :: m
integer(psb_i2pk_), intent (in) :: x(:)
integer(psb_i2pk_), intent (inout) :: y(:)
integer(psb_i2pk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info
end subroutine psi_i2axpbyv
subroutine psi_i2axpbyv2(m,alpha, x, beta, y, z, info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_), intent(in) :: m
integer(psb_i2pk_), intent (in) :: x(:)
integer(psb_i2pk_), intent (in) :: y(:)
integer(psb_i2pk_), intent (in) :: z(:)
integer(psb_i2pk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info
end subroutine psi_i2axpbyv2
end interface psb_geaxpby
interface psi_gth
@@ -91,18 +101,18 @@ module psi_i2_serial_mod
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_i2pk_) :: x(:,:), y(:)
end subroutine psi_i2gthzmv
subroutine psi_i2gthzmm(n,k,idx,x,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_i2pk_) :: x(:,:), y(:,:)
end subroutine psi_i2gthzmm
subroutine psi_i2gthzv(n,idx,x,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
implicit none
integer(psb_ipk_) :: n, idx(:)
integer(psb_i2pk_) :: x(:), y(:)
end subroutine psi_i2gthzv
@@ -124,7 +134,7 @@ module psi_i2_serial_mod
subroutine psi_i2sctv(n,idx,x,beta,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, idx(:)
integer(psb_i2pk_) :: beta, x(:), y(:)
end subroutine psi_i2sctv
base/modules/auxil/psi_m_serial_mod.f90
+27 -17
View File
@@ -1,9 +1,9 @@
!
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006-2018
! Salvatore Filippone
! Alfredo Buttari
!
! Salvatore Filippone
! Alfredo Buttari
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
@@ -15,7 +15,7 @@
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@@ -27,8 +27,8 @@
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
!
!
module psi_m_serial_mod
use psb_const_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_
@@ -36,7 +36,7 @@ module psi_m_serial_mod
! 2-D version
subroutine psb_mgelp(trans,iperm,x,info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
implicit none
integer(psb_mpk_), intent(inout) :: x(:,:)
integer(psb_ipk_), intent(in) :: iperm(:)
integer(psb_ipk_), intent(out) :: info
@@ -44,18 +44,18 @@ module psi_m_serial_mod
end subroutine psb_mgelp
subroutine psb_mgelpv(trans,iperm,x,info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
implicit none
integer(psb_mpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: iperm(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in) :: trans
end subroutine psb_mgelpv
end interface psb_gelp
interface psb_geaxpby
interface psb_geaxpby
subroutine psi_maxpby(m,n,alpha, x, beta, y, info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
implicit none
integer(psb_ipk_), intent(in) :: m, n
integer(psb_mpk_), intent (in) :: x(:,:)
integer(psb_mpk_), intent (inout) :: y(:,:)
@@ -64,13 +64,23 @@ module psi_m_serial_mod
end subroutine psi_maxpby
subroutine psi_maxpbyv(m,alpha, x, beta, y, info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
implicit none
integer(psb_ipk_), intent(in) :: m
integer(psb_mpk_), intent (in) :: x(:)
integer(psb_mpk_), intent (inout) :: y(:)
integer(psb_mpk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info
end subroutine psi_maxpbyv
subroutine psi_maxpbyv2(m,alpha, x, beta, y, z, info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_), intent(in) :: m
integer(psb_mpk_), intent (in) :: x(:)
integer(psb_mpk_), intent (in) :: y(:)
integer(psb_mpk_), intent (in) :: z(:)
integer(psb_mpk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info
end subroutine psi_maxpbyv2
end interface psb_geaxpby
interface psi_gth
@@ -91,18 +101,18 @@ module psi_m_serial_mod
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_mpk_) :: x(:,:), y(:)
end subroutine psi_mgthzmv
subroutine psi_mgthzmm(n,k,idx,x,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_mpk_) :: x(:,:), y(:,:)
end subroutine psi_mgthzmm
subroutine psi_mgthzv(n,idx,x,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
implicit none
integer(psb_ipk_) :: n, idx(:)
integer(psb_mpk_) :: x(:), y(:)
end subroutine psi_mgthzv
@@ -124,7 +134,7 @@ module psi_m_serial_mod
subroutine psi_msctv(n,idx,x,beta,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, idx(:)
integer(psb_mpk_) :: beta, x(:), y(:)
end subroutine psi_msctv
base/modules/auxil/psi_s_serial_mod.f90
+27 -17
View File
@@ -1,9 +1,9 @@
!
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006-2018
! Salvatore Filippone
! Alfredo Buttari
!
! Salvatore Filippone
! Alfredo Buttari
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
@@ -15,7 +15,7 @@
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@@ -27,8 +27,8 @@
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
!
!
module psi_s_serial_mod
use psb_const_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_, psb_spk_
@@ -36,7 +36,7 @@ module psi_s_serial_mod
! 2-D version
subroutine psb_sgelp(trans,iperm,x,info)
import :: psb_ipk_, psb_spk_
implicit none
implicit none
real(psb_spk_), intent(inout) :: x(:,:)
integer(psb_ipk_), intent(in) :: iperm(:)
integer(psb_ipk_), intent(out) :: info
@@ -44,18 +44,18 @@ module psi_s_serial_mod
end subroutine psb_sgelp
subroutine psb_sgelpv(trans,iperm,x,info)
import :: psb_ipk_, psb_spk_
implicit none
implicit none
real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: iperm(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in) :: trans
end subroutine psb_sgelpv
end interface psb_gelp
interface psb_geaxpby
interface psb_geaxpby
subroutine psi_saxpby(m,n,alpha, x, beta, y, info)
import :: psb_ipk_, psb_spk_
implicit none
implicit none
integer(psb_ipk_), intent(in) :: m, n
real(psb_spk_), intent (in) :: x(:,:)
real(psb_spk_), intent (inout) :: y(:,:)
@@ -64,13 +64,23 @@ module psi_s_serial_mod
end subroutine psi_saxpby
subroutine psi_saxpbyv(m,alpha, x, beta, y, info)
import :: psb_ipk_, psb_spk_
implicit none
implicit none
integer(psb_ipk_), intent(in) :: m
real(psb_spk_), intent (in) :: x(:)
real(psb_spk_), intent (inout) :: y(:)
real(psb_spk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info
end subroutine psi_saxpbyv
subroutine psi_saxpbyv2(m,alpha, x, beta, y, z, info)
import :: psb_ipk_, psb_spk_
implicit none
integer(psb_ipk_), intent(in) :: m
real(psb_spk_), intent (in) :: x(:)
real(psb_spk_), intent (in) :: y(:)
real(psb_spk_), intent (in) :: z(:)
real(psb_spk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info
end subroutine psi_saxpbyv2
end interface psb_geaxpby
interface psi_gth
@@ -91,18 +101,18 @@ module psi_s_serial_mod
implicit none
integer(psb_ipk_) :: n, k, idx(:)
real(psb_spk_) :: x(:,:), y(:)
end subroutine psi_sgthzmv
subroutine psi_sgthzmm(n,k,idx,x,y)
import :: psb_ipk_, psb_spk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
real(psb_spk_) :: x(:,:), y(:,:)
end subroutine psi_sgthzmm
subroutine psi_sgthzv(n,idx,x,y)
import :: psb_ipk_, psb_spk_
implicit none
implicit none
integer(psb_ipk_) :: n, idx(:)
real(psb_spk_) :: x(:), y(:)
end subroutine psi_sgthzv
@@ -124,7 +134,7 @@ module psi_s_serial_mod
subroutine psi_ssctv(n,idx,x,beta,y)
import :: psb_ipk_, psb_spk_
implicit none
integer(psb_ipk_) :: n, idx(:)
real(psb_spk_) :: beta, x(:), y(:)
end subroutine psi_ssctv
base/modules/auxil/psi_z_serial_mod.f90
+27 -17
View File
@@ -1,9 +1,9 @@
!
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006-2018
! Salvatore Filippone
! Alfredo Buttari
!
! Salvatore Filippone
! Alfredo Buttari
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
@@ -15,7 +15,7 @@
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@@ -27,8 +27,8 @@
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
!
!
module psi_z_serial_mod
use psb_const_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_, psb_dpk_
@@ -36,7 +36,7 @@ module psi_z_serial_mod
! 2-D version
subroutine psb_zgelp(trans,iperm,x,info)
import :: psb_ipk_, psb_dpk_
implicit none
implicit none
complex(psb_dpk_), intent(inout) :: x(:,:)
integer(psb_ipk_), intent(in) :: iperm(:)
integer(psb_ipk_), intent(out) :: info
@@ -44,18 +44,18 @@ module psi_z_serial_mod
end subroutine psb_zgelp
subroutine psb_zgelpv(trans,iperm,x,info)
import :: psb_ipk_, psb_dpk_
implicit none
implicit none
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: iperm(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in) :: trans
end subroutine psb_zgelpv
end interface psb_gelp
interface psb_geaxpby
interface psb_geaxpby
subroutine psi_zaxpby(m,n,alpha, x, beta, y, info)
import :: psb_ipk_, psb_dpk_
implicit none
implicit none
integer(psb_ipk_), intent(in) :: m, n
complex(psb_dpk_), intent (in) :: x(:,:)
complex(psb_dpk_), intent (inout) :: y(:,:)
@@ -64,13 +64,23 @@ module psi_z_serial_mod
end subroutine psi_zaxpby
subroutine psi_zaxpbyv(m,alpha, x, beta, y, info)
import :: psb_ipk_, psb_dpk_
implicit none
implicit none
integer(psb_ipk_), intent(in) :: m
complex(psb_dpk_), intent (in) :: x(:)
complex(psb_dpk_), intent (inout) :: y(:)
complex(psb_dpk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info
end subroutine psi_zaxpbyv
subroutine psi_zaxpbyv2(m,alpha, x, beta, y, z, info)
import :: psb_ipk_, psb_dpk_
implicit none
integer(psb_ipk_), intent(in) :: m
complex(psb_dpk_), intent (in) :: x(:)
complex(psb_dpk_), intent (in) :: y(:)
complex(psb_dpk_), intent (in) :: z(:)
complex(psb_dpk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info
end subroutine psi_zaxpbyv2
end interface psb_geaxpby
interface psi_gth
@@ -91,18 +101,18 @@ module psi_z_serial_mod
implicit none
integer(psb_ipk_) :: n, k, idx(:)
complex(psb_dpk_) :: x(:,:), y(:)
end subroutine psi_zgthzmv
subroutine psi_zgthzmm(n,k,idx,x,y)
import :: psb_ipk_, psb_dpk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
complex(psb_dpk_) :: x(:,:), y(:,:)
end subroutine psi_zgthzmm
subroutine psi_zgthzv(n,idx,x,y)
import :: psb_ipk_, psb_dpk_
implicit none
implicit none
integer(psb_ipk_) :: n, idx(:)
complex(psb_dpk_) :: x(:), y(:)
end subroutine psi_zgthzv
@@ -124,7 +134,7 @@ module psi_z_serial_mod
subroutine psi_zsctv(n,idx,x,beta,y)
import :: psb_ipk_, psb_dpk_
implicit none
integer(psb_ipk_) :: n, idx(:)
complex(psb_dpk_) :: beta, x(:), y(:)
end subroutine psi_zsctv
base/modules/penv/psi_collective_mod.F90
+74 -49
View File
@@ -1,9 +1,9 @@
!
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006-2018
! Salvatore Filippone
! Alfredo Buttari
!
! Salvatore Filippone
! Alfredo Buttari
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
@@ -15,7 +15,7 @@
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@@ -27,8 +27,8 @@
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
!
!
module psi_collective_mod
use psi_penv_mod
use psi_m_collective_mod
@@ -42,10 +42,10 @@ module psi_collective_mod
module procedure psb_hbcasts, psb_hbcastv,&
& psb_hbcasts_ec, psb_hbcastv_ec,&
& psb_lbcasts, psb_lbcastv, &
& psb_lbcasts_ec, psb_lbcastv_ec
& psb_lbcasts_ec, psb_lbcastv_ec
end interface psb_bcast
#if defined(SHORT_INTEGERS)
interface psb_sum
module procedure psb_i2sums, psb_i2sumv, psb_i2summ, &
@@ -55,12 +55,12 @@ module psi_collective_mod
contains
subroutine psb_hbcasts(ictxt,dat,root,length)
#ifdef MPI_MOD
use mpi
#endif
implicit none
implicit none
#ifdef MPI_H
include 'mpif.h'
#endif
@@ -85,7 +85,7 @@ contains
call psb_info(ictxt,iam,np)
call mpi_bcast(dat,length_,MPI_CHARACTER,root_,ictxt,info)
#endif
#endif
end subroutine psb_hbcasts
@@ -93,7 +93,7 @@ contains
#ifdef MPI_MOD
use mpi
#endif
implicit none
implicit none
#ifdef MPI_H
include 'mpif.h'
#endif
@@ -110,24 +110,24 @@ contains
root_ = psb_root_
endif
length_ = len(dat)
size_ = size(dat)
size_ = size(dat)
call psb_info(ictxt,iam,np)
call mpi_bcast(dat,length_*size_,MPI_CHARACTER,root_,ictxt,info)
#endif
#endif
end subroutine psb_hbcastv
subroutine psb_hbcasts_ec(ictxt,dat,root)
implicit none
implicit none
integer(psb_epk_), intent(in) :: ictxt
character(len=*), intent(inout) :: dat
integer(psb_epk_), intent(in), optional :: root
integer(psb_mpk_) :: ictxt_, root_
ictxt_ = ictxt
if (present(root)) then
if (present(root)) then
root_ = root
call psb_bcast(ictxt_,dat,root_)
else
@@ -136,14 +136,14 @@ contains
end subroutine psb_hbcasts_ec
subroutine psb_hbcastv_ec(ictxt,dat,root)
implicit none
implicit none
integer(psb_epk_), intent(in) :: ictxt
character(len=*), intent(inout) :: dat(:)
integer(psb_epk_), intent(in), optional :: root
integer(psb_mpk_) :: ictxt_, root_
ictxt_ = ictxt
if (present(root)) then
if (present(root)) then
root_ = root
call psb_bcast(ictxt_,dat,root_)
else
@@ -152,12 +152,12 @@ contains
end subroutine psb_hbcastv_ec
subroutine psb_lbcasts(ictxt,dat,root)
#ifdef MPI_MOD
use mpi
#endif
implicit none
implicit none
#ifdef MPI_H
include 'mpif.h'
#endif
@@ -176,16 +176,41 @@ contains
call psb_info(ictxt,iam,np)
call mpi_bcast(dat,1,MPI_LOGICAL,root_,ictxt,info)
#endif
#endif
end subroutine psb_lbcasts
subroutine psb_lallreduceand(ictxt,dat,rec)
#ifdef MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
include 'mpif.h'
#endif
integer(psb_mpk_), intent(in) :: ictxt
logical, intent(inout) :: dat
logical, intent(inout), optional :: rec
integer(psb_mpk_) :: iam, np, info
#if !defined(SERIAL_MPI)
call psb_info(ictxt,iam,np)
if (present(rec)) then
call mpi_allreduce(dat,rec,1,MPI_LOGICAL,MPI_LAND,ictxt,info)
else
call mpi_allreduce(MPI_IN_PLACE,dat,1,MPI_LOGICAL,MPI_LAND,ictxt,info)
endif
#endif
end subroutine psb_lallreduceand
subroutine psb_lbcastv(ictxt,dat,root)
#ifdef MPI_MOD
use mpi
#endif
implicit none
implicit none
#ifdef MPI_H
include 'mpif.h'
#endif
@@ -204,20 +229,20 @@ contains
call psb_info(ictxt,iam,np)
call mpi_bcast(dat,size(dat),MPI_LOGICAL,root_,ictxt,info)
#endif
#endif
end subroutine psb_lbcastv
subroutine psb_lbcasts_ec(ictxt,dat,root)
implicit none
implicit none
integer(psb_epk_), intent(in) :: ictxt
logical, intent(inout) :: dat
integer(psb_epk_), intent(in), optional :: root
integer(psb_mpk_) :: ictxt_, root_
ictxt_ = ictxt
if (present(root)) then
if (present(root)) then
root_ = root
call psb_bcast(ictxt_,dat,root_)
else
@@ -226,14 +251,14 @@ contains
end subroutine psb_lbcasts_ec
subroutine psb_lbcastv_ec(ictxt,dat,root)
implicit none
implicit none
integer(psb_epk_), intent(in) :: ictxt
logical, intent(inout) :: dat(:)
integer(psb_epk_), intent(in), optional :: root
integer(psb_mpk_) :: ictxt_, root_
ictxt_ = ictxt
if (present(root)) then
if (present(root)) then
root_ = root
call psb_bcast(ictxt_,dat,root_)
else
@@ -242,14 +267,14 @@ contains
end subroutine psb_lbcastv_ec
#if defined(SHORT_INTEGERS)
subroutine psb_i2sums(ictxt,dat,root)
#ifdef MPI_MOD
use mpi
#endif
implicit none
implicit none
#ifdef MPI_H
include 'mpif.h'
#endif
@@ -265,12 +290,12 @@ contains
call psb_info(ictxt,iam,np)
if (present(root)) then
if (present(root)) then
root_ = root
else
root_ = -1
endif
if (root_ == -1) then
if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,psb_mpi_i2pk_,mpi_sum,ictxt,info)
dat = dat_
else
@@ -278,7 +303,7 @@ contains
if (iam == root_) dat = dat_
endif
#endif
#endif
end subroutine psb_i2sums
subroutine psb_i2sumv(ictxt,dat,root)
@@ -286,7 +311,7 @@ contains
#ifdef MPI_MOD
use mpi
#endif
implicit none
implicit none
#ifdef MPI_H
include 'mpif.h'
#endif
@@ -302,18 +327,18 @@ contains
call psb_info(ictxt,iam,np)
if (present(root)) then
if (present(root)) then
root_ = root
else
root_ = -1
endif
if (root_ == -1) then
if (root_ == -1) then
call psb_realloc(size(dat),dat_,iinfo)
dat_=dat
if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),&
& psb_mpi_i2pk_,mpi_sum,ictxt,info)
else
if (iam == root_) then
if (iam == root_) then
call psb_realloc(size(dat),dat_,iinfo)
dat_=dat
call mpi_reduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_sum,root_,ictxt,info)
@@ -321,7 +346,7 @@ contains
call mpi_reduce(dat,dat_,size(dat),psb_mpi_i2pk_,mpi_sum,root_,ictxt,info)
end if
endif
#endif
#endif
end subroutine psb_i2sumv
subroutine psb_i2summ(ictxt,dat,root)
@@ -329,7 +354,7 @@ contains
#ifdef MPI_MOD
use mpi
#endif
implicit none
implicit none
#ifdef MPI_H
include 'mpif.h'
#endif
@@ -345,18 +370,18 @@ contains
#if !defined(SERIAL_MPI)
call psb_info(ictxt,iam,np)
if (present(root)) then
if (present(root)) then
root_ = root
else
root_ = -1
endif
if (root_ == -1) then
if (root_ == -1) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_=dat
if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),&
& psb_mpi_i2pk_,mpi_sum,ictxt,info)
else
if (iam == root_) then
if (iam == root_) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_=dat
call mpi_reduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_sum,root_,ictxt,info)
@@ -364,18 +389,18 @@ contains
call mpi_reduce(dat,dat_,size(dat),psb_mpi_i2pk_,mpi_sum,root_,ictxt,info)
end if
endif
#endif
#endif
end subroutine psb_i2summ
subroutine psb_i2sums_ec(ictxt,dat,root)
implicit none
implicit none
integer(psb_epk_), intent(in) :: ictxt
integer(psb_i2pk_), intent(inout) :: dat
integer(psb_epk_), intent(in), optional :: root
integer(psb_mpk_) :: ictxt_, root_
ictxt_ = ictxt
if (present(root)) then
if (present(root)) then
root_ = root
call psb_sum(ictxt_,dat,root_)
else
@@ -384,14 +409,14 @@ contains
end subroutine psb_i2sums_ec
subroutine psb_i2sumv_ec(ictxt,dat,root)
implicit none
implicit none
integer(psb_epk_), intent(in) :: ictxt
integer(psb_i2pk_), intent(inout) :: dat(:)
integer(psb_epk_), intent(in), optional :: root
integer(psb_mpk_) :: ictxt_, root_
ictxt_ = ictxt
if (present(root)) then
if (present(root)) then
root_ = root
call psb_sum(ictxt_,dat,root_)
else
@@ -400,14 +425,14 @@ contains
end subroutine psb_i2sumv_ec
subroutine psb_i2summ_ec(ictxt,dat,root)
implicit none
implicit none
integer(psb_epk_), intent(in) :: ictxt
integer(psb_i2pk_), intent(inout) :: dat(:,:)
integer(psb_epk_), intent(in), optional :: root
integer(psb_mpk_) :: ictxt_, root_
ictxt_ = ictxt
if (present(root)) then
if (present(root)) then
root_ = root
call psb_sum(ictxt_,dat,root_)
else
base/modules/psblas/psb_c_psblas_mod.F90
+248 -24
View File
@@ -1,9 +1,9 @@
!
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006-2018
! Salvatore Filippone
! Alfredo Buttari
!
! Salvatore Filippone
! Alfredo Buttari
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
@@ -15,7 +15,7 @@
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@@ -27,10 +27,10 @@
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
!
!
module psb_c_psblas_mod
use psb_desc_mod, only : psb_desc_type, psb_spk_, psb_ipk_
use psb_desc_mod, only : psb_desc_type, psb_spk_, psb_ipk_, psb_lpk_
use psb_c_vect_mod, only : psb_c_vect_type
use psb_c_mat_mod, only : psb_cspmat_type
@@ -44,7 +44,7 @@ module psb_c_psblas_mod
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_cdot_vect
function psb_cdotv(x, y, desc_a,info,global)
function psb_cdotv(x, y, desc_a,info,global)
import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_c_vect_type, psb_cspmat_type
complex(psb_spk_) :: psb_cdotv
@@ -53,7 +53,7 @@ module psb_c_psblas_mod
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_cdotv
function psb_cdot(x, y, desc_a, info, jx, jy,global)
function psb_cdot(x, y, desc_a, info, jx, jy,global)
import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_c_vect_type, psb_cspmat_type
complex(psb_spk_) :: psb_cdot
@@ -69,7 +69,7 @@ module psb_c_psblas_mod
interface psb_gedots
subroutine psb_cdotvs(res,x, y, desc_a, info,global)
import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_c_vect_type, psb_cspmat_type
& psb_c_vect_type, psb_cspmat_type
complex(psb_spk_), intent(out) :: res
complex(psb_spk_), intent(in) :: x(:), y(:)
type(psb_desc_type), intent(in) :: desc_a
@@ -78,7 +78,7 @@ module psb_c_psblas_mod
end subroutine psb_cdotvs
subroutine psb_cmdots(res,x, y, desc_a,info,global)
import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_c_vect_type, psb_cspmat_type
& psb_c_vect_type, psb_cspmat_type
complex(psb_spk_), intent(out) :: res(:)
complex(psb_spk_), intent(in) :: x(:,:), y(:,:)
type(psb_desc_type), intent(in) :: desc_a
@@ -98,6 +98,17 @@ module psb_c_psblas_mod
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_caxpby_vect
subroutine psb_caxpby_vect_out(alpha, x, beta, y,&
& z, desc_a, info)
import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_c_vect_type, psb_cspmat_type
type(psb_c_vect_type), intent (inout) :: x
type(psb_c_vect_type), intent (inout) :: y
type(psb_c_vect_type), intent (inout) :: z
complex(psb_spk_), intent (in) :: alpha, beta
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_caxpby_vect_out
subroutine psb_caxpbyv(alpha, x, beta, y,&
& desc_a, info)
import :: psb_desc_type, psb_spk_, psb_ipk_, &
@@ -108,6 +119,17 @@ module psb_c_psblas_mod
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_caxpbyv
subroutine psb_caxpbyvout(alpha, x, beta, y,&
& z, desc_a, info)
import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_c_vect_type, psb_cspmat_type
complex(psb_spk_), intent (in) :: x(:)
complex(psb_spk_), intent (in) :: y(:)
complex(psb_spk_), intent (inout) :: z(:)
complex(psb_spk_), intent (in) :: alpha, beta
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_caxpbyvout
subroutine psb_caxpby(alpha, x, beta, y,&
& desc_a, info, n, jx, jy)
import :: psb_desc_type, psb_spk_, psb_ipk_, &
@@ -155,10 +177,10 @@ module psb_c_psblas_mod
#if ! defined(HAVE_BUGGY_GENERICS)
interface psb_genrmi
procedure psb_camax, psb_camaxv, psb_camax_vect
end interface
end interface
interface psb_normi
procedure psb_camax, psb_camaxv, psb_camax_vect
end interface
end interface
#endif
interface psb_geamaxs
@@ -183,6 +205,7 @@ module psb_c_psblas_mod
end subroutine psb_cmamaxs
end interface
interface psb_geasum
function psb_casum_vect(x, desc_a, info,global) result(res)
import :: psb_desc_type, psb_spk_, psb_ipk_, &
@@ -238,10 +261,10 @@ module psb_c_psblas_mod
#if ! defined(HAVE_BUGGY_GENERICS)
interface psb_genrm1
procedure psb_casum, psb_casumv, psb_casum_vect
end interface
end interface
interface psb_norm1
procedure psb_casum, psb_casumv, psb_casum_vect
end interface
end interface
#endif
interface psb_genrm2
@@ -273,12 +296,33 @@ module psb_c_psblas_mod
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_cnrm2_vect
function psb_cnrm2_weight_vect(x,w, desc_a, info,global) result(res)
import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_c_vect_type, psb_cspmat_type
real(psb_spk_) :: res
type(psb_c_vect_type), intent (inout) :: x
type(psb_c_vect_type), intent (inout) :: w
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_cnrm2_weight_vect
function psb_cnrm2_weightmask_vect(x,w,idv, desc_a, info,global) result(res)
import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_c_vect_type, psb_cspmat_type
real(psb_spk_) :: res
type(psb_c_vect_type), intent (inout) :: x
type(psb_c_vect_type), intent (inout) :: w
type(psb_c_vect_type), intent (inout) :: idv
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_cnrm2_weightmask_vect
end interface
#if ! defined(HAVE_BUGGY_GENERICS)
interface psb_norm2
procedure psb_cnrm2, psb_cnrm2v, psb_cnrm2_vect
end interface
procedure psb_cnrm2, psb_cnrm2v, psb_cnrm2_vect, psb_cnrm2_weight_vect, psb_cnrm2_weightmask_vect
end interface
#endif
interface psb_genrm2s
@@ -309,7 +353,7 @@ module psb_c_psblas_mod
#if ! defined(HAVE_BUGGY_GENERICS)
interface psb_normi
procedure psb_cnrmi
end interface
end interface
#endif
interface psb_spnrm1
@@ -323,11 +367,11 @@ module psb_c_psblas_mod
logical, intent(in), optional :: global
end function psb_cspnrm1
end interface
#if ! defined(HAVE_BUGGY_GENERICS)
interface psb_norm1
procedure psb_cspnrm1
end interface
end interface
#endif
interface psb_spmm
@@ -378,7 +422,7 @@ module psb_c_psblas_mod
interface psb_spsm
subroutine psb_cspsm(alpha, t, x, beta, y,&
& desc_a, info, trans, scale, choice,&
& desc_a, info, trans, scale, choice,&
& diag, n, jx, jy, work)
import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_c_vect_type, psb_cspmat_type
@@ -395,7 +439,7 @@ module psb_c_psblas_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psb_cspsm
subroutine psb_cspsv(alpha, t, x, beta, y,&
& desc_a, info, trans, scale, choice,&
& desc_a, info, trans, scale, choice,&
& diag, work)
import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_c_vect_type, psb_cspmat_type
@@ -411,7 +455,7 @@ module psb_c_psblas_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psb_cspsv
subroutine psb_cspsv_vect(alpha, t, x, beta, y,&
& desc_a, info, trans, scale, choice,&
& desc_a, info, trans, scale, choice,&
& diag, work)
import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_c_vect_type, psb_cspmat_type
@@ -428,4 +472,184 @@ module psb_c_psblas_mod
end subroutine psb_cspsv_vect
end interface
interface psb_gemlt
subroutine psb_cmlt_vect(x,y,desc_a,info)
import :: psb_desc_type, psb_ipk_, &
& psb_c_vect_type
type(psb_c_vect_type), intent (inout) :: x
type(psb_c_vect_type), intent (inout) :: y
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_cmlt_vect
subroutine psb_cmlt_vect2(alpha,x,y,beta,z,desc_a,info,conjgx,conjgy)
import :: psb_desc_type, psb_ipk_, &
& psb_c_vect_type, psb_spk_
complex(psb_spk_), intent(in) :: alpha,beta
type(psb_c_vect_type), intent (inout) :: x
type(psb_c_vect_type), intent (inout) :: y
type(psb_c_vect_type), intent (inout) :: z
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
character(len=1), intent(in), optional :: conjgx, conjgy
end subroutine psb_cmlt_vect2
end interface
interface psb_gediv
subroutine psb_cdiv_vect(x,y,desc_a,info)
import :: psb_desc_type, psb_ipk_, &
& psb_c_vect_type
type(psb_c_vect_type), intent (inout) :: x
type(psb_c_vect_type), intent (inout) :: y
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_cdiv_vect
subroutine psb_cdiv_vect2(x,y,z,desc_a,info)
import :: psb_desc_type, psb_ipk_, &
& psb_c_vect_type
type(psb_c_vect_type), intent (inout) :: x
type(psb_c_vect_type), intent (inout) :: y
type(psb_c_vect_type), intent (inout) :: z
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_cdiv_vect2
subroutine psb_cdiv_vect_check(x,y,desc_a,info,flag)
import :: psb_desc_type, psb_ipk_, &
& psb_c_vect_type
type(psb_c_vect_type), intent (inout) :: x
type(psb_c_vect_type), intent (inout) :: y
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
logical, intent(in) :: flag
end subroutine psb_cdiv_vect_check
subroutine psb_cdiv_vect2_check(x,y,z,desc_a,info,flag)
import :: psb_desc_type, psb_ipk_, &
& psb_c_vect_type
type(psb_c_vect_type), intent (inout) :: x
type(psb_c_vect_type), intent (inout) :: y
type(psb_c_vect_type), intent (inout) :: z
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
logical, intent(in) :: flag
end subroutine psb_cdiv_vect2_check
end interface
interface psb_geinv
subroutine psb_cinv_vect(x,y,desc_a,info)
import :: psb_desc_type, psb_ipk_, &
& psb_c_vect_type
type(psb_c_vect_type), intent (inout) :: x
type(psb_c_vect_type), intent (inout) :: y
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_cinv_vect
subroutine psb_cinv_vect_check(x,y,desc_a,info,flag)
import :: psb_desc_type, psb_ipk_, &
& psb_c_vect_type
type(psb_c_vect_type), intent (inout) :: x
type(psb_c_vect_type), intent (inout) :: y
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
logical, intent(in) :: flag
end subroutine psb_cinv_vect_check
end interface
interface psb_geabs
subroutine psb_cabs_vect(x,y,desc_a,info)
import :: psb_desc_type, psb_ipk_, &
& psb_c_vect_type
type(psb_c_vect_type), intent (inout) :: x
type(psb_c_vect_type), intent (inout) :: y
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_cabs_vect
end interface
interface psb_gecmp
subroutine psb_ccmp_vect(x,c,z,desc_a,info)
import :: psb_desc_type, psb_ipk_, &
& psb_c_vect_type, psb_spk_
type(psb_c_vect_type), intent (inout) :: x
type(psb_c_vect_type), intent (inout) :: z
real(psb_spk_), intent(in) :: c
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ccmp_vect
subroutine psb_ccmp_spmatval(a,val,tol,desc_a,res,info)
import :: psb_desc_type, psb_ipk_, &
& psb_lpk_, psb_cspmat_type, psb_spk_
type(psb_cspmat_type), intent(inout) :: a
complex(psb_spk_), intent(in) :: val
real(psb_spk_), intent(in) :: tol
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
logical, intent(out) :: res
end subroutine psb_ccmp_spmatval
subroutine psb_ccmp_spmat(a,b,tol,desc_a,res,info)
import :: psb_desc_type, psb_ipk_, &
& psb_lpk_, psb_cspmat_type, psb_spk_
type(psb_cspmat_type), intent(inout) :: a
type(psb_cspmat_type), intent(inout) :: b
real(psb_spk_), intent(in) :: tol
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
logical, intent(out) :: res
end subroutine psb_ccmp_spmat
end interface
interface psb_geaddconst
subroutine psb_caddconst_vect(x,b,z,desc_a,info)
import :: psb_desc_type, psb_ipk_, &
& psb_c_vect_type, psb_spk_
type(psb_c_vect_type), intent (inout) :: x
type(psb_c_vect_type), intent (inout) :: z
real(psb_spk_), intent(in) :: b
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_caddconst_vect
end interface
interface psb_nnz
function psb_cget_nnz(a,desc_a,info) result(res)
import :: psb_desc_type, psb_ipk_, psb_lpk_, &
& psb_cspmat_type, psb_spk_
integer(psb_lpk_) :: res
type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end function
end interface
interface psb_is_matupd
function psb_c_is_matupd(a,desc_a,info) result(res)
import :: psb_desc_type, psb_cspmat_type, &
& psb_spk_, psb_ipk_
logical :: res
type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end function
end interface
interface psb_is_matasb
function psb_c_is_matasb(a,desc_a,info) result(res)
import :: psb_desc_type, psb_cspmat_type, &
& psb_spk_, psb_ipk_
logical :: res
type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end function
end interface
interface psb_is_matbld
function psb_c_is_matbld(a,desc_a,info) result(res)
import :: psb_desc_type, psb_cspmat_type, &
& psb_spk_, psb_ipk_
logical :: res
type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end function
end interface
end module psb_c_psblas_mod
base/modules/psblas/psb_d_psblas_mod.F90
+283 -24
View File
@@ -1,9 +1,9 @@
!
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006-2018
! Salvatore Filippone
! Alfredo Buttari
!
! Salvatore Filippone
! Alfredo Buttari
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
@@ -15,7 +15,7 @@
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@@ -27,10 +27,10 @@
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
!
!
module psb_d_psblas_mod
use psb_desc_mod, only : psb_desc_type, psb_dpk_, psb_ipk_
use psb_desc_mod, only : psb_desc_type, psb_dpk_, psb_ipk_, psb_lpk_
use psb_d_vect_mod, only : psb_d_vect_type
use psb_d_mat_mod, only : psb_dspmat_type
@@ -44,7 +44,7 @@ module psb_d_psblas_mod
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_ddot_vect
function psb_ddotv(x, y, desc_a,info,global)
function psb_ddotv(x, y, desc_a,info,global)
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_d_vect_type, psb_dspmat_type
real(psb_dpk_) :: psb_ddotv
@@ -53,7 +53,7 @@ module psb_d_psblas_mod
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_ddotv
function psb_ddot(x, y, desc_a, info, jx, jy,global)
function psb_ddot(x, y, desc_a, info, jx, jy,global)
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_d_vect_type, psb_dspmat_type
real(psb_dpk_) :: psb_ddot
@@ -69,7 +69,7 @@ module psb_d_psblas_mod
interface psb_gedots
subroutine psb_ddotvs(res,x, y, desc_a, info,global)
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_d_vect_type, psb_dspmat_type
& psb_d_vect_type, psb_dspmat_type
real(psb_dpk_), intent(out) :: res
real(psb_dpk_), intent(in) :: x(:), y(:)
type(psb_desc_type), intent(in) :: desc_a
@@ -78,7 +78,7 @@ module psb_d_psblas_mod
end subroutine psb_ddotvs
subroutine psb_dmdots(res,x, y, desc_a,info,global)
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_d_vect_type, psb_dspmat_type
& psb_d_vect_type, psb_dspmat_type
real(psb_dpk_), intent(out) :: res(:)
real(psb_dpk_), intent(in) :: x(:,:), y(:,:)
type(psb_desc_type), intent(in) :: desc_a
@@ -98,6 +98,17 @@ module psb_d_psblas_mod
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_daxpby_vect
subroutine psb_daxpby_vect_out(alpha, x, beta, y,&
& z, desc_a, info)
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_d_vect_type, psb_dspmat_type
type(psb_d_vect_type), intent (inout) :: x
type(psb_d_vect_type), intent (inout) :: y
type(psb_d_vect_type), intent (inout) :: z
real(psb_dpk_), intent (in) :: alpha, beta
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_daxpby_vect_out
subroutine psb_daxpbyv(alpha, x, beta, y,&
& desc_a, info)
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
@@ -108,6 +119,17 @@ module psb_d_psblas_mod
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_daxpbyv
subroutine psb_daxpbyvout(alpha, x, beta, y,&
& z, desc_a, info)
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_d_vect_type, psb_dspmat_type
real(psb_dpk_), intent (in) :: x(:)
real(psb_dpk_), intent (in) :: y(:)
real(psb_dpk_), intent (inout) :: z(:)
real(psb_dpk_), intent (in) :: alpha, beta
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_daxpbyvout
subroutine psb_daxpby(alpha, x, beta, y,&
& desc_a, info, n, jx, jy)
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
@@ -155,10 +177,10 @@ module psb_d_psblas_mod
#if ! defined(HAVE_BUGGY_GENERICS)
interface psb_genrmi
procedure psb_damax, psb_damaxv, psb_damax_vect
end interface
end interface
interface psb_normi
procedure psb_damax, psb_damaxv, psb_damax_vect
end interface
end interface
#endif
interface psb_geamaxs
@@ -183,6 +205,18 @@ module psb_d_psblas_mod
end subroutine psb_dmamaxs
end interface
interface psb_gemin
function psb_dmin_vect(x, desc_a, info,global) result(res)
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_d_vect_type, psb_dspmat_type
real(psb_dpk_) :: res
type(psb_d_vect_type), intent (inout) :: x
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_dmin_vect
end interface
interface psb_geasum
function psb_dasum_vect(x, desc_a, info,global) result(res)
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
@@ -238,10 +272,10 @@ module psb_d_psblas_mod
#if ! defined(HAVE_BUGGY_GENERICS)
interface psb_genrm1
procedure psb_dasum, psb_dasumv, psb_dasum_vect
end interface
end interface
interface psb_norm1
procedure psb_dasum, psb_dasumv, psb_dasum_vect
end interface
end interface
#endif
interface psb_genrm2
@@ -273,12 +307,33 @@ module psb_d_psblas_mod
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_dnrm2_vect
function psb_dnrm2_weight_vect(x,w, desc_a, info,global) result(res)
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_d_vect_type, psb_dspmat_type
real(psb_dpk_) :: res
type(psb_d_vect_type), intent (inout) :: x
type(psb_d_vect_type), intent (inout) :: w
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_dnrm2_weight_vect
function psb_dnrm2_weightmask_vect(x,w,idv, desc_a, info,global) result(res)
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_d_vect_type, psb_dspmat_type
real(psb_dpk_) :: res
type(psb_d_vect_type), intent (inout) :: x
type(psb_d_vect_type), intent (inout) :: w
type(psb_d_vect_type), intent (inout) :: idv
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_dnrm2_weightmask_vect
end interface
#if ! defined(HAVE_BUGGY_GENERICS)
interface psb_norm2
procedure psb_dnrm2, psb_dnrm2v, psb_dnrm2_vect
end interface
procedure psb_dnrm2, psb_dnrm2v, psb_dnrm2_vect, psb_dnrm2_weight_vect, psb_dnrm2_weightmask_vect
end interface
#endif
interface psb_genrm2s
@@ -309,7 +364,7 @@ module psb_d_psblas_mod
#if ! defined(HAVE_BUGGY_GENERICS)
interface psb_normi
procedure psb_dnrmi
end interface
end interface
#endif
interface psb_spnrm1
@@ -323,11 +378,11 @@ module psb_d_psblas_mod
logical, intent(in), optional :: global
end function psb_dspnrm1
end interface
#if ! defined(HAVE_BUGGY_GENERICS)
interface psb_norm1
procedure psb_dspnrm1
end interface
end interface
#endif
interface psb_spmm
@@ -378,7 +433,7 @@ module psb_d_psblas_mod
interface psb_spsm
subroutine psb_dspsm(alpha, t, x, beta, y,&
& desc_a, info, trans, scale, choice,&
& desc_a, info, trans, scale, choice,&
& diag, n, jx, jy, work)
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_d_vect_type, psb_dspmat_type
@@ -395,7 +450,7 @@ module psb_d_psblas_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psb_dspsm
subroutine psb_dspsv(alpha, t, x, beta, y,&
& desc_a, info, trans, scale, choice,&
& desc_a, info, trans, scale, choice,&
& diag, work)
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_d_vect_type, psb_dspmat_type
@@ -411,7 +466,7 @@ module psb_d_psblas_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psb_dspsv
subroutine psb_dspsv_vect(alpha, t, x, beta, y,&
& desc_a, info, trans, scale, choice,&
& desc_a, info, trans, scale, choice,&
& diag, work)
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_d_vect_type, psb_dspmat_type
@@ -428,4 +483,208 @@ module psb_d_psblas_mod
end subroutine psb_dspsv_vect
end interface
interface psb_gemlt
subroutine psb_dmlt_vect(x,y,desc_a,info)
import :: psb_desc_type, psb_ipk_, &
& psb_d_vect_type
type(psb_d_vect_type), intent (inout) :: x
type(psb_d_vect_type), intent (inout) :: y
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_dmlt_vect
subroutine psb_dmlt_vect2(alpha,x,y,beta,z,desc_a,info,conjgx,conjgy)
import :: psb_desc_type, psb_ipk_, &
& psb_d_vect_type, psb_dpk_
real(psb_dpk_), intent(in) :: alpha,beta
type(psb_d_vect_type), intent (inout) :: x
type(psb_d_vect_type), intent (inout) :: y
type(psb_d_vect_type), intent (inout) :: z
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
character(len=1), intent(in), optional :: conjgx, conjgy
end subroutine psb_dmlt_vect2
end interface
interface psb_gediv
subroutine psb_ddiv_vect(x,y,desc_a,info)
import :: psb_desc_type, psb_ipk_, &
& psb_d_vect_type
type(psb_d_vect_type), intent (inout) :: x
type(psb_d_vect_type), intent (inout) :: y
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ddiv_vect
subroutine psb_ddiv_vect2(x,y,z,desc_a,info)
import :: psb_desc_type, psb_ipk_, &
& psb_d_vect_type
type(psb_d_vect_type), intent (inout) :: x
type(psb_d_vect_type), intent (inout) :: y
type(psb_d_vect_type), intent (inout) :: z
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ddiv_vect2
subroutine psb_ddiv_vect_check(x,y,desc_a,info,flag)
import :: psb_desc_type, psb_ipk_, &
& psb_d_vect_type
type(psb_d_vect_type), intent (inout) :: x
type(psb_d_vect_type), intent (inout) :: y
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
logical, intent(in) :: flag
end subroutine psb_ddiv_vect_check
subroutine psb_ddiv_vect2_check(x,y,z,desc_a,info,flag)
import :: psb_desc_type, psb_ipk_, &
& psb_d_vect_type
type(psb_d_vect_type), intent (inout) :: x
type(psb_d_vect_type), intent (inout) :: y
type(psb_d_vect_type), intent (inout) :: z
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
logical, intent(in) :: flag
end subroutine psb_ddiv_vect2_check
end interface
interface psb_geinv
subroutine psb_dinv_vect(x,y,desc_a,info)
import :: psb_desc_type, psb_ipk_, &
& psb_d_vect_type
type(psb_d_vect_type), intent (inout) :: x
type(psb_d_vect_type), intent (inout) :: y
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_dinv_vect
subroutine psb_dinv_vect_check(x,y,desc_a,info,flag)
import :: psb_desc_type, psb_ipk_, &
& psb_d_vect_type
type(psb_d_vect_type), intent (inout) :: x
type(psb_d_vect_type), intent (inout) :: y
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
logical, intent(in) :: flag
end subroutine psb_dinv_vect_check
end interface
interface psb_geabs
subroutine psb_dabs_vect(x,y,desc_a,info)
import :: psb_desc_type, psb_ipk_, &
& psb_d_vect_type
type(psb_d_vect_type), intent (inout) :: x
type(psb_d_vect_type), intent (inout) :: y
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_dabs_vect
end interface
interface psb_gecmp
subroutine psb_dcmp_vect(x,c,z,desc_a,info)
import :: psb_desc_type, psb_ipk_, &
& psb_d_vect_type, psb_dpk_
type(psb_d_vect_type), intent (inout) :: x
type(psb_d_vect_type), intent (inout) :: z
real(psb_dpk_), intent(in) :: c
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_dcmp_vect
subroutine psb_dcmp_spmatval(a,val,tol,desc_a,res,info)
import :: psb_desc_type, psb_ipk_, &
& psb_lpk_, psb_dspmat_type, psb_dpk_
type(psb_dspmat_type), intent(inout) :: a
real(psb_dpk_), intent(in) :: val
real(psb_dpk_), intent(in) :: tol
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
logical, intent(out) :: res
end subroutine psb_dcmp_spmatval
subroutine psb_dcmp_spmat(a,b,tol,desc_a,res,info)
import :: psb_desc_type, psb_ipk_, &
& psb_lpk_, psb_dspmat_type, psb_dpk_
type(psb_dspmat_type), intent(inout) :: a
type(psb_dspmat_type), intent(inout) :: b
real(psb_dpk_), intent(in) :: tol
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
logical, intent(out) :: res
end subroutine psb_dcmp_spmat
end interface
interface psb_geaddconst
subroutine psb_daddconst_vect(x,b,z,desc_a,info)
import :: psb_desc_type, psb_ipk_, &
& psb_d_vect_type, psb_dpk_
type(psb_d_vect_type), intent (inout) :: x
type(psb_d_vect_type), intent (inout) :: z
real(psb_dpk_), intent(in) :: b
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_daddconst_vect
end interface
interface psb_mask
subroutine psb_dmask_vect(c,x,m,t,desc_a,info)
import :: psb_desc_type, psb_ipk_, &
& psb_d_vect_type, psb_dpk_
type(psb_d_vect_type), intent (inout) :: c
type(psb_d_vect_type), intent (inout) :: x
type(psb_d_vect_type), intent (inout) :: m
logical, intent(out) :: t
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_dmask_vect
end interface
interface psb_minquotient
function psb_dminquotient_vect(x,y,desc_a,info,global) result(res)
import :: psb_desc_type, psb_ipk_, &
& psb_d_vect_type, psb_dpk_
real(psb_dpk_) :: res
type(psb_d_vect_type), intent (inout) :: x
type(psb_d_vect_type), intent (inout) :: y
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function
end interface
interface psb_nnz
function psb_dget_nnz(a,desc_a,info) result(res)
import :: psb_desc_type, psb_ipk_, psb_lpk_, &
& psb_dspmat_type, psb_dpk_
integer(psb_lpk_) :: res
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end function
end interface
interface psb_is_matupd
function psb_d_is_matupd(a,desc_a,info) result(res)
import :: psb_desc_type, psb_dspmat_type, &
& psb_dpk_, psb_ipk_
logical :: res
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end function
end interface
interface psb_is_matasb
function psb_d_is_matasb(a,desc_a,info) result(res)
import :: psb_desc_type, psb_dspmat_type, &
& psb_dpk_, psb_ipk_
logical :: res
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end function
end interface
interface psb_is_matbld
function psb_d_is_matbld(a,desc_a,info) result(res)
import :: psb_desc_type, psb_dspmat_type, &
& psb_dpk_, psb_ipk_
logical :: res
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end function
end interface
end module psb_d_psblas_mod
base/modules/psblas/psb_s_psblas_mod.F90
+283 -24
View File
@@ -1,9 +1,9 @@
!
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006-2018
! Salvatore Filippone
! Alfredo Buttari
!
! Salvatore Filippone
! Alfredo Buttari
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
@@ -15,7 +15,7 @@
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@@ -27,10 +27,10 @@
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
!
!
module psb_s_psblas_mod
use psb_desc_mod, only : psb_desc_type, psb_spk_, psb_ipk_
use psb_desc_mod, only : psb_desc_type, psb_spk_, psb_ipk_, psb_lpk_
use psb_s_vect_mod, only : psb_s_vect_type
use psb_s_mat_mod, only : psb_sspmat_type
@@ -44,7 +44,7 @@ module psb_s_psblas_mod
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_sdot_vect
function psb_sdotv(x, y, desc_a,info,global)
function psb_sdotv(x, y, desc_a,info,global)
import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_s_vect_type, psb_sspmat_type
real(psb_spk_) :: psb_sdotv
@@ -53,7 +53,7 @@ module psb_s_psblas_mod
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_sdotv
function psb_sdot(x, y, desc_a, info, jx, jy,global)
function psb_sdot(x, y, desc_a, info, jx, jy,global)
import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_s_vect_type, psb_sspmat_type
real(psb_spk_) :: psb_sdot
@@ -69,7 +69,7 @@ module psb_s_psblas_mod
interface psb_gedots
subroutine psb_sdotvs(res,x, y, desc_a, info,global)
import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_s_vect_type, psb_sspmat_type
& psb_s_vect_type, psb_sspmat_type
real(psb_spk_), intent(out) :: res
real(psb_spk_), intent(in) :: x(:), y(:)
type(psb_desc_type), intent(in) :: desc_a
@@ -78,7 +78,7 @@ module psb_s_psblas_mod
end subroutine psb_sdotvs
subroutine psb_smdots(res,x, y, desc_a,info,global)
import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_s_vect_type, psb_sspmat_type
& psb_s_vect_type, psb_sspmat_type
real(psb_spk_), intent(out) :: res(:)
real(psb_spk_), intent(in) :: x(:,:), y(:,:)
type(psb_desc_type), intent(in) :: desc_a
@@ -98,6 +98,17 @@ module psb_s_psblas_mod
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_saxpby_vect
subroutine psb_saxpby_vect_out(alpha, x, beta, y,&
& z, desc_a, info)
import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_s_vect_type, psb_sspmat_type
type(psb_s_vect_type), intent (inout) :: x
type(psb_s_vect_type), intent (inout) :: y
type(psb_s_vect_type), intent (inout) :: z
real(psb_spk_), intent (in) :: alpha, beta
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_saxpby_vect_out
subroutine psb_saxpbyv(alpha, x, beta, y,&
& desc_a, info)
import :: psb_desc_type, psb_spk_, psb_ipk_, &
@@ -108,6 +119,17 @@ module psb_s_psblas_mod
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_saxpbyv
subroutine psb_saxpbyvout(alpha, x, beta, y,&
& z, desc_a, info)
import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_s_vect_type, psb_sspmat_type
real(psb_spk_), intent (in) :: x(:)
real(psb_spk_), intent (in) :: y(:)
real(psb_spk_), intent (inout) :: z(:)
real(psb_spk_), intent (in) :: alpha, beta
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_saxpbyvout
subroutine psb_saxpby(alpha, x, beta, y,&
& desc_a, info, n, jx, jy)
import :: psb_desc_type, psb_spk_, psb_ipk_, &
@@ -155,10 +177,10 @@ module psb_s_psblas_mod
#if ! defined(HAVE_BUGGY_GENERICS)
interface psb_genrmi
procedure psb_samax, psb_samaxv, psb_samax_vect
end interface
end interface
interface psb_normi
procedure psb_samax, psb_samaxv, psb_samax_vect
end interface
end interface
#endif
interface psb_geamaxs
@@ -183,6 +205,18 @@ module psb_s_psblas_mod
end subroutine psb_smamaxs
end interface
interface psb_gemin
function psb_smin_vect(x, desc_a, info,global) result(res)
import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_s_vect_type, psb_sspmat_type
real(psb_spk_) :: res
type(psb_s_vect_type), intent (inout) :: x
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_smin_vect
end interface
interface psb_geasum
function psb_sasum_vect(x, desc_a, info,global) result(res)
import :: psb_desc_type, psb_spk_, psb_ipk_, &
@@ -238,10 +272,10 @@ module psb_s_psblas_mod
#if ! defined(HAVE_BUGGY_GENERICS)
interface psb_genrm1
procedure psb_sasum, psb_sasumv, psb_sasum_vect
end interface
end interface
interface psb_norm1
procedure psb_sasum, psb_sasumv, psb_sasum_vect
end interface
end interface
#endif
interface psb_genrm2
@@ -273,12 +307,33 @@ module psb_s_psblas_mod
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_snrm2_vect
function psb_snrm2_weight_vect(x,w, desc_a, info,global) result(res)
import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_s_vect_type, psb_sspmat_type
real(psb_spk_) :: res
type(psb_s_vect_type), intent (inout) :: x
type(psb_s_vect_type), intent (inout) :: w
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_snrm2_weight_vect
function psb_snrm2_weightmask_vect(x,w,idv, desc_a, info,global) result(res)
import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_s_vect_type, psb_sspmat_type
real(psb_spk_) :: res
type(psb_s_vect_type), intent (inout) :: x
type(psb_s_vect_type), intent (inout) :: w
type(psb_s_vect_type), intent (inout) :: idv
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_snrm2_weightmask_vect
end interface
#if ! defined(HAVE_BUGGY_GENERICS)
interface psb_norm2
procedure psb_snrm2, psb_snrm2v, psb_snrm2_vect
end interface
procedure psb_snrm2, psb_snrm2v, psb_snrm2_vect, psb_snrm2_weight_vect, psb_snrm2_weightmask_vect
end interface
#endif
interface psb_genrm2s
@@ -309,7 +364,7 @@ module psb_s_psblas_mod
#if ! defined(HAVE_BUGGY_GENERICS)
interface psb_normi
procedure psb_snrmi
end interface
end interface
#endif
interface psb_spnrm1
@@ -323,11 +378,11 @@ module psb_s_psblas_mod
logical, intent(in), optional :: global
end function psb_sspnrm1
end interface
#if ! defined(HAVE_BUGGY_GENERICS)
interface psb_norm1
procedure psb_sspnrm1
end interface
end interface
#endif
interface psb_spmm
@@ -378,7 +433,7 @@ module psb_s_psblas_mod
interface psb_spsm
subroutine psb_sspsm(alpha, t, x, beta, y,&
& desc_a, info, trans, scale, choice,&
& desc_a, info, trans, scale, choice,&
& diag, n, jx, jy, work)
import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_s_vect_type, psb_sspmat_type
@@ -395,7 +450,7 @@ module psb_s_psblas_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psb_sspsm
subroutine psb_sspsv(alpha, t, x, beta, y,&
& desc_a, info, trans, scale, choice,&
& desc_a, info, trans, scale, choice,&
& diag, work)
import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_s_vect_type, psb_sspmat_type
@@ -411,7 +466,7 @@ module psb_s_psblas_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psb_sspsv
subroutine psb_sspsv_vect(alpha, t, x, beta, y,&
& desc_a, info, trans, scale, choice,&
& desc_a, info, trans, scale, choice,&
& diag, work)
import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_s_vect_type, psb_sspmat_type
@@ -428,4 +483,208 @@ module psb_s_psblas_mod
end subroutine psb_sspsv_vect
end interface
interface psb_gemlt
subroutine psb_smlt_vect(x,y,desc_a,info)
import :: psb_desc_type, psb_ipk_, &
& psb_s_vect_type
type(psb_s_vect_type), intent (inout) :: x
type(psb_s_vect_type), intent (inout) :: y
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_smlt_vect
subroutine psb_smlt_vect2(alpha,x,y,beta,z,desc_a,info,conjgx,conjgy)
import :: psb_desc_type, psb_ipk_, &
& psb_s_vect_type, psb_spk_
real(psb_spk_), intent(in) :: alpha,beta
type(psb_s_vect_type), intent (inout) :: x
type(psb_s_vect_type), intent (inout) :: y
type(psb_s_vect_type), intent (inout) :: z
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
character(len=1), intent(in), optional :: conjgx, conjgy
end subroutine psb_smlt_vect2
end interface
interface psb_gediv
subroutine psb_sdiv_vect(x,y,desc_a,info)
import :: psb_desc_type, psb_ipk_, &
& psb_s_vect_type
type(psb_s_vect_type), intent (inout) :: x
type(psb_s_vect_type), intent (inout) :: y
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_sdiv_vect
subroutine psb_sdiv_vect2(x,y,z,desc_a,info)
import :: psb_desc_type, psb_ipk_, &
& psb_s_vect_type
type(psb_s_vect_type), intent (inout) :: x
type(psb_s_vect_type), intent (inout) :: y
type(psb_s_vect_type), intent (inout) :: z
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_sdiv_vect2
subroutine psb_sdiv_vect_check(x,y,desc_a,info,flag)
import :: psb_desc_type, psb_ipk_, &
& psb_s_vect_type
type(psb_s_vect_type), intent (inout) :: x
type(psb_s_vect_type), intent (inout) :: y
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
logical, intent(in) :: flag
end subroutine psb_sdiv_vect_check
subroutine psb_sdiv_vect2_check(x,y,z,desc_a,info,flag)
import :: psb_desc_type, psb_ipk_, &
& psb_s_vect_type
type(psb_s_vect_type), intent (inout) :: x
type(psb_s_vect_type), intent (inout) :: y
type(psb_s_vect_type), intent (inout) :: z
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
logical, intent(in) :: flag
end subroutine psb_sdiv_vect2_check
end interface
interface psb_geinv
subroutine psb_sinv_vect(x,y,desc_a,info)
import :: psb_desc_type, psb_ipk_, &
& psb_s_vect_type
type(psb_s_vect_type), intent (inout) :: x
type(psb_s_vect_type), intent (inout) :: y
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_sinv_vect
subroutine psb_sinv_vect_check(x,y,desc_a,info,flag)
import :: psb_desc_type, psb_ipk_, &
& psb_s_vect_type
type(psb_s_vect_type), intent (inout) :: x
type(psb_s_vect_type), intent (inout) :: y
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
logical, intent(in) :: flag
end subroutine psb_sinv_vect_check
end interface
interface psb_geabs
subroutine psb_sabs_vect(x,y,desc_a,info)
import :: psb_desc_type, psb_ipk_, &
& psb_s_vect_type
type(psb_s_vect_type), intent (inout) :: x
type(psb_s_vect_type), intent (inout) :: y
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_sabs_vect
end interface
interface psb_gecmp
subroutine psb_scmp_vect(x,c,z,desc_a,info)
import :: psb_desc_type, psb_ipk_, &
& psb_s_vect_type, psb_spk_
type(psb_s_vect_type), intent (inout) :: x
type(psb_s_vect_type), intent (inout) :: z
real(psb_spk_), intent(in) :: c
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_scmp_vect
subroutine psb_scmp_spmatval(a,val,tol,desc_a,res,info)
import :: psb_desc_type, psb_ipk_, &
& psb_lpk_, psb_sspmat_type, psb_spk_
type(psb_sspmat_type), intent(inout) :: a
real(psb_spk_), intent(in) :: val
real(psb_spk_), intent(in) :: tol
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
logical, intent(out) :: res
end subroutine psb_scmp_spmatval
subroutine psb_scmp_spmat(a,b,tol,desc_a,res,info)
import :: psb_desc_type, psb_ipk_, &
& psb_lpk_, psb_sspmat_type, psb_spk_
type(psb_sspmat_type), intent(inout) :: a
type(psb_sspmat_type), intent(inout) :: b
real(psb_spk_), intent(in) :: tol
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
logical, intent(out) :: res
end subroutine psb_scmp_spmat
end interface
interface psb_geaddconst
subroutine psb_saddconst_vect(x,b,z,desc_a,info)
import :: psb_desc_type, psb_ipk_, &
& psb_s_vect_type, psb_spk_
type(psb_s_vect_type), intent (inout) :: x
type(psb_s_vect_type), intent (inout) :: z
real(psb_spk_), intent(in) :: b
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_saddconst_vect
end interface
interface psb_mask
subroutine psb_smask_vect(c,x,m,t,desc_a,info)
import :: psb_desc_type, psb_ipk_, &
& psb_s_vect_type, psb_spk_
type(psb_s_vect_type), intent (inout) :: c
type(psb_s_vect_type), intent (inout) :: x
type(psb_s_vect_type), intent (inout) :: m
logical, intent(out) :: t
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_smask_vect
end interface
interface psb_minquotient
function psb_sminquotient_vect(x,y,desc_a,info,global) result(res)
import :: psb_desc_type, psb_ipk_, &
& psb_s_vect_type, psb_spk_
real(psb_spk_) :: res
type(psb_s_vect_type), intent (inout) :: x
type(psb_s_vect_type), intent (inout) :: y
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function
end interface
interface psb_nnz
function psb_sget_nnz(a,desc_a,info) result(res)
import :: psb_desc_type, psb_ipk_, psb_lpk_, &
& psb_sspmat_type, psb_spk_
integer(psb_lpk_) :: res
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end function
end interface
interface psb_is_matupd
function psb_s_is_matupd(a,desc_a,info) result(res)
import :: psb_desc_type, psb_sspmat_type, &
& psb_spk_, psb_ipk_
logical :: res
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end function
end interface
interface psb_is_matasb
function psb_s_is_matasb(a,desc_a,info) result(res)
import :: psb_desc_type, psb_sspmat_type, &
& psb_spk_, psb_ipk_
logical :: res
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end function
end interface
interface psb_is_matbld
function psb_s_is_matbld(a,desc_a,info) result(res)
import :: psb_desc_type, psb_sspmat_type, &
& psb_spk_, psb_ipk_
logical :: res
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end function
end interface
end module psb_s_psblas_mod
base/modules/psblas/psb_z_psblas_mod.F90
+248 -24
View File
@@ -1,9 +1,9 @@
!
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006-2018
! Salvatore Filippone
! Alfredo Buttari
!
! Salvatore Filippone
! Alfredo Buttari
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
@@ -15,7 +15,7 @@
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@@ -27,10 +27,10 @@
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
!
!
module psb_z_psblas_mod
use psb_desc_mod, only : psb_desc_type, psb_dpk_, psb_ipk_
use psb_desc_mod, only : psb_desc_type, psb_dpk_, psb_ipk_, psb_lpk_
use psb_z_vect_mod, only : psb_z_vect_type
use psb_z_mat_mod, only : psb_zspmat_type
@@ -44,7 +44,7 @@ module psb_z_psblas_mod
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_zdot_vect
function psb_zdotv(x, y, desc_a,info,global)
function psb_zdotv(x, y, desc_a,info,global)
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_z_vect_type, psb_zspmat_type
complex(psb_dpk_) :: psb_zdotv
@@ -53,7 +53,7 @@ module psb_z_psblas_mod
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_zdotv
function psb_zdot(x, y, desc_a, info, jx, jy,global)
function psb_zdot(x, y, desc_a, info, jx, jy,global)
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_z_vect_type, psb_zspmat_type
complex(psb_dpk_) :: psb_zdot
@@ -69,7 +69,7 @@ module psb_z_psblas_mod
interface psb_gedots
subroutine psb_zdotvs(res,x, y, desc_a, info,global)
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_z_vect_type, psb_zspmat_type
& psb_z_vect_type, psb_zspmat_type
complex(psb_dpk_), intent(out) :: res
complex(psb_dpk_), intent(in) :: x(:), y(:)
type(psb_desc_type), intent(in) :: desc_a
@@ -78,7 +78,7 @@ module psb_z_psblas_mod
end subroutine psb_zdotvs
subroutine psb_zmdots(res,x, y, desc_a,info,global)
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_z_vect_type, psb_zspmat_type
& psb_z_vect_type, psb_zspmat_type
complex(psb_dpk_), intent(out) :: res(:)
complex(psb_dpk_), intent(in) :: x(:,:), y(:,:)
type(psb_desc_type), intent(in) :: desc_a
@@ -98,6 +98,17 @@ module psb_z_psblas_mod
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_zaxpby_vect
subroutine psb_zaxpby_vect_out(alpha, x, beta, y,&
& z, desc_a, info)
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_z_vect_type, psb_zspmat_type
type(psb_z_vect_type), intent (inout) :: x
type(psb_z_vect_type), intent (inout) :: y
type(psb_z_vect_type), intent (inout) :: z
complex(psb_dpk_), intent (in) :: alpha, beta
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_zaxpby_vect_out
subroutine psb_zaxpbyv(alpha, x, beta, y,&
& desc_a, info)
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
@@ -108,6 +119,17 @@ module psb_z_psblas_mod
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_zaxpbyv
subroutine psb_zaxpbyvout(alpha, x, beta, y,&
& z, desc_a, info)
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_z_vect_type, psb_zspmat_type
complex(psb_dpk_), intent (in) :: x(:)
complex(psb_dpk_), intent (in) :: y(:)
complex(psb_dpk_), intent (inout) :: z(:)
complex(psb_dpk_), intent (in) :: alpha, beta
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_zaxpbyvout
subroutine psb_zaxpby(alpha, x, beta, y,&
& desc_a, info, n, jx, jy)
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
@@ -155,10 +177,10 @@ module psb_z_psblas_mod
#if ! defined(HAVE_BUGGY_GENERICS)
interface psb_genrmi
procedure psb_zamax, psb_zamaxv, psb_zamax_vect
end interface
end interface
interface psb_normi
procedure psb_zamax, psb_zamaxv, psb_zamax_vect
end interface
end interface
#endif
interface psb_geamaxs
@@ -183,6 +205,7 @@ module psb_z_psblas_mod
end subroutine psb_zmamaxs
end interface
interface psb_geasum
function psb_zasum_vect(x, desc_a, info,global) result(res)
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
@@ -238,10 +261,10 @@ module psb_z_psblas_mod
#if ! defined(HAVE_BUGGY_GENERICS)
interface psb_genrm1
procedure psb_zasum, psb_zasumv, psb_zasum_vect
end interface
end interface
interface psb_norm1
procedure psb_zasum, psb_zasumv, psb_zasum_vect
end interface
end interface
#endif
interface psb_genrm2
@@ -273,12 +296,33 @@ module psb_z_psblas_mod
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_znrm2_vect
function psb_znrm2_weight_vect(x,w, desc_a, info,global) result(res)
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_z_vect_type, psb_zspmat_type
real(psb_dpk_) :: res
type(psb_z_vect_type), intent (inout) :: x
type(psb_z_vect_type), intent (inout) :: w
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_znrm2_weight_vect
function psb_znrm2_weightmask_vect(x,w,idv, desc_a, info,global) result(res)
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_z_vect_type, psb_zspmat_type
real(psb_dpk_) :: res
type(psb_z_vect_type), intent (inout) :: x
type(psb_z_vect_type), intent (inout) :: w
type(psb_z_vect_type), intent (inout) :: idv
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_znrm2_weightmask_vect
end interface
#if ! defined(HAVE_BUGGY_GENERICS)
interface psb_norm2
procedure psb_znrm2, psb_znrm2v, psb_znrm2_vect
end interface
procedure psb_znrm2, psb_znrm2v, psb_znrm2_vect, psb_znrm2_weight_vect, psb_znrm2_weightmask_vect
end interface
#endif
interface psb_genrm2s
@@ -309,7 +353,7 @@ module psb_z_psblas_mod
#if ! defined(HAVE_BUGGY_GENERICS)
interface psb_normi
procedure psb_znrmi
end interface
end interface
#endif
interface psb_spnrm1
@@ -323,11 +367,11 @@ module psb_z_psblas_mod
logical, intent(in), optional :: global
end function psb_zspnrm1
end interface
#if ! defined(HAVE_BUGGY_GENERICS)
interface psb_norm1
procedure psb_zspnrm1
end interface
end interface
#endif
interface psb_spmm
@@ -378,7 +422,7 @@ module psb_z_psblas_mod
interface psb_spsm
subroutine psb_zspsm(alpha, t, x, beta, y,&
& desc_a, info, trans, scale, choice,&
& desc_a, info, trans, scale, choice,&
& diag, n, jx, jy, work)
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_z_vect_type, psb_zspmat_type
@@ -395,7 +439,7 @@ module psb_z_psblas_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psb_zspsm
subroutine psb_zspsv(alpha, t, x, beta, y,&
& desc_a, info, trans, scale, choice,&
& desc_a, info, trans, scale, choice,&
& diag, work)
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_z_vect_type, psb_zspmat_type
@@ -411,7 +455,7 @@ module psb_z_psblas_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psb_zspsv
subroutine psb_zspsv_vect(alpha, t, x, beta, y,&
& desc_a, info, trans, scale, choice,&
& desc_a, info, trans, scale, choice,&
& diag, work)
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_z_vect_type, psb_zspmat_type
@@ -428,4 +472,184 @@ module psb_z_psblas_mod
end subroutine psb_zspsv_vect
end interface
interface psb_gemlt
subroutine psb_zmlt_vect(x,y,desc_a,info)
import :: psb_desc_type, psb_ipk_, &
& psb_z_vect_type
type(psb_z_vect_type), intent (inout) :: x
type(psb_z_vect_type), intent (inout) :: y
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_zmlt_vect
subroutine psb_zmlt_vect2(alpha,x,y,beta,z,desc_a,info,conjgx,conjgy)
import :: psb_desc_type, psb_ipk_, &
& psb_z_vect_type, psb_dpk_
complex(psb_dpk_), intent(in) :: alpha,beta
type(psb_z_vect_type), intent (inout) :: x
type(psb_z_vect_type), intent (inout) :: y
type(psb_z_vect_type), intent (inout) :: z
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
character(len=1), intent(in), optional :: conjgx, conjgy
end subroutine psb_zmlt_vect2
end interface
interface psb_gediv
subroutine psb_zdiv_vect(x,y,desc_a,info)
import :: psb_desc_type, psb_ipk_, &
& psb_z_vect_type
type(psb_z_vect_type), intent (inout) :: x
type(psb_z_vect_type), intent (inout) :: y
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_zdiv_vect
subroutine psb_zdiv_vect2(x,y,z,desc_a,info)
import :: psb_desc_type, psb_ipk_, &
& psb_z_vect_type
type(psb_z_vect_type), intent (inout) :: x
type(psb_z_vect_type), intent (inout) :: y
type(psb_z_vect_type), intent (inout) :: z
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_zdiv_vect2
subroutine psb_zdiv_vect_check(x,y,desc_a,info,flag)
import :: psb_desc_type, psb_ipk_, &
& psb_z_vect_type
type(psb_z_vect_type), intent (inout) :: x
type(psb_z_vect_type), intent (inout) :: y
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
logical, intent(in) :: flag
end subroutine psb_zdiv_vect_check
subroutine psb_zdiv_vect2_check(x,y,z,desc_a,info,flag)
import :: psb_desc_type, psb_ipk_, &
& psb_z_vect_type
type(psb_z_vect_type), intent (inout) :: x
type(psb_z_vect_type), intent (inout) :: y
type(psb_z_vect_type), intent (inout) :: z
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
logical, intent(in) :: flag
end subroutine psb_zdiv_vect2_check
end interface
interface psb_geinv
subroutine psb_zinv_vect(x,y,desc_a,info)
import :: psb_desc_type, psb_ipk_, &
& psb_z_vect_type
type(psb_z_vect_type), intent (inout) :: x
type(psb_z_vect_type), intent (inout) :: y
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_zinv_vect
subroutine psb_zinv_vect_check(x,y,desc_a,info,flag)
import :: psb_desc_type, psb_ipk_, &
& psb_z_vect_type
type(psb_z_vect_type), intent (inout) :: x
type(psb_z_vect_type), intent (inout) :: y
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
logical, intent(in) :: flag
end subroutine psb_zinv_vect_check
end interface
interface psb_geabs
subroutine psb_zabs_vect(x,y,desc_a,info)
import :: psb_desc_type, psb_ipk_, &
& psb_z_vect_type
type(psb_z_vect_type), intent (inout) :: x
type(psb_z_vect_type), intent (inout) :: y
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_zabs_vect
end interface
interface psb_gecmp
subroutine psb_zcmp_vect(x,c,z,desc_a,info)
import :: psb_desc_type, psb_ipk_, &
& psb_z_vect_type, psb_dpk_
type(psb_z_vect_type), intent (inout) :: x
type(psb_z_vect_type), intent (inout) :: z
real(psb_dpk_), intent(in) :: c
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_zcmp_vect
subroutine psb_zcmp_spmatval(a,val,tol,desc_a,res,info)
import :: psb_desc_type, psb_ipk_, &
& psb_lpk_, psb_zspmat_type, psb_dpk_
type(psb_zspmat_type), intent(inout) :: a
complex(psb_dpk_), intent(in) :: val
real(psb_dpk_), intent(in) :: tol
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
logical, intent(out) :: res
end subroutine psb_zcmp_spmatval
subroutine psb_zcmp_spmat(a,b,tol,desc_a,res,info)
import :: psb_desc_type, psb_ipk_, &
& psb_lpk_, psb_zspmat_type, psb_dpk_
type(psb_zspmat_type), intent(inout) :: a
type(psb_zspmat_type), intent(inout) :: b
real(psb_dpk_), intent(in) :: tol
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
logical, intent(out) :: res
end subroutine psb_zcmp_spmat
end interface
interface psb_geaddconst
subroutine psb_zaddconst_vect(x,b,z,desc_a,info)
import :: psb_desc_type, psb_ipk_, &
& psb_z_vect_type, psb_dpk_
type(psb_z_vect_type), intent (inout) :: x
type(psb_z_vect_type), intent (inout) :: z
real(psb_dpk_), intent(in) :: b
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_zaddconst_vect
end interface
interface psb_nnz
function psb_zget_nnz(a,desc_a,info) result(res)
import :: psb_desc_type, psb_ipk_, psb_lpk_, &
& psb_zspmat_type, psb_dpk_
integer(psb_lpk_) :: res
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end function
end interface
interface psb_is_matupd
function psb_z_is_matupd(a,desc_a,info) result(res)
import :: psb_desc_type, psb_zspmat_type, &
& psb_dpk_, psb_ipk_
logical :: res
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end function
end interface
interface psb_is_matasb
function psb_z_is_matasb(a,desc_a,info) result(res)
import :: psb_desc_type, psb_zspmat_type, &
& psb_dpk_, psb_ipk_
logical :: res
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end function
end interface
interface psb_is_matbld
function psb_z_is_matbld(a,desc_a,info) result(res)
import :: psb_desc_type, psb_zspmat_type, &
& psb_dpk_, psb_ipk_
logical :: res
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end function
end interface
end module psb_z_psblas_mod
base/modules/serial/psb_base_mat_mod.F90
+404 -405
View File
File diff suppressed because it is too large Load Diff
base/modules/serial/psb_c_base_mat_mod.F90
+1419 -1131
View File
File diff suppressed because it is too large Load Diff
base/modules/serial/psb_c_base_vect_mod.f90
+830 -376
View File
File diff suppressed because it is too large Load Diff
base/modules/serial/psb_c_csc_mat_mod.f90
+228 -231
View File
File diff suppressed because it is too large Load Diff
base/modules/serial/psb_c_csr_mat_mod.f90
+264 -265
View File
File diff suppressed because it is too large Load Diff
base/modules/serial/psb_c_mat_mod.F90
+621 -531
View File
File diff suppressed because it is too large Load Diff
base/modules/serial/psb_c_vect_mod.F90
+441 -141
View File
File diff suppressed because it is too large Load Diff
base/modules/serial/psb_d_base_mat_mod.F90
+1419 -1131
View File
File diff suppressed because it is too large Load Diff
base/modules/serial/psb_d_base_vect_mod.f90
+1000 -376
View File
File diff suppressed because it is too large Load Diff
base/modules/serial/psb_d_csc_mat_mod.f90
+228 -231
View File
File diff suppressed because it is too large Load Diff
base/modules/serial/psb_d_csr_mat_mod.f90
+264 -265
View File
File diff suppressed because it is too large Load Diff
base/modules/serial/psb_d_mat_mod.F90
+621 -531
View File
File diff suppressed because it is too large Load Diff
base/modules/serial/psb_d_vect_mod.F90
+521 -142
View File
File diff suppressed because it is too large Load Diff
base/modules/serial/psb_i_base_vect_mod.f90
+259 -255
View File
File diff suppressed because it is too large Load Diff
base/modules/serial/psb_i_vect_mod.F90
+80 -77
View File
@@ -1,9 +1,9 @@
!
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006-2018
! Salvatore Filippone
! Alfredo Buttari
!
! Salvatore Filippone
! Alfredo Buttari
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
@@ -15,7 +15,7 @@
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@@ -27,22 +27,22 @@
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
!
!
!
! package: psb_i_vect_mod
!
! This module contains the definition of the psb_i_vect type which
! is the outer container for dense vectors.
! Therefore all methods simply invoke the corresponding methods of the
! inner component.
! inner component.
!
module psb_i_vect_mod
use psb_i_base_vect_mod
type psb_i_vect_type
class(psb_i_base_vect_type), allocatable :: v
class(psb_i_base_vect_type), allocatable :: v
contains
procedure, pass(x) :: get_nrows => i_vect_get_nrows
procedure, pass(x) :: sizeof => i_vect_sizeof
@@ -79,6 +79,8 @@ module psb_i_vect_mod
procedure, pass(x) :: set_dev => i_vect_set_dev
procedure, pass(x) :: set_sync => i_vect_set_sync
end type psb_i_vect_type
public :: psb_i_vect
@@ -98,7 +100,6 @@ module psb_i_vect_mod
& i_vect_set_dev, i_vect_set_sync
class(psb_i_base_vect_type), allocatable, target,&
& save, private :: psb_i_base_vect_default
@@ -114,11 +115,11 @@ module psb_i_vect_mod
contains
subroutine psb_i_set_vect_default(v)
implicit none
subroutine psb_i_set_vect_default(v)
implicit none
class(psb_i_base_vect_type), intent(in) :: v
if (allocated(psb_i_base_vect_default)) then
if (allocated(psb_i_base_vect_default)) then
deallocate(psb_i_base_vect_default)
end if
allocate(psb_i_base_vect_default, mold=v)
@@ -126,7 +127,7 @@ contains
end subroutine psb_i_set_vect_default
function psb_i_get_vect_default(v) result(res)
implicit none
implicit none
class(psb_i_vect_type), intent(in) :: v
class(psb_i_base_vect_type), pointer :: res
@@ -144,10 +145,10 @@ contains
end subroutine psb_i_clear_vect_default
function psb_i_get_base_vect_default() result(res)
implicit none
implicit none
class(psb_i_base_vect_type), pointer :: res
if (.not.allocated(psb_i_base_vect_default)) then
if (.not.allocated(psb_i_base_vect_default)) then
allocate(psb_i_base_vect_type :: psb_i_base_vect_default)
end if
@@ -156,14 +157,14 @@ contains
end function psb_i_get_base_vect_default
subroutine i_vect_clone(x,y,info)
implicit none
implicit none
class(psb_i_vect_type), intent(inout) :: x
class(psb_i_vect_type), intent(inout) :: y
integer(psb_ipk_), intent(out) :: info
info = psb_success_
call y%free(info)
if ((info==0).and.allocated(x%v)) then
if ((info==0).and.allocated(x%v)) then
call y%bld(x%get_vect(),mold=x%v)
end if
end subroutine i_vect_clone
@@ -178,7 +179,7 @@ contains
if (allocated(x%v)) &
& call x%free(info)
if (present(mold)) then
if (present(mold)) then
allocate(x%v,stat=info,mold=mold)
else
allocate(x%v,stat=info, mold=psb_i_get_base_vect_default())
@@ -200,7 +201,7 @@ contains
if (allocated(x%v)) &
& call x%free(info)
if (present(mold)) then
if (present(mold)) then
allocate(x%v,stat=info,mold=mold)
else
allocate(x%v,stat=info, mold=psb_i_get_base_vect_default())
@@ -220,7 +221,7 @@ contains
if (allocated(x%v)) &
& call x%free(info)
if (present(mold)) then
if (present(mold)) then
allocate(x%v,stat=info,mold=mold)
else
allocate(x%v,stat=info, mold=psb_i_get_base_vect_default())
@@ -283,7 +284,7 @@ contains
end function size_const
function i_vect_get_nrows(x) result(res)
implicit none
implicit none
class(psb_i_vect_type), intent(in) :: x
integer(psb_ipk_) :: res
res = 0
@@ -291,7 +292,7 @@ contains
end function i_vect_get_nrows
function i_vect_sizeof(x) result(res)
implicit none
implicit none
class(psb_i_vect_type), intent(in) :: x
integer(psb_epk_) :: res
res = 0
@@ -299,7 +300,7 @@ contains
end function i_vect_sizeof
function i_vect_get_fmt(x) result(res)
implicit none
implicit none
class(psb_i_vect_type), intent(in) :: x
character(len=5) :: res
res = 'NULL'
@@ -308,7 +309,7 @@ contains
subroutine i_vect_all(n, x, info, mold)
implicit none
implicit none
integer(psb_ipk_), intent(in) :: n
class(psb_i_vect_type), intent(inout) :: x
class(psb_i_base_vect_type), intent(in), optional :: mold
@@ -317,12 +318,12 @@ contains
if (allocated(x%v)) &
& call x%free(info)
if (present(mold)) then
if (present(mold)) then
allocate(x%v,stat=info,mold=mold)
else
allocate(psb_i_base_vect_type :: x%v,stat=info)
endif
if (info == 0) then
if (info == 0) then
call x%v%all(n,info)
else
info = psb_err_alloc_dealloc_
@@ -332,12 +333,12 @@ contains
subroutine i_vect_reall(n, x, info)
implicit none
implicit none
integer(psb_ipk_), intent(in) :: n
class(psb_i_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
info = 0
info = 0
if (.not.allocated(x%v)) &
& call x%all(n,info)
if (info == 0) &
@@ -347,7 +348,7 @@ contains
subroutine i_vect_zero(x)
use psi_serial_mod
implicit none
implicit none
class(psb_i_vect_type), intent(inout) :: x
if (allocated(x%v)) call x%v%zero()
@@ -357,7 +358,7 @@ contains
subroutine i_vect_asb(n, x, info)
use psi_serial_mod
use psb_realloc_mod
implicit none
implicit none
integer(psb_ipk_), intent(in) :: n
class(psb_i_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
@@ -403,12 +404,12 @@ contains
subroutine i_vect_free(x, info)
use psi_serial_mod
use psb_realloc_mod
implicit none
implicit none
class(psb_i_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
info = 0
if (allocated(x%v)) then
if (allocated(x%v)) then
call x%v%free(info)
if (info == 0) deallocate(x%v,stat=info)
end if
@@ -417,7 +418,7 @@ contains
subroutine i_vect_ins_a(n,irl,val,dupl,x,info)
use psi_serial_mod
implicit none
implicit none
class(psb_i_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in) :: n, dupl
integer(psb_ipk_), intent(in) :: irl(:)
@@ -427,7 +428,7 @@ contains
integer(psb_ipk_) :: i
info = 0
if (.not.allocated(x%v)) then
if (.not.allocated(x%v)) then
info = psb_err_invalid_vect_state_
return
end if
@@ -438,7 +439,7 @@ contains
subroutine i_vect_ins_v(n,irl,val,dupl,x,info)
use psi_serial_mod
implicit none
implicit none
class(psb_i_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in) :: n, dupl
class(psb_i_vect_type), intent(inout) :: irl
@@ -448,7 +449,7 @@ contains
integer(psb_ipk_) :: i
info = 0
if (.not.(allocated(x%v).and.allocated(irl%v).and.allocated(val%v))) then
if (.not.(allocated(x%v).and.allocated(irl%v).and.allocated(val%v))) then
info = psb_err_invalid_vect_state_
return
end if
@@ -466,12 +467,12 @@ contains
integer(psb_ipk_) :: info
info = psb_success_
if (present(mold)) then
if (present(mold)) then
allocate(tmp,stat=info,mold=mold)
else
allocate(tmp,stat=info,mold=psb_i_get_base_vect_default())
end if
if (allocated(x%v)) then
if (allocated(x%v)) then
call x%v%sync()
if (info == psb_success_) call tmp%bld(x%v%v)
call x%v%free(info)
@@ -482,7 +483,7 @@ contains
subroutine i_vect_sync(x)
implicit none
implicit none
class(psb_i_vect_type), intent(inout) :: x
if (allocated(x%v)) &
@@ -491,7 +492,7 @@ contains
end subroutine i_vect_sync
subroutine i_vect_set_sync(x)
implicit none
implicit none
class(psb_i_vect_type), intent(inout) :: x
if (allocated(x%v)) &
@@ -500,7 +501,7 @@ contains
end subroutine i_vect_set_sync
subroutine i_vect_set_host(x)
implicit none
implicit none
class(psb_i_vect_type), intent(inout) :: x
if (allocated(x%v)) &
@@ -509,7 +510,7 @@ contains
end subroutine i_vect_set_host
subroutine i_vect_set_dev(x)
implicit none
implicit none
class(psb_i_vect_type), intent(inout) :: x
if (allocated(x%v)) &
@@ -518,7 +519,7 @@ contains
end subroutine i_vect_set_dev
function i_vect_is_sync(x) result(res)
implicit none
implicit none
logical :: res
class(psb_i_vect_type), intent(inout) :: x
@@ -529,7 +530,7 @@ contains
end function i_vect_is_sync
function i_vect_is_host(x) result(res)
implicit none
implicit none
logical :: res
class(psb_i_vect_type), intent(inout) :: x
@@ -540,17 +541,19 @@ contains
end function i_vect_is_host
function i_vect_is_dev(x) result(res)
implicit none
implicit none
logical :: res
class(psb_i_vect_type), intent(inout) :: x
res = .false.
res = .false.
if (allocated(x%v)) &
& res = x%v%is_dev()
end function i_vect_is_dev
end module psb_i_vect_mod
@@ -565,7 +568,7 @@ module psb_i_multivect_mod
!private
type psb_i_multivect_type
class(psb_i_base_multivect_type), allocatable :: v
class(psb_i_base_multivect_type), allocatable :: v
contains
procedure, pass(x) :: get_nrows => i_vect_get_nrows
procedure, pass(x) :: get_ncols => i_vect_get_ncols
@@ -621,11 +624,11 @@ module psb_i_multivect_mod
contains
subroutine psb_i_set_multivect_default(v)
implicit none
subroutine psb_i_set_multivect_default(v)
implicit none
class(psb_i_base_multivect_type), intent(in) :: v
if (allocated(psb_i_base_multivect_default)) then
if (allocated(psb_i_base_multivect_default)) then
deallocate(psb_i_base_multivect_default)
end if
allocate(psb_i_base_multivect_default, mold=v)
@@ -633,7 +636,7 @@ contains
end subroutine psb_i_set_multivect_default
function psb_i_get_multivect_default(v) result(res)
implicit none
implicit none
class(psb_i_multivect_type), intent(in) :: v
class(psb_i_base_multivect_type), pointer :: res
@@ -643,10 +646,10 @@ contains
function psb_i_get_base_multivect_default() result(res)
implicit none
implicit none
class(psb_i_base_multivect_type), pointer :: res
if (.not.allocated(psb_i_base_multivect_default)) then
if (.not.allocated(psb_i_base_multivect_default)) then
allocate(psb_i_base_multivect_type :: psb_i_base_multivect_default)
end if
@@ -656,14 +659,14 @@ contains
subroutine i_vect_clone(x,y,info)
implicit none
implicit none
class(psb_i_multivect_type), intent(inout) :: x
class(psb_i_multivect_type), intent(inout) :: y
integer(psb_ipk_), intent(out) :: info
info = psb_success_
call y%free(info)
if ((info==0).and.allocated(x%v)) then
if ((info==0).and.allocated(x%v)) then
call y%bld(x%get_vect(),mold=x%v)
end if
end subroutine i_vect_clone
@@ -676,7 +679,7 @@ contains
class(psb_i_base_multivect_type), pointer :: mld
info = psb_success_
if (present(mold)) then
if (present(mold)) then
allocate(x%v,stat=info,mold=mold)
else
allocate(x%v,stat=info, mold=psb_i_get_base_multivect_default())
@@ -694,7 +697,7 @@ contains
integer(psb_ipk_) :: info
info = psb_success_
if (present(mold)) then
if (present(mold)) then
allocate(x%v,stat=info,mold=mold)
else
allocate(x%v,stat=info, mold=psb_i_get_base_multivect_default())
@@ -754,7 +757,7 @@ contains
end function size_const
function i_vect_get_nrows(x) result(res)
implicit none
implicit none
class(psb_i_multivect_type), intent(in) :: x
integer(psb_ipk_) :: res
res = 0
@@ -762,7 +765,7 @@ contains
end function i_vect_get_nrows
function i_vect_get_ncols(x) result(res)
implicit none
implicit none
class(psb_i_multivect_type), intent(in) :: x
integer(psb_ipk_) :: res
res = 0
@@ -770,7 +773,7 @@ contains
end function i_vect_get_ncols
function i_vect_sizeof(x) result(res)
implicit none
implicit none
class(psb_i_multivect_type), intent(in) :: x
integer(psb_epk_) :: res
res = 0
@@ -778,7 +781,7 @@ contains
end function i_vect_sizeof
function i_vect_get_fmt(x) result(res)
implicit none
implicit none
class(psb_i_multivect_type), intent(in) :: x
character(len=5) :: res
res = 'NULL'
@@ -787,18 +790,18 @@ contains
subroutine i_vect_all(m,n, x, info, mold)
implicit none
implicit none
integer(psb_ipk_), intent(in) :: m,n
class(psb_i_multivect_type), intent(out) :: x
class(psb_i_base_multivect_type), intent(in), optional :: mold
integer(psb_ipk_), intent(out) :: info
if (present(mold)) then
if (present(mold)) then
allocate(x%v,stat=info,mold=mold)
else
allocate(psb_i_base_multivect_type :: x%v,stat=info)
endif
if (info == 0) then
if (info == 0) then
call x%v%all(m,n,info)
else
info = psb_err_alloc_dealloc_
@@ -808,12 +811,12 @@ contains
subroutine i_vect_reall(m,n, x, info)
implicit none
implicit none
integer(psb_ipk_), intent(in) :: m,n
class(psb_i_multivect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
info = 0
info = 0
if (.not.allocated(x%v)) &
& call x%all(m,n,info)
if (info == 0) &
@@ -823,7 +826,7 @@ contains
subroutine i_vect_zero(x)
use psi_serial_mod
implicit none
implicit none
class(psb_i_multivect_type), intent(inout) :: x
if (allocated(x%v)) call x%v%zero()
@@ -833,7 +836,7 @@ contains
subroutine i_vect_asb(m,n, x, info)
use psi_serial_mod
use psb_realloc_mod
implicit none
implicit none
integer(psb_ipk_), intent(in) :: m,n
class(psb_i_multivect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
@@ -844,7 +847,7 @@ contains
end subroutine i_vect_asb
subroutine i_vect_sync(x)
implicit none
implicit none
class(psb_i_multivect_type), intent(inout) :: x
if (allocated(x%v)) &
@@ -912,12 +915,12 @@ contains
subroutine i_vect_free(x, info)
use psi_serial_mod
use psb_realloc_mod
implicit none
implicit none
class(psb_i_multivect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
info = 0
if (allocated(x%v)) then
if (allocated(x%v)) then
call x%v%free(info)
if (info == 0) deallocate(x%v,stat=info)
end if
@@ -926,7 +929,7 @@ contains
subroutine i_vect_ins(n,irl,val,dupl,x,info)
use psi_serial_mod
implicit none
implicit none
class(psb_i_multivect_type), intent(inout) :: x
integer(psb_ipk_), intent(in) :: n, dupl
integer(psb_ipk_), intent(in) :: irl(:)
@@ -936,7 +939,7 @@ contains
integer(psb_ipk_) :: i
info = 0
if (.not.allocated(x%v)) then
if (.not.allocated(x%v)) then
info = psb_err_invalid_vect_state_
return
end if
@@ -952,12 +955,12 @@ contains
class(psb_i_base_multivect_type), allocatable :: tmp
integer(psb_ipk_) :: info
if (present(mold)) then
if (present(mold)) then
allocate(tmp,stat=info,mold=mold)
else
allocate(tmp,stat=info, mold=psb_i_get_base_multivect_default())
endif
if (allocated(x%v)) then
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)
base/modules/serial/psb_l_base_vect_mod.f90
+259 -255
View File
File diff suppressed because it is too large Load Diff
base/modules/serial/psb_l_vect_mod.F90
+80 -77
View File
@@ -1,9 +1,9 @@
!
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006-2018
! Salvatore Filippone
! Alfredo Buttari
!
! Salvatore Filippone
! Alfredo Buttari
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
@@ -15,7 +15,7 @@
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@@ -27,15 +27,15 @@
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
!
!
!
! package: psb_l_vect_mod
!
! This module contains the definition of the psb_l_vect type which
! is the outer container for dense vectors.
! Therefore all methods simply invoke the corresponding methods of the
! inner component.
! inner component.
!
module psb_l_vect_mod
@@ -43,7 +43,7 @@ module psb_l_vect_mod
use psb_i_vect_mod
type psb_l_vect_type
class(psb_l_base_vect_type), allocatable :: v
class(psb_l_base_vect_type), allocatable :: v
contains
procedure, pass(x) :: get_nrows => l_vect_get_nrows
procedure, pass(x) :: sizeof => l_vect_sizeof
@@ -80,6 +80,8 @@ module psb_l_vect_mod
procedure, pass(x) :: set_dev => l_vect_set_dev
procedure, pass(x) :: set_sync => l_vect_set_sync
end type psb_l_vect_type
public :: psb_l_vect
@@ -99,7 +101,6 @@ module psb_l_vect_mod
& l_vect_set_dev, l_vect_set_sync
class(psb_l_base_vect_type), allocatable, target,&
& save, private :: psb_l_base_vect_default
@@ -115,11 +116,11 @@ module psb_l_vect_mod
contains
subroutine psb_l_set_vect_default(v)
implicit none
subroutine psb_l_set_vect_default(v)
implicit none
class(psb_l_base_vect_type), intent(in) :: v
if (allocated(psb_l_base_vect_default)) then
if (allocated(psb_l_base_vect_default)) then
deallocate(psb_l_base_vect_default)
end if
allocate(psb_l_base_vect_default, mold=v)
@@ -127,7 +128,7 @@ contains
end subroutine psb_l_set_vect_default
function psb_l_get_vect_default(v) result(res)
implicit none
implicit none
class(psb_l_vect_type), intent(in) :: v
class(psb_l_base_vect_type), pointer :: res
@@ -145,10 +146,10 @@ contains
end subroutine psb_l_clear_vect_default
function psb_l_get_base_vect_default() result(res)
implicit none
implicit none
class(psb_l_base_vect_type), pointer :: res
if (.not.allocated(psb_l_base_vect_default)) then
if (.not.allocated(psb_l_base_vect_default)) then
allocate(psb_l_base_vect_type :: psb_l_base_vect_default)
end if
@@ -157,14 +158,14 @@ contains
end function psb_l_get_base_vect_default
subroutine l_vect_clone(x,y,info)
implicit none
implicit none
class(psb_l_vect_type), intent(inout) :: x
class(psb_l_vect_type), intent(inout) :: y
integer(psb_ipk_), intent(out) :: info
info = psb_success_
call y%free(info)
if ((info==0).and.allocated(x%v)) then
if ((info==0).and.allocated(x%v)) then
call y%bld(x%get_vect(),mold=x%v)
end if
end subroutine l_vect_clone
@@ -179,7 +180,7 @@ contains
if (allocated(x%v)) &
& call x%free(info)
if (present(mold)) then
if (present(mold)) then
allocate(x%v,stat=info,mold=mold)
else
allocate(x%v,stat=info, mold=psb_l_get_base_vect_default())
@@ -201,7 +202,7 @@ contains
if (allocated(x%v)) &
& call x%free(info)
if (present(mold)) then
if (present(mold)) then
allocate(x%v,stat=info,mold=mold)
else
allocate(x%v,stat=info, mold=psb_l_get_base_vect_default())
@@ -221,7 +222,7 @@ contains
if (allocated(x%v)) &
& call x%free(info)
if (present(mold)) then
if (present(mold)) then
allocate(x%v,stat=info,mold=mold)
else
allocate(x%v,stat=info, mold=psb_l_get_base_vect_default())
@@ -284,7 +285,7 @@ contains
end function size_const
function l_vect_get_nrows(x) result(res)
implicit none
implicit none
class(psb_l_vect_type), intent(in) :: x
integer(psb_ipk_) :: res
res = 0
@@ -292,7 +293,7 @@ contains
end function l_vect_get_nrows
function l_vect_sizeof(x) result(res)
implicit none
implicit none
class(psb_l_vect_type), intent(in) :: x
integer(psb_epk_) :: res
res = 0
@@ -300,7 +301,7 @@ contains
end function l_vect_sizeof
function l_vect_get_fmt(x) result(res)
implicit none
implicit none
class(psb_l_vect_type), intent(in) :: x
character(len=5) :: res
res = 'NULL'
@@ -309,7 +310,7 @@ contains
subroutine l_vect_all(n, x, info, mold)
implicit none
implicit none
integer(psb_ipk_), intent(in) :: n
class(psb_l_vect_type), intent(inout) :: x
class(psb_l_base_vect_type), intent(in), optional :: mold
@@ -318,12 +319,12 @@ contains
if (allocated(x%v)) &
& call x%free(info)
if (present(mold)) then
if (present(mold)) then
allocate(x%v,stat=info,mold=mold)
else
allocate(psb_l_base_vect_type :: x%v,stat=info)
endif
if (info == 0) then
if (info == 0) then
call x%v%all(n,info)
else
info = psb_err_alloc_dealloc_
@@ -333,12 +334,12 @@ contains
subroutine l_vect_reall(n, x, info)
implicit none
implicit none
integer(psb_ipk_), intent(in) :: n
class(psb_l_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
info = 0
info = 0
if (.not.allocated(x%v)) &
& call x%all(n,info)
if (info == 0) &
@@ -348,7 +349,7 @@ contains
subroutine l_vect_zero(x)
use psi_serial_mod
implicit none
implicit none
class(psb_l_vect_type), intent(inout) :: x
if (allocated(x%v)) call x%v%zero()
@@ -358,7 +359,7 @@ contains
subroutine l_vect_asb(n, x, info)
use psi_serial_mod
use psb_realloc_mod
implicit none
implicit none
integer(psb_ipk_), intent(in) :: n
class(psb_l_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
@@ -404,12 +405,12 @@ contains
subroutine l_vect_free(x, info)
use psi_serial_mod
use psb_realloc_mod
implicit none
implicit none
class(psb_l_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
info = 0
if (allocated(x%v)) then
if (allocated(x%v)) then
call x%v%free(info)
if (info == 0) deallocate(x%v,stat=info)
end if
@@ -418,7 +419,7 @@ contains
subroutine l_vect_ins_a(n,irl,val,dupl,x,info)
use psi_serial_mod
implicit none
implicit none
class(psb_l_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in) :: n, dupl
integer(psb_ipk_), intent(in) :: irl(:)
@@ -428,7 +429,7 @@ contains
integer(psb_ipk_) :: i
info = 0
if (.not.allocated(x%v)) then
if (.not.allocated(x%v)) then
info = psb_err_invalid_vect_state_
return
end if
@@ -439,7 +440,7 @@ contains
subroutine l_vect_ins_v(n,irl,val,dupl,x,info)
use psi_serial_mod
implicit none
implicit none
class(psb_l_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in) :: n, dupl
class(psb_i_vect_type), intent(inout) :: irl
@@ -449,7 +450,7 @@ contains
integer(psb_ipk_) :: i
info = 0
if (.not.(allocated(x%v).and.allocated(irl%v).and.allocated(val%v))) then
if (.not.(allocated(x%v).and.allocated(irl%v).and.allocated(val%v))) then
info = psb_err_invalid_vect_state_
return
end if
@@ -467,12 +468,12 @@ contains
integer(psb_ipk_) :: info
info = psb_success_
if (present(mold)) then
if (present(mold)) then
allocate(tmp,stat=info,mold=mold)
else
allocate(tmp,stat=info,mold=psb_l_get_base_vect_default())
end if
if (allocated(x%v)) then
if (allocated(x%v)) then
call x%v%sync()
if (info == psb_success_) call tmp%bld(x%v%v)
call x%v%free(info)
@@ -483,7 +484,7 @@ contains
subroutine l_vect_sync(x)
implicit none
implicit none
class(psb_l_vect_type), intent(inout) :: x
if (allocated(x%v)) &
@@ -492,7 +493,7 @@ contains
end subroutine l_vect_sync
subroutine l_vect_set_sync(x)
implicit none
implicit none
class(psb_l_vect_type), intent(inout) :: x
if (allocated(x%v)) &
@@ -501,7 +502,7 @@ contains
end subroutine l_vect_set_sync
subroutine l_vect_set_host(x)
implicit none
implicit none
class(psb_l_vect_type), intent(inout) :: x
if (allocated(x%v)) &
@@ -510,7 +511,7 @@ contains
end subroutine l_vect_set_host
subroutine l_vect_set_dev(x)
implicit none
implicit none
class(psb_l_vect_type), intent(inout) :: x
if (allocated(x%v)) &
@@ -519,7 +520,7 @@ contains
end subroutine l_vect_set_dev
function l_vect_is_sync(x) result(res)
implicit none
implicit none
logical :: res
class(psb_l_vect_type), intent(inout) :: x
@@ -530,7 +531,7 @@ contains
end function l_vect_is_sync
function l_vect_is_host(x) result(res)
implicit none
implicit none
logical :: res
class(psb_l_vect_type), intent(inout) :: x
@@ -541,17 +542,19 @@ contains
end function l_vect_is_host
function l_vect_is_dev(x) result(res)
implicit none
implicit none
logical :: res
class(psb_l_vect_type), intent(inout) :: x
res = .false.
res = .false.
if (allocated(x%v)) &
& res = x%v%is_dev()
end function l_vect_is_dev
end module psb_l_vect_mod
@@ -566,7 +569,7 @@ module psb_l_multivect_mod
!private
type psb_l_multivect_type
class(psb_l_base_multivect_type), allocatable :: v
class(psb_l_base_multivect_type), allocatable :: v
contains
procedure, pass(x) :: get_nrows => l_vect_get_nrows
procedure, pass(x) :: get_ncols => l_vect_get_ncols
@@ -622,11 +625,11 @@ module psb_l_multivect_mod
contains
subroutine psb_l_set_multivect_default(v)
implicit none
subroutine psb_l_set_multivect_default(v)
implicit none
class(psb_l_base_multivect_type), intent(in) :: v
if (allocated(psb_l_base_multivect_default)) then
if (allocated(psb_l_base_multivect_default)) then
deallocate(psb_l_base_multivect_default)
end if
allocate(psb_l_base_multivect_default, mold=v)
@@ -634,7 +637,7 @@ contains
end subroutine psb_l_set_multivect_default
function psb_l_get_multivect_default(v) result(res)
implicit none
implicit none
class(psb_l_multivect_type), intent(in) :: v
class(psb_l_base_multivect_type), pointer :: res
@@ -644,10 +647,10 @@ contains
function psb_l_get_base_multivect_default() result(res)
implicit none
implicit none
class(psb_l_base_multivect_type), pointer :: res
if (.not.allocated(psb_l_base_multivect_default)) then
if (.not.allocated(psb_l_base_multivect_default)) then
allocate(psb_l_base_multivect_type :: psb_l_base_multivect_default)
end if
@@ -657,14 +660,14 @@ contains
subroutine l_vect_clone(x,y,info)
implicit none
implicit none
class(psb_l_multivect_type), intent(inout) :: x
class(psb_l_multivect_type), intent(inout) :: y
integer(psb_ipk_), intent(out) :: info
info = psb_success_
call y%free(info)
if ((info==0).and.allocated(x%v)) then
if ((info==0).and.allocated(x%v)) then
call y%bld(x%get_vect(),mold=x%v)
end if
end subroutine l_vect_clone
@@ -677,7 +680,7 @@ contains
class(psb_l_base_multivect_type), pointer :: mld
info = psb_success_
if (present(mold)) then
if (present(mold)) then
allocate(x%v,stat=info,mold=mold)
else
allocate(x%v,stat=info, mold=psb_l_get_base_multivect_default())
@@ -695,7 +698,7 @@ contains
integer(psb_ipk_) :: info
info = psb_success_
if (present(mold)) then
if (present(mold)) then
allocate(x%v,stat=info,mold=mold)
else
allocate(x%v,stat=info, mold=psb_l_get_base_multivect_default())
@@ -755,7 +758,7 @@ contains
end function size_const
function l_vect_get_nrows(x) result(res)
implicit none
implicit none
class(psb_l_multivect_type), intent(in) :: x
integer(psb_ipk_) :: res
res = 0
@@ -763,7 +766,7 @@ contains
end function l_vect_get_nrows
function l_vect_get_ncols(x) result(res)
implicit none
implicit none
class(psb_l_multivect_type), intent(in) :: x
integer(psb_ipk_) :: res
res = 0
@@ -771,7 +774,7 @@ contains
end function l_vect_get_ncols
function l_vect_sizeof(x) result(res)
implicit none
implicit none
class(psb_l_multivect_type), intent(in) :: x
integer(psb_epk_) :: res
res = 0
@@ -779,7 +782,7 @@ contains
end function l_vect_sizeof
function l_vect_get_fmt(x) result(res)
implicit none
implicit none
class(psb_l_multivect_type), intent(in) :: x
character(len=5) :: res
res = 'NULL'
@@ -788,18 +791,18 @@ contains
subroutine l_vect_all(m,n, x, info, mold)
implicit none
implicit none
integer(psb_ipk_), intent(in) :: m,n
class(psb_l_multivect_type), intent(out) :: x
class(psb_l_base_multivect_type), intent(in), optional :: mold
integer(psb_ipk_), intent(out) :: info
if (present(mold)) then
if (present(mold)) then
allocate(x%v,stat=info,mold=mold)
else
allocate(psb_l_base_multivect_type :: x%v,stat=info)
endif
if (info == 0) then
if (info == 0) then
call x%v%all(m,n,info)
else
info = psb_err_alloc_dealloc_
@@ -809,12 +812,12 @@ contains
subroutine l_vect_reall(m,n, x, info)
implicit none
implicit none
integer(psb_ipk_), intent(in) :: m,n
class(psb_l_multivect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
info = 0
info = 0
if (.not.allocated(x%v)) &
& call x%all(m,n,info)
if (info == 0) &
@@ -824,7 +827,7 @@ contains
subroutine l_vect_zero(x)
use psi_serial_mod
implicit none
implicit none
class(psb_l_multivect_type), intent(inout) :: x
if (allocated(x%v)) call x%v%zero()
@@ -834,7 +837,7 @@ contains
subroutine l_vect_asb(m,n, x, info)
use psi_serial_mod
use psb_realloc_mod
implicit none
implicit none
integer(psb_ipk_), intent(in) :: m,n
class(psb_l_multivect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
@@ -845,7 +848,7 @@ contains
end subroutine l_vect_asb
subroutine l_vect_sync(x)
implicit none
implicit none
class(psb_l_multivect_type), intent(inout) :: x
if (allocated(x%v)) &
@@ -913,12 +916,12 @@ contains
subroutine l_vect_free(x, info)
use psi_serial_mod
use psb_realloc_mod
implicit none
implicit none
class(psb_l_multivect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
info = 0
if (allocated(x%v)) then
if (allocated(x%v)) then
call x%v%free(info)
if (info == 0) deallocate(x%v,stat=info)
end if
@@ -927,7 +930,7 @@ contains
subroutine l_vect_ins(n,irl,val,dupl,x,info)
use psi_serial_mod
implicit none
implicit none
class(psb_l_multivect_type), intent(inout) :: x
integer(psb_ipk_), intent(in) :: n, dupl
integer(psb_ipk_), intent(in) :: irl(:)
@@ -937,7 +940,7 @@ contains
integer(psb_ipk_) :: i
info = 0
if (.not.allocated(x%v)) then
if (.not.allocated(x%v)) then
info = psb_err_invalid_vect_state_
return
end if
@@ -953,12 +956,12 @@ contains
class(psb_l_base_multivect_type), allocatable :: tmp
integer(psb_ipk_) :: info
if (present(mold)) then
if (present(mold)) then
allocate(tmp,stat=info,mold=mold)
else
allocate(tmp,stat=info, mold=psb_l_get_base_multivect_default())
endif
if (allocated(x%v)) then
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)
base/modules/serial/psb_s_base_mat_mod.F90
+1419 -1131
View File
File diff suppressed because it is too large Load Diff
base/modules/serial/psb_s_base_vect_mod.f90
+1000 -376
View File
File diff suppressed because it is too large Load Diff
base/modules/serial/psb_s_csc_mat_mod.f90
+228 -231
View File
File diff suppressed because it is too large Load Diff
base/modules/serial/psb_s_csr_mat_mod.f90
+264 -265
View File
File diff suppressed because it is too large Load Diff
base/modules/serial/psb_s_mat_mod.F90
+621 -531
View File
File diff suppressed because it is too large Load Diff
base/modules/serial/psb_s_vect_mod.F90
+521 -142
View File
File diff suppressed because it is too large Load Diff
base/modules/serial/psb_z_base_mat_mod.F90
+1419 -1131
View File
File diff suppressed because it is too large Load Diff
base/modules/serial/psb_z_base_vect_mod.f90
+830 -376
View File
File diff suppressed because it is too large Load Diff
base/modules/serial/psb_z_csc_mat_mod.f90
+228 -231
View File
File diff suppressed because it is too large Load Diff
base/modules/serial/psb_z_csr_mat_mod.f90
+264 -265
View File
File diff suppressed because it is too large Load Diff
base/modules/serial/psb_z_mat_mod.F90
+621 -531
View File
File diff suppressed because it is too large Load Diff
base/modules/serial/psb_z_vect_mod.F90
+441 -141
View File
File diff suppressed because it is too large Load Diff