!!$ !!$ Parallel Sparse BLAS v2.0 !!$ (C) Copyright 2006 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. !!$ !!$ module psb_serial_mod use psb_spmat_type use psb_string_mod interface psb_csdp subroutine psb_dcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl) use psb_spmat_type type(psb_dspmat_type), intent(in) :: a type(psb_dspmat_type), intent(inout) :: b integer, intent(out) :: info integer, intent(in), optional :: ifc,upd,dupl character, intent(in), optional :: check,trans,unitd end subroutine psb_dcsdp subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl) use psb_spmat_type type(psb_zspmat_type), intent(in) :: a type(psb_zspmat_type), intent(inout) :: b integer, intent(out) :: info integer, intent(in), optional :: ifc,upd,dupl character, intent(in), optional :: check,trans,unitd end subroutine psb_zcsdp end interface interface psb_csrws subroutine psb_dcsrws(rw,a,info,trans) use psb_spmat_type type(psb_dspmat_type) :: a real(kind(1.d0)), allocatable :: rw(:) integer :: info character, optional :: trans end subroutine psb_dcsrws subroutine psb_zcsrws(rw,a,info,trans) use psb_spmat_type type(psb_zspmat_type) :: a complex(kind(1.d0)), allocatable :: rw(:) integer :: info character, optional :: trans end subroutine psb_zcsrws end interface interface psb_cssm subroutine psb_dcssm(alpha,t,b,beta,c,info,trans,unitd,d) use psb_spmat_type type(psb_dspmat_type) :: t real(kind(1.d0)) :: alpha, beta, b(:,:), c(:,:) integer :: info character, optional :: trans, unitd real(kind(1.d0)), optional, target :: d(:) end subroutine psb_dcssm subroutine psb_dcssv(alpha,t,b,beta,c,info,trans,unitd,d) use psb_spmat_type type(psb_dspmat_type) :: t real(kind(1.d0)) :: alpha, beta, b(:), c(:) integer :: info character, optional :: trans, unitd real(kind(1.d0)), optional, target :: d(:) end subroutine psb_dcssv subroutine psb_zcssm(alpha,t,b,beta,c,info,trans,unitd,d) use psb_spmat_type type(psb_zspmat_type) :: t complex(kind(1.d0)) :: alpha, beta, b(:,:), c(:,:) integer :: info character, optional :: trans, unitd complex(kind(1.d0)), optional, target :: d(:) end subroutine psb_zcssm subroutine psb_zcssv(alpha,t,b,beta,c,info,trans,unitd,d) use psb_spmat_type type(psb_zspmat_type) :: t complex(kind(1.d0)) :: alpha, beta, b(:), c(:) integer :: info character, optional :: trans, unitd complex(kind(1.d0)), optional, target :: d(:) end subroutine psb_zcssv end interface interface psb_csmm subroutine psb_dcsmv(alpha,a,b,beta,c,info,trans) use psb_spmat_type type(psb_dspmat_type) :: a real(kind(1.d0)) :: alpha, beta, b(:), c(:) integer :: info character, optional :: trans end subroutine psb_dcsmv subroutine psb_dcsmm(alpha,a,b,beta,c,info,trans) use psb_spmat_type type(psb_dspmat_type) :: a real(kind(1.d0)) :: alpha, beta, b(:,:), c(:,:) integer :: info character, optional :: trans end subroutine psb_dcsmm subroutine psb_zcsmv(alpha,a,b,beta,c,info,trans) use psb_spmat_type type(psb_zspmat_type) :: a complex(kind(1.d0)) :: alpha, beta, b(:), c(:) integer :: info character, optional :: trans end subroutine psb_zcsmv subroutine psb_zcsmm(alpha,a,b,beta,c,info,trans) use psb_spmat_type type(psb_zspmat_type) :: a complex(kind(1.d0)) :: alpha, beta, b(:,:), c(:,:) integer :: info character, optional :: trans end subroutine psb_zcsmm end interface interface psb_cest subroutine psb_cest(afmt, m,n,nnz, lia1, lia2, lar, iup, info) integer, intent(in) :: m,n,nnz,iup integer, intent(out) :: lia1, lia2, lar, info character, intent(inout) :: afmt*5 end subroutine psb_cest end interface interface psb_fixcoo subroutine psb_dfixcoo(a,info,idir) use psb_spmat_type type(psb_dspmat_type), intent(inout) :: a integer, intent(out) :: info integer, intent(in), optional :: idir end subroutine psb_dfixcoo subroutine psb_zfixcoo(a,info,idir) use psb_spmat_type type(psb_zspmat_type), intent(inout) :: a integer, intent(out) :: info integer, intent(in), optional :: idir end subroutine psb_zfixcoo end interface interface psb_ipcoo2csr subroutine psb_dipcoo2csr(a,info,rwshr) use psb_spmat_type type(psb_dspmat_type), intent(inout) :: a integer, intent(out) :: info logical, optional :: rwshr end subroutine psb_dipcoo2csr subroutine psb_zipcoo2csr(a,info,rwshr) use psb_spmat_type type(psb_zspmat_type), intent(inout) :: a integer, intent(out) :: info logical, optional :: rwshr end subroutine psb_zipcoo2csr end interface interface psb_ipcoo2csc subroutine psb_dipcoo2csc(a,info,clshr) use psb_spmat_type type(psb_dspmat_type), intent(inout) :: a integer, intent(out) :: info logical, optional :: clshr end subroutine psb_dipcoo2csc subroutine psb_zipcoo2csc(a,info,clshr) use psb_spmat_type type(psb_zspmat_type), intent(inout) :: a integer, intent(out) :: info logical, optional :: clshr end subroutine psb_zipcoo2csc end interface interface psb_ipcsr2coo subroutine psb_dipcsr2coo(a,info) use psb_spmat_type type(psb_dspmat_type), intent(inout) :: a integer, intent(out) :: info end subroutine psb_dipcsr2coo subroutine psb_zipcsr2coo(a,info) use psb_spmat_type type(psb_zspmat_type), intent(inout) :: a integer, intent(out) :: info end subroutine psb_zipcsr2coo end interface interface psb_csprt subroutine psb_dcsprt(iout,a,iv,irs,ics,head,ivr,ivc) use psb_spmat_type integer, intent(in) :: iout type(psb_dspmat_type), intent(in) :: a integer, intent(in), optional :: iv(:) integer, intent(in), optional :: irs,ics character(len=*), optional :: head integer, intent(in), optional :: ivr(:),ivc(:) end subroutine psb_dcsprt subroutine psb_zcsprt(iout,a,iv,irs,ics,head,ivr,ivc) use psb_spmat_type integer, intent(in) :: iout type(psb_zspmat_type), intent(in) :: a integer, intent(in), optional :: iv(:) integer, intent(in), optional :: irs,ics character(len=*), optional :: head integer, intent(in), optional :: ivr(:),ivc(:) end subroutine psb_zcsprt end interface interface psb_neigh subroutine psb_dneigh(a,idx,neigh,n,info,lev) use psb_spmat_type type(psb_dspmat_type), intent(in) :: a integer, intent(in) :: idx integer, intent(out) :: n integer, allocatable :: neigh(:) integer, intent(out) :: info integer, optional, intent(in) :: lev end subroutine psb_dneigh subroutine psb_zneigh(a,idx,neigh,n,info,lev) use psb_spmat_type type(psb_zspmat_type), intent(in) :: a integer, intent(in) :: idx integer, intent(out) :: n integer, allocatable :: neigh(:) integer, intent(out) :: info integer, optional, intent(in) :: lev end subroutine psb_zneigh end interface interface psb_coins subroutine psb_dcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild) use psb_spmat_type integer, intent(in) :: nz, imin,imax,jmin,jmax integer, intent(in) :: ia(:),ja(:) real(kind(1.d0)), intent(in) :: val(:) type(psb_dspmat_type), intent(inout) :: a integer, intent(out) :: info integer, intent(in), optional :: gtl(:) logical, optional, intent(in) :: rebuild end subroutine psb_dcoins subroutine psb_zcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild) use psb_spmat_type integer, intent(in) :: nz, imin,imax,jmin,jmax integer, intent(in) :: ia(:),ja(:) complex(kind(1.d0)), intent(in) :: val(:) type(psb_zspmat_type), intent(inout) :: a integer, intent(out) :: info integer, intent(in), optional :: gtl(:) logical, optional, intent(in) :: rebuild end subroutine psb_zcoins end interface interface psb_symbmm subroutine psb_dsymbmm(a,b,c,info) use psb_spmat_type type(psb_dspmat_type) :: a,b,c integer :: info end subroutine psb_dsymbmm subroutine psb_zsymbmm(a,b,c,info) use psb_spmat_type type(psb_zspmat_type) :: a,b,c integer :: info end subroutine psb_zsymbmm end interface interface psb_numbmm subroutine psb_dnumbmm(a,b,c) use psb_spmat_type type(psb_dspmat_type) :: a,b,c end subroutine psb_dnumbmm subroutine psb_znumbmm(a,b,c) use psb_spmat_type type(psb_zspmat_type) :: a,b,c end subroutine psb_znumbmm end interface interface psb_transp subroutine psb_dtransp(a,b,c,fmt) use psb_spmat_type type(psb_dspmat_type) :: a,b integer, optional :: c character(len=*), optional :: fmt end subroutine psb_dtransp subroutine psb_ztransp(a,b,c,fmt) use psb_spmat_type type(psb_zspmat_type) :: a,b integer, optional :: c character(len=*), optional :: fmt end subroutine psb_ztransp end interface interface psb_transc subroutine psb_ztransc(a,b,c,fmt) use psb_spmat_type type(psb_zspmat_type) :: a,b integer, optional :: c character(len=*), optional :: fmt end subroutine psb_ztransc end interface interface psb_rwextd subroutine psb_drwextd(nr,a,info,b,rowscale) use psb_spmat_type integer, intent(in) :: nr type(psb_dspmat_type), intent(inout) :: a integer, intent(out) :: info type(psb_dspmat_type), intent(in), optional :: b logical, intent(in), optional :: rowscale end subroutine psb_drwextd subroutine psb_zrwextd(nr,a,info,b,rowscale) use psb_spmat_type integer, intent(in) :: nr type(psb_zspmat_type), intent(inout) :: a integer, intent(out) :: info type(psb_zspmat_type), intent(in), optional :: b logical, intent(in), optional :: rowscale end subroutine psb_zrwextd end interface interface psb_csnmi real(kind(1.d0)) function psb_dcsnmi(a,info,trans) use psb_spmat_type type(psb_dspmat_type), intent(in) :: a integer, intent(out) :: info character, optional :: trans end function psb_dcsnmi real(kind(1.d0)) function psb_zcsnmi(a,info,trans) use psb_spmat_type type(psb_zspmat_type), intent(in) :: a integer, intent(out) :: info character, optional :: trans end function psb_zcsnmi end interface interface psb_sp_clip subroutine psb_dspclip(a,b,info,imin,imax,jmin,jmax,rscale,cscale) use psb_spmat_type implicit none type(psb_dspmat_type), intent(in) :: a type(psb_dspmat_type), intent(out) :: b integer, intent(out) :: info integer, intent(in), optional :: imin,imax,jmin,jmax logical, intent(in), optional :: rscale,cscale end subroutine psb_dspclip subroutine psb_zspclip(a,b,info,imin,imax,jmin,jmax,rscale,cscale) use psb_spmat_type implicit none type(psb_zspmat_type), intent(in) :: a type(psb_zspmat_type), intent(out) :: b integer, intent(out) :: info integer, intent(in), optional :: imin,imax,jmin,jmax logical, intent(in), optional :: rscale,cscale end subroutine psb_zspclip end interface interface psb_sp_getdiag subroutine psb_dspgtdiag(a,d,info) use psb_spmat_type type(psb_dspmat_type), intent(in) :: a real(kind(1.d0)), intent(inout) :: d(:) integer, intent(out) :: info end subroutine psb_dspgtdiag subroutine psb_zspgtdiag(a,d,info) use psb_spmat_type type(psb_zspmat_type), intent(in) :: a complex(kind(1.d0)), intent(inout) :: d(:) integer, intent(out) :: info end subroutine psb_zspgtdiag end interface interface psb_sp_scal subroutine psb_dspscal(a,d,info) use psb_spmat_type type(psb_dspmat_type), intent(inout) :: a real(kind(1.d0)), intent(in) :: d(:) integer, intent(out) :: info end subroutine psb_dspscal subroutine psb_zspscal(a,d,info) use psb_spmat_type type(psb_zspmat_type), intent(inout) :: a complex(kind(1.d0)), intent(in) :: d(:) integer, intent(out) :: info end subroutine psb_zspscal end interface interface psb_sp_getblk subroutine psb_dspgtblk(irw,a,b,info,append,iren,lrw,srt) use psb_spmat_type type(psb_dspmat_type), intent(in) :: a integer, intent(in) :: irw type(psb_dspmat_type), intent(inout) :: b integer, intent(out) :: info logical, intent(in), optional :: append integer, intent(in), target, optional :: iren(:) integer, intent(in), optional :: lrw logical, intent(in), optional :: srt end subroutine psb_dspgtblk subroutine psb_zspgtblk(irw,a,b,info,append,iren,lrw,srt) use psb_spmat_type type(psb_zspmat_type), intent(in) :: a integer, intent(in) :: irw type(psb_zspmat_type), intent(inout) :: b integer, intent(out) :: info logical, intent(in), optional :: append integer, intent(in), target, optional :: iren(:) integer, intent(in), optional :: lrw logical, intent(in), optional :: srt end subroutine psb_zspgtblk end interface interface psb_sp_getrow subroutine psb_dspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw,append,nzin) ! Output is always in COO format use psb_spmat_type implicit none type(psb_dspmat_type), intent(in) :: a integer, intent(in) :: irw integer, intent(out) :: nz integer, allocatable, intent(inout) :: ia(:), ja(:) real(kind(1.d0)), allocatable, intent(inout) :: val(:) integer,intent(out) :: info logical, intent(in), optional :: append integer, intent(in), optional :: iren(:) integer, intent(in), optional :: lrw, nzin end subroutine psb_dspgetrow subroutine psb_zspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw,append,nzin) ! Output is always in COO format use psb_spmat_type implicit none type(psb_zspmat_type), intent(in) :: a integer, intent(in) :: irw integer, intent(out) :: nz integer, allocatable, intent(inout) :: ia(:), ja(:) complex(kind(1.d0)), allocatable, intent(inout) :: val(:) integer,intent(out) :: info logical, intent(in), optional :: append integer, intent(in), optional :: iren(:) integer, intent(in), optional :: lrw, nzin end subroutine psb_zspgetrow end interface interface psb_msort module procedure imsort end interface interface psb_msort_unique module procedure imsort_u end interface interface psb_qsort module procedure iqsort end interface integer, parameter :: psb_sort_up_=1, psb_sort_down_=-1 integer, parameter :: psb_sort_ovw_idx_=0, psb_sort_keep_idx_=1 contains subroutine imsort(x,ix,dir,flag) use psb_error_mod implicit none integer, intent(inout) :: x(:) integer, optional, intent(in) :: dir, flag integer, optional, intent(inout) :: ix(:) integer :: dir_, flag_, n, err_act character(len=20) :: name name='psb_msort' call psb_erractionsave(err_act) if (present(dir)) then dir_ = dir else dir_= psb_sort_up_ end if select case(dir_) case( psb_sort_up_, psb_sort_down_) ! OK keep going case default call psb_errpush(30,name,i_err=(/3,dir_,0,0,0/)) goto 9999 end select n = size(x) if (present(ix)) then if (size(ix) < n) then call psb_errpush(35,name,i_err=(/2,size(ix),0,0,0/)) goto 9999 end if if (present(flag)) then flag_ = flag else flag_ = psb_sort_ovw_idx_ end if select case(flag_) case( psb_sort_ovw_idx_, psb_sort_keep_idx_) ! OK keep going case default call psb_errpush(30,name,i_err=(/4,flag_,0,0,0/)) goto 9999 end select call imsrx(n,x,ix,dir_,flag_) else call imsr(n,x,dir_) end if 9999 continue if (err_act.eq.psb_act_abort_) then call psb_error() return end if end subroutine imsort subroutine imsort_u(x,nout,dir) use psb_error_mod implicit none integer, intent(inout) :: x(:) integer, intent(out) :: nout integer, optional, intent(in) :: dir integer :: dir_, flag_, n, err_act character(len=20) :: name name='psb_msort_u' call psb_erractionsave(err_act) if (present(dir)) then dir_ = dir else dir_= psb_sort_up_ end if select case(dir_) case( psb_sort_up_, psb_sort_down_) ! OK keep going case default call psb_errpush(30,name,i_err=(/3,dir_,0,0,0/)) goto 9999 end select n = size(x) call imsru(n,x,dir_,nout) 9999 continue if (err_act.eq.psb_act_abort_) then call psb_error() return end if end subroutine imsort_u subroutine iqsort(x,ix,dir,flag) use psb_error_mod implicit none integer, intent(inout) :: x(:) integer, optional, intent(in) :: dir, flag integer, optional, intent(inout) :: ix(:) integer :: dir_, flag_, n, err_act character(len=20) :: name name='psb_qsort' call psb_erractionsave(err_act) if (present(dir)) then dir_ = dir else dir_= psb_sort_up_ end if select case(dir_) case( psb_sort_up_, psb_sort_down_) ! OK keep going case default call psb_errpush(30,name,i_err=(/3,dir_,0,0,0/)) goto 9999 end select n = size(x) if (present(ix)) then if (size(ix) < n) then call psb_errpush(35,name,i_err=(/2,size(ix),0,0,0/)) goto 9999 end if if (present(flag)) then flag_ = flag else flag_ = psb_sort_ovw_idx_ end if select case(flag_) case( psb_sort_ovw_idx_, psb_sort_keep_idx_) ! OK keep going case default call psb_errpush(30,name,i_err=(/4,flag_,0,0,0/)) goto 9999 end select call isrx(n,x,ix,dir_,flag_) else call isr(n,x,dir_) end if 9999 continue if (err_act.eq.psb_act_abort_) then call psb_error() return end if end subroutine iqsort end module psb_serial_mod