diff --git a/base/modules/psblas/psb_c_psblas_mod.F90 b/base/modules/psblas/psb_c_psblas_mod.F90 index 37fd313e..a1e232c1 100644 --- a/base/modules/psblas/psb_c_psblas_mod.F90 +++ b/base/modules/psblas/psb_c_psblas_mod.F90 @@ -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 diff --git a/base/modules/psblas/psb_d_psblas_mod.F90 b/base/modules/psblas/psb_d_psblas_mod.F90 index 5c5d7992..5fd7fc7b 100644 --- a/base/modules/psblas/psb_d_psblas_mod.F90 +++ b/base/modules/psblas/psb_d_psblas_mod.F90 @@ -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 diff --git a/base/modules/psblas/psb_s_psblas_mod.F90 b/base/modules/psblas/psb_s_psblas_mod.F90 index 90c306ce..01fe1852 100644 --- a/base/modules/psblas/psb_s_psblas_mod.F90 +++ b/base/modules/psblas/psb_s_psblas_mod.F90 @@ -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 diff --git a/base/modules/psblas/psb_z_psblas_mod.F90 b/base/modules/psblas/psb_z_psblas_mod.F90 index 162fe8d3..8fe2f910 100644 --- a/base/modules/psblas/psb_z_psblas_mod.F90 +++ b/base/modules/psblas/psb_z_psblas_mod.F90 @@ -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 diff --git a/base/modules/serial/psb_c_base_vect_mod.f90 b/base/modules/serial/psb_c_base_vect_mod.f90 index 524160ed..f9e1bd9b 100644 --- a/base/modules/serial/psb_c_base_vect_mod.f90 +++ b/base/modules/serial/psb_c_base_vect_mod.f90 @@ -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 !! diff --git a/base/modules/serial/psb_c_vect_mod.F90 b/base/modules/serial/psb_c_vect_mod.F90 index 57585075..a4432959 100644 --- a/base/modules/serial/psb_c_vect_mod.F90 +++ b/base/modules/serial/psb_c_vect_mod.F90 @@ -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 diff --git a/base/modules/serial/psb_d_base_vect_mod.f90 b/base/modules/serial/psb_d_base_vect_mod.f90 index 1c8d41f9..fcff2ff8 100644 --- a/base/modules/serial/psb_d_base_vect_mod.f90 +++ b/base/modules/serial/psb_d_base_vect_mod.f90 @@ -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 !! diff --git a/base/modules/serial/psb_d_vect_mod.F90 b/base/modules/serial/psb_d_vect_mod.F90 index 27ba9212..acb2a60d 100644 --- a/base/modules/serial/psb_d_vect_mod.F90 +++ b/base/modules/serial/psb_d_vect_mod.F90 @@ -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 diff --git a/base/modules/serial/psb_s_base_vect_mod.f90 b/base/modules/serial/psb_s_base_vect_mod.f90 index fb7b9950..fd153d3e 100644 --- a/base/modules/serial/psb_s_base_vect_mod.f90 +++ b/base/modules/serial/psb_s_base_vect_mod.f90 @@ -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 !! diff --git a/base/modules/serial/psb_s_vect_mod.F90 b/base/modules/serial/psb_s_vect_mod.F90 index e80ae5d3..7b4f9384 100644 --- a/base/modules/serial/psb_s_vect_mod.F90 +++ b/base/modules/serial/psb_s_vect_mod.F90 @@ -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 diff --git a/base/modules/serial/psb_z_base_vect_mod.f90 b/base/modules/serial/psb_z_base_vect_mod.f90 index a353af0c..9fd1d02f 100644 --- a/base/modules/serial/psb_z_base_vect_mod.f90 +++ b/base/modules/serial/psb_z_base_vect_mod.f90 @@ -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 !! diff --git a/base/modules/serial/psb_z_vect_mod.F90 b/base/modules/serial/psb_z_vect_mod.F90 index d3e84d03..40e2a565 100644 --- a/base/modules/serial/psb_z_vect_mod.F90 +++ b/base/modules/serial/psb_z_vect_mod.F90 @@ -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 diff --git a/base/psblas/psb_cdiv_vect.f90 b/base/psblas/psb_cdiv_vect.f90 index 99e4fef6..32fdba9d 100644 --- a/base/psblas/psb_cdiv_vect.f90 +++ b/base/psblas/psb_cdiv_vect.f90 @@ -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 diff --git a/base/psblas/psb_ddiv_vect.f90 b/base/psblas/psb_ddiv_vect.f90 index 20536a2c..90ddd1c4 100644 --- a/base/psblas/psb_ddiv_vect.f90 +++ b/base/psblas/psb_ddiv_vect.f90 @@ -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 diff --git a/base/psblas/psb_sdiv_vect.f90 b/base/psblas/psb_sdiv_vect.f90 index 42bc8b83..5e81abce 100644 --- a/base/psblas/psb_sdiv_vect.f90 +++ b/base/psblas/psb_sdiv_vect.f90 @@ -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 diff --git a/base/psblas/psb_zdiv_vect.f90 b/base/psblas/psb_zdiv_vect.f90 index 5ef0552a..582f1233 100644 --- a/base/psblas/psb_zdiv_vect.f90 +++ b/base/psblas/psb_zdiv_vect.f90 @@ -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 diff --git a/cbind/base/psb_c_cbase.h b/cbind/base/psb_c_cbase.h index 86f57f3f..04e534ec 100644 --- a/cbind/base/psb_c_cbase.h +++ b/cbind/base/psb_c_cbase.h @@ -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); diff --git a/cbind/base/psb_c_dbase.h b/cbind/base/psb_c_dbase.h index aa203064..f97e6904 100644 --- a/cbind/base/psb_c_dbase.h +++ b/cbind/base/psb_c_dbase.h @@ -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); diff --git a/cbind/base/psb_c_psblas_cbind_mod.f90 b/cbind/base/psb_c_psblas_cbind_mod.f90 index 25b6e445..2801e709 100644 --- a/cbind/base/psb_c_psblas_cbind_mod.f90 +++ b/cbind/base/psb_c_psblas_cbind_mod.f90 @@ -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 diff --git a/cbind/base/psb_c_sbase.h b/cbind/base/psb_c_sbase.h index f9e855fe..02b7818d 100644 --- a/cbind/base/psb_c_sbase.h +++ b/cbind/base/psb_c_sbase.h @@ -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); diff --git a/cbind/base/psb_c_zbase.h b/cbind/base/psb_c_zbase.h index 401826dc..a5701e4a 100644 --- a/cbind/base/psb_c_zbase.h +++ b/cbind/base/psb_c_zbase.h @@ -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); diff --git a/cbind/base/psb_d_psblas_cbind_mod.f90 b/cbind/base/psb_d_psblas_cbind_mod.f90 index 8fd05660..4e878628 100644 --- a/cbind/base/psb_d_psblas_cbind_mod.f90 +++ b/cbind/base/psb_d_psblas_cbind_mod.f90 @@ -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 diff --git a/cbind/base/psb_s_psblas_cbind_mod.f90 b/cbind/base/psb_s_psblas_cbind_mod.f90 index f4c306ef..88b1e226 100644 --- a/cbind/base/psb_s_psblas_cbind_mod.f90 +++ b/cbind/base/psb_s_psblas_cbind_mod.f90 @@ -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 diff --git a/cbind/base/psb_z_psblas_cbind_mod.f90 b/cbind/base/psb_z_psblas_cbind_mod.f90 index ae814d6d..8b2845a4 100644 --- a/cbind/base/psb_z_psblas_cbind_mod.f90 +++ b/cbind/base/psb_z_psblas_cbind_mod.f90 @@ -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