From 608c97e9d4f5cc5c1302a9cc5f931d57cb061cea Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Tue, 13 May 2008 15:37:13 +0000 Subject: [PATCH] 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. --- base/modules/psb_serial_mod.f90 | 17 ++++++ base/serial/Makefile | 3 +- base/serial/psb_dspscal.f90 | 59 +++++++++++++++++++++ base/serial/psb_dspshift.f90 | 92 +++++++++++++++++++++++++++++++++ 4 files changed, 170 insertions(+), 1 deletion(-) create mode 100644 base/serial/psb_dspshift.f90 diff --git a/base/modules/psb_serial_mod.f90 b/base/modules/psb_serial_mod.f90 index ef1dd242..e28e00ce 100644 --- a/base/modules/psb_serial_mod.f90 +++ b/base/modules/psb_serial_mod.f90 @@ -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 diff --git a/base/serial/Makefile b/base/serial/Makefile index ace5b23c..70d1637b 100644 --- a/base/serial/Makefile +++ b/base/serial/Makefile @@ -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 diff --git a/base/serial/psb_dspscal.f90 b/base/serial/psb_dspscal.f90 index 6e842000..8d94c33e 100644 --- a/base/serial/psb_dspscal.f90 +++ b/base/serial/psb_dspscal.f90 @@ -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 diff --git a/base/serial/psb_dspshift.f90 b/base/serial/psb_dspshift.f90 new file mode 100644 index 00000000..1c436ffd --- /dev/null +++ b/base/serial/psb_dspshift.f90 @@ -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 +