fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-18 11:52:11 +00:00
Code Issues Packages Projects Releases Wiki Activity

Fixed interface to GEINS to make it look more consistent with SPINS.

Browse Source
This commit is contained in:
Salvatore Filippone
2006-04-26 12:00:12 +00:00
parent 05ac599969
commit 936c761233
8 changed files with 5656 additions and 4544 deletions
Download Patch File Download Diff File Expand all files Collapse all files
docs/pdf/toolsrout.tex
+8 -15
View File
@@ -564,31 +564,24 @@ Specified as: Integer scalar.
%
\subroutine{psb\_geins}{Dense matrix insertion routine}
\syntax{call psb\_geins}{m, n, blck, x, ix, jx, desc\_a, info,dupl}
\syntax*{call psb\_geins}{m, blck, x, ix, desc\_a, info,dupl}
\syntax{call psb\_geins}{m, irw, val, x, desc\_a, info,dupl}
\begin{description}
\item[\bf On Entry]
\item[m] rows number of submatrix belonging to blck to be inserted..\\
\item[m] Number of rows in $val$ to be inserted.\\
Scope:{\bf local}.\\
Type:{\bf required}.\\
Specified as: an integer value.
\item[n] columns number of submatrix belonging to blck to be inserted
(only when $x$ is of rank 2).\\
\item[irw] Indices of the rows to be inserted. Specifically, row $i$
of $val$ will be inserted into the local row corresponding to the
global row index $irw(i)$.
Scope:{\bf local}.\\
Type:{\bf required}.\\
Specified as: an integer value.
\item[blck] the dense submatrix to be inserted.\\
Scope:{\bf local}.\\
Type:{\bf required}.\\
Specified as: a one or two dimensional array.
\item[ix] x global-row corresponding to position at which blck submatrix must be inserted.\\
Scope:{\bf local}.\\
Type:{\bf required}.\\
Specified as: an integer value.
\item[jx] x global-col corresponding to position at which blck submatrix must be inserted (only when $x$ is of rank 2).\\
Specified as: an integer array.
\item[val] the dense submatrix to be inserted.\\
Scope:{\bf local}.\\
Type:{\bf required}.\\
Specified as: a rank 1 or 2 array.
Specified as: an integer value.
\item[desc\_a] the communication descriptor.\\
Scope:{\bf local}.\\
docs/userguide.pdf
+4411 -4499
View File
File diff suppressed because it is too large Load Diff
src/modules/psb_tools_mod.f90
+66
View File
@@ -328,6 +328,28 @@ Module psb_tools_mod
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
integer, intent(in) :: m
type(psb_desc_type), intent(in) :: desc_a
real(kind(1.d0)),pointer :: x(:,:)
integer, intent(in) :: irw(:)
real(kind(1.d0)), intent(in) :: val(:,:)
integer, intent(out) :: info
integer, optional, intent(in) :: dupl
end subroutine psb_dinsi
! 1-D double precision version
subroutine psb_dinsvi(m,irw,val,x,desc_a,info,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) :: irw(:)
real(kind(1.d0)), intent(in) :: val(:)
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)
@@ -369,6 +391,28 @@ Module psb_tools_mod
integer, optional, intent(in) :: dupl
end subroutine psb_iinsvv
! 2-D double precision version
subroutine psb_iinsi(m,val,irw, x,desc_a,info,dupl)
use psb_descriptor_type
integer, intent(in) :: m
type(psb_desc_type), intent(in) :: desc_a
integer,pointer :: x(:,:)
integer, intent(in) :: irw(:)
integer, intent(in) :: val(:,:)
integer, intent(out) :: info
integer, optional, intent(in) :: dupl
end subroutine psb_iinsi
! 1-D double precision version
subroutine psb_iinsvi(m, val,irw, x,desc_a,info,dupl)
use psb_descriptor_type
integer, intent(in) :: m
type(psb_desc_type), intent(in) :: desc_a
integer,pointer :: x(:)
integer, intent(in) :: irw(:)
integer, intent(in) :: val(:)
integer, intent(out) :: info
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
@@ -408,6 +452,28 @@ Module psb_tools_mod
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
type(psb_desc_type), intent(in) :: desc_a
complex(kind(1.d0)),pointer :: x(:,:)
integer, intent(in) :: irw(:)
complex(kind(1.d0)), intent(in) :: val(:,:)
integer, intent(out) :: info
integer, optional, intent(in) :: dupl
end subroutine psb_zinsi
! 1-D double precision version
subroutine psb_zinsvi(m, irw,val, x,desc_a,info,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) :: irw(:)
complex(kind(1.d0)), intent(in) :: val(:)
integer, intent(out) :: info
integer, optional, intent(in) :: dupl
end subroutine psb_zinsvi
end interface
src/tools/psb_dins.f90
+384
View File
@@ -669,3 +669,387 @@ subroutine psb_dinsvv(m, blck, x, ix, desc_a, info,&
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.
! val - 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_dinsvi(m, irw, val, x, desc_a, info, 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 val to be inserted
! ix x global-row corresponding to position at which val submatrix
! must be inserted
!....parameters...
integer, intent(in) :: m
integer, intent(in) :: irw(:)
real(kind(1.d0)), intent(in) :: val(:)
real(kind(1.d0)),pointer :: x(:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
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_dinsvi'
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 (.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(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_ovwrt_
endif
select case(dupl_)
case(psb_dupl_ovwrt_)
do i = 1, m
!loop over all val's rows
! row actual block row
glob_row=irw(i)
if ((glob_row>0).and.(glob_row <= mglob)) then
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 val in x
x(loc_row) = val(i)
end if
end if
enddo
case(psb_dupl_add_)
do i = 1, m
!loop over all val's rows
! row actual block row
glob_row=irw(i)
if ((glob_row>0).and.(glob_row <= mglob)) then
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 val in x
x(loc_row) = x(loc_row) + val(i)
end if
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_dinsvi
!!$
!!$ 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.
! 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
use psb_const_mod
use psb_error_mod
implicit none
! m rows number of submatrix belonging to val to be inserted
! ival first row of submatrix belonging to val to be inserted
! ix x global-row corresponding to position at which val submatrix
! must be inserted
!....parameters...
integer, intent(in) :: m
integer, intent(in) :: irw(:)
real(kind(1.d0)), intent(in) :: val(:,:)
real(kind(1.d0)),pointer :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
integer, optional, intent(in) :: dupl
!locals.....
integer :: icontxt,i,loc_row,glob_row,row,k,j,n,&
& 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_dinsi'
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 (.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_)
n = min(size(val,2),size(x,2))
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 val's rows
! row actual block row
glob_row=irw(i)
if ((glob_row>0).and.(glob_row <= mglob)) then
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 val in x
do j=1,n
x(loc_row,j) = val(i,j)
end do
end if
end if
enddo
case(psb_dupl_add_)
do i = 1, m
!loop over all val's rows
! row actual block row
glob_row=irw(i)
if ((glob_row>0).and.(glob_row <= mglob)) then
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 val in x
do j=1,n
x(loc_row,j) = x(loc_row,j) + val(i,j)
end do
end if
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_dinsi
src/tools/psb_iins.f90
+378
View File
@@ -568,3 +568,381 @@ subroutine psb_iinsvv(m, blck, x, ix, desc_a, info,&
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
! 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.
! 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)
!....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 val to be inserted
! ix x global-row corresponding to position at which val submatrix
! must be inserted
!....parameters...
integer, intent(in) :: m
integer, intent(in) :: irw(:)
integer, intent(in) :: val(:)
integer,pointer :: x(:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
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 (.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(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_ovwrt_
endif
select case(dupl_)
case(psb_dupl_ovwrt_)
do i = 1, m
!loop over all val's rows
! row actual block row
glob_row=irw(i)
if ((glob_row>0).and.(glob_row <= mglob)) then
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 val in x
x(loc_row) = val(i)
end if
end if
enddo
case(psb_dupl_add_)
do i = 1, m
!loop over all val's rows
! row actual block row
glob_row=irw(i)
if ((glob_row>0).and.(glob_row <= mglob)) then
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 val in x
x(loc_row) = x(loc_row) + val(i)
end if
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_iinsvi
!!$
!!$ 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.
! 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
use psb_const_mod
use psb_error_mod
implicit none
! m rows number of submatrix belonging to val to be inserted
! ix x global-row corresponding to position at which val submatrix
! must be inserted
!....parameters...
integer, intent(in) :: m
integer, intent(in) :: irw(:)
integer, intent(in) :: val(:,:)
integer,pointer :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
integer, optional, intent(in) :: dupl
!locals.....
integer :: icontxt,i,loc_row,glob_row,row,k,j,n,&
& 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 (.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_)
n = min(size(val,2),size(x,2))
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 val's rows
! row actual block row
glob_row=irw(i)
if ((glob_row>0).and.(glob_row <= mglob)) then
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 val in x
do j=1,n
x(loc_row,j) = val(i,j)
end do
end if
end if
enddo
case(psb_dupl_add_)
do i = 1, m
!loop over all val's rows
! row actual block row
glob_row=irw(i)
if ((glob_row>0).and.(glob_row <= mglob)) then
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 val in x
do j=1,n
x(loc_row,j) = x(loc_row,j) + val(i,j)
end do
end if
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_iinsi
src/tools/psb_zins.f90
+379
View File
@@ -668,3 +668,382 @@ subroutine psb_zinsvv(m, blck, x, ix, desc_a, info,&
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.
! 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)
!....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 val to be inserted
! ix x global-row corresponding to position at which val submatrix
! must be inserted
!....parameters...
integer, intent(in) :: m
integer, intent(in) :: irw(:)
complex(kind(1.d0)), intent(in) :: val(:)
complex(kind(1.d0)),pointer :: x(:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
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 (.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(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_ovwrt_
endif
select case(dupl_)
case(psb_dupl_ovwrt_)
do i = 1, m
!loop over all val's rows
! row actual block row
glob_row=irw(i)
if ((glob_row>0).and.(glob_row <= mglob)) then
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 val in x
x(loc_row) = val(i)
end if
end if
enddo
case(psb_dupl_add_)
do i = 1, m
!loop over all val's rows
! row actual block row
glob_row=irw(i)
if ((glob_row>0).and.(glob_row <= mglob)) then
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 val in x
x(loc_row) = x(loc_row) + val(i)
end if
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_zinsvi
!!$
!!$ 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.
! 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)
!....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 val to be inserted
! ix x global-row corresponding to position at which val submatrix
! must be inserted
!....parameters...
integer, intent(in) :: m
integer, intent(in) :: irw(:)
complex(kind(1.d0)), intent(in) :: val(:,:)
complex(kind(1.d0)),pointer :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
integer, optional, intent(in) :: dupl
!locals.....
integer :: icontxt,i,loc_row,glob_row,row,k,j,n,&
& 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 (.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_)
n = min(size(val,2),size(x,2))
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 val's rows
! row actual block row
glob_row=irw(i)
if ((glob_row>0).and.(glob_row <= mglob)) then
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 val in x
do j=1,n
x(loc_row,j) = val(i,j)
end do
end if
end if
enddo
case(psb_dupl_add_)
do i = 1, m
!loop over all val's rows
! row actual block row
glob_row=irw(i)
if ((glob_row>0).and.(glob_row <= mglob)) then
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 val in x
do j=1,n
x(loc_row,j) = x(loc_row,j) + val(i,j)
end do
end if
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_zinsi
test/Fileread/mat_dist.f90
+28 -28
View File
@@ -40,7 +40,7 @@ contains
& b_glob, b, info, inroot,fmt)
!
! an utility subroutine to distribute a matrix among processors
! according to a user defined data distribution, using pessl
! according to a user defined data distribution, using
! sparse matrix subroutines.
!
! type(d_spmat) :: a_glob
@@ -272,8 +272,8 @@ contains
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_geins(nnr,b_glob(i_count:j_count-1),b,i_count,&
&desc_a,info)
call psb_geins(nnr,(/(i,i=i_count,j_count-1)/),&
& b_glob(i_count:j_count-1),b,desc_a,info)
if(info/=0) then
info=4010
ch_err='psb_ins'
@@ -318,8 +318,8 @@ contains
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_geins(nnr,b_glob(i_count:i_count+nnr-1),b,i_count,&
&desc_a,info)
call psb_geins(nnr,(/(i,i=i_count,i_count+nnr-1)/),&
& b_glob(i_count:i_count+nnr-1),b,desc_a,info)
if(info/=0) then
info=4010
ch_err='psdsins'
@@ -354,8 +354,8 @@ contains
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_geins(1,b_glob(i_count:i_count),b,i_count,&
&desc_a,info)
call psb_geins(1,(/i_count/),b_glob(i_count:i_count),&
& b,desc_a,info)
if(info/=0) then
info=4010
ch_err='psdsins'
@@ -385,8 +385,8 @@ contains
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_geins(1,b_glob(i_count:i_count),b,i_count,&
&desc_a,info)
call psb_geins(1,(/i_count/),b_glob(i_count:i_count),&
& b,desc_a,info)
if(info/=0) then
info=4010
ch_err='psdsins'
@@ -483,7 +483,7 @@ contains
& b_glob, b, info, inroot,fmt)
!
! an utility subroutine to distribute a matrix among processors
! according to a user defined data distribution, using pessl
! according to a user defined data distribution, using
! sparse matrix subroutines.
!
! type(d_spmat) :: a_glob
@@ -699,8 +699,8 @@ contains
goto 9999
end if
call psb_geins(nnr,b_glob(i_count:j_count-1),b,i_count,&
&desc_a,info)
call psb_geins(nnr,(/(i,i=i_count,j_count-1)/),b_glob(i_count:j_count-1),&
& b,desc_a,info)
if(info/=0) then
info=4010
ch_err='dsins'
@@ -745,8 +745,8 @@ contains
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_geins(nnr,b_glob(i_count:i_count+nnr-1),b,i_count,&
&desc_a,info)
call psb_geins(nnr,(/(i,i=i_count,i_count+nnr-1)/),&
& b_glob(i_count:i_count+nnr-1),b,desc_a,info)
if(info/=0) then
info=4010
ch_err='psdsins'
@@ -823,7 +823,7 @@ contains
& b_glob, b, info, inroot,fmt)
!
! an utility subroutine to distribute a matrix among processors
! according to a user defined data distribution, using pessl
! according to a user defined data distribution, using
! sparse matrix subroutines.
!
! type(d_spmat) :: a_glob
@@ -1055,8 +1055,8 @@ contains
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_geins(nnr,b_glob(i_count:j_count-1),b,i_count,&
&desc_a,info)
call psb_geins(nnr,(/(i,i=i_count,j_count-1)/),b_glob(i_count:j_count-1),&
& b,desc_a,info)
if(info/=0) then
info=4010
ch_err='psb_ins'
@@ -1101,8 +1101,8 @@ contains
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_geins(nnr,b_glob(i_count:i_count+nnr-1),b,i_count,&
&desc_a,info)
call psb_geins(nnr,(/(i,i=i_count,i_count+nnr-1)/),&
& b_glob(i_count:i_count+nnr-1),b,desc_a,info)
if(info/=0) then
info=4010
ch_err='psdsins'
@@ -1137,8 +1137,8 @@ contains
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_geins(1,b_glob(i_count:i_count),b,i_count,&
&desc_a,info)
call psb_geins(1,(/i_count/),b_glob(i_count:i_count),&
& b,desc_a,info)
if(info/=0) then
info=4010
ch_err='psdsins'
@@ -1168,8 +1168,8 @@ contains
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_geins(1,b_glob(i_count:i_count),b,i_count,&
&desc_a,info)
call psb_geins(1,(/i_count/),b_glob(i_count:i_count),&
& b,desc_a,info)
if(info/=0) then
info=4010
ch_err='psdsins'
@@ -1266,7 +1266,7 @@ contains
& b_glob, b, info, inroot,fmt)
!
! an utility subroutine to distribute a matrix among processors
! according to a user defined data distribution, using pessl
! according to a user defined data distribution, using
! sparse matrix subroutines.
!
! type(d_spmat) :: a_glob
@@ -1482,8 +1482,8 @@ contains
goto 9999
end if
call psb_geins(nnr,b_glob(i_count:j_count-1),b,i_count,&
&desc_a,info)
call psb_geins(nnr,(/(i,i=i_count,j_count-1)/),b_glob(i_count:j_count-1),&
& b,desc_a,info)
if(info/=0) then
info=4010
ch_err='dsins'
@@ -1528,8 +1528,8 @@ contains
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_geins(nnr,b_glob(i_count:i_count+nnr-1),b,i_count,&
&desc_a,info)
call psb_geins(nnr,(/(i,i=i_count,i_count+nnr-1)/),&
& b_glob(i_count:i_count+nnr-1),b,desc_a,info)
if(info/=0) then
info=4010
ch_err='psdsins'
test/pargen/ppde90.f90
+2 -2
View File
@@ -644,10 +644,10 @@ contains
call psb_spins(element-1,irow,icol,val,a,desc_a,info)
if(info.ne.0) exit
tins = tins + (mpi_wtime()-t3)
call psb_geins(1,zt(1:1),b,ia,desc_a,info)
call psb_geins(1,(/ia/),zt(1:1),b,desc_a,info)
if(info.ne.0) exit
zt(1)=0.d0
call psb_geins(1,zt(1:1),t,ia,desc_a,info)
call psb_geins(1,(/ia/),zt(1:1),t,desc_a,info)
if(info.ne.0) exit
end if
end do