psblas2-dev:

base/serial/psb_cspscal.f90
 base/serial/psb_sspscal.f90


Added scaling by a scalar.

base/serial/psb_cspscal.f90

@@ -96,4 +96,63 @@ subroutine psb_cspscal(a,d,info)
   return
 
 end subroutine psb_cspscal
+subroutine psb_cspscals(a,d,info)
+  ! the input format 
+  use psb_spmat_type
+  use psb_error_mod
+  use psb_const_mod
+  use psb_string_mod
+  implicit none
+
+  type(psb_cspmat_type), intent(inout) :: a
+  integer, intent(out)                 :: info
+  complex(psb_spk_), intent(in)        :: d
+
+  integer :: i,j, err_act
+  character(len=20)                 :: name, ch_err
+
+  name='psb_cspscal'
+  info  = 0
+  call psb_erractionsave(err_act)
+
+  select case(psb_toupper(a%fida(1:3)))
+  case  ('CSR')
+
+    do i=1, a%m
+      do j=a%ia2(i),a%ia2(i+1)-1
+        a%aspk(j) = a%aspk(j) * d
+      end do
+    end do
+
+  case ('COO') 
+
+    do i=1,a%infoa(psb_nnz_)
+      j=a%ia1(i)
+      a%aspk(i) = a%aspk(i) * d
+    enddo
+
+  case ('JAD') 
+    info=135
+    ch_err=a%fida(1:3)
+    call psb_errpush(info,name,a_err=ch_err)
+    goto 9999
+  case default
+    info=136
+    ch_err=a%fida(1:3)
+    call psb_errpush(info,name,a_err=ch_err)
+    goto 9999
+  end select
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+     call psb_error()
+     return
+  end if
+  return
+
+end subroutine psb_cspscals
 

base/serial/psb_sspscal.f90

@@ -97,3 +97,63 @@ subroutine psb_sspscal(a,d,info)
 
 end subroutine psb_sspscal
 
+subroutine psb_sspscals(a,d,info)
+  ! the input format 
+  use psb_spmat_type
+  use psb_error_mod
+  use psb_const_mod
+  use psb_string_mod
+  implicit none
+
+  type(psb_sspmat_type), intent(inout) :: a
+  integer, intent(out)                 :: info
+  real(psb_spk_), intent(in)           :: d
+
+  integer :: i,j,err_act
+  character(len=20)                 :: name, ch_err
+
+  name='psb_sspscal'
+  info  = 0
+  call psb_erractionsave(err_act)
+
+  select case(psb_toupper(a%fida(1:3)))
+  case  ('CSR')
+
+    do i=1, a%m
+      do j=a%ia2(i),a%ia2(i+1)-1
+        a%aspk(j) = a%aspk(j) * d
+      end do
+    end do
+
+  case ('COO') 
+
+    do i=1,a%infoa(psb_nnz_)
+      j=a%ia1(i)
+      a%aspk(i) = a%aspk(i) * d
+    enddo
+
+  case ('JAD') 
+    info=135
+    ch_err=a%fida(1:3)
+    call psb_errpush(info,name,a_err=ch_err)
+    goto 9999
+  case default
+    info=136
+    ch_err=a%fida(1:3)
+    call psb_errpush(info,name,a_err=ch_err)
+    goto 9999
+  end select
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+     call psb_error()
+     return
+  end if
+  return
+
+end subroutine psb_sspscals
+