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

Added out-of-place entrywise division with C interfaces

Browse Source
This commit is contained in:
Cirdans-Home
2020-02-26 13:25:24 +01:00
parent 22e7df48da
commit 439246e643
24 changed files with 1464 additions and 20 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/modules/psblas/psb_c_psblas_mod.F90
+19
View File
@@ -481,6 +481,15 @@ module psb_c_psblas_mod
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
@@ -490,6 +499,16 @@ module psb_c_psblas_mod
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
base/modules/psblas/psb_d_psblas_mod.F90
+19
View File
@@ -492,6 +492,15 @@ module psb_d_psblas_mod
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
@@ -501,6 +510,16 @@ module psb_d_psblas_mod
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
base/modules/psblas/psb_s_psblas_mod.F90
+19
View File
@@ -492,6 +492,15 @@ module psb_s_psblas_mod
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
@@ -501,6 +510,16 @@ module psb_s_psblas_mod
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
base/modules/psblas/psb_z_psblas_mod.F90
+19
View File
@@ -481,6 +481,15 @@ module psb_z_psblas_mod
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
@@ -490,6 +499,16 @@ module psb_z_psblas_mod
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
base/modules/serial/psb_c_base_vect_mod.f90
+52 -3
View File
@@ -162,15 +162,19 @@ module psb_c_base_vect_mod
procedure, pass(z) :: mlt_v_2 => c_base_mlt_v_2
procedure, pass(z) :: mlt_va => c_base_mlt_va
procedure, pass(z) :: mlt_av => c_base_mlt_av
generic, public :: mlt => mlt_v, mlt_a, mlt_a_2, mlt_v_2, mlt_av, mlt_va
generic, public :: mlt => mlt_v, mlt_a, mlt_a_2, mlt_v_2, mlt_av, &
mlt_va
!
! Vector-Vector operations
!
procedure, pass(x) :: div_v => c_base_div_v
procedure, pass(x) :: div_v_check => c_base_div_v_check
procedure, pass(x) :: div_v2 => c_base_div_v2
procedure, pass(x) :: div_v2_check => c_base_div_v2_check
procedure, pass(z) :: div_a2 => c_base_div_a2
procedure, pass(z) :: div_a2_check => c_base_div_a2_check
generic, public :: div => div_v, div_v_check, div_a2, div_a2_check
generic, public :: div => div_v, div_v2, div_v_check, &
div_v2_check, div_a2, div_a2_check
procedure, pass(y) :: inv_v => c_base_inv_v
procedure, pass(y) :: inv_v_check => c_base_inv_v_check
procedure, pass(y) :: inv_a2 => c_base_inv_a2
@@ -1220,6 +1224,28 @@ contains
end subroutine c_base_div_v
!
!> Function base_div_v2
!! \memberof psb_c_base_vect_type
!! \brief Vector entry-by-entry divide by a vector z=x/y
!! \param y The array to be divided by
!! \param info return code
!!
subroutine c_base_div_v2(x, y, z, info)
use psi_serial_mod
implicit none
class(psb_c_base_vect_type), intent(inout) :: x
class(psb_c_base_vect_type), intent(inout) :: y
class(psb_c_base_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
info = 0
if (z%is_dev()) call z%sync()
call z%div(x%v,y%v,info)
end subroutine c_base_div_v2
!
!> Function base_div_v_check
!! \memberof psb_c_base_vect_type
!! \brief Vector entry-by-entry divide by a vector x=x/y
@@ -1242,9 +1268,32 @@ contains
end subroutine c_base_div_v_check
!
!> Function base_div_v2_check
!! \memberof psb_c_base_vect_type
!! \brief Vector entry-by-entry divide by a vector z=x/y
!! \param y The array to be divided by
!! \param info return code
!!
subroutine c_base_div_v2_check(x, y, z, info, flag)
use psi_serial_mod
implicit none
class(psb_c_base_vect_type), intent(inout) :: x
class(psb_c_base_vect_type), intent(inout) :: y
class(psb_c_base_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
logical, intent(in) :: flag
info = 0
if (z%is_dev()) call z%sync()
call z%div(x%v,y%v,info,flag)
end subroutine c_base_div_v2_check
!
!> Function base_div_a2
!! \memberof psb_c_base_vect_type
!! \brief Entry-by-entry divide between normal array x=x/y
!! \brief Entry-by-entry divide between normal array z=x/y
!! \param y(:) The array to be divided by
!! \param info return code
!!
base/modules/serial/psb_c_vect_mod.F90
+35 -1
View File
@@ -95,10 +95,13 @@ module psb_c_vect_mod
generic, public :: mlt => mlt_v, mlt_a, mlt_a_2,&
& mlt_v_2, mlt_av, mlt_va
procedure, pass(x) :: div_v => c_vect_div_v
procedure, pass(x) :: div_v2 => c_vect_div_v2
procedure, pass(x) :: div_v_check => c_vect_div_v_check
procedure, pass(x) :: div_v2_check => c_vect_div_v2_check
procedure, pass(z) :: div_a2 => c_vect_div_a2
procedure, pass(z) :: div_a2_check => c_vect_div_a2_check
generic, public :: div => div_v, div_v_check, div_a2, div_a2_check
generic, public :: div => div_v, div_v2, div_v_check, &
div_v2_check, div_a2, div_a2_check
procedure, pass(y) :: inv_v => c_vect_inv_v
procedure, pass(y) :: inv_v_check => c_vect_inv_v_check
procedure, pass(y) :: inv_a2 => c_vect_inv_a2
@@ -764,6 +767,21 @@ contains
end subroutine c_vect_div_v
subroutine c_vect_div_v2( x, y, z, info)
use psi_serial_mod
implicit none
class(psb_c_vect_type), intent(inout) :: x
class(psb_c_vect_type), intent(inout) :: y
class(psb_c_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
info = 0
if (allocated(x%v).and.allocated(y%v).and.allocated(z%v)) &
& call z%v%div(x%v,y%v,info)
end subroutine c_vect_div_v2
subroutine c_vect_div_v_check(x, y, info, flag)
use psi_serial_mod
implicit none
@@ -779,6 +797,22 @@ contains
end subroutine c_vect_div_v_check
subroutine c_vect_div_v2_check(x, y, z, info, flag)
use psi_serial_mod
implicit none
class(psb_c_vect_type), intent(inout) :: x
class(psb_c_vect_type), intent(inout) :: y
class(psb_c_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
logical, intent(in) :: flag
info = 0
if (allocated(x%v).and.allocated(y%v).and.allocated(z%v)) &
& call z%v%div(x%v,y%v,info,flag)
end subroutine c_vect_div_v2_check
subroutine c_vect_div_a2(x, y, z, info)
use psi_serial_mod
implicit none
base/modules/serial/psb_d_base_vect_mod.f90
+52 -3
View File
@@ -162,15 +162,19 @@ module psb_d_base_vect_mod
procedure, pass(z) :: mlt_v_2 => d_base_mlt_v_2
procedure, pass(z) :: mlt_va => d_base_mlt_va
procedure, pass(z) :: mlt_av => d_base_mlt_av
generic, public :: mlt => mlt_v, mlt_a, mlt_a_2, mlt_v_2, mlt_av, mlt_va
generic, public :: mlt => mlt_v, mlt_a, mlt_a_2, mlt_v_2, mlt_av, &
mlt_va
!
! Vector-Vector operations
!
procedure, pass(x) :: div_v => d_base_div_v
procedure, pass(x) :: div_v_check => d_base_div_v_check
procedure, pass(x) :: div_v2 => d_base_div_v2
procedure, pass(x) :: div_v2_check => d_base_div_v2_check
procedure, pass(z) :: div_a2 => d_base_div_a2
procedure, pass(z) :: div_a2_check => d_base_div_a2_check
generic, public :: div => div_v, div_v_check, div_a2, div_a2_check
generic, public :: div => div_v, div_v2, div_v_check, &
div_v2_check, div_a2, div_a2_check
procedure, pass(y) :: inv_v => d_base_inv_v
procedure, pass(y) :: inv_v_check => d_base_inv_v_check
procedure, pass(y) :: inv_a2 => d_base_inv_a2
@@ -1224,6 +1228,28 @@ contains
end subroutine d_base_div_v
!
!> Function base_div_v2
!! \memberof psb_d_base_vect_type
!! \brief Vector entry-by-entry divide by a vector z=x/y
!! \param y The array to be divided by
!! \param info return code
!!
subroutine d_base_div_v2(x, y, z, info)
use psi_serial_mod
implicit none
class(psb_d_base_vect_type), intent(inout) :: x
class(psb_d_base_vect_type), intent(inout) :: y
class(psb_d_base_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
info = 0
if (z%is_dev()) call z%sync()
call z%div(x%v,y%v,info)
end subroutine d_base_div_v2
!
!> Function base_div_v_check
!! \memberof psb_d_base_vect_type
!! \brief Vector entry-by-entry divide by a vector x=x/y
@@ -1246,9 +1272,32 @@ contains
end subroutine d_base_div_v_check
!
!> Function base_div_v2_check
!! \memberof psb_d_base_vect_type
!! \brief Vector entry-by-entry divide by a vector z=x/y
!! \param y The array to be divided by
!! \param info return code
!!
subroutine d_base_div_v2_check(x, y, z, info, flag)
use psi_serial_mod
implicit none
class(psb_d_base_vect_type), intent(inout) :: x
class(psb_d_base_vect_type), intent(inout) :: y
class(psb_d_base_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
logical, intent(in) :: flag
info = 0
if (z%is_dev()) call z%sync()
call z%div(x%v,y%v,info,flag)
end subroutine d_base_div_v2_check
!
!> Function base_div_a2
!! \memberof psb_d_base_vect_type
!! \brief Entry-by-entry divide between normal array x=x/y
!! \brief Entry-by-entry divide between normal array z=x/y
!! \param y(:) The array to be divided by
!! \param info return code
!!
base/modules/serial/psb_d_vect_mod.F90
+35 -1
View File
@@ -95,10 +95,13 @@ module psb_d_vect_mod
generic, public :: mlt => mlt_v, mlt_a, mlt_a_2,&
& mlt_v_2, mlt_av, mlt_va
procedure, pass(x) :: div_v => d_vect_div_v
procedure, pass(x) :: div_v2 => d_vect_div_v2
procedure, pass(x) :: div_v_check => d_vect_div_v_check
procedure, pass(x) :: div_v2_check => d_vect_div_v2_check
procedure, pass(z) :: div_a2 => d_vect_div_a2
procedure, pass(z) :: div_a2_check => d_vect_div_a2_check
generic, public :: div => div_v, div_v_check, div_a2, div_a2_check
generic, public :: div => div_v, div_v2, div_v_check, &
div_v2_check, div_a2, div_a2_check
procedure, pass(y) :: inv_v => d_vect_inv_v
procedure, pass(y) :: inv_v_check => d_vect_inv_v_check
procedure, pass(y) :: inv_a2 => d_vect_inv_a2
@@ -768,6 +771,21 @@ contains
end subroutine d_vect_div_v
subroutine d_vect_div_v2( x, y, z, info)
use psi_serial_mod
implicit none
class(psb_d_vect_type), intent(inout) :: x
class(psb_d_vect_type), intent(inout) :: y
class(psb_d_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
info = 0
if (allocated(x%v).and.allocated(y%v).and.allocated(z%v)) &
& call z%v%div(x%v,y%v,info)
end subroutine d_vect_div_v2
subroutine d_vect_div_v_check(x, y, info, flag)
use psi_serial_mod
implicit none
@@ -783,6 +801,22 @@ contains
end subroutine d_vect_div_v_check
subroutine d_vect_div_v2_check(x, y, z, info, flag)
use psi_serial_mod
implicit none
class(psb_d_vect_type), intent(inout) :: x
class(psb_d_vect_type), intent(inout) :: y
class(psb_d_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
logical, intent(in) :: flag
info = 0
if (allocated(x%v).and.allocated(y%v).and.allocated(z%v)) &
& call z%v%div(x%v,y%v,info,flag)
end subroutine d_vect_div_v2_check
subroutine d_vect_div_a2(x, y, z, info)
use psi_serial_mod
implicit none
base/modules/serial/psb_s_base_vect_mod.f90
+52 -3
View File
@@ -162,15 +162,19 @@ module psb_s_base_vect_mod
procedure, pass(z) :: mlt_v_2 => s_base_mlt_v_2
procedure, pass(z) :: mlt_va => s_base_mlt_va
procedure, pass(z) :: mlt_av => s_base_mlt_av
generic, public :: mlt => mlt_v, mlt_a, mlt_a_2, mlt_v_2, mlt_av, mlt_va
generic, public :: mlt => mlt_v, mlt_a, mlt_a_2, mlt_v_2, mlt_av, &
mlt_va
!
! Vector-Vector operations
!
procedure, pass(x) :: div_v => s_base_div_v
procedure, pass(x) :: div_v_check => s_base_div_v_check
procedure, pass(x) :: div_v2 => s_base_div_v2
procedure, pass(x) :: div_v2_check => s_base_div_v2_check
procedure, pass(z) :: div_a2 => s_base_div_a2
procedure, pass(z) :: div_a2_check => s_base_div_a2_check
generic, public :: div => div_v, div_v_check, div_a2, div_a2_check
generic, public :: div => div_v, div_v2, div_v_check, &
div_v2_check, div_a2, div_a2_check
procedure, pass(y) :: inv_v => s_base_inv_v
procedure, pass(y) :: inv_v_check => s_base_inv_v_check
procedure, pass(y) :: inv_a2 => s_base_inv_a2
@@ -1224,6 +1228,28 @@ contains
end subroutine s_base_div_v
!
!> Function base_div_v2
!! \memberof psb_s_base_vect_type
!! \brief Vector entry-by-entry divide by a vector z=x/y
!! \param y The array to be divided by
!! \param info return code
!!
subroutine s_base_div_v2(x, y, z, info)
use psi_serial_mod
implicit none
class(psb_s_base_vect_type), intent(inout) :: x
class(psb_s_base_vect_type), intent(inout) :: y
class(psb_s_base_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
info = 0
if (z%is_dev()) call z%sync()
call z%div(x%v,y%v,info)
end subroutine s_base_div_v2
!
!> Function base_div_v_check
!! \memberof psb_s_base_vect_type
!! \brief Vector entry-by-entry divide by a vector x=x/y
@@ -1246,9 +1272,32 @@ contains
end subroutine s_base_div_v_check
!
!> Function base_div_v2_check
!! \memberof psb_s_base_vect_type
!! \brief Vector entry-by-entry divide by a vector z=x/y
!! \param y The array to be divided by
!! \param info return code
!!
subroutine s_base_div_v2_check(x, y, z, info, flag)
use psi_serial_mod
implicit none
class(psb_s_base_vect_type), intent(inout) :: x
class(psb_s_base_vect_type), intent(inout) :: y
class(psb_s_base_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
logical, intent(in) :: flag
info = 0
if (z%is_dev()) call z%sync()
call z%div(x%v,y%v,info,flag)
end subroutine s_base_div_v2_check
!
!> Function base_div_a2
!! \memberof psb_s_base_vect_type
!! \brief Entry-by-entry divide between normal array x=x/y
!! \brief Entry-by-entry divide between normal array z=x/y
!! \param y(:) The array to be divided by
!! \param info return code
!!
base/modules/serial/psb_s_vect_mod.F90
+35 -1
View File
@@ -95,10 +95,13 @@ module psb_s_vect_mod
generic, public :: mlt => mlt_v, mlt_a, mlt_a_2,&
& mlt_v_2, mlt_av, mlt_va
procedure, pass(x) :: div_v => s_vect_div_v
procedure, pass(x) :: div_v2 => s_vect_div_v2
procedure, pass(x) :: div_v_check => s_vect_div_v_check
procedure, pass(x) :: div_v2_check => s_vect_div_v2_check
procedure, pass(z) :: div_a2 => s_vect_div_a2
procedure, pass(z) :: div_a2_check => s_vect_div_a2_check
generic, public :: div => div_v, div_v_check, div_a2, div_a2_check
generic, public :: div => div_v, div_v2, div_v_check, &
div_v2_check, div_a2, div_a2_check
procedure, pass(y) :: inv_v => s_vect_inv_v
procedure, pass(y) :: inv_v_check => s_vect_inv_v_check
procedure, pass(y) :: inv_a2 => s_vect_inv_a2
@@ -768,6 +771,21 @@ contains
end subroutine s_vect_div_v
subroutine s_vect_div_v2( x, y, z, info)
use psi_serial_mod
implicit none
class(psb_s_vect_type), intent(inout) :: x
class(psb_s_vect_type), intent(inout) :: y
class(psb_s_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
info = 0
if (allocated(x%v).and.allocated(y%v).and.allocated(z%v)) &
& call z%v%div(x%v,y%v,info)
end subroutine s_vect_div_v2
subroutine s_vect_div_v_check(x, y, info, flag)
use psi_serial_mod
implicit none
@@ -783,6 +801,22 @@ contains
end subroutine s_vect_div_v_check
subroutine s_vect_div_v2_check(x, y, z, info, flag)
use psi_serial_mod
implicit none
class(psb_s_vect_type), intent(inout) :: x
class(psb_s_vect_type), intent(inout) :: y
class(psb_s_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
logical, intent(in) :: flag
info = 0
if (allocated(x%v).and.allocated(y%v).and.allocated(z%v)) &
& call z%v%div(x%v,y%v,info,flag)
end subroutine s_vect_div_v2_check
subroutine s_vect_div_a2(x, y, z, info)
use psi_serial_mod
implicit none
base/modules/serial/psb_z_base_vect_mod.f90
+52 -3
View File
@@ -162,15 +162,19 @@ module psb_z_base_vect_mod
procedure, pass(z) :: mlt_v_2 => z_base_mlt_v_2
procedure, pass(z) :: mlt_va => z_base_mlt_va
procedure, pass(z) :: mlt_av => z_base_mlt_av
generic, public :: mlt => mlt_v, mlt_a, mlt_a_2, mlt_v_2, mlt_av, mlt_va
generic, public :: mlt => mlt_v, mlt_a, mlt_a_2, mlt_v_2, mlt_av, &
mlt_va
!
! Vector-Vector operations
!
procedure, pass(x) :: div_v => z_base_div_v
procedure, pass(x) :: div_v_check => z_base_div_v_check
procedure, pass(x) :: div_v2 => z_base_div_v2
procedure, pass(x) :: div_v2_check => z_base_div_v2_check
procedure, pass(z) :: div_a2 => z_base_div_a2
procedure, pass(z) :: div_a2_check => z_base_div_a2_check
generic, public :: div => div_v, div_v_check, div_a2, div_a2_check
generic, public :: div => div_v, div_v2, div_v_check, &
div_v2_check, div_a2, div_a2_check
procedure, pass(y) :: inv_v => z_base_inv_v
procedure, pass(y) :: inv_v_check => z_base_inv_v_check
procedure, pass(y) :: inv_a2 => z_base_inv_a2
@@ -1220,6 +1224,28 @@ contains
end subroutine z_base_div_v
!
!> Function base_div_v2
!! \memberof psb_z_base_vect_type
!! \brief Vector entry-by-entry divide by a vector z=x/y
!! \param y The array to be divided by
!! \param info return code
!!
subroutine z_base_div_v2(x, y, z, info)
use psi_serial_mod
implicit none
class(psb_z_base_vect_type), intent(inout) :: x
class(psb_z_base_vect_type), intent(inout) :: y
class(psb_z_base_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
info = 0
if (z%is_dev()) call z%sync()
call z%div(x%v,y%v,info)
end subroutine z_base_div_v2
!
!> Function base_div_v_check
!! \memberof psb_z_base_vect_type
!! \brief Vector entry-by-entry divide by a vector x=x/y
@@ -1242,9 +1268,32 @@ contains
end subroutine z_base_div_v_check
!
!> Function base_div_v2_check
!! \memberof psb_z_base_vect_type
!! \brief Vector entry-by-entry divide by a vector z=x/y
!! \param y The array to be divided by
!! \param info return code
!!
subroutine z_base_div_v2_check(x, y, z, info, flag)
use psi_serial_mod
implicit none
class(psb_z_base_vect_type), intent(inout) :: x
class(psb_z_base_vect_type), intent(inout) :: y
class(psb_z_base_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
logical, intent(in) :: flag
info = 0
if (z%is_dev()) call z%sync()
call z%div(x%v,y%v,info,flag)
end subroutine z_base_div_v2_check
!
!> Function base_div_a2
!! \memberof psb_z_base_vect_type
!! \brief Entry-by-entry divide between normal array x=x/y
!! \brief Entry-by-entry divide between normal array z=x/y
!! \param y(:) The array to be divided by
!! \param info return code
!!
base/modules/serial/psb_z_vect_mod.F90
+35 -1
View File
@@ -95,10 +95,13 @@ module psb_z_vect_mod
generic, public :: mlt => mlt_v, mlt_a, mlt_a_2,&
& mlt_v_2, mlt_av, mlt_va
procedure, pass(x) :: div_v => z_vect_div_v
procedure, pass(x) :: div_v2 => z_vect_div_v2
procedure, pass(x) :: div_v_check => z_vect_div_v_check
procedure, pass(x) :: div_v2_check => z_vect_div_v2_check
procedure, pass(z) :: div_a2 => z_vect_div_a2
procedure, pass(z) :: div_a2_check => z_vect_div_a2_check
generic, public :: div => div_v, div_v_check, div_a2, div_a2_check
generic, public :: div => div_v, div_v2, div_v_check, &
div_v2_check, div_a2, div_a2_check
procedure, pass(y) :: inv_v => z_vect_inv_v
procedure, pass(y) :: inv_v_check => z_vect_inv_v_check
procedure, pass(y) :: inv_a2 => z_vect_inv_a2
@@ -764,6 +767,21 @@ contains
end subroutine z_vect_div_v
subroutine z_vect_div_v2( x, y, z, info)
use psi_serial_mod
implicit none
class(psb_z_vect_type), intent(inout) :: x
class(psb_z_vect_type), intent(inout) :: y
class(psb_z_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
info = 0
if (allocated(x%v).and.allocated(y%v).and.allocated(z%v)) &
& call z%v%div(x%v,y%v,info)
end subroutine z_vect_div_v2
subroutine z_vect_div_v_check(x, y, info, flag)
use psi_serial_mod
implicit none
@@ -779,6 +797,22 @@ contains
end subroutine z_vect_div_v_check
subroutine z_vect_div_v2_check(x, y, z, info, flag)
use psi_serial_mod
implicit none
class(psb_z_vect_type), intent(inout) :: x
class(psb_z_vect_type), intent(inout) :: y
class(psb_z_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
logical, intent(in) :: flag
info = 0
if (allocated(x%v).and.allocated(y%v).and.allocated(z%v)) &
& call z%v%div(x%v,y%v,info,flag)
end subroutine z_vect_div_v2_check
subroutine z_vect_div_a2(x, y, z, info)
use psi_serial_mod
implicit none
base/psblas/psb_cdiv_vect.f90
+174
View File
@@ -104,6 +104,93 @@ subroutine psb_cdiv_vect(x,y,desc_a,info)
end subroutine psb_cdiv_vect
subroutine psb_cdiv_vect2(x,y,z,desc_a,info)
use psb_base_mod, psb_protect_name => psb_cdiv_vect2
implicit none
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
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, iiy, jjy, iiz, jjz
integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m
character(len=20) :: name, ch_err
name='psb_c_div_vect2'
if (psb_errstatus_fatal()) return
info=psb_success_
call psb_erractionsave(err_act)
ictxt=desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -ione) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(x%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(y%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(z%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
ix = ione
iy = ione
iz = ione
m = desc_a%get_global_rows()
! check vector correctness
call psb_chkvect(m,lone,x%get_nrows(),ix,lone,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 1'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_chkvect(m,lone,y%get_nrows(),iy,lone,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 2'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_chkvect(m,lone,z%get_nrows(),iz,lone,desc_a,info,iiz,jjz)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 2'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if(desc_a%get_local_rows() > 0) then
call z%div(x,y,info)
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_cdiv_vect2
subroutine psb_cdiv_vect_check(x,y,desc_a,info,flag)
use psb_base_mod, psb_protect_name => psb_cdiv_vect_check
implicit none
@@ -177,3 +264,90 @@ subroutine psb_cdiv_vect_check(x,y,desc_a,info,flag)
return
end subroutine psb_cdiv_vect_check
subroutine psb_cdiv_vect2_check(x,y,z,desc_a,info,flag)
use psb_base_mod, psb_protect_name => psb_cdiv_vect2_check
implicit none
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
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, iiy, jjy, iiz, jjz
integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m
character(len=20) :: name, ch_err
name='psb_c_div_vect2_check'
if (psb_errstatus_fatal()) return
info=psb_success_
call psb_erractionsave(err_act)
ictxt=desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -ione) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(x%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(y%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(z%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
ix = ione
iy = ione
iz = ione
m = desc_a%get_global_rows()
! check vector correctness
call psb_chkvect(m,lone,x%get_nrows(),ix,lone,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 1'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_chkvect(m,lone,y%get_nrows(),iy,lone,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 2'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_chkvect(m,lone,z%get_nrows(),iz,lone,desc_a,info,iiz,jjz)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 2'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if(desc_a%get_local_rows() > 0) then
call z%div(x,y,info,flag)
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_cdiv_vect2_check
base/psblas/psb_ddiv_vect.f90
+174
View File
@@ -104,6 +104,93 @@ subroutine psb_ddiv_vect(x,y,desc_a,info)
end subroutine psb_ddiv_vect
subroutine psb_ddiv_vect2(x,y,z,desc_a,info)
use psb_base_mod, psb_protect_name => psb_ddiv_vect2
implicit none
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
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, iiy, jjy, iiz, jjz
integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m
character(len=20) :: name, ch_err
name='psb_d_div_vect2'
if (psb_errstatus_fatal()) return
info=psb_success_
call psb_erractionsave(err_act)
ictxt=desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -ione) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(x%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(y%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(z%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
ix = ione
iy = ione
iz = ione
m = desc_a%get_global_rows()
! check vector correctness
call psb_chkvect(m,lone,x%get_nrows(),ix,lone,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 1'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_chkvect(m,lone,y%get_nrows(),iy,lone,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 2'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_chkvect(m,lone,z%get_nrows(),iz,lone,desc_a,info,iiz,jjz)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 2'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if(desc_a%get_local_rows() > 0) then
call z%div(x,y,info)
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_ddiv_vect2
subroutine psb_ddiv_vect_check(x,y,desc_a,info,flag)
use psb_base_mod, psb_protect_name => psb_ddiv_vect_check
implicit none
@@ -177,3 +264,90 @@ subroutine psb_ddiv_vect_check(x,y,desc_a,info,flag)
return
end subroutine psb_ddiv_vect_check
subroutine psb_ddiv_vect2_check(x,y,z,desc_a,info,flag)
use psb_base_mod, psb_protect_name => psb_ddiv_vect2_check
implicit none
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
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, iiy, jjy, iiz, jjz
integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m
character(len=20) :: name, ch_err
name='psb_d_div_vect2_check'
if (psb_errstatus_fatal()) return
info=psb_success_
call psb_erractionsave(err_act)
ictxt=desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -ione) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(x%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(y%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(z%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
ix = ione
iy = ione
iz = ione
m = desc_a%get_global_rows()
! check vector correctness
call psb_chkvect(m,lone,x%get_nrows(),ix,lone,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 1'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_chkvect(m,lone,y%get_nrows(),iy,lone,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 2'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_chkvect(m,lone,z%get_nrows(),iz,lone,desc_a,info,iiz,jjz)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 2'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if(desc_a%get_local_rows() > 0) then
call z%div(x,y,info,flag)
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_ddiv_vect2_check
base/psblas/psb_sdiv_vect.f90
+174
View File
@@ -104,6 +104,93 @@ subroutine psb_sdiv_vect(x,y,desc_a,info)
end subroutine psb_sdiv_vect
subroutine psb_sdiv_vect2(x,y,z,desc_a,info)
use psb_base_mod, psb_protect_name => psb_sdiv_vect2
implicit none
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
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, iiy, jjy, iiz, jjz
integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m
character(len=20) :: name, ch_err
name='psb_s_div_vect2'
if (psb_errstatus_fatal()) return
info=psb_success_
call psb_erractionsave(err_act)
ictxt=desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -ione) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(x%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(y%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(z%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
ix = ione
iy = ione
iz = ione
m = desc_a%get_global_rows()
! check vector correctness
call psb_chkvect(m,lone,x%get_nrows(),ix,lone,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 1'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_chkvect(m,lone,y%get_nrows(),iy,lone,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 2'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_chkvect(m,lone,z%get_nrows(),iz,lone,desc_a,info,iiz,jjz)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 2'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if(desc_a%get_local_rows() > 0) then
call z%div(x,y,info)
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_sdiv_vect2
subroutine psb_sdiv_vect_check(x,y,desc_a,info,flag)
use psb_base_mod, psb_protect_name => psb_sdiv_vect_check
implicit none
@@ -177,3 +264,90 @@ subroutine psb_sdiv_vect_check(x,y,desc_a,info,flag)
return
end subroutine psb_sdiv_vect_check
subroutine psb_sdiv_vect2_check(x,y,z,desc_a,info,flag)
use psb_base_mod, psb_protect_name => psb_sdiv_vect2_check
implicit none
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
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, iiy, jjy, iiz, jjz
integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m
character(len=20) :: name, ch_err
name='psb_s_div_vect2_check'
if (psb_errstatus_fatal()) return
info=psb_success_
call psb_erractionsave(err_act)
ictxt=desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -ione) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(x%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(y%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(z%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
ix = ione
iy = ione
iz = ione
m = desc_a%get_global_rows()
! check vector correctness
call psb_chkvect(m,lone,x%get_nrows(),ix,lone,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 1'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_chkvect(m,lone,y%get_nrows(),iy,lone,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 2'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_chkvect(m,lone,z%get_nrows(),iz,lone,desc_a,info,iiz,jjz)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 2'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if(desc_a%get_local_rows() > 0) then
call z%div(x,y,info,flag)
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_sdiv_vect2_check
base/psblas/psb_zdiv_vect.f90
+174
View File
@@ -104,6 +104,93 @@ subroutine psb_zdiv_vect(x,y,desc_a,info)
end subroutine psb_zdiv_vect
subroutine psb_zdiv_vect2(x,y,z,desc_a,info)
use psb_base_mod, psb_protect_name => psb_zdiv_vect2
implicit none
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
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, iiy, jjy, iiz, jjz
integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m
character(len=20) :: name, ch_err
name='psb_z_div_vect2'
if (psb_errstatus_fatal()) return
info=psb_success_
call psb_erractionsave(err_act)
ictxt=desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -ione) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(x%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(y%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(z%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
ix = ione
iy = ione
iz = ione
m = desc_a%get_global_rows()
! check vector correctness
call psb_chkvect(m,lone,x%get_nrows(),ix,lone,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 1'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_chkvect(m,lone,y%get_nrows(),iy,lone,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 2'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_chkvect(m,lone,z%get_nrows(),iz,lone,desc_a,info,iiz,jjz)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 2'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if(desc_a%get_local_rows() > 0) then
call z%div(x,y,info)
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_zdiv_vect2
subroutine psb_zdiv_vect_check(x,y,desc_a,info,flag)
use psb_base_mod, psb_protect_name => psb_zdiv_vect_check
implicit none
@@ -177,3 +264,90 @@ subroutine psb_zdiv_vect_check(x,y,desc_a,info,flag)
return
end subroutine psb_zdiv_vect_check
subroutine psb_zdiv_vect2_check(x,y,z,desc_a,info,flag)
use psb_base_mod, psb_protect_name => psb_zdiv_vect2_check
implicit none
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
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, iiy, jjy, iiz, jjz
integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m
character(len=20) :: name, ch_err
name='psb_z_div_vect2_check'
if (psb_errstatus_fatal()) return
info=psb_success_
call psb_erractionsave(err_act)
ictxt=desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -ione) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(x%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(y%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(z%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
ix = ione
iy = ione
iz = ione
m = desc_a%get_global_rows()
! check vector correctness
call psb_chkvect(m,lone,x%get_nrows(),ix,lone,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 1'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_chkvect(m,lone,y%get_nrows(),iy,lone,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 2'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_chkvect(m,lone,z%get_nrows(),iz,lone,desc_a,info,iiz,jjz)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 2'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if(desc_a%get_local_rows() > 0) then
call z%div(x,y,info,flag)
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_zdiv_vect2_check
cbind/base/psb_c_cbase.h
+3 -1
View File
@@ -64,7 +64,9 @@ psb_i_t psb_c_cspsm(psb_c_t alpha, psb_c_cspmat *th, psb_c_cvector *xh,
psb_i_t psb_c_cgemlt(psb_c_cvector *xh,psb_c_cvector *yh,psb_c_descriptor *cdh);
psb_i_t psb_c_cgemlt2(psb_c_t alpha, psb_c_cvector *xh, psb_c_cvector *yh, psb_c_t beta, psb_c_cvector *zh, psb_c_descriptor *cdh);
psb_i_t psb_c_cgediv(psb_c_cvector *xh,psb_c_cvector *yh,psb_c_descriptor *cdh);
psb_i_t psb_c_cgediv_check(psb_c_cvector *xh,psb_c_cvector *yh,psb_c_descriptor *cdh);
psb_i_t psb_c_cgediv_check(psb_c_cvector *xh,psb_c_cvector *yh,psb_c_descriptor *cdh, bool flag);
psb_i_t psb_c_cgediv2(psb_c_cvector *xh,psb_c_cvector *yh,psb_c_cvector *zh,psb_c_descriptor *cdh);
psb_i_t psb_c_cgediv2_check(psb_c_cvector *xh,psb_c_cvector *yh,psb_c_cvector *zh,psb_c_descriptor *cdh, bool flag);
psb_i_t psb_c_cgeinv(psb_c_cvector *xh,psb_c_cvector *yh,psb_c_descriptor *cdh);
psb_i_t psb_c_cgeinv_check(psb_c_cvector *xh,psb_c_cvector *yh,psb_c_descriptor *cdh);
psb_i_t psb_c_cgeabs(psb_c_cvector *xh,psb_c_cvector *yh,psb_c_cvector *cdh);
cbind/base/psb_c_dbase.h
+3 -1
View File
@@ -64,7 +64,9 @@ psb_i_t psb_c_dspsm(psb_d_t alpha, psb_c_dspmat *th, psb_c_dvector *xh,
psb_i_t psb_c_dgemlt(psb_c_dvector *xh,psb_c_dvector *yh,psb_c_descriptor *cdh);
psb_i_t psb_c_dgemlt2(psb_d_t alpha, psb_c_dvector *xh, psb_c_dvector *yh, psb_d_t beta, psb_c_dvector *zh, psb_c_descriptor *cdh);
psb_i_t psb_c_dgediv(psb_c_dvector *xh,psb_c_dvector *yh,psb_c_descriptor *cdh);
psb_i_t psb_c_dgediv_check(psb_c_dvector *xh,psb_c_dvector *yh,psb_c_descriptor *cdh);
psb_i_t psb_c_dgediv_check(psb_c_dvector *xh,psb_c_dvector *yh,psb_c_descriptor *cdh, bool flag);
psb_i_t psb_c_dgediv2(psb_c_dvector *xh,psb_c_dvector *yh,psb_c_dvector *zh,psb_c_descriptor *cdh);
psb_i_t psb_c_dgediv2_check(psb_c_dvector *xh,psb_c_dvector *yh,psb_c_dvector *zh,psb_c_descriptor *cdh, bool flag);
psb_i_t psb_c_dgeinv(psb_c_dvector *xh,psb_c_dvector *yh,psb_c_descriptor *cdh);
psb_i_t psb_c_dgeinv_check(psb_c_dvector *xh,psb_c_dvector *yh,psb_c_descriptor *cdh);
psb_i_t psb_c_dgeabs(psb_c_dvector *xh,psb_c_dvector *yh,psb_c_descriptor *cdh);
cbind/base/psb_c_psblas_cbind_mod.f90
+83
View File
@@ -155,6 +155,46 @@ contains
end function psb_c_cgediv
function psb_c_cgediv2(xh,yh,zh,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_cvector) :: xh,yh,zh
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_c_vect_type), pointer :: xp,yp,zp
integer(psb_c_ipk_) :: info
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(xh%item)) then
call c_f_pointer(xh%item,xp)
else
return
end if
if (c_associated(yh%item)) then
call c_f_pointer(yh%item,yp)
else
return
end if
if (c_associated(zh%item)) then
call c_f_pointer(zh%item,zp)
else
return
end if
call psb_gediv(xp,yp,zp,descp,info)
res = info
end function psb_c_cgediv2
function psb_c_cgediv_check(xh,yh,cdh, flag) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
@@ -193,6 +233,49 @@ contains
end function psb_c_cgediv_check
function psb_c_cgediv2_check(xh,yh,zh,cdh, flag) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_cvector) :: xh,yh,zh
type(psb_c_descriptor) :: cdh
logical(c_bool), value :: flag
type(psb_desc_type), pointer :: descp
type(psb_c_vect_type), pointer :: xp,yp,zp
integer(psb_c_ipk_) :: info
logical :: fflag
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(xh%item)) then
call c_f_pointer(xh%item,xp)
else
return
end if
if (c_associated(yh%item)) then
call c_f_pointer(yh%item,yp)
else
return
end if
if (c_associated(zh%item)) then
call c_f_pointer(zh%item,zp)
else
return
end if
fflag = flag
call psb_gediv(xp,yp,zp,descp,info,fflag)
res = info
end function psb_c_cgediv2_check
function psb_c_cgeinv(xh,yh,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
cbind/base/psb_c_sbase.h
+3 -1
View File
@@ -64,7 +64,9 @@ psb_i_t psb_c_sspsm(psb_s_t alpha, psb_c_sspmat *th, psb_c_svector *xh,
psb_i_t psb_c_sgemlt(psb_c_svector *xh,psb_c_svector *yh,psb_c_descriptor *cdh);
psb_i_t psb_c_sgemlt2(psb_s_t alpha, psb_c_svector *xh, psb_c_svector *yh, psb_s_t beta, psb_c_svector *zh, psb_c_descriptor *cdh);
psb_i_t psb_c_sgediv(psb_c_svector *xh,psb_c_svector *yh,psb_c_descriptor *cdh);
psb_i_t psb_c_sgediv_check(psb_c_svector *xh,psb_c_svector *yh,psb_c_descriptor *cdh);
psb_i_t psb_c_sgediv_check(psb_c_svector *xh,psb_c_svector *yh,psb_c_descriptor *cdh, bool flag);
psb_i_t psb_c_sgediv2(psb_c_svector *xh,psb_c_svector *yh,psb_c_svector *zh,psb_c_descriptor *cdh);
psb_i_t psb_c_sgediv2_check(psb_c_svector *xh,psb_c_svector *yh,psb_c_svector *zh,psb_c_descriptor *cdh, bool flag);
psb_i_t psb_c_sgeinv(psb_c_svector *xh,psb_c_svector *yh,psb_c_descriptor *cdh);
psb_i_t psb_c_sgeinv_check(psb_c_svector *xh,psb_c_svector *yh,psb_c_descriptor *cdh);
psb_i_t psb_c_sgeabs(psb_c_svector *xh,psb_c_svector *yh,psb_c_descriptor *cdh);
cbind/base/psb_c_zbase.h
+3 -1
View File
@@ -64,7 +64,9 @@ psb_i_t psb_c_zspsm(psb_z_t alpha, psb_c_zspmat *th, psb_c_zvector *xh,
psb_i_t psb_c_zgemlt(psb_c_zvector *xh,psb_c_zvector *yh,psb_c_descriptor *cdh);
psb_i_t psb_c_zgemlt2(psb_z_t alpha, psb_c_zvector *xh, psb_c_zvector *yh, psb_z_t beta, psb_c_zvector *zh, psb_c_descriptor *cdh);
psb_i_t psb_c_zgediv(psb_c_zvector *xh,psb_c_zvector *yh,psb_c_descriptor *cdh);
psb_i_t psb_c_zgediv_check(psb_c_zvector *xh,psb_c_zvector *yh,psb_c_descriptor *cdh);
psb_i_t psb_c_zgediv_check(psb_c_zvector *xh,psb_c_zvector *yh,psb_c_descriptor *cdh, bool flag);
psb_i_t psb_c_zgediv2(psb_c_zvector *xh,psb_c_zvector *yh,psb_c_zvector *zh,psb_c_descriptor *cdh);
psb_i_t psb_c_zgediv2_check(psb_c_zvector *xh,psb_c_zvector *yh,psb_c_zvector *zh,psb_c_descriptor *cdh, bool flag);
psb_i_t psb_c_zgeinv(psb_c_zvector *xh,psb_c_zvector *yh,psb_c_descriptor *cdh);
psb_i_t psb_c_zgeinv_check(psb_c_zvector *xh,psb_c_zvector *yh,psb_c_descriptor *cdh);
psb_i_t psb_c_zgeabs(psb_c_zvector *xh,psb_c_zvector *yh,psb_c_descriptor *cdh);
cbind/base/psb_d_psblas_cbind_mod.f90
+83
View File
@@ -155,6 +155,46 @@ contains
end function psb_c_dgediv
function psb_c_dgediv2(xh,yh,zh,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_dvector) :: xh,yh,zh
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_d_vect_type), pointer :: xp,yp,zp
integer(psb_c_ipk_) :: info
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(xh%item)) then
call c_f_pointer(xh%item,xp)
else
return
end if
if (c_associated(yh%item)) then
call c_f_pointer(yh%item,yp)
else
return
end if
if (c_associated(zh%item)) then
call c_f_pointer(zh%item,zp)
else
return
end if
call psb_gediv(xp,yp,zp,descp,info)
res = info
end function psb_c_dgediv2
function psb_c_dgediv_check(xh,yh,cdh, flag) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
@@ -193,6 +233,49 @@ contains
end function psb_c_dgediv_check
function psb_c_dgediv2_check(xh,yh,zh,cdh, flag) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_dvector) :: xh,yh,zh
type(psb_c_descriptor) :: cdh
logical(c_bool), value :: flag
type(psb_desc_type), pointer :: descp
type(psb_d_vect_type), pointer :: xp,yp,zp
integer(psb_c_ipk_) :: info
logical :: fflag
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(xh%item)) then
call c_f_pointer(xh%item,xp)
else
return
end if
if (c_associated(yh%item)) then
call c_f_pointer(yh%item,yp)
else
return
end if
if (c_associated(zh%item)) then
call c_f_pointer(zh%item,zp)
else
return
end if
fflag = flag
call psb_gediv(xp,yp,zp,descp,info,fflag)
res = info
end function psb_c_dgediv2_check
function psb_c_dgeinv(xh,yh,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
cbind/base/psb_s_psblas_cbind_mod.f90
+83
View File
@@ -155,6 +155,46 @@ contains
end function psb_c_sgediv
function psb_c_sgediv2(xh,yh,zh,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_svector) :: xh,yh,zh
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_s_vect_type), pointer :: xp,yp,zp
integer(psb_c_ipk_) :: info
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(xh%item)) then
call c_f_pointer(xh%item,xp)
else
return
end if
if (c_associated(yh%item)) then
call c_f_pointer(yh%item,yp)
else
return
end if
if (c_associated(zh%item)) then
call c_f_pointer(zh%item,zp)
else
return
end if
call psb_gediv(xp,yp,zp,descp,info)
res = info
end function psb_c_sgediv2
function psb_c_sgediv_check(xh,yh,cdh, flag) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
@@ -193,6 +233,49 @@ contains
end function psb_c_sgediv_check
function psb_c_sgediv2_check(xh,yh,zh,cdh, flag) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_svector) :: xh,yh,zh
type(psb_c_descriptor) :: cdh
logical(c_bool), value :: flag
type(psb_desc_type), pointer :: descp
type(psb_s_vect_type), pointer :: xp,yp,zp
integer(psb_c_ipk_) :: info
logical :: fflag
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(xh%item)) then
call c_f_pointer(xh%item,xp)
else
return
end if
if (c_associated(yh%item)) then
call c_f_pointer(yh%item,yp)
else
return
end if
if (c_associated(zh%item)) then
call c_f_pointer(zh%item,zp)
else
return
end if
fflag = flag
call psb_gediv(xp,yp,zp,descp,info,fflag)
res = info
end function psb_c_sgediv2_check
function psb_c_sgeinv(xh,yh,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
cbind/base/psb_z_psblas_cbind_mod.f90
+83
View File
@@ -155,6 +155,46 @@ contains
end function psb_c_zgediv
function psb_c_zgediv2(xh,yh,zh,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_zvector) :: xh,yh,zh
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_z_vect_type), pointer :: xp,yp,zp
integer(psb_c_ipk_) :: info
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(xh%item)) then
call c_f_pointer(xh%item,xp)
else
return
end if
if (c_associated(yh%item)) then
call c_f_pointer(yh%item,yp)
else
return
end if
if (c_associated(zh%item)) then
call c_f_pointer(zh%item,zp)
else
return
end if
call psb_gediv(xp,yp,zp,descp,info)
res = info
end function psb_c_zgediv2
function psb_c_zgediv_check(xh,yh,cdh, flag) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
@@ -193,6 +233,49 @@ contains
end function psb_c_zgediv_check
function psb_c_zgediv2_check(xh,yh,zh,cdh, flag) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_zvector) :: xh,yh,zh
type(psb_c_descriptor) :: cdh
logical(c_bool), value :: flag
type(psb_desc_type), pointer :: descp
type(psb_z_vect_type), pointer :: xp,yp,zp
integer(psb_c_ipk_) :: info
logical :: fflag
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(xh%item)) then
call c_f_pointer(xh%item,xp)
else
return
end if
if (c_associated(yh%item)) then
call c_f_pointer(yh%item,yp)
else
return
end if
if (c_associated(zh%item)) then
call c_f_pointer(zh%item,zp)
else
return
end if
fflag = flag
call psb_gediv(xp,yp,zp,descp,info,fflag)
res = info
end function psb_c_zgediv2_check
function psb_c_zgeinv(xh,yh,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res