Merge branch 'development' into maint-3.7.0

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

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
@@ -2254,7 +2254,6 @@ subroutine psb_d_xyz_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
   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_) :: 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,90 +2363,6 @@ 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
-
-      case default
-        info = -3
-        if (debug_level >= psb_debug_serial_) &
-             & write(debug_unit,*) trim(name),&
-             & ': Duplicate handling: ',dupl
-      end select
-
-    else
 
     select case(dupl)
     case(psb_dupl_ovwrt_,psb_dupl_err_)
@@ -2467,7 +2381,7 @@ contains
           i2 = a%irp(ir+1)
           nc=i2-i1
 
-            ip = psb_ibsrch(ic,nc,a%ja(i1:i2-1))    
+          ip = psb_bsrch(ic,nc,a%ja(i1:i2-1))    
           if (ip>0) then 
             a%val(i1+ip-1) = val(i)
           else
@@ -2498,7 +2412,7 @@ contains
           i1 = a%irp(ir)
           i2 = a%irp(ir+1)
           nc = i2-i1
-            ip = psb_ibsrch(ic,nc,a%ja(i1:i2-1))
+          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
@@ -2519,7 +2433,6 @@ contains
            & ': 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)

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