mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-18 03:42:09 +00:00
psblas2-dev:
base/modules/psb_serial_mod.f90 base/serial/Makefile base/serial/psb_dspscal.f90 base/serial/psb_dspshift.f90 Added shift routine for usage with eigenvalues. To be done: general add routine.
This commit is contained in:
Salvatore Filippone
@@ -432,6 +432,12 @@ module psb_serial_mod
|
||||
end interface
|
||||
|
||||
interface psb_sp_scal
|
||||
subroutine psb_dspscals(a,d,info)
|
||||
use psb_spmat_type
|
||||
type(psb_dspmat_type), intent(inout) :: a
|
||||
real(psb_dpk_), intent(in) :: d
|
||||
integer, intent(out) :: info
|
||||
end subroutine psb_dspscals
|
||||
subroutine psb_dspscal(a,d,info)
|
||||
use psb_spmat_type
|
||||
type(psb_dspmat_type), intent(inout) :: a
|
||||
@@ -446,6 +452,17 @@ module psb_serial_mod
|
||||
end subroutine psb_zspscal
|
||||
end interface
|
||||
|
||||
|
||||
interface psb_sp_shift
|
||||
subroutine psb_dspshift(alpha,a,beta,b,info)
|
||||
use psb_spmat_type
|
||||
type(psb_dspmat_type), intent(in) :: a
|
||||
type(psb_dspmat_type), intent(out) :: b
|
||||
real(psb_dpk_), intent(in) :: alpha, beta
|
||||
integer, intent(out) :: info
|
||||
end subroutine psb_dspshift
|
||||
end interface
|
||||
|
||||
interface psb_sp_getblk
|
||||
subroutine psb_dspgtblk(irw,a,b,info,append,iren,lrw,srt)
|
||||
use psb_spmat_type
|
||||
|
||||
@@ -13,7 +13,8 @@ FOBJS = psb_cest.o psb_dcoins.o psb_dcsmm.o psb_dcsmv.o \
|
||||
psb_zcoins.o psb_zcsprt.o psb_zneigh.o psb_ztransp.o psb_ztransc.o\
|
||||
psb_zrwextd.o psb_zsymbmm.o psb_znumbmm.o psb_zspscal.o psb_zspclip.o\
|
||||
psb_getifield.o psb_setifield.o psb_update_mod.o psb_getrow_mod.o\
|
||||
psb_dgelp.o psb_zgelp.o psb_dcsrp.o psb_zcsrp.o
|
||||
psb_dgelp.o psb_zgelp.o psb_dcsrp.o psb_zcsrp.o\
|
||||
psb_dspshift.o
|
||||
|
||||
LIBDIR=..
|
||||
MODDIR=../modules
|
||||
|
||||
@@ -96,4 +96,63 @@ subroutine psb_dspscal(a,d,info)
|
||||
return
|
||||
|
||||
end subroutine psb_dspscal
|
||||
subroutine psb_dspscals(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_dspmat_type), intent(inout) :: a
|
||||
integer, intent(out) :: info
|
||||
real(psb_dpk_), intent(in) :: d
|
||||
|
||||
integer :: i,j,err_act
|
||||
character(len=20) :: name, ch_err
|
||||
|
||||
name='psb_dspscal'
|
||||
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_dspscals
|
||||
|
||||
|
||||
@@ -0,0 +1,92 @@
|
||||
!!$
|
||||
!!$ Parallel Sparse BLAS version 2.2
|
||||
!!$ (C) Copyright 2006/2007/2008
|
||||
!!$ Salvatore Filippone University of Rome Tor Vergata
|
||||
!!$ Alfredo Buttari University of Rome Tor Vergata
|
||||
!!$
|
||||
!!$ Redistribution and use in source and binary forms, with or without
|
||||
!!$ modification, are permitted provided that the following conditions
|
||||
!!$ are met:
|
||||
!!$ 1. Redistributions of source code must retain the above copyright
|
||||
!!$ notice, this list of conditions and the following disclaimer.
|
||||
!!$ 2. Redistributions in binary form must reproduce the above copyright
|
||||
!!$ notice, this list of conditions, and the following disclaimer in the
|
||||
!!$ documentation and/or other materials provided with the distribution.
|
||||
!!$ 3. The name of the PSBLAS group or the names of its contributors may
|
||||
!!$ not be used to endorse or promote products derived from this
|
||||
!!$ software without specific written permission.
|
||||
!!$
|
||||
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
|
||||
!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
|
||||
!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
|
||||
!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
|
||||
!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
|
||||
!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
|
||||
!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
|
||||
!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
|
||||
!!$ POSSIBILITY OF SUCH DAMAGE.
|
||||
!!$
|
||||
!!$
|
||||
! File: psb_dspgtblk.f90
|
||||
! Subroutine: psb_dspgtblk
|
||||
! Gets one or more rows from a sparse matrix.
|
||||
! Arguments:
|
||||
!*****************************************************************************
|
||||
!* *
|
||||
!* Takes a specified row from matrix A and copies into matrix B (possibly *
|
||||
!* appending to B). Output is always COO. Input might be anything, *
|
||||
!* *
|
||||
!*****************************************************************************
|
||||
subroutine psb_dspshift(alpha,a,beta,b,info)
|
||||
! Output is always in COO format into B, irrespective of
|
||||
! the input format
|
||||
use psb_spmat_type
|
||||
use psb_const_mod
|
||||
use psb_string_mod
|
||||
use psb_serial_mod, psb_protect_name => psb_dspshift
|
||||
|
||||
implicit none
|
||||
|
||||
type(psb_dspmat_type), intent(in) :: a
|
||||
type(psb_dspmat_type), intent(out) :: b
|
||||
real(psb_dpk_), intent(in) :: alpha, beta
|
||||
integer, intent(out) :: info
|
||||
|
||||
logical :: append_,srt_
|
||||
integer :: i,j, err_act
|
||||
character(len=20) :: name
|
||||
|
||||
name='psb_sp_shift'
|
||||
info = 0
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
call psb_spcnv(a,b,info,afmt='COO')
|
||||
if (info == 0) call psb_sp_scal(b,alpha,info)
|
||||
call psb_sp_setifld(psb_spmat_bld_,psb_state_,b,info)
|
||||
do i=1,min(b%m,b%k)
|
||||
if (info == 0) call psb_coins(1,(/i/),(/i/),(/beta/),b,1,1,b%m,b%k,info)
|
||||
end do
|
||||
if (info == 0) call psb_spcnv(b,info,afmt=a%fida,dupl=psb_dupl_add_)
|
||||
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Internal call')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
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_dspshift
|
||||
|
||||
Reference in New Issue
Block a user