fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Take out obsolete GEINS interfaces.

Browse Source
psblas3-type-indexed
Salvatore Filippone 19 years ago
parent 50c9a04a1d
commit cfe206de5f
4 changed files with 35 additions and 2070 deletions
Show Stats Download Patch File Download Diff File

120
src/modules/psb_tools_mod.f90
Unescape Escape View File

@ -288,46 +288,6 @@ Module psb_tools_mod
interface psb_geins
! 2-D double precision version
subroutine psb_dins(m, n, blck, x, ix, jx, desc_a, info,&
& iblck, jblck,dupl)
use psb_descriptor_type
integer, intent(in) :: m,n
type(psb_desc_type), intent(in) :: desc_a
real(kind(1.d0)),pointer :: x(:,:)
integer, intent(in) :: ix,jx
real(kind(1.d0)), intent(in) :: blck(:,:)
integer,intent(out) :: info
integer, optional, intent(in) :: iblck,jblck
integer, optional, intent(in) :: dupl
end subroutine psb_dins
! 2-D double precision square version
subroutine psb_dinsvm(m, blck, x, ix, jx, desc_a,info,&
& iblck,dupl)
use psb_descriptor_type
integer, intent(in) :: m
type(psb_desc_type), intent(in) :: desc_a
real(kind(1.d0)),pointer :: x(:,:)
integer, intent(in) :: ix,jx
real(kind(1.d0)), intent(in) :: blck(:)
integer, intent(out) :: info
integer, optional, intent(in) :: iblck
integer, optional, intent(in) :: dupl
end subroutine psb_dinsvm
! 1-D double precision version
subroutine psb_dinsvv(m, blck, x, ix, desc_a, info,&
& iblck,insflag,dupl)
use psb_descriptor_type
integer, intent(in) :: m
type(psb_desc_type), intent(in) :: desc_a
real(kind(1.d0)),pointer :: x(:)
integer, intent(in) :: ix
real(kind(1.d0)), intent(in) :: blck(:)
integer, intent(out) :: info
integer, optional, intent(in) :: iblck
integer, optional, intent(in) :: insflag
integer, optional, intent(in) :: dupl
end subroutine psb_dinsvv
! 2-D double precision version
subroutine psb_dinsi(m,irw,val, x,desc_a,info,dupl)
use psb_descriptor_type
@ -350,46 +310,6 @@ Module psb_tools_mod
integer, intent(out) :: info
integer, optional, intent(in) :: dupl
end subroutine psb_dinsvi
! 2-D integer version
subroutine psb_iins(m, n, blck, x, ix, jx, desc_a, info,&
& iblck, jblck,dupl)
use psb_descriptor_type
integer, intent(in) :: m,n
type(psb_desc_type), intent(in) :: desc_a
integer,pointer :: x(:,:)
integer, intent(in) :: ix,jx
integer, intent(in) :: blck(:,:)
integer,intent(out) :: info
integer, optional, intent(in) :: iblck,jblck
integer, optional, intent(in) :: dupl
end subroutine psb_iins
! 2-D integer square version
subroutine psb_iinsvm(m, blck, x, ix, jx, desc_a,info,&
& iblck,dupl)
use psb_descriptor_type
integer, intent(in) :: m
type(psb_desc_type), intent(in) :: desc_a
integer, pointer :: x(:,:)
integer, intent(in) :: ix,jx
integer, intent(in) :: blck(:)
integer, intent(out) :: info
integer, optional, intent(in) :: iblck
integer, optional, intent(in) :: dupl
end subroutine psb_iinsvm
! 1-D integer version
subroutine psb_iinsvv(m, blck, x, ix, desc_a, info,&
& iblck,insflag,dupl)
use psb_descriptor_type
integer, intent(in) :: m
type(psb_desc_type), intent(in) :: desc_a
integer, pointer :: x(:)
integer, intent(in) :: ix
integer, intent(in) :: blck(:)
integer, intent(out) :: info
integer, optional, intent(in) :: iblck
integer, optional, intent(in) :: insflag
integer, optional, intent(in) :: dupl
end subroutine psb_iinsvv
! 2-D double precision version
subroutine psb_iinsi(m,irw,val, x,desc_a,info,dupl)
use psb_descriptor_type
@ -413,46 +333,6 @@ Module psb_tools_mod
integer, optional, intent(in) :: dupl
end subroutine psb_iinsvi
! 2-D double precision version
subroutine psb_zins(m, n, blck, x, ix, jx, desc_a, info,&
& iblck, jblck,dupl)
use psb_descriptor_type
integer, intent(in) :: m,n
type(psb_desc_type), intent(in) :: desc_a
complex(kind(1.d0)),pointer :: x(:,:)
integer, intent(in) :: ix,jx
complex(kind(1.d0)), intent(in) :: blck(:,:)
integer,intent(out) :: info
integer, optional, intent(in) :: iblck,jblck
integer, optional, intent(in) :: dupl
end subroutine psb_zins
! 2-D double precision square version
subroutine psb_zinsvm(m, blck, x, ix, jx, desc_a,info,&
& iblck,dupl)
use psb_descriptor_type
integer, intent(in) :: m
type(psb_desc_type), intent(in) :: desc_a
complex(kind(1.d0)),pointer :: x(:,:)
integer, intent(in) :: ix,jx
complex(kind(1.d0)), intent(in) :: blck(:)
integer, intent(out) :: info
integer, optional, intent(in) :: iblck
integer, optional, intent(in) :: dupl
end subroutine psb_zinsvm
! 1-D double precision version
subroutine psb_zinsvv(m, blck, x, ix, desc_a, info,&
& iblck,insflag,dupl)
use psb_descriptor_type
integer, intent(in) :: m
type(psb_desc_type), intent(in) :: desc_a
complex(kind(1.d0)),pointer :: x(:)
integer, intent(in) :: ix
complex(kind(1.d0)), intent(in) :: blck(:)
integer, intent(out) :: info
integer, optional, intent(in) :: iblck
integer, optional, intent(in) :: insflag
integer, optional, intent(in) :: dupl
end subroutine psb_zinsvv
! 2-D double precision version
subroutine psb_zinsi(m,irw,val, x, desc_a,info,dupl)
use psb_descriptor_type
integer, intent(in) :: m

695
src/tools/psb_dins.f90
Unescape Escape View File

@ -28,689 +28,17 @@
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
! File: psb_dins.f90
!
! Subroutine: psb_dins
! Subroutine: psb_dinsvi
! Insert dense submatrix to dense matrix.
!
! Parameters:
! m - integer. Rows number of submatrix belonging to blck to be inserted.
! n - integer. Cols number of submatrix belonging to blck to be inserted.
! x - real, pointer, dimension(:,:). The destination dense matrix.
! ix - integer. x global-row corresponding to position at which blck submatrix must be inserted.
! jx - integer. x global-col corresponding to position at which blck submatrix must be inserted.
! blck - real, pointer, dimension(:,:). The source dense submatrix.
! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code
! iblck - integer(optional). First row of submatrix belonging to blck to be inserted.
! jblck - integer(optional). First col of submatrix belonging to blck to be inserted.
subroutine psb_dins(m, n, blck, x, ix, jx, desc_a, info,&
& iblck, jblck,dupl)
!....insert dense submatrix to dense matrix .....
use psb_descriptor_type
use psb_const_mod
use psb_error_mod
implicit none
!....parameters...
integer, intent(in) :: m,n
type(psb_desc_type), intent(in) :: desc_a
real(kind(1.d0)),pointer :: x(:,:)
integer, intent(in) :: ix,jx
real(kind(1.d0)), intent(in) :: blck(:,:)
integer,intent(out) :: info
integer, optional, intent(in) :: iblck,jblck
integer, optional, intent(in) :: dupl
!locals.....
integer :: icontxt,i,loc_row,glob_row,row,k,err_act,&
& nprocs,mode, loc_cols,col,iblock, jblock, mglob, int_err(5), err
integer :: nprow,npcol, me ,mypcol,dupl_
character :: temp_descra*11,temp_fida*5
character(len=20) :: name, char_err
if(psb_get_errstatus().ne.0) return
info=0
call psb_erractionsave(err_act)
name = 'psb_dins'
if (.not.associated(desc_a%glob_to_loc)) then
info=3110
call psb_errpush(info,name)
return
end if
if ((.not.associated(desc_a%matrix_data))) then
int_err(1)=3110
call psb_errpush(info,name)
return
end if
icontxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, me, mypcol)
if (nprow.eq.-1) then
info = 2010
call psb_errpush(info,name)
goto 9999
else if (npcol.ne.1) then
info = 2030
int_err(1) = npcol
call psb_errpush(info,name,int_err)
goto 9999
endif
!... check parameters....
if (m.lt.0) then
info = 10
int_err(1) = 1
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999
else if (n.lt.0) then
info = 10
int_err(1) = 2
int_err(2) = n
call psb_errpush(info,name,int_err)
goto 9999
else if (ix.lt.1) then
info = 20
int_err(1) = 6
int_err(2) = ix
call psb_errpush(info,name,int_err)
goto 9999
else if (jx.lt.1) then
info = 20
int_err(1) = 7
int_err(2) = jx
call psb_errpush(info,name,int_err)
goto 9999
else if (.not.psb_is_ok_dec(desc_a%matrix_data(psb_dec_type_))) then
info = 3110
int_err(1) = desc_a%matrix_data(psb_dec_type_)
call psb_errpush(info,name,int_err)
goto 9999
else if (size(x, dim=1).lt.desc_a%matrix_data(psb_n_row_)) then
info = 310
int_err(1) = 5
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999
else if (size(x, dim=2).lt.n) then
! check if dimension of x is greater than dimension of submatrix
! to insert
info = 320
int_err(1) = 2
int_err(2) = size(x, dim=2)
int_err(3) = n
call psb_errpush(info,name,int_err)
goto 9999
endif
loc_cols = desc_a%matrix_data(psb_n_col_)
mglob = desc_a%matrix_data(psb_m_)
if (present(iblck)) then
iblock = iblck
else
iblock = 1
endif
if (present(jblck)) then
jblock = jblck
else
jblock = 1
endif
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_ovwrt_
endif
select case(dupl_)
case(psb_dupl_ovwrt_)
do i = 1, m
!loop over all blck's rows
! row actual block row
glob_row=ix+i-1
if (glob_row > mglob) exit
loc_row=desc_a%glob_to_loc(glob_row)
if (loc_row.ge.1) then
! this row belongs to me
! copy i-th row of block blck in x
do col = 1, n
x(loc_row,jx+col-1) = blck(iblock+i-1,jblock+col-1)
enddo
end if
enddo
case(psb_dupl_add_)
do i = 1, m
!loop over all blck's rows
! row actual block row
glob_row=ix+i-1
if (glob_row > mglob) exit
loc_row=desc_a%glob_to_loc(glob_row)
if (loc_row.ge.1) then
! this row belongs to me
! copy i-th row of block blck in x
do col = 1, n
x(loc_row,jx+col-1) = x(loc_row,jx+col-1) + blck(iblock+i-1,jblock+col-1)
enddo
end if
enddo
case default
info = 321
call psb_errpush(info,name)
goto 9999
end select
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then
return
else
call psb_error(icontxt)
end if
return
end subroutine psb_dins
!!$
!!$ 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.
!!$
!!$
! Subroutine: psb_dinsvm
! Insert dense submatrix to dense matrix.
!
! Parameters:
! m - integer. Rows number of submatrix belonging to blck to be inserted.
! x - real, pointer, dimension(:,:). The destination dense matrix.
! ix - integer. x global-row corresponding to position at which blck submatrix must be inserted.
! jx - integer. x global-col corresponding to position at which blck submatrix must be inserted.
! blck - real, pointer, dimension(:,:). The source dense submatrix.
! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code
! iblck - integer(optional). First row of submatrix belonging to blck to be inserted.
subroutine psb_dinsvm(m, blck, x, ix, jx, desc_a,info,&
& iblck,dupl)
!....insert dense submatrix to dense matrix .....
use psb_descriptor_type
use psb_const_mod
use psb_error_mod
implicit none
! m rows number of submatrix belonging to blck to be inserted
! iblck first row of submatrix belonging to blck to be inserted
! ix x global-row corresponding to position at which blck submatrix
! must be inserted
! jx x global-col corresponding to position at which blck submatrix
! must be inserted
!....parameters...
integer, intent(in) :: m
type(psb_desc_type), intent(in) :: desc_a
real(kind(1.d0)),pointer :: x(:,:)
integer, intent(in) :: ix,jx
real(kind(1.d0)), intent(in) :: blck(:)
integer, intent(out) :: info
integer, optional, intent(in) :: iblck
integer, optional, intent(in) :: dupl
!locals.....
integer :: icontxt,i,loc_row,glob_row,loc_cols,mglob,err_act, int_err(5),err
integer :: nprow,npcol, me ,mypcol, iblock, dupl_
character(len=20) :: name, char_err
if(psb_get_errstatus().ne.0) return
info=0
call psb_erractionsave(err_act)
name = 'psb_dinsvm'
if (.not.associated(desc_a%glob_to_loc)) then
info=3110
call psb_errpush(info,name)
return
end if
if ((.not.associated(desc_a%matrix_data))) then
int_err(1)=3110
call psb_errpush(info,name)
return
end if
icontxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, me, mypcol)
if (nprow.eq.-1) then
info = 2010
call psb_errpush(info,name)
goto 9999
else if (npcol.ne.1) then
info = 2030
int_err(1) = npcol
call psb_errpush(info,name,int_err)
goto 9999
endif
!... check parameters....
if (m.lt.0) then
info = 10
int_err(1) = 1
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999
else if (ix.lt.1) then
info = 20
int_err(1) = 6
int_err(2) = ix
call psb_errpush(info,name,int_err)
goto 9999
else if (jx.lt.1) then
info = 20
int_err(1) = 7
int_err(2) = jx
call psb_errpush(info,name,int_err)
goto 9999
else if (.not.psb_is_ok_dec(desc_a%matrix_data(psb_dec_type_))) then
info = 3110
int_err(1) = desc_a%matrix_data(psb_dec_type_)
call psb_errpush(info,name,int_err)
goto 9999
else if (size(x, dim=1).lt.desc_a%matrix_data(psb_n_row_)) then
info = 310
int_err(1) = 5
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999
else if (size(x, dim=2).lt.1) then
! check if dimension of x is greater than dimension of submatrix
! to insert
info = 320
int_err(1) = 2
int_err(2) = size(x, dim=2)
int_err(3) = 1
call psb_errpush(info,name,int_err)
goto 9999
endif
loc_cols=desc_a%matrix_data(psb_n_col_)
mglob = desc_a%matrix_data(psb_m_)
if (present(iblck)) then
iblock = iblck
else
iblock = 1
endif
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_ovwrt_
endif
select case(dupl_)
case(psb_dupl_ovwrt_)
do i = 1, m
!loop over all blck's rows
! row actual block row
glob_row=ix+i-1
if (glob_row > mglob) exit
loc_row=desc_a%glob_to_loc(glob_row)
if (loc_row.ge.1) then
! this row belongs to me
! copy i-th row of block blck in x
x(loc_row,jx) = blck(iblock+i-1)
end if
enddo
case(psb_dupl_add_)
do i = 1, m
!loop over all blck's rows
! row actual block row
glob_row=ix+i-1
if (glob_row > mglob) exit
loc_row=desc_a%glob_to_loc(glob_row)
if (loc_row.ge.1) then
! this row belongs to me
! copy i-th row of block blck in x
x(loc_row,jx) = x(loc_row,jx) + blck(iblock+i-1)
end if
enddo
case default
info = 321
call psb_errpush(info,name)
goto 9999
end select
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then
return
else
call psb_error(icontxt)
end if
return
end subroutine psb_dinsvm
!!$
!!$ 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.
!!$
!!$
! Subroutine: psb_dinsvv
! Insert dense submatrix to dense matrix.
!
! Parameters:
! m - integer. Rows number of submatrix belonging to blck to be inserted.
! x - real, pointer, dimension(:). The destination dense matrix.
! ix - integer. x global-row corresponding to position at which blck submatrix must be inserted.
! blck - real, pointer, dimension(:). The source dense submatrix.
! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code
! iblck - integer(optional). First row of submatrix belonging to blck to be inserted.
! insflag - integer(optional). ???
subroutine psb_dinsvv(m, blck, x, ix, desc_a, info,&
& iblck,insflag,dupl)
!....insert dense submatrix to dense matrix .....
use psb_descriptor_type
use psb_const_mod
use psb_error_mod
implicit none
! m rows number of submatrix belonging to blck to be inserted
! iblck first row of submatrix belonging to blck to be inserted
! ix x global-row corresponding to position at which blck submatrix
! must be inserted
!....parameters...
integer, intent(in) :: m
type(psb_desc_type), intent(in) :: desc_a
real(kind(1.d0)),pointer :: x(:)
integer, intent(in) :: ix
real(kind(1.d0)), intent(in) :: blck(:)
integer, intent(out) :: info
integer, optional, intent(in) :: iblck
integer, optional, intent(in) :: insflag
integer, optional, intent(in) :: dupl
!locals.....
integer :: icontxt,i,loc_row,glob_row,row,k,&
& loc_rows,loc_cols,iblock, liflag,mglob,err_act, int_err(5), err
integer :: nprow,npcol, me ,mypcol,dupl_
character(len=20) :: name, char_err
if(psb_get_errstatus().ne.0) return
info=0
call psb_erractionsave(err_act)
name = 'psb_dinsvv'
if (.not.associated(desc_a%glob_to_loc)) then
info=3110
call psb_errpush(info,name)
return
end if
if ((.not.associated(desc_a%matrix_data))) then
int_err(1)=3110
call psb_errpush(info,name)
return
end if
icontxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, me, mypcol)
if (nprow.eq.-1) then
info = 2010
call psb_errpush(info,name)
goto 9999
else if (npcol.ne.1) then
info = 2030
int_err(1) = npcol
call psb_errpush(info,name,int_err)
goto 9999
endif
!... check parameters....
if (m.lt.0) then
info = 10
int_err(1) = 1
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999
else if (ix.lt.1) then
info = 20
int_err(1) = 6
int_err(2) = ix
call psb_errpush(info,name,int_err)
goto 9999
else if (.not.psb_is_ok_dec(desc_a%matrix_data(psb_dec_type_))) then
info = 3110
int_err(1) = desc_a%matrix_data(psb_dec_type_)
call psb_errpush(info,name,int_err)
goto 9999
else if (size(x, dim=1).lt.desc_a%matrix_data(psb_n_row_)) then
info = 310
int_err(1) = 5
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999
endif
loc_rows=desc_a%matrix_data(psb_n_row_)
loc_cols=desc_a%matrix_data(psb_n_col_)
mglob = desc_a%matrix_data(psb_m_)
if (present(iblck)) then
iblock = iblck
else
iblock = 1
endif
if (present(insflag)) then
liflag = insflag
else
liflag = psb_upd_glbnum_
end if
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_ovwrt_
endif
select case(dupl_)
case(psb_dupl_ovwrt_)
if (liflag == psb_upd_glbnum_) then
do i = 1, m
!loop over all blck's rows
! row actual block row
glob_row=ix+i-1
if (glob_row > mglob) exit
loc_row=desc_a%glob_to_loc(glob_row)
if (loc_row.ge.1) then
! this row belongs to me
! copy i-th row of block blck in x
x(loc_row) = blck(iblock+i-1)
end if
enddo
else if (liflag == psb_upd_locnum_) then
k = min(ix+m-1,loc_rows)
do i=ix,k
x(i) = blck(i-ix+1)
enddo
else
info=-1
call psb_errpush(info,name)
goto 9999
endif
case(psb_dupl_add_)
if (liflag == psb_upd_glbnum_) then
do i = 1, m
!loop over all blck's rows
! row actual block row
glob_row=ix+i-1
if (glob_row > mglob) exit
loc_row=desc_a%glob_to_loc(glob_row)
if (loc_row.ge.1) then
! this row belongs to me
! copy i-th row of block blck in x
x(loc_row) = x(loc_row) + blck(iblock+i-1)
end if
enddo
else if (liflag == psb_upd_locnum_) then
k = min(ix+m-1,loc_rows)
do i=ix,k
x(i) = x(i) + blck(i-ix+1)
enddo
else
info=-1
call psb_errpush(info,name)
goto 9999
endif
case default
info = 321
call psb_errpush(info,name)
goto 9999
end select
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then
return
else
call psb_error(icontxt)
end if
return
end subroutine psb_dinsvv
!!$
!!$ 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.
!!$
!!$
! Subroutine: psb_dinsvv
! Insert dense submatrix to dense matrix.
!
! Parameters:
! m - integer. Rows number of submatrix belonging to blck to be inserted.
! x - real, pointer, dimension(:). The destination dense matrix.
! m - integer. Number of rows of submatrix belonging to
! val to be inserted.
! irw - integer(:) Row indices of rows of val (global numbering)
! val - real, pointer, dimension(:). The source dense submatrix.
! x - real, pointer, dimension(:). The destination dense matrix.
! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code
! iblck - integer(optional). First row of submatrix belonging to blck to be inserted.
! insflag - integer(optional). ???
subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl)
!....insert dense submatrix to dense matrix .....
use psb_descriptor_type
@ -888,17 +216,16 @@ end subroutine psb_dinsvi
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
! Subroutine: psb_dinsvv
! Insert dense submatrix to dense matrix.
! Subroutine: psb_dinsi
!
! Parameters:
! m - integer. Rows number of submatrix belonging to val to be inserted.
! x - real, pointer, dimension(:). The destination dense matrix.
! ix - integer. x global-row corresponding to position at which val submatrix must be inserted.
! val - real, pointer, dimension(:). The source dense submatrix.
! m - integer. Number of rows of submatrix belonging to
! val to be inserted.
! irw - integer(:) Row indices of rows of val (global numbering)
! val - real, pointer, dimension(:,:). The source dense submatrix.
! x - real, pointer, dimension(:,:). The destination dense matrix.
! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code
! insflag - integer(optional). ???
subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl)
!....insert dense submatrix to dense matrix .....
use psb_descriptor_type

596
src/tools/psb_iins.f90
Unescape Escape View File

@ -28,586 +28,15 @@
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
! File: psb_iins.f90
!
! Subroutine: psb_iins
! Insert dense integer submatrix to dense integer matrix.
!
! Parameters:
! m - integer. Rows number of submatrix belonging to blck to be inserted.
! n - integer. Cols number of submatrix belonging to blck to be inserted.
! x - integer, pointer, dimension(:,:). The destination dense matrix.
! ix - integer. x global-row corresponding to position at which blck submatrix must be inserted.
! jx - integer. x global-col corresponding to position at which blck submatrix must be inserted.
! blck - integer, pointer, dimension(:,:). The source dense submatrix.
! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code
! iblck - integer(optional). First row of submatrix belonging to blck to be inserted.
! jblck - integer(optional). First col of submatrix belonging to blck to be inserted.
subroutine psb_iins(m, n, blck, x, ix, jx, desc_a, info,&
& iblck, jblck,dupl)
!....insert dense submatrix to dense matrix .....
use psb_descriptor_type
use psb_const_mod
use psb_error_mod
implicit none
!....parameters...
integer, intent(in) :: m,n
type(psb_desc_type), intent(in) :: desc_a
integer, pointer :: x(:,:)
integer, intent(in) :: ix,jx
integer, intent(in) :: blck(:,:)
integer, intent(out) :: info
integer, optional, intent(in) :: iblck,jblck
integer, optional, intent(in) :: dupl
!locals.....
integer :: icontxt,i,loc_row,glob_row,&
& loc_cols,col,iblock, jblock, mglob,dupl_
integer :: nprow,npcol, myrow ,mycol, int_err(5),err_act
character(len=20) :: name, ch_err
if(psb_get_errstatus().ne.0) return
info=0
call psb_erractionsave(err_act)
name = 'psb_iins'
if ((.not.associated(desc_a%matrix_data))) then
info=3110
call psb_errpush(info, name)
return
end if
icontxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
if (nprow.eq.-1) then
info = 2010
call psb_errpush(info,name)
goto 9999
else if (npcol.ne.1) then
info = 2030
int_err(1) = npcol
call psb_errpush(info,name,int_err)
goto 9999
endif
if (.not.associated(desc_a%glob_to_loc)) then
info=3110
call psb_errpush(info,name,int_err)
goto 9999
end if
!... check parameters....
if (m.lt.0) then
info = 10
int_err(1) = 1
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999
else if (n.lt.0) then
info = 10
int_err(1) = 2
int_err(2) = n
call psb_errpush(info,name,int_err)
goto 9999
else if (ix.lt.1) then
info = 20
int_err(1) = 6
int_err(2) = ix
call psb_errpush(info,name,int_err)
goto 9999
else if (jx.lt.1) then
info = 20
int_err(1) = 7
int_err(2) = jx
call psb_errpush(info,name,int_err)
goto 9999
else if (.not.psb_is_ok_dec(desc_a%matrix_data(psb_dec_type_))) then
info = 3110
int_err(1) = desc_a%matrix_data(psb_dec_type_)
call psb_errpush(info,name,int_err)
goto 9999
else if (size(x, dim=1).lt.desc_a%matrix_data(psb_n_row_)) then
info = 310
int_err(1) = 5
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999
else if (size(x, dim=2).lt.n) then
! check if dimension of x is greater than dimension of submatrix
! to insert
info = 320
int_err(1) = 2
int_err(2) = size(x, dim=2)
int_err(3) = n
call psb_errpush(info,name,int_err)
goto 9999
endif
loc_cols = desc_a%matrix_data(psb_n_col_)
mglob = desc_a%matrix_data(psb_m_)
if (present(iblck)) then
iblock = iblck
else
iblock = 1
endif
if (present(jblck)) then
jblock = jblck
else
jblock = 1
endif
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_ovwrt_
endif
select case(dupl_)
case(psb_dupl_ovwrt_)
do i = 1, m
!loop over all blck's rows
! row actual block row
glob_row=ix+i-1
if (glob_row > mglob) exit
loc_row=desc_a%glob_to_loc(glob_row)
if (loc_row.ge.1) then
! this row belongs to me
! copy i-th row of block blck in x
do col = 1, n
x(loc_row,jx+col-1) = blck(iblock+i-1,jblock+col-1)
enddo
end if
enddo
case(psb_dupl_add_)
do i = 1, m
!loop over all blck's rows
! row actual block row
glob_row=ix+i-1
if (glob_row > mglob) exit
loc_row=desc_a%glob_to_loc(glob_row)
if (loc_row.ge.1) then
! this row belongs to me
! copy i-th row of block blck in x
do col = 1, n
x(loc_row,jx+col-1) = x(loc_row,jx+col-1) + blck(iblock+i-1,jblock+col-1)
enddo
end if
enddo
case default
info = 321
call psb_errpush(info,name)
goto 9999
end select
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
return
end if
return
end subroutine psb_iins
!!$
!!$ 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.
!!$
!!$
! Subroutine: psb_iinsvm
! Insert dense integer submatrix to dense integer matrix.
!
! Parameters:
! m - integer. Rows number of submatrix belonging to blck to be inserted.
! x - integer, pointer, dimension(:,:). The destination dense matrix.
! ix - integer. x global-row corresponding to position at which blck submatrix must be inserted.
! jx - integer. x global-col corresponding to position at which blck submatrix must be inserted.
! blck - integer, pointer, dimension(:,:). The source dense submatrix.
! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code
! iblck - integer(optional). First row of submatrix belonging to blck to be inserted.
subroutine psb_iinsvm(m, blck, x, ix, jx, desc_a, info,&
& iblck,dupl)
!....insert dense submatrix to dense matrix .....
use psb_descriptor_type
use psb_const_mod
use psb_error_mod
implicit none
! m rows number of submatrix belonging to blck to be inserted
! iblck first row of submatrix belonging to blck to be inserted
! ix x global-row corresponding to position at which blck submatrix
! must be inserted
! jx x global-col corresponding to position at which blck submatrix
! must be inserted
!....parameters...
integer, intent(in) :: m
type(psb_desc_type), intent(in) :: desc_a
integer, pointer :: x(:,:)
integer, intent(in) :: ix,jx
integer, intent(in) :: blck(:)
integer, intent(out) :: info
integer, optional, intent(in) :: iblck
integer, optional, intent(in) :: dupl
!locals.....
integer :: icontxt,i,loc_row,glob_row,&
& loc_cols,iblock, jblock,mglob, err_act, int_err(5)
integer :: nprow,npcol, myrow ,mycol,dupl_
character(len=20) :: name, ch_err
if(psb_get_errstatus().ne.0) return
info=0
name = 'psb_iinsvm'
call psb_erractionsave(err_act)
loc_cols=desc_a%matrix_data(psb_n_col_)
mglob = desc_a%matrix_data(psb_m_)
if (present(iblck)) then
iblock = iblck
else
iblock = 1
endif
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_ovwrt_
endif
select case(dupl_)
case(psb_dupl_ovwrt_)
do i = 1, m
!loop over all blck's rows
! row actual block row
glob_row=ix+i-1
if (glob_row > mglob) exit
loc_row=desc_a%glob_to_loc(glob_row)
if (loc_row.ge.1) then
! this row belongs to me
! copy i-th row of block blck in x
x(loc_row,jx) = blck(iblock+i-1)
end if
enddo
case(psb_dupl_add_)
do i = 1, m
!loop over all blck's rows
! row actual block row
glob_row=ix+i-1
if (glob_row > mglob) exit
loc_row=desc_a%glob_to_loc(glob_row)
if (loc_row.ge.1) then
! this row belongs to me
! copy i-th row of block blck in x
x(loc_row,jx) = x(loc_row,jx) + blck(iblock+i-1)
end if
enddo
case default
info = 321
call psb_errpush(info,name)
goto 9999
end select
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
return
end if
return
end subroutine psb_iinsvm
!!$
!!$ 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.
!!$
!!$
! Subroutine: psb_iinsvv
! Insert dense integer submatrix to dense integer matrix.
!
! Parameters:
! m - integer. Rows number of submatrix belonging to blck to be inserted.
! x - integer, pointer, dimension(:,:). The destination dense matrix.
! ix - integer. x global-row corresponding to position at which blck submatrix must be inserted.
! blck - integer, pointer, dimension(:,:). The source dense submatrix.
! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code
! iblck - integer(optional). First row of submatrix belonging to blck to be inserted.
subroutine psb_iinsvv(m, blck, x, ix, desc_a, info,&
& iblck,dupl)
!....insert dense submatrix to dense matrix .....
use psb_descriptor_type
use psb_const_mod
use psb_error_mod
implicit none
! m rows number of submatrix belonging to blck to be inserted
! iblck first row of submatrix belonging to blck to be inserted
! ix x global-row corresponding to position at which blck submatrix
! must be inserted
!....parameters...
integer, intent(in) :: m
type(psb_desc_type), intent(in) :: desc_a
integer, pointer :: x(:)
integer, intent(in) :: ix
integer, intent(in) :: blck(:)
integer, intent(out) :: info
integer, optional, intent(in) :: iblck
integer, optional, intent(in) :: dupl
!locals.....
integer :: icontxt,i,loc_row,glob_row,k,&
& loc_rows,loc_cols,col,iblock, jblock, mglob, err_act, int_err(5)
integer :: nprow,npcol, myrow ,mycol,dupl_
character(len=20) :: name, ch_err
if(psb_get_errstatus().ne.0) return
info=0
name = 'psb_iinsvv'
call psb_erractionsave(err_act)
if ((.not.associated(desc_a%matrix_data))) then
info=3110
call psb_errpush(info,name)
return
end if
icontxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
if (nprow.eq.-1) then
info = 2010
call psb_errpush(info,name)
goto 9999
else if (npcol.ne.1) then
info = 2030
int_err(1) = npcol
call psb_errpush(info,name,int_err)
goto 9999
endif
if (.not.associated(desc_a%glob_to_loc)) then
info=3110
call psb_errpush(info,name)
goto 9999
end if
!... check parameters....
if (m.lt.0) then
info = 10
int_err(1) = 1
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999
else if (ix.lt.1) then
info = 20
int_err(1) = 6
int_err(2) = ix
call psb_errpush(info,name,int_err)
goto 9999
else if (.not.psb_is_ok_dec(desc_a%matrix_data(psb_dec_type_))) then
info = 3110
int_err(1) = desc_a%matrix_data(psb_dec_type_)
call psb_errpush(info,name,int_err)
goto 9999
else if (size(x, dim=1).lt.desc_a%matrix_data(psb_n_row_)) then
info = 310
int_err(1) = 5
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999
endif
loc_rows=desc_a%matrix_data(psb_n_row_)
loc_cols=desc_a%matrix_data(psb_n_col_)
mglob = desc_a%matrix_data(psb_m_)
if (present(iblck)) then
iblock = iblck
else
iblock = 1
endif
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_ovwrt_
endif
select case(dupl_)
case(psb_dupl_ovwrt_)
do i = 1, m
!loop over all blck's rows
! row actual block row
glob_row=ix+i-1
if (glob_row > mglob) exit
loc_row=desc_a%glob_to_loc(glob_row)
if (loc_row.ge.1) then
! this row belongs to me
! copy i-th row of block blck in x
x(loc_row) = blck(iblock+i-1)
end if
enddo
case(psb_dupl_add_)
do i = 1, m
!loop over all blck's rows
! row actual block row
glob_row=ix+i-1
if (glob_row > mglob) exit
loc_row=desc_a%glob_to_loc(glob_row)
if (loc_row.ge.1) then
! this row belongs to me
! copy i-th row of block blck in x
x(loc_row) = x(loc_row) + blck(iblock+i-1)
end if
enddo
case default
info = 321
call psb_errpush(info,name)
goto 9999
end select
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
return
end if
return
end subroutine psb_iinsvv
!!$
!!$ 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.
!!$
!!$
! Subroutine: psb_dinsvv
! Subroutine: psb_iinsvi
! Insert dense submatrix to dense matrix.
!
! Parameters:
! m - integer. Rows number of submatrix belonging to val to be inserted.
! x - real, pointer, dimension(:). The destination dense matrix.
! ix - integer. x global-row corresponding to position at which val submatrix must be inserted.
! val - real, pointer, dimension(:). The source dense submatrix.
! m - integer. Number of rows of submatrix belonging to
! val to be inserted.
! irw - integer(:) Row indices of rows of val (global numbering)
! val - integer, dimension(:). The source dense submatrix.
! x - integer, pointer, dimension(:). The destination dense matrix.
! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code
subroutine psb_iinsvi(m, irw, val, x, desc_a, info, dupl)
@ -785,17 +214,16 @@ end subroutine psb_iinsvi
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
! Subroutine: psb_dinsvv
! Insert dense submatrix to dense matrix.
! Subroutine: psb_iinsi
!
! Parameters:
! m - integer. Rows number of submatrix belonging to val to be inserted.
! x - real, pointer, dimension(:). The destination dense matrix.
! ix - integer. x global-row corresponding to position at which val submatrix must be inserted.
! val - real, pointer, dimension(:). The source dense submatrix.
! m - integer. Number of rows of submatrix belonging to
! val to be inserted.
! irw - integer(:) Row indices of rows of val (global numbering)
! val - integer, dimension(:,:). The source dense submatrix.
! x - integer, pointer, dimension(:,:). The destination dense matrix.
! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code
! insflag - integer(optional). ???
subroutine psb_iinsi(m,irw, val, x, desc_a, info, dupl)
!....insert dense submatrix to dense matrix .....
use psb_descriptor_type

694
src/tools/psb_zins.f90
Unescape Escape View File

@ -1,230 +1,3 @@
!!$
!!$ 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.
!!$
!!$
! File: psb_zins.f90
!
! Subroutine: psb_zins
! Insert dense submatrix to dense matrix.
!
! Parameters:
! m - integer. Rows number of submatrix belonging to blck to be inserted.
! n - integer. Cols number of submatrix belonging to blck to be inserted.
! x - real, pointer, dimension(:,:). The destination dense matrix.
! ix - integer. x global-row corresponding to position at which blck submatrix must be inserted.
! jx - integer. x global-col corresponding to position at which blck submatrix must be inserted.
! blck - real, pointer, dimension(:,:). The source dense submatrix.
! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code
! iblck - integer(optional). First row of submatrix belonging to blck to be inserted.
! jblck - integer(optional). First col of submatrix belonging to blck to be inserted.
subroutine psb_zins(m, n, blck, x, ix, jx, desc_a, info,&
& iblck, jblck,dupl)
!....insert dense submatrix to dense matrix .....
use psb_descriptor_type
use psb_const_mod
use psb_error_mod
implicit none
!....parameters...
integer, intent(in) :: m,n
type(psb_desc_type), intent(in) :: desc_a
complex(kind(1.d0)),pointer :: x(:,:)
integer, intent(in) :: ix,jx
complex(kind(1.d0)), intent(in) :: blck(:,:)
integer,intent(out) :: info
integer, optional, intent(in) :: iblck,jblck
integer, optional, intent(in) :: dupl
!locals.....
integer :: icontxt,i,loc_row,glob_row,row,k,err_act,&
& nprocs,mode, loc_cols,col,iblock, jblock, mglob, int_err(5), err
integer :: nprow,npcol, me ,mypcol,dupl_
character :: temp_descra*11,temp_fida*5
character(len=20) :: name, char_err
if(psb_get_errstatus().ne.0) return
info=0
call psb_erractionsave(err_act)
name = 'psb_zins'
if (.not.associated(desc_a%glob_to_loc)) then
info=3110
call psb_errpush(info,name)
return
end if
if ((.not.associated(desc_a%matrix_data))) then
int_err(1)=3110
call psb_errpush(info,name)
return
end if
icontxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, me, mypcol)
if (nprow.eq.-1) then
info = 2010
call psb_errpush(info,name)
goto 9999
else if (npcol.ne.1) then
info = 2030
int_err(1) = npcol
call psb_errpush(info,name,int_err)
goto 9999
endif
!... check parameters....
if (m.lt.0) then
info = 10
int_err(1) = 1
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999
else if (n.lt.0) then
info = 10
int_err(1) = 2
int_err(2) = n
call psb_errpush(info,name,int_err)
goto 9999
else if (ix.lt.1) then
info = 20
int_err(1) = 6
int_err(2) = ix
call psb_errpush(info,name,int_err)
goto 9999
else if (jx.lt.1) then
info = 20
int_err(1) = 7
int_err(2) = jx
call psb_errpush(info,name,int_err)
goto 9999
else if (.not.psb_is_ok_dec(desc_a%matrix_data(psb_dec_type_))) then
info = 3110
int_err(1) = desc_a%matrix_data(psb_dec_type_)
call psb_errpush(info,name,int_err)
goto 9999
else if (size(x, dim=1).lt.desc_a%matrix_data(psb_n_row_)) then
info = 310
int_err(1) = 5
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999
else if (size(x, dim=2).lt.n) then
! check if dimension of x is greater than dimension of submatrix
! to insert
info = 320
int_err(1) = 2
int_err(2) = size(x, dim=2)
int_err(3) = n
call psb_errpush(info,name,int_err)
goto 9999
endif
loc_cols = desc_a%matrix_data(psb_n_col_)
mglob = desc_a%matrix_data(psb_m_)
if (present(iblck)) then
iblock = iblck
else
iblock = 1
endif
if (present(jblck)) then
jblock = jblck
else
jblock = 1
endif
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_ovwrt_
endif
select case(dupl_)
case(psb_dupl_ovwrt_)
do i = 1, m
!loop over all blck's rows
! row actual block row
glob_row=ix+i-1
if (glob_row > mglob) exit
loc_row=desc_a%glob_to_loc(glob_row)
if (loc_row.ge.1) then
! this row belongs to me
! copy i-th row of block blck in x
do col = 1, n
x(loc_row,jx+col-1) = blck(iblock+i-1,jblock+col-1)
enddo
end if
enddo
case(psb_dupl_add_)
do i = 1, m
!loop over all blck's rows
! row actual block row
glob_row=ix+i-1
if (glob_row > mglob) exit
loc_row=desc_a%glob_to_loc(glob_row)
if (loc_row.ge.1) then
! this row belongs to me
! copy i-th row of block blck in x
do col = 1, n
x(loc_row,jx+col-1) = x(loc_row,jx+col-1) + blck(iblock+i-1,jblock+col-1)
enddo
end if
enddo
case default
info = 321
call psb_errpush(info,name)
goto 9999
end select
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then
return
else
call psb_error(icontxt)
end if
return
end subroutine psb_zins
!!$
!!$ Parallel Sparse BLAS v2.0
@ -256,458 +29,15 @@ end subroutine psb_zins
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
! Subroutine: psb_zinsvm
! Subroutine: psb_zinsvi
! Insert dense submatrix to dense matrix.
!
! Parameters:
! m - integer. Rows number of submatrix belonging to blck to be inserted.
! x - real, pointer, dimension(:,:). The destination dense matrix.
! ix - integer. x global-row corresponding to position at which blck submatrix must be inserted.
! jx - integer. x global-col corresponding to position at which blck submatrix must be inserted.
! blck - real, pointer, dimension(:,:). The source dense submatrix.
! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code
! iblck - integer(optional). First row of submatrix belonging to blck to be inserted.
subroutine psb_zinsvm(m, blck, x, ix, jx, desc_a,info,&
& iblck,dupl)
!....insert dense submatrix to dense matrix .....
use psb_descriptor_type
use psb_const_mod
use psb_error_mod
implicit none
! m rows number of submatrix belonging to blck to be inserted
! iblck first row of submatrix belonging to blck to be inserted
! ix x global-row corresponding to position at which blck submatrix
! must be inserted
! jx x global-col corresponding to position at which blck submatrix
! must be inserted
!....parameters...
integer, intent(in) :: m
type(psb_desc_type), intent(in) :: desc_a
complex(kind(1.d0)),pointer :: x(:,:)
integer, intent(in) :: ix,jx
complex(kind(1.d0)), intent(in) :: blck(:)
integer, intent(out) :: info
integer, optional, intent(in) :: iblck
integer, optional, intent(in) :: dupl
!locals.....
integer :: icontxt,i,loc_row,glob_row,loc_cols,mglob,err_act, int_err(5),err
integer :: nprow,npcol, me ,mypcol, iblock,dupl_
character(len=20) :: name, char_err
if(psb_get_errstatus().ne.0) return
info=0
call psb_erractionsave(err_act)
name = 'psb_zinsvm'
if (.not.associated(desc_a%glob_to_loc)) then
info=3110
call psb_errpush(info,name)
return
end if
if ((.not.associated(desc_a%matrix_data))) then
int_err(1)=3110
call psb_errpush(info,name)
return
end if
icontxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, me, mypcol)
if (nprow.eq.-1) then
info = 2010
call psb_errpush(info,name)
goto 9999
else if (npcol.ne.1) then
info = 2030
int_err(1) = npcol
call psb_errpush(info,name,int_err)
goto 9999
endif
!... check parameters....
if (m.lt.0) then
info = 10
int_err(1) = 1
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999
else if (ix.lt.1) then
info = 20
int_err(1) = 6
int_err(2) = ix
call psb_errpush(info,name,int_err)
goto 9999
else if (jx.lt.1) then
info = 20
int_err(1) = 7
int_err(2) = jx
call psb_errpush(info,name,int_err)
goto 9999
else if (.not.psb_is_ok_dec(desc_a%matrix_data(psb_dec_type_))) then
info = 3110
int_err(1) = desc_a%matrix_data(psb_dec_type_)
call psb_errpush(info,name,int_err)
goto 9999
else if (size(x, dim=1).lt.desc_a%matrix_data(psb_n_row_)) then
info = 310
int_err(1) = 5
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999
else if (size(x, dim=2).lt.1) then
! check if dimension of x is greater than dimension of submatrix
! to insert
info = 320
int_err(1) = 2
int_err(2) = size(x, dim=2)
int_err(3) = 1
call psb_errpush(info,name,int_err)
goto 9999
endif
loc_cols=desc_a%matrix_data(psb_n_col_)
mglob = desc_a%matrix_data(psb_m_)
if (present(iblck)) then
iblock = iblck
else
iblock = 1
endif
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_ovwrt_
endif
select case(dupl_)
case(psb_dupl_ovwrt_)
do i = 1, m
!loop over all blck's rows
! row actual block row
glob_row=ix+i-1
if (glob_row > mglob) exit
loc_row=desc_a%glob_to_loc(glob_row)
if (loc_row.ge.1) then
! this row belongs to me
! copy i-th row of block blck in x
x(loc_row,jx) = blck(iblock+i-1)
end if
enddo
case(psb_dupl_add_)
do i = 1, m
!loop over all blck's rows
! row actual block row
glob_row=ix+i-1
if (glob_row > mglob) exit
loc_row=desc_a%glob_to_loc(glob_row)
if (loc_row.ge.1) then
! this row belongs to me
! copy i-th row of block blck in x
x(loc_row,jx) = x(loc_row,jx) + blck(iblock+i-1)
end if
enddo
case default
info = 321
call psb_errpush(info,name)
goto 9999
end select
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then
return
else
call psb_error(icontxt)
end if
return
end subroutine psb_zinsvm
!!$
!!$ 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.
!!$
!!$
! Subroutine: psb_zinsvv
! Insert dense submatrix to dense matrix.
!
! Parameters:
! m - integer. Rows number of submatrix belonging to blck to be inserted.
! x - real, pointer, dimension(:). The destination dense matrix.
! ix - integer. x global-row corresponding to position at which blck submatrix must be inserted.
! blck - real, pointer, dimension(:). The source dense submatrix.
! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code
! iblck - integer(optional). First row of submatrix belonging to blck to be inserted.
! insflag - integer(optional). ???
subroutine psb_zinsvv(m, blck, x, ix, desc_a, info,&
& iblck,insflag,dupl)
!....insert dense submatrix to dense matrix .....
use psb_descriptor_type
use psb_const_mod
use psb_error_mod
implicit none
! m rows number of submatrix belonging to blck to be inserted
! iblck first row of submatrix belonging to blck to be inserted
! ix x global-row corresponding to position at which blck submatrix
! must be inserted
!....parameters...
integer, intent(in) :: m
type(psb_desc_type), intent(in) :: desc_a
complex(kind(1.d0)),pointer :: x(:)
integer, intent(in) :: ix
complex(kind(1.d0)), intent(in) :: blck(:)
integer, intent(out) :: info
integer, optional, intent(in) :: iblck
integer, optional, intent(in) :: insflag
integer, optional, intent(in) :: dupl
!locals.....
integer :: icontxt,i,loc_row,glob_row,row,k,&
& loc_rows,loc_cols,iblock, liflag,mglob,err_act, int_err(5), err
integer :: nprow,npcol, me ,mypcol,dupl_
character(len=20) :: name, char_err
if(psb_get_errstatus().ne.0) return
info=0
call psb_erractionsave(err_act)
name = 'psb_zinsvv'
if (.not.associated(desc_a%glob_to_loc)) then
info=3110
call psb_errpush(info,name)
return
end if
if ((.not.associated(desc_a%matrix_data))) then
int_err(1)=3110
call psb_errpush(info,name)
return
end if
icontxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, me, mypcol)
if (nprow.eq.-1) then
info = 2010
call psb_errpush(info,name)
goto 9999
else if (npcol.ne.1) then
info = 2030
int_err(1) = npcol
call psb_errpush(info,name,int_err)
goto 9999
endif
!... check parameters....
if (m.lt.0) then
info = 10
int_err(1) = 1
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999
else if (ix.lt.1) then
info = 20
int_err(1) = 6
int_err(2) = ix
call psb_errpush(info,name,int_err)
goto 9999
else if (.not.psb_is_ok_dec(desc_a%matrix_data(psb_dec_type_))) then
info = 3110
int_err(1) = desc_a%matrix_data(psb_dec_type_)
call psb_errpush(info,name,int_err)
goto 9999
else if (size(x, dim=1).lt.desc_a%matrix_data(psb_n_row_)) then
info = 310
int_err(1) = 5
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999
endif
loc_rows=desc_a%matrix_data(psb_n_row_)
loc_cols=desc_a%matrix_data(psb_n_col_)
mglob = desc_a%matrix_data(psb_m_)
if (present(iblck)) then
iblock = iblck
else
iblock = 1
endif
if (present(insflag)) then
liflag = insflag
else
liflag = psb_upd_glbnum_
end if
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_ovwrt_
endif
select case(dupl_)
case(psb_dupl_ovwrt_)
if (liflag == psb_upd_glbnum_) then
do i = 1, m
!loop over all blck's rows
! row actual block row
glob_row=ix+i-1
if (glob_row > mglob) exit
loc_row=desc_a%glob_to_loc(glob_row)
if (loc_row.ge.1) then
! this row belongs to me
! copy i-th row of block blck in x
x(loc_row) = blck(iblock+i-1)
end if
enddo
else if (liflag == psb_upd_locnum_) then
k = min(ix+m-1,loc_rows)
do i=ix,k
x(i) = blck(i-ix+1)
enddo
else
info=-1
call psb_errpush(info,name)
goto 9999
endif
case(psb_dupl_add_)
if (liflag == psb_upd_glbnum_) then
do i = 1, m
!loop over all blck's rows
! row actual block row
glob_row=ix+i-1
if (glob_row > mglob) exit
loc_row=desc_a%glob_to_loc(glob_row)
if (loc_row.ge.1) then
! this row belongs to me
! copy i-th row of block blck in x
x(loc_row) = x(loc_row) + blck(iblock+i-1)
end if
enddo
else if (liflag == psb_upd_locnum_) then
k = min(ix+m-1,loc_rows)
do i=ix,k
x(i) = x(i) + blck(i-ix+1)
enddo
else
info=-1
call psb_errpush(info,name)
goto 9999
endif
case default
info = 321
call psb_errpush(info,name)
goto 9999
end select
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then
return
else
call psb_error(icontxt)
end if
return
end subroutine psb_zinsvv
!!$
!!$ 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.
!!$
!!$
! Subroutine: psb_dinsvv
! Insert dense submatrix to dense matrix.
!
! Parameters:
! m - integer. Rows number of submatrix belonging to val to be inserted.
! x - real, pointer, dimension(:). The destination dense matrix.
! ix - integer. x global-row corresponding to position at which val submatrix must be inserted.
! val - real, pointer, dimension(:). The source dense submatrix.
! m - integer. Number of rows of submatrix belonging to
! val to be inserted.
! irw - integer(:) Row indices of rows of val (global numbering)
! val - complex, dimension(:). The source dense submatrix.
! x - complex, pointer, dimension(:). The destination dense matrix.
! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code
subroutine psb_zinsvi(m, irw, val, x, desc_a, info, dupl)
@ -886,14 +216,14 @@ end subroutine psb_zinsvi
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
! Subroutine: psb_dinsvv
! Insert dense submatrix to dense matrix.
! Subroutine: psb_zinsi
!
! Parameters:
! m - integer. Rows number of submatrix belonging to val to be inserted.
! x - real, pointer, dimension(:). The destination dense matrix.
! ix - integer. x global-row corresponding to position at which val submatrix must be inserted.
! val - real, pointer, dimension(:). The source dense submatrix.
! m - integer. Number of rows of submatrix belonging to
! val to be inserted.
! irw - integer(:) Row indices of rows of val (global numbering)
! val - complex, dimension(:,:). The source dense submatrix.
! x - complex, pointer, dimension(:,:). The destination dense matrix.
! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code
subroutine psb_zinsi(m,irw, val, x, desc_a, info, dupl)

Write Preview
Loading…
Cancel
Save