psb_gescal Fortran semantic fix

base/modules/psblas/psb_c_psblas_mod.F90

@@ -618,6 +618,14 @@ module psb_c_psblas_mod
     type(psb_desc_type), intent (in)        :: desc_a
     integer(psb_ipk_), intent(out)          :: info
   end subroutine psb_cscal_vect
+  subroutine psb_cscal_inplace_vect(x,c,desc_a,info)
+    import :: psb_desc_type, psb_ipk_, &
+         & psb_c_vect_type, psb_spk_
+    type(psb_c_vect_type), intent (inout) :: x
+    complex(psb_spk_), intent(in)             :: c
+    type(psb_desc_type), intent (in)        :: desc_a
+    integer(psb_ipk_), intent(out)          :: info
+  end subroutine psb_cscal_inplace_vect
   end interface
 
 

base/modules/psblas/psb_d_psblas_mod.F90

@@ -629,6 +629,14 @@ module psb_d_psblas_mod
     type(psb_desc_type), intent (in)        :: desc_a
     integer(psb_ipk_), intent(out)          :: info
   end subroutine psb_dscal_vect
+  subroutine psb_dscal_inplace_vect(x,c,desc_a,info)
+    import :: psb_desc_type, psb_ipk_, &
+         & psb_d_vect_type, psb_dpk_
+    type(psb_d_vect_type), intent (inout) :: x
+    real(psb_dpk_), intent(in)             :: c
+    type(psb_desc_type), intent (in)        :: desc_a
+    integer(psb_ipk_), intent(out)          :: info
+  end subroutine psb_dscal_inplace_vect
   end interface
 
   interface psb_mask

base/modules/psblas/psb_s_psblas_mod.F90

@@ -629,6 +629,14 @@ module psb_s_psblas_mod
     type(psb_desc_type), intent (in)        :: desc_a
     integer(psb_ipk_), intent(out)          :: info
   end subroutine psb_sscal_vect
+  subroutine psb_sscal_inplace_vect(x,c,desc_a,info)
+    import :: psb_desc_type, psb_ipk_, &
+         & psb_s_vect_type, psb_spk_
+    type(psb_s_vect_type), intent (inout) :: x
+    real(psb_spk_), intent(in)             :: c
+    type(psb_desc_type), intent (in)        :: desc_a
+    integer(psb_ipk_), intent(out)          :: info
+  end subroutine psb_sscal_inplace_vect
   end interface
 
   interface psb_mask

base/modules/psblas/psb_z_psblas_mod.F90

@@ -618,6 +618,14 @@ module psb_z_psblas_mod
     type(psb_desc_type), intent (in)        :: desc_a
     integer(psb_ipk_), intent(out)          :: info
   end subroutine psb_zscal_vect
+  subroutine psb_zscal_inplace_vect(x,c,desc_a,info)
+    import :: psb_desc_type, psb_ipk_, &
+         & psb_z_vect_type, psb_dpk_
+    type(psb_z_vect_type), intent (inout) :: x
+    complex(psb_dpk_), intent(in)             :: c
+    type(psb_desc_type), intent (in)        :: desc_a
+    integer(psb_ipk_), intent(out)          :: info
+  end subroutine psb_zscal_inplace_vect
   end interface
 
 

base/psblas/psb_caxpby.f90

@@ -827,3 +827,75 @@ subroutine psb_cscal_vect(x,c,z,desc_a,info)
   return
 
 end subroutine psb_cscal_vect
+!
+! Subroutine: psb_cscal_inplace_vect
+!    Scale one distributed vector with scalar c,
+!
+!    Z(i) := c*X(i)
+!
+! Arguments:
+!    x      - type(psb_c_vect_type) The input/output vector X
+!    c      -  complex,input        The scalar used to scale each component of X
+!    desc_a -  type(psb_desc_type)  The communication descriptor.
+!    info   -  integer              Return code
+!
+subroutine psb_cscal_inplace_vect(x,c,desc_a,info)
+  use psb_base_mod, psb_protect_name => psb_cscal_inplace_vect
+  implicit none
+  type(psb_c_vect_type), intent (inout) :: x
+  complex(psb_spk_), intent(in)             :: c
+  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=30)        :: name, ch_err
+
+  name='psb_cscal_inplace_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
+
+  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
+
+  if(desc_a%get_local_rows() > 0) then
+    call x%scal(c)
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(ctxt,err_act)
+
+  return
+
+end subroutine psb_cscal_inplace_vect

base/psblas/psb_daxpby.f90

@@ -827,3 +827,75 @@ subroutine psb_dscal_vect(x,c,z,desc_a,info)
   return
 
 end subroutine psb_dscal_vect
+!
+! Subroutine: psb_dscal_inplace_vect
+!    Scale one distributed vector with scalar c,
+!
+!    Z(i) := c*X(i)
+!
+! Arguments:
+!    x      - type(psb_d_vect_type) The input/output vector X
+!    c      -  real,input        The scalar used to scale each component of X
+!    desc_a -  type(psb_desc_type)  The communication descriptor.
+!    info   -  integer              Return code
+!
+subroutine psb_dscal_inplace_vect(x,c,desc_a,info)
+  use psb_base_mod, psb_protect_name => psb_dscal_inplace_vect
+  implicit none
+  type(psb_d_vect_type), intent (inout) :: x
+  real(psb_dpk_), intent(in)             :: c
+  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=30)        :: name, ch_err
+
+  name='psb_dscal_inplace_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
+
+  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
+
+  if(desc_a%get_local_rows() > 0) then
+    call x%scal(c)
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(ctxt,err_act)
+
+  return
+
+end subroutine psb_dscal_inplace_vect

base/psblas/psb_saxpby.f90

@@ -827,3 +827,75 @@ subroutine psb_sscal_vect(x,c,z,desc_a,info)
   return
 
 end subroutine psb_sscal_vect
+!
+! Subroutine: psb_sscal_inplace_vect
+!    Scale one distributed vector with scalar c,
+!
+!    Z(i) := c*X(i)
+!
+! Arguments:
+!    x      - type(psb_s_vect_type) The input/output vector X
+!    c      -  real,input        The scalar used to scale each component of X
+!    desc_a -  type(psb_desc_type)  The communication descriptor.
+!    info   -  integer              Return code
+!
+subroutine psb_sscal_inplace_vect(x,c,desc_a,info)
+  use psb_base_mod, psb_protect_name => psb_sscal_inplace_vect
+  implicit none
+  type(psb_s_vect_type), intent (inout) :: x
+  real(psb_spk_), intent(in)             :: c
+  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=30)        :: name, ch_err
+
+  name='psb_sscal_inplace_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
+
+  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
+
+  if(desc_a%get_local_rows() > 0) then
+    call x%scal(c)
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(ctxt,err_act)
+
+  return
+
+end subroutine psb_sscal_inplace_vect

base/psblas/psb_zaxpby.f90

@@ -827,3 +827,75 @@ subroutine psb_zscal_vect(x,c,z,desc_a,info)
   return
 
 end subroutine psb_zscal_vect
+!
+! Subroutine: psb_zscal_inplace_vect
+!    Scale one distributed vector with scalar c,
+!
+!    Z(i) := c*X(i)
+!
+! Arguments:
+!    x      - type(psb_z_vect_type) The input/output vector X
+!    c      -  complex,input        The scalar used to scale each component of X
+!    desc_a -  type(psb_desc_type)  The communication descriptor.
+!    info   -  integer              Return code
+!
+subroutine psb_zscal_inplace_vect(x,c,desc_a,info)
+  use psb_base_mod, psb_protect_name => psb_zscal_inplace_vect
+  implicit none
+  type(psb_z_vect_type), intent (inout) :: x
+  complex(psb_dpk_), intent(in)             :: c
+  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=30)        :: name, ch_err
+
+  name='psb_zscal_inplace_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
+
+  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
+
+  if(desc_a%get_local_rows() > 0) then
+    call x%scal(c)
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(ctxt,err_act)
+
+  return
+
+end subroutine psb_zscal_inplace_vect

krylov/psb_ckrylovsubspace_mod.F90

@@ -255,7 +255,7 @@ contains
         goto 9999
       end if
       scal = cone/kryl%h(i1,i)
-      call psb_gescal(kryl%v(i1),scal,kryl%v(i1),desc_a,info)
+      call psb_gescal(kryl%v(i1),scal,desc_a,info)
       if (info /= psb_success_) then
         info=psb_err_from_subroutine_non_
         call psb_errpush(info,name)

krylov/psb_dkrylovsubspace_mod.F90

@@ -255,7 +255,7 @@ contains
         goto 9999
       end if
       scal = done/kryl%h(i1,i)
-      call psb_gescal(kryl%v(i1),scal,kryl%v(i1),desc_a,info)
+      call psb_gescal(kryl%v(i1),scal,desc_a,info)
       if (info /= psb_success_) then
         info=psb_err_from_subroutine_non_
         call psb_errpush(info,name)

krylov/psb_skrylovsubspace_mod.F90

@@ -255,7 +255,7 @@ contains
         goto 9999
       end if
       scal = sone/kryl%h(i1,i)
-      call psb_gescal(kryl%v(i1),scal,kryl%v(i1),desc_a,info)
+      call psb_gescal(kryl%v(i1),scal,desc_a,info)
       if (info /= psb_success_) then
         info=psb_err_from_subroutine_non_
         call psb_errpush(info,name)

krylov/psb_zkrylovsubspace_mod.F90

@@ -255,7 +255,7 @@ contains
         goto 9999
       end if
       scal = zone/kryl%h(i1,i)
-      call psb_gescal(kryl%v(i1),scal,kryl%v(i1),desc_a,info)
+      call psb_gescal(kryl%v(i1),scal,desc_a,info)
       if (info /= psb_success_) then
         info=psb_err_from_subroutine_non_
         call psb_errpush(info,name)