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

Merge branch 'development' into maint-3.7.0

Browse Source
maint-3.7.0
Salvatore Filippone 4 years ago
parent 448c1fa551 716a1a6513
commit 43fad98253
3 changed files with 69 additions and 156 deletions
Show Stats Download Patch File Download Diff File

5
test/serial/d_matgen.F90
Unescape Escape View File

@ -74,11 +74,12 @@ contains
type(psb_d_coo_sparse_mat) :: acoo
type(psb_d_csr_sparse_mat) :: acsr
real(psb_dpk_) :: zt(nb),x,y,z
integer(psb_ipk_) :: m,n,nnz,glob_row,nlr,i,ii,ib,k
integer(psb_lpk_) :: m,n,glob_row
integer(psb_ipk_) :: nnz,nlr,i,ii,ib,k
integer(psb_ipk_) :: ix,iy,iz,ia,indx_owner
integer(psb_ipk_) :: np, iam, nr, nt
integer(psb_ipk_) :: icoeff
integer(psb_ipk_), allocatable :: irow(:),icol(:),myidx(:)
integer(psb_lpk_), allocatable :: irow(:),icol(:),myidx(:)
real(psb_dpk_), allocatable :: val(:)
! deltah dimension of each grid cell
! deltat discretization time

211
test/serial/psb_d_xyz_impl.f90
Unescape Escape View File

@ -2244,7 +2244,7 @@ end subroutine psb_d_xyz_csgetblk
subroutine psb_d_xyz_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
subroutine psb_d_xyz_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info)
use psb_error_mod
use psb_realloc_mod
use psb_d_xyz_mat_mod, psb_protect_name => psb_d_xyz_csput_a
@ -2252,9 +2252,8 @@ subroutine psb_d_xyz_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
class(psb_d_xyz_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: val(:)
integer(psb_ipk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: gtl(:)
integer(psb_ipk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
@ -2303,7 +2302,7 @@ subroutine psb_d_xyz_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
else if (a%is_upd()) then
call psb_d_xyz_srch_upd(nz,ia,ja,val,a,&
& imin,imax,jmin,jmax,info,gtl)
& imin,imax,jmin,jmax,info)
if (info /= psb_success_) then
@ -2329,7 +2328,7 @@ subroutine psb_d_xyz_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
contains
subroutine psb_d_xyz_srch_upd(nz,ia,ja,val,a,&
& imin,imax,jmin,jmax,info,gtl)
& imin,imax,jmin,jmax,info)
use psb_const_mod
use psb_realloc_mod
@ -2342,7 +2341,6 @@ contains
integer(psb_ipk_), intent(in) :: ia(:),ja(:)
real(psb_dpk_), intent(in) :: val(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: gtl(:)
integer(psb_ipk_) :: i,ir,ic, ilr, ilc, ip, &
& i1,i2,nr,nc,nnz,dupl,ng
integer(psb_ipk_) :: debug_level, debug_unit
@ -2365,161 +2363,76 @@ contains
nr = a%get_nrows()
nc = a%get_ncols()
if (present(gtl)) then
ng = size(gtl)
select case(dupl)
case(psb_dupl_ovwrt_,psb_dupl_err_)
! Overwrite.
! Cannot test for error, should have been caught earlier.
ilr = -1
ilc = -1
do i=1, nz
ir = ia(i)
ic = ja(i)
if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then
ir = gtl(ir)
ic = gtl(ic)
if ((ir > 0).and.(ir <= nr)) then
i1 = a%irp(ir)
i2 = a%irp(ir+1)
nc=i2-i1
ip = psb_ibsrch(ic,nc,a%ja(i1:i2-1))
if (ip>0) then
a%val(i1+ip-1) = val(i)
else
if (debug_level >= psb_debug_serial_) &
& write(debug_unit,*) trim(name),&
& ': Was searching ',ic,' in: ',i1,i2,&
& ' : ',a%ja(i1:i2-1)
info = i
return
end if
else
if (debug_level >= psb_debug_serial_) &
& write(debug_unit,*) trim(name),&
& ': Discarding row that does not belong to us.'
end if
end if
end do
case(psb_dupl_add_)
! Add
ilr = -1
ilc = -1
do i=1, nz
ir = ia(i)
ic = ja(i)
if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then
ir = gtl(ir)
ic = gtl(ic)
if ((ir > 0).and.(ir <= nr)) then
i1 = a%irp(ir)
i2 = a%irp(ir+1)
nc = i2-i1
ip = psb_ibsrch(ic,nc,a%ja(i1:i2-1))
if (ip>0) then
a%val(i1+ip-1) = a%val(i1+ip-1) + val(i)
else
if (debug_level >= psb_debug_serial_) &
& write(debug_unit,*) trim(name),&
& ': Was searching ',ic,' in: ',i1,i2,&
& ' : ',a%ja(i1:i2-1)
info = i
return
end if
else
if (debug_level >= psb_debug_serial_) &
& write(debug_unit,*) trim(name),&
& ': Discarding row that does not belong to us.'
end if
end if
end do
select case(dupl)
case(psb_dupl_ovwrt_,psb_dupl_err_)
! Overwrite.
! Cannot test for error, should have been caught earlier.
case default
info = -3
if (debug_level >= psb_debug_serial_) &
& write(debug_unit,*) trim(name),&
& ': Duplicate handling: ',dupl
end select
ilr = -1
ilc = -1
do i=1, nz
ir = ia(i)
ic = ja(i)
else
if ((ir > 0).and.(ir <= nr)) then
select case(dupl)
case(psb_dupl_ovwrt_,psb_dupl_err_)
! Overwrite.
! Cannot test for error, should have been caught earlier.
ilr = -1
ilc = -1
do i=1, nz
ir = ia(i)
ic = ja(i)
if ((ir > 0).and.(ir <= nr)) then
i1 = a%irp(ir)
i2 = a%irp(ir+1)
nc=i2-i1
ip = psb_ibsrch(ic,nc,a%ja(i1:i2-1))
if (ip>0) then
a%val(i1+ip-1) = val(i)
else
if (debug_level >= psb_debug_serial_) &
& write(debug_unit,*) trim(name),&
& ': Was searching ',ic,' in: ',i1,i2,&
& ' : ',a%ja(i1:i2-1)
info = i
return
end if
i1 = a%irp(ir)
i2 = a%irp(ir+1)
nc=i2-i1
ip = psb_bsrch(ic,nc,a%ja(i1:i2-1))
if (ip>0) then
a%val(i1+ip-1) = val(i)
else
if (debug_level >= psb_debug_serial_) &
& write(debug_unit,*) trim(name),&
& ': Discarding row that does not belong to us.'
& ': Was searching ',ic,' in: ',i1,i2,&
& ' : ',a%ja(i1:i2-1)
info = i
return
end if
end do
else
if (debug_level >= psb_debug_serial_) &
& write(debug_unit,*) trim(name),&
& ': Discarding row that does not belong to us.'
end if
case(psb_dupl_add_)
! Add
ilr = -1
ilc = -1
do i=1, nz
ir = ia(i)
ic = ja(i)
if ((ir > 0).and.(ir <= nr)) then
i1 = a%irp(ir)
i2 = a%irp(ir+1)
nc = i2-i1
ip = psb_ibsrch(ic,nc,a%ja(i1:i2-1))
if (ip>0) then
a%val(i1+ip-1) = a%val(i1+ip-1) + val(i)
else
info = i
return
end if
end do
case(psb_dupl_add_)
! Add
ilr = -1
ilc = -1
do i=1, nz
ir = ia(i)
ic = ja(i)
if ((ir > 0).and.(ir <= nr)) then
i1 = a%irp(ir)
i2 = a%irp(ir+1)
nc = i2-i1
ip = psb_bsrch(ic,nc,a%ja(i1:i2-1))
if (ip>0) then
a%val(i1+ip-1) = a%val(i1+ip-1) + val(i)
else
if (debug_level >= psb_debug_serial_) &
& write(debug_unit,*) trim(name),&
& ': Discarding row that does not belong to us.'
info = i
return
end if
end do
else
if (debug_level >= psb_debug_serial_) &
& write(debug_unit,*) trim(name),&
& ': Discarding row that does not belong to us.'
end if
end do
case default
info = -3
if (debug_level >= psb_debug_serial_) &
& write(debug_unit,*) trim(name),&
& ': Duplicate handling: ',dupl
end select
case default
info = -3
if (debug_level >= psb_debug_serial_) &
& write(debug_unit,*) trim(name),&
& ': Duplicate handling: ',dupl
end select
end if
end subroutine psb_d_xyz_srch_upd
@ -2606,9 +2519,9 @@ subroutine psb_d_xyz_print(iout,a,iv,head,ivr,ivc)
integer(psb_ipk_), intent(in) :: iout
class(psb_d_xyz_sparse_mat), intent(in) :: a
integer(psb_ipk_), intent(in), optional :: iv(:)
integer(psb_lpk_), intent(in), optional :: iv(:)
character(len=*), optional :: head
integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:)
integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:)
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5)

9
test/serial/psb_d_xyz_mat_mod.f90
Unescape Escape View File

@ -160,12 +160,12 @@ module psb_d_xyz_mat_mod
!! \see psb_d_base_mat_mod::psb_d_base_print
interface
subroutine psb_d_xyz_print(iout,a,iv,head,ivr,ivc)
import :: psb_ipk_, psb_d_xyz_sparse_mat
import :: psb_ipk_, psb_d_xyz_sparse_mat, psb_lpk_
integer(psb_ipk_), intent(in) :: iout
class(psb_d_xyz_sparse_mat), intent(in) :: a
integer(psb_ipk_), intent(in), optional :: iv(:)
integer(psb_lpk_), intent(in), optional :: iv(:)
character(len=*), optional :: head
integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:)
integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:)
end subroutine psb_d_xyz_print
end interface
@ -281,14 +281,13 @@ module psb_d_xyz_mat_mod
!> \memberof psb_d_xyz_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_csput
interface
subroutine psb_d_xyz_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
subroutine psb_d_xyz_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info)
import :: psb_ipk_, psb_d_xyz_sparse_mat, psb_dpk_
class(psb_d_xyz_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: val(:)
integer(psb_ipk_), intent(in) :: nz,ia(:), ja(:),&
& imin,imax,jmin,jmax
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: gtl(:)
end subroutine psb_d_xyz_csput_a
end interface

Write Preview
Loading…
Cancel
Save