Implementation of psb_abgdxyz

base/psblas/psb_caxpby.f90

@@ -741,3 +741,85 @@ subroutine psb_caddconst_vect(x,b,z,desc_a,info)
   return
 
 end subroutine psb_caddconst_vect
+
+
+subroutine psb_cabgdxyz_vect(alpha, beta, gamma, delta, x, y, z,&
+     & desc_a, info)
+  import :: psb_desc_type, psb_spk_, psb_ipk_, &
+       & psb_c_vect_type, psb_cspmat_type
+  type(psb_c_vect_type), intent (inout) :: x
+  type(psb_c_vect_type), intent (inout) :: y
+  type(psb_c_vect_type), intent (inout) :: z
+  complex(psb_spk_), intent (in)        :: alpha, beta, gamma, delta
+  type(psb_desc_type), intent (in)      :: desc_a
+  integer(psb_ipk_), intent(out)        :: info
+  ! locals
+  type(psb_ctxt_type) :: ctxt
+  integer(psb_ipk_) :: np, me,&
+       & err_act, iix, jjx, iiy, jjy
+  integer(psb_lpk_) :: ix, ijx, iy, ijy, m
+  character(len=20)        :: name, ch_err
+
+  name='psb_c_addconst_vect'
+  if (psb_errstatus_fatal()) return
+  info=psb_success_
+  call psb_erractionsave(err_act)
+
+  ctxt=desc_a%get_context()
+
+  call psb_info(ctxt, 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
+
+  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,z%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
+
+  if(desc_a%get_local_rows() > 0) then
+    call z%abgdxyz(alpha,beta,gamma,delta,x,y,info)
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(ctxt,err_act)
+
+  return
+
+end subroutine psb_cabgdxyz_vect
+

base/psblas/psb_daxpby.f90

@@ -741,3 +741,85 @@ subroutine psb_daddconst_vect(x,b,z,desc_a,info)
   return
 
 end subroutine psb_daddconst_vect
+
+
+subroutine psb_dabgdxyz_vect(alpha, beta, gamma, delta, x, y, z,&
+     & desc_a, info)
+  import :: psb_desc_type, psb_dpk_, psb_ipk_, &
+       & psb_d_vect_type, psb_dspmat_type
+  type(psb_d_vect_type), intent (inout) :: x
+  type(psb_d_vect_type), intent (inout) :: y
+  type(psb_d_vect_type), intent (inout) :: z
+  real(psb_dpk_), intent (in)        :: alpha, beta, gamma, delta
+  type(psb_desc_type), intent (in)      :: desc_a
+  integer(psb_ipk_), intent(out)        :: info
+  ! locals
+  type(psb_ctxt_type) :: ctxt
+  integer(psb_ipk_) :: np, me,&
+       & err_act, iix, jjx, iiy, jjy
+  integer(psb_lpk_) :: ix, ijx, iy, ijy, m
+  character(len=20)        :: name, ch_err
+
+  name='psb_d_addconst_vect'
+  if (psb_errstatus_fatal()) return
+  info=psb_success_
+  call psb_erractionsave(err_act)
+
+  ctxt=desc_a%get_context()
+
+  call psb_info(ctxt, 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
+
+  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,z%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
+
+  if(desc_a%get_local_rows() > 0) then
+    call z%abgdxyz(alpha,beta,gamma,delta,x,y,info)
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(ctxt,err_act)
+
+  return
+
+end subroutine psb_dabgdxyz_vect
+

base/psblas/psb_saxpby.f90

@@ -741,3 +741,85 @@ subroutine psb_saddconst_vect(x,b,z,desc_a,info)
   return
 
 end subroutine psb_saddconst_vect
+
+
+subroutine psb_sabgdxyz_vect(alpha, beta, gamma, delta, x, y, z,&
+     & desc_a, info)
+  import :: psb_desc_type, psb_spk_, psb_ipk_, &
+       & psb_s_vect_type, psb_sspmat_type
+  type(psb_s_vect_type), intent (inout) :: x
+  type(psb_s_vect_type), intent (inout) :: y
+  type(psb_s_vect_type), intent (inout) :: z
+  real(psb_spk_), intent (in)        :: alpha, beta, gamma, delta
+  type(psb_desc_type), intent (in)      :: desc_a
+  integer(psb_ipk_), intent(out)        :: info
+  ! locals
+  type(psb_ctxt_type) :: ctxt
+  integer(psb_ipk_) :: np, me,&
+       & err_act, iix, jjx, iiy, jjy
+  integer(psb_lpk_) :: ix, ijx, iy, ijy, m
+  character(len=20)        :: name, ch_err
+
+  name='psb_s_addconst_vect'
+  if (psb_errstatus_fatal()) return
+  info=psb_success_
+  call psb_erractionsave(err_act)
+
+  ctxt=desc_a%get_context()
+
+  call psb_info(ctxt, 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
+
+  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,z%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
+
+  if(desc_a%get_local_rows() > 0) then
+    call z%abgdxyz(alpha,beta,gamma,delta,x,y,info)
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(ctxt,err_act)
+
+  return
+
+end subroutine psb_sabgdxyz_vect
+

base/psblas/psb_zaxpby.f90

@@ -741,3 +741,85 @@ subroutine psb_zaddconst_vect(x,b,z,desc_a,info)
   return
 
 end subroutine psb_zaddconst_vect
+
+
+subroutine psb_zabgdxyz_vect(alpha, beta, gamma, delta, x, y, z,&
+     & desc_a, info)
+  import :: psb_desc_type, psb_dpk_, psb_ipk_, &
+       & psb_z_vect_type, psb_zspmat_type
+  type(psb_z_vect_type), intent (inout) :: x
+  type(psb_z_vect_type), intent (inout) :: y
+  type(psb_z_vect_type), intent (inout) :: z
+  complex(psb_dpk_), intent (in)        :: alpha, beta, gamma, delta
+  type(psb_desc_type), intent (in)      :: desc_a
+  integer(psb_ipk_), intent(out)        :: info
+  ! locals
+  type(psb_ctxt_type) :: ctxt
+  integer(psb_ipk_) :: np, me,&
+       & err_act, iix, jjx, iiy, jjy
+  integer(psb_lpk_) :: ix, ijx, iy, ijy, m
+  character(len=20)        :: name, ch_err
+
+  name='psb_z_addconst_vect'
+  if (psb_errstatus_fatal()) return
+  info=psb_success_
+  call psb_erractionsave(err_act)
+
+  ctxt=desc_a%get_context()
+
+  call psb_info(ctxt, 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
+
+  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,z%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
+
+  if(desc_a%get_local_rows() > 0) then
+    call z%abgdxyz(alpha,beta,gamma,delta,x,y,info)
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(ctxt,err_act)
+
+  return
+
+end subroutine psb_zabgdxyz_vect
+