From 716a1a65137851e13a8c27477b07d1463f28ef66 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Fri, 16 Apr 2021 09:17:21 +0200 Subject: [PATCH] Fix SERIAL test subdir --- test/serial/d_matgen.F90 | 5 +- test/serial/psb_d_xyz_impl.f90 | 211 +++++++++--------------------- test/serial/psb_d_xyz_mat_mod.f90 | 9 +- 3 files changed, 69 insertions(+), 156 deletions(-) diff --git a/test/serial/d_matgen.F90 b/test/serial/d_matgen.F90 index 5d6cd18e..5ee51a2e 100644 --- a/test/serial/d_matgen.F90 +++ b/test/serial/d_matgen.F90 @@ -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 diff --git a/test/serial/psb_d_xyz_impl.f90 b/test/serial/psb_d_xyz_impl.f90 index cf32ec60..8796a352 100644 --- a/test/serial/psb_d_xyz_impl.f90 +++ b/test/serial/psb_d_xyz_impl.f90 @@ -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 + select case(dupl) + case(psb_dupl_ovwrt_,psb_dupl_err_) + ! Overwrite. + ! Cannot test for error, should have been caught earlier. - end if - end do + ilr = -1 + ilc = -1 + do i=1, nz + ir = ia(i) + ic = ja(i) - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select + if ((ir > 0).and.(ir <= nr)) then - else - - 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) diff --git a/test/serial/psb_d_xyz_mat_mod.f90 b/test/serial/psb_d_xyz_mat_mod.f90 index 3ec9ef61..009ddab0 100644 --- a/test/serial/psb_d_xyz_mat_mod.f90 +++ b/test/serial/psb_d_xyz_mat_mod.f90 @@ -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