New SCAN collective, only for SUM right now.

New arg in CDALL to force HASH over GEN_BLOCK

base/modules/psi_reduce_mod.F90

@@ -182,6 +182,14 @@ module psi_reduce_mod
   end interface
 #endif
 
+  interface psb_scan_sum
+    module procedure psb_iscan_sums
+  end interface psb_scan_sum
+
+  interface psb_exscan_sum
+    module procedure psb_iexscan_sums
+  end interface psb_exscan_sum
+
 
 contains 
 
@@ -5586,4 +5594,59 @@ contains
   end subroutine psb_d_nrm2v_ic
 
 #endif
+
+
+  ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  !  SCAN
+  !
+  ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  subroutine psb_iscan_sums(ictxt,dat)
+#ifdef MPI_MOD
+    use mpi
+#endif
+    implicit none 
+#ifdef MPI_H
+    include 'mpif.h'
+#endif
+    integer(psb_mpik_), intent(in)              :: ictxt
+    integer(psb_ipk_), intent(inout)  :: dat
+    integer(psb_ipk_) :: dat_
+    integer(psb_mpik_) :: iam, np, info
+    integer(psb_ipk_) :: iinfo
+
+
+#if !defined(SERIAL_MPI)
+    call psb_info(ictxt,iam,np)
+    call mpi_scan(dat,dat_,1,psb_mpi_ipk_integer,mpi_sum,ictxt,info)
+    dat = dat_
+#endif    
+  end subroutine psb_iscan_sums
+
+
+  subroutine psb_iexscan_sums(ictxt,dat)
+#ifdef MPI_MOD
+    use mpi
+#endif
+    implicit none 
+#ifdef MPI_H
+    include 'mpif.h'
+#endif
+    integer(psb_mpik_), intent(in)              :: ictxt
+    integer(psb_ipk_), intent(inout)  :: dat
+    integer(psb_ipk_) :: dat_
+    integer(psb_mpik_) :: iam, np, info
+    integer(psb_ipk_) :: iinfo
+
+
+#if !defined(SERIAL_MPI)
+    call psb_info(ictxt,iam,np)
+    call mpi_scan(dat,dat_,1,psb_mpi_ipk_integer,mpi_sum,ictxt,info)
+    dat = dat_
+#else
+    dat = 0
+#endif    
+  end subroutine psb_iexscan_sums
+
 end module psi_reduce_mod

base/tools/psb_cdall.f90

@@ -50,7 +50,7 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl,globalchec
   character(len=20)  :: name
   integer(psb_ipk_)  :: err_act, n_, flag_, i, me, np, nlp, nnv, lr
   logical            :: usehash_
-  integer(psb_ipk_), allocatable :: itmpsz(:) 
+  integer(psb_ipk_), allocatable :: itmpv(:), lvl(:) 
   integer(psb_mpik_) :: iictxt
  
   
@@ -136,35 +136,40 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl,globalchec
     else
       usehash_ = .false.
     end if
-    if (usehash_) then
-      write(0,*) 'Fix usehash_ implementationt '
-    end if
 
-    if (np == 1) then 
-      allocate(psb_repl_map      :: desc%indxmap, stat=info)
+    if (usehash_) then
+      nlp = nl
+      call psb_exscan_sum(ictxt,nlp)
+      lvl = [ (i,i=1,nl) ] + nlp
+      call psb_cd_inloc(lvl(1:nl),ictxt,desc,info, globalcheck=.false.)
+    
     else
-      allocate(psb_gen_block_map :: desc%indxmap, stat=info)
-    end if
-    if (info == psb_success_) then 
-      select type(aa => desc%indxmap) 
-      type is (psb_repl_map) 
-        call aa%repl_map_init(iictxt,nl,info)
-      type is (psb_gen_block_map) 
-        call aa%gen_block_map_init(iictxt,nl,info)
-      class default 
-        ! This cannot happen 
-        info = psb_err_internal_error_
-        goto 9999
-      end select
+      if (np == 1) then 
+        allocate(psb_repl_map      :: desc%indxmap, stat=info)
+      else
+        allocate(psb_gen_block_map :: desc%indxmap, stat=info)
+      end if
+      if (info == psb_success_) then 
+        select type(aa => desc%indxmap) 
+        type is (psb_repl_map) 
+          call aa%repl_map_init(iictxt,nl,info)
+        type is (psb_gen_block_map) 
+          call aa%gen_block_map_init(iictxt,nl,info)
+        class default 
+          ! This cannot happen 
+          info = psb_err_internal_error_
+          goto 9999
+        end select
+      end if
     end if
     
-    call psb_realloc(1,itmpsz, info)
+    call psb_realloc(1,itmpv, info)
     if (info /= 0) then 
       write(0,*) 'Error reallocating itmspz'
       goto 9999
     end if
-    itmpsz(:) = -1
-    call psi_bld_tmpovrl(itmpsz,desc,info)
+    itmpv(:) = -1
+    call psi_bld_tmpovrl(itmpv,desc,info)
 
   endif