diff --git a/base/serial/psb_cspscal.f90 b/base/serial/psb_cspscal.f90 index 4a0eb7d0..e17a6f70 100644 --- a/base/serial/psb_cspscal.f90 +++ b/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 diff --git a/base/serial/psb_sspscal.f90 b/base/serial/psb_sspscal.f90 index d32efd49..95aa91af 100644 --- a/base/serial/psb_sspscal.f90 +++ b/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 +