psblas2-typext:

Merged fixes for empty local rows from trunk.

base/internals/psi_bld_tmphalo.f90

@@ -81,7 +81,6 @@ subroutine psi_bld_tmphalo(desc,info)
     goto 9999
   endif
 
-
   if (.not.(psb_is_bld_desc(desc).and.psb_is_large_desc(desc))) then 
     info = 1122
     call psb_errpush(info,name)
@@ -100,9 +99,11 @@ subroutine psi_bld_tmphalo(desc,info)
   do i=1, nh
     helem(i) = n_row+i ! desc%loc_to_glob(n_row+i)
   end do
-  call psb_map_l2g(helem,desc%idxmap,info)
+
+  call psb_map_l2g(helem(1:nh),desc%idxmap,info)
   if (info == 0) &
        & call psi_fnd_owner(nh,helem,hproc,desc,info)
+
   if (info /= 0) then 
     call psb_errpush(4010,name,a_err='fnd_owner')
     goto 9999      
@@ -112,6 +113,7 @@ subroutine psi_bld_tmphalo(desc,info)
     call psb_errpush(4010,name,a_err='nh > size(hproc)')
     goto 9999      
   end if
+
   allocate(tmphl((3*((n_col-n_row)+1)+1)),stat=info)
   if (info /= 0) then 
     call psb_errpush(4010,name,a_err='Allocate')

base/internals/psi_fnd_owner.F90

@@ -74,7 +74,7 @@ subroutine psi_fnd_owner(nv,idx,iprc,desc,info)
   integer             :: i,n_row,n_col,err_act,ih,icomm,hsize,ip,isz,k,j,&
        & last_ih, last_j
   integer             :: ictxt,np,me
-  logical, parameter  :: gettime=.false.
+  logical, parameter  :: gettime=.true.
   real(psb_dpk_)      :: t0, t1, t2, t3, t4, tamx, tidx
   character(len=20)   :: name
 
@@ -90,6 +90,7 @@ subroutine psi_fnd_owner(nv,idx,iprc,desc,info)
 
   ! check on blacs grid 
   call psb_info(ictxt, me, np)
+
   if (np == -1) then
     info = 2010
     call psb_errpush(info,name)
@@ -121,6 +122,7 @@ subroutine psi_fnd_owner(nv,idx,iprc,desc,info)
     call psb_errpush(4010,name,a_err='Allocate') 
     goto 9999      
   end if
+
   hsz       = 0
   hsz(me+1) = nv
   call psb_amx(ictxt,hsz,info)
@@ -151,10 +153,12 @@ subroutine psi_fnd_owner(nv,idx,iprc,desc,info)
   if (gettime) then 
     t3 = psb_wtime()
   end if
+
   call psi_idx_cnv(hsize,hproc,helem,desc,info,owned=.true.)
   if (gettime) then 
     tidx = psb_wtime()-t3
   end if
+  if (info == 140) info = 0
   if (info /= 0) then 
     call psb_errpush(4010,name,a_err='psi_idx_cnv')
     goto 9999      
@@ -179,6 +183,7 @@ subroutine psi_fnd_owner(nv,idx,iprc,desc,info)
   if (gettime) then 
     t3 = psb_wtime()
   end if
+
   ! Collect all the answers with alltoallv (need sizes) 
   call mpi_alltoall(sdsz,1,mpi_integer,rvsz,1,mpi_integer,icomm,info)
 

base/modules/psb_desc_type.f90

@@ -1222,6 +1222,7 @@ contains
     integer :: nc, i, ix
 
     info = 0
+    if (size(idx)==0) return
     if (.not.allocated(map%loc_to_glob)) then 
       info = 140
       idx = -1 
@@ -1248,6 +1249,7 @@ contains
     integer :: nc, i, ix
 
     info = 0
+    if (size(idx)==0) return
     if ((.not.allocated(map%loc_to_glob)).or.&
          & (size(gidx)<size(idx))) then 
       info = 140
@@ -1268,7 +1270,6 @@ contains
     
   end subroutine psb_map_l2g_v2
 
-
   Subroutine psb_cd_get_recv_idx(tmp,desc,data,info,toglob)
 
     use psb_error_mod

base/tools/psb_cd_inloc.f90

@@ -283,7 +283,7 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck)
   ! allocate work vector
   if (islarge) then 
     allocate(desc%matrix_data(psb_mdata_size_),&
-         &temp_ovrlap(2*loc_row),desc%lprm(1),&
+         &temp_ovrlap(max(1,2*loc_row)),desc%lprm(1),&
          & stat=info)
     if (info == 0) then 
       desc%lprm(1)        = 0   
@@ -292,7 +292,7 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck)
     end if
   else
     allocate(desc%idxmap%glob_to_loc(m),desc%matrix_data(psb_mdata_size_),&
-         &temp_ovrlap(2*loc_row),desc%lprm(1),&
+         &temp_ovrlap(max(1,2*loc_row)),desc%lprm(1),&
          & stat=info)
     if (info == 0) then 
       desc%lprm(1)        = 0   

base/tools/psb_cdals.f90

@@ -129,14 +129,14 @@ subroutine psb_cdals(m, n, parts, ictxt, desc, info)
   ! allocate work vector
   if (psb_cd_choose_large_state(ictxt,m)) then 
     allocate(desc%matrix_data(psb_mdata_size_),&
-         & temp_ovrlap(2*loc_row),prc_v(np),stat=info)
+         & temp_ovrlap(max(1,2*loc_row)),prc_v(np),stat=info)
     if (info == 0) then 
       desc%matrix_data(:) = 0
       desc%idxmap%state = psb_desc_large_
     end if
   else
     allocate(desc%idxmap%glob_to_loc(m),desc%matrix_data(psb_mdata_size_),&
-         & temp_ovrlap(2*loc_row),prc_v(np),stat=info)
+         & temp_ovrlap(max(1,2*loc_row)),prc_v(np),stat=info)
     if (info == 0) then 
       desc%matrix_data(:) = 0
       desc%idxmap%state = psb_desc_normal_

base/tools/psb_cdalv.f90

@@ -140,14 +140,14 @@ subroutine psb_cdalv(v, ictxt, desc, info, flag)
   ! allocate work vector
   if (psb_cd_choose_large_state(ictxt,m)) then 
     allocate(desc%matrix_data(psb_mdata_size_),&
-         &temp_ovrlap(2*loc_row),stat=info)
+         &temp_ovrlap(max(1,2*loc_row)),stat=info)
     if (info == 0) then 
       desc%matrix_data(:) = 0
       desc%idxmap%state = psb_desc_large_
     end if
   else
     allocate(desc%idxmap%glob_to_loc(m),desc%matrix_data(psb_mdata_size_),&
-         &temp_ovrlap(2*loc_row),stat=info)
+         &temp_ovrlap(max(1,2*loc_row)),stat=info)
     if (info == 0) then 
       desc%matrix_data(:) = 0
       desc%idxmap%state = psb_desc_normal_

test/pargen/ppde.f90

@@ -389,7 +389,7 @@ contains
     ! Using a simple BLOCK distribution.
     !
     nt = (m+np-1)/np
-    nr = min(nt,m-(iam*nt))
+    nr = max(0,min(nt,m-(iam*nt)))
 
     nt = nr
     call psb_sum(ictxt,nt) 

test/pargen/spde.f90

@@ -387,7 +387,7 @@ contains
     ! Using a simple BLOCK distribution.
     !
     nt = (m+np-1)/np
-    nr = min(nt,m-(iam*nt))
+    nr = max(0,min(nt,m-(iam*nt)))
 
     nt = nr
     call psb_sum(ictxt,nt)