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

Fix SERIAL test subdir

Browse Source
newG2L
Salvatore Filippone 4 years ago
parent 23c9a71ed6
commit 716a1a6513
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_coo_sparse_mat) :: acoo
type(psb_d_csr_sparse_mat) :: acsr type(psb_d_csr_sparse_mat) :: acsr
real(psb_dpk_) :: zt(nb),x,y,z 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_) :: ix,iy,iz,ia,indx_owner
integer(psb_ipk_) :: np, iam, nr, nt integer(psb_ipk_) :: np, iam, nr, nt
integer(psb_ipk_) :: icoeff integer(psb_ipk_) :: icoeff
integer(psb_ipk_), allocatable :: irow(:),icol(:),myidx(:) integer(psb_lpk_), allocatable :: irow(:),icol(:),myidx(:)
real(psb_dpk_), allocatable :: val(:) real(psb_dpk_), allocatable :: val(:)
! deltah dimension of each grid cell ! deltah dimension of each grid cell
! deltat discretization time ! 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_error_mod
use psb_realloc_mod use psb_realloc_mod
use psb_d_xyz_mat_mod, psb_protect_name => psb_d_xyz_csput_a 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 class(psb_d_xyz_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: val(:) real(psb_dpk_), intent(in) :: val(:)
integer(psb_ipk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: gtl(:)
integer(psb_ipk_) :: err_act 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 else if (a%is_upd()) then
call psb_d_xyz_srch_upd(nz,ia,ja,val,a,& 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 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 contains
subroutine psb_d_xyz_srch_upd(nz,ia,ja,val,a,& 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_const_mod
use psb_realloc_mod use psb_realloc_mod
@ -2342,7 +2341,6 @@ contains
integer(psb_ipk_), intent(in) :: ia(:),ja(:) integer(psb_ipk_), intent(in) :: ia(:),ja(:)
real(psb_dpk_), intent(in) :: val(:) real(psb_dpk_), intent(in) :: val(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: gtl(:)
integer(psb_ipk_) :: i,ir,ic, ilr, ilc, ip, & integer(psb_ipk_) :: i,ir,ic, ilr, ilc, ip, &
& i1,i2,nr,nc,nnz,dupl,ng & i1,i2,nr,nc,nnz,dupl,ng
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
@ -2365,161 +2363,76 @@ contains
nr = a%get_nrows() nr = a%get_nrows()
nc = a%get_ncols() 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_) select case(dupl)
! Add case(psb_dupl_ovwrt_,psb_dupl_err_)
ilr = -1 ! Overwrite.
ilc = -1 ! Cannot test for error, should have been caught earlier.
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 ilr = -1
end do ilc = -1
do i=1, nz
ir = ia(i)
ic = ja(i)
case default if ((ir > 0).and.(ir <= nr)) then
info = -3
if (debug_level >= psb_debug_serial_) &
& write(debug_unit,*) trim(name),&
& ': Duplicate handling: ',dupl
end select
else i1 = a%irp(ir)
i2 = a%irp(ir+1)
select case(dupl) nc=i2-i1
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
ip = psb_bsrch(ic,nc,a%ja(i1:i2-1))
if (ip>0) then
a%val(i1+ip-1) = val(i)
else else
if (debug_level >= psb_debug_serial_) & if (debug_level >= psb_debug_serial_) &
& write(debug_unit,*) trim(name),& & 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 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_) end do
! Add
ilr = -1 case(psb_dupl_add_)
ilc = -1 ! Add
do i=1, nz ilr = -1
ir = ia(i) ilc = -1
ic = ja(i) do i=1, nz
if ((ir > 0).and.(ir <= nr)) then ir = ia(i)
i1 = a%irp(ir) ic = ja(i)
i2 = a%irp(ir+1) if ((ir > 0).and.(ir <= nr)) then
nc = i2-i1 i1 = a%irp(ir)
ip = psb_ibsrch(ic,nc,a%ja(i1:i2-1)) i2 = a%irp(ir+1)
if (ip>0) then nc = i2-i1
a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) ip = psb_bsrch(ic,nc,a%ja(i1:i2-1))
else if (ip>0) then
info = i a%val(i1+ip-1) = a%val(i1+ip-1) + val(i)
return
end if
else else
if (debug_level >= psb_debug_serial_) & info = i
& write(debug_unit,*) trim(name),& return
& ': Discarding row that does not belong to us.'
end if 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 case default
info = -3 info = -3
if (debug_level >= psb_debug_serial_) & if (debug_level >= psb_debug_serial_) &
& write(debug_unit,*) trim(name),& & write(debug_unit,*) trim(name),&
& ': Duplicate handling: ',dupl & ': Duplicate handling: ',dupl
end select end select
end if
end subroutine psb_d_xyz_srch_upd 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 integer(psb_ipk_), intent(in) :: iout
class(psb_d_xyz_sparse_mat), intent(in) :: a 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 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_) :: err_act
integer(psb_ipk_) :: ierr(5) 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 !! \see psb_d_base_mat_mod::psb_d_base_print
interface interface
subroutine psb_d_xyz_print(iout,a,iv,head,ivr,ivc) 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 integer(psb_ipk_), intent(in) :: iout
class(psb_d_xyz_sparse_mat), intent(in) :: a 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 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 subroutine psb_d_xyz_print
end interface end interface
@ -281,14 +281,13 @@ module psb_d_xyz_mat_mod
!> \memberof psb_d_xyz_sparse_mat !> \memberof psb_d_xyz_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_csput !! \see psb_d_base_mat_mod::psb_d_base_csput
interface 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_ import :: psb_ipk_, psb_d_xyz_sparse_mat, psb_dpk_
class(psb_d_xyz_sparse_mat), intent(inout) :: a class(psb_d_xyz_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: val(:) real(psb_dpk_), intent(in) :: val(:)
integer(psb_ipk_), intent(in) :: nz,ia(:), ja(:),& integer(psb_ipk_), intent(in) :: nz,ia(:), ja(:),&
& imin,imax,jmin,jmax & imin,imax,jmin,jmax
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: gtl(:)
end subroutine psb_d_xyz_csput_a end subroutine psb_d_xyz_csput_a
end interface end interface

Write Preview
Loading…
Cancel
Save