Fix clone_settings for AINV variants.

.gitignore

@@ -12,9 +12,9 @@ config.log
 config.status
 
 # generated folder
-include/
-modules/
-docs/src/tmp
+/include/
+/modules/
+/docs/src/tmp
 autom4te.cache
 
 # the executable from tests

README.md

@@ -1,3 +1,4 @@
+
                          AMG4PSBLAS  
  Algebraic Multigrid Package  based on PSBLAS (Parallel Sparse BLAS version 3.8)
     

amgprec/amg_base_prec_type.F90

@@ -94,6 +94,7 @@ module amg_base_prec_type
     integer(psb_ipk_) :: aggr_omega_alg, aggr_eig, aggr_filter
     integer(psb_ipk_) :: coarse_mat, coarse_solve
   contains
+    procedure, pass(pm) :: get_coarse_mat  => ml_parms_get_coarse_mat
     procedure, pass(pm) :: get_coarse  => ml_parms_get_coarse
     procedure, pass(pm) :: clone       => ml_parms_clone
     procedure, pass(pm) :: descr       => ml_parms_descr
@@ -577,6 +578,33 @@ contains
     end select
   end function amg_stringval
 
+  function amg_get_coarse_mat_name(val) result(res)
+    character(len=15) :: res
+    integer :: val
+    select case(val)
+    case (0,1)
+      res = matrix_names(val)
+    case default
+      res = 'Unknown '
+    end select
+  end function amg_get_coarse_mat_name
+
+  subroutine amg_warn_coarse_mat(val,expected)
+    integer(psb_ipk_) :: val, expected
+    if (val /= expected) then
+      write(0,*) 'Warning: resetting COARSE_MAT on an existing hierarchy from ',&
+           & amg_get_coarse_mat_name(val), ' to ',amg_get_coarse_mat_name(expected)
+    end if
+  end subroutine amg_warn_coarse_mat
+
+  
+  function  ml_parms_get_coarse_mat(pm) result(res)
+    implicit none
+    class(amg_ml_parms), intent(in)    :: pm
+    integer(psb_ipk_) :: res
+    res   = pm%coarse_mat
+  end function ml_parms_get_coarse_mat
+
   subroutine  ml_parms_get_coarse(pm,pmin)
     implicit none
     class(amg_ml_parms), intent(inout) :: pm

amgprec/amg_c_ainv_solver.F90

@@ -58,6 +58,7 @@ module amg_c_ainv_solver
     procedure, pass(sv) :: check   => amg_c_ainv_solver_check
     procedure, pass(sv) :: build   => amg_c_ainv_solver_bld
     procedure, pass(sv) :: clone   => amg_c_ainv_solver_clone
+    procedure, pass(sv) :: clone_settings   => amg_c_ainv_solver_clone_settings
     procedure, pass(sv) :: cseti   => amg_c_ainv_solver_cseti
     procedure, pass(sv) :: csetc   => amg_c_ainv_solver_csetc
     procedure, pass(sv) :: csetr   => amg_c_ainv_solver_csetr
@@ -85,6 +86,16 @@ module amg_c_ainv_solver
     end subroutine amg_c_ainv_solver_clone
   end interface
 
+  interface
+    subroutine amg_c_ainv_solver_clone_settings(sv,svout,info)
+      import :: psb_desc_type, psb_cspmat_type,  psb_c_base_sparse_mat, &
+       & amg_c_base_solver_type, psb_dpk_, amg_c_ainv_solver_type, psb_ipk_
+      Implicit None
+      class(amg_c_ainv_solver_type), intent(inout)              :: sv
+      class(amg_c_base_solver_type), allocatable, intent(inout) :: svout
+      integer(psb_ipk_), intent(out)                            :: info
+    end subroutine amg_c_ainv_solver_clone_settings
+  end interface
 
   interface
     subroutine amg_c_ainv_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)

amgprec/amg_c_invk_solver.f90

@@ -52,6 +52,7 @@ module amg_c_invk_solver
   contains
     procedure, pass(sv) :: check   => amg_c_invk_solver_check
     procedure, pass(sv) :: clone   => amg_c_invk_solver_clone
+    procedure, pass(sv) :: clone_settings   => amg_c_invk_solver_clone_settings
     procedure, pass(sv) :: build   => amg_c_invk_solver_bld
     procedure, pass(sv) :: cseti   => amg_c_invk_solver_cseti
     procedure, pass(sv) :: descr   => amg_c_invk_solver_descr
@@ -73,6 +74,17 @@ module amg_c_invk_solver
     end subroutine amg_c_invk_solver_clone
   end interface
 
+  interface
+    subroutine amg_c_invk_solver_clone_settings(sv,svout,info)
+      import :: psb_desc_type, psb_cspmat_type,  psb_c_base_sparse_mat, &
+       & amg_c_base_solver_type, psb_spk_, amg_c_invk_solver_type, psb_ipk_
+      Implicit None
+      class(amg_c_invk_solver_type), intent(inout)              :: sv
+      class(amg_c_base_solver_type), allocatable, intent(inout) :: svout
+      integer(psb_ipk_), intent(out)                            :: info
+    end subroutine amg_c_invk_solver_clone_settings
+  end interface
+
   interface
     subroutine amg_c_invk_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
       import :: psb_desc_type, psb_cspmat_type,  psb_c_base_sparse_mat, &

amgprec/amg_c_invt_solver.f90

@@ -52,6 +52,7 @@ module amg_c_invt_solver
   contains
     procedure, pass(sv) :: check   => amg_c_invt_solver_check
     procedure, pass(sv) :: clone   => amg_c_invt_solver_clone
+    procedure, pass(sv) :: clone_settings   => amg_c_invt_solver_clone_settings
     procedure, pass(sv) :: build   => amg_c_invt_solver_bld
     procedure, pass(sv) :: cseti   => amg_c_invt_solver_cseti
     procedure, pass(sv) :: csetr   => amg_c_invt_solver_csetr
@@ -73,6 +74,17 @@ module amg_c_invt_solver
     end subroutine amg_c_invt_solver_clone
   end interface
 
+  interface
+    subroutine amg_c_invt_solver_clone_settings(sv,svout,info)
+      import :: psb_desc_type, psb_cspmat_type,  psb_c_base_sparse_mat, &
+       & amg_c_base_solver_type, psb_spk_, amg_c_invt_solver_type, psb_ipk_
+      Implicit None
+      class(amg_c_invt_solver_type), intent(inout)              :: sv
+      class(amg_c_base_solver_type), allocatable, intent(inout) :: svout
+      integer(psb_ipk_), intent(out)                            :: info
+    end subroutine amg_c_invt_solver_clone_settings
+  end interface
+
   interface
     subroutine amg_c_invt_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
       import :: psb_desc_type, psb_cspmat_type,  psb_c_base_sparse_mat, &

amgprec/amg_c_onelev_mod.f90

@@ -189,6 +189,7 @@ module amg_c_onelev_mod
     procedure, pass(lv) :: descr   => amg_c_base_onelev_descr
     procedure, pass(lv) :: default => c_base_onelev_default
     procedure, pass(lv) :: free    => amg_c_base_onelev_free
+    procedure, pass(lv) :: free_smoothers => amg_c_base_onelev_free_smoothers
     procedure, pass(lv) :: nullify => c_base_onelev_nullify
     procedure, pass(lv) :: check => amg_c_base_onelev_check
     procedure, pass(lv) :: dump  => amg_c_base_onelev_dump
@@ -285,7 +286,7 @@ module amg_c_onelev_mod
     end subroutine amg_c_base_onelev_cnv
   end interface
 
-interface
+  interface
     subroutine amg_c_base_onelev_free(lv,info)
       import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
            & psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
@@ -297,6 +298,18 @@ interface
     end subroutine amg_c_base_onelev_free
   end interface
 
+  interface
+    subroutine amg_c_base_onelev_free_smoothers(lv,info)
+      import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
+           & psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
+           & psb_ipk_, psb_epk_, psb_desc_type
+      implicit none
+
+      class(amg_c_onelev_type), intent(inout) :: lv
+      integer(psb_ipk_), intent(out)                :: info
+    end subroutine amg_c_base_onelev_free_smoothers
+  end interface
+
   interface
     subroutine amg_c_base_onelev_check(lv,info)
       import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &

amgprec/amg_c_prec_type.f90

@@ -135,7 +135,9 @@ module amg_c_prec_type
     procedure, pass(prec)               :: build        => amg_cprecbld
     procedure, pass(prec)               :: hierarchy_build   => amg_c_hierarchy_bld
     procedure, pass(prec)               :: hierarchy_rebuild => amg_c_hierarchy_rebld
+    procedure, pass(prec)               :: hierarchy_free    => amg_c_hierarchy_free    
     procedure, pass(prec)               :: smoothers_build   => amg_c_smoothers_bld
+    procedure, pass(prec)               :: smoothers_free    => amg_c_smoothers_free
     procedure, pass(prec)               :: descr        =>  amg_cfile_prec_descr
   end type amg_cprec_type
 
@@ -345,6 +347,14 @@ module amg_c_prec_type
     end subroutine amg_c_smoothers_bld
   end interface amg_smoothers_bld
 
+  interface amg_smoothers_free
+    module procedure  amg_c_smoothers_free
+  end interface amg_smoothers_free
+
+  interface amg_hierarchy_free
+    module procedure amg_c_hierarchy_free
+  end interface amg_hierarchy_free
+
 contains
   !
   ! Function returning a pointer to the smoother
@@ -618,6 +628,68 @@ contains
 
   end subroutine amg_c_prec_free
 
+  subroutine amg_c_smoothers_free(prec,info)
+
+    implicit none
+
+    ! Arguments
+    class(amg_cprec_type), intent(inout) :: prec
+    integer(psb_ipk_), intent(out)        :: info
+
+    ! Local variables
+    integer(psb_ipk_)   :: me,err_act,i
+    character(len=20)   :: name
+
+    info=psb_success_
+    name = 'amg_c_smoothers_free'
+    call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
+
+    if (allocated(prec%precv)) then
+      do i=1,size(prec%precv)
+        call prec%precv(i)%free_smoothers(info)
+      end do
+    end if
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+
+  end subroutine amg_c_smoothers_free
+
+  subroutine amg_c_hierarchy_free(prec,info)
+
+    implicit none
+
+    ! Arguments
+    class(amg_cprec_type), intent(inout) :: prec
+    integer(psb_ipk_), intent(out)        :: info
+
+    ! Local variables
+    integer(psb_ipk_)   :: me,err_act,i
+    character(len=20)   :: name
+
+    info=psb_success_
+    name = 'amg_c_hierarchy_free'
+    call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
+
+    me=-1
+    write(0,*) 'Missing implementation '
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+
+  end subroutine amg_c_hierarchy_free
 
 
   !

amgprec/amg_d_ainv_solver.F90

@@ -58,6 +58,7 @@ module amg_d_ainv_solver
     procedure, pass(sv) :: check   => amg_d_ainv_solver_check
     procedure, pass(sv) :: build   => amg_d_ainv_solver_bld
     procedure, pass(sv) :: clone   => amg_d_ainv_solver_clone
+    procedure, pass(sv) :: clone_settings   => amg_d_ainv_solver_clone_settings
     procedure, pass(sv) :: cseti   => amg_d_ainv_solver_cseti
     procedure, pass(sv) :: csetc   => amg_d_ainv_solver_csetc
     procedure, pass(sv) :: csetr   => amg_d_ainv_solver_csetr
@@ -85,6 +86,16 @@ module amg_d_ainv_solver
     end subroutine amg_d_ainv_solver_clone
   end interface
 
+  interface
+    subroutine amg_d_ainv_solver_clone_settings(sv,svout,info)
+      import :: psb_desc_type, psb_dspmat_type,  psb_d_base_sparse_mat, &
+       & amg_d_base_solver_type, psb_dpk_, amg_d_ainv_solver_type, psb_ipk_
+      Implicit None
+      class(amg_d_ainv_solver_type), intent(inout)              :: sv
+      class(amg_d_base_solver_type), allocatable, intent(inout) :: svout
+      integer(psb_ipk_), intent(out)                            :: info
+    end subroutine amg_d_ainv_solver_clone_settings
+  end interface
 
   interface
     subroutine amg_d_ainv_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)

amgprec/amg_d_invk_solver.f90

@@ -52,6 +52,7 @@ module amg_d_invk_solver
   contains
     procedure, pass(sv) :: check   => amg_d_invk_solver_check
     procedure, pass(sv) :: clone   => amg_d_invk_solver_clone
+    procedure, pass(sv) :: clone_settings   => amg_d_invk_solver_clone_settings
     procedure, pass(sv) :: build   => amg_d_invk_solver_bld
     procedure, pass(sv) :: cseti   => amg_d_invk_solver_cseti
     procedure, pass(sv) :: descr   => amg_d_invk_solver_descr
@@ -73,6 +74,17 @@ module amg_d_invk_solver
     end subroutine amg_d_invk_solver_clone
   end interface
 
+  interface
+    subroutine amg_d_invk_solver_clone_settings(sv,svout,info)
+      import :: psb_desc_type, psb_dspmat_type,  psb_d_base_sparse_mat, &
+       & amg_d_base_solver_type, psb_dpk_, amg_d_invk_solver_type, psb_ipk_
+      Implicit None
+      class(amg_d_invk_solver_type), intent(inout)              :: sv
+      class(amg_d_base_solver_type), allocatable, intent(inout) :: svout
+      integer(psb_ipk_), intent(out)                            :: info
+    end subroutine amg_d_invk_solver_clone_settings
+  end interface
+
   interface
     subroutine amg_d_invk_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
       import :: psb_desc_type, psb_dspmat_type,  psb_d_base_sparse_mat, &

amgprec/amg_d_invt_solver.f90

@@ -52,6 +52,7 @@ module amg_d_invt_solver
   contains
     procedure, pass(sv) :: check   => amg_d_invt_solver_check
     procedure, pass(sv) :: clone   => amg_d_invt_solver_clone
+    procedure, pass(sv) :: clone_settings   => amg_d_invt_solver_clone_settings
     procedure, pass(sv) :: build   => amg_d_invt_solver_bld
     procedure, pass(sv) :: cseti   => amg_d_invt_solver_cseti
     procedure, pass(sv) :: csetr   => amg_d_invt_solver_csetr
@@ -73,6 +74,17 @@ module amg_d_invt_solver
     end subroutine amg_d_invt_solver_clone
   end interface
 
+  interface
+    subroutine amg_d_invt_solver_clone_settings(sv,svout,info)
+      import :: psb_desc_type, psb_dspmat_type,  psb_d_base_sparse_mat, &
+       & amg_d_base_solver_type, psb_dpk_, amg_d_invt_solver_type, psb_ipk_
+      Implicit None
+      class(amg_d_invt_solver_type), intent(inout)              :: sv
+      class(amg_d_base_solver_type), allocatable, intent(inout) :: svout
+      integer(psb_ipk_), intent(out)                            :: info
+    end subroutine amg_d_invt_solver_clone_settings
+  end interface
+
   interface
     subroutine amg_d_invt_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
       import :: psb_desc_type, psb_dspmat_type,  psb_d_base_sparse_mat, &

amgprec/amg_d_matchboxp_mod.f90

@@ -143,10 +143,9 @@ contains
     type(psb_ld_coo_sparse_mat) :: tmpcoo
     logical  :: display_out_, print_out_, reproducible_
     logical, parameter  :: dump=.false., debug=.false., dump_mate=.false., &
-         & debug_ilaggr=.false., debug_sync=.false., debug_mate=.false.
+         & debug_ilaggr=.false., debug_sync=.false.
     integer(psb_ipk_), save :: idx_bldmtc=-1, idx_phase1=-1, idx_phase2=-1, idx_phase3=-1
     logical, parameter :: do_timings=.true.
-    integer, parameter :: ilaggr_neginit=-1, ilaggr_nonlocal=-2
 
     ictxt = desc_a%get_ctxt()
     call psb_info(ictxt,iam,np)
@@ -188,7 +187,7 @@ contains
     call desc_a%l2gip(ilv,info,owned=.false.)
 
     call psb_geall(ilaggr,desc_a,info)
-    ilaggr = ilaggr_neginit
+    ilaggr = -1
     call psb_geasb(ilaggr,desc_a,info)
     nr = a%get_nrows()
     nc = a%get_ncols()
@@ -214,20 +213,7 @@ contains
       call psb_barrier(ictxt)
       if (iam == 0) write(0,*)' out from buildmatching:', info
     end if
-    if (debug_mate) then
-      block
-        integer(psb_lpk_), allocatable :: ckmate(:)
-        allocate(ckmate(nr))
-        ckmate(1:nr) = mate(1:nr)
-        call psb_msort(ckmate(1:nr))
-        do i=1,nr-1
-          if ((ckmate(i)>0) .and. (ckmate(i) == ckmate(i+1))) then
-            write(0,*) iam,' Duplicate mate entry  at',i,' :',ckmate(i)
-          end if
-        end do
-      end block
-    end if
-     
+
     if (info == 0) then
       if (do_timings) call psb_tic(idx_phase2)
       if (debug_sync) then
@@ -273,7 +259,7 @@ contains
           cycle
         else
 
-          if (ilaggr(k) == ilaggr_neginit) then
+          if (ilaggr(k) == -1) then
 
             wk   = w(k)
             widx = w(idx)
@@ -281,7 +267,7 @@ contains
             nrmagg = wmax*sqrt((wk/wmax)**2+(widx/wmax)**2)
             if (nrmagg > epsilon(nrmagg)) then
               if (idx <= nr) then
-                if (ilaggr(idx) == ilaggr_neginit) then
+                if (ilaggr(idx) == -1) then
                   ! Now, if both vertices are local, the aggregate is local
                   ! (kinda obvious).
                   nlaggr(iam) = nlaggr(iam) + 1
@@ -289,9 +275,6 @@ contains
                   ilaggr(idx) = nlaggr(iam)
                   wtemp(k)    = w(k)/nrmagg
                   wtemp(idx)  = w(idx)/nrmagg
-                else
-                  write(0,*) iam,' Inconsistent mate? ',k,mate(k),idx,&
-                       &mate(idx),ilaggr(idx)
                 end if
                 nlpairs = nlpairs+1
               else if (idx <= nc) then
@@ -311,7 +294,7 @@ contains
                     ilaggr(k)   = nlaggr(iam)
                     nlpairs = nlpairs+1
                   else
-                    ilaggr(k) = ilaggr_nonlocal
+                    ilaggr(k) = -2
                   end if
                 else
                   ! Use a statistically unbiased tie-breaking rule,
@@ -326,7 +309,7 @@ contains
                     ilaggr(k)   = nlaggr(iam)
                     nlpairs = nlpairs+1
                   else
-                    ilaggr(k) = ilaggr_nonlocal
+                    ilaggr(k) = -2
                   end if
                 end if
               end if
@@ -342,12 +325,6 @@ contains
                 nlsingl     = nlsingl + 1
               end if
             end if
-            if (ilaggr(k) == ilaggr_neginit) then
-              write(0,*) iam,' Error: no update to ',k,mate(k),&
-                   & abs(w(k)),nrmagg,epsilon(nrmagg),wtemp(k)
-            end if
-          else
-            if (ilaggr(k)<0) write(0,*) 'Strange? ',k,ilaggr(k)
           end if
         end if
       end do
@@ -355,7 +332,7 @@ contains
       if (do_timings) call psb_tic(idx_phase3)
 
       ! Ok, now compute offsets, gather halo and fix non-local
-      ! aggregates  (those where ilaggr == ilaggr_nonlocal)
+      ! aggregates  (those where ilaggr == -2)
       call psb_sum(ictxt,nlaggr)
       ntaggr  = sum(nlaggr(0:np-1))
       naggrm1 = sum(nlaggr(0:iam-1))
@@ -370,7 +347,7 @@ contains
       call psb_halo(wtemp,desc_a,info)
       ! Cleanup as yet unmarked entries
       do k=1,nr
-        if (ilaggr(k) == ilaggr_nonlocal) then
+        if (ilaggr(k) == -2) then
           idx = mate(k)
           if (idx > nr) then
             i   = ilaggr(idx)
@@ -382,14 +359,9 @@ contains
           else
             write(0,*) 'Error : unresolved (paired) index ',k,idx,i,nr,nc, ilv(k),ilv(idx)
           end if
-        else if (ilaggr(k) <0) then
-          write(0,*) iam,'Matchboxp: Funny number: ',k,ilv(k),ilaggr(k),wtemp(k)
-          write(0,*) iam,'         :             : ',nr,nc,mate(k)
-          if (mate(k) <= nr) then
-            write(0,*) iam,'         :             : ',ilaggr(mate(k)),mate(mate(k)),&
-                 & ilv(k),ilv(mate(k)), ilv(mate(mate(k))),ilaggr(mate(mate(k)))
-          end if
-          flush(0)
+        end if
+        if (ilaggr(k) <0) then
+          write(0,*) 'Matchboxp: Funny number: ',k,ilv(k),ilaggr(k),wtemp(k)
         end if
       end do
       if (debug_sync) then
@@ -442,7 +414,7 @@ contains
 
       end block
       if (iam == 0) then
-        write(0,*) iam,'Matching statistics: Unmatched nodes ',&
+        write(0,*) 'Matching statistics: Unmatched nodes ',&
              & nunmatched,' Singletons:',nlsingl,' Pairs:',nlpairs
       end if
 

amgprec/amg_d_onelev_mod.f90

@@ -190,6 +190,7 @@ module amg_d_onelev_mod
     procedure, pass(lv) :: descr   => amg_d_base_onelev_descr
     procedure, pass(lv) :: default => d_base_onelev_default
     procedure, pass(lv) :: free    => amg_d_base_onelev_free
+    procedure, pass(lv) :: free_smoothers => amg_d_base_onelev_free_smoothers
     procedure, pass(lv) :: nullify => d_base_onelev_nullify
     procedure, pass(lv) :: check => amg_d_base_onelev_check
     procedure, pass(lv) :: dump  => amg_d_base_onelev_dump
@@ -286,7 +287,7 @@ module amg_d_onelev_mod
     end subroutine amg_d_base_onelev_cnv
   end interface
 
-interface
+  interface
     subroutine amg_d_base_onelev_free(lv,info)
       import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
            & psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
@@ -298,6 +299,18 @@ interface
     end subroutine amg_d_base_onelev_free
   end interface
 
+  interface
+    subroutine amg_d_base_onelev_free_smoothers(lv,info)
+      import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
+           & psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
+           & psb_ipk_, psb_epk_, psb_desc_type
+      implicit none
+
+      class(amg_d_onelev_type), intent(inout) :: lv
+      integer(psb_ipk_), intent(out)                :: info
+    end subroutine amg_d_base_onelev_free_smoothers
+  end interface
+
   interface
     subroutine amg_d_base_onelev_check(lv,info)
       import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &

amgprec/amg_d_prec_type.f90

@@ -135,7 +135,9 @@ module amg_d_prec_type
     procedure, pass(prec)               :: build        => amg_dprecbld
     procedure, pass(prec)               :: hierarchy_build   => amg_d_hierarchy_bld
     procedure, pass(prec)               :: hierarchy_rebuild => amg_d_hierarchy_rebld
+    procedure, pass(prec)               :: hierarchy_free    => amg_d_hierarchy_free    
     procedure, pass(prec)               :: smoothers_build   => amg_d_smoothers_bld
+    procedure, pass(prec)               :: smoothers_free    => amg_d_smoothers_free
     procedure, pass(prec)               :: descr        =>  amg_dfile_prec_descr
   end type amg_dprec_type
 
@@ -345,6 +347,14 @@ module amg_d_prec_type
     end subroutine amg_d_smoothers_bld
   end interface amg_smoothers_bld
 
+  interface amg_smoothers_free
+    module procedure  amg_d_smoothers_free
+  end interface amg_smoothers_free
+
+  interface amg_hierarchy_free
+    module procedure amg_d_hierarchy_free
+  end interface amg_hierarchy_free
+
 contains
   !
   ! Function returning a pointer to the smoother
@@ -618,6 +628,68 @@ contains
 
   end subroutine amg_d_prec_free
 
+  subroutine amg_d_smoothers_free(prec,info)
+
+    implicit none
+
+    ! Arguments
+    class(amg_dprec_type), intent(inout) :: prec
+    integer(psb_ipk_), intent(out)        :: info
+
+    ! Local variables
+    integer(psb_ipk_)   :: me,err_act,i
+    character(len=20)   :: name
+
+    info=psb_success_
+    name = 'amg_d_smoothers_free'
+    call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
+
+    if (allocated(prec%precv)) then
+      do i=1,size(prec%precv)
+        call prec%precv(i)%free_smoothers(info)
+      end do
+    end if
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+
+  end subroutine amg_d_smoothers_free
+
+  subroutine amg_d_hierarchy_free(prec,info)
+
+    implicit none
+
+    ! Arguments
+    class(amg_dprec_type), intent(inout) :: prec
+    integer(psb_ipk_), intent(out)        :: info
+
+    ! Local variables
+    integer(psb_ipk_)   :: me,err_act,i
+    character(len=20)   :: name
+
+    info=psb_success_
+    name = 'amg_d_hierarchy_free'
+    call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
+
+    me=-1
+    write(0,*) 'Missing implementation '
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+
+  end subroutine amg_d_hierarchy_free
 
 
   !

amgprec/amg_s_ainv_solver.F90

@@ -58,6 +58,7 @@ module amg_s_ainv_solver
     procedure, pass(sv) :: check   => amg_s_ainv_solver_check
     procedure, pass(sv) :: build   => amg_s_ainv_solver_bld
     procedure, pass(sv) :: clone   => amg_s_ainv_solver_clone
+    procedure, pass(sv) :: clone_settings   => amg_s_ainv_solver_clone_settings
     procedure, pass(sv) :: cseti   => amg_s_ainv_solver_cseti
     procedure, pass(sv) :: csetc   => amg_s_ainv_solver_csetc
     procedure, pass(sv) :: csetr   => amg_s_ainv_solver_csetr
@@ -85,6 +86,16 @@ module amg_s_ainv_solver
     end subroutine amg_s_ainv_solver_clone
   end interface
 
+  interface
+    subroutine amg_s_ainv_solver_clone_settings(sv,svout,info)
+      import :: psb_desc_type, psb_sspmat_type,  psb_s_base_sparse_mat, &
+       & amg_s_base_solver_type, psb_dpk_, amg_s_ainv_solver_type, psb_ipk_
+      Implicit None
+      class(amg_s_ainv_solver_type), intent(inout)              :: sv
+      class(amg_s_base_solver_type), allocatable, intent(inout) :: svout
+      integer(psb_ipk_), intent(out)                            :: info
+    end subroutine amg_s_ainv_solver_clone_settings
+  end interface
 
   interface
     subroutine amg_s_ainv_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)

amgprec/amg_s_invk_solver.f90

@@ -52,6 +52,7 @@ module amg_s_invk_solver
   contains
     procedure, pass(sv) :: check   => amg_s_invk_solver_check
     procedure, pass(sv) :: clone   => amg_s_invk_solver_clone
+    procedure, pass(sv) :: clone_settings   => amg_s_invk_solver_clone_settings
     procedure, pass(sv) :: build   => amg_s_invk_solver_bld
     procedure, pass(sv) :: cseti   => amg_s_invk_solver_cseti
     procedure, pass(sv) :: descr   => amg_s_invk_solver_descr
@@ -73,6 +74,17 @@ module amg_s_invk_solver
     end subroutine amg_s_invk_solver_clone
   end interface
 
+  interface
+    subroutine amg_s_invk_solver_clone_settings(sv,svout,info)
+      import :: psb_desc_type, psb_sspmat_type,  psb_s_base_sparse_mat, &
+       & amg_s_base_solver_type, psb_spk_, amg_s_invk_solver_type, psb_ipk_
+      Implicit None
+      class(amg_s_invk_solver_type), intent(inout)              :: sv
+      class(amg_s_base_solver_type), allocatable, intent(inout) :: svout
+      integer(psb_ipk_), intent(out)                            :: info
+    end subroutine amg_s_invk_solver_clone_settings
+  end interface
+
   interface
     subroutine amg_s_invk_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
       import :: psb_desc_type, psb_sspmat_type,  psb_s_base_sparse_mat, &

amgprec/amg_s_invt_solver.f90

@@ -52,6 +52,7 @@ module amg_s_invt_solver
   contains
     procedure, pass(sv) :: check   => amg_s_invt_solver_check
     procedure, pass(sv) :: clone   => amg_s_invt_solver_clone
+    procedure, pass(sv) :: clone_settings   => amg_s_invt_solver_clone_settings
     procedure, pass(sv) :: build   => amg_s_invt_solver_bld
     procedure, pass(sv) :: cseti   => amg_s_invt_solver_cseti
     procedure, pass(sv) :: csetr   => amg_s_invt_solver_csetr
@@ -73,6 +74,17 @@ module amg_s_invt_solver
     end subroutine amg_s_invt_solver_clone
   end interface
 
+  interface
+    subroutine amg_s_invt_solver_clone_settings(sv,svout,info)
+      import :: psb_desc_type, psb_sspmat_type,  psb_s_base_sparse_mat, &
+       & amg_s_base_solver_type, psb_spk_, amg_s_invt_solver_type, psb_ipk_
+      Implicit None
+      class(amg_s_invt_solver_type), intent(inout)              :: sv
+      class(amg_s_base_solver_type), allocatable, intent(inout) :: svout
+      integer(psb_ipk_), intent(out)                            :: info
+    end subroutine amg_s_invt_solver_clone_settings
+  end interface
+
   interface
     subroutine amg_s_invt_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
       import :: psb_desc_type, psb_sspmat_type,  psb_s_base_sparse_mat, &

amgprec/amg_s_matchboxp_mod.f90

@@ -143,10 +143,9 @@ contains
     type(psb_ls_coo_sparse_mat) :: tmpcoo
     logical  :: display_out_, print_out_, reproducible_
     logical, parameter  :: dump=.false., debug=.false., dump_mate=.false., &
-         & debug_ilaggr=.false., debug_sync=.false., debug_mate=.false.
+         & debug_ilaggr=.false., debug_sync=.false.
     integer(psb_ipk_), save :: idx_bldmtc=-1, idx_phase1=-1, idx_phase2=-1, idx_phase3=-1
     logical, parameter :: do_timings=.true.
-    integer, parameter :: ilaggr_neginit=-1, ilaggr_nonlocal=-2
 
     ictxt = desc_a%get_ctxt()
     call psb_info(ictxt,iam,np)
@@ -188,7 +187,7 @@ contains
     call desc_a%l2gip(ilv,info,owned=.false.)
 
     call psb_geall(ilaggr,desc_a,info)
-    ilaggr = ilaggr_neginit
+    ilaggr = -1
     call psb_geasb(ilaggr,desc_a,info)
     nr = a%get_nrows()
     nc = a%get_ncols()
@@ -214,20 +213,7 @@ contains
       call psb_barrier(ictxt)
       if (iam == 0) write(0,*)' out from buildmatching:', info
     end if
-    if (debug_mate) then
-      block
-        integer(psb_lpk_), allocatable :: ckmate(:)
-        allocate(ckmate(nr))
-        ckmate(1:nr) = mate(1:nr)
-        call psb_msort(ckmate(1:nr))
-        do i=1,nr-1
-          if ((ckmate(i)>0) .and. (ckmate(i) == ckmate(i+1))) then
-            write(0,*) iam,' Duplicate mate entry  at',i,' :',ckmate(i)
-          end if
-        end do
-      end block
-    end if
-     
+
     if (info == 0) then
       if (do_timings) call psb_tic(idx_phase2)
       if (debug_sync) then
@@ -273,7 +259,7 @@ contains
           cycle
         else
 
-          if (ilaggr(k) == ilaggr_neginit) then
+          if (ilaggr(k) == -1) then
 
             wk   = w(k)
             widx = w(idx)
@@ -281,7 +267,7 @@ contains
             nrmagg = wmax*sqrt((wk/wmax)**2+(widx/wmax)**2)
             if (nrmagg > epsilon(nrmagg)) then
               if (idx <= nr) then
-                if (ilaggr(idx) == ilaggr_neginit) then
+                if (ilaggr(idx) == -1) then
                   ! Now, if both vertices are local, the aggregate is local
                   ! (kinda obvious).
                   nlaggr(iam) = nlaggr(iam) + 1
@@ -289,9 +275,6 @@ contains
                   ilaggr(idx) = nlaggr(iam)
                   wtemp(k)    = w(k)/nrmagg
                   wtemp(idx)  = w(idx)/nrmagg
-                else
-                  write(0,*) iam,' Inconsistent mate? ',k,mate(k),idx,&
-                       &mate(idx),ilaggr(idx)
                 end if
                 nlpairs = nlpairs+1
               else if (idx <= nc) then
@@ -311,7 +294,7 @@ contains
                     ilaggr(k)   = nlaggr(iam)
                     nlpairs = nlpairs+1
                   else
-                    ilaggr(k) = ilaggr_nonlocal
+                    ilaggr(k) = -2
                   end if
                 else
                   ! Use a statistically unbiased tie-breaking rule,
@@ -326,7 +309,7 @@ contains
                     ilaggr(k)   = nlaggr(iam)
                     nlpairs = nlpairs+1
                   else
-                    ilaggr(k) = ilaggr_nonlocal
+                    ilaggr(k) = -2
                   end if
                 end if
               end if
@@ -342,12 +325,6 @@ contains
                 nlsingl     = nlsingl + 1
               end if
             end if
-            if (ilaggr(k) == ilaggr_neginit) then
-              write(0,*) iam,' Error: no update to ',k,mate(k),&
-                   & abs(w(k)),nrmagg,epsilon(nrmagg),wtemp(k)
-            end if
-          else
-            if (ilaggr(k)<0) write(0,*) 'Strange? ',k,ilaggr(k)
           end if
         end if
       end do
@@ -355,7 +332,7 @@ contains
       if (do_timings) call psb_tic(idx_phase3)
 
       ! Ok, now compute offsets, gather halo and fix non-local
-      ! aggregates  (those where ilaggr == ilaggr_nonlocal)
+      ! aggregates  (those where ilaggr == -2)
       call psb_sum(ictxt,nlaggr)
       ntaggr  = sum(nlaggr(0:np-1))
       naggrm1 = sum(nlaggr(0:iam-1))
@@ -370,7 +347,7 @@ contains
       call psb_halo(wtemp,desc_a,info)
       ! Cleanup as yet unmarked entries
       do k=1,nr
-        if (ilaggr(k) == ilaggr_nonlocal) then
+        if (ilaggr(k) == -2) then
           idx = mate(k)
           if (idx > nr) then
             i   = ilaggr(idx)
@@ -382,14 +359,9 @@ contains
           else
             write(0,*) 'Error : unresolved (paired) index ',k,idx,i,nr,nc, ilv(k),ilv(idx)
           end if
-        else if (ilaggr(k) <0) then
-          write(0,*) iam,'Matchboxp: Funny number: ',k,ilv(k),ilaggr(k),wtemp(k)
-          write(0,*) iam,'         :             : ',nr,nc,mate(k)
-          if (mate(k) <= nr) then
-            write(0,*) iam,'         :             : ',ilaggr(mate(k)),mate(mate(k)),&
-                 & ilv(k),ilv(mate(k)), ilv(mate(mate(k))),ilaggr(mate(mate(k)))
-          end if
-          flush(0)
+        end if
+        if (ilaggr(k) <0) then
+          write(0,*) 'Matchboxp: Funny number: ',k,ilv(k),ilaggr(k),wtemp(k)
         end if
       end do
       if (debug_sync) then
@@ -442,7 +414,7 @@ contains
 
       end block
       if (iam == 0) then
-        write(0,*) iam,'Matching statistics: Unmatched nodes ',&
+        write(0,*) 'Matching statistics: Unmatched nodes ',&
              & nunmatched,' Singletons:',nlsingl,' Pairs:',nlpairs
       end if
 

amgprec/amg_s_onelev_mod.f90

@@ -190,6 +190,7 @@ module amg_s_onelev_mod
     procedure, pass(lv) :: descr   => amg_s_base_onelev_descr
     procedure, pass(lv) :: default => s_base_onelev_default
     procedure, pass(lv) :: free    => amg_s_base_onelev_free
+    procedure, pass(lv) :: free_smoothers => amg_s_base_onelev_free_smoothers
     procedure, pass(lv) :: nullify => s_base_onelev_nullify
     procedure, pass(lv) :: check => amg_s_base_onelev_check
     procedure, pass(lv) :: dump  => amg_s_base_onelev_dump
@@ -286,7 +287,7 @@ module amg_s_onelev_mod
     end subroutine amg_s_base_onelev_cnv
   end interface
 
-interface
+  interface
     subroutine amg_s_base_onelev_free(lv,info)
       import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
            & psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
@@ -298,6 +299,18 @@ interface
     end subroutine amg_s_base_onelev_free
   end interface
 
+  interface
+    subroutine amg_s_base_onelev_free_smoothers(lv,info)
+      import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
+           & psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
+           & psb_ipk_, psb_epk_, psb_desc_type
+      implicit none
+
+      class(amg_s_onelev_type), intent(inout) :: lv
+      integer(psb_ipk_), intent(out)                :: info
+    end subroutine amg_s_base_onelev_free_smoothers
+  end interface
+
   interface
     subroutine amg_s_base_onelev_check(lv,info)
       import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &

amgprec/amg_s_prec_type.f90

@@ -135,7 +135,9 @@ module amg_s_prec_type
     procedure, pass(prec)               :: build        => amg_sprecbld
     procedure, pass(prec)               :: hierarchy_build   => amg_s_hierarchy_bld
     procedure, pass(prec)               :: hierarchy_rebuild => amg_s_hierarchy_rebld
+    procedure, pass(prec)               :: hierarchy_free    => amg_s_hierarchy_free    
     procedure, pass(prec)               :: smoothers_build   => amg_s_smoothers_bld
+    procedure, pass(prec)               :: smoothers_free    => amg_s_smoothers_free
     procedure, pass(prec)               :: descr        =>  amg_sfile_prec_descr
   end type amg_sprec_type
 
@@ -345,6 +347,14 @@ module amg_s_prec_type
     end subroutine amg_s_smoothers_bld
   end interface amg_smoothers_bld
 
+  interface amg_smoothers_free
+    module procedure  amg_s_smoothers_free
+  end interface amg_smoothers_free
+
+  interface amg_hierarchy_free
+    module procedure amg_s_hierarchy_free
+  end interface amg_hierarchy_free
+
 contains
   !
   ! Function returning a pointer to the smoother
@@ -618,6 +628,68 @@ contains
 
   end subroutine amg_s_prec_free
 
+  subroutine amg_s_smoothers_free(prec,info)
+
+    implicit none
+
+    ! Arguments
+    class(amg_sprec_type), intent(inout) :: prec
+    integer(psb_ipk_), intent(out)        :: info
+
+    ! Local variables
+    integer(psb_ipk_)   :: me,err_act,i
+    character(len=20)   :: name
+
+    info=psb_success_
+    name = 'amg_s_smoothers_free'
+    call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
+
+    if (allocated(prec%precv)) then
+      do i=1,size(prec%precv)
+        call prec%precv(i)%free_smoothers(info)
+      end do
+    end if
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+
+  end subroutine amg_s_smoothers_free
+
+  subroutine amg_s_hierarchy_free(prec,info)
+
+    implicit none
+
+    ! Arguments
+    class(amg_sprec_type), intent(inout) :: prec
+    integer(psb_ipk_), intent(out)        :: info
+
+    ! Local variables
+    integer(psb_ipk_)   :: me,err_act,i
+    character(len=20)   :: name
+
+    info=psb_success_
+    name = 'amg_s_hierarchy_free'
+    call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
+
+    me=-1
+    write(0,*) 'Missing implementation '
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+
+  end subroutine amg_s_hierarchy_free
 
 
   !

amgprec/amg_z_ainv_solver.F90

@@ -58,6 +58,7 @@ module amg_z_ainv_solver
     procedure, pass(sv) :: check   => amg_z_ainv_solver_check
     procedure, pass(sv) :: build   => amg_z_ainv_solver_bld
     procedure, pass(sv) :: clone   => amg_z_ainv_solver_clone
+    procedure, pass(sv) :: clone_settings   => amg_z_ainv_solver_clone_settings
     procedure, pass(sv) :: cseti   => amg_z_ainv_solver_cseti
     procedure, pass(sv) :: csetc   => amg_z_ainv_solver_csetc
     procedure, pass(sv) :: csetr   => amg_z_ainv_solver_csetr
@@ -85,6 +86,16 @@ module amg_z_ainv_solver
     end subroutine amg_z_ainv_solver_clone
   end interface
 
+  interface
+    subroutine amg_z_ainv_solver_clone_settings(sv,svout,info)
+      import :: psb_desc_type, psb_zspmat_type,  psb_z_base_sparse_mat, &
+       & amg_z_base_solver_type, psb_dpk_, amg_z_ainv_solver_type, psb_ipk_
+      Implicit None
+      class(amg_z_ainv_solver_type), intent(inout)              :: sv
+      class(amg_z_base_solver_type), allocatable, intent(inout) :: svout
+      integer(psb_ipk_), intent(out)                            :: info
+    end subroutine amg_z_ainv_solver_clone_settings
+  end interface
 
   interface
     subroutine amg_z_ainv_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)

amgprec/amg_z_invk_solver.f90

@@ -52,6 +52,7 @@ module amg_z_invk_solver
   contains
     procedure, pass(sv) :: check   => amg_z_invk_solver_check
     procedure, pass(sv) :: clone   => amg_z_invk_solver_clone
+    procedure, pass(sv) :: clone_settings   => amg_z_invk_solver_clone_settings
     procedure, pass(sv) :: build   => amg_z_invk_solver_bld
     procedure, pass(sv) :: cseti   => amg_z_invk_solver_cseti
     procedure, pass(sv) :: descr   => amg_z_invk_solver_descr
@@ -73,6 +74,17 @@ module amg_z_invk_solver
     end subroutine amg_z_invk_solver_clone
   end interface
 
+  interface
+    subroutine amg_z_invk_solver_clone_settings(sv,svout,info)
+      import :: psb_desc_type, psb_zspmat_type,  psb_z_base_sparse_mat, &
+       & amg_z_base_solver_type, psb_dpk_, amg_z_invk_solver_type, psb_ipk_
+      Implicit None
+      class(amg_z_invk_solver_type), intent(inout)              :: sv
+      class(amg_z_base_solver_type), allocatable, intent(inout) :: svout
+      integer(psb_ipk_), intent(out)                            :: info
+    end subroutine amg_z_invk_solver_clone_settings
+  end interface
+
   interface
     subroutine amg_z_invk_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
       import :: psb_desc_type, psb_zspmat_type,  psb_z_base_sparse_mat, &

amgprec/amg_z_invt_solver.f90

@@ -52,6 +52,7 @@ module amg_z_invt_solver
   contains
     procedure, pass(sv) :: check   => amg_z_invt_solver_check
     procedure, pass(sv) :: clone   => amg_z_invt_solver_clone
+    procedure, pass(sv) :: clone_settings   => amg_z_invt_solver_clone_settings
     procedure, pass(sv) :: build   => amg_z_invt_solver_bld
     procedure, pass(sv) :: cseti   => amg_z_invt_solver_cseti
     procedure, pass(sv) :: csetr   => amg_z_invt_solver_csetr
@@ -73,6 +74,17 @@ module amg_z_invt_solver
     end subroutine amg_z_invt_solver_clone
   end interface
 
+  interface
+    subroutine amg_z_invt_solver_clone_settings(sv,svout,info)
+      import :: psb_desc_type, psb_zspmat_type,  psb_z_base_sparse_mat, &
+       & amg_z_base_solver_type, psb_dpk_, amg_z_invt_solver_type, psb_ipk_
+      Implicit None
+      class(amg_z_invt_solver_type), intent(inout)              :: sv
+      class(amg_z_base_solver_type), allocatable, intent(inout) :: svout
+      integer(psb_ipk_), intent(out)                            :: info
+    end subroutine amg_z_invt_solver_clone_settings
+  end interface
+
   interface
     subroutine amg_z_invt_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
       import :: psb_desc_type, psb_zspmat_type,  psb_z_base_sparse_mat, &

amgprec/amg_z_onelev_mod.f90

@@ -189,6 +189,7 @@ module amg_z_onelev_mod
     procedure, pass(lv) :: descr   => amg_z_base_onelev_descr
     procedure, pass(lv) :: default => z_base_onelev_default
     procedure, pass(lv) :: free    => amg_z_base_onelev_free
+    procedure, pass(lv) :: free_smoothers => amg_z_base_onelev_free_smoothers
     procedure, pass(lv) :: nullify => z_base_onelev_nullify
     procedure, pass(lv) :: check => amg_z_base_onelev_check
     procedure, pass(lv) :: dump  => amg_z_base_onelev_dump
@@ -285,7 +286,7 @@ module amg_z_onelev_mod
     end subroutine amg_z_base_onelev_cnv
   end interface
 
-interface
+  interface
     subroutine amg_z_base_onelev_free(lv,info)
       import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
            & psb_zlinmap_type, psb_dpk_, amg_z_onelev_type, &
@@ -297,6 +298,18 @@ interface
     end subroutine amg_z_base_onelev_free
   end interface
 
+  interface
+    subroutine amg_z_base_onelev_free_smoothers(lv,info)
+      import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
+           & psb_zlinmap_type, psb_dpk_, amg_z_onelev_type, &
+           & psb_ipk_, psb_epk_, psb_desc_type
+      implicit none
+
+      class(amg_z_onelev_type), intent(inout) :: lv
+      integer(psb_ipk_), intent(out)                :: info
+    end subroutine amg_z_base_onelev_free_smoothers
+  end interface
+
   interface
     subroutine amg_z_base_onelev_check(lv,info)
       import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &

amgprec/amg_z_prec_type.f90

@@ -135,7 +135,9 @@ module amg_z_prec_type
     procedure, pass(prec)               :: build        => amg_zprecbld
     procedure, pass(prec)               :: hierarchy_build   => amg_z_hierarchy_bld
     procedure, pass(prec)               :: hierarchy_rebuild => amg_z_hierarchy_rebld
+    procedure, pass(prec)               :: hierarchy_free    => amg_z_hierarchy_free    
     procedure, pass(prec)               :: smoothers_build   => amg_z_smoothers_bld
+    procedure, pass(prec)               :: smoothers_free    => amg_z_smoothers_free
     procedure, pass(prec)               :: descr        =>  amg_zfile_prec_descr
   end type amg_zprec_type
 
@@ -345,6 +347,14 @@ module amg_z_prec_type
     end subroutine amg_z_smoothers_bld
   end interface amg_smoothers_bld
 
+  interface amg_smoothers_free
+    module procedure  amg_z_smoothers_free
+  end interface amg_smoothers_free
+
+  interface amg_hierarchy_free
+    module procedure amg_z_hierarchy_free
+  end interface amg_hierarchy_free
+
 contains
   !
   ! Function returning a pointer to the smoother
@@ -618,6 +628,68 @@ contains
 
   end subroutine amg_z_prec_free
 
+  subroutine amg_z_smoothers_free(prec,info)
+
+    implicit none
+
+    ! Arguments
+    class(amg_zprec_type), intent(inout) :: prec
+    integer(psb_ipk_), intent(out)        :: info
+
+    ! Local variables
+    integer(psb_ipk_)   :: me,err_act,i
+    character(len=20)   :: name
+
+    info=psb_success_
+    name = 'amg_z_smoothers_free'
+    call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
+
+    if (allocated(prec%precv)) then
+      do i=1,size(prec%precv)
+        call prec%precv(i)%free_smoothers(info)
+      end do
+    end if
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+
+  end subroutine amg_z_smoothers_free
+
+  subroutine amg_z_hierarchy_free(prec,info)
+
+    implicit none
+
+    ! Arguments
+    class(amg_zprec_type), intent(inout) :: prec
+    integer(psb_ipk_), intent(out)        :: info
+
+    ! Local variables
+    integer(psb_ipk_)   :: me,err_act,i
+    character(len=20)   :: name
+
+    info=psb_success_
+    name = 'amg_z_hierarchy_free'
+    call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
+
+    me=-1
+    write(0,*) 'Missing implementation '
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+
+  end subroutine amg_z_hierarchy_free
 
 
   !

amgprec/impl/aggregator/Makefile

@@ -62,22 +62,7 @@ amg_s_parmatch_smth_bld.o \
 amg_s_parmatch_spmm_bld_inner.o
 
 MPCOBJS=MatchBoxPC.o \
-sendBundledMessages.o \
-initialize.o \
-extractUChunk.o \
-isAlreadyMatched.o \
-findOwnerOfGhost.o \
-clean.o \
-computeCandidateMate.o \
-parallelComputeCandidateMateB.o \
-processMatchedVertices.o \
-processMatchedVerticesAndSendMessages.o \
-processCrossEdge.o \
-queueTransfer.o \
-processMessages.o \
-processExposedVertex.o \
-algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC.o \
-algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP.o
+algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC.o
 
 OBJS = $(FOBJS) $(MPCOBJS)
 

amgprec/impl/aggregator/MatchBoxPC.cpp

@@ -60,43 +60,17 @@ void dMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
 		MilanLongInt* ph1_card, MilanLongInt* ph2_card ) {
 #if !defined(SERIAL_MPI)
   MPI_Comm C_comm=MPI_Comm_f2c(icomm);
-
 #ifdef DEBUG
   fprintf(stderr,"MatchBoxPC: rank %d nlver %ld nledge %ld [ %ld %ld ]\n",
 	  myRank,NLVer, NLEdge,verDistance[0],verDistance[1]);
 #endif
-
-
-#define TIME_TRACKER
-    #ifdef TIME_TRACKER
-        double tmr = MPI_Wtime();
-    #endif
-
-#define OMP
-#ifdef OMP
-        dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(NLVer, NLEdge,
+  dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC(NLVer, NLEdge,
 							   verLocPtr, verLocInd, edgeLocWeight,
 							   verDistance,  Mate,
 							   myRank, numProcs, C_comm,
 							   msgIndSent, msgActualSent, msgPercent,
 							   ph0_time, ph1_time, ph2_time,
 							   ph1_card, ph2_card );
-#else
-        dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC(NLVer, NLEdge,
-							   verLocPtr, verLocInd, edgeLocWeight,
-							   verDistance,  Mate,
-							   myRank, numProcs, C_comm,
-							   msgIndSent, msgActualSent, msgPercent,
-							   ph0_time, ph1_time, ph2_time,
-							   ph1_card, ph2_card );
-#endif
-
-
-  #ifdef TIME_TRACKER
-    tmr = MPI_Wtime() - tmr;
-    fprintf(stderr, "Elaboration time: %f for %ld nodes\n", tmr, NLVer);
-  #endif
-
 #endif
 }
 

amgprec/impl/aggregator/MatchBoxPC.h

@@ -52,412 +52,145 @@
 
 #ifndef _matchboxpC_H_
 #define _matchboxpC_H_
-// Turn on a lot of debugging information with this switch:
+//Turn on a lot of debugging information with this switch:
 //#define PRINT_DEBUG_INFO_
 #include <stdio.h>
 #include <iostream>
 #include <assert.h>
 #include <map>
 #include <vector>
-#include "omp.h"
+// #include "matchboxp.h"
 #include "primitiveDataTypeDefinitions.h"
 #include "dataStrStaticQueue.h"
 
 using namespace std;
 
-const int NUM_THREAD = 4;
-const int UCHUNK = 10;
-
-const MilanLongInt REQUEST = 1;
-const MilanLongInt SUCCESS = 2;
-const MilanLongInt FAILURE = 3;
-const MilanLongInt SIZEINFO = 4;
-
-const int ComputeTag = 7; // Predefined tag
-const int BundleTag = 9;  // Predefined tag
-
-static vector<MilanLongInt> DEFAULT_VECTOR;
-
-// MPI type map
-template <typename T>
-MPI_Datatype TypeMap();
-template <>
-inline MPI_Datatype TypeMap<int64_t>() { return MPI_LONG_LONG; }
-template <>
-inline MPI_Datatype TypeMap<int>() { return MPI_INT; }
-template <>
-inline MPI_Datatype TypeMap<double>() { return MPI_DOUBLE; }
-template <>
-inline MPI_Datatype TypeMap<float>() { return MPI_FLOAT; }
-
 #ifdef __cplusplus
-extern "C"
-{
+extern "C" {
 #endif
 
 #if !defined(SERIAL_MPI)
-
-#define MilanMpiLongInt MPI_LONG_LONG
+  
+#define MilanMpiLongInt  MPI_LONG_LONG
 
 #ifndef _primitiveDataType_Definition_
 #define _primitiveDataType_Definition_
-// Regular integer:
-#ifndef INTEGER_H
-#define INTEGER_H
-    typedef int32_t MilanInt;
-#endif
+    //Regular integer:
+    #ifndef INTEGER_H
+    #define INTEGER_H
+        typedef int32_t MilanInt;
+    #endif
 
-// Regular long integer:
-#ifndef LONG_INT_H
-#define LONG_INT_H
-#ifdef BIT64
-    typedef int64_t MilanLongInt;
-    typedef MPI_LONG MilanMpiLongInt;
-#else
-    typedef int32_t MilanLongInt;
-    typedef MPI_INT MilanMpiLongInt;
-#endif
-#endif
+    //Regular long integer:
+    #ifndef LONG_INT_H
+    #define LONG_INT_H
+        #ifdef BIT64
+            typedef int64_t MilanLongInt;
+            typedef MPI_LONG MilanMpiLongInt;
+        #else
+            typedef int32_t MilanLongInt;
+            typedef MPI_INT MilanMpiLongInt;
+        #endif
+    #endif
 
-// Regular boolean
-#ifndef BOOL_H
-#define BOOL_H
-    typedef bool MilanBool;
-#endif
+    //Regular boolean
+    #ifndef BOOL_H
+    #define BOOL_H
+        typedef bool MilanBool;
+    #endif
 
-// Regular double and absolute value computation:
-#ifndef REAL_H
-#define REAL_H
-    typedef double MilanReal;
-    typedef MPI_DOUBLE MilanMpiReal;
-    inline MilanReal MilanAbs(MilanReal value)
-    {
-        return fabs(value);
-    }
-#endif
+    //Regular double and absolute value computation:
+    #ifndef REAL_H
+    #define REAL_H
+        typedef double MilanReal;
+        typedef MPI_DOUBLE MilanMpiReal;
+        inline MilanReal MilanAbs(MilanReal value)
+        {
+            return fabs(value);
+        }
+    #endif
 
-// Regular float and absolute value computation:
-#ifndef FLOAT_H
-#define FLOAT_H
-    typedef float MilanFloat;
-    typedef MPI_FLOAT MilanMpiFloat;
-    inline MilanFloat MilanAbsFloat(MilanFloat value)
-    {
-        return fabs(value);
-    }
-#endif
+    //Regular float and absolute value computation:
+    #ifndef FLOAT_H
+    #define FLOAT_H
+        typedef float MilanFloat;
+        typedef MPI_FLOAT MilanMpiFloat;
+        inline MilanFloat MilanAbsFloat(MilanFloat value)
+        {
+            return fabs(value);
+        }
+    #endif
 
-//// Define the limits:
-#ifndef LIMITS_H
-#define LIMITS_H
-    // Integer Maximum and Minimum:
-    //      #define MilanIntMax INT_MAX
-    //    #define MilanIntMin INT_MIN
-#define MilanIntMax INT32_MAX
-#define MilanIntMin INT32_MIN
+    //// Define the limits:
+    #ifndef LIMITS_H
+    #define LIMITS_H
+    //Integer Maximum and Minimum:
+  //      #define MilanIntMax INT_MAX
+  //    #define MilanIntMin INT_MIN
+        #define MilanIntMax INT32_MAX
+        #define MilanIntMin INT32_MIN
 
-#ifdef BIT64
-#define MilanLongIntMax INT64_MAX
-#define MilanLongIntMin -INT64_MAX
-#else
-#define MilanLongIntMax INT32_MAX
-#define MilanLongIntMin -INT32_MAX
-#endif
+        #ifdef BIT64
+            #define MilanLongIntMax INT64_MAX
+            #define MilanLongIntMin -INT64_MAX
+        #else
+            #define MilanLongIntMax INT32_MAX
+            #define MilanLongIntMin -INT32_MAX
+        #endif
 
-#endif
+    #endif
 
     // +INFINITY
     const double PLUS_INFINITY = numeric_limits<int>::infinity();
     const double MINUS_INFINITY = -PLUS_INFINITY;
-//#define MilanRealMax LDBL_MAX
-#define MilanRealMax PLUS_INFINITY
-#define MilanRealMin MINUS_INFINITY
+    //#define MilanRealMax LDBL_MAX
+    #define MilanRealMax PLUS_INFINITY
+    #define MilanRealMin MINUS_INFINITY
 #endif
 
-    // Function of find the owner of a ghost vertex using binary search:
-    MilanInt findOwnerOfGhost(MilanLongInt vtxIndex, MilanLongInt *mVerDistance,
-                              MilanInt myRank, MilanInt numProcs);
+//Function of find the owner of a ghost vertex using binary search:
+inline MilanInt findOwnerOfGhost(MilanLongInt vtxIndex, MilanLongInt *mVerDistance,
+                                     MilanInt myRank, MilanInt numProcs);
 
-    MilanLongInt firstComputeCandidateMate(MilanLongInt adj1,
-                                           MilanLongInt adj2,
-                                           MilanLongInt *verLocInd,
-                                           MilanReal *edgeLocWeight);
+  void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC
+(
+ MilanLongInt NLVer, MilanLongInt NLEdge,
+ MilanLongInt* verLocPtr, MilanLongInt* verLocInd, MilanReal* edgeLocWeight,
+ MilanLongInt* verDistance,
+ MilanLongInt* Mate,
+ MilanInt myRank, MilanInt numProcs, MPI_Comm comm,
+ MilanLongInt* msgIndSent, MilanLongInt* msgActualSent, MilanReal* msgPercent,
+ MilanReal* ph0_time, MilanReal* ph1_time, MilanReal* ph2_time,
+ MilanLongInt* ph1_card, MilanLongInt* ph2_card );
 
-    void queuesTransfer(vector<MilanLongInt> &U,
-                        vector<MilanLongInt> &privateU,
-                        vector<MilanLongInt> &QLocalVtx,
-                        vector<MilanLongInt> &QGhostVtx,
-                        vector<MilanLongInt> &QMsgType,
-                        vector<MilanInt> &QOwner,
-                        vector<MilanLongInt> &privateQLocalVtx,
-                        vector<MilanLongInt> &privateQGhostVtx,
-                        vector<MilanLongInt> &privateQMsgType,
-                        vector<MilanInt> &privateQOwner);
+ void salgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC
+(
+MilanLongInt NLVer, MilanLongInt NLEdge,
+MilanLongInt* verLocPtr, MilanLongInt* verLocInd, MilanFloat* edgeLocWeight,
+MilanLongInt* verDistance,
+MilanLongInt* Mate,
+MilanInt myRank, MilanInt numProcs, MPI_Comm comm,
+MilanLongInt* msgIndSent, MilanLongInt* msgActualSent, MilanReal* msgPercent,
+MilanReal* ph0_time, MilanReal* ph1_time, MilanReal* ph2_time,
+MilanLongInt* ph1_card, MilanLongInt* ph2_card );
 
-    bool isAlreadyMatched(MilanLongInt node,
-                          MilanLongInt StartIndex,
-                          MilanLongInt EndIndex,
-                          vector<MilanLongInt> &GMate,
-                          MilanLongInt *Mate,
-                          map<MilanLongInt, MilanLongInt> &Ghost2LocalMap);
+void dMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
+		MilanLongInt* verLocPtr, MilanLongInt* verLocInd, MilanReal* edgeLocWeight,
+		MilanLongInt* verDistance,
+		MilanLongInt* Mate,
+		MilanInt myRank, MilanInt numProcs, MilanInt icomm,
+		MilanLongInt* msgIndSent, MilanLongInt* msgActualSent, MilanReal* msgPercent,
+		MilanReal* ph0_time, MilanReal* ph1_time, MilanReal* ph2_time,
+		MilanLongInt* ph1_card, MilanLongInt* ph2_card );
 
-    MilanLongInt computeCandidateMate(MilanLongInt adj1,
-                                      MilanLongInt adj2,
-                                      MilanReal *edgeLocWeight,
-                                      MilanLongInt k,
-                                      MilanLongInt *verLocInd,
-                                      MilanLongInt StartIndex,
-                                      MilanLongInt EndIndex,
-                                      vector<MilanLongInt> &GMate,
-                                      MilanLongInt *Mate,
-                                      map<MilanLongInt, MilanLongInt> &Ghost2LocalMap);
-
-    void initialize(MilanLongInt NLVer, MilanLongInt NLEdge,
-                    MilanLongInt StartIndex, MilanLongInt EndIndex,
-                    MilanLongInt *numGhostEdgesPtr,
-                    MilanLongInt *numGhostVerticesPtr,
-                    MilanLongInt *S,
-                    MilanLongInt *verLocInd,
-                    MilanLongInt *verLocPtr,
-                    map<MilanLongInt, MilanLongInt> &Ghost2LocalMap,
-                    vector<MilanLongInt> &Counter,
-                    vector<MilanLongInt> &verGhostPtr,
-                    vector<MilanLongInt> &verGhostInd,
-                    vector<MilanLongInt> &tempCounter,
-                    vector<MilanLongInt> &GMate,
-                    vector<MilanLongInt> &Message,
-                    vector<MilanLongInt> &QLocalVtx,
-                    vector<MilanLongInt> &QGhostVtx,
-                    vector<MilanLongInt> &QMsgType,
-                    vector<MilanInt> &QOwner,
-                    MilanLongInt *&candidateMate,
-                    vector<MilanLongInt> &U,
-                    vector<MilanLongInt> &privateU,
-                    vector<MilanLongInt> &privateQLocalVtx,
-                    vector<MilanLongInt> &privateQGhostVtx,
-                    vector<MilanLongInt> &privateQMsgType,
-                    vector<MilanInt> &privateQOwner);
-
-    void clean(MilanLongInt NLVer,
-               MilanInt myRank,
-               MilanLongInt MessageIndex,
-               vector<MPI_Request> &SRequest,
-               vector<MPI_Status> &SStatus,
-               MilanInt BufferSize,
-               MilanLongInt *Buffer,
-               MilanLongInt msgActual,
-               MilanLongInt *msgActualSent,
-               MilanLongInt msgInd,
-               MilanLongInt *msgIndSent,
-               MilanLongInt NumMessagesBundled,
-               MilanReal *msgPercent);
-
-    void PARALLEL_COMPUTE_CANDIDATE_MATE_B(MilanLongInt NLVer,
-                                           MilanLongInt *verLocPtr,
-                                           MilanLongInt *verLocInd,
-                                           MilanInt myRank,
-                                           MilanReal *edgeLocWeight,
-                                           MilanLongInt *candidateMate);
-
-    void PARALLEL_PROCESS_EXPOSED_VERTEX_B(MilanLongInt NLVer,
-                                           MilanLongInt *candidateMate,
-                                           MilanLongInt *verLocInd,
-                                           MilanLongInt *verLocPtr,
-                                           MilanLongInt StartIndex,
-                                           MilanLongInt EndIndex,
-                                           MilanLongInt *Mate,
-                                           vector<MilanLongInt> &GMate,
-                                           map<MilanLongInt, MilanLongInt> &Ghost2LocalMap,
-                                           MilanReal *edgeLocWeight,
-                                           MilanLongInt *myCardPtr,
-                                           MilanLongInt *msgIndPtr,
-                                           MilanLongInt *NumMessagesBundledPtr,
-                                           MilanLongInt *SPtr,
-                                           MilanLongInt *verDistance,
-                                           MilanLongInt *PCounter,
-                                           vector<MilanLongInt> &Counter,
-                                           MilanInt myRank,
-                                           MilanInt numProcs,
-                                           vector<MilanLongInt> &U,
-                                           vector<MilanLongInt> &privateU,
-                                           vector<MilanLongInt> &QLocalVtx,
-                                           vector<MilanLongInt> &QGhostVtx,
-                                           vector<MilanLongInt> &QMsgType,
-                                           vector<MilanInt> &QOwner,
-                                           vector<MilanLongInt> &privateQLocalVtx,
-                                           vector<MilanLongInt> &privateQGhostVtx,
-                                           vector<MilanLongInt> &privateQMsgType,
-                                           vector<MilanInt> &privateQOwner);
-
-    void PROCESS_CROSS_EDGE(MilanLongInt *edge,
-                            MilanLongInt *SPtr);
-
-    void processMatchedVertices(
-        MilanLongInt NLVer,
-        vector<MilanLongInt> &UChunkBeingProcessed,
-        vector<MilanLongInt> &U,
-        vector<MilanLongInt> &privateU,
-        MilanLongInt StartIndex,
-        MilanLongInt EndIndex,
-        MilanLongInt *myCardPtr,
-        MilanLongInt *msgIndPtr,
-        MilanLongInt *NumMessagesBundledPtr,
-        MilanLongInt *SPtr,
-        MilanLongInt *verLocPtr,
-        MilanLongInt *verLocInd,
-        MilanLongInt *verDistance,
-        MilanLongInt *PCounter,
-        vector<MilanLongInt> &Counter,
-        MilanInt myRank,
-        MilanInt numProcs,
-        MilanLongInt *candidateMate,
-        vector<MilanLongInt> &GMate,
-        MilanLongInt *Mate,
-        map<MilanLongInt, MilanLongInt> &Ghost2LocalMap,
-        MilanReal *edgeLocWeight,
-        vector<MilanLongInt> &QLocalVtx,
-        vector<MilanLongInt> &QGhostVtx,
-        vector<MilanLongInt> &QMsgType,
-        vector<MilanInt> &QOwner,
-        vector<MilanLongInt> &privateQLocalVtx,
-        vector<MilanLongInt> &privateQGhostVtx,
-        vector<MilanLongInt> &privateQMsgType,
-        vector<MilanInt> &privateQOwner);
-
-    void processMatchedVerticesAndSendMessages(
-        MilanLongInt NLVer,
-        vector<MilanLongInt> &UChunkBeingProcessed,
-        vector<MilanLongInt> &U,
-        vector<MilanLongInt> &privateU,
-        MilanLongInt StartIndex,
-        MilanLongInt EndIndex,
-        MilanLongInt *myCardPtr,
-        MilanLongInt *msgIndPtr,
-        MilanLongInt *NumMessagesBundledPtr,
-        MilanLongInt *SPtr,
-        MilanLongInt *verLocPtr,
-        MilanLongInt *verLocInd,
-        MilanLongInt *verDistance,
-        MilanLongInt *PCounter,
-        vector<MilanLongInt> &Counter,
-        MilanInt myRank,
-        MilanInt numProcs,
-        MilanLongInt *candidateMate,
-        vector<MilanLongInt> &GMate,
-        MilanLongInt *Mate,
-        map<MilanLongInt, MilanLongInt> &Ghost2LocalMap,
-        MilanReal *edgeLocWeight,
-        vector<MilanLongInt> &QLocalVtx,
-        vector<MilanLongInt> &QGhostVtx,
-        vector<MilanLongInt> &QMsgType,
-        vector<MilanInt> &QOwner,
-        vector<MilanLongInt> &privateQLocalVtx,
-        vector<MilanLongInt> &privateQGhostVtx,
-        vector<MilanLongInt> &privateQMsgType,
-        vector<MilanInt> &privateQOwner,
-        MPI_Comm comm,
-        MilanLongInt *msgActual,
-        vector<MilanLongInt> &Message);
-
-    void sendBundledMessages(MilanLongInt *numGhostEdgesPtr,
-                             MilanInt *BufferSizePtr,
-                             MilanLongInt *Buffer,
-                             vector<MilanLongInt> &PCumulative,
-                             vector<MilanLongInt> &PMessageBundle,
-                             vector<MilanLongInt> &PSizeInfoMessages,
-                             MilanLongInt *PCounter,
-                             MilanLongInt NumMessagesBundled,
-                             MilanLongInt *msgActualPtr,
-                             MilanLongInt *MessageIndexPtr,
-                             MilanInt numProcs,
-                             MilanInt myRank,
-                             MPI_Comm comm,
-                             vector<MilanLongInt> &QLocalVtx,
-                             vector<MilanLongInt> &QGhostVtx,
-                             vector<MilanLongInt> &QMsgType,
-                             vector<MilanInt> &QOwner,
-                             vector<MPI_Request> &SRequest,
-                             vector<MPI_Status> &SStatus);
-
-    void processMessages(
-        MilanLongInt NLVer,
-        MilanLongInt *Mate,
-        MilanLongInt *candidateMate,
-        map<MilanLongInt, MilanLongInt> &Ghost2LocalMap,
-        vector<MilanLongInt> &GMate,
-        vector<MilanLongInt> &Counter,
-        MilanLongInt StartIndex,
-        MilanLongInt EndIndex,
-        MilanLongInt *myCardPtr,
-        MilanLongInt *msgIndPtr,
-        MilanLongInt *msgActualPtr,
-        MilanReal *edgeLocWeight,
-        MilanLongInt *verDistance,
-        MilanLongInt *verLocPtr,
-        MilanLongInt k,
-        MilanLongInt *verLocInd,
-        MilanInt numProcs,
-        MilanInt myRank,
-        MPI_Comm comm,
-        vector<MilanLongInt> &Message,
-        MilanLongInt numGhostEdges,
-        MilanLongInt u,
-        MilanLongInt v,
-        MilanLongInt *SPtr,
-        vector<MilanLongInt> &U);
-
-    void extractUChunk(
-        vector<MilanLongInt> &UChunkBeingProcessed,
-        vector<MilanLongInt> &U,
-        vector<MilanLongInt> &privateU);
-
-    void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(
-        MilanLongInt NLVer, MilanLongInt NLEdge,
-        MilanLongInt *verLocPtr, MilanLongInt *verLocInd, MilanReal *edgeLocWeight,
-        MilanLongInt *verDistance,
-        MilanLongInt *Mate,
-        MilanInt myRank, MilanInt numProcs, MPI_Comm comm,
-        MilanLongInt *msgIndSent, MilanLongInt *msgActualSent, MilanReal *msgPercent,
-        MilanReal *ph0_time, MilanReal *ph1_time, MilanReal *ph2_time,
-        MilanLongInt *ph1_card, MilanLongInt *ph2_card);
-
-    void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC(
-        MilanLongInt NLVer, MilanLongInt NLEdge,
-        MilanLongInt *verLocPtr, MilanLongInt *verLocInd, MilanReal *edgeLocWeight,
-        MilanLongInt *verDistance,
-        MilanLongInt *Mate,
-        MilanInt myRank, MilanInt numProcs, MPI_Comm comm,
-        MilanLongInt *msgIndSent, MilanLongInt *msgActualSent, MilanReal *msgPercent,
-        MilanReal *ph0_time, MilanReal *ph1_time, MilanReal *ph2_time,
-        MilanLongInt *ph1_card, MilanLongInt *ph2_card);
-
-    void salgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC(
-        MilanLongInt NLVer, MilanLongInt NLEdge,
-        MilanLongInt *verLocPtr, MilanLongInt *verLocInd, MilanFloat *edgeLocWeight,
-        MilanLongInt *verDistance,
-        MilanLongInt *Mate,
-        MilanInt myRank, MilanInt numProcs, MPI_Comm comm,
-        MilanLongInt *msgIndSent, MilanLongInt *msgActualSent, MilanReal *msgPercent,
-        MilanReal *ph0_time, MilanReal *ph1_time, MilanReal *ph2_time,
-        MilanLongInt *ph1_card, MilanLongInt *ph2_card);
-
-    void dMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
-                     MilanLongInt *verLocPtr, MilanLongInt *verLocInd, MilanReal *edgeLocWeight,
-                     MilanLongInt *verDistance,
-                     MilanLongInt *Mate,
-                     MilanInt myRank, MilanInt numProcs, MilanInt icomm,
-                     MilanLongInt *msgIndSent, MilanLongInt *msgActualSent, MilanReal *msgPercent,
-                     MilanReal *ph0_time, MilanReal *ph1_time, MilanReal *ph2_time,
-                     MilanLongInt *ph1_card, MilanLongInt *ph2_card);
-
-    void sMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
-                     MilanLongInt *verLocPtr, MilanLongInt *verLocInd, MilanFloat *edgeLocWeight,
-                     MilanLongInt *verDistance,
-                     MilanLongInt *Mate,
-                     MilanInt myRank, MilanInt numProcs, MilanInt icomm,
-                     MilanLongInt *msgIndSent, MilanLongInt *msgActualSent, MilanReal *msgPercent,
-                     MilanReal *ph0_time, MilanReal *ph1_time, MilanReal *ph2_time,
-                     MilanLongInt *ph1_card, MilanLongInt *ph2_card);
+void sMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
+		MilanLongInt* verLocPtr, MilanLongInt* verLocInd, MilanFloat* edgeLocWeight,
+		MilanLongInt* verDistance,
+		MilanLongInt* Mate,
+		MilanInt myRank, MilanInt numProcs, MilanInt icomm,
+		MilanLongInt* msgIndSent, MilanLongInt* msgActualSent, MilanReal* msgPercent,
+		MilanReal* ph0_time, MilanReal* ph1_time, MilanReal* ph2_time,
+		MilanLongInt* ph1_card, MilanLongInt* ph2_card );
 
 #endif
 #ifdef __cplusplus

amgprec/impl/aggregator/algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC.cpp

@@ -72,6 +72,12 @@
 
 #ifdef SERIAL_MPI
 #else
+//MPI type map
+template<typename T> MPI_Datatype TypeMap();
+template<> inline MPI_Datatype TypeMap<int64_t>() { return MPI_LONG_LONG; }
+template<> inline MPI_Datatype TypeMap<int>() { return MPI_INT; }
+template<> inline MPI_Datatype TypeMap<double>() { return MPI_DOUBLE; }
+template<> inline MPI_Datatype TypeMap<float>() { return MPI_FLOAT; }
 
 // DOUBLE PRECISION VERSION
 //WARNING: The vertex block on a given rank is contiguous

amgprec/impl/aggregator/algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP.cpp

@@ -1,554 +0,0 @@
-#include "MatchBoxPC.h"
-
-// ***********************************************************************
-//
-//        MatchboxP: A C++ library for approximate weighted matching
-//               Mahantesh Halappanavar (hala@pnnl.gov)
-//               Pacific Northwest National Laboratory
-//
-// ***********************************************************************
-//
-//       Copyright (2021) Battelle Memorial Institute
-//                      All rights reserved.
-//
-// Redistribution and use in source and binary forms, with or without
-// modification, are permitted provided that the following conditions
-// are met:
-//
-// 1. Redistributions of source code must retain the above copyright
-// notice, this list of conditions and the following disclaimer.
-//
-// 2. Redistributions in binary form must reproduce the above copyright
-// notice, this list of conditions and the following disclaimer in the
-// documentation and/or other materials provided with the distribution.
-//
-// 3. Neither the name of the copyright holder nor the names of its
-// contributors may be used to endorse or promote products derived from
-// this software without specific prior written permission.
-//
-// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-// "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-// LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
-// FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
-// COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
-// INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
-// BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
-// LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-// CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
-// LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
-// ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-// POSSIBILITY OF SUCH DAMAGE.
-//
-// ************************************************************************
-//////////////////////////////////////////////////////////////////////////////////////
-/////////////////////////// DOMINATING EDGES MODEL ///////////////////////////////////
-//////////////////////////////////////////////////////////////////////////////////////
-/* Function	: algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMate()
- *
- * Date     : New update: Feb 17, 2019, Richland, Washington.
- * Date		: Original development: May 17, 2009, E&CS Bldg.
- *
- * Purpose	: Compute Approximate Maximum Weight Matching in Linear Time
- *
- * Args		: inputMatrix - instance of Compressed-Col format of Matrix
- *                Mate - The Mate array
- *
- * Returns	: By Value: (void)
- *            By Reference: Mate
- *
- * Comments	: 1/2 Approx Algorithm. Picks the locally available heaviest edge.
- *                Assumption: The Mate Array is empty.
- */
-
-/*
- NLVer = #of vertices, NLEdge = #of edges
- CSR/CSC/Compressed format: verLocPtr = Pointer, verLocInd = Index, edgeLocWeight = edge weights (positive real numbers)
- verDistance = A vector of size |P|+1 containing the cumulative number of vertices per process
- Mate = A vector of size |V_p| (local subgraph) to store the output (matching)
- MPI: myRank, numProcs, comm,
- Statistics: msgIndSent, msgActualSent, msgPercent : Size: |P| number of processes in the comm-world
- Statistics: ph0_time, ph1_time, ph2_time: Runtimes
- Statistics: ph1_card, ph2_card : Size: |P| number of processes in the comm-world (number of matched edges in Phase 1 and Phase 2)
- */
-//#define DEBUG_HANG_
-#ifdef SERIAL_MPI
-#else
-
-// DOUBLE PRECISION VERSION
-// WARNING: The vertex block on a given rank is contiguous
-void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(
-    MilanLongInt NLVer, MilanLongInt NLEdge,
-    MilanLongInt *verLocPtr, MilanLongInt *verLocInd,
-    MilanReal *edgeLocWeight,
-    MilanLongInt *verDistance,
-    MilanLongInt *Mate,
-    MilanInt myRank, MilanInt numProcs, MPI_Comm comm,
-    MilanLongInt *msgIndSent, MilanLongInt *msgActualSent,
-    MilanReal *msgPercent,
-    MilanReal *ph0_time, MilanReal *ph1_time, MilanReal *ph2_time,
-    MilanLongInt *ph1_card, MilanLongInt *ph2_card)
-{
-
-    /*
-     * verDistance: it's a vector long as the number of processors.
-     *              verDistance[i] contains the first node index of the i-th processor
-     *              verDistance[i + 1] contains the last node index of the i-th processor
-     * NLVer: number of elements in the LocPtr
-     * NLEdge: number of edges assigned to the current processor
-     *
-     * Contains the portion of matrix assigned to the processor in
-     * Yale notation
-     * verLocInd: contains the positions on row of the matrix
-     * verLocPtr: i-th value is the position of the first element on the i-th row and
-     *            i+1-th value is the position of the first element on the i+1-th row
-     */
-
-#if !defined(SERIAL_MPI)
-#ifdef PRINT_DEBUG_INFO_
-    cout << "\n(" << myRank << ")Within algoEdgeApproxDominatingEdgesLinearSearchMessageBundling()";
-    fflush(stdout);
-#endif
-
-#ifdef PRINT_DEBUG_INFO_
-    cout << "\n(" << myRank << ") verDistance [" ;
-    for (int i = 0; i < numProcs; i++)
-      cout << verDistance[i] << "," << verDistance[i+1];
-    cout  << "]\n";
-    fflush(stdout);
-#endif
-#ifdef DEBUG_HANG_
-    if (myRank == 0) {
-      cout << "\n(" << myRank << ") verDistance [" ;
-      for (int i = 0; i < numProcs; i++)
-	cout << verDistance[i] << "," ;
-      cout  << verDistance[numProcs]<< "]\n";
-    }
-    fflush(stdout);
-#endif
-
-    MilanLongInt StartIndex = verDistance[myRank];       // The starting vertex owned by the current rank
-    MilanLongInt EndIndex   = verDistance[myRank + 1] - 1; // The ending vertex owned by the current rank
-
-    MPI_Status computeStatus;
-
-    MilanLongInt msgActual = 0, msgInd = 0;
-    MilanReal heaviestEdgeWt = 0.0f; // Assumes positive weight
-    MilanReal startTime, finishTime;
-
-    startTime = MPI_Wtime();
-
-    // Data structures for sending and receiving messages:
-    vector<MilanLongInt> Message; // [ u, v, message_type ]
-    Message.resize(3, -1);
-    // Data structures for Message Bundling:
-    // Although up to two messages can be sent along any cross edge,
-    // only one message will be sent in the initialization phase -
-    // one of: REQUEST/FAILURE/SUCCESS
-    vector<MilanLongInt> QLocalVtx, QGhostVtx, QMsgType;
-    vector<MilanInt> QOwner; // Changed by Fabio to be an integer, addresses needs to be integers!
-
-    MilanLongInt *PCounter = new MilanLongInt[numProcs];
-    for (int i = 0; i < numProcs; i++)
-        PCounter[i] = 0;
-
-    MilanLongInt NumMessagesBundled = 0;
-    // TODO when the last computational section will be refactored this could be eliminated
-    MilanInt ghostOwner = 0; // Changed by Fabio to be an integer, addresses needs to be integers!
-    MilanLongInt *candidateMate = nullptr;
-#ifdef PRINT_DEBUG_INFO_
-    cout << "\n(" << myRank << ")NV: " << NLVer << "  Edges: " << NLEdge;
-    fflush(stdout);
-    cout << "\n(" << myRank << ")StartIndex: " << StartIndex << "  EndIndex: " << EndIndex;
-    fflush(stdout);
-#endif
-    // Other Variables:
-    MilanLongInt u = -1, v = -1, w = -1, i = 0;
-    MilanLongInt k = -1, adj1 = -1, adj2 = -1;
-    MilanLongInt k1 = -1, adj11 = -1, adj12 = -1;
-    MilanLongInt myCard = 0;
-
-    // Build the Ghost Vertex Set: Vg
-    map<MilanLongInt, MilanLongInt> Ghost2LocalMap;       // Map each ghost vertex to a local vertex
-    vector<MilanLongInt> Counter;                         // Store the edge count for each ghost vertex
-    MilanLongInt numGhostVertices = 0, numGhostEdges = 0; // Number of Ghost vertices
-
-#ifdef PRINT_DEBUG_INFO_
-    cout << "\n(" << myRank << ")About to compute Ghost Vertices...";
-    fflush(stdout);
-#endif
-#ifdef DEBUG_HANG_
-    if (myRank == 0)
-        cout << "\n(" << myRank << ")About to compute Ghost Vertices...";
-    fflush(stdout);
-#endif
-
-    // Define Adjacency Lists for Ghost Vertices:
-    // cout<<"Building Ghost data structures ... \n\n";
-    vector<MilanLongInt> verGhostPtr, verGhostInd, tempCounter;
-    // Mate array for ghost vertices:
-    vector<MilanLongInt> GMate; // Proportional to the number of ghost vertices
-    MilanLongInt S;
-    MilanLongInt privateMyCard = 0;
-    vector<MilanLongInt> PCumulative, PMessageBundle, PSizeInfoMessages;
-    vector<MPI_Request> SRequest;  // Requests that are used for each send message
-    vector<MPI_Status> SStatus;    // Status of sent messages, used in MPI_Wait
-    MilanLongInt MessageIndex = 0; // Pointer for current message
-    MilanInt BufferSize;
-    MilanLongInt *Buffer;
-
-    vector<MilanLongInt> privateQLocalVtx, privateQGhostVtx, privateQMsgType;
-    vector<MilanInt> privateQOwner;
-    vector<MilanLongInt> U, privateU;
-
-    initialize(NLVer, NLEdge, StartIndex,
-               EndIndex, &numGhostEdges,
-               &numGhostVertices, &S,
-               verLocInd, verLocPtr,
-               Ghost2LocalMap, Counter,
-               verGhostPtr, verGhostInd,
-               tempCounter, GMate,
-               Message, QLocalVtx,
-               QGhostVtx, QMsgType, QOwner,
-               candidateMate, U,
-               privateU,
-               privateQLocalVtx,
-               privateQGhostVtx,
-               privateQMsgType,
-               privateQOwner);
-
-    finishTime = MPI_Wtime();
-    *ph0_time = finishTime - startTime; // Time taken for Phase-0: Initialization
-#ifdef DEBUG_HANG_
-    cout << myRank << " Finished initialization" << endl;
-    fflush(stdout);
-#endif
-   
-    startTime = MPI_Wtime();
-
-    /////////////////////////////////////////////////////////////////////////////////////////
-    //////////////////////////////////// INITIALIZATION /////////////////////////////////////
-    /////////////////////////////////////////////////////////////////////////////////////////
-    // Compute the Initial Matching Set:
-
-    /*
-     * OMP PARALLEL_COMPUTE_CANDIDATE_MATE_B has been splitted from
-     * PARALLEL_PROCESS_EXPOSED_VERTEX_B in order to better parallelize
-     * the two.
-     * PARALLEL_COMPUTE_CANDIDATE_MATE_B is now totally parallel.
-     */
-
-    PARALLEL_COMPUTE_CANDIDATE_MATE_B(NLVer,
-                                      verLocPtr,
-                                      verLocInd,
-                                      myRank,
-                                      edgeLocWeight,
-                                      candidateMate);
-
-#ifdef DEBUG_HANG_
-    cout << myRank << " Finished Exposed Vertex" << endl;
-    fflush(stdout);
-#if 0
-    cout << myRank << " candidateMate after parallelCompute " <<endl;
-    for (int i=0; i<NLVer; i++) {
-      cout << candidateMate[i] << " " ;
-    }
-    cout << endl;
-#endif
-#endif
-    /*
-     * PARALLEL_PROCESS_EXPOSED_VERTEX_B
-     * TODO: write comment
-     *
-     * TODO: Test when it's actually more efficient to execute this code
-     *       in parallel.
-     */
-    PARALLEL_PROCESS_EXPOSED_VERTEX_B(NLVer,
-                                      candidateMate,
-                                      verLocInd,
-                                      verLocPtr,
-                                      StartIndex,
-                                      EndIndex,
-                                      Mate,
-                                      GMate,
-                                      Ghost2LocalMap,
-                                      edgeLocWeight,
-                                      &myCard,
-                                      &msgInd,
-                                      &NumMessagesBundled,
-                                      &S,
-                                      verDistance,
-                                      PCounter,
-                                      Counter,
-                                      myRank,
-                                      numProcs,
-                                      U,
-                                      privateU,
-                                      QLocalVtx,
-                                      QGhostVtx,
-                                      QMsgType,
-                                      QOwner,
-                                      privateQLocalVtx,
-                                      privateQGhostVtx,
-                                      privateQMsgType,
-                                      privateQOwner);
-
-    tempCounter.clear(); // Do not need this any more
-
-#ifdef DEBUG_HANG_
-    cout << myRank << " Finished Exposed Vertex" << endl;
-    fflush(stdout);
-#if 0
-    cout << myRank << " Mate after Exposed Vertices " <<endl;
-    for (int i=0; i<NLVer; i++) {
-      cout << Mate[i] << " " ;
-    }
-    cout << endl;
-#endif
-#endif
-
-    ///////////////////////////////////////////////////////////////////////////////////
-    /////////////////////////// PROCESS MATCHED VERTICES //////////////////////////////
-    ///////////////////////////////////////////////////////////////////////////////////
-
-    // TODO what would be the optimal UCHUNK
-    vector<MilanLongInt> UChunkBeingProcessed;
-    UChunkBeingProcessed.reserve(UCHUNK);
-
-    processMatchedVertices(NLVer,
-                           UChunkBeingProcessed,
-                           U,
-                           privateU,
-                           StartIndex,
-                           EndIndex,
-                           &myCard,
-                           &msgInd,
-                           &NumMessagesBundled,
-                           &S,
-                           verLocPtr,
-                           verLocInd,
-                           verDistance,
-                           PCounter,
-                           Counter,
-                           myRank,
-                           numProcs,
-                           candidateMate,
-                           GMate,
-                           Mate,
-                           Ghost2LocalMap,
-                           edgeLocWeight,
-                           QLocalVtx,
-                           QGhostVtx,
-                           QMsgType,
-                           QOwner,
-                           privateQLocalVtx,
-                           privateQGhostVtx,
-                           privateQMsgType,
-                           privateQOwner);
-
-
-#ifdef DEBUG_HANG_
-    cout << myRank << " Finished Process Vertices" << endl;
-    fflush(stdout);
-#if 0
-    cout << myRank << " Mate after Matched Vertices " <<endl;
-    for (int i=0; i<NLVer; i++) {
-      cout << Mate[i] << " " ;
-    }
-    cout << endl;
-#endif
-#endif
-
-    /////////////////////////////////////////////////////////////////////////////////////////
-    ///////////////////////////// SEND BUNDLED MESSAGES /////////////////////////////////////
-    /////////////////////////////////////////////////////////////////////////////////////////
-
-    sendBundledMessages(&numGhostEdges,
-                        &BufferSize,
-                        Buffer,
-                        PCumulative,
-                        PMessageBundle,
-                        PSizeInfoMessages,
-                        PCounter,
-                        NumMessagesBundled,
-                        &msgActual,
-                        &MessageIndex,
-                        numProcs,
-                        myRank,
-                        comm,
-                        QLocalVtx,
-                        QGhostVtx,
-                        QMsgType,
-                        QOwner,
-                        SRequest,
-                        SStatus);
-
-    ///////////////////////// END OF SEND BUNDLED MESSAGES //////////////////////////////////
-
-    finishTime = MPI_Wtime();
-    *ph1_time = finishTime - startTime; // Time taken for Phase-1
-
-#ifdef DEBUG_HANG_
-    cout << myRank << " Finished sendBundles" << endl;
-    fflush(stdout);
-#endif
- 
-    *ph1_card = myCard;                 // Cardinality at the end of Phase-1
-    startTime = MPI_Wtime();
-    /////////////////////////////////////////////////////////////////////////////////////////
-    //////////////////////////////////////// MAIN LOOP //////////////////////////////////////
-    /////////////////////////////////////////////////////////////////////////////////////////
-    // Main While Loop:
-#ifdef PRINT_DEBUG_INFO_
-    cout << "\n(" << myRank << "=========================************===============================" << endl;
-    fflush(stdout);
-    fflush(stdout);
-#endif
-#ifdef PRINT_DEBUG_INFO_
-    cout << "\n(" << myRank << ")Entering While(true) loop..";
-    fflush(stdout);
-#endif
-#ifdef PRINT_DEBUG_INFO_
-    cout << "\n(" << myRank << "=========================************===============================" << endl;
-    fflush(stdout);
-    fflush(stdout);
-#endif
-
-    while (true)  {
-#ifdef DEBUG_HANG_
-      //if (myRank == 0)
-      cout << "\n(" << myRank << ") Main loop" << endl;
-      fflush(stdout);
-#endif
-        ///////////////////////////////////////////////////////////////////////////////////
-        /////////////////////////// PROCESS MATCHED VERTICES //////////////////////////////
-        ///////////////////////////////////////////////////////////////////////////////////
-      
-      processMatchedVerticesAndSendMessages(NLVer,
-					    UChunkBeingProcessed,
-					    U,
-					    privateU,
-					    StartIndex,
-					    EndIndex,
-					    &myCard,
-					    &msgInd,
-					    &NumMessagesBundled,
-					    &S,
-					    verLocPtr,
-					    verLocInd,
-					    verDistance,
-					    PCounter,
-					    Counter,
-					    myRank,
-					    numProcs,
-					    candidateMate,
-					    GMate,
-					    Mate,
-					    Ghost2LocalMap,
-					    edgeLocWeight,
-					    QLocalVtx,
-					    QGhostVtx,
-					    QMsgType,
-					    QOwner,
-					    privateQLocalVtx,
-					    privateQGhostVtx,
-					    privateQMsgType,
-					    privateQOwner,
-					    comm,
-					    &msgActual,
-					    Message);
-      
-      ///////////////////////// END OF PROCESS MATCHED VERTICES /////////////////////////
-
-        //// BREAK IF NO MESSAGES EXPECTED /////////
-#ifdef DEBUG_HANG_
-#if 0
-      cout << myRank << " Mate after ProcessMatchedAndSend phase "<<S <<endl;
-      for (int i=0; i<NLVer; i++) {
-	cout << Mate[i] << " " ;
-      }
-      cout << endl;
-#endif
-#endif
-#ifdef PRINT_DEBUG_INFO_
-        cout << "\n(" << myRank << ")Deciding whether to break: S= " << S << endl;
-#endif
-
-        if (S == 0) {
-#ifdef DEBUG_HANG_
-	  cout << "\n(" << myRank << ") Breaking out" << endl;
-	  fflush(stdout);
-#endif
-	  break;
-        }
-        ///////////////////////////////////////////////////////////////////////////////////
-        /////////////////////////// PROCESS MESSAGES //////////////////////////////////////
-        ///////////////////////////////////////////////////////////////////////////////////
-
-        processMessages(NLVer,
-                        Mate,
-                        candidateMate,
-                        Ghost2LocalMap,
-                        GMate,
-                        Counter,
-                        StartIndex,
-                        EndIndex,
-                        &myCard,
-                        &msgInd,
-                        &msgActual,
-                        edgeLocWeight,
-                        verDistance,
-                        verLocPtr,
-                        k,
-                        verLocInd,
-                        numProcs,
-                        myRank,
-                        comm,
-                        Message,
-                        numGhostEdges,
-                        u,
-                        v,
-                        &S,
-                        U);
-
-        ///////////////////////// END OF PROCESS MESSAGES /////////////////////////////////
-#ifdef DEBUG_HANG_
-#if 0
-      cout << myRank << " Mate after ProcessMessages phase "<<S <<endl;
-      for (int i=0; i<NLVer; i++) {
-	cout << Mate[i] << " " ;
-      }
-      cout << endl;
-#endif
-#endif
-#ifdef PRINT_DEBUG_INFO_
-        cout << "\n(" << myRank << ")Finished Message processing phase: S= " << S;
-        fflush(stdout);
-        cout << "\n(" << myRank << ")** SENT     : ACTUAL= " << msgActual;
-        fflush(stdout);
-        cout << "\n(" << myRank << ")** SENT     : INDIVIDUAL= " << msgInd << endl;
-        fflush(stdout);
-#endif
-    } // End of while (true)
-
-    clean(NLVer,
-          myRank,
-          MessageIndex,
-          SRequest,
-          SStatus,
-          BufferSize,
-          Buffer,
-          msgActual,
-          msgActualSent,
-          msgInd,
-          msgIndSent,
-          NumMessagesBundled,
-          msgPercent);
-
-    finishTime = MPI_Wtime();
-    *ph2_time = finishTime - startTime; // Time taken for Phase-2
-    *ph2_card = myCard;                 // Cardinality at the end of Phase-2
-}
-// End of algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMate
-#endif
-
-#endif

amgprec/impl/aggregator/amg_c_dec_aggregator_tprol.f90

@@ -97,8 +97,6 @@ subroutine  amg_c_dec_aggregator_build_tprol(ag,parms,ag_data,&
   integer(psb_lpk_)   :: ntaggr
   integer(psb_ipk_)   :: debug_level, debug_unit
   logical             :: clean_zeros
-  integer(psb_ipk_), save :: idx_map_bld=-1, idx_map_tprol=-1
-  logical, parameter      :: do_timings=.false.
 
   name='amg_c_dec_aggregator_tprol'
   call psb_erractionsave(err_act)
@@ -110,10 +108,6 @@ subroutine  amg_c_dec_aggregator_build_tprol(ag,parms,ag_data,&
   info  = psb_success_
   ctxt = desc_a%get_context()
   call psb_info(ctxt,me,np)
-  if ((do_timings).and.(idx_map_bld==-1))       &
-       & idx_map_bld = psb_get_timer_idx("DEC_TPROL: map_bld")
-  if ((do_timings).and.(idx_map_tprol==-1))     &
-       & idx_map_tprol = psb_get_timer_idx("DEC_TPROL: map_tprol")
 
   call amg_check_def(parms%ml_cycle,'Multilevel cycle',&
        &   amg_mult_ml_,is_legal_ml_cycle)
@@ -127,14 +121,10 @@ subroutine  amg_c_dec_aggregator_build_tprol(ag,parms,ag_data,&
   ! The decoupled aggregator based on SOC measures ignores
   ! ag_data except for clean_zeros; soc_map_bld is a procedure pointer.
   !
-  if (do_timings) call psb_tic(idx_map_bld)
   clean_zeros = ag%do_clean_zeros
   call ag%soc_map_bld(parms%aggr_ord,parms%aggr_thresh,clean_zeros,a,desc_a,nlaggr,ilaggr,info)
-  if (do_timings) call psb_toc(idx_map_bld)
-  if (do_timings) call psb_tic(idx_map_tprol)
 
   if (info==psb_success_) call amg_map_to_tprol(desc_a,ilaggr,nlaggr,t_prol,info)
-  if (do_timings) call psb_toc(idx_map_tprol)
   if (info /= psb_success_) then
     info=psb_err_from_subroutine_
     call psb_errpush(info,name,a_err='soc_map_bld/map_to_tprol')

amgprec/impl/aggregator/amg_caggrmat_smth_bld.f90

@@ -140,9 +140,6 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
   real(psb_spk_)     :: anorm, omega, tmp, dg, theta
   logical, parameter :: debug_new=.false.
   character(len=80) :: filename
-  logical, parameter :: do_timings=.false.
-  integer(psb_ipk_), save :: idx_spspmm=-1, idx_phase1=-1, idx_gtrans=-1, idx_phase2=-1, idx_refine=-1
-  integer(psb_ipk_), save :: idx_phase3=-1, idx_cdasb=-1, idx_ptap=-1
 
   name='amg_aggrmat_smth_bld'
   info=psb_success_
@@ -156,23 +153,6 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
   ctxt = desc_a%get_context()
 
   call psb_info(ctxt, me, np)
-  if ((do_timings).and.(idx_spspmm==-1)) &
-       & idx_spspmm = psb_get_timer_idx("DEC_SMTH_BLD: par_spspmm")
-  if ((do_timings).and.(idx_phase1==-1)) &
-       & idx_phase1 = psb_get_timer_idx("DEC_SMTH_BLD: phase1    ")
-  if ((do_timings).and.(idx_phase2==-1)) &
-       & idx_phase2 = psb_get_timer_idx("DEC_SMTH_BLD: phase2    ")
-  if ((do_timings).and.(idx_phase3==-1)) &
-       & idx_phase3 = psb_get_timer_idx("DEC_SMTH_BLD: phase3    ")
-  if ((do_timings).and.(idx_gtrans==-1)) &
-       & idx_gtrans = psb_get_timer_idx("DEC_SMTH_BLD: gtrans    ")
-  if ((do_timings).and.(idx_refine==-1)) &
-       & idx_refine = psb_get_timer_idx("DEC_SMTH_BLD: refine    ")
-  if ((do_timings).and.(idx_cdasb==-1)) &
-       & idx_cdasb = psb_get_timer_idx("DEC_SMTH_BLD: cdasb     ")
-  if ((do_timings).and.(idx_ptap==-1)) &
-       & idx_ptap = psb_get_timer_idx("DEC_SMTH_BLD: ptap_bld  ")
-
 
   nglob = desc_a%get_global_rows()
   nrow  = desc_a%get_local_rows()
@@ -191,7 +171,6 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
   ! naggr: number of local aggregates
   ! nrow: local rows. 
   ! 
-  if (do_timings) call psb_tic(idx_phase1)
 
   ! Get the diagonal D
   adiag = a%get_diag(info)
@@ -217,7 +196,7 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
     !
     ! Build the filtered matrix Af from A
     ! 
-    !$OMP parallel do private(i,j,tmp,jd) schedule(static)
+
     do i=1, nrow
       tmp = czero
       jd  = -1 
@@ -235,13 +214,11 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
         acsrf%val(jd)=acsrf%val(jd)-tmp
       end if
     enddo
-    !$OMP end parallel do 
     ! Take out zeroed terms 
     call acsrf%clean_zeros(info)
   end if
 
 
-  !$OMP parallel do private(i) schedule(static)
   do i=1,size(adiag)
     if (adiag(i) /= czero) then
       adiag(i) = cone / adiag(i)
@@ -249,7 +226,7 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
       adiag(i) = cone
     end if
   end do
-  !$OMP end parallel do 
+
   if (parms%aggr_omega_alg == amg_eig_est_) then 
 
     if (parms%aggr_eig == amg_max_norm_) then 
@@ -275,9 +252,8 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
     call psb_errpush(info,name,a_err='invalid amg_aggr_omega_alg_')
     goto 9999
   end if
-  if (do_timings) call psb_toc(idx_phase1)
 
-  if (do_timings) call psb_tic(idx_phase2)
+  
   call acsrf%scal(adiag,info)
   if (info /= psb_success_) goto 9999
 
@@ -291,8 +267,6 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
 
   call psb_cdasb(desc_ac,info)
   call psb_cd_reinit(desc_ac,info)
-  if (do_timings) call psb_toc(idx_phase2)
-  if (do_timings) call psb_tic(idx_phase3)
   !
   ! Build the smoothed prolongator using either A or Af
   !    acsr1 = (I-w*D*A) Prol      acsr1 = (I-w*D*Af) Prol 
@@ -305,8 +279,8 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
     call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 1')
     goto 9999
   end if
-  if (do_timings) call psb_toc(idx_phase3)
-  if (do_timings) call psb_tic(idx_ptap)
+
+
   if (debug_level >= psb_debug_outer_) &
        & write(debug_unit,*) me,' ',trim(name),&
        & 'Done SPSPMM 1'
@@ -318,7 +292,7 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
 
   call op_prol%mv_from(coo_prol)
   call op_restr%mv_from(coo_restr)
-  if (do_timings) call psb_toc(idx_ptap)
+
   if (debug_level >= psb_debug_outer_) &
        & write(debug_unit,*) me,' ',trim(name),&
        & 'Done smooth_aggregate '

amgprec/impl/aggregator/amg_d_dec_aggregator_tprol.f90

@@ -97,8 +97,6 @@ subroutine  amg_d_dec_aggregator_build_tprol(ag,parms,ag_data,&
   integer(psb_lpk_)   :: ntaggr
   integer(psb_ipk_)   :: debug_level, debug_unit
   logical             :: clean_zeros
-  integer(psb_ipk_), save :: idx_map_bld=-1, idx_map_tprol=-1
-  logical, parameter      :: do_timings=.false.
 
   name='amg_d_dec_aggregator_tprol'
   call psb_erractionsave(err_act)
@@ -110,10 +108,6 @@ subroutine  amg_d_dec_aggregator_build_tprol(ag,parms,ag_data,&
   info  = psb_success_
   ctxt = desc_a%get_context()
   call psb_info(ctxt,me,np)
-  if ((do_timings).and.(idx_map_bld==-1))       &
-       & idx_map_bld = psb_get_timer_idx("DEC_TPROL: map_bld")
-  if ((do_timings).and.(idx_map_tprol==-1))     &
-       & idx_map_tprol = psb_get_timer_idx("DEC_TPROL: map_tprol")
 
   call amg_check_def(parms%ml_cycle,'Multilevel cycle',&
        &   amg_mult_ml_,is_legal_ml_cycle)
@@ -127,14 +121,10 @@ subroutine  amg_d_dec_aggregator_build_tprol(ag,parms,ag_data,&
   ! The decoupled aggregator based on SOC measures ignores
   ! ag_data except for clean_zeros; soc_map_bld is a procedure pointer.
   !
-  if (do_timings) call psb_tic(idx_map_bld)
   clean_zeros = ag%do_clean_zeros
   call ag%soc_map_bld(parms%aggr_ord,parms%aggr_thresh,clean_zeros,a,desc_a,nlaggr,ilaggr,info)
-  if (do_timings) call psb_toc(idx_map_bld)
-  if (do_timings) call psb_tic(idx_map_tprol)
 
   if (info==psb_success_) call amg_map_to_tprol(desc_a,ilaggr,nlaggr,t_prol,info)
-  if (do_timings) call psb_toc(idx_map_tprol)
   if (info /= psb_success_) then
     info=psb_err_from_subroutine_
     call psb_errpush(info,name,a_err='soc_map_bld/map_to_tprol')

amgprec/impl/aggregator/amg_daggrmat_smth_bld.f90

@@ -140,9 +140,6 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
   real(psb_dpk_)     :: anorm, omega, tmp, dg, theta
   logical, parameter :: debug_new=.false.
   character(len=80) :: filename
-  logical, parameter :: do_timings=.false.
-  integer(psb_ipk_), save :: idx_spspmm=-1, idx_phase1=-1, idx_gtrans=-1, idx_phase2=-1, idx_refine=-1
-  integer(psb_ipk_), save :: idx_phase3=-1, idx_cdasb=-1, idx_ptap=-1
 
   name='amg_aggrmat_smth_bld'
   info=psb_success_
@@ -156,23 +153,6 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
   ctxt = desc_a%get_context()
 
   call psb_info(ctxt, me, np)
-  if ((do_timings).and.(idx_spspmm==-1)) &
-       & idx_spspmm = psb_get_timer_idx("DEC_SMTH_BLD: par_spspmm")
-  if ((do_timings).and.(idx_phase1==-1)) &
-       & idx_phase1 = psb_get_timer_idx("DEC_SMTH_BLD: phase1    ")
-  if ((do_timings).and.(idx_phase2==-1)) &
-       & idx_phase2 = psb_get_timer_idx("DEC_SMTH_BLD: phase2    ")
-  if ((do_timings).and.(idx_phase3==-1)) &
-       & idx_phase3 = psb_get_timer_idx("DEC_SMTH_BLD: phase3    ")
-  if ((do_timings).and.(idx_gtrans==-1)) &
-       & idx_gtrans = psb_get_timer_idx("DEC_SMTH_BLD: gtrans    ")
-  if ((do_timings).and.(idx_refine==-1)) &
-       & idx_refine = psb_get_timer_idx("DEC_SMTH_BLD: refine    ")
-  if ((do_timings).and.(idx_cdasb==-1)) &
-       & idx_cdasb = psb_get_timer_idx("DEC_SMTH_BLD: cdasb     ")
-  if ((do_timings).and.(idx_ptap==-1)) &
-       & idx_ptap = psb_get_timer_idx("DEC_SMTH_BLD: ptap_bld  ")
-
 
   nglob = desc_a%get_global_rows()
   nrow  = desc_a%get_local_rows()
@@ -191,7 +171,6 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
   ! naggr: number of local aggregates
   ! nrow: local rows. 
   ! 
-  if (do_timings) call psb_tic(idx_phase1)
 
   ! Get the diagonal D
   adiag = a%get_diag(info)
@@ -217,7 +196,7 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
     !
     ! Build the filtered matrix Af from A
     ! 
-    !$OMP parallel do private(i,j,tmp,jd) schedule(static)
+
     do i=1, nrow
       tmp = dzero
       jd  = -1 
@@ -235,13 +214,11 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
         acsrf%val(jd)=acsrf%val(jd)-tmp
       end if
     enddo
-    !$OMP end parallel do 
     ! Take out zeroed terms 
     call acsrf%clean_zeros(info)
   end if
 
 
-  !$OMP parallel do private(i) schedule(static)
   do i=1,size(adiag)
     if (adiag(i) /= dzero) then
       adiag(i) = done / adiag(i)
@@ -249,7 +226,7 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
       adiag(i) = done
     end if
   end do
-  !$OMP end parallel do 
+
   if (parms%aggr_omega_alg == amg_eig_est_) then 
 
     if (parms%aggr_eig == amg_max_norm_) then 
@@ -275,9 +252,8 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
     call psb_errpush(info,name,a_err='invalid amg_aggr_omega_alg_')
     goto 9999
   end if
-  if (do_timings) call psb_toc(idx_phase1)
 
-  if (do_timings) call psb_tic(idx_phase2)
+  
   call acsrf%scal(adiag,info)
   if (info /= psb_success_) goto 9999
 
@@ -291,8 +267,6 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
 
   call psb_cdasb(desc_ac,info)
   call psb_cd_reinit(desc_ac,info)
-  if (do_timings) call psb_toc(idx_phase2)
-  if (do_timings) call psb_tic(idx_phase3)
   !
   ! Build the smoothed prolongator using either A or Af
   !    acsr1 = (I-w*D*A) Prol      acsr1 = (I-w*D*Af) Prol 
@@ -305,8 +279,8 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
     call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 1')
     goto 9999
   end if
-  if (do_timings) call psb_toc(idx_phase3)
-  if (do_timings) call psb_tic(idx_ptap)
+
+
   if (debug_level >= psb_debug_outer_) &
        & write(debug_unit,*) me,' ',trim(name),&
        & 'Done SPSPMM 1'
@@ -318,7 +292,7 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
 
   call op_prol%mv_from(coo_prol)
   call op_restr%mv_from(coo_restr)
-  if (do_timings) call psb_toc(idx_ptap)
+
   if (debug_level >= psb_debug_outer_) &
        & write(debug_unit,*) me,' ',trim(name),&
        & 'Done smooth_aggregate '

amgprec/impl/aggregator/amg_s_dec_aggregator_tprol.f90

@@ -97,8 +97,6 @@ subroutine  amg_s_dec_aggregator_build_tprol(ag,parms,ag_data,&
   integer(psb_lpk_)   :: ntaggr
   integer(psb_ipk_)   :: debug_level, debug_unit
   logical             :: clean_zeros
-  integer(psb_ipk_), save :: idx_map_bld=-1, idx_map_tprol=-1
-  logical, parameter      :: do_timings=.false.
 
   name='amg_s_dec_aggregator_tprol'
   call psb_erractionsave(err_act)
@@ -110,10 +108,6 @@ subroutine  amg_s_dec_aggregator_build_tprol(ag,parms,ag_data,&
   info  = psb_success_
   ctxt = desc_a%get_context()
   call psb_info(ctxt,me,np)
-  if ((do_timings).and.(idx_map_bld==-1))       &
-       & idx_map_bld = psb_get_timer_idx("DEC_TPROL: map_bld")
-  if ((do_timings).and.(idx_map_tprol==-1))     &
-       & idx_map_tprol = psb_get_timer_idx("DEC_TPROL: map_tprol")
 
   call amg_check_def(parms%ml_cycle,'Multilevel cycle',&
        &   amg_mult_ml_,is_legal_ml_cycle)
@@ -127,14 +121,10 @@ subroutine  amg_s_dec_aggregator_build_tprol(ag,parms,ag_data,&
   ! The decoupled aggregator based on SOC measures ignores
   ! ag_data except for clean_zeros; soc_map_bld is a procedure pointer.
   !
-  if (do_timings) call psb_tic(idx_map_bld)
   clean_zeros = ag%do_clean_zeros
   call ag%soc_map_bld(parms%aggr_ord,parms%aggr_thresh,clean_zeros,a,desc_a,nlaggr,ilaggr,info)
-  if (do_timings) call psb_toc(idx_map_bld)
-  if (do_timings) call psb_tic(idx_map_tprol)
 
   if (info==psb_success_) call amg_map_to_tprol(desc_a,ilaggr,nlaggr,t_prol,info)
-  if (do_timings) call psb_toc(idx_map_tprol)
   if (info /= psb_success_) then
     info=psb_err_from_subroutine_
     call psb_errpush(info,name,a_err='soc_map_bld/map_to_tprol')

amgprec/impl/aggregator/amg_saggrmat_smth_bld.f90

@@ -140,9 +140,6 @@ subroutine amg_saggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
   real(psb_spk_)     :: anorm, omega, tmp, dg, theta
   logical, parameter :: debug_new=.false.
   character(len=80) :: filename
-  logical, parameter :: do_timings=.false.
-  integer(psb_ipk_), save :: idx_spspmm=-1, idx_phase1=-1, idx_gtrans=-1, idx_phase2=-1, idx_refine=-1
-  integer(psb_ipk_), save :: idx_phase3=-1, idx_cdasb=-1, idx_ptap=-1
 
   name='amg_aggrmat_smth_bld'
   info=psb_success_
@@ -156,23 +153,6 @@ subroutine amg_saggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
   ctxt = desc_a%get_context()
 
   call psb_info(ctxt, me, np)
-  if ((do_timings).and.(idx_spspmm==-1)) &
-       & idx_spspmm = psb_get_timer_idx("DEC_SMTH_BLD: par_spspmm")
-  if ((do_timings).and.(idx_phase1==-1)) &
-       & idx_phase1 = psb_get_timer_idx("DEC_SMTH_BLD: phase1    ")
-  if ((do_timings).and.(idx_phase2==-1)) &
-       & idx_phase2 = psb_get_timer_idx("DEC_SMTH_BLD: phase2    ")
-  if ((do_timings).and.(idx_phase3==-1)) &
-       & idx_phase3 = psb_get_timer_idx("DEC_SMTH_BLD: phase3    ")
-  if ((do_timings).and.(idx_gtrans==-1)) &
-       & idx_gtrans = psb_get_timer_idx("DEC_SMTH_BLD: gtrans    ")
-  if ((do_timings).and.(idx_refine==-1)) &
-       & idx_refine = psb_get_timer_idx("DEC_SMTH_BLD: refine    ")
-  if ((do_timings).and.(idx_cdasb==-1)) &
-       & idx_cdasb = psb_get_timer_idx("DEC_SMTH_BLD: cdasb     ")
-  if ((do_timings).and.(idx_ptap==-1)) &
-       & idx_ptap = psb_get_timer_idx("DEC_SMTH_BLD: ptap_bld  ")
-
 
   nglob = desc_a%get_global_rows()
   nrow  = desc_a%get_local_rows()
@@ -191,7 +171,6 @@ subroutine amg_saggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
   ! naggr: number of local aggregates
   ! nrow: local rows. 
   ! 
-  if (do_timings) call psb_tic(idx_phase1)
 
   ! Get the diagonal D
   adiag = a%get_diag(info)
@@ -217,7 +196,7 @@ subroutine amg_saggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
     !
     ! Build the filtered matrix Af from A
     ! 
-    !$OMP parallel do private(i,j,tmp,jd) schedule(static)
+
     do i=1, nrow
       tmp = szero
       jd  = -1 
@@ -235,13 +214,11 @@ subroutine amg_saggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
         acsrf%val(jd)=acsrf%val(jd)-tmp
       end if
     enddo
-    !$OMP end parallel do 
     ! Take out zeroed terms 
     call acsrf%clean_zeros(info)
   end if
 
 
-  !$OMP parallel do private(i) schedule(static)
   do i=1,size(adiag)
     if (adiag(i) /= szero) then
       adiag(i) = sone / adiag(i)
@@ -249,7 +226,7 @@ subroutine amg_saggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
       adiag(i) = sone
     end if
   end do
-  !$OMP end parallel do 
+
   if (parms%aggr_omega_alg == amg_eig_est_) then 
 
     if (parms%aggr_eig == amg_max_norm_) then 
@@ -275,9 +252,8 @@ subroutine amg_saggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
     call psb_errpush(info,name,a_err='invalid amg_aggr_omega_alg_')
     goto 9999
   end if
-  if (do_timings) call psb_toc(idx_phase1)
 
-  if (do_timings) call psb_tic(idx_phase2)
+  
   call acsrf%scal(adiag,info)
   if (info /= psb_success_) goto 9999
 
@@ -291,8 +267,6 @@ subroutine amg_saggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
 
   call psb_cdasb(desc_ac,info)
   call psb_cd_reinit(desc_ac,info)
-  if (do_timings) call psb_toc(idx_phase2)
-  if (do_timings) call psb_tic(idx_phase3)
   !
   ! Build the smoothed prolongator using either A or Af
   !    acsr1 = (I-w*D*A) Prol      acsr1 = (I-w*D*Af) Prol 
@@ -305,8 +279,8 @@ subroutine amg_saggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
     call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 1')
     goto 9999
   end if
-  if (do_timings) call psb_toc(idx_phase3)
-  if (do_timings) call psb_tic(idx_ptap)
+
+
   if (debug_level >= psb_debug_outer_) &
        & write(debug_unit,*) me,' ',trim(name),&
        & 'Done SPSPMM 1'
@@ -318,7 +292,7 @@ subroutine amg_saggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
 
   call op_prol%mv_from(coo_prol)
   call op_restr%mv_from(coo_restr)
-  if (do_timings) call psb_toc(idx_ptap)
+
   if (debug_level >= psb_debug_outer_) &
        & write(debug_unit,*) me,' ',trim(name),&
        & 'Done smooth_aggregate '

amgprec/impl/aggregator/amg_z_dec_aggregator_tprol.f90

@@ -97,8 +97,6 @@ subroutine  amg_z_dec_aggregator_build_tprol(ag,parms,ag_data,&
   integer(psb_lpk_)   :: ntaggr
   integer(psb_ipk_)   :: debug_level, debug_unit
   logical             :: clean_zeros
-  integer(psb_ipk_), save :: idx_map_bld=-1, idx_map_tprol=-1
-  logical, parameter      :: do_timings=.false.
 
   name='amg_z_dec_aggregator_tprol'
   call psb_erractionsave(err_act)
@@ -110,10 +108,6 @@ subroutine  amg_z_dec_aggregator_build_tprol(ag,parms,ag_data,&
   info  = psb_success_
   ctxt = desc_a%get_context()
   call psb_info(ctxt,me,np)
-  if ((do_timings).and.(idx_map_bld==-1))       &
-       & idx_map_bld = psb_get_timer_idx("DEC_TPROL: map_bld")
-  if ((do_timings).and.(idx_map_tprol==-1))     &
-       & idx_map_tprol = psb_get_timer_idx("DEC_TPROL: map_tprol")
 
   call amg_check_def(parms%ml_cycle,'Multilevel cycle',&
        &   amg_mult_ml_,is_legal_ml_cycle)
@@ -127,14 +121,10 @@ subroutine  amg_z_dec_aggregator_build_tprol(ag,parms,ag_data,&
   ! The decoupled aggregator based on SOC measures ignores
   ! ag_data except for clean_zeros; soc_map_bld is a procedure pointer.
   !
-  if (do_timings) call psb_tic(idx_map_bld)
   clean_zeros = ag%do_clean_zeros
   call ag%soc_map_bld(parms%aggr_ord,parms%aggr_thresh,clean_zeros,a,desc_a,nlaggr,ilaggr,info)
-  if (do_timings) call psb_toc(idx_map_bld)
-  if (do_timings) call psb_tic(idx_map_tprol)
 
   if (info==psb_success_) call amg_map_to_tprol(desc_a,ilaggr,nlaggr,t_prol,info)
-  if (do_timings) call psb_toc(idx_map_tprol)
   if (info /= psb_success_) then
     info=psb_err_from_subroutine_
     call psb_errpush(info,name,a_err='soc_map_bld/map_to_tprol')

amgprec/impl/aggregator/amg_zaggrmat_smth_bld.f90

@@ -140,9 +140,6 @@ subroutine amg_zaggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
   real(psb_dpk_)     :: anorm, omega, tmp, dg, theta
   logical, parameter :: debug_new=.false.
   character(len=80) :: filename
-  logical, parameter :: do_timings=.false.
-  integer(psb_ipk_), save :: idx_spspmm=-1, idx_phase1=-1, idx_gtrans=-1, idx_phase2=-1, idx_refine=-1
-  integer(psb_ipk_), save :: idx_phase3=-1, idx_cdasb=-1, idx_ptap=-1
 
   name='amg_aggrmat_smth_bld'
   info=psb_success_
@@ -156,23 +153,6 @@ subroutine amg_zaggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
   ctxt = desc_a%get_context()
 
   call psb_info(ctxt, me, np)
-  if ((do_timings).and.(idx_spspmm==-1)) &
-       & idx_spspmm = psb_get_timer_idx("DEC_SMTH_BLD: par_spspmm")
-  if ((do_timings).and.(idx_phase1==-1)) &
-       & idx_phase1 = psb_get_timer_idx("DEC_SMTH_BLD: phase1    ")
-  if ((do_timings).and.(idx_phase2==-1)) &
-       & idx_phase2 = psb_get_timer_idx("DEC_SMTH_BLD: phase2    ")
-  if ((do_timings).and.(idx_phase3==-1)) &
-       & idx_phase3 = psb_get_timer_idx("DEC_SMTH_BLD: phase3    ")
-  if ((do_timings).and.(idx_gtrans==-1)) &
-       & idx_gtrans = psb_get_timer_idx("DEC_SMTH_BLD: gtrans    ")
-  if ((do_timings).and.(idx_refine==-1)) &
-       & idx_refine = psb_get_timer_idx("DEC_SMTH_BLD: refine    ")
-  if ((do_timings).and.(idx_cdasb==-1)) &
-       & idx_cdasb = psb_get_timer_idx("DEC_SMTH_BLD: cdasb     ")
-  if ((do_timings).and.(idx_ptap==-1)) &
-       & idx_ptap = psb_get_timer_idx("DEC_SMTH_BLD: ptap_bld  ")
-
 
   nglob = desc_a%get_global_rows()
   nrow  = desc_a%get_local_rows()
@@ -191,7 +171,6 @@ subroutine amg_zaggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
   ! naggr: number of local aggregates
   ! nrow: local rows. 
   ! 
-  if (do_timings) call psb_tic(idx_phase1)
 
   ! Get the diagonal D
   adiag = a%get_diag(info)
@@ -217,7 +196,7 @@ subroutine amg_zaggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
     !
     ! Build the filtered matrix Af from A
     ! 
-    !$OMP parallel do private(i,j,tmp,jd) schedule(static)
+
     do i=1, nrow
       tmp = zzero
       jd  = -1 
@@ -235,13 +214,11 @@ subroutine amg_zaggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
         acsrf%val(jd)=acsrf%val(jd)-tmp
       end if
     enddo
-    !$OMP end parallel do 
     ! Take out zeroed terms 
     call acsrf%clean_zeros(info)
   end if
 
 
-  !$OMP parallel do private(i) schedule(static)
   do i=1,size(adiag)
     if (adiag(i) /= zzero) then
       adiag(i) = zone / adiag(i)
@@ -249,7 +226,7 @@ subroutine amg_zaggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
       adiag(i) = zone
     end if
   end do
-  !$OMP end parallel do 
+
   if (parms%aggr_omega_alg == amg_eig_est_) then 
 
     if (parms%aggr_eig == amg_max_norm_) then 
@@ -275,9 +252,8 @@ subroutine amg_zaggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
     call psb_errpush(info,name,a_err='invalid amg_aggr_omega_alg_')
     goto 9999
   end if
-  if (do_timings) call psb_toc(idx_phase1)
 
-  if (do_timings) call psb_tic(idx_phase2)
+  
   call acsrf%scal(adiag,info)
   if (info /= psb_success_) goto 9999
 
@@ -291,8 +267,6 @@ subroutine amg_zaggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
 
   call psb_cdasb(desc_ac,info)
   call psb_cd_reinit(desc_ac,info)
-  if (do_timings) call psb_toc(idx_phase2)
-  if (do_timings) call psb_tic(idx_phase3)
   !
   ! Build the smoothed prolongator using either A or Af
   !    acsr1 = (I-w*D*A) Prol      acsr1 = (I-w*D*Af) Prol 
@@ -305,8 +279,8 @@ subroutine amg_zaggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
     call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 1')
     goto 9999
   end if
-  if (do_timings) call psb_toc(idx_phase3)
-  if (do_timings) call psb_tic(idx_ptap)
+
+
   if (debug_level >= psb_debug_outer_) &
        & write(debug_unit,*) me,' ',trim(name),&
        & 'Done SPSPMM 1'
@@ -318,7 +292,7 @@ subroutine amg_zaggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
 
   call op_prol%mv_from(coo_prol)
   call op_restr%mv_from(coo_restr)
-  if (do_timings) call psb_toc(idx_ptap)
+
   if (debug_level >= psb_debug_outer_) &
        & write(debug_unit,*) me,' ',trim(name),&
        & 'Done smooth_aggregate '

amgprec/impl/aggregator/clean.cpp

@@ -1,91 +0,0 @@
-#include "MatchBoxPC.h"
-
-// TODO comment
-
-void clean(MilanLongInt NLVer,
-           MilanInt myRank,
-           MilanLongInt MessageIndex,
-           vector<MPI_Request> &SRequest,
-           vector<MPI_Status> &SStatus,
-           MilanInt BufferSize,
-           MilanLongInt *Buffer,
-           MilanLongInt msgActual,
-           MilanLongInt *msgActualSent,
-           MilanLongInt msgInd,
-           MilanLongInt *msgIndSent,
-           MilanLongInt NumMessagesBundled,
-           MilanReal *msgPercent)
-{
-    // Cleanup Phase
-
-#pragma omp parallel
-    {
-#pragma omp master
-        {
-#pragma omp task
-            {
-
-#ifdef PRINT_DEBUG_INFO_
-                cout << "\n(" << myRank << ") Waitall= " << endl;
-                fflush(stdout);
-#endif
-#ifdef DEBUG_HANG_
-                cout << "\n(" << myRank << ") Waitall " << endl;
-                fflush(stdout);
-#endif
-                //return;
-
-                MPI_Waitall(MessageIndex, &SRequest[0], &SStatus[0]);
-
-                // MPI_Buffer_attach(&Buffer, BufferSize); //Attach the Buffer
-                if (BufferSize > 0)
-                {
-                    MPI_Buffer_detach(&Buffer, &BufferSize); // Detach the Buffer
-                    free(Buffer);                            // Free the memory that was allocated
-                }
-            }
-
-#ifdef PRINT_DEBUG_INFO_
-            cout << "\n(" << myRank << ")End of function to compute matching: " << endl;
-            fflush(stdout);
-            cout << "\n(" << myRank << ")myCardinality: " << myCard << endl;
-            fflush(stdout);
-            cout << "\n(" << myRank << ")Matching took " << finishTime - startTime << "seconds" << endl;
-            fflush(stdout);
-            cout << "\n(" << myRank << ")** Getting out of the matching function **" << endl;
-            fflush(stdout);
-#endif
-#ifdef PRINT_DEBUG_INFO_
-            cout << "\n(" << myRank << ") Number of Ghost edges = " << numGhostEdges;
-            cout << "\n(" << myRank << ") Total number of potential message X 2 = " << numGhostEdges * 2;
-            cout << "\n(" << myRank << ") Number messages bundled = " << NumMessagesBundled;
-            cout << "\n(" << myRank << ") Total Individual Messages sent = " << msgInd;
-            if (msgInd > 0)
-            {
-                cout << "\n(" << myRank << ") Percentage of messages bundled = " << ((double)NumMessagesBundled / (double)(msgInd)) * 100.0 << "% \n";
-            }
-            fflush(stdout);
-#endif
-
-#pragma omp task
-            {
-                *msgActualSent = msgActual;
-                *msgIndSent = msgInd;
-                if (msgInd > 0)
-                {
-                    *msgPercent = ((double)NumMessagesBundled / (double)(msgInd)) * 100.0;
-                }
-                else
-                {
-                    *msgPercent = 0;
-                }
-            }
-
-#ifdef DEBUG_HANG_
-            if (myRank == 0)
-                cout << "\n(" << myRank << ") Done" << endl;
-            fflush(stdout);
-#endif
-        }
-    }
-}

amgprec/impl/aggregator/computeCandidateMate.cpp

@@ -1,73 +0,0 @@
-#include "MatchBoxPC.h"
-
-/**
- * Execute the research fr the Candidate Mate without controlling if the vertices are already matched.
- * Returns the vertices with the highest weight
- * @param adj1
- * @param adj2
- * @param verLocInd
- * @param edgeLocWeight
- * @return
- */
-MilanLongInt firstComputeCandidateMate(MilanLongInt adj1,
-                                       MilanLongInt adj2,
-                                       MilanLongInt *verLocInd,
-                                       MilanReal *edgeLocWeight)
-{
-    MilanInt w = -1;
-    MilanReal heaviestEdgeWt = MilanRealMin; // Assign the smallest Value possible first LDBL_MIN
-    int finalK;
-    for (int k = adj1; k < adj2; k++) {
-      if ((edgeLocWeight[k] > heaviestEdgeWt) ||
-	  ((edgeLocWeight[k] == heaviestEdgeWt) && (w < verLocInd[k])))     {
-	heaviestEdgeWt = edgeLocWeight[k];
-	w = verLocInd[k];
-	finalK = k;
-      }
-    } // End of for loop
-    return finalK;
-}
-
-/**
- * //TODO documentation
- * @param adj1
- * @param adj2
- * @param edgeLocWeight
- * @param k
- * @param verLocInd
- * @param StartIndex
- * @param EndIndex
- * @param GMate
- * @param Mate
- * @param Ghost2LocalMap
- * @return
- */
-MilanLongInt computeCandidateMate(MilanLongInt adj1,
-                                  MilanLongInt adj2,
-                                  MilanReal *edgeLocWeight,
-                                  MilanLongInt k,
-                                  MilanLongInt *verLocInd,
-                                  MilanLongInt StartIndex,
-                                  MilanLongInt EndIndex,
-                                  vector<MilanLongInt> &GMate,
-                                  MilanLongInt *Mate,
-                                  map<MilanLongInt, MilanLongInt> &Ghost2LocalMap)
-{
-    // Start: PARALLEL_COMPUTE_CANDIDATE_MATE_B(v)
-
-    MilanInt w = -1;
-    MilanReal heaviestEdgeWt = MilanRealMin; // Assign the smallest Value possible first LDBL_MIN
-    for (k = adj1; k < adj2; k++)   {
-      if (isAlreadyMatched(verLocInd[k], StartIndex, EndIndex, GMate, Mate, Ghost2LocalMap))
-	continue;
-      
-      if ((edgeLocWeight[k] > heaviestEdgeWt) ||
-	  ((edgeLocWeight[k] == heaviestEdgeWt) && (w < verLocInd[k])))     {
-	heaviestEdgeWt = edgeLocWeight[k];
-	w = verLocInd[k];
-      }
-    } // End of for loop
-      //  End: PARALLEL_COMPUTE_CANDIDATE_MATE_B(v)
-    
-    return w;
-}

amgprec/impl/aggregator/dataStrStaticQueue.h

@@ -80,11 +80,9 @@ class staticQueue
 		MilanLongInt squeueTail;
 		MilanLongInt NumNodes;
 
-		//FIXME I had to comment this piece of code in order to make everything work.
-		//		why?
 		//Prevent Assignment and Pass by Value:
-		//staticQueue(const staticQueue& src);
-		//staticQueue& operator=(const staticQueue& rhs);
+		staticQueue(const staticQueue& src);
+		staticQueue& operator=(const staticQueue& rhs);
 
 	public:
 		//Constructors and Destructors

amgprec/impl/aggregator/extractUChunk.cpp

@@ -1,31 +0,0 @@
-#include "MatchBoxPC.h"
-
-void extractUChunk(
-    vector<MilanLongInt> &UChunkBeingProcessed,
-    vector<MilanLongInt> &U,
-    vector<MilanLongInt> &privateU)
-{
-
-    UChunkBeingProcessed.clear();
-#pragma omp critical(U)
-    {
-
-        if (U.empty() && !privateU.empty()) // If U is empty but there are nodes in private U
-        {
-            while (!privateU.empty())
-                UChunkBeingProcessed.push_back(privateU.back());
-            privateU.pop_back();
-        }
-        else
-        {
-            for (int i = 0; i < UCHUNK; i++)
-            { // Pop the new nodes
-                if (U.empty())
-                    break;
-                UChunkBeingProcessed.push_back(U.back());
-                U.pop_back();
-            }
-        }
-
-    } // End of critical U // End of critical U
-}

amgprec/impl/aggregator/findOwnerOfGhost.cpp

@@ -1,29 +0,0 @@
-#include "MatchBoxPC.h"
-
-/// Find the owner of a ghost node:
-MilanInt findOwnerOfGhost(MilanLongInt vtxIndex, MilanLongInt *mVerDistance,
-                          MilanInt myRank, MilanInt numProcs)
-{
-
-  MilanLongInt mStartInd = mVerDistance[myRank];
-  MilanInt Start = 0;
-  MilanInt End = numProcs;
-  MilanInt Current = 0;
-
-  while (Start <= End)
-  {
-    Current = (End + Start) / 2;
-    // CASE-1:
-    if (mVerDistance[Current] == vtxIndex) return Current;
-    else // CASE 2:
-      if (mVerDistance[Current] > vtxIndex)
-        End = Current - 1;
-      else // CASE 3:
-        Start = Current + 1;
-  } // End of While()
-
- if (mVerDistance[Current] > vtxIndex)
-      return (Current - 1);
-
-  return Current;
-} // End of findOwnerOfGhost()

amgprec/impl/aggregator/initialize.cpp

@@ -1,304 +0,0 @@
-#include "MatchBoxPC.h"
-
-void initialize(MilanLongInt NLVer, MilanLongInt NLEdge,
-                MilanLongInt StartIndex, MilanLongInt EndIndex,
-                MilanLongInt *numGhostEdges,
-                MilanLongInt *numGhostVertices,
-                MilanLongInt *S,
-                MilanLongInt *verLocInd,
-                MilanLongInt *verLocPtr,
-                map<MilanLongInt, MilanLongInt> &Ghost2LocalMap,
-                vector<MilanLongInt> &Counter,
-                vector<MilanLongInt> &verGhostPtr,
-                vector<MilanLongInt> &verGhostInd,
-                vector<MilanLongInt> &tempCounter,
-                vector<MilanLongInt> &GMate,
-                vector<MilanLongInt> &Message,
-                vector<MilanLongInt> &QLocalVtx,
-                vector<MilanLongInt> &QGhostVtx,
-                vector<MilanLongInt> &QMsgType,
-                vector<MilanInt> &QOwner,
-                MilanLongInt *&candidateMate,
-                vector<MilanLongInt> &U,
-                vector<MilanLongInt> &privateU,
-                vector<MilanLongInt> &privateQLocalVtx,
-                vector<MilanLongInt> &privateQGhostVtx,
-                vector<MilanLongInt> &privateQMsgType,
-                vector<MilanInt> &privateQOwner)
-{
-
-    MilanLongInt insertMe = 0;
-    MilanLongInt adj1, adj2;
-    int i, v, k, w;
-    // index that starts with zero to |Vg|  - 1
-    map<MilanLongInt, MilanLongInt>::iterator storedAlready;
-
-#pragma omp parallel private(insertMe, k, w, v, adj1, adj2) firstprivate(StartIndex, EndIndex) default(shared) num_threads(NUM_THREAD)
-    {
-
-#pragma omp single
-        {
-
-#ifdef TIME_TRACKER
-            double Ghost2LocalInitialization = MPI_Wtime();
-#endif
-
-            /*
-             * OMP Ghost2LocalInitialization
-             * This loop analyzes all the edges and when finds a ghost edge
-             * puts it in the Ghost2LocalMap.
-             * A critical region is needed when inserting data in the map.
-             *
-             * Despite the critical region it is still productive to
-             * parallelize this cycle because the critical region is exeuted
-             * only when a ghost edge is found and ghost edges are a minority,
-             * circa 3.5% during the tests.
-             */
-#pragma omp task depend(out \
-                        : *numGhostEdges, Counter, Ghost2LocalMap, insertMe, storedAlready, *numGhostVertices)
-            {
-#pragma omp taskloop num_tasks(NUM_THREAD) reduction(+ \
-                                                     : numGhostEdges[:1])
-                for (i = 0; i < NLEdge; i++)
-                { // O(m) - Each edge stored twice
-                    insertMe = verLocInd[i];
-                    if ((insertMe < StartIndex) || (insertMe > EndIndex))
-                    { // Find a ghost
-                        (*numGhostEdges)++;
-#pragma omp critical
-                        {
-                            storedAlready = Ghost2LocalMap.find(insertMe);
-                            if (storedAlready != Ghost2LocalMap.end())
-                            {                                     // Has already been added
-                                Counter[storedAlready->second]++; // Increment the counter
-                            }
-                            else
-                            {                                                 // Insert an entry for the ghost:
-                                Ghost2LocalMap[insertMe] = *numGhostVertices; // Add a map entry
-                                Counter.push_back(1);                         // Initialize the counter
-                                (*numGhostVertices)++;                        // Increment the number of ghost vertices
-                            }                                                 // End of else()
-                        }
-                    } // End of if ( (insertMe < StartIndex) || (insertMe > EndIndex) )
-                }     // End of for(ghost vertices)
-            }         // end of task depend
-
-            // *numGhostEdges = atomicNumGhostEdges;
-#ifdef TIME_TRACKER
-            Ghost2LocalInitialization = MPI_Wtime() - Ghost2LocalInitialization;
-            fprintf(stderr, "Ghost2LocalInitialization time: %f\n", Ghost2LocalInitialization);
-#endif
-
-#ifdef PRINT_DEBUG_INFO_
-            cout << "\n(" << myRank << ")NGhosts:" << *numGhostVertices << " GhostEdges: " << *numGhostEdges;
-            if (!Ghost2LocalMap.empty())
-            {
-                cout << "\n(" << myRank << ")Final Map : on process ";
-                cout << "\n(" << myRank << ")Key \t Value \t Counter \n";
-                fflush(stdout);
-                storedAlready = Ghost2LocalMap.begin();
-                do
-                {
-                    cout << storedAlready->second << " - " << storedAlready->first << " : " << Counter[storedAlready->second] << endl;
-                    fflush(stdout);
-                    storedAlready++;
-                } while (storedAlready != Ghost2LocalMap.end());
-            }
-#endif
-
-#pragma omp task depend(out                                                       \
-                        : verGhostPtr, tempCounter, verGhostInd, GMate) depend(in \
-                                                                               : *numGhostVertices, *numGhostEdges)
-            {
-
-                // Initialize adjacency Lists for Ghost Vertices:
-                try
-                {
-                    verGhostPtr.reserve(*numGhostVertices + 1); // Pointer Vector
-                    tempCounter.reserve(*numGhostVertices);     // Pointer Vector
-                    verGhostInd.reserve(*numGhostEdges);        // Index Vector
-                    GMate.reserve(*numGhostVertices);           // Ghost Mate Vector
-                }
-                catch (length_error)
-                {
-                    cout << "Error in function algoDistEdgeApproxDominatingEdgesLinearSearch: \n";
-                    cout << "Not enough memory to allocate the internal variables \n";
-                    exit(1);
-                }
-                // Initialize the Vectors:
-                verGhostPtr.resize(*numGhostVertices + 1, 0); // Pointer Vector
-                tempCounter.resize(*numGhostVertices, 0);     // Temporary Counter
-                verGhostInd.resize(*numGhostEdges, -1);       // Index Vector
-                GMate.resize(*numGhostVertices, -1);          // Temporary Counter
-                verGhostPtr[0] = 0;                           // The first value
-#ifdef PRINT_DEBUG_INFO_
-                cout << "\n(" << myRank << ")Ghost Vertex Pointer: ";
-                fflush(stdout);
-#endif
-
-            } // End of task
-
-#pragma omp task depend(out                      \
-                        : verGhostPtr) depend(in \
-                                              : Counter, *numGhostVertices)
-            {
-
-#ifdef TIME_TRACKER
-                double verGhostPtrInitialization = MPI_Wtime();
-#endif
-                for (i = 0; i < *numGhostVertices; i++)
-                { // O(|Ghost Vertices|)
-                    verGhostPtr[i + 1] = verGhostPtr[i] + Counter[i];
-#ifdef PRINT_DEBUG_INFO_
-                    cout << verGhostPtr[i] << "\t";
-                    fflush(stdout);
-#endif
-                }
-
-#ifdef TIME_TRACKER
-                verGhostPtrInitialization = MPI_Wtime() - verGhostPtrInitialization;
-                fprintf(stderr, "verGhostPtrInitialization time: %f\n", verGhostPtrInitialization);
-#endif
-            } // End of task
-
-#ifdef PRINT_DEBUG_INFO_
-            if (*numGhostVertices > 0)
-                cout << verGhostPtr[*numGhostVertices] << "\n";
-            fflush(stdout);
-#endif
-
-#ifdef TIME_TRACKER
-            double verGhostIndInitialization = MPI_Wtime();
-#endif
-
-            /*
-             * OMP verGhostIndInitialization
-             *
-             * In this cycle the verGhostInd is initialized
-             * with the datas related to ghost edges.
-             * The check to see if a node is a ghost node is
-             * executed in paralle and when a ghost node
-             * is found a critical region is started.
-             *
-             * Despite the critical region it's still useful to
-             * parallelize the for cause the ghost nodes
-             * are a minority hence the critical region is executed
-             * few times, circa 3.5% of the times in the tests.
-             */
-#pragma omp task depend(in                                                               \
-                        : insertMe, Ghost2LocalMap, tempCounter, verGhostPtr) depend(out \
-                                                                                     : verGhostInd)
-            {
-#pragma omp taskloop num_tasks(NUM_THREAD)
-                for (v = 0; v < NLVer; v++)
-                {
-                    adj1 = verLocPtr[v]; // Vertex Pointer
-                    adj2 = verLocPtr[v + 1];
-                    for (k = adj1; k < adj2; k++)
-                    {
-                        w = verLocInd[k]; // Get the adjacent vertex
-                        if ((w < StartIndex) || (w > EndIndex))
-                        { // Find a ghost
-#pragma omp critical
-                            {
-                                insertMe = verGhostPtr[Ghost2LocalMap[w]] + tempCounter[Ghost2LocalMap[w]]; // Where to insert
-                                tempCounter[Ghost2LocalMap[w]]++;                                           // Increment the counter
-                            }
-                            verGhostInd[insertMe] = v + StartIndex; // Add the adjacency
-                        }                                           // End of if((w < StartIndex) || (w > EndIndex))
-                    }                                               // End of for(k)
-                }                                                   // End of for (v)
-            }                                                       // end of tasklopp
-
-#ifdef TIME_TRACKER
-            verGhostIndInitialization = MPI_Wtime() - verGhostIndInitialization;
-            fprintf(stderr, "verGhostIndInitialization time: %f\n", verGhostIndInitialization);
-#endif
-
-#ifdef PRINT_DEBUG_INFO_
-            cout << "\n(" << myRank << ")Ghost Vertex Index: ";
-            for (v = 0; v < *numGhostEdges; v++)
-                cout << verGhostInd[v] << "\t";
-            cout << endl;
-            fflush(stdout);
-#endif
-
-#pragma omp task depend(in                           \
-                        : *numGhostEdges) depend(out \
-                                                 : QLocalVtx, QGhostVtx, QMsgType, QOwner)
-            {
-                try
-                {
-                    QLocalVtx.reserve(*numGhostEdges); // Local Vertex
-                    QGhostVtx.reserve(*numGhostEdges); // Ghost Vertex
-                    QMsgType.reserve(*numGhostEdges);  // Message Type (Request/Failure)
-                    QOwner.reserve(*numGhostEdges);    // Owner of the ghost: COmpute once and use later
-                }
-                catch (length_error)
-                {
-                    cout << "Error in function algoDistEdgeApproxDominatingEdgesMessageBundling: \n";
-                    cout << "Not enough memory to allocate the internal variables \n";
-                    exit(1);
-                }
-            } // end of task
-
-#ifdef PRINT_DEBUG_INFO_
-            cout << "\n(" << myRank << ")Allocating CandidateMate.. ";
-            fflush(stdout);
-#endif
-
-#ifdef PRINT_DEBUG_INFO_
-            cout << "\n(" << myRank << "=========================************===============================" << endl;
-            fflush(stdout);
-            fflush(stdout);
-#endif
-
-#ifdef PRINT_DEBUG_INFO_
-            cout << "\n(" << myRank << ") Setup Time :" << *ph0_time << endl;
-            fflush(stdout);
-            fflush(stdout);
-#endif
-
-#ifdef DEBUG_HANG_
-            if (myRank == 0)
-                cout << "\n(" << myRank << ") Setup Time :" << *ph0_time << endl;
-            fflush(stdout);
-#endif
-
-#pragma omp task depend(in                              \
-                        : *numGhostVertices) depend(out \
-                                                    : candidateMate, S, U, privateU, privateQLocalVtx, privateQGhostVtx, privateQMsgType, privateQOwner)
-            {
-
-                // Allocate Data Structures:
-                /*
-                 * candidateMate was a vector and has been replaced with an array
-                 * there is no point in using the vector (or maybe there is (???))
-                 * so I replaced it with an array wich is slightly faster
-                 */
-                candidateMate = new MilanLongInt[NLVer + (*numGhostVertices)];
-
-                *S = (*numGhostVertices); // Initialize S with number of Ghost Vertices
-
-                /*
-                 * Create the Queue Data Structure for the Dominating Set
-                 *
-                 * I had to declare the staticuQueue U before the parallel region
-                 * to have it in the correct scope. Since we can't change the dimension
-                 * of a staticQueue I had to destroy the previous object and instantiate
-                 * a new one of the correct size.
-                 */
-                //new (&U) staticQueue(NLVer + (*numGhostVertices));
-                U.reserve(NLVer + (*numGhostVertices));
-
-                // Initialize the private vectors                
-                privateQLocalVtx.reserve(*numGhostVertices);
-                privateQGhostVtx.reserve(*numGhostVertices);
-                privateQMsgType.reserve(*numGhostVertices);
-                privateQOwner.reserve(*numGhostVertices);
-                privateU.reserve(*numGhostVertices);
-            } // end of task
-
-        } // End of single region
-    }     // End of parallel region
-}

amgprec/impl/aggregator/isAlreadyMatched.cpp

@@ -1,46 +0,0 @@
-#include "MatchBoxPC.h"
-
-/**
- * //TODO documentation
- * @param k
- * @param verLocInd
- * @param StartIndex
- * @param EndIndex
- * @param GMate
- * @param Mate
- * @param Ghost2LocalMap
- * @return
- */
-bool isAlreadyMatched(MilanLongInt node,
-                      MilanLongInt StartIndex,
-                      MilanLongInt EndIndex,
-                      vector<MilanLongInt> &GMate,
-                      MilanLongInt *Mate,
-                      map<MilanLongInt, MilanLongInt> &Ghost2LocalMap)
-{
-
-    /*
-#pragma omp critical(Mate)
-    {
-        if ((node < StartIndex) || (node > EndIndex)) { //Is it a ghost vertex?
-            result = GMate[Ghost2LocalMap[node]] >= 0;// Already matched
-        } else { //A local vertex
-            result = (Mate[node - StartIndex] >= 0); // Already matched
-        }
-
-    }
-    */
-    MilanLongInt val;
-    if ((node < StartIndex) || (node > EndIndex)) // if ghost vertex
-    { 
-#pragma omp atomic read
-        val = GMate[Ghost2LocalMap[node]];
-        return val >= 0; // Already matched
-    }
-
-    // If not ghost vertex
-#pragma omp atomic read
-    val = Mate[node - StartIndex];
-
-    return val >= 0; // Already matched
-}

amgprec/impl/aggregator/parallelComputeCandidateMateB.cpp

@@ -1,27 +0,0 @@
-#include "MatchBoxPC.h"
-
-void PARALLEL_COMPUTE_CANDIDATE_MATE_B(MilanLongInt NLVer,
-                                              MilanLongInt *verLocPtr,
-                                              MilanLongInt *verLocInd,
-                                              MilanInt myRank,
-                                              MilanReal *edgeLocWeight,
-                                              MilanLongInt *candidateMate)
-{
-
-    MilanLongInt v = -1;
-
-#pragma omp parallel private(v) default(shared) num_threads(NUM_THREAD)
-    {
-
-#pragma omp for schedule(static)
-        for (v = 0; v < NLVer; v++) {
-#ifdef PRINT_DEBUG_INFO_
-            cout << "\n(" << myRank << ")Processing: " << v + StartIndex << endl;
-            fflush(stdout);
-#endif
-            // Start: PARALLEL_COMPUTE_CANDIDATE_MATE_B(v)
-            candidateMate[v] = firstComputeCandidateMate(verLocPtr[v], verLocPtr[v + 1], verLocInd, edgeLocWeight);
-            // End: PARALLEL_COMPUTE_CANDIDATE_MATE_B(v)
-        }
-    }
-}

amgprec/impl/aggregator/processCrossEdge.cpp

@@ -1,24 +0,0 @@
-#include "MatchBoxPC.h"
-
-void PROCESS_CROSS_EDGE(MilanLongInt *edge,
-                        MilanLongInt *S)
-{
-    // Start: PARALLEL_PROCESS_CROSS_EDGE_B
-    MilanLongInt captureCounter;
-
-#pragma omp atomic capture
-    captureCounter = --(*edge); // Decrement
-
-    //assert(captureCounter >= 0);
-
-    if (captureCounter == 0)
-#pragma omp atomic
-        (*S)--; // Decrement S
-
-#ifdef PRINT_DEBUG_INFO_
-    cout << "\n(" << myRank << ")Decrementing S: Ghost vertex " << edge << " has received all its messages";
-    fflush(stdout);
-#endif
-
-    // End: PARALLEL_PROCESS_CROSS_EDGE_B
-}

amgprec/impl/aggregator/processExposedVertex.cpp

@@ -1,195 +0,0 @@
-#include "MatchBoxPC.h"
-
-void PARALLEL_PROCESS_EXPOSED_VERTEX_B(MilanLongInt NLVer,
-                                       MilanLongInt *candidateMate,
-                                       MilanLongInt *verLocInd,
-                                       MilanLongInt *verLocPtr,
-                                       MilanLongInt StartIndex,
-                                       MilanLongInt EndIndex,
-                                       MilanLongInt *Mate,
-                                       vector<MilanLongInt> &GMate,
-                                       map<MilanLongInt, MilanLongInt> &Ghost2LocalMap,
-                                       MilanReal *edgeLocWeight,
-                                       MilanLongInt *myCard,
-                                       MilanLongInt *msgInd,
-                                       MilanLongInt *NumMessagesBundled,
-                                       MilanLongInt *S,
-                                       MilanLongInt *verDistance,
-                                       MilanLongInt *PCounter,
-                                       vector<MilanLongInt> &Counter,
-                                       MilanInt myRank,
-                                       MilanInt numProcs,
-                                       vector<MilanLongInt> &U,
-                                       vector<MilanLongInt> &privateU,
-                                       vector<MilanLongInt> &QLocalVtx,
-                                       vector<MilanLongInt> &QGhostVtx,
-                                       vector<MilanLongInt> &QMsgType,
-                                       vector<MilanInt> &QOwner,
-                                       vector<MilanLongInt> &privateQLocalVtx,
-                                       vector<MilanLongInt> &privateQGhostVtx,
-                                       vector<MilanLongInt> &privateQMsgType,
-                                       vector<MilanInt> &privateQOwner)
-{ 
-
-    MilanLongInt v = -1, k = -1, w = -1, adj11 = 0, adj12 = 0, k1 = 0;
-    MilanInt ghostOwner = 0, option, igw;
-
-#pragma omp parallel private(option, k, w, v, k1, adj11, adj12, ghostOwner)    \
-    firstprivate(privateU, StartIndex, EndIndex, privateQLocalVtx, privateQGhostVtx, privateQMsgType, privateQOwner) \
-     default(shared)   num_threads(NUM_THREAD)
-
-    {
-#pragma omp for reduction(+                             \
-                          : PCounter[:numProcs], myCard \
-                          [:1], msgInd                  \
-                          [:1], NumMessagesBundled      \
-                          [:1]) \
-        schedule(static)
-        for (v = 0; v < NLVer; v++) {
-            option = -1;
-            // Start: PARALLEL_PROCESS_EXPOSED_VERTEX_B(v)
-            k = candidateMate[v];
-            candidateMate[v] = verLocInd[k];
-            w = candidateMate[v];
-
-#ifdef PRINT_DEBUG_INFO_
-            cout << "\n(" << myRank << ")Processing: " << v + StartIndex << endl;
-            fflush(stdout);
-#endif
-
-#ifdef PRINT_DEBUG_INFO_
-            cout << "\n(" << myRank << ")" << v + StartIndex << " Points to: " << w;
-            fflush(stdout);
-#endif
-            // If found a dominating edge:
-            if (w >= 0)
-            {
-
-#pragma omp critical(processExposed)
-                {
-                    if (isAlreadyMatched(verLocInd[k], StartIndex, EndIndex, GMate, Mate, Ghost2LocalMap)) {
-		      w = computeCandidateMate(verLocPtr[v],
-					       verLocPtr[v + 1],
-					       edgeLocWeight, 0,
-					       verLocInd,
-					       StartIndex,
-					       EndIndex,
-					       GMate,
-					       Mate,
-					       Ghost2LocalMap);
-		      candidateMate[v] = w;
-                    }
-		    
-                    if (w >= 0) {
-		      (*myCard)++;
-		      if ((w < StartIndex) || (w > EndIndex)) { // w is a ghost vertex
-			option = 2;
-			if (candidateMate[NLVer + Ghost2LocalMap[w]] == v + StartIndex) {
-			  option = 1;
-			  Mate[v] = w;
-			  GMate[Ghost2LocalMap[w]] = v + StartIndex; // w is a Ghost
-			  
-			} // End of if CandidateMate[w] = v
-
-		      } // End of if a Ghost Vertex
-		      else  { // w is a local vertex
-			
-			if (candidateMate[w - StartIndex] == (v + StartIndex)) {
-			  option = 3;
-			  Mate[v] = w;                           // v is local
-			  Mate[w - StartIndex] = v + StartIndex; // w is local
-			  
-#ifdef PRINT_DEBUG_INFO_
-			  cout << "\n(" << myRank << ")MATCH: (" << v + StartIndex << "," << w << ") ";
-			  fflush(stdout);
-#endif
-			  
-			} // End of if ( candidateMate[w-StartIndex] == (v+StartIndex) )
-		      }     // End of Else
-		      
-                    } // End of second if
-		    
-                } // End critical processExposed
-		
-            } // End of if(w >=0)
-            else  {
-	      // This piece of code is executed a really small amount of times
-	      adj11 = verLocPtr[v];
-	      adj12 = verLocPtr[v + 1];
-	      for (k1 = adj11; k1 < adj12; k1++) {
-		w = verLocInd[k1];
-		if ((w < StartIndex) || (w > EndIndex)) { // A ghost
-
-#ifdef PRINT_DEBUG_INFO_
-		  cout << "\n(" << myRank << ")Sending a failure message: ";
-		  cout << "\n(" << myRank << ")Ghost is " << w << " Owner is: " << findOwnerOfGhost(w, verDistance, myRank, numProcs);
-		  fflush(stdout);
-#endif
-		  (*msgInd)++;
-		  (*NumMessagesBundled)++;
-		  ghostOwner = findOwnerOfGhost(w, verDistance, myRank, numProcs);
-		  // assert(ghostOwner != -1);
-		  // assert(ghostOwner != myRank);
-		  PCounter[ghostOwner]++;
-		  
-		  privateQLocalVtx.push_back(v + StartIndex);
-		  privateQGhostVtx.push_back(w);
-		  privateQMsgType.push_back(FAILURE);
-		  privateQOwner.push_back(ghostOwner);
-		  
-		} // End of if(GHOST)
-	      }     // End of for loop
-            }
-            // End:   PARALLEL_PROCESS_EXPOSED_VERTEX_B(v)
-	    
-            switch (option)
-            {
-            case -1:
-                break;
-            case 1:
-                privateU.push_back(v + StartIndex);
-                privateU.push_back(w);
-
-#ifdef PRINT_DEBUG_INFO_
-                cout << "\n(" << myRank << ")MATCH: (" << v + StartIndex << "," << w << ")";
-                fflush(stdout);
-#endif
-
-                //  Decrement the counter:
-                PROCESS_CROSS_EDGE(&Counter[Ghost2LocalMap[w]], S);
-            case 2:
-#ifdef PRINT_DEBUG_INFO_
-                cout << "\n(" << myRank << ")Sending a request message (291):";
-                cout << "\n(" << myRank << ")Local is: " << v + StartIndex << " Ghost is " << w << " Owner is: " << findOwnerOfGhost(w, verDistance, myRank, numProcs) << endl;
-                fflush(stdout);
-#endif
-                (*msgInd)++;
-                (*NumMessagesBundled)++;
-                ghostOwner = findOwnerOfGhost(w, verDistance, myRank, numProcs);
-                // assert(ghostOwner != -1);
-                // assert(ghostOwner != myRank);
-                PCounter[ghostOwner]++;
-
-                privateQLocalVtx.push_back(v + StartIndex);
-                privateQGhostVtx.push_back(w);
-                privateQMsgType.push_back(REQUEST);
-                privateQOwner.push_back(ghostOwner);
-                break;
-            case 3:
-            default:
-                privateU.push_back(v + StartIndex);
-                privateU.push_back(w);
-                break;
-            }
-
-        } // End of for ( v=0; v < NLVer; v++ )
-
-        queuesTransfer(U, privateU, QLocalVtx,
-                       QGhostVtx,
-                       QMsgType, QOwner, privateQLocalVtx,
-                       privateQGhostVtx,
-                       privateQMsgType,
-                       privateQOwner);
-
-    } // End of parallel region
-}

amgprec/impl/aggregator/processMatchedVertices.cpp

@@ -1,294 +0,0 @@
-#include "MatchBoxPC.h"
-
-void processMatchedVertices(
-    MilanLongInt NLVer,
-    vector<MilanLongInt> &UChunkBeingProcessed,
-    vector<MilanLongInt> &U,
-    vector<MilanLongInt> &privateU,
-    MilanLongInt StartIndex,
-    MilanLongInt EndIndex,
-    MilanLongInt *myCard,
-    MilanLongInt *msgInd,
-    MilanLongInt *NumMessagesBundled,
-    MilanLongInt *SPtr,
-    MilanLongInt *verLocPtr,
-    MilanLongInt *verLocInd,
-    MilanLongInt *verDistance,
-    MilanLongInt *PCounter,
-    vector<MilanLongInt> &Counter,
-    MilanInt myRank,
-    MilanInt numProcs,
-    MilanLongInt *candidateMate,
-    vector<MilanLongInt> &GMate,
-    MilanLongInt *Mate,
-    map<MilanLongInt, MilanLongInt> &Ghost2LocalMap,
-    MilanReal *edgeLocWeight,
-    vector<MilanLongInt> &QLocalVtx,
-    vector<MilanLongInt> &QGhostVtx,
-    vector<MilanLongInt> &QMsgType,
-    vector<MilanInt> &QOwner,
-    vector<MilanLongInt> &privateQLocalVtx,
-    vector<MilanLongInt> &privateQGhostVtx,
-    vector<MilanLongInt> &privateQMsgType,
-    vector<MilanInt> &privateQOwner)
-{
-
-    MilanLongInt adj1, adj2, adj11, adj12, k, k1, v = -1, w = -1, ghostOwner;
-    int option;
-    MilanLongInt mateVal;
-
-#ifdef PRINT_DEBUG_INFO_
-    cout << "\n(" << myRank << "=========================************===============================" << endl;
-    fflush(stdout);
-    fflush(stdout);
-#endif
-
-#ifdef COUNT_LOCAL_VERTEX
-    MilanLongInt localVertices = 0;
-#endif
-    //#pragma omp parallel private(k, w, v, k1, adj1, adj2, adj11, adj12, ghostOwner, option) \
-    firstprivate(privateU, StartIndex, EndIndex, privateQLocalVtx, privateQGhostVtx, \
-       privateQMsgType, privateQOwner, UChunkBeingProcessed) \
-       default(shared)  num_threads(NUM_THREAD)   \
-            reduction(+                           \
-                      : msgInd[:1], PCounter      \
-                      [:numProcs], myCard         \
-                      [:1], NumMessagesBundled    \
-                      [:1])
-    {
-
-        while (!U.empty()) {
-	  
-	  extractUChunk(UChunkBeingProcessed, U, privateU);
-	  
-	  for (MilanLongInt u : UChunkBeingProcessed)   {
-#ifdef PRINT_DEBUG_INFO_
-	    cout << "\n(" << myRank << ")u: " << u;
-	    fflush(stdout);
-#endif
-	    if ((u >= StartIndex) && (u <= EndIndex))     { // Process Only the Local Vertices
-	      
-#ifdef COUNT_LOCAL_VERTEX
-	      localVertices++;
-#endif
-	      
-	      // Get the Adjacency list for u
-	      adj1 = verLocPtr[u - StartIndex]; // Pointer
-	      adj2 = verLocPtr[u - StartIndex + 1];
-	      for (k = adj1; k < adj2; k++) {
-		option = -1;
-		v = verLocInd[k];
-		
-		if ((v >= StartIndex) && (v <= EndIndex)) { // If Local Vertex:
-		  
-#ifdef PRINT_DEBUG_INFO_
-		  cout << "\n(" << myRank << ")v: " << v << " c(v)= " << candidateMate[v - StartIndex] << " Mate[v]: " << Mate[v];
-		  fflush(stdout);
-#endif
-#pragma omp atomic read
-		  mateVal = Mate[v - StartIndex];
-		  // If the current vertex is pointing to a matched vertex and is not matched
-		  if (mateVal < 0)  {
-#pragma omp critical
-		    {
-		      if (candidateMate[v - StartIndex] == u) {
-			  // Start: PARALLEL_PROCESS_EXPOSED_VERTEX_B(v)
-			w = computeCandidateMate(verLocPtr[v - StartIndex],
-						 verLocPtr[v - StartIndex + 1],
-						 edgeLocWeight, 0,
-						 verLocInd,
-						 StartIndex,
-						 EndIndex,
-						 GMate,
-						 Mate,
-						 Ghost2LocalMap);
-			
-			candidateMate[v - StartIndex] = w;
-			
-#ifdef PRINT_DEBUG_INFO_
-			cout << "\n(" << myRank << ")" << v << " Points to: " << w;
-			fflush(stdout);
-#endif
-			// If found a dominating edge:
-			if (w >= 0)   {			  
-			  if ((w < StartIndex) || (w > EndIndex))  { // A ghost
-#ifdef PRINT_DEBUG_INFO_
-			    cout << "\n(" << myRank << ")Sending a request message:";
-			    cout << "\n(" << myRank << ")Ghost is " << w << " Owner is: " << findOwnerOfGhost(w, verDistance, myRank, numProcs);
-#endif
-			    option = 2;
-			    
-			    if (candidateMate[NLVer + Ghost2LocalMap[w]] == v)  {
-			      option = 1;
-			      Mate[v - StartIndex] = w;     // v is a local vertex
-			      GMate[Ghost2LocalMap[w]] = v; // w is a ghost vertex
-			      
-			    } // End of if CandidateMate[w] = v
-			  }     // End of if a Ghost Vertex
-			  else    { // w is a local vertex
-			    if (candidateMate[w - StartIndex] == v)  {
-			      option = 3;
-			      Mate[v - StartIndex] = w; // v is a local vertex
-			      Mate[w - StartIndex] = v; // w is a local vertex
-			      
-#ifdef PRINT_DEBUG_INFO_
-			      cout << "\n(" << myRank << ")MATCH: (" << v << "," << w << ") ";
-			      fflush(stdout);
-#endif
-			    } // End of if(CandidateMate(w) = v
-			  }     // End of Else
-			}         // End of if(w >=0)
-			else
-			  option = 4; // End of Else: w == -1
-			// End:   PARALLEL_PROCESS_EXPOSED_VERTEX_B(v)
-		      } // End of If (candidateMate[v-StartIndex] == u
-		    }     // End of task
-		  }         // mateval < 0
-		}             // End of if ( (v >= StartIndex) && (v <= EndIndex) ) //If Local Vertex:
-		else  { // Neighbor is a ghost vertex
-		  
-#pragma omp critical
-		  {
-		    if (candidateMate[NLVer + Ghost2LocalMap[v]] == u)
-		      candidateMate[NLVer + Ghost2LocalMap[v]] = -1;
-		    if (v != Mate[u - StartIndex])
-		      option = 5; // u is local
-		  }                   // End of critical
-		}                       // End of Else //A Ghost Vertex
-		
-		switch (option)
-		  {
-		  case -1:
-		    // No things to do
-		    break;
-		  case 1:
-		    // Found a dominating edge, it is a ghost and candidateMate[NLVer + Ghost2LocalMap[w]] == v
-		    privateU.push_back(v);
-		    privateU.push_back(w);
-		    
-		    (*myCard)++;
-#ifdef PRINT_DEBUG_INFO_
-		    cout << "\n(" << myRank << ")MATCH: (" << v << "," << w << ") ";
-		    fflush(stdout);
-#endif
-		    // Decrement the counter:
-		    PROCESS_CROSS_EDGE(&Counter[Ghost2LocalMap[w]], SPtr);
-		  case 2:
-		    
-		    // Found a dominating edge, it is a ghost
-		    ghostOwner = findOwnerOfGhost(w, verDistance, myRank, numProcs);
-		    // assert(ghostOwner != -1);
-		    // assert(ghostOwner != myRank);
-		    PCounter[ghostOwner]++;
-		    (*NumMessagesBundled)++;
-		    (*msgInd)++;
-		    
-		    privateQLocalVtx.push_back(v);
-		    privateQGhostVtx.push_back(w);
-		    privateQMsgType.push_back(REQUEST);
-		    privateQOwner.push_back(ghostOwner);
-		    break;
-		  case 3:
-		    privateU.push_back(v);
-		    privateU.push_back(w);
-		    
-		    (*myCard)++;
-		    break;
-		  case 4:
-		    // Could not find a dominating vertex
-		    adj11 = verLocPtr[v - StartIndex];
-		    adj12 = verLocPtr[v - StartIndex + 1];
-		    for (k1 = adj11; k1 < adj12; k1++) {
-		      w = verLocInd[k1];
-		      if ((w < StartIndex) || (w > EndIndex)) { // A ghost
-			
-#ifdef PRINT_DEBUG_INFO_
-			cout << "\n(" << myRank << ")Sending a failure message: ";
-			cout << "\n(" << myRank << ")Ghost is " << w << " Owner is: " << findOwnerOfGhost(w, verDistance, myRank, numProcs);
-			fflush(stdout);
-#endif
-			
-			ghostOwner = findOwnerOfGhost(w, verDistance, myRank, numProcs);
-			// assert(ghostOwner != -1);
-			// assert(ghostOwner != myRank);
-			
-			PCounter[ghostOwner]++;
-			(*NumMessagesBundled)++;
-			(*msgInd)++;
-			
-			privateQLocalVtx.push_back(v);
-			privateQGhostVtx.push_back(w);
-			privateQMsgType.push_back(FAILURE);
-			privateQOwner.push_back(ghostOwner);
-			
-		      } // End of if(GHOST)
-		    }     // End of for loop
-		    break;
-		  case 5:
-		  default:
-		    
-#ifdef PRINT_DEBUG_INFO_
-		    cout << "\n(" << myRank << ")Sending a success message: ";
-		    cout << "\n(" << myRank << ")Ghost is " << v << " Owner is: " << findOwnerOfGhost(v, verDistance, myRank, numProcs) << "\n";
-		    fflush(stdout);
-#endif
-		    
-		    ghostOwner = findOwnerOfGhost(v, verDistance, myRank, numProcs);
-		    // assert(ghostOwner != -1);
-		    // assert(ghostOwner != myRank);
-		    
-		    (*NumMessagesBundled)++;
-		    PCounter[ghostOwner]++;
-		    (*msgInd)++;
-		    
-		    privateQLocalVtx.push_back(u);
-		    privateQGhostVtx.push_back(v);
-		    privateQMsgType.push_back(SUCCESS);
-		    privateQOwner.push_back(ghostOwner);
-		    
-		    break;
-		  } // End of switch
-		
-	      } // End of inner for
-	    }
-	  } // End of outer for
-	  
-	  queuesTransfer(U, privateU, QLocalVtx,
-			 QGhostVtx,
-			 QMsgType, QOwner, privateQLocalVtx,
-			 privateQGhostVtx,
-			 privateQMsgType,
-			 privateQOwner);
-	  
-#pragma omp critical(U)
-	  {
-	    U.insert(U.end(), privateU.begin(), privateU.end());
-	  }
-	  
-	  privateU.clear();
-	  
-#pragma omp critical(sendMessageTransfer)
-	  {
-	    
-	    QLocalVtx.insert(QLocalVtx.end(), privateQLocalVtx.begin(), privateQLocalVtx.end());
-	    QGhostVtx.insert(QGhostVtx.end(), privateQGhostVtx.begin(), privateQGhostVtx.end());
-	    QMsgType.insert(QMsgType.end(), privateQMsgType.begin(), privateQMsgType.end());
-	    QOwner.insert(QOwner.end(), privateQOwner.begin(), privateQOwner.end());
-	  }
-	  
-	  privateQLocalVtx.clear();
-	  privateQGhostVtx.clear();
-	  privateQMsgType.clear();
-	  privateQOwner.clear();
-	  
-        } // End of while ( !U.empty() )
-	
-#ifdef COUNT_LOCAL_VERTEX
-        printf("Count local vertexes: %ld for thread %d of processor %d\n",
-               localVertices,
-               omp_get_thread_num(),
-               myRank);
-	
-#endif
-    } // End of parallel region
-}

amgprec/impl/aggregator/processMatchedVerticesAndSendMessages.cpp

@@ -1,308 +0,0 @@
-#include "MatchBoxPC.h"
-//#define DEBUG_HANG_
-void processMatchedVerticesAndSendMessages(
-					   MilanLongInt NLVer,
-					   vector<MilanLongInt> &UChunkBeingProcessed,
-					   vector<MilanLongInt> &U,
-					   vector<MilanLongInt> &privateU,
-					   MilanLongInt StartIndex,
-					   MilanLongInt EndIndex,
-					   MilanLongInt *myCard,
-					   MilanLongInt *msgInd,
-					   MilanLongInt *NumMessagesBundled,
-					   MilanLongInt *SPtr,
-					   MilanLongInt *verLocPtr,
-					   MilanLongInt *verLocInd,
-					   MilanLongInt *verDistance,
-					   MilanLongInt *PCounter,
-					   vector<MilanLongInt> &Counter,
-					   MilanInt myRank,
-					   MilanInt numProcs,
-					   MilanLongInt *candidateMate,
-					   vector<MilanLongInt> &GMate,
-					   MilanLongInt *Mate,
-					   map<MilanLongInt, MilanLongInt> &Ghost2LocalMap,
-					   MilanReal *edgeLocWeight,
-					   vector<MilanLongInt> &QLocalVtx,
-					   vector<MilanLongInt> &QGhostVtx,
-					   vector<MilanLongInt> &QMsgType,
-					   vector<MilanInt> &QOwner,
-					   vector<MilanLongInt> &privateQLocalVtx,
-					   vector<MilanLongInt> &privateQGhostVtx,
-					   vector<MilanLongInt> &privateQMsgType,
-					   vector<MilanInt> &privateQOwner,
-					   MPI_Comm comm,
-					   MilanLongInt *msgActual,
-					   vector<MilanLongInt> &Message)
-{
-
-    MilanLongInt initialSize = QLocalVtx.size();
-    MilanLongInt adj1, adj2, adj11, adj12, k, k1, v = -1, w = -1, ghostOwner;
-    int option;
-    MilanLongInt mateVal;
-
-#ifdef PRINT_DEBUG_INFO_
-    cout << "\n(" << myRank << "=========================************===============================" << endl;
-    fflush(stdout);
-    fflush(stdout);
-#endif
-
-#ifdef COUNT_LOCAL_VERTEX
-    MilanLongInt localVertices = 0;
-#endif
-    //#pragma omp parallel private(k, w, v, k1, adj1, adj2, adj11, adj12, ghostOwner, option) \
-    firstprivate(Message, privateU, StartIndex, EndIndex, privateQLocalVtx, privateQGhostVtx,\
-		 privateQMsgType, privateQOwner, UChunkBeingProcessed) default(shared) \
-        num_threads(NUM_THREAD)                                                        \
-            reduction(+                                                                \
-                      : msgInd[:1], PCounter                                           \
-                      [:numProcs], myCard                                              \
-                      [:1], NumMessagesBundled                                         \
-                      [:1], msgActual                                                  \
-                      [:1])
-    {
-
-        while (!U.empty()) {
-	  
-	  extractUChunk(UChunkBeingProcessed, U, privateU);
-	  
-	  for (MilanLongInt u : UChunkBeingProcessed) {
-#ifdef PRINT_DEBUG_INFO_
-	    cout << "\n(" << myRank << ")u: " << u;
-	    fflush(stdout);
-#endif
-	    if ((u >= StartIndex) && (u <= EndIndex)) { // Process Only the Local Vertices
-	      
-#ifdef COUNT_LOCAL_VERTEX
-	      localVertices++;
-#endif
-	      
-	      // Get the Adjacency list for u
-	      adj1 = verLocPtr[u - StartIndex]; // Pointer
-	      adj2 = verLocPtr[u - StartIndex + 1];
-	      for (k = adj1; k < adj2; k++) {
-		option = -1;
-		v = verLocInd[k];
-		
-		if ((v >= StartIndex) && (v <= EndIndex)) { // If Local Vertex:
-		  
-#ifdef PRINT_DEBUG_INFO_
-		  cout << "\n(" << myRank << ")v: " << v << " c(v)= " << candidateMate[v - StartIndex] << " Mate[v]: " << Mate[v];
-		  fflush(stdout);
-#endif
-#pragma omp atomic read
-		  mateVal = Mate[v - StartIndex];
-		  // If the current vertex is pointing to a matched vertex and is not matched
-		  if (mateVal < 0) {
-#pragma omp critical
-		    {
-		      if (candidateMate[v - StartIndex] == u)  {
-			// Start: PARALLEL_PROCESS_EXPOSED_VERTEX_B(v)
-			w = computeCandidateMate(verLocPtr[v - StartIndex],
-						 verLocPtr[v - StartIndex + 1],
-						 edgeLocWeight, 0,
-						 verLocInd,
-						 StartIndex,
-						 EndIndex,
-						 GMate,
-						 Mate,
-						 Ghost2LocalMap);
-			
-			candidateMate[v - StartIndex] = w;
-			
-#ifdef PRINT_DEBUG_INFO_
-			cout << "\n(" << myRank << ")" << v << " Points to: " << w;
-			fflush(stdout);
-#endif
-			// If found a dominating edge:
-			if (w >= 0)  {
-			  
-			  if ((w < StartIndex) || (w > EndIndex))  { // A ghost
-#ifdef PRINT_DEBUG_INFO_
-			    cout << "\n(" << myRank << ")Sending a request message:";
-			    cout << "\n(" << myRank << ")Ghost is " << w << " Owner is: " << findOwnerOfGhost(w, verDistance, myRank, numProcs);
-#endif
-			    option = 2;
-			    
-			    if (candidateMate[NLVer + Ghost2LocalMap[w]] == v) {
-			      option = 1;
-			      Mate[v - StartIndex] = w;     // v is a local vertex
-			      GMate[Ghost2LocalMap[w]] = v; // w is a ghost vertex
-			      
-			    } // End of if CandidateMate[w] = v
-			  }     // End of if a Ghost Vertex
-			  else   { // w is a local vertex
-			    if (candidateMate[w - StartIndex] == v)  {
-			      option = 3;
-			      Mate[v - StartIndex] = w; // v is a local vertex
-			      Mate[w - StartIndex] = v; // w is a local vertex
-			      
-#ifdef PRINT_DEBUG_INFO_
-			      cout << "\n(" << myRank << ")MATCH: (" << v << "," << w << ") ";
-			      fflush(stdout);
-#endif
-			    } // End of if(CandidateMate(w) = v
-			  }     // End of Else
-			}         // End of if(w >=0)
-			else
-			  option = 4; // End of Else: w == -1
-			// End:   PARALLEL_PROCESS_EXPOSED_VERTEX_B(v)
-		      } // End of If (candidateMate[v-StartIndex] == u
-		    }     // End of task
-		  }         // mateval < 0
-		}             // End of if ( (v >= StartIndex) && (v <= EndIndex) ) //If Local Vertex:
-		else { // Neighbor is a ghost vertex
-		  
-#pragma omp critical
-		  {
-		    if (candidateMate[NLVer + Ghost2LocalMap[v]] == u)
-		      candidateMate[NLVer + Ghost2LocalMap[v]] = -1;
-		    if (v != Mate[u - StartIndex])
-		      option = 5; // u is local
-		  }                   // End of critical
-		}                       // End of Else //A Ghost Vertex
-		
-		switch (option)
-		  {
-		  case -1:
-		    // No things to do
-		    break;
-		  case 1:
-		    // Found a dominating edge, it is a ghost and candidateMate[NLVer + Ghost2LocalMap[w]] == v
-		    privateU.push_back(v);
-		    privateU.push_back(w);
-		    (*myCard)++;
-#ifdef PRINT_DEBUG_INFO_
-		    cout << "\n(" << myRank << ")MATCH: (" << v << "," << w << ") ";
-		    fflush(stdout);
-#endif
-		    // Decrement the counter:
-		    PROCESS_CROSS_EDGE(&Counter[Ghost2LocalMap[w]], SPtr);
-		  case 2:
-		    
-		    // Found a dominating edge, it is a ghost
-		    ghostOwner = findOwnerOfGhost(w, verDistance, myRank, numProcs);
-		    
-		    // Build the Message Packet:
-		    // Message[0] = v;       // LOCAL
-		    // Message[1] = w;       // GHOST
-		    // Message[2] = REQUEST; // TYPE
-		    // Send a Request (Asynchronous)
-		    // MPI_Bsend(&Message[0], 3, TypeMap<MilanLongInt>(), ghostOwner, ComputeTag, comm);
-		    
-		    (*msgActual)++;
-		    (*msgInd)++;
-		    
-		    privateQLocalVtx.push_back(v);
-		    privateQGhostVtx.push_back(w);
-		    privateQMsgType.push_back(REQUEST);
-		    privateQOwner.push_back(ghostOwner);
-		    break;
-		  case 3:
-		    privateU.push_back(v);
-		    privateU.push_back(w);
-		    (*myCard)++;
-		    break;
-		  case 4:
-		    // Could not find a dominating vertex
-		    adj11 = verLocPtr[v - StartIndex];
-		    adj12 = verLocPtr[v - StartIndex + 1];
-		    for (k1 = adj11; k1 < adj12; k1++) {
-		      w = verLocInd[k1];
-		      if ((w < StartIndex) || (w > EndIndex))  { // A ghost
-			
-#ifdef PRINT_DEBUG_INFO_
-			cout << "\n(" << myRank << ")Sending a failure message: ";
-			cout << "\n(" << myRank << ")Ghost is " << w << " Owner is: " << findOwnerOfGhost(w, verDistance, myRank, numProcs);
-			fflush(stdout);
-#endif
-			
-			ghostOwner = findOwnerOfGhost(w, verDistance, myRank, numProcs);
-			
-			// Build the Message Packet:
-			// Message[0] = v;       // LOCAL
-			// Message[1] = w;       // GHOST
-			// Message[2] = FAILURE; // TYPE
-			// Send a Request (Asynchronous)
-			// MPI_Bsend(&Message[0], 3, TypeMap<MilanLongInt>(), ghostOwner, ComputeTag, comm);
-			
-			(*msgActual)++;
-			(*msgInd)++;
-			
-			privateQLocalVtx.push_back(v);
-			privateQGhostVtx.push_back(w);
-			privateQMsgType.push_back(FAILURE);
-			privateQOwner.push_back(ghostOwner);
-			
-		      } // End of if(GHOST)
-		    }     // End of for loop
-		    break;
-		  case 5:
-		  default:
-		    
-#ifdef PRINT_DEBUG_INFO_
-		    cout << "\n(" << myRank << ")Sending a success message: ";
-		    cout << "\n(" << myRank << ")Ghost is " << v << " Owner is: " << findOwnerOfGhost(v, verDistance, myRank, numProcs) << "\n";
-		    fflush(stdout);
-#endif
-		    
-		    ghostOwner = findOwnerOfGhost(v, verDistance, myRank, numProcs);
-		    
-		    // Build the Message Packet:
-		    // Message[0] = u;       // LOCAL
-		    // Message[1] = v;       // GHOST
-		    // Message[2] = SUCCESS; // TYPE
-		    // Send a Request (Asynchronous)
-		    // MPI_Bsend(&Message[0], 3, TypeMap<MilanLongInt>(), ghostOwner, ComputeTag, comm);
-		    
-		    (*msgActual)++;
-		    (*msgInd)++;
-		    
-		    privateQLocalVtx.push_back(u);
-		    privateQGhostVtx.push_back(v);
-		    privateQMsgType.push_back(SUCCESS);
-		    privateQOwner.push_back(ghostOwner);
-		    
-		    break;
-		  } // End of switch
-	      }     // End of inner for
-	    }
-	  } // End of outer for
-	  
-	  queuesTransfer(U, privateU, QLocalVtx,
-			 QGhostVtx,
-			 QMsgType, QOwner, privateQLocalVtx,
-			 privateQGhostVtx,
-			 privateQMsgType,
-			 privateQOwner);
-	  
-        } // End of while ( !U.empty() )
-	
-#ifdef COUNT_LOCAL_VERTEX
-        printf("Count local vertexes: %ld for thread %d of processor %d\n",
-               localVertices,
-               omp_get_thread_num(),
-               myRank);
-	
-#endif
-    } // End of parallel region
-    
-    // Send the messages
-#ifdef DEBUG_HANG_
-    cout << myRank<<" Sending: "<<QOwner.size()-initialSize<<" messages" <<endl;
-#endif
-    for (int i = initialSize; i < QOwner.size(); i++)   {
-      
-      Message[0] = QLocalVtx[i];
-      Message[1] = QGhostVtx[i];
-      Message[2] = QMsgType[i];
-      ghostOwner = QOwner[i];
-      
-      //MPI_Bsend(&Message[0], 3, TypeMap<MilanLongInt>(), ghostOwner, ComputeTag, comm);
-      //cout << myRank<<" Sending to "<<ghostOwner<<endl;
-      MPI_Bsend(&Message[0], 3, TypeMap<MilanLongInt>(), ghostOwner, ComputeTag, comm);
-    }
-#ifdef DEBUG_HANG_
-    cout << myRank<<" Done sending messages"<<endl;
-#endif
-}

amgprec/impl/aggregator/processMessages.cpp

@@ -1,315 +0,0 @@
-#include "MatchBoxPC.h"
-//#define DEBUG_HANG_
-
-void processMessages(
-    MilanLongInt NLVer,
-    MilanLongInt *Mate,
-    MilanLongInt *candidateMate,
-    map<MilanLongInt, MilanLongInt> &Ghost2LocalMap,
-    vector<MilanLongInt> &GMate,
-    vector<MilanLongInt> &Counter,
-    MilanLongInt StartIndex,
-    MilanLongInt EndIndex,
-    MilanLongInt *myCard,
-    MilanLongInt *msgInd,
-    MilanLongInt *msgActual,
-    MilanReal *edgeLocWeight,
-    MilanLongInt *verDistance,
-    MilanLongInt *verLocPtr,
-    MilanLongInt k,
-    MilanLongInt *verLocInd,
-    MilanInt numProcs,
-    MilanInt myRank,
-    MPI_Comm comm,
-    vector<MilanLongInt> &Message,
-    MilanLongInt numGhostEdges,
-    MilanLongInt u,
-    MilanLongInt v,
-    MilanLongInt *S,
-    vector<MilanLongInt> &U)
-{
-
-    //#define PRINT_DEBUG_INFO_
-
-    MilanInt Sender;
-    MPI_Status computeStatus;
-    MilanLongInt bundleSize, w;
-    MilanLongInt adj11, adj12, k1;
-    MilanLongInt ghostOwner;
-    int error_codeC;
-    error_codeC = MPI_Comm_set_errhandler(MPI_COMM_WORLD, MPI_ERRORS_RETURN);
-    char error_message[MPI_MAX_ERROR_STRING];
-    int message_length;
-    MilanLongInt message_type = 0;
-
-    // Buffer to receive bundled messages
-    // Maximum messages that can be received from any processor is
-    // twice the edge cut: REQUEST; REQUEST+(FAILURE/SUCCESS)
-    vector<MilanLongInt> ReceiveBuffer;
-    try
-    {
-        ReceiveBuffer.reserve(numGhostEdges * 2 * 3); // Three integers per cross edge
-    }
-    catch (length_error)
-    {
-        cout << "Error in function algoDistEdgeApproxDominatingEdgesMessageBundling: \n";
-        cout << "Not enough memory to allocate the internal variables \n";
-        exit(1);
-    }
-
-#ifdef PRINT_DEBUG_INFO_
-    cout
-        << "\n(" << myRank << "=========================************===============================" << endl;
-    fflush(stdout);
-    fflush(stdout);
-#endif
-#ifdef PRINT_DEBUG_INFO_
-    cout << "\n(" << myRank << ")About to begin Message processing phase ... *S=" << *S << endl;
-    fflush(stdout);
-#endif
-#ifdef PRINT_DEBUG_INFO_
-    cout << "\n(" << myRank << "=========================************===============================" << endl;
-    fflush(stdout);
-    fflush(stdout);
-#endif
-    // BLOCKING RECEIVE:
-#ifdef PRINT_DEBUG_INFO_
-    cout << "\n(" << myRank << " Waiting for blocking receive..." << endl;
-    fflush(stdout);
-    fflush(stdout);
-#endif
-
-    //cout << myRank<<" Receiving ...";
-    error_codeC = MPI_Recv(&Message[0], 3, TypeMap<MilanLongInt>(), MPI_ANY_SOURCE, ComputeTag, comm, &computeStatus);
-    if (error_codeC != MPI_SUCCESS)
-    {
-        MPI_Error_string(error_codeC, error_message, &message_length);
-        cout << "\n*Error in call to MPI_Receive on Slave: " << error_message << "\n";
-        fflush(stdout);
-    }
-    Sender = computeStatus.MPI_SOURCE;
-    //cout << " ...from "<<Sender << endl;
-#ifdef PRINT_DEBUG_INFO_
-    cout << "\n(" << myRank << ")Received message from Process " << Sender << " Type= " << Message[2] << endl;
-    fflush(stdout);
-#endif
-
-    if (Message[2] == SIZEINFO)  {
-
-#ifdef PRINT_DEBUG_INFO_
-      cout << "\n(" << myRank << ")Received bundled message from Process " << Sender << " Size= " << Message[0] << endl;
-      fflush(stdout);
-#endif
-      bundleSize = Message[0]; //#of integers in the message
-      // Build the Message Buffer:
-      if (!ReceiveBuffer.empty())
-	ReceiveBuffer.clear();            // Empty it out first
-      ReceiveBuffer.resize(bundleSize, -1); // Initialize
-#ifdef PRINT_DEBUG_INFO_
-      cout << "\n(" << myRank << ")Message Bundle Before: " << endl;
-      for (int i = 0; i < bundleSize; i++)
-	cout << ReceiveBuffer[i] << ",";
-      cout << endl;
-      fflush(stdout);
-#endif
-      // Receive the message
-      //cout << myRank<<" Receiving from "<<Sender<<endl;
-      error_codeC = MPI_Recv(&ReceiveBuffer[0], bundleSize, TypeMap<MilanLongInt>(), Sender, BundleTag, comm, &computeStatus);
-      if (error_codeC != MPI_SUCCESS) {
-	MPI_Error_string(error_codeC, error_message, &message_length);
-	cout << "\n*Error in call to MPI_Receive on processor " << myRank << " Error: " << error_message << "\n";
-	fflush(stdout);
-      }
-#ifdef PRINT_DEBUG_INFO_
-      cout << "\n(" << myRank << ")Message Bundle After: " << endl;
-      for (int i = 0; i < bundleSize; i++)
-	cout << ReceiveBuffer[i] << ",";
-      cout << endl;
-      fflush(stdout);
-#endif
-    } else   { // Just a single message:
-#ifdef PRINT_DEBUG_INFO_
-      cout << "\n(" << myRank << ")Received regular message from Process " << Sender << " u= " << Message[0] << " v= " << Message[1] << endl;
-      fflush(stdout);
-#endif
-      // Add the current message to Queue:
-      bundleSize = 3; //#of integers in the message
-      // Build the Message Buffer:
-      if (!ReceiveBuffer.empty())
-	ReceiveBuffer.clear();            // Empty it out first
-      ReceiveBuffer.resize(bundleSize, -1); // Initialize
-      
-      ReceiveBuffer[0] = Message[0]; // u
-      ReceiveBuffer[1] = Message[1]; // v
-      ReceiveBuffer[2] = Message[2]; // message_type
-    }
-    
-#ifdef DEBUG_GHOST_
-    if ((v < StartIndex) || (v > EndIndex)) {
-      cout << "\n(" << myRank << ") From ReceiveBuffer: This should not happen: u= " << u << " v= " << v << " Type= " << message_type << " StartIndex " << StartIndex << " EndIndex " << EndIndex << endl;
-      fflush(stdout);
-    }
-#endif
-#ifdef PRINT_DEBUG_INFO_
-    cout << "\n(" << myRank << ")Processing message: u= " << u << " v= " << v << " Type= " << message_type << endl;
-    fflush(stdout);
-#endif
-
-    // Most of the time bundleSize == 3, thus, it's not worth parallelizing thi loop
-    for (MilanLongInt bundleCounter = 3; bundleCounter < bundleSize + 3; bundleCounter += 3)  {
-      u = ReceiveBuffer[bundleCounter - 3];            // GHOST
-      v = ReceiveBuffer[bundleCounter - 2];            // LOCAL
-      message_type = ReceiveBuffer[bundleCounter - 1]; // TYPE
-      
-      // CASE I: REQUEST
-      if (message_type == REQUEST)  {
-#ifdef PRINT_DEBUG_INFO_
-	cout << "\n(" << myRank << ")Message type is REQUEST" << endl;
-	fflush(stdout);
-#endif
-#ifdef DEBUG_GHOST_
-	if ((v < 0) || (v < StartIndex) || ((v - StartIndex) > NLVer)) {
-	  cout << "\n(" << myRank << ") case 1 Bad address " << v << " " << StartIndex << " " << v - StartIndex << " " << NLVer << endl;
-	  fflush(stdout);
-	}
-
-#endif
-
-	if (Mate[v - StartIndex] == -1) {
-	  // Process only if not already matched  (v is local)
-	  candidateMate[NLVer + Ghost2LocalMap[u]] = v; // Set CandidateMate for the ghost
-	  if (candidateMate[v - StartIndex] == u)   {
-	    GMate[Ghost2LocalMap[u]] = v; // u is ghost
-	    Mate[v - StartIndex] = u;     // v is local
-	    U.push_back(v);
-	    U.push_back(u);
-	    (*myCard)++;
-#ifdef PRINT_DEBUG_INFO_
-	    cout << "\n(" << myRank << ")MATCH: (" << v << "," << u << ") " << endl;
-	    fflush(stdout);
-#endif
-	    
-	    PROCESS_CROSS_EDGE(&Counter[Ghost2LocalMap[u]], S);
-	  } // End of if ( candidateMate[v-StartIndex] == u )e
-	}     // End of if ( Mate[v] == -1 )
-      }         // End of REQUEST
-      else  { // CASE II: SUCCESS
-	if (message_type == SUCCESS) {
-#ifdef PRINT_DEBUG_INFO_
-	  cout << "\n(" << myRank << ")Message type is SUCCESS" << endl;
-	  fflush(stdout);
-#endif
-	  GMate[Ghost2LocalMap[u]] = EndIndex + 1; // Set a Dummy Mate to make sure that we do not (u is a ghost) process it again
-	  PROCESS_CROSS_EDGE(&Counter[Ghost2LocalMap[u]], S);
-#ifdef DEBUG_GHOST_
-	  if ((v < 0) || (v < StartIndex) || ((v - StartIndex) > NLVer)) {
-	    cout << "\n(" << myRank << ") case 2  Bad address " << v << " " << StartIndex << " " << v - StartIndex << " " << NLVer << endl;
-	    fflush(stdout);
-	  }
-#endif
-	  if (Mate[v - StartIndex] == -1) {
-	    // Process only if not already matched ( v is local)
-	    if (candidateMate[v - StartIndex] == u)  {
-	      // Start: PARALLEL_PROCESS_EXPOSED_VERTEX_B(v)
-	      w = computeCandidateMate(verLocPtr[v - StartIndex], verLocPtr[v - StartIndex + 1], edgeLocWeight, k,
-				       verLocInd, StartIndex, EndIndex, GMate, Mate, Ghost2LocalMap);
-	      candidateMate[v - StartIndex] = w;
-#ifdef PRINT_DEBUG_INFO_
-	      cout << "\n(" << myRank << ")" << v << " Points to: " << w << endl;
-	      fflush(stdout);
-#endif
-	      // If found a dominating edge:
-	      if (w >= 0)  {
-		if ((w < StartIndex) || (w > EndIndex))   {
-		  // w is a ghost
-		  // Build the Message Packet:
-		  Message[0] = v;       // LOCAL
-		  Message[1] = w;       // GHOST
-		  Message[2] = REQUEST; // TYPE
-		  // Send a Request (Asynchronous)
-#ifdef PRINT_DEBUG_INFO_
-		  cout << "\n(" << myRank << ")Sending a request message: ";
-		  cout << "\n(" << myRank << ")Ghost is " << w << " Owner is: " << findOwnerOfGhost(w, verDistance, myRank, numProcs) << endl;
-		  fflush(stdout);
-#endif
-		  ghostOwner = findOwnerOfGhost(w, verDistance, myRank, numProcs);
-		  //assert(ghostOwner != -1);
-		  //assert(ghostOwner != myRank);
-		  //cout << myRank<<" Sending to "<<ghostOwner<<endl;
-		  MPI_Bsend(&Message[0], 3, TypeMap<MilanLongInt>(), ghostOwner, ComputeTag, comm);
-		  (*msgInd)++;
-		  (*msgActual)++;
-		  if (candidateMate[NLVer + Ghost2LocalMap[w]] == v) {
-		    Mate[v - StartIndex] = w;     // v is local
-		    GMate[Ghost2LocalMap[w]] = v; // w is ghost
-		    U.push_back(v);
-		    U.push_back(w);
-		    (*myCard)++;
-#ifdef PRINT_DEBUG_INFO_
-		    cout << "\n(" << myRank << ")MATCH: (" << v << "," << w << ") " << endl;
-		    fflush(stdout);
-#endif
-		    
-		    PROCESS_CROSS_EDGE(&Counter[Ghost2LocalMap[w]], S);
-		  } // End of if CandidateMate[w] = v
-		}     // End of if a Ghost Vertex
-		else   { // w is a local vertex
-		  if (candidateMate[w - StartIndex] == v) {
-		    Mate[v - StartIndex] = w; // v is local
-		    Mate[w - StartIndex] = v; // w is local
-		    // Q.push_back(u);
-		    U.push_back(v);
-		    U.push_back(w);
-		    (*myCard)++;
-#ifdef PRINT_DEBUG_INFO_
-		    cout << "\n(" << myRank << ")MATCH: (" << v << "," << w << ") " << endl;
-		    fflush(stdout);
-#endif
-		  } // End of if(CandidateMate(w) = v
-		}     // End of Else
-	      }         // End of if(w >=0)
-	      else  { // No dominant edge found
-		adj11 = verLocPtr[v - StartIndex];
-		adj12 = verLocPtr[v - StartIndex + 1];
-		for (k1 = adj11; k1 < adj12; k1++) {
-		  w = verLocInd[k1];
-		  if ((w < StartIndex) || (w > EndIndex))  {
-		    // A ghost
-		    // Build the Message Packet:
-		    Message[0] = v;       // LOCAL
-		    Message[1] = w;       // GHOST
-		    Message[2] = FAILURE; // TYPE
-		    // Send a Request (Asynchronous)
-#ifdef PRINT_DEBUG_INFO_
-		    cout << "\n(" << myRank << ")Sending a failure message: ";
-		    cout << "\n(" << myRank << ")Ghost is " << w << " Owner is: " << findOwnerOfGhost(w, verDistance, myRank, numProcs) << endl;
-		    fflush(stdout);
-#endif
-		    ghostOwner = findOwnerOfGhost(w, verDistance, myRank, numProcs);
-		    //assert(ghostOwner != -1);
-		    //assert(ghostOwner != myRank);
-		    //cout << myRank<<" Sending to "<<ghostOwner<<endl;
-		    MPI_Bsend(&Message[0], 3, TypeMap<MilanLongInt>(), ghostOwner, ComputeTag, comm);
-		    (*msgInd)++;
-		    (*msgActual)++;
-		  } // End of if(GHOST)
-		}     // End of for loop
-	      }         // End of Else: w == -1
-                        // End:   PARALLEL_PROCESS_EXPOSED_VERTEX_B(v)
-	    } // End of if ( candidateMate[v-StartIndex] == u )
-	  }     // End of if ( Mate[v] == -1 )
-	}         // End of if ( message_type == SUCCESS )
-	else  {
-	  // CASE III: FAILURE
-#ifdef PRINT_DEBUG_INFO_
-	  cout << "\n(" << myRank << ")Message type is FAILURE" << endl;
-	  fflush(stdout);
-#endif
-	  GMate[Ghost2LocalMap[u]] = EndIndex + 1;            // Set a Dummy Mate to make sure that we do not (u is a ghost) process this anymore
-	  PROCESS_CROSS_EDGE(&Counter[Ghost2LocalMap[u]], S); // Decrease the counter
-	}                                                       // End of else: CASE III
-      }                                                           // End of else: CASE I
-    }
-    
-    return;
-}

amgprec/impl/aggregator/queueTransfer.cpp

@@ -1,36 +0,0 @@
-#include "MatchBoxPC.h"
-
-void queuesTransfer(vector<MilanLongInt> &U,
-                    vector<MilanLongInt> &privateU,
-                    vector<MilanLongInt> &QLocalVtx,
-                    vector<MilanLongInt> &QGhostVtx,
-                    vector<MilanLongInt> &QMsgType,
-                    vector<MilanInt> &QOwner,
-                    vector<MilanLongInt> &privateQLocalVtx,
-                    vector<MilanLongInt> &privateQGhostVtx,
-                    vector<MilanLongInt> &privateQMsgType,
-                    vector<MilanInt> &privateQOwner)
-{
-
-#pragma omp critical(U)
-    {
-        U.insert(U.end(), privateU.begin(), privateU.end());
-    }
-
-    privateU.clear();
-
-#pragma omp critical(sendMessageTransfer)
-    {
-
-        QLocalVtx.insert(QLocalVtx.end(), privateQLocalVtx.begin(), privateQLocalVtx.end());
-        QGhostVtx.insert(QGhostVtx.end(), privateQGhostVtx.begin(), privateQGhostVtx.end());
-        QMsgType.insert(QMsgType.end(), privateQMsgType.begin(), privateQMsgType.end());
-        QOwner.insert(QOwner.end(), privateQOwner.begin(), privateQOwner.end());
-    }
-
-    privateQLocalVtx.clear();
-    privateQGhostVtx.clear();
-    privateQMsgType.clear();
-    privateQOwner.clear();
-
-}

amgprec/impl/aggregator/sendBundledMessages.cpp

@@ -1,209 +0,0 @@
-#include "MatchBoxPC.h"
-
-void sendBundledMessages(MilanLongInt *numGhostEdges,
-                                MilanInt *BufferSize,
-                                MilanLongInt *Buffer,
-                                vector<MilanLongInt> &PCumulative,
-                                vector<MilanLongInt> &PMessageBundle,
-                                vector<MilanLongInt> &PSizeInfoMessages,
-                                MilanLongInt *PCounter,
-                                MilanLongInt NumMessagesBundled,
-                                MilanLongInt *msgActual,
-                                MilanLongInt *msgInd,
-                                MilanInt numProcs,
-                                MilanInt myRank,
-                                MPI_Comm comm,
-                                vector<MilanLongInt> &QLocalVtx,
-                                vector<MilanLongInt> &QGhostVtx,
-                                vector<MilanLongInt> &QMsgType,
-                                vector<MilanInt> &QOwner,
-                                vector<MPI_Request> &SRequest,
-                                vector<MPI_Status> &SStatus)
-{
-
-    MilanLongInt myIndex = 0, numMessagesToSend;
-    MilanInt i = 0, OneMessageSize = 0;
-
-#ifdef DEBUG_HANG_
-    if (myRank == 0)
-        cout << "\n(" << myRank << ") Send Bundles" << endl;
-    fflush(stdout);
-#endif
-
-#pragma omp parallel private(i) default(shared) num_threads(NUM_THREAD)
-    {
-#pragma omp master
-        {
-// Data structures for Bundled Messages:
-#pragma omp task depend(inout                                                       \
-                        : PCumulative, PMessageBundle, PSizeInfoMessages) depend(in \
-                                                                                 : NumMessagesBundled, numProcs)
-            {
-	      try {
-                PMessageBundle.reserve(NumMessagesBundled * 3); // Three integers per message
-		PCumulative.reserve(numProcs + 1);                          // Similar to Row Pointer vector in CSR data structure
-		PSizeInfoMessages.reserve(numProcs * 3);                    // Buffer to hold the Size info message packets
-	      }
-	      catch (length_error)
-		{
-		  cout << "Error in function algoDistEdgeApproxDominatingEdgesMessageBundling: \n";
-		  cout << "Not enough memory to allocate the internal variables \n";
-		  exit(1);
-		}
-	      PMessageBundle.resize(NumMessagesBundled * 3, -1); // Initialize
-	      PCumulative.resize(numProcs + 1, 0);               // Only initialize the counter variable
-	      PSizeInfoMessages.resize(numProcs * 3, 0);
-	    }
-
-#pragma omp task depend(inout                    \
-                        : PCumulative) depend(in		\
-                                              : PCounter)
-	    {
-	      for (i = 0; i < numProcs; i++)
-		PCumulative[i + 1] = PCumulative[i] + PCounter[i];
-	    }
-	    
-#pragma omp task depend(inout \
-                        : PCounter)
-	    {
-	      // Reuse PCounter to keep track of how many messages were inserted:
-	      for (MilanInt i = 0; i < numProcs; i++) // Changed by Fabio to be an integer, addresses needs to be integers!
-		PCounter[i] = 0;
-	    }
-
-// Build the Message Bundle packet:
-#pragma omp task depend(in                                                                                          \
-                        : PCounter, QLocalVtx, QGhostVtx, QMsgType, QOwner, PMessageBundle, PCumulative) depend(out \
-                                                                                                                : myIndex, PMessageBundle, PCounter)
-{
-  for (i = 0; i < NumMessagesBundled; i++)   {
-    myIndex = (PCumulative[QOwner[i]] + PCounter[QOwner[i]]) * 3;
-    PMessageBundle[myIndex + 0] = QLocalVtx[i];
-    PMessageBundle[myIndex + 1] = QGhostVtx[i];
-    PMessageBundle[myIndex + 2] = QMsgType[i];
-    PCounter[QOwner[i]]++;
-  }
- }
- 
-// Send the Bundled Messages: Use ISend
-#pragma omp task depend(out \
-                        : SRequest, SStatus)
- {
-   try
-     {
-       SRequest.reserve(numProcs * 2); // At most two messages per processor
-       SStatus.reserve(numProcs * 2);  // At most two messages per processor
-     }
-   catch (length_error)
-     {
-       cout << "Error in function algoDistEdgeApproxDominatingEdgesLinearSearchImmediateSend: \n";
-       cout << "Not enough memory to allocate the internal variables \n";
-       exit(1);
-     }
- }
- 
-// Send the Messages
-#pragma omp task depend(inout                                                  \
-                        : SRequest, PSizeInfoMessages, PCumulative) depend(out \
-                                                                           : *msgActual, *msgInd)
-{
-  for (i = 0; i < numProcs; i++)   {                    // Changed by Fabio to be an integer, addresses needs to be integers!
-    if (i == myRank) // Do not send anything to yourself
-      continue;
-    // Send the Message with information about the size of next message:
-    // Build the Message Packet:
-    PSizeInfoMessages[i * 3 + 0] = (PCumulative[i + 1] - PCumulative[i]) * 3; // # of integers in the next message
-    PSizeInfoMessages[i * 3 + 1] = -1;                                        // Dummy packet
-    PSizeInfoMessages[i * 3 + 2] = SIZEINFO;                                  // TYPE
-    // Send a Request (Asynchronous)
-#ifdef PRINT_DEBUG_INFO_
-    cout << "\n(" << myRank << ")Sending bundled message to process " << i << " size: " << PSizeInfoMessages[i * 3 + 0] << endl;
-    fflush(stdout);
-#endif
-    if (PSizeInfoMessages[i * 3 + 0] > 0)
-      { // Send only if it is a nonempty packet
-	MPI_Isend(&PSizeInfoMessages[i * 3 + 0], 3, TypeMap<MilanLongInt>(), i, ComputeTag, comm,
-		  &SRequest[(*msgInd)]);
-	(*msgActual)++;
-	(*msgInd)++;
-	// Now Send the message with the data packet:
-#ifdef PRINT_DEBUG_INFO_
-	cout << "\n(" << myRank << ")SendiFFng Bundle to : " << i << endl;
-	for (k = (PCumulative[i] * 3); k < (PCumulative[i] * 3 + PSizeInfoMessages[i * 3 + 0]); k++)
-	  cout << PMessageBundle[k] << ",";
-	cout << endl;
-	fflush(stdout);
-#endif
-	MPI_Isend(&PMessageBundle[PCumulative[i] * 3], PSizeInfoMessages[i * 3 + 0],
-		  TypeMap<MilanLongInt>(), i, BundleTag, comm, &SRequest[(*msgInd)]);
-	(*msgInd)++;
-      } // End of if size > 0
-  }
-}
-
-#pragma omp task depend(inout \
-                        : PCumulative, QLocalVtx, QGhostVtx, QMsgType, QOwner)
-{
-
-    // Free up temporary memory:
-  PCumulative.clear();
-  QLocalVtx.clear();
-  QGhostVtx.clear();
-  QMsgType.clear();
-  QOwner.clear();
-}
-
-#pragma omp task depend(inout : OneMessageSize, *BufferSize) depend(out : numMessagesToSend) depend(in : *numGhostEdges)
-{
-
-#ifdef PRINT_DEBUG_INFO_
-  cout << "\n(" << myRank << ")Number of Ghost edges = " << *numGhostEdges;
-  cout << "\n(" << myRank << ")Total number of potential message X 2 = " << *numGhostEdges * 2;
-  cout << "\n(" << myRank << ")Number messages already sent in bundles = " << NumMessagesBundled;
-  if (*numGhostEdges > 0)
-    {
-      cout << "\n(" << myRank << ")Percentage of total = " << ((double)NumMessagesBundled / (double)(*numGhostEdges * 2)) * 100.0 << "% \n";
-    }
-  fflush(stdout);
-#endif
-
-  // Allocate memory for MPI Send messages:
-  /* WILL COME BACK HERE - NO NEED TO STORE ALL THIS MEMORY !! */
-  OneMessageSize = 0;
-  MPI_Pack_size(3, TypeMap<MilanLongInt>(), comm, &OneMessageSize); // Size of one message packet
-  // How many messages to send?
-  // Potentially three kinds of messages will be sent/received:
-  // Request, Success, Failure.
-  // But only two will be sent from a given processor.
-  // Substract the number of messages that have already been sent as bundled messages:
-  numMessagesToSend = (*numGhostEdges) * 2 - NumMessagesBundled;
-  *BufferSize = (OneMessageSize + MPI_BSEND_OVERHEAD) * numMessagesToSend;
-}
-
-#pragma omp task depend(out : Buffer) depend(in : *BufferSize)
- {
-   Buffer = 0;
-#ifdef PRINT_DEBUG_INFO_
-   cout << "\n(" << myRank << ")Size of One Message from PACK= " << OneMessageSize;
-   cout << "\n(" << myRank << ")Size of Message overhead = " << MPI_BSEND_OVERHEAD;
-   cout << "\n(" << myRank << ")Number of Ghost edges = " << *numGhostEdges;
-   cout << "\n(" << myRank << ")Number of remaining message = " << numMessagesToSend;
-   cout << "\n(" << myRank << ")BufferSize = " << (*BufferSize);
-   cout << "\n(" << myRank << ")Attaching Buffer on.. ";
-   fflush(stdout);
-#endif
-   if ((*BufferSize) > 0)
-     {
-       Buffer = (MilanLongInt *)malloc((*BufferSize)); // Allocate memory
-       if (Buffer == 0)
-	 {
-	   cout << "Error in function algoDistEdgeApproxDominatingEdgesLinearSearch: \n";
-	   cout << "Not enough memory to allocate for send buffer on process " << myRank << "\n";
-	   exit(1);
-	 }
-       MPI_Buffer_attach(Buffer, *BufferSize); // Attach the Buffer
-     }
- }
-}
-}
-}

amgprec/impl/amg_ccprecset.F90

@@ -336,7 +336,8 @@ subroutine amg_ccprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
   ! Local variables
   integer(psb_ipk_)                      :: ilev_, nlev_,val,ilmax_, il
   character(len=*), parameter            :: name='amg_precsetc'
-
+  logical :: hier_asb
+  
   info = psb_success_
 
   if (.not.allocated(p%precv)) then
@@ -459,6 +460,7 @@ subroutine amg_ccprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
           return
         end if
         if (nlev_ > 1) then
+          hier_asb = p%precv(nlev_)%ac%is_asb()          
           select case (psb_toupper(string))
           case('BJAC')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
@@ -469,7 +471,11 @@ subroutine amg_ccprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
 #else
             call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
 #endif
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info)
+
           case('L1-BJAC')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_l1_bjac_,info,pos=pos)
 #if defined(HAVE_SLU_)
@@ -479,55 +485,91 @@ subroutine amg_ccprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
 #else
             call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
 #endif
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info)
           case('SLU')
 #if defined(HAVE_SLU_)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_slu_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_repl_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
 #elif defined(HAVE_MUMPS_)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_mumps_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #else
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #endif
           case('ILU')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_repl_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
           case('ILUT')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_t_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_repl_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
           case('MILU')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',psb_milu_n_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_repl_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
           case('MUMPS')
 #if defined(HAVE_MUMPS_)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_mumps_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #else
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #endif
          case('UMF')
 #if defined(HAVE_SLU_)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_slu_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_repl_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
 #elif defined(HAVE_MUMPS_)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_mumps_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #else
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #endif
 
@@ -535,42 +577,69 @@ subroutine amg_ccprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
 #if defined(HAVE_SLU_)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_slu_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_repl_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
 #elif defined(HAVE_MUMPS_)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_mumps_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_repl_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #else
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #endif
           case('JACOBI','JAC')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_diag_scale_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 
           case('L1-JACOBI','L1-JAC')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_l1_diag_scale_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
           case('GS','FBGS')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_gs_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
           case('BWGS')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_bwgs_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
           case('L1-GS','L1-FBGS')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_l1_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_gs_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
           case('KRM')
             block
               type(amg_c_krm_solver_type)          :: krm_slv
               call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_krm_,info,pos=pos)
               call p%precv(nlev_)%set(krm_slv,info)
+              if (hier_asb) &
+                   & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                   & amg_distr_mat_)
               call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
             end block
           end select
@@ -610,11 +679,16 @@ subroutine amg_ccprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
 
     case('COARSE_MAT')
       if (nlev_ > 1) then
+        hier_asb = p%precv(nlev_)%ac%is_asb()                  
+        if (hier_asb) &
+             & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+             & amg_stringval(string))
         call p%precv(nlev_)%set('COARSE_MAT',string,info,pos=pos)
       end if
 
     case('COARSE_SOLVE')
       if (nlev_ > 1) then
+        hier_asb = p%precv(nlev_)%ac%is_asb()          
         call p%precv(nlev_)%set('COARSE_SOLVE',string,info,pos=pos)
         select case (psb_toupper(trim(string)))
         case('BJAC')
@@ -626,6 +700,9 @@ subroutine amg_ccprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
 #else
           call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
 #endif
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info)
         case('L1-BJAC')
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_l1_bjac_,info,pos=pos)
@@ -636,55 +713,91 @@ subroutine amg_ccprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
 #else
           call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
 #endif
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info)
         case('SLU')
 #if defined(HAVE_SLU_)
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_slu_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_repl_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
 #elif defined(HAVE_MUMPS_)
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_mumps_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #else
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #endif
         case('ILU')
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_repl_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
         case('ILUT')
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_t_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_repl_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
         case('MILU')
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',psb_milu_n_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_repl_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
         case('MUMPS')
 #if defined(HAVE_MUMPS_)
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_mumps_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #else
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #endif
         case('UMF')
 #if defined(HAVE_SLU_)
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_slu_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_repl_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
 #elif defined(HAVE_MUMPS_)
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_mumps_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #else
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #endif
 
@@ -692,42 +805,69 @@ subroutine amg_ccprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
 #if defined(HAVE_SLU_)
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_slu_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_repl_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
 #elif defined(HAVE_MUMPS_)
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_mumps_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #else
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #endif
         case('JACOBI','JAC')
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_diag_scale_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 
         case('L1-JACOBI','L1-JAC')
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_l1_diag_scale_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
         case('GS','FBGS')
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_gs_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
         case('BWGS')
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_bwgs_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
         case('L1-FBGS','L1-GS')
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_l1_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_gs_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
           case('KRM')
             block
               type(amg_c_krm_solver_type)          :: krm_slv
               call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_krm_,info,pos=pos)
               call p%precv(nlev_)%set(krm_slv,info)
+              if (hier_asb) &
+                   & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                   & amg_distr_mat_)
               call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
             end block
         end select

amgprec/impl/amg_cprecinit.F90

@@ -237,7 +237,6 @@ subroutine amg_cprecinit(ctxt,prec,ptype,info)
 #else
     call prec%set('COARSE_SOLVE','ILU',info)
 #endif
-
   case default
     write(psb_err_unit,*) name,&
          &': Warning: Unknown preconditioner type request "',ptype,'"'

amgprec/impl/amg_dcprecset.F90

@@ -348,7 +348,8 @@ subroutine amg_dcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
   ! Local variables
   integer(psb_ipk_)                      :: ilev_, nlev_,val,ilmax_, il
   character(len=*), parameter            :: name='amg_precsetc'
-
+  logical :: hier_asb
+  
   info = psb_success_
 
   if (.not.allocated(p%precv)) then
@@ -471,6 +472,7 @@ subroutine amg_dcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
           return
         end if
         if (nlev_ > 1) then
+          hier_asb = p%precv(nlev_)%ac%is_asb()          
           select case (psb_toupper(string))
           case('BJAC')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
@@ -483,7 +485,11 @@ subroutine amg_dcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
 #else
             call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
 #endif
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info)
+
           case('L1-BJAC')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_l1_bjac_,info,pos=pos)
 #if defined(HAVE_UMF_)
@@ -495,59 +501,98 @@ subroutine amg_dcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
 #else
             call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
 #endif
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info)
           case('SLU')
 #if defined(HAVE_SLU_)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_slu_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_repl_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
 #elif defined(HAVE_MUMPS_)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_mumps_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #else
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #endif
           case('ILU')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_repl_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
           case('ILUT')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_t_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_repl_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
           case('MILU')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',psb_milu_n_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_repl_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
           case('MUMPS')
 #if defined(HAVE_MUMPS_)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_mumps_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #else
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #endif
           case('UMF')
 #if defined(HAVE_UMF_)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_umf_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_repl_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
 #elif defined(HAVE_SLU_)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_slu_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_repl_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
 #elif defined(HAVE_MUMPS_)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_mumps_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #else
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #endif
 
@@ -555,50 +600,83 @@ subroutine amg_dcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
 #if defined(HAVE_SLUDIST_)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_sludist_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #elif defined(HAVE_UMF_)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_umf_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_repl_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
 #elif defined(HAVE_SLU_)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_slu_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_repl_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
 #elif defined(HAVE_MUMPS_)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_mumps_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #else
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #endif
           case('JACOBI','JAC')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_diag_scale_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 
           case('L1-JACOBI','L1-JAC')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_l1_diag_scale_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
           case('GS','FBGS')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_gs_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
           case('BWGS')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_bwgs_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
           case('L1-GS','L1-FBGS')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_l1_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_gs_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
           case('KRM')
             block
               type(amg_d_krm_solver_type)          :: krm_slv
               call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_krm_,info,pos=pos)
               call p%precv(nlev_)%set(krm_slv,info)
+              if (hier_asb) &
+                   & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                   & amg_distr_mat_)
               call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
             end block
           end select
@@ -638,11 +716,16 @@ subroutine amg_dcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
 
     case('COARSE_MAT')
       if (nlev_ > 1) then
+        hier_asb = p%precv(nlev_)%ac%is_asb()                  
+        if (hier_asb) &
+             & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+             & amg_stringval(string))
         call p%precv(nlev_)%set('COARSE_MAT',string,info,pos=pos)
       end if
 
     case('COARSE_SOLVE')
       if (nlev_ > 1) then
+        hier_asb = p%precv(nlev_)%ac%is_asb()          
         call p%precv(nlev_)%set('COARSE_SOLVE',string,info,pos=pos)
         select case (psb_toupper(trim(string)))
         case('BJAC')
@@ -656,6 +739,9 @@ subroutine amg_dcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
 #else
           call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
 #endif
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info)
         case('L1-BJAC')
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_l1_bjac_,info,pos=pos)
@@ -668,59 +754,98 @@ subroutine amg_dcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
 #else
           call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
 #endif
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info)
         case('SLU')
 #if defined(HAVE_SLU_)
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_slu_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_repl_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
 #elif defined(HAVE_MUMPS_)
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_mumps_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #else
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #endif
         case('ILU')
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_repl_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
         case('ILUT')
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_t_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_repl_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
         case('MILU')
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',psb_milu_n_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_repl_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
         case('MUMPS')
 #if defined(HAVE_MUMPS_)
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_mumps_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #else
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #endif
         case('UMF')
 #if defined(HAVE_UMF_)
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_umf_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_repl_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
 #elif defined(HAVE_SLU_)
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_slu_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_repl_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
 #elif defined(HAVE_MUMPS_)
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_mumps_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #else
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #endif
 
@@ -728,50 +853,83 @@ subroutine amg_dcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
 #if defined(HAVE_SLUDIST_)
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_sludist_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #elif defined(HAVE_UMF_)
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_umf_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_repl_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
 #elif defined(HAVE_SLU_)
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_slu_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_repl_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
 #elif defined(HAVE_MUMPS_)
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_mumps_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #else
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #endif
         case('JACOBI','JAC')
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_diag_scale_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 
         case('L1-JACOBI','L1-JAC')
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_l1_diag_scale_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
         case('GS','FBGS')
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_gs_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
         case('BWGS')
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_bwgs_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
         case('L1-FBGS','L1-GS')
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_l1_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_gs_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
           case('KRM')
             block
               type(amg_d_krm_solver_type)          :: krm_slv
               call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_krm_,info,pos=pos)
               call p%precv(nlev_)%set(krm_slv,info)
+              if (hier_asb) &
+                   & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                   & amg_distr_mat_)
               call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
             end block
         end select

amgprec/impl/amg_dprecinit.F90

@@ -242,7 +242,6 @@ subroutine amg_dprecinit(ctxt,prec,ptype,info)
 #else
     call prec%set('COARSE_SOLVE','ILU',info)
 #endif
-
   case default
     write(psb_err_unit,*) name,&
          &': Warning: Unknown preconditioner type request "',ptype,'"'

amgprec/impl/amg_scprecset.F90

@@ -336,7 +336,8 @@ subroutine amg_scprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
   ! Local variables
   integer(psb_ipk_)                      :: ilev_, nlev_,val,ilmax_, il
   character(len=*), parameter            :: name='amg_precsetc'
-
+  logical :: hier_asb
+  
   info = psb_success_
 
   if (.not.allocated(p%precv)) then
@@ -459,6 +460,7 @@ subroutine amg_scprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
           return
         end if
         if (nlev_ > 1) then
+          hier_asb = p%precv(nlev_)%ac%is_asb()          
           select case (psb_toupper(string))
           case('BJAC')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
@@ -469,7 +471,11 @@ subroutine amg_scprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
 #else
             call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
 #endif
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info)
+
           case('L1-BJAC')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_l1_bjac_,info,pos=pos)
 #if defined(HAVE_SLU_)
@@ -479,55 +485,91 @@ subroutine amg_scprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
 #else
             call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
 #endif
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info)
           case('SLU')
 #if defined(HAVE_SLU_)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_slu_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_repl_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
 #elif defined(HAVE_MUMPS_)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_mumps_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #else
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #endif
           case('ILU')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_repl_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
           case('ILUT')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_t_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_repl_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
           case('MILU')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',psb_milu_n_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_repl_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
           case('MUMPS')
 #if defined(HAVE_MUMPS_)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_mumps_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #else
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #endif
          case('UMF')
 #if defined(HAVE_SLU_)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_slu_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_repl_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
 #elif defined(HAVE_MUMPS_)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_mumps_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #else
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #endif
 
@@ -535,42 +577,69 @@ subroutine amg_scprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
 #if defined(HAVE_SLU_)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_slu_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_repl_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
 #elif defined(HAVE_MUMPS_)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_mumps_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_repl_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #else
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #endif
           case('JACOBI','JAC')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_diag_scale_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 
           case('L1-JACOBI','L1-JAC')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_l1_diag_scale_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
           case('GS','FBGS')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_gs_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
           case('BWGS')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_bwgs_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
           case('L1-GS','L1-FBGS')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_l1_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_gs_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
           case('KRM')
             block
               type(amg_s_krm_solver_type)          :: krm_slv
               call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_krm_,info,pos=pos)
               call p%precv(nlev_)%set(krm_slv,info)
+              if (hier_asb) &
+                   & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                   & amg_distr_mat_)
               call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
             end block
           end select
@@ -610,11 +679,16 @@ subroutine amg_scprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
 
     case('COARSE_MAT')
       if (nlev_ > 1) then
+        hier_asb = p%precv(nlev_)%ac%is_asb()                  
+        if (hier_asb) &
+             & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+             & amg_stringval(string))
         call p%precv(nlev_)%set('COARSE_MAT',string,info,pos=pos)
       end if
 
     case('COARSE_SOLVE')
       if (nlev_ > 1) then
+        hier_asb = p%precv(nlev_)%ac%is_asb()          
         call p%precv(nlev_)%set('COARSE_SOLVE',string,info,pos=pos)
         select case (psb_toupper(trim(string)))
         case('BJAC')
@@ -626,6 +700,9 @@ subroutine amg_scprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
 #else
           call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
 #endif
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info)
         case('L1-BJAC')
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_l1_bjac_,info,pos=pos)
@@ -636,55 +713,91 @@ subroutine amg_scprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
 #else
           call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
 #endif
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info)
         case('SLU')
 #if defined(HAVE_SLU_)
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_slu_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_repl_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
 #elif defined(HAVE_MUMPS_)
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_mumps_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #else
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #endif
         case('ILU')
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_repl_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
         case('ILUT')
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_t_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_repl_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
         case('MILU')
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',psb_milu_n_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_repl_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
         case('MUMPS')
 #if defined(HAVE_MUMPS_)
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_mumps_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #else
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #endif
         case('UMF')
 #if defined(HAVE_SLU_)
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_slu_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_repl_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
 #elif defined(HAVE_MUMPS_)
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_mumps_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #else
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #endif
 
@@ -692,42 +805,69 @@ subroutine amg_scprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
 #if defined(HAVE_SLU_)
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_slu_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_repl_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
 #elif defined(HAVE_MUMPS_)
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_mumps_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #else
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #endif
         case('JACOBI','JAC')
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_diag_scale_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 
         case('L1-JACOBI','L1-JAC')
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_l1_diag_scale_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
         case('GS','FBGS')
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_gs_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
         case('BWGS')
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_bwgs_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
         case('L1-FBGS','L1-GS')
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_l1_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_gs_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
           case('KRM')
             block
               type(amg_s_krm_solver_type)          :: krm_slv
               call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_krm_,info,pos=pos)
               call p%precv(nlev_)%set(krm_slv,info)
+              if (hier_asb) &
+                   & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                   & amg_distr_mat_)
               call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
             end block
         end select

amgprec/impl/amg_sprecinit.F90

@@ -237,7 +237,6 @@ subroutine amg_sprecinit(ctxt,prec,ptype,info)
 #else
     call prec%set('COARSE_SOLVE','ILU',info)
 #endif
-
   case default
     write(psb_err_unit,*) name,&
          &': Warning: Unknown preconditioner type request "',ptype,'"'

amgprec/impl/amg_zcprecset.F90

@@ -348,7 +348,8 @@ subroutine amg_zcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
   ! Local variables
   integer(psb_ipk_)                      :: ilev_, nlev_,val,ilmax_, il
   character(len=*), parameter            :: name='amg_precsetc'
-
+  logical :: hier_asb
+  
   info = psb_success_
 
   if (.not.allocated(p%precv)) then
@@ -471,6 +472,7 @@ subroutine amg_zcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
           return
         end if
         if (nlev_ > 1) then
+          hier_asb = p%precv(nlev_)%ac%is_asb()          
           select case (psb_toupper(string))
           case('BJAC')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
@@ -483,7 +485,11 @@ subroutine amg_zcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
 #else
             call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
 #endif
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info)
+
           case('L1-BJAC')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_l1_bjac_,info,pos=pos)
 #if defined(HAVE_UMF_)
@@ -495,59 +501,98 @@ subroutine amg_zcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
 #else
             call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
 #endif
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info)
           case('SLU')
 #if defined(HAVE_SLU_)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_slu_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_repl_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
 #elif defined(HAVE_MUMPS_)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_mumps_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #else
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #endif
           case('ILU')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_repl_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
           case('ILUT')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_t_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_repl_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
           case('MILU')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',psb_milu_n_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_repl_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
           case('MUMPS')
 #if defined(HAVE_MUMPS_)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_mumps_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #else
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #endif
           case('UMF')
 #if defined(HAVE_UMF_)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_umf_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_repl_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
 #elif defined(HAVE_SLU_)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_slu_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_repl_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
 #elif defined(HAVE_MUMPS_)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_mumps_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #else
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #endif
 
@@ -555,50 +600,83 @@ subroutine amg_zcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
 #if defined(HAVE_SLUDIST_)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_sludist_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #elif defined(HAVE_UMF_)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_umf_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_repl_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
 #elif defined(HAVE_SLU_)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_slu_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_repl_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
 #elif defined(HAVE_MUMPS_)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_mumps_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #else
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #endif
           case('JACOBI','JAC')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_diag_scale_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 
           case('L1-JACOBI','L1-JAC')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_l1_diag_scale_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
           case('GS','FBGS')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_gs_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
           case('BWGS')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_bwgs_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
           case('L1-GS','L1-FBGS')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_l1_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_gs_,info,pos=pos)
+            if (hier_asb) &
+                 & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                 & amg_distr_mat_)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
           case('KRM')
             block
               type(amg_z_krm_solver_type)          :: krm_slv
               call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_krm_,info,pos=pos)
               call p%precv(nlev_)%set(krm_slv,info)
+              if (hier_asb) &
+                   & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                   & amg_distr_mat_)
               call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
             end block
           end select
@@ -638,11 +716,16 @@ subroutine amg_zcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
 
     case('COARSE_MAT')
       if (nlev_ > 1) then
+        hier_asb = p%precv(nlev_)%ac%is_asb()                  
+        if (hier_asb) &
+             & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+             & amg_stringval(string))
         call p%precv(nlev_)%set('COARSE_MAT',string,info,pos=pos)
       end if
 
     case('COARSE_SOLVE')
       if (nlev_ > 1) then
+        hier_asb = p%precv(nlev_)%ac%is_asb()          
         call p%precv(nlev_)%set('COARSE_SOLVE',string,info,pos=pos)
         select case (psb_toupper(trim(string)))
         case('BJAC')
@@ -656,6 +739,9 @@ subroutine amg_zcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
 #else
           call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
 #endif
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info)
         case('L1-BJAC')
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_l1_bjac_,info,pos=pos)
@@ -668,59 +754,98 @@ subroutine amg_zcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
 #else
           call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
 #endif
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info)
         case('SLU')
 #if defined(HAVE_SLU_)
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_slu_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_repl_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
 #elif defined(HAVE_MUMPS_)
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_mumps_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #else
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #endif
         case('ILU')
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_repl_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
         case('ILUT')
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_t_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_repl_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
         case('MILU')
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',psb_milu_n_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_repl_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
         case('MUMPS')
 #if defined(HAVE_MUMPS_)
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_mumps_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #else
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #endif
         case('UMF')
 #if defined(HAVE_UMF_)
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_umf_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_repl_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
 #elif defined(HAVE_SLU_)
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_slu_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_repl_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
 #elif defined(HAVE_MUMPS_)
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_mumps_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #else
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #endif
 
@@ -728,50 +853,83 @@ subroutine amg_zcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
 #if defined(HAVE_SLUDIST_)
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_sludist_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #elif defined(HAVE_UMF_)
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_umf_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_repl_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
 #elif defined(HAVE_SLU_)
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_slu_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_repl_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_repl_mat_,info,pos=pos)
 #elif defined(HAVE_MUMPS_)
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_mumps_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #else
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 #endif
         case('JACOBI','JAC')
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_diag_scale_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
 
         case('L1-JACOBI','L1-JAC')
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_l1_diag_scale_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
         case('GS','FBGS')
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_gs_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
         case('BWGS')
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_bwgs_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
         case('L1-FBGS','L1-GS')
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_l1_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_gs_,info,pos=pos)
+          if (hier_asb) &
+               & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+               & amg_distr_mat_)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
           case('KRM')
             block
               type(amg_z_krm_solver_type)          :: krm_slv
               call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_krm_,info,pos=pos)
               call p%precv(nlev_)%set(krm_slv,info)
+              if (hier_asb) &
+                   & call amg_warn_coarse_mat(p%precv(nlev_)%parms%get_coarse_mat(),&
+                   & amg_distr_mat_)
               call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
             end block
         end select

amgprec/impl/amg_zprecinit.F90

@@ -242,7 +242,6 @@ subroutine amg_zprecinit(ctxt,prec,ptype,info)
 #else
     call prec%set('COARSE_SOLVE','ILU',info)
 #endif
-
   case default
     write(psb_err_unit,*) name,&
          &': Warning: Unknown preconditioner type request "',ptype,'"'

amgprec/impl/level/Makefile

@@ -17,6 +17,7 @@ amg_c_base_onelev_csetr.o \
 amg_c_base_onelev_descr.o \
 amg_c_base_onelev_dump.o \
 amg_c_base_onelev_free.o \
+amg_c_base_onelev_free_smoothers.o \
 amg_c_base_onelev_mat_asb.o \
 amg_c_base_onelev_setag.o \
 amg_c_base_onelev_setsm.o \
@@ -32,6 +33,7 @@ amg_d_base_onelev_csetr.o \
 amg_d_base_onelev_descr.o \
 amg_d_base_onelev_dump.o \
 amg_d_base_onelev_free.o \
+amg_d_base_onelev_free_smoothers.o \
 amg_d_base_onelev_mat_asb.o \
 amg_d_base_onelev_setag.o \
 amg_d_base_onelev_setsm.o \
@@ -47,6 +49,7 @@ amg_s_base_onelev_csetr.o \
 amg_s_base_onelev_descr.o \
 amg_s_base_onelev_dump.o \
 amg_s_base_onelev_free.o \
+amg_s_base_onelev_free_smoothers.o \
 amg_s_base_onelev_mat_asb.o \
 amg_s_base_onelev_setag.o \
 amg_s_base_onelev_setsm.o \
@@ -62,6 +65,7 @@ amg_z_base_onelev_csetr.o \
 amg_z_base_onelev_descr.o \
 amg_z_base_onelev_dump.o \
 amg_z_base_onelev_free.o \
+amg_z_base_onelev_free_smoothers.o \
 amg_z_base_onelev_mat_asb.o \
 amg_z_base_onelev_setag.o \
 amg_z_base_onelev_setsm.o \

amgprec/impl/level/amg_c_base_onelev_free_smoothers.f90

@@ -0,0 +1,60 @@
+!  
+!   
+!                             AMG4PSBLAS version 1.0
+!    Algebraic Multigrid Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!    
+!    (C) Copyright 2021 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Fabio Durastante        
+!   
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the AMG4PSBLAS group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!   
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!   
+!  
+subroutine amg_c_base_onelev_free_smoothers(lv,info)
+  
+  use psb_base_mod
+  use amg_c_onelev_mod, amg_protect_name =>  amg_c_base_onelev_free_smoothers
+  implicit none 
+
+  class(amg_c_onelev_type), intent(inout) :: lv
+  integer(psb_ipk_), intent(out)          :: info
+  integer(psb_ipk_) :: i
+
+  info = psb_success_
+
+  ! We might just deallocate the top level array, except 
+  ! that there may be inner objects containing C pointers,
+  ! e.g.  UMFPACK, SLU or CUDA stuff.
+  ! We really need FINALs. 
+  if (allocated(lv%sm)) &
+       & call lv%sm%free(info)
+
+  if (allocated(lv%sm2a)) &
+       & call lv%sm2a%free(info)
+
+end subroutine amg_c_base_onelev_free_smoothers

amgprec/impl/level/amg_c_base_onelev_mat_asb.f90

@@ -109,8 +109,6 @@ subroutine amg_c_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
   type(psb_cspmat_type)    :: ac, op_restr, op_prol
   integer(psb_ipk_)        :: nzl, inl
   integer(psb_ipk_)        :: debug_level, debug_unit
-  integer(psb_ipk_), save  :: idx_matbld=-1, idx_matasb=-1, idx_mapbld=-1
-  logical, parameter :: do_timings=.false.
 
   name='amg_c_onelev_mat_asb'
   call psb_erractionsave(err_act)
@@ -122,12 +120,6 @@ subroutine amg_c_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
   info  = psb_success_
   ctxt = desc_a%get_context()
   call psb_info(ctxt,me,np)
-  if ((do_timings).and.(idx_matbld==-1))       &
-       & idx_matbld = psb_get_timer_idx("LEV_MASB: mat_bld")
-  if ((do_timings).and.(idx_matasb==-1))     &
-       & idx_matasb = psb_get_timer_idx("LEV_MASB: mat_asb")
-  if ((do_timings).and.(idx_mapbld==-1))       &
-       & idx_mapbld = psb_get_timer_idx("LEV_MASB: map_bld")
 
   call amg_check_def(lv%parms%aggr_prol,'Smoother',&
        &   amg_smooth_prol_,is_legal_ml_aggr_prol)
@@ -147,10 +139,9 @@ subroutine amg_c_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
   ! the mapping defined by amg_aggrmap_bld and applying the aggregation
   ! algorithm specified by lv%iprcparm(amg_aggr_prol_)
   !
-  if (do_timings) call psb_tic(idx_matbld)
   call lv%aggr%mat_bld(lv%parms,a,desc_a,ilaggr,nlaggr,&
        & lv%ac,lv%desc_ac,op_prol,op_restr,t_prol,info)
-  if (do_timings) call psb_toc(idx_matbld)
+
   if(info /= psb_success_) then
     call psb_errpush(psb_err_from_subroutine_,name,a_err='amg_aggrmat_asb')
     goto 9999
@@ -160,17 +151,14 @@ subroutine amg_c_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
   ! Now build its descriptor and convert global indices for
   ! ac, op_restr and op_prol
   !
-  if (do_timings) call psb_tic(idx_matasb)
   if (info == psb_success_) &
        & call lv%aggr%mat_asb(lv%parms,a,desc_a,&
        & lv%ac,lv%desc_ac,op_prol,op_restr,info)
-  if (do_timings) call psb_toc(idx_matasb)
-  if (do_timings) call psb_tic(idx_mapbld)  
+  
   if (info == psb_success_) call lv%ac%cscnv(info,type='csr',dupl=psb_dupl_add_)
   
   if (info == psb_success_) call lv%aggr%bld_map(desc_a, lv%desc_ac,&
        & ilaggr,nlaggr,op_restr,op_prol,lv%linmap,info)
-  if (do_timings) call psb_toc(idx_mapbld)  
   if(info /= psb_success_) then
     call psb_errpush(psb_err_from_subroutine_,name,a_err='mat_asb/map_bld')
     goto 9999

amgprec/impl/level/amg_d_base_onelev_free_smoothers.f90

@@ -0,0 +1,60 @@
+!  
+!   
+!                             AMG4PSBLAS version 1.0
+!    Algebraic Multigrid Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!    
+!    (C) Copyright 2021 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Fabio Durastante        
+!   
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the AMG4PSBLAS group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!   
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!   
+!  
+subroutine amg_d_base_onelev_free_smoothers(lv,info)
+  
+  use psb_base_mod
+  use amg_d_onelev_mod, amg_protect_name =>  amg_d_base_onelev_free_smoothers
+  implicit none 
+
+  class(amg_d_onelev_type), intent(inout) :: lv
+  integer(psb_ipk_), intent(out)          :: info
+  integer(psb_ipk_) :: i
+
+  info = psb_success_
+
+  ! We might just deallocate the top level array, except 
+  ! that there may be inner objects containing C pointers,
+  ! e.g.  UMFPACK, SLU or CUDA stuff.
+  ! We really need FINALs. 
+  if (allocated(lv%sm)) &
+       & call lv%sm%free(info)
+
+  if (allocated(lv%sm2a)) &
+       & call lv%sm2a%free(info)
+
+end subroutine amg_d_base_onelev_free_smoothers

amgprec/impl/level/amg_d_base_onelev_mat_asb.f90

@@ -109,8 +109,6 @@ subroutine amg_d_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
   type(psb_dspmat_type)    :: ac, op_restr, op_prol
   integer(psb_ipk_)        :: nzl, inl
   integer(psb_ipk_)        :: debug_level, debug_unit
-  integer(psb_ipk_), save  :: idx_matbld=-1, idx_matasb=-1, idx_mapbld=-1
-  logical, parameter :: do_timings=.false.
 
   name='amg_d_onelev_mat_asb'
   call psb_erractionsave(err_act)
@@ -122,12 +120,6 @@ subroutine amg_d_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
   info  = psb_success_
   ctxt = desc_a%get_context()
   call psb_info(ctxt,me,np)
-  if ((do_timings).and.(idx_matbld==-1))       &
-       & idx_matbld = psb_get_timer_idx("LEV_MASB: mat_bld")
-  if ((do_timings).and.(idx_matasb==-1))     &
-       & idx_matasb = psb_get_timer_idx("LEV_MASB: mat_asb")
-  if ((do_timings).and.(idx_mapbld==-1))       &
-       & idx_mapbld = psb_get_timer_idx("LEV_MASB: map_bld")
 
   call amg_check_def(lv%parms%aggr_prol,'Smoother',&
        &   amg_smooth_prol_,is_legal_ml_aggr_prol)
@@ -147,10 +139,9 @@ subroutine amg_d_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
   ! the mapping defined by amg_aggrmap_bld and applying the aggregation
   ! algorithm specified by lv%iprcparm(amg_aggr_prol_)
   !
-  if (do_timings) call psb_tic(idx_matbld)
   call lv%aggr%mat_bld(lv%parms,a,desc_a,ilaggr,nlaggr,&
        & lv%ac,lv%desc_ac,op_prol,op_restr,t_prol,info)
-  if (do_timings) call psb_toc(idx_matbld)
+
   if(info /= psb_success_) then
     call psb_errpush(psb_err_from_subroutine_,name,a_err='amg_aggrmat_asb')
     goto 9999
@@ -160,17 +151,14 @@ subroutine amg_d_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
   ! Now build its descriptor and convert global indices for
   ! ac, op_restr and op_prol
   !
-  if (do_timings) call psb_tic(idx_matasb)
   if (info == psb_success_) &
        & call lv%aggr%mat_asb(lv%parms,a,desc_a,&
        & lv%ac,lv%desc_ac,op_prol,op_restr,info)
-  if (do_timings) call psb_toc(idx_matasb)
-  if (do_timings) call psb_tic(idx_mapbld)  
+  
   if (info == psb_success_) call lv%ac%cscnv(info,type='csr',dupl=psb_dupl_add_)
   
   if (info == psb_success_) call lv%aggr%bld_map(desc_a, lv%desc_ac,&
        & ilaggr,nlaggr,op_restr,op_prol,lv%linmap,info)
-  if (do_timings) call psb_toc(idx_mapbld)  
   if(info /= psb_success_) then
     call psb_errpush(psb_err_from_subroutine_,name,a_err='mat_asb/map_bld')
     goto 9999

amgprec/impl/level/amg_s_base_onelev_free_smoothers.f90

@@ -0,0 +1,60 @@
+!  
+!   
+!                             AMG4PSBLAS version 1.0
+!    Algebraic Multigrid Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!    
+!    (C) Copyright 2021 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Fabio Durastante        
+!   
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the AMG4PSBLAS group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!   
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!   
+!  
+subroutine amg_s_base_onelev_free_smoothers(lv,info)
+  
+  use psb_base_mod
+  use amg_s_onelev_mod, amg_protect_name =>  amg_s_base_onelev_free_smoothers
+  implicit none 
+
+  class(amg_s_onelev_type), intent(inout) :: lv
+  integer(psb_ipk_), intent(out)          :: info
+  integer(psb_ipk_) :: i
+
+  info = psb_success_
+
+  ! We might just deallocate the top level array, except 
+  ! that there may be inner objects containing C pointers,
+  ! e.g.  UMFPACK, SLU or CUDA stuff.
+  ! We really need FINALs. 
+  if (allocated(lv%sm)) &
+       & call lv%sm%free(info)
+
+  if (allocated(lv%sm2a)) &
+       & call lv%sm2a%free(info)
+
+end subroutine amg_s_base_onelev_free_smoothers

amgprec/impl/level/amg_s_base_onelev_mat_asb.f90

@@ -109,8 +109,6 @@ subroutine amg_s_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
   type(psb_sspmat_type)    :: ac, op_restr, op_prol
   integer(psb_ipk_)        :: nzl, inl
   integer(psb_ipk_)        :: debug_level, debug_unit
-  integer(psb_ipk_), save  :: idx_matbld=-1, idx_matasb=-1, idx_mapbld=-1
-  logical, parameter :: do_timings=.false.
 
   name='amg_s_onelev_mat_asb'
   call psb_erractionsave(err_act)
@@ -122,12 +120,6 @@ subroutine amg_s_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
   info  = psb_success_
   ctxt = desc_a%get_context()
   call psb_info(ctxt,me,np)
-  if ((do_timings).and.(idx_matbld==-1))       &
-       & idx_matbld = psb_get_timer_idx("LEV_MASB: mat_bld")
-  if ((do_timings).and.(idx_matasb==-1))     &
-       & idx_matasb = psb_get_timer_idx("LEV_MASB: mat_asb")
-  if ((do_timings).and.(idx_mapbld==-1))       &
-       & idx_mapbld = psb_get_timer_idx("LEV_MASB: map_bld")
 
   call amg_check_def(lv%parms%aggr_prol,'Smoother',&
        &   amg_smooth_prol_,is_legal_ml_aggr_prol)
@@ -147,10 +139,9 @@ subroutine amg_s_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
   ! the mapping defined by amg_aggrmap_bld and applying the aggregation
   ! algorithm specified by lv%iprcparm(amg_aggr_prol_)
   !
-  if (do_timings) call psb_tic(idx_matbld)
   call lv%aggr%mat_bld(lv%parms,a,desc_a,ilaggr,nlaggr,&
        & lv%ac,lv%desc_ac,op_prol,op_restr,t_prol,info)
-  if (do_timings) call psb_toc(idx_matbld)
+
   if(info /= psb_success_) then
     call psb_errpush(psb_err_from_subroutine_,name,a_err='amg_aggrmat_asb')
     goto 9999
@@ -160,17 +151,14 @@ subroutine amg_s_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
   ! Now build its descriptor and convert global indices for
   ! ac, op_restr and op_prol
   !
-  if (do_timings) call psb_tic(idx_matasb)
   if (info == psb_success_) &
        & call lv%aggr%mat_asb(lv%parms,a,desc_a,&
        & lv%ac,lv%desc_ac,op_prol,op_restr,info)
-  if (do_timings) call psb_toc(idx_matasb)
-  if (do_timings) call psb_tic(idx_mapbld)  
+  
   if (info == psb_success_) call lv%ac%cscnv(info,type='csr',dupl=psb_dupl_add_)
   
   if (info == psb_success_) call lv%aggr%bld_map(desc_a, lv%desc_ac,&
        & ilaggr,nlaggr,op_restr,op_prol,lv%linmap,info)
-  if (do_timings) call psb_toc(idx_mapbld)  
   if(info /= psb_success_) then
     call psb_errpush(psb_err_from_subroutine_,name,a_err='mat_asb/map_bld')
     goto 9999

amgprec/impl/level/amg_z_base_onelev_free_smoothers.f90

@@ -0,0 +1,60 @@
+!  
+!   
+!                             AMG4PSBLAS version 1.0
+!    Algebraic Multigrid Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!    
+!    (C) Copyright 2021 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Fabio Durastante        
+!   
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the AMG4PSBLAS group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!   
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!   
+!  
+subroutine amg_z_base_onelev_free_smoothers(lv,info)
+  
+  use psb_base_mod
+  use amg_z_onelev_mod, amg_protect_name =>  amg_z_base_onelev_free_smoothers
+  implicit none 
+
+  class(amg_z_onelev_type), intent(inout) :: lv
+  integer(psb_ipk_), intent(out)          :: info
+  integer(psb_ipk_) :: i
+
+  info = psb_success_
+
+  ! We might just deallocate the top level array, except 
+  ! that there may be inner objects containing C pointers,
+  ! e.g.  UMFPACK, SLU or CUDA stuff.
+  ! We really need FINALs. 
+  if (allocated(lv%sm)) &
+       & call lv%sm%free(info)
+
+  if (allocated(lv%sm2a)) &
+       & call lv%sm2a%free(info)
+
+end subroutine amg_z_base_onelev_free_smoothers

amgprec/impl/level/amg_z_base_onelev_mat_asb.f90

@@ -109,8 +109,6 @@ subroutine amg_z_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
   type(psb_zspmat_type)    :: ac, op_restr, op_prol
   integer(psb_ipk_)        :: nzl, inl
   integer(psb_ipk_)        :: debug_level, debug_unit
-  integer(psb_ipk_), save  :: idx_matbld=-1, idx_matasb=-1, idx_mapbld=-1
-  logical, parameter :: do_timings=.false.
 
   name='amg_z_onelev_mat_asb'
   call psb_erractionsave(err_act)
@@ -122,12 +120,6 @@ subroutine amg_z_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
   info  = psb_success_
   ctxt = desc_a%get_context()
   call psb_info(ctxt,me,np)
-  if ((do_timings).and.(idx_matbld==-1))       &
-       & idx_matbld = psb_get_timer_idx("LEV_MASB: mat_bld")
-  if ((do_timings).and.(idx_matasb==-1))     &
-       & idx_matasb = psb_get_timer_idx("LEV_MASB: mat_asb")
-  if ((do_timings).and.(idx_mapbld==-1))       &
-       & idx_mapbld = psb_get_timer_idx("LEV_MASB: map_bld")
 
   call amg_check_def(lv%parms%aggr_prol,'Smoother',&
        &   amg_smooth_prol_,is_legal_ml_aggr_prol)
@@ -147,10 +139,9 @@ subroutine amg_z_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
   ! the mapping defined by amg_aggrmap_bld and applying the aggregation
   ! algorithm specified by lv%iprcparm(amg_aggr_prol_)
   !
-  if (do_timings) call psb_tic(idx_matbld)
   call lv%aggr%mat_bld(lv%parms,a,desc_a,ilaggr,nlaggr,&
        & lv%ac,lv%desc_ac,op_prol,op_restr,t_prol,info)
-  if (do_timings) call psb_toc(idx_matbld)
+
   if(info /= psb_success_) then
     call psb_errpush(psb_err_from_subroutine_,name,a_err='amg_aggrmat_asb')
     goto 9999
@@ -160,17 +151,14 @@ subroutine amg_z_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
   ! Now build its descriptor and convert global indices for
   ! ac, op_restr and op_prol
   !
-  if (do_timings) call psb_tic(idx_matasb)
   if (info == psb_success_) &
        & call lv%aggr%mat_asb(lv%parms,a,desc_a,&
        & lv%ac,lv%desc_ac,op_prol,op_restr,info)
-  if (do_timings) call psb_toc(idx_matasb)
-  if (do_timings) call psb_tic(idx_mapbld)  
+  
   if (info == psb_success_) call lv%ac%cscnv(info,type='csr',dupl=psb_dupl_add_)
   
   if (info == psb_success_) call lv%aggr%bld_map(desc_a, lv%desc_ac,&
        & ilaggr,nlaggr,op_restr,op_prol,lv%linmap,info)
-  if (do_timings) call psb_toc(idx_mapbld)  
   if(info /= psb_success_) then
     call psb_errpush(psb_err_from_subroutine_,name,a_err='mat_asb/map_bld')
     goto 9999

amgprec/impl/solver/Makefile

@@ -197,6 +197,7 @@ amg_z_mumps_solver_bld.o \
 amg_s_ainv_solver_bld.o \
 amg_s_ainv_solver_check.o \
 amg_s_ainv_solver_clone.o \
+amg_s_ainv_solver_clone_settings.o \
 amg_s_ainv_solver_csetc.o \
 amg_s_ainv_solver_cseti.o \
 amg_s_ainv_solver_csetr.o \
@@ -204,6 +205,7 @@ amg_s_ainv_solver_descr.o \
 amg_d_ainv_solver_bld.o \
 amg_d_ainv_solver_check.o \
 amg_d_ainv_solver_clone.o \
+amg_d_ainv_solver_clone_settings.o \
 amg_d_ainv_solver_csetc.o \
 amg_d_ainv_solver_cseti.o \
 amg_d_ainv_solver_csetr.o \
@@ -211,6 +213,7 @@ amg_d_ainv_solver_descr.o \
 amg_c_ainv_solver_bld.o \
 amg_c_ainv_solver_check.o \
 amg_c_ainv_solver_clone.o \
+amg_c_ainv_solver_clone_settings.o \
 amg_c_ainv_solver_csetc.o \
 amg_c_ainv_solver_cseti.o \
 amg_c_ainv_solver_csetr.o \
@@ -218,6 +221,7 @@ amg_c_ainv_solver_descr.o \
 amg_z_ainv_solver_bld.o \
 amg_z_ainv_solver_check.o \
 amg_z_ainv_solver_clone.o \
+amg_z_ainv_solver_clone_settings.o \
 amg_z_ainv_solver_csetc.o \
 amg_z_ainv_solver_cseti.o \
 amg_z_ainv_solver_csetr.o \
@@ -249,45 +253,53 @@ amg_z_base_ainv_update_a.o \
 amg_d_invt_solver_bld.o \
 amg_d_invt_solver_check.o \
 amg_d_invt_solver_clone.o \
+amg_d_invt_solver_clone_settings.o \
 amg_d_invt_solver_cseti.o \
 amg_d_invt_solver_csetr.o \
 amg_d_invt_solver_descr.o \
 amg_d_invk_solver_bld.o \
 amg_d_invk_solver_check.o \
 amg_d_invk_solver_clone.o \
+amg_d_invk_solver_clone_settings.o \
 amg_d_invk_solver_cseti.o \
 amg_d_invk_solver_descr.o \
 amg_s_invt_solver_bld.o \
 amg_s_invt_solver_check.o \
 amg_s_invt_solver_clone.o \
+amg_s_invt_solver_clone_settings.o \
 amg_s_invt_solver_cseti.o \
 amg_s_invt_solver_csetr.o \
 amg_s_invt_solver_descr.o \
 amg_s_invk_solver_bld.o \
 amg_s_invk_solver_check.o \
 amg_s_invk_solver_clone.o \
+amg_s_invk_solver_clone_settings.o \
 amg_s_invk_solver_cseti.o \
 amg_s_invk_solver_descr.o \
 amg_c_invt_solver_bld.o \
 amg_c_invt_solver_check.o \
 amg_c_invt_solver_clone.o \
+amg_c_invt_solver_clone_settings.o \
 amg_c_invt_solver_cseti.o \
 amg_c_invt_solver_csetr.o \
 amg_c_invt_solver_descr.o \
 amg_c_invk_solver_bld.o \
 amg_c_invk_solver_check.o \
 amg_c_invk_solver_clone.o \
+amg_c_invk_solver_clone_settings.o \
 amg_c_invk_solver_cseti.o \
 amg_c_invk_solver_descr.o \
 amg_z_invt_solver_bld.o \
 amg_z_invt_solver_check.o \
 amg_z_invt_solver_clone.o \
+amg_z_invt_solver_clone_settings.o \
 amg_z_invt_solver_cseti.o \
 amg_z_invt_solver_csetr.o \
 amg_z_invt_solver_descr.o \
 amg_z_invk_solver_bld.o \
 amg_z_invk_solver_check.o \
 amg_z_invk_solver_clone.o \
+amg_z_invk_solver_clone_settings.o \
 amg_z_invk_solver_cseti.o \
 amg_z_invk_solver_descr.o \
 amg_z_krm_solver_impl.o 

amgprec/impl/solver/amg_c_ainv_solver_clone_settings.f90

@@ -0,0 +1,84 @@
+!
+!
+!                             AMG4PSBLAS version 1.0
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.0)
+!
+!    (C) Copyright 2008,2009,2010,2010,2012
+!
+!                        Salvatore Filippone  University of Rome Tor Vergata
+!                        Alfredo Buttari      CNRS-IRIT, Toulouse
+!                        Pasqua D'Ambra       ICAR-CNR, Naples
+!                        Daniela di Serafino  Second University of Naples
+!
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the AMG4PSBLAS group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!
+!
+subroutine amg_c_ainv_solver_clone_settings(sv,svout,info)
+
+  use psb_base_mod
+  use amg_c_ainv_solver, amg_protect_name => amg_c_ainv_solver_clone_settings
+
+  Implicit None
+
+  ! Arguments
+  class(amg_c_ainv_solver_type), intent(inout)              :: sv
+  class(amg_c_base_solver_type), allocatable, intent(inout) :: svout
+  integer(psb_ipk_), intent(out)                            :: info
+  ! Local variables
+  integer(psb_ipk_) :: err_act
+
+
+  info=psb_success_
+  call psb_erractionsave(err_act)
+
+  if (allocated(svout)) then
+    call svout%free(info)
+    if (info == psb_success_) deallocate(svout, stat=info)
+  end if
+  if (info == psb_success_) &
+       & allocate(amg_c_ainv_solver_type :: svout, stat=info)
+  if (info /= 0) then
+    info = psb_err_alloc_dealloc_
+    goto 9999
+  end if
+  select type(svo => svout)
+  type is (amg_c_ainv_solver_type)
+    svo%alg      = sv%alg
+    svo%fill_in  = sv%fill_in
+    svo%thresh   = sv%thresh
+
+  class default
+    info = psb_err_internal_error_
+  end select
+
+  if (info /= 0) goto 9999
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+  return
+end subroutine amg_c_ainv_solver_clone_settings

amgprec/impl/solver/amg_c_invk_solver_clone_settings.f90

@@ -0,0 +1,83 @@
+!  
+!
+!                             AMG4PSBLAS version 1.0
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.0)
+!
+!    (C) Copyright 2008,2009,2010,2010,2012
+!
+!                        Salvatore Filippone  University of Rome Tor Vergata
+!                        Alfredo Buttari      CNRS-IRIT, Toulouse
+!                        Pasqua D'Ambra       ICAR-CNR, Naples
+!                        Daniela di Serafino  Second University of Naples
+!
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the AMG4PSBLAS group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!
+!
+subroutine amg_c_invk_solver_clone_settings(sv,svout,info)
+
+  use psb_base_mod
+  use amg_c_invk_solver, amg_protect_name => amg_c_invk_solver_clone_settings
+
+  Implicit None
+
+  ! Arguments
+  class(amg_c_invk_solver_type), intent(inout)              :: sv
+  class(amg_c_base_solver_type), allocatable, intent(inout) :: svout
+  integer(psb_ipk_), intent(out)                            :: info
+  ! Local variables
+  integer(psb_ipk_) :: err_act
+
+
+  info=psb_success_
+  call psb_erractionsave(err_act)
+
+  if (allocated(svout)) then
+    call svout%free(info)
+    if (info == psb_success_) deallocate(svout, stat=info)
+  end if
+  if (info == psb_success_) &
+       & allocate(amg_c_invk_solver_type :: svout, stat=info)
+  if (info /= 0) then
+    info = psb_err_alloc_dealloc_
+    goto 9999
+  end if
+  select type(svo => svout)
+  type is (amg_c_invk_solver_type)
+    svo%fill_in  = sv%fill_in
+    svo%inv_fill = sv%inv_fill
+
+  class default
+    info = psb_err_internal_error_
+  end select
+
+  if (info /= 0) goto 9999
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+  return
+end subroutine amg_c_invk_solver_clone_settings

amgprec/impl/solver/amg_c_invt_solver_clone_settings.f90

@@ -0,0 +1,85 @@
+!  
+!
+!                             AMG4PSBLAS version 1.0
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.0)
+!
+!    (C) Copyright 2008,2009,2010,2010,2012
+!
+!                        Salvatore Filippone  University of Rome Tor Vergata
+!                        Alfredo Buttari      CNRS-IRIT, Toulouse
+!                        Pasqua D'Ambra       ICAR-CNR, Naples
+!                        Daniela di Serafino  Second University of Naples
+!
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the AMG4PSBLAS group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!
+!
+subroutine amg_c_invt_solver_clone_settings(sv,svout,info)
+
+  use psb_base_mod
+  use amg_c_invt_solver, amg_protect_name => amg_c_invt_solver_clone_settings
+
+  Implicit None
+
+  ! Arguments
+  class(amg_c_invt_solver_type), intent(inout)              :: sv
+  class(amg_c_base_solver_type), allocatable, intent(inout) :: svout
+  integer(psb_ipk_), intent(out)                            :: info
+  ! Local variables
+  integer(psb_ipk_) :: err_act
+
+
+  info=psb_success_
+  call psb_erractionsave(err_act)
+
+  if (allocated(svout)) then
+    call svout%free(info)
+    if (info == psb_success_) deallocate(svout, stat=info)
+  end if
+  if (info == psb_success_) &
+       & allocate(amg_c_invt_solver_type :: svout, stat=info)
+  if (info /= 0) then
+    info = psb_err_alloc_dealloc_
+    goto 9999
+  end if
+  select type(svo => svout)
+  type is (amg_c_invt_solver_type)
+    svo%fill_in    = sv%fill_in
+    svo%inv_fill   = sv%inv_fill
+    svo%thresh     = sv%thresh
+    svo%inv_thresh = sv%inv_thresh
+
+  class default
+    info = psb_err_internal_error_
+  end select
+
+  if (info /= 0) goto 9999
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+  return
+end subroutine amg_c_invt_solver_clone_settings

amgprec/impl/solver/amg_d_ainv_solver_clone_settings.f90

@@ -0,0 +1,84 @@
+!
+!
+!                             AMG4PSBLAS version 1.0
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.0)
+!
+!    (C) Copyright 2008,2009,2010,2010,2012
+!
+!                        Salvatore Filippone  University of Rome Tor Vergata
+!                        Alfredo Buttari      CNRS-IRIT, Toulouse
+!                        Pasqua D'Ambra       ICAR-CNR, Naples
+!                        Daniela di Serafino  Second University of Naples
+!
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the AMG4PSBLAS group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!
+!
+subroutine amg_d_ainv_solver_clone_settings(sv,svout,info)
+
+  use psb_base_mod
+  use amg_d_ainv_solver, amg_protect_name => amg_d_ainv_solver_clone_settings
+
+  Implicit None
+
+  ! Arguments
+  class(amg_d_ainv_solver_type), intent(inout)              :: sv
+  class(amg_d_base_solver_type), allocatable, intent(inout) :: svout
+  integer(psb_ipk_), intent(out)                            :: info
+  ! Local variables
+  integer(psb_ipk_) :: err_act
+
+
+  info=psb_success_
+  call psb_erractionsave(err_act)
+
+  if (allocated(svout)) then
+    call svout%free(info)
+    if (info == psb_success_) deallocate(svout, stat=info)
+  end if
+  if (info == psb_success_) &
+       & allocate(amg_d_ainv_solver_type :: svout, stat=info)
+  if (info /= 0) then
+    info = psb_err_alloc_dealloc_
+    goto 9999
+  end if
+  select type(svo => svout)
+  type is (amg_d_ainv_solver_type)
+    svo%alg      = sv%alg
+    svo%fill_in  = sv%fill_in
+    svo%thresh   = sv%thresh
+
+  class default
+    info = psb_err_internal_error_
+  end select
+
+  if (info /= 0) goto 9999
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+  return
+end subroutine amg_d_ainv_solver_clone_settings

amgprec/impl/solver/amg_d_invk_solver_clone_settings.f90

@@ -0,0 +1,83 @@
+!  
+!
+!                             AMG4PSBLAS version 1.0
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.0)
+!
+!    (C) Copyright 2008,2009,2010,2010,2012
+!
+!                        Salvatore Filippone  University of Rome Tor Vergata
+!                        Alfredo Buttari      CNRS-IRIT, Toulouse
+!                        Pasqua D'Ambra       ICAR-CNR, Naples
+!                        Daniela di Serafino  Second University of Naples
+!
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the AMG4PSBLAS group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!
+!
+subroutine amg_d_invk_solver_clone_settings(sv,svout,info)
+
+  use psb_base_mod
+  use amg_d_invk_solver, amg_protect_name => amg_d_invk_solver_clone_settings
+
+  Implicit None
+
+  ! Arguments
+  class(amg_d_invk_solver_type), intent(inout)              :: sv
+  class(amg_d_base_solver_type), allocatable, intent(inout) :: svout
+  integer(psb_ipk_), intent(out)                            :: info
+  ! Local variables
+  integer(psb_ipk_) :: err_act
+
+
+  info=psb_success_
+  call psb_erractionsave(err_act)
+
+  if (allocated(svout)) then
+    call svout%free(info)
+    if (info == psb_success_) deallocate(svout, stat=info)
+  end if
+  if (info == psb_success_) &
+       & allocate(amg_d_invk_solver_type :: svout, stat=info)
+  if (info /= 0) then
+    info = psb_err_alloc_dealloc_
+    goto 9999
+  end if
+  select type(svo => svout)
+  type is (amg_d_invk_solver_type)
+    svo%fill_in  = sv%fill_in
+    svo%inv_fill = sv%inv_fill
+
+  class default
+    info = psb_err_internal_error_
+  end select
+
+  if (info /= 0) goto 9999
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+  return
+end subroutine amg_d_invk_solver_clone_settings

amgprec/impl/solver/amg_d_invt_solver_clone_settings.f90

@@ -0,0 +1,85 @@
+!  
+!
+!                             AMG4PSBLAS version 1.0
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.0)
+!
+!    (C) Copyright 2008,2009,2010,2010,2012
+!
+!                        Salvatore Filippone  University of Rome Tor Vergata
+!                        Alfredo Buttari      CNRS-IRIT, Toulouse
+!                        Pasqua D'Ambra       ICAR-CNR, Naples
+!                        Daniela di Serafino  Second University of Naples
+!
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the AMG4PSBLAS group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!
+!
+subroutine amg_d_invt_solver_clone_settings(sv,svout,info)
+
+  use psb_base_mod
+  use amg_d_invt_solver, amg_protect_name => amg_d_invt_solver_clone_settings
+
+  Implicit None
+
+  ! Arguments
+  class(amg_d_invt_solver_type), intent(inout)              :: sv
+  class(amg_d_base_solver_type), allocatable, intent(inout) :: svout
+  integer(psb_ipk_), intent(out)                            :: info
+  ! Local variables
+  integer(psb_ipk_) :: err_act
+
+
+  info=psb_success_
+  call psb_erractionsave(err_act)
+
+  if (allocated(svout)) then
+    call svout%free(info)
+    if (info == psb_success_) deallocate(svout, stat=info)
+  end if
+  if (info == psb_success_) &
+       & allocate(amg_d_invt_solver_type :: svout, stat=info)
+  if (info /= 0) then
+    info = psb_err_alloc_dealloc_
+    goto 9999
+  end if
+  select type(svo => svout)
+  type is (amg_d_invt_solver_type)
+    svo%fill_in    = sv%fill_in
+    svo%inv_fill   = sv%inv_fill
+    svo%thresh     = sv%thresh
+    svo%inv_thresh = sv%inv_thresh
+
+  class default
+    info = psb_err_internal_error_
+  end select
+
+  if (info /= 0) goto 9999
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+  return
+end subroutine amg_d_invt_solver_clone_settings

amgprec/impl/solver/amg_s_ainv_solver_clone_settings.f90

@@ -0,0 +1,84 @@
+!
+!
+!                             AMG4PSBLAS version 1.0
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.0)
+!
+!    (C) Copyright 2008,2009,2010,2010,2012
+!
+!                        Salvatore Filippone  University of Rome Tor Vergata
+!                        Alfredo Buttari      CNRS-IRIT, Toulouse
+!                        Pasqua D'Ambra       ICAR-CNR, Naples
+!                        Daniela di Serafino  Second University of Naples
+!
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the AMG4PSBLAS group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!
+!
+subroutine amg_s_ainv_solver_clone_settings(sv,svout,info)
+
+  use psb_base_mod
+  use amg_s_ainv_solver, amg_protect_name => amg_s_ainv_solver_clone_settings
+
+  Implicit None
+
+  ! Arguments
+  class(amg_s_ainv_solver_type), intent(inout)              :: sv
+  class(amg_s_base_solver_type), allocatable, intent(inout) :: svout
+  integer(psb_ipk_), intent(out)                            :: info
+  ! Local variables
+  integer(psb_ipk_) :: err_act
+
+
+  info=psb_success_
+  call psb_erractionsave(err_act)
+
+  if (allocated(svout)) then
+    call svout%free(info)
+    if (info == psb_success_) deallocate(svout, stat=info)
+  end if
+  if (info == psb_success_) &
+       & allocate(amg_s_ainv_solver_type :: svout, stat=info)
+  if (info /= 0) then
+    info = psb_err_alloc_dealloc_
+    goto 9999
+  end if
+  select type(svo => svout)
+  type is (amg_s_ainv_solver_type)
+    svo%alg      = sv%alg
+    svo%fill_in  = sv%fill_in
+    svo%thresh   = sv%thresh
+
+  class default
+    info = psb_err_internal_error_
+  end select
+
+  if (info /= 0) goto 9999
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+  return
+end subroutine amg_s_ainv_solver_clone_settings

amgprec/impl/solver/amg_s_invk_solver_clone_settings.f90

@@ -0,0 +1,83 @@
+!  
+!
+!                             AMG4PSBLAS version 1.0
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.0)
+!
+!    (C) Copyright 2008,2009,2010,2010,2012
+!
+!                        Salvatore Filippone  University of Rome Tor Vergata
+!                        Alfredo Buttari      CNRS-IRIT, Toulouse
+!                        Pasqua D'Ambra       ICAR-CNR, Naples
+!                        Daniela di Serafino  Second University of Naples
+!
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the AMG4PSBLAS group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!
+!
+subroutine amg_s_invk_solver_clone_settings(sv,svout,info)
+
+  use psb_base_mod
+  use amg_s_invk_solver, amg_protect_name => amg_s_invk_solver_clone_settings
+
+  Implicit None
+
+  ! Arguments
+  class(amg_s_invk_solver_type), intent(inout)              :: sv
+  class(amg_s_base_solver_type), allocatable, intent(inout) :: svout
+  integer(psb_ipk_), intent(out)                            :: info
+  ! Local variables
+  integer(psb_ipk_) :: err_act
+
+
+  info=psb_success_
+  call psb_erractionsave(err_act)
+
+  if (allocated(svout)) then
+    call svout%free(info)
+    if (info == psb_success_) deallocate(svout, stat=info)
+  end if
+  if (info == psb_success_) &
+       & allocate(amg_s_invk_solver_type :: svout, stat=info)
+  if (info /= 0) then
+    info = psb_err_alloc_dealloc_
+    goto 9999
+  end if
+  select type(svo => svout)
+  type is (amg_s_invk_solver_type)
+    svo%fill_in  = sv%fill_in
+    svo%inv_fill = sv%inv_fill
+
+  class default
+    info = psb_err_internal_error_
+  end select
+
+  if (info /= 0) goto 9999
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+  return
+end subroutine amg_s_invk_solver_clone_settings

amgprec/impl/solver/amg_s_invt_solver_clone_settings.f90

@@ -0,0 +1,85 @@
+!  
+!
+!                             AMG4PSBLAS version 1.0
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.0)
+!
+!    (C) Copyright 2008,2009,2010,2010,2012
+!
+!                        Salvatore Filippone  University of Rome Tor Vergata
+!                        Alfredo Buttari      CNRS-IRIT, Toulouse
+!                        Pasqua D'Ambra       ICAR-CNR, Naples
+!                        Daniela di Serafino  Second University of Naples
+!
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the AMG4PSBLAS group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!
+!
+subroutine amg_s_invt_solver_clone_settings(sv,svout,info)
+
+  use psb_base_mod
+  use amg_s_invt_solver, amg_protect_name => amg_s_invt_solver_clone_settings
+
+  Implicit None
+
+  ! Arguments
+  class(amg_s_invt_solver_type), intent(inout)              :: sv
+  class(amg_s_base_solver_type), allocatable, intent(inout) :: svout
+  integer(psb_ipk_), intent(out)                            :: info
+  ! Local variables
+  integer(psb_ipk_) :: err_act
+
+
+  info=psb_success_
+  call psb_erractionsave(err_act)
+
+  if (allocated(svout)) then
+    call svout%free(info)
+    if (info == psb_success_) deallocate(svout, stat=info)
+  end if
+  if (info == psb_success_) &
+       & allocate(amg_s_invt_solver_type :: svout, stat=info)
+  if (info /= 0) then
+    info = psb_err_alloc_dealloc_
+    goto 9999
+  end if
+  select type(svo => svout)
+  type is (amg_s_invt_solver_type)
+    svo%fill_in    = sv%fill_in
+    svo%inv_fill   = sv%inv_fill
+    svo%thresh     = sv%thresh
+    svo%inv_thresh = sv%inv_thresh
+
+  class default
+    info = psb_err_internal_error_
+  end select
+
+  if (info /= 0) goto 9999
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+  return
+end subroutine amg_s_invt_solver_clone_settings

amgprec/impl/solver/amg_z_ainv_solver_clone_settings.f90

@@ -0,0 +1,84 @@
+!
+!
+!                             AMG4PSBLAS version 1.0
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.0)
+!
+!    (C) Copyright 2008,2009,2010,2010,2012
+!
+!                        Salvatore Filippone  University of Rome Tor Vergata
+!                        Alfredo Buttari      CNRS-IRIT, Toulouse
+!                        Pasqua D'Ambra       ICAR-CNR, Naples
+!                        Daniela di Serafino  Second University of Naples
+!
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the AMG4PSBLAS group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!
+!
+subroutine amg_z_ainv_solver_clone_settings(sv,svout,info)
+
+  use psb_base_mod
+  use amg_z_ainv_solver, amg_protect_name => amg_z_ainv_solver_clone_settings
+
+  Implicit None
+
+  ! Arguments
+  class(amg_z_ainv_solver_type), intent(inout)              :: sv
+  class(amg_z_base_solver_type), allocatable, intent(inout) :: svout
+  integer(psb_ipk_), intent(out)                            :: info
+  ! Local variables
+  integer(psb_ipk_) :: err_act
+
+
+  info=psb_success_
+  call psb_erractionsave(err_act)
+
+  if (allocated(svout)) then
+    call svout%free(info)
+    if (info == psb_success_) deallocate(svout, stat=info)
+  end if
+  if (info == psb_success_) &
+       & allocate(amg_z_ainv_solver_type :: svout, stat=info)
+  if (info /= 0) then
+    info = psb_err_alloc_dealloc_
+    goto 9999
+  end if
+  select type(svo => svout)
+  type is (amg_z_ainv_solver_type)
+    svo%alg      = sv%alg
+    svo%fill_in  = sv%fill_in
+    svo%thresh   = sv%thresh
+
+  class default
+    info = psb_err_internal_error_
+  end select
+
+  if (info /= 0) goto 9999
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+  return
+end subroutine amg_z_ainv_solver_clone_settings

amgprec/impl/solver/amg_z_invk_solver_clone_settings.f90

@@ -0,0 +1,83 @@
+!  
+!
+!                             AMG4PSBLAS version 1.0
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.0)
+!
+!    (C) Copyright 2008,2009,2010,2010,2012
+!
+!                        Salvatore Filippone  University of Rome Tor Vergata
+!                        Alfredo Buttari      CNRS-IRIT, Toulouse
+!                        Pasqua D'Ambra       ICAR-CNR, Naples
+!                        Daniela di Serafino  Second University of Naples
+!
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the AMG4PSBLAS group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!
+!
+subroutine amg_z_invk_solver_clone_settings(sv,svout,info)
+
+  use psb_base_mod
+  use amg_z_invk_solver, amg_protect_name => amg_z_invk_solver_clone_settings
+
+  Implicit None
+
+  ! Arguments
+  class(amg_z_invk_solver_type), intent(inout)              :: sv
+  class(amg_z_base_solver_type), allocatable, intent(inout) :: svout
+  integer(psb_ipk_), intent(out)                            :: info
+  ! Local variables
+  integer(psb_ipk_) :: err_act
+
+
+  info=psb_success_
+  call psb_erractionsave(err_act)
+
+  if (allocated(svout)) then
+    call svout%free(info)
+    if (info == psb_success_) deallocate(svout, stat=info)
+  end if
+  if (info == psb_success_) &
+       & allocate(amg_z_invk_solver_type :: svout, stat=info)
+  if (info /= 0) then
+    info = psb_err_alloc_dealloc_
+    goto 9999
+  end if
+  select type(svo => svout)
+  type is (amg_z_invk_solver_type)
+    svo%fill_in  = sv%fill_in
+    svo%inv_fill = sv%inv_fill
+
+  class default
+    info = psb_err_internal_error_
+  end select
+
+  if (info /= 0) goto 9999
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+  return
+end subroutine amg_z_invk_solver_clone_settings

amgprec/impl/solver/amg_z_invt_solver_clone_settings.f90

@@ -0,0 +1,85 @@
+!  
+!
+!                             AMG4PSBLAS version 1.0
+!    MultiLevel Domain Decomposition Parallel Preconditioners Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.0)
+!
+!    (C) Copyright 2008,2009,2010,2010,2012
+!
+!                        Salvatore Filippone  University of Rome Tor Vergata
+!                        Alfredo Buttari      CNRS-IRIT, Toulouse
+!                        Pasqua D'Ambra       ICAR-CNR, Naples
+!                        Daniela di Serafino  Second University of Naples
+!
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the AMG4PSBLAS group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!
+!
+subroutine amg_z_invt_solver_clone_settings(sv,svout,info)
+
+  use psb_base_mod
+  use amg_z_invt_solver, amg_protect_name => amg_z_invt_solver_clone_settings
+
+  Implicit None
+
+  ! Arguments
+  class(amg_z_invt_solver_type), intent(inout)              :: sv
+  class(amg_z_base_solver_type), allocatable, intent(inout) :: svout
+  integer(psb_ipk_), intent(out)                            :: info
+  ! Local variables
+  integer(psb_ipk_) :: err_act
+
+
+  info=psb_success_
+  call psb_erractionsave(err_act)
+
+  if (allocated(svout)) then
+    call svout%free(info)
+    if (info == psb_success_) deallocate(svout, stat=info)
+  end if
+  if (info == psb_success_) &
+       & allocate(amg_z_invt_solver_type :: svout, stat=info)
+  if (info /= 0) then
+    info = psb_err_alloc_dealloc_
+    goto 9999
+  end if
+  select type(svo => svout)
+  type is (amg_z_invt_solver_type)
+    svo%fill_in    = sv%fill_in
+    svo%inv_fill   = sv%inv_fill
+    svo%thresh     = sv%thresh
+    svo%inv_thresh = sv%inv_thresh
+
+  class default
+    info = psb_err_internal_error_
+  end select
+
+  if (info /= 0) goto 9999
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+  return
+end subroutine amg_z_invt_solver_clone_settings

config/pac.m4

@@ -608,8 +608,12 @@ dnl Maybe new structure with UMFPACK UFconfig AMD?
 fi
 
 
-if test "x$pac_umf_header_ok" == "xyes" ; then 
-      UMF_LIBS="$amg4psblas_cv_umfpack $UMF_LIBDIR"
+if test "x$pac_umf_header_ok" == "xyes" ; then
+      if  test "x$UMF_LIBDIR" == "x" ; then
+	  UMF_LIBS="$amg4psblas_cv_umfpack"
+      else
+          UMF_LIBS="$UMF_LIBDIR $amg4psblas_cv_umfpack"
+      fi
       LIBS="$UMF_LIBS -lm $LIBS $EXTRA_LIBS";
       AC_MSG_CHECKING([for umfpack_di_symbolic in $UMF_LIBS])
       AC_TRY_LINK_FUNC(umfpack_di_symbolic, 
@@ -619,8 +623,8 @@ if test "x$pac_umf_header_ok" == "xyes" ; then
      if test "x$pac_umf_lib_ok" == "xno" ; then 
         dnl Maybe Lib or lib? 
         UMF_LIBDIR="-L$amg4psblas_cv_umfpackdir/Lib -L$amg4psblas_cv_umfpackdir/lib"
-        UMF_LIBS="$amg4psblas_cv_umfpack $UMF_LIBDIR -lm $SAVE_LIBS  $EXTRA_LIBS"
-        LIBS="$UMF_LIBS"
+        UMF_LIBS="$amg4psblas_cv_umfpack $UMF_LIBDIR -lm"
+        LIBS="$UMF_LIBS $SAVE_LIBS  $EXTRA_LIBS "
         
       AC_MSG_CHECKING([for umfpack_di_symbolic in $UMF_LIBS])
       AC_TRY_LINK_FUNC(umfpack_di_symbolic, 
@@ -631,8 +635,8 @@ if test "x$pac_umf_header_ok" == "xyes" ; then
      if test "x$pac_umf_lib_ok" == "xno" ; then 
         dnl Maybe UMFPACK/Lib? 
         UMF_LIBDIR="-L$amg4psblas_cv_umfpackdir/AMD/Lib -L$amg4psblas_cv_umfpackdir/UMFPACK/Lib"
-        UMF_LIBS="$amg4psblas_cv_umfpack $UMF_LIBDIR -lm $SAVE_LIBS $EXTRA_LIBS"
-             LIBS="$UMF_LIBS"
+        UMF_LIBS="$amg4psblas_cv_umfpack $UMF_LIBDIR -lm"
+        LIBS="$UMF_LIBS $SAVE_LIBS $EXTRA_LIBS"
       AC_MSG_CHECKING([for umfpack_di_symbolic in $UMF_LIBS])
       AC_TRY_LINK_FUNC(umfpack_di_symbolic, 
        [amg4psblas_cv_have_umfpack=yes;pac_umf_lib_ok=yes; ],
@@ -716,7 +720,11 @@ dnl Maybe Include subdirs?
 fi
 
 if test "x$pac_slu_header_ok" == "xyes" ; then 
- SLU_LIBS="$amg4psblas_cv_superlu $SLU_LIBS"
+   if  test "x$SLU_LIBS" == "x" ; then
+       SLU_LIBS="$amg4psblas_cv_superlu"
+   else
+     SLU_LIBS="$SLU_LIBS $amg4psblas_cv_superlu"
+   fi  
  LIBS="$SLU_LIBS -lm $save_LIBS";
  AC_MSG_CHECKING([for superlu_malloc in $SLU_LIBS])
  AC_TRY_LINK_FUNC(superlu_malloc, 
@@ -813,7 +821,7 @@ elif test "x$amg4psblas_cv_superludistdir" != "x"; then
    SLUDIST_LIBS="-L$amg4psblas_cv_superludistdir"
 fi
 
-LIBS="$SLUDIST_LIBS $save_LIBS"
+LIBS="$save_LIBS $SLUDIST_LIBS"
 CPPFLAGS="$SLUDIST_INCLUDES $save_CPPFLAGS"
 
 AC_CHECK_HEADERS([superlu_ddefs.h],
@@ -841,7 +849,11 @@ dnl Maybe Include subdirs?
 fi
 
 if test "x$pac_sludist_header_ok" == "xyes" ; then 
-      SLUDIST_LIBS="$amg4psblas_cv_superludist $SLUDIST_LIBS"
+      if  test "x$SLUDIST_LIBS" == "x" ; then
+         SLUDIST_LIBS="$amg4psblas_cv_superludist"
+      else
+         SLUDIST_LIBS="$SLUDIST_LIBS $amg4psblas_cv_superludist"
+      fi  
       LIBS="$SLUDIST_LIBS -lm $save_LIBS";
       AC_MSG_CHECKING([for superlu_malloc_dist in $SLUDIST_LIBS])
       AC_TRY_LINK_FUNC(superlu_malloc_dist, 
@@ -1150,7 +1162,11 @@ if test "x$pac_mumps_fmods_ok" == "xno" ; then
 fi   
 
 if test "x$pac_mumps_fmods_ok" == "xyes" || test "x$pac_mumps_fincs_ok" == "xyes" ; then  
-    MUMPS_LIBS="$amg4psblas_cv_mumps $MUMPS_LIBS"
+    if  test "x$MUMPS_LIBS" == "x" ; then
+        MUMPS_LIBS="$amg4psblas_cv_mumps"
+    else
+      MUMPS_LIBS="$MUMPS_LIBS $amg4psblas_cv_mumps"
+    fi  
     LIBS="$MUMPS_LIBS  $save_LIBS  $EXTRA_LIBS";
     AC_MSG_CHECKING([for dmumps in $MUMPS_LIBS])
 			AC_TRY_LINK_FUNC(dmumps, 

configure.ac

@@ -98,6 +98,7 @@ AC_PREREQ(2.59)
 #
 #
 AC_PROG_INSTALL
+INSTALL="${INSTALL} -p"
 
 AC_MSG_CHECKING([where to install])
 case $prefix in  

exec.sh

@@ -1,25 +0,0 @@
-cd amgprec/impl/aggregator/
-rm MatchBoxPC.o 
-rm sendBundledMessages.o 
-rm initialize.o 
-rm extractUChunk.o 
-rm isAlreadyMatched.o 
-rm findOwnerOfGhost.o 
-rm computeCandidateMate.o 
-rm parallelComputeCandidateMateB.o 
-rm processMatchedVertices.o 
-rm processCrossEdge.o 
-rm queueTransfer.o 
-rm processMessages.o 
-rm processExposedVertex.o 
-rm algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC.o 
-rm algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP.o
-cd ../../../
-make all
-cd samples/advanced/pdegen
-make amg_d_pde3d
-cd runs
-mpirun -np 4 amg_d_pde3d amg_pde3d.inp
-
-
-

install-sh

@@ -1,251 +1,541 @@
 #!/bin/sh
-#
 # install - install a program, script, or datafile
-# This comes from X11R5 (mit/util/scripts/install.sh).
+
+scriptversion=2020-11-14.01; # UTC
+
+# This originates from X11R5 (mit/util/scripts/install.sh), which was
+# later released in X11R6 (xc/config/util/install.sh) with the
+# following copyright and license.
 #
-# Copyright 1991 by the Massachusetts Institute of Technology
+# Copyright (C) 1994 X Consortium
 #
-# Permission to use, copy, modify, distribute, and sell this software and its
-# documentation for any purpose is hereby granted without fee, provided that
-# the above copyright notice appear in all copies and that both that
-# copyright notice and this permission notice appear in supporting
-# documentation, and that the name of M.I.T. not be used in advertising or
-# publicity pertaining to distribution of the software without specific,
-# written prior permission.  M.I.T. makes no representations about the
-# suitability of this software for any purpose.  It is provided "as is"
-# without express or implied warranty.
+# Permission is hereby granted, free of charge, to any person obtaining a copy
+# of this software and associated documentation files (the "Software"), to
+# deal in the Software without restriction, including without limitation the
+# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
+# sell copies of the Software, and to permit persons to whom the Software is
+# furnished to do so, subject to the following conditions:
+#
+# The above copyright notice and this permission notice shall be included in
+# all copies or substantial portions of the Software.
+#
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL THE
+# X CONSORTIUM BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN
+# AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNEC-
+# TION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+#
+# Except as contained in this notice, the name of the X Consortium shall not
+# be used in advertising or otherwise to promote the sale, use or other deal-
+# ings in this Software without prior written authorization from the X Consor-
+# tium.
+#
+#
+# FSF changes to this file are in the public domain.
 #
 # Calling this script install-sh is preferred over install.sh, to prevent
-# `make' implicit rules from creating a file called install from it
+# 'make' implicit rules from creating a file called install from it
 # when there is no Makefile.
 #
 # This script is compatible with the BSD install script, but was written
-# from scratch.  It can only install one file at a time, a restriction
-# shared with many OS's install programs.
+# from scratch.
 
-
-# set DOITPROG to echo to test this script
-
-# Don't use :- since 4.3BSD and earlier shells don't like it.
-doit="${DOITPROG-}"
-
-
-# put in absolute paths if you don't have them in your path; or use env. vars.
-
-mvprog="${MVPROG-mv}"
-cpprog="${CPPROG-cp}"
-chmodprog="${CHMODPROG-chmod}"
-chownprog="${CHOWNPROG-chown}"
-chgrpprog="${CHGRPPROG-chgrp}"
-stripprog="${STRIPPROG-strip}"
-rmprog="${RMPROG-rm}"
-mkdirprog="${MKDIRPROG-mkdir}"
-
-transformbasename=""
-transform_arg=""
-instcmd="$mvprog"
-chmodcmd="$chmodprog 0755"
-chowncmd=""
-chgrpcmd=""
-stripcmd=""
-rmcmd="$rmprog -f"
-mvcmd="$mvprog"
-src=""
-dst=""
-dir_arg=""
-
-while [ x"$1" != x ]; do
-    case $1 in
-	-c) instcmd="$cpprog"
-	    shift
-	    continue;;
-
-	-d) dir_arg=true
-	    shift
-	    continue;;
-
-	-m) chmodcmd="$chmodprog $2"
-	    shift
-	    shift
-	    continue;;
-
-	-o) chowncmd="$chownprog $2"
-	    shift
-	    shift
-	    continue;;
-
-	-g) chgrpcmd="$chgrpprog $2"
-	    shift
-	    shift
-	    continue;;
-
-	-s) stripcmd="$stripprog"
-	    shift
-	    continue;;
-
-	-t=*) transformarg=`echo $1 | sed 's/-t=//'`
-	    shift
-	    continue;;
-
-	-b=*) transformbasename=`echo $1 | sed 's/-b=//'`
-	    shift
-	    continue;;
-
-	*)  if [ x"$src" = x ]
-	    then
-		src=$1
-	    else
-		# this colon is to work around a 386BSD /bin/sh bug
-		:
-		dst=$1
-	    fi
-	    shift
-	    continue;;
-    esac
-done
-
-if [ x"$src" = x ]
-then
-	echo "install:	no input file specified"
-	exit 1
-else
-	true
-fi
-
-if [ x"$dir_arg" != x ]; then
-	dst=$src
-	src=""
-	
-	if [ -d $dst ]; then
-		instcmd=:
-		chmodcmd=""
-	else
-		instcmd=mkdir
-	fi
-else
-
-# Waiting for this to be detected by the "$instcmd $src $dsttmp" command
-# might cause directories to be created, which would be especially bad 
-# if $src (and thus $dsttmp) contains '*'.
-
-	if [ -f $src -o -d $src ]
-	then
-		true
-	else
-		echo "install:  $src does not exist"
-		exit 1
-	fi
-	
-	if [ x"$dst" = x ]
-	then
-		echo "install:	no destination specified"
-		exit 1
-	else
-		true
-	fi
-
-# If destination is a directory, append the input filename; if your system
-# does not like double slashes in filenames, you may need to add some logic
-
-	if [ -d $dst ]
-	then
-		dst="$dst"/`basename $src`
-	else
-		true
-	fi
-fi
-
-## this sed command emulates the dirname command
-dstdir=`echo $dst | sed -e 's,[^/]*$,,;s,/$,,;s,^$,.,'`
-
-# Make sure that the destination directory exists.
-#  this part is taken from Noah Friedman's mkinstalldirs script
-
-# Skip lots of stat calls in the usual case.
-if [ ! -d "$dstdir" ]; then
-defaultIFS='	
+tab='	'
+nl='
 '
-IFS="${IFS-${defaultIFS}}"
+IFS=" $tab$nl"
 
-oIFS="${IFS}"
-# Some sh's can't handle IFS=/ for some reason.
-IFS='%'
-set - `echo ${dstdir} | sed -e 's@/@%@g' -e 's@^%@/@'`
-IFS="${oIFS}"
+# Set DOITPROG to "echo" to test this script.
 
-pathcomp=''
+doit=${DOITPROG-}
+doit_exec=${doit:-exec}
 
-while [ $# -ne 0 ] ; do
-	pathcomp="${pathcomp}${1}"
-	shift
+# Put in absolute file names if you don't have them in your path;
+# or use environment vars.
 
-	if [ ! -d "${pathcomp}" ] ;
-        then
-		$mkdirprog "${pathcomp}"
-	else
-		true
-	fi
+chgrpprog=${CHGRPPROG-chgrp}
+chmodprog=${CHMODPROG-chmod}
+chownprog=${CHOWNPROG-chown}
+cmpprog=${CMPPROG-cmp}
+cpprog=${CPPROG-cp}
+mkdirprog=${MKDIRPROG-mkdir}
+mvprog=${MVPROG-mv}
+rmprog=${RMPROG-rm}
+stripprog=${STRIPPROG-strip}
 
-	pathcomp="${pathcomp}/"
+posix_mkdir=
+
+# Desired mode of installed file.
+mode=0755
+
+# Create dirs (including intermediate dirs) using mode 755.
+# This is like GNU 'install' as of coreutils 8.32 (2020).
+mkdir_umask=22
+
+backupsuffix=
+chgrpcmd=
+chmodcmd=$chmodprog
+chowncmd=
+mvcmd=$mvprog
+rmcmd="$rmprog -f"
+stripcmd=
+
+src=
+dst=
+dir_arg=
+dst_arg=
+
+copy_on_change=false
+is_target_a_directory=possibly
+
+usage="\
+Usage: $0 [OPTION]... [-T] SRCFILE DSTFILE
+   or: $0 [OPTION]... SRCFILES... DIRECTORY
+   or: $0 [OPTION]... -t DIRECTORY SRCFILES...
+   or: $0 [OPTION]... -d DIRECTORIES...
+
+In the 1st form, copy SRCFILE to DSTFILE.
+In the 2nd and 3rd, copy all SRCFILES to DIRECTORY.
+In the 4th, create DIRECTORIES.
+
+Options:
+     --help     display this help and exit.
+     --version  display version info and exit.
+
+  -c            (ignored)
+  -C            install only if different (preserve data modification time)
+  -d            create directories instead of installing files.
+  -g GROUP      $chgrpprog installed files to GROUP.
+  -m MODE       $chmodprog installed files to MODE.
+  -o USER       $chownprog installed files to USER.
+  -p            pass -p to $cpprog.
+  -s            $stripprog installed files.
+  -S SUFFIX     attempt to back up existing files, with suffix SUFFIX.
+  -t DIRECTORY  install into DIRECTORY.
+  -T            report an error if DSTFILE is a directory.
+
+Environment variables override the default commands:
+  CHGRPPROG CHMODPROG CHOWNPROG CMPPROG CPPROG MKDIRPROG MVPROG
+  RMPROG STRIPPROG
+
+By default, rm is invoked with -f; when overridden with RMPROG,
+it's up to you to specify -f if you want it.
+
+If -S is not specified, no backups are attempted.
+
+Email bug reports to bug-automake@gnu.org.
+Automake home page: https://www.gnu.org/software/automake/
+"
+
+while test $# -ne 0; do
+  case $1 in
+    -c) ;;
+
+    -C) copy_on_change=true;;
+
+    -d) dir_arg=true;;
+
+    -g) chgrpcmd="$chgrpprog $2"
+        shift;;
+
+    --help) echo "$usage"; exit $?;;
+
+    -m) mode=$2
+        case $mode in
+          *' '* | *"$tab"* | *"$nl"* | *'*'* | *'?'* | *'['*)
+            echo "$0: invalid mode: $mode" >&2
+            exit 1;;
+        esac
+        shift;;
+
+    -o) chowncmd="$chownprog $2"
+        shift;;
+
+    -p) cpprog="$cpprog -p";;
+
+    -s) stripcmd=$stripprog;;
+
+    -S) backupsuffix="$2"
+        shift;;
+
+    -t)
+        is_target_a_directory=always
+        dst_arg=$2
+        # Protect names problematic for 'test' and other utilities.
+        case $dst_arg in
+          -* | [=\(\)!]) dst_arg=./$dst_arg;;
+        esac
+        shift;;
+
+    -T) is_target_a_directory=never;;
+
+    --version) echo "$0 $scriptversion"; exit $?;;
+
+    --) shift
+        break;;
+
+    -*) echo "$0: invalid option: $1" >&2
+        exit 1;;
+
+    *)  break;;
+  esac
+  shift
 done
+
+# We allow the use of options -d and -T together, by making -d
+# take the precedence; this is for compatibility with GNU install.
+
+if test -n "$dir_arg"; then
+  if test -n "$dst_arg"; then
+    echo "$0: target directory not allowed when installing a directory." >&2
+    exit 1
+  fi
 fi
 
-if [ x"$dir_arg" != x ]
-then
-	$doit $instcmd $dst &&
+if test $# -ne 0 && test -z "$dir_arg$dst_arg"; then
+  # When -d is used, all remaining arguments are directories to create.
+  # When -t is used, the destination is already specified.
+  # Otherwise, the last argument is the destination.  Remove it from $@.
+  for arg
+  do
+    if test -n "$dst_arg"; then
+      # $@ is not empty: it contains at least $arg.
+      set fnord "$@" "$dst_arg"
+      shift # fnord
+    fi
+    shift # arg
+    dst_arg=$arg
+    # Protect names problematic for 'test' and other utilities.
+    case $dst_arg in
+      -* | [=\(\)!]) dst_arg=./$dst_arg;;
+    esac
+  done
+fi
 
-	if [ x"$chowncmd" != x ]; then $doit $chowncmd $dst; else true ; fi &&
-	if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dst; else true ; fi &&
-	if [ x"$stripcmd" != x ]; then $doit $stripcmd $dst; else true ; fi &&
-	if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dst; else true ; fi
-else
+if test $# -eq 0; then
+  if test -z "$dir_arg"; then
+    echo "$0: no input file specified." >&2
+    exit 1
+  fi
+  # It's OK to call 'install-sh -d' without argument.
+  # This can happen when creating conditional directories.
+  exit 0
+fi
 
-# If we're going to rename the final executable, determine the name now.
+if test -z "$dir_arg"; then
+  if test $# -gt 1 || test "$is_target_a_directory" = always; then
+    if test ! -d "$dst_arg"; then
+      echo "$0: $dst_arg: Is not a directory." >&2
+      exit 1
+    fi
+  fi
+fi
 
-	if [ x"$transformarg" = x ] 
+if test -z "$dir_arg"; then
+  do_exit='(exit $ret); exit $ret'
+  trap "ret=129; $do_exit" 1
+  trap "ret=130; $do_exit" 2
+  trap "ret=141; $do_exit" 13
+  trap "ret=143; $do_exit" 15
+
+  # Set umask so as not to create temps with too-generous modes.
+  # However, 'strip' requires both read and write access to temps.
+  case $mode in
+    # Optimize common cases.
+    *644) cp_umask=133;;
+    *755) cp_umask=22;;
+
+    *[0-7])
+      if test -z "$stripcmd"; then
+        u_plus_rw=
+      else
+        u_plus_rw='% 200'
+      fi
+      cp_umask=`expr '(' 777 - $mode % 1000 ')' $u_plus_rw`;;
+    *)
+      if test -z "$stripcmd"; then
+        u_plus_rw=
+      else
+        u_plus_rw=,u+rw
+      fi
+      cp_umask=$mode$u_plus_rw;;
+  esac
+fi
+
+for src
+do
+  # Protect names problematic for 'test' and other utilities.
+  case $src in
+    -* | [=\(\)!]) src=./$src;;
+  esac
+
+  if test -n "$dir_arg"; then
+    dst=$src
+    dstdir=$dst
+    test -d "$dstdir"
+    dstdir_status=$?
+    # Don't chown directories that already exist.
+    if test $dstdir_status = 0; then
+      chowncmd=""
+    fi
+  else
+
+    # Waiting for this to be detected by the "$cpprog $src $dsttmp" command
+    # might cause directories to be created, which would be especially bad
+    # if $src (and thus $dsttmp) contains '*'.
+    if test ! -f "$src" && test ! -d "$src"; then
+      echo "$0: $src does not exist." >&2
+      exit 1
+    fi
+
+    if test -z "$dst_arg"; then
+      echo "$0: no destination specified." >&2
+      exit 1
+    fi
+    dst=$dst_arg
+
+    # If destination is a directory, append the input filename.
+    if test -d "$dst"; then
+      if test "$is_target_a_directory" = never; then
+        echo "$0: $dst_arg: Is a directory" >&2
+        exit 1
+      fi
+      dstdir=$dst
+      dstbase=`basename "$src"`
+      case $dst in
+	*/) dst=$dst$dstbase;;
+	*)  dst=$dst/$dstbase;;
+      esac
+      dstdir_status=0
+    else
+      dstdir=`dirname "$dst"`
+      test -d "$dstdir"
+      dstdir_status=$?
+    fi
+  fi
+
+  case $dstdir in
+    */) dstdirslash=$dstdir;;
+    *)  dstdirslash=$dstdir/;;
+  esac
+
+  obsolete_mkdir_used=false
+
+  if test $dstdir_status != 0; then
+    case $posix_mkdir in
+      '')
+        # With -d, create the new directory with the user-specified mode.
+        # Otherwise, rely on $mkdir_umask.
+        if test -n "$dir_arg"; then
+          mkdir_mode=-m$mode
+        else
+          mkdir_mode=
+        fi
+
+        posix_mkdir=false
+	# The $RANDOM variable is not portable (e.g., dash).  Use it
+	# here however when possible just to lower collision chance.
+	tmpdir=${TMPDIR-/tmp}/ins$RANDOM-$$
+
+	trap '
+	  ret=$?
+	  rmdir "$tmpdir/a/b" "$tmpdir/a" "$tmpdir" 2>/dev/null
+	  exit $ret
+	' 0
+
+	# Because "mkdir -p" follows existing symlinks and we likely work
+	# directly in world-writeable /tmp, make sure that the '$tmpdir'
+	# directory is successfully created first before we actually test
+	# 'mkdir -p'.
+	if (umask $mkdir_umask &&
+	    $mkdirprog $mkdir_mode "$tmpdir" &&
+	    exec $mkdirprog $mkdir_mode -p -- "$tmpdir/a/b") >/dev/null 2>&1
 	then
-		dstfile=`basename $dst`
+	  if test -z "$dir_arg" || {
+	       # Check for POSIX incompatibilities with -m.
+	       # HP-UX 11.23 and IRIX 6.5 mkdir -m -p sets group- or
+	       # other-writable bit of parent directory when it shouldn't.
+	       # FreeBSD 6.1 mkdir -m -p sets mode of existing directory.
+	       test_tmpdir="$tmpdir/a"
+	       ls_ld_tmpdir=`ls -ld "$test_tmpdir"`
+	       case $ls_ld_tmpdir in
+		 d????-?r-*) different_mode=700;;
+		 d????-?--*) different_mode=755;;
+		 *) false;;
+	       esac &&
+	       $mkdirprog -m$different_mode -p -- "$test_tmpdir" && {
+		 ls_ld_tmpdir_1=`ls -ld "$test_tmpdir"`
+		 test "$ls_ld_tmpdir" = "$ls_ld_tmpdir_1"
+	       }
+	     }
+	  then posix_mkdir=:
+	  fi
+	  rmdir "$tmpdir/a/b" "$tmpdir/a" "$tmpdir"
 	else
-		dstfile=`basename $dst $transformbasename | 
-			sed $transformarg`$transformbasename
+	  # Remove any dirs left behind by ancient mkdir implementations.
+	  rmdir ./$mkdir_mode ./-p ./-- "$tmpdir" 2>/dev/null
 	fi
+	trap '' 0;;
+    esac
 
-# don't allow the sed command to completely eliminate the filename
+    if
+      $posix_mkdir && (
+        umask $mkdir_umask &&
+        $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir"
+      )
+    then :
+    else
 
-	if [ x"$dstfile" = x ] 
-	then
-		dstfile=`basename $dst`
-	else
-		true
-	fi
+      # mkdir does not conform to POSIX,
+      # or it failed possibly due to a race condition.  Create the
+      # directory the slow way, step by step, checking for races as we go.
 
-# Make a temp file name in the proper directory.
+      case $dstdir in
+        /*) prefix='/';;
+        [-=\(\)!]*) prefix='./';;
+        *)  prefix='';;
+      esac
 
-	dsttmp=$dstdir/#inst.$$#
+      oIFS=$IFS
+      IFS=/
+      set -f
+      set fnord $dstdir
+      shift
+      set +f
+      IFS=$oIFS
 
-# Move or copy the file name to the temp name
+      prefixes=
 
-	$doit $instcmd $src $dsttmp &&
+      for d
+      do
+        test X"$d" = X && continue
 
-	trap "rm -f ${dsttmp}" 0 &&
+        prefix=$prefix$d
+        if test -d "$prefix"; then
+          prefixes=
+        else
+          if $posix_mkdir; then
+            (umask $mkdir_umask &&
+             $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir") && break
+            # Don't fail if two instances are running concurrently.
+            test -d "$prefix" || exit 1
+          else
+            case $prefix in
+              *\'*) qprefix=`echo "$prefix" | sed "s/'/'\\\\\\\\''/g"`;;
+              *) qprefix=$prefix;;
+            esac
+            prefixes="$prefixes '$qprefix'"
+          fi
+        fi
+        prefix=$prefix/
+      done
 
-# and set any options; do chmod last to preserve setuid bits
+      if test -n "$prefixes"; then
+        # Don't fail if two instances are running concurrently.
+        (umask $mkdir_umask &&
+         eval "\$doit_exec \$mkdirprog $prefixes") ||
+          test -d "$dstdir" || exit 1
+        obsolete_mkdir_used=true
+      fi
+    fi
+  fi
 
-# If any of these fail, we abort the whole thing.  If we want to
-# ignore errors from any of these, just make sure not to ignore
-# errors from the above "$doit $instcmd $src $dsttmp" command.
+  if test -n "$dir_arg"; then
+    { test -z "$chowncmd" || $doit $chowncmd "$dst"; } &&
+    { test -z "$chgrpcmd" || $doit $chgrpcmd "$dst"; } &&
+    { test "$obsolete_mkdir_used$chowncmd$chgrpcmd" = false ||
+      test -z "$chmodcmd" || $doit $chmodcmd $mode "$dst"; } || exit 1
+  else
 
-	if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; else true;fi &&
-	if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; else true;fi &&
-	if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; else true;fi &&
-	if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; else true;fi &&
+    # Make a couple of temp file names in the proper directory.
+    dsttmp=${dstdirslash}_inst.$$_
+    rmtmp=${dstdirslash}_rm.$$_
 
-# Now rename the file to the real destination.
+    # Trap to clean up those temp files at exit.
+    trap 'ret=$?; rm -f "$dsttmp" "$rmtmp" && exit $ret' 0
 
-	$doit $rmcmd -f $dstdir/$dstfile &&
-	$doit $mvcmd $dsttmp $dstdir/$dstfile 
+    # Copy the file name to the temp name.
+    (umask $cp_umask &&
+     { test -z "$stripcmd" || {
+	 # Create $dsttmp read-write so that cp doesn't create it read-only,
+	 # which would cause strip to fail.
+	 if test -z "$doit"; then
+	   : >"$dsttmp" # No need to fork-exec 'touch'.
+	 else
+	   $doit touch "$dsttmp"
+	 fi
+       }
+     } &&
+     $doit_exec $cpprog "$src" "$dsttmp") &&
 
-fi &&
+    # and set any options; do chmod last to preserve setuid bits.
+    #
+    # If any of these fail, we abort the whole thing.  If we want to
+    # ignore errors from any of these, just make sure not to ignore
+    # errors from the above "$doit $cpprog $src $dsttmp" command.
+    #
+    { test -z "$chowncmd" || $doit $chowncmd "$dsttmp"; } &&
+    { test -z "$chgrpcmd" || $doit $chgrpcmd "$dsttmp"; } &&
+    { test -z "$stripcmd" || $doit $stripcmd "$dsttmp"; } &&
+    { test -z "$chmodcmd" || $doit $chmodcmd $mode "$dsttmp"; } &&
 
+    # If -C, don't bother to copy if it wouldn't change the file.
+    if $copy_on_change &&
+       old=`LC_ALL=C ls -dlL "$dst"     2>/dev/null` &&
+       new=`LC_ALL=C ls -dlL "$dsttmp"  2>/dev/null` &&
+       set -f &&
+       set X $old && old=:$2:$4:$5:$6 &&
+       set X $new && new=:$2:$4:$5:$6 &&
+       set +f &&
+       test "$old" = "$new" &&
+       $cmpprog "$dst" "$dsttmp" >/dev/null 2>&1
+    then
+      rm -f "$dsttmp"
+    else
+      # If $backupsuffix is set, and the file being installed
+      # already exists, attempt a backup.  Don't worry if it fails,
+      # e.g., if mv doesn't support -f.
+      if test -n "$backupsuffix" && test -f "$dst"; then
+        $doit $mvcmd -f "$dst" "$dst$backupsuffix" 2>/dev/null
+      fi
 
-exit 0
+      # Rename the file to the real destination.
+      $doit $mvcmd -f "$dsttmp" "$dst" 2>/dev/null ||
+
+      # The rename failed, perhaps because mv can't rename something else
+      # to itself, or perhaps because mv is so ancient that it does not
+      # support -f.
+      {
+        # Now remove or move aside any old file at destination location.
+        # We try this two ways since rm can't unlink itself on some
+        # systems and the destination file might be busy for other
+        # reasons.  In this case, the final cleanup might fail but the new
+        # file should still install successfully.
+        {
+          test ! -f "$dst" ||
+          $doit $rmcmd "$dst" 2>/dev/null ||
+          { $doit $mvcmd -f "$dst" "$rmtmp" 2>/dev/null &&
+            { $doit $rmcmd "$rmtmp" 2>/dev/null; :; }
+          } ||
+          { echo "$0: cannot unlink or rename $dst" >&2
+            (exit 1); exit 1
+          }
+        } &&
+
+        # Now rename the file to the real destination.
+        $doit $mvcmd "$dsttmp" "$dst"
+      }
+    fi || exit 1
+
+    trap '' 0
+  fi
+done
+
+# Local variables:
+# eval: (add-hook 'before-save-hook 'time-stamp)
+# time-stamp-start: "scriptversion="
+# time-stamp-format: "%:y-%02m-%02d.%02H"
+# time-stamp-time-zone: "UTC0"
+# time-stamp-end: "; # UTC"
+# End:

samples/advanced/pdegen/Makefile

@@ -3,7 +3,7 @@ AMGINCDIR=$(AMGDIR)/include
 include $(AMGINCDIR)/Make.inc.amg4psblas
 AMGMODDIR=$(AMGDIR)/modules
 AMGLIBDIR=$(AMGDIR)/lib
-AMG_LIBS=-L$(AMGLIBDIR) -lpsb_krylov -lamg_prec -lpsb_prec 
+AMG_LIBS=-L$(AMGLIBDIR) -lpsb_krylov -lamg_prec -lpsb_prec
 FINCLUDES=$(FMFLAG). $(FMFLAG)$(AMGMODDIR) $(FMFLAG)$(AMGINCDIR) $(PSBLAS_INCLUDES) $(FIFLAG).
 
 LINKOPT=

samples/advanced/pdegen/amg_d_genpde_mod.F90

@@ -93,9 +93,6 @@ contains
        & a1,a2,a3,b1,b2,b3,c,g,info,f,amold,vmold,partition, nrl,iv)
     use psb_base_mod
     use psb_util_mod
-#if defined(OPENMP)
-    use omp_lib
-#endif
     !
     !   Discretizes the partial differential equation
     !
@@ -131,6 +128,7 @@ contains
     type(psb_d_csc_sparse_mat)  :: acsc
     type(psb_d_coo_sparse_mat)  :: acoo
     type(psb_d_csr_sparse_mat)  :: acsr
+    real(psb_dpk_)           :: zt(nb),x,y,z,xph,xmh,yph,ymh,zph,zmh
     integer(psb_ipk_) :: nnz,nr,nlr,i,j,ii,ib,k, partition_
     integer(psb_lpk_) :: m,n,glob_row,nt
     integer(psb_ipk_) :: ix,iy,iz,ia,indx_owner
@@ -143,7 +141,8 @@ contains
     ! Process grid
     integer(psb_ipk_) :: np, iam
     integer(psb_ipk_) :: icoeff
-    integer(psb_lpk_), allocatable     :: myidx(:)
+    integer(psb_lpk_), allocatable     :: irow(:),icol(:),myidx(:)
+    real(psb_dpk_), allocatable :: val(:)
     ! deltah dimension of each grid cell
     ! deltat discretization time
     real(psb_dpk_)            :: deltah, sqdeltah, deltah2
@@ -369,128 +368,119 @@ contains
     call psb_barrier(ctxt)
     talc = psb_wtime()-t0
 
+    if (info /= psb_success_) then
+      info=psb_err_from_subroutine_
+      ch_err='allocation rout.'
+      call psb_errpush(info,name,a_err=ch_err)
+      goto 9999
+    end if
+
+    ! we build an auxiliary matrix consisting of one row at a
+    ! time; just a small matrix. might be extended to generate
+    ! a bunch of rows per call.
+    !
+    allocate(val(20*nb),irow(20*nb),&
+         &icol(20*nb),stat=info)
+    if (info /= psb_success_ ) then
+      info=psb_err_alloc_dealloc_
+      call psb_errpush(info,name)
+      goto 9999
+    endif
+
+
+    ! loop over rows belonging to current process in a block
+    ! distribution.
+
     call psb_barrier(ctxt)
     t1 = psb_wtime()
-    !$omp parallel shared(deltah,myidx,a,desc_a)
-    !
-    block 
-      integer(psb_ipk_) :: i,j,k,ii,ib,icoeff, ix,iy,iz, ith,nth
-      integer(psb_lpk_) :: glob_row
-      integer(psb_lpk_), allocatable :: irow(:),icol(:)
-      real(psb_dpk_), allocatable :: val(:)
-      real(psb_dpk_)     :: x,y,z, zt(nb)
-#if defined(OPENMP)
-      nth = omp_get_num_threads()
-      ith = omp_get_thread_num()
-#else
-      nth = 1
-      ith = 0
-#endif
-      allocate(val(20*nb),irow(20*nb),&
-           &icol(20*nb),stat=info)
-      if (info /= psb_success_ ) then
-        info=psb_err_alloc_dealloc_
-        call psb_errpush(info,name)
-        !goto 9999
-      endif
-
-      !$omp  do schedule(dynamic)
-      !     
-      do ii=1, nlr, nb
-        if (info /= psb_success_) cycle
-        ib = min(nb,nlr-ii+1)
-        icoeff = 1
-        do k=1,ib
-          i=ii+k-1
-          ! local matrix pointer
-          glob_row=myidx(i)
-          ! compute gridpoint coordinates
-          call idx2ijk(ix,iy,iz,glob_row,idim,idim,idim)
-          ! x, y, z coordinates
-          x = (ix-1)*deltah
-          y = (iy-1)*deltah
-          z = (iz-1)*deltah
-          zt(k) = f_(x,y,z)
-          ! internal point: build discretization
-          !
-          !  term depending on   (x-1,y,z)
-          !
-          val(icoeff) = -a1(x,y,z)/sqdeltah-b1(x,y,z)/deltah2
-          if (ix == 1) then
-            zt(k) = g(dzero,y,z)*(-val(icoeff)) + zt(k)
-          else
-            call ijk2idx(icol(icoeff),ix-1,iy,iz,idim,idim,idim)
-            irow(icoeff) = glob_row
-            icoeff       = icoeff+1
-          endif
-          !  term depending on     (x,y-1,z)
-          val(icoeff)  = -a2(x,y,z)/sqdeltah-b2(x,y,z)/deltah2
-          if (iy == 1) then
-            zt(k) = g(x,dzero,z)*(-val(icoeff))   + zt(k)
-          else
-            call ijk2idx(icol(icoeff),ix,iy-1,iz,idim,idim,idim)
-            irow(icoeff) = glob_row
-            icoeff       = icoeff+1
-          endif
-          !  term depending on     (x,y,z-1)
-          val(icoeff)=-a3(x,y,z)/sqdeltah-b3(x,y,z)/deltah2
-          if (iz == 1) then
-            zt(k) = g(x,y,dzero)*(-val(icoeff))   + zt(k)
-          else
-            call ijk2idx(icol(icoeff),ix,iy,iz-1,idim,idim,idim)
-            irow(icoeff) = glob_row
-            icoeff       = icoeff+1
-          endif
-
-          !  term depending on     (x,y,z)
-          val(icoeff)=(2*done)*(a1(x,y,z)+a2(x,y,z)+a3(x,y,z))/sqdeltah &
-               & + c(x,y,z)
-          call ijk2idx(icol(icoeff),ix,iy,iz,idim,idim,idim)
+    do ii=1, nlr,nb
+      ib = min(nb,nlr-ii+1)
+      icoeff = 1
+      do k=1,ib
+        i=ii+k-1
+        ! local matrix pointer
+        glob_row=myidx(i)
+        ! compute gridpoint coordinates
+        call idx2ijk(ix,iy,iz,glob_row,idim,idim,idim)
+        ! x, y, z coordinates
+        x = (ix-1)*deltah
+        y = (iy-1)*deltah
+        z = (iz-1)*deltah
+        zt(k) = f_(x,y,z)
+        ! internal point: build discretization
+        !
+        !  term depending on   (x-1,y,z)
+        !
+        val(icoeff) = -a1(x,y,z)/sqdeltah-b1(x,y,z)/deltah2
+        if (ix == 1) then
+          zt(k) = g(dzero,y,z)*(-val(icoeff)) + zt(k)
+        else
+          call ijk2idx(icol(icoeff),ix-1,iy,iz,idim,idim,idim)
           irow(icoeff) = glob_row
           icoeff       = icoeff+1
-          !  term depending on     (x,y,z+1)
-          val(icoeff)=-a3(x,y,z)/sqdeltah+b3(x,y,z)/deltah2
-          if (iz == idim) then
-            zt(k) = g(x,y,done)*(-val(icoeff))   + zt(k)
-          else
-            call ijk2idx(icol(icoeff),ix,iy,iz+1,idim,idim,idim)
-            irow(icoeff) = glob_row
-            icoeff       = icoeff+1
-          endif
-          !  term depending on     (x,y+1,z)
-          val(icoeff)=-a2(x,y,z)/sqdeltah+b2(x,y,z)/deltah2
-          if (iy == idim) then
-            zt(k) = g(x,done,z)*(-val(icoeff))   + zt(k)
-          else
-            call ijk2idx(icol(icoeff),ix,iy+1,iz,idim,idim,idim)
-            irow(icoeff) = glob_row
-            icoeff       = icoeff+1
-          endif
-          !  term depending on     (x+1,y,z)
-          val(icoeff)=-a1(x,y,z)/sqdeltah+b1(x,y,z)/deltah2
-          if (ix==idim) then
-            zt(k) = g(done,y,z)*(-val(icoeff))   + zt(k)
-          else
-            call ijk2idx(icol(icoeff),ix+1,iy,iz,idim,idim,idim)
-            irow(icoeff) = glob_row
-            icoeff       = icoeff+1
-          endif
+        endif
+        !  term depending on     (x,y-1,z)
+        val(icoeff)  = -a2(x,y,z)/sqdeltah-b2(x,y,z)/deltah2
+        if (iy == 1) then
+          zt(k) = g(x,dzero,z)*(-val(icoeff))   + zt(k)
+        else
+          call ijk2idx(icol(icoeff),ix,iy-1,iz,idim,idim,idim)
+          irow(icoeff) = glob_row
+          icoeff       = icoeff+1
+        endif
+        !  term depending on     (x,y,z-1)
+        val(icoeff)=-a3(x,y,z)/sqdeltah-b3(x,y,z)/deltah2
+        if (iz == 1) then
+          zt(k) = g(x,y,dzero)*(-val(icoeff))   + zt(k)
+        else
+          call ijk2idx(icol(icoeff),ix,iy,iz-1,idim,idim,idim)
+          irow(icoeff) = glob_row
+          icoeff       = icoeff+1
+        endif
+
+        !  term depending on     (x,y,z)
+        val(icoeff)=(2*done)*(a1(x,y,z)+a2(x,y,z)+a3(x,y,z))/sqdeltah &
+             & + c(x,y,z)
+        call ijk2idx(icol(icoeff),ix,iy,iz,idim,idim,idim)
+        irow(icoeff) = glob_row
+        icoeff       = icoeff+1
+        !  term depending on     (x,y,z+1)
+        val(icoeff)=-a3(x,y,z)/sqdeltah+b3(x,y,z)/deltah2
+        if (iz == idim) then
+          zt(k) = g(x,y,done)*(-val(icoeff))   + zt(k)
+        else
+          call ijk2idx(icol(icoeff),ix,iy,iz+1,idim,idim,idim)
+          irow(icoeff) = glob_row
+          icoeff       = icoeff+1
+        endif
+        !  term depending on     (x,y+1,z)
+        val(icoeff)=-a2(x,y,z)/sqdeltah+b2(x,y,z)/deltah2
+        if (iy == idim) then
+          zt(k) = g(x,done,z)*(-val(icoeff))   + zt(k)
+        else
+          call ijk2idx(icol(icoeff),ix,iy+1,iz,idim,idim,idim)
+          irow(icoeff) = glob_row
+          icoeff       = icoeff+1
+        endif
+        !  term depending on     (x+1,y,z)
+        val(icoeff)=-a1(x,y,z)/sqdeltah+b1(x,y,z)/deltah2
+        if (ix==idim) then
+          zt(k) = g(done,y,z)*(-val(icoeff))   + zt(k)
+        else
+          call ijk2idx(icol(icoeff),ix+1,iy,iz,idim,idim,idim)
+          irow(icoeff) = glob_row
+          icoeff       = icoeff+1
+        endif
 
-        end do
-        !write(0,*) ' Outer in_parallel ',omp_in_parallel()
-        call psb_spins(icoeff-1,irow,icol,val,a,desc_a,info)
-        if(info /= psb_success_) cycle
-        call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info)
-        if(info /= psb_success_) cycle
-        zt(:)=dzero
-        call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info)
-        if(info /= psb_success_) cycle
       end do
-      !$omp end do
-
-      deallocate(val,irow,icol)
-    end block
-    !$omp end parallel
+      call psb_spins(icoeff-1,irow,icol,val,a,desc_a,info)
+      if(info /= psb_success_) exit
+      call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info)
+      if(info /= psb_success_) exit
+      zt(:)=dzero
+      call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info)
+      if(info /= psb_success_) exit
+    end do
 
     tgen = psb_wtime()-t1
     if(info /= psb_success_) then
@@ -500,6 +490,7 @@ contains
       goto 9999
     end if
 
+    deallocate(val,irow,icol)
 
     call psb_barrier(ctxt)
     t1 = psb_wtime()
@@ -566,9 +557,6 @@ contains
        & a1,a2,b1,b2,c,g,info,f,amold,vmold,partition, nrl,iv)
     use psb_base_mod
     use psb_util_mod
-#if defined(OPENMP)
-    use omp_lib
-#endif
     !
     !   Discretizes the partial differential equation
     !
@@ -603,6 +591,7 @@ contains
     type(psb_d_csc_sparse_mat)  :: acsc
     type(psb_d_coo_sparse_mat)  :: acoo
     type(psb_d_csr_sparse_mat)  :: acsr
+    real(psb_dpk_)           :: zt(nb),x,y,z,xph,xmh,yph,ymh,zph,zmh
     integer(psb_ipk_) :: nnz,nr,nlr,i,j,ii,ib,k, partition_
     integer(psb_lpk_) :: m,n,glob_row,nt
     integer(psb_ipk_) :: ix,iy,iz,ia,indx_owner
@@ -615,7 +604,8 @@ contains
     ! Process grid
     integer(psb_ipk_) :: np, iam
     integer(psb_ipk_) :: icoeff
-    integer(psb_lpk_), allocatable     :: myidx(:)
+    integer(psb_lpk_), allocatable     :: irow(:),icol(:),myidx(:)
+    real(psb_dpk_), allocatable :: val(:)
     ! deltah dimension of each grid cell
     ! deltat discretization time
     real(psb_dpk_)            :: deltah, sqdeltah, deltah2, dd
@@ -801,7 +791,7 @@ contains
           !write(0,*) iam,' Check on neighbours: ',desc_a%get_p_adjcncy()
         end if
       end block
-
+      
     case default
       write(psb_err_unit,*) iam, 'Initialization error: should not get here'
       info = -1
@@ -826,109 +816,93 @@ contains
       goto 9999
     end if
 
+    ! we build an auxiliary matrix consisting of one row at a
+    ! time; just a small matrix. might be extended to generate
+    ! a bunch of rows per call.
+    !
+    allocate(val(20*nb),irow(20*nb),&
+         &icol(20*nb),stat=info)
+    if (info /= psb_success_ ) then
+      info=psb_err_alloc_dealloc_
+      call psb_errpush(info,name)
+      goto 9999
+    endif
+
+
+    ! loop over rows belonging to current process in a block
+    ! distribution.
+
     call psb_barrier(ctxt)
     t1 = psb_wtime()
-    !$omp parallel shared(deltah,myidx,a,desc_a)
-    !
-    block 
-      integer(psb_ipk_) :: i,j,k,ii,ib,icoeff, ix,iy,iz, ith,nth
-      integer(psb_lpk_) :: glob_row
-      integer(psb_lpk_), allocatable :: irow(:),icol(:)
-      real(psb_dpk_), allocatable :: val(:)
-      real(psb_dpk_)     :: x,y,z, zt(nb)
-#if defined(OPENMP)
-      nth = omp_get_num_threads()
-      ith = omp_get_thread_num()
-#else
-      nth = 1
-      ith = 0
-#endif
-      allocate(val(20*nb),irow(20*nb),&
-           &icol(20*nb),stat=info)
-      if (info /= psb_success_ ) then
-        info=psb_err_alloc_dealloc_
-        call psb_errpush(info,name)
-        !goto 9999
-      endif
+    do ii=1, nlr,nb
+      ib = min(nb,nlr-ii+1)
+      icoeff = 1
+      do k=1,ib
+        i=ii+k-1
+        ! local matrix pointer
+        glob_row=myidx(i)
+        ! compute gridpoint coordinates
+        call idx2ijk(ix,iy,glob_row,idim,idim)
+        ! x, y coordinates
+        x = (ix-1)*deltah
+        y = (iy-1)*deltah
 
-      ! loop over rows belonging to current process in a block
-      ! distribution.
-      !$omp  do schedule(dynamic)
-      !     
-      do ii=1, nlr,nb
-        ib = min(nb,nlr-ii+1)
-        icoeff = 1
-        do k=1,ib
-          i=ii+k-1
-          ! local matrix pointer
-          glob_row=myidx(i)
-          ! compute gridpoint coordinates
-          call idx2ijk(ix,iy,glob_row,idim,idim)
-          ! x, y coordinates
-          x = (ix-1)*deltah
-          y = (iy-1)*deltah
-
-          zt(k) = f_(x,y)
-          ! internal point: build discretization
-          !
-          !  term depending on   (x-1,y)
-          !
-          val(icoeff) = -a1(x,y)/sqdeltah-b1(x,y)/deltah2
-          if (ix == 1) then
-            zt(k) = g(dzero,y)*(-val(icoeff)) + zt(k)
-          else
-            call ijk2idx(icol(icoeff),ix-1,iy,idim,idim)
-            irow(icoeff) = glob_row
-            icoeff       = icoeff+1
-          endif
-          !  term depending on     (x,y-1)
-          val(icoeff)  = -a2(x,y)/sqdeltah-b2(x,y)/deltah2
-          if (iy == 1) then
-            zt(k) = g(x,dzero)*(-val(icoeff))   + zt(k)
-          else
-            call ijk2idx(icol(icoeff),ix,iy-1,idim,idim)
-            irow(icoeff) = glob_row
-            icoeff       = icoeff+1
-          endif
-
-          !  term depending on     (x,y)
-          val(icoeff)=(2*done)*(a1(x,y) + a2(x,y))/sqdeltah + c(x,y)
-          call ijk2idx(icol(icoeff),ix,iy,idim,idim)
+        zt(k) = f_(x,y)
+        ! internal point: build discretization
+        !
+        !  term depending on   (x-1,y)
+        !
+        val(icoeff) = -a1(x,y)/sqdeltah-b1(x,y)/deltah2
+        if (ix == 1) then
+          zt(k) = g(dzero,y)*(-val(icoeff)) + zt(k)
+        else
+          call ijk2idx(icol(icoeff),ix-1,iy,idim,idim)
           irow(icoeff) = glob_row
           icoeff       = icoeff+1
-          !  term depending on     (x,y+1)
-          val(icoeff)=-a2(x,y)/sqdeltah+b2(x,y)/deltah2
-          if (iy == idim) then
-            zt(k) = g(x,done)*(-val(icoeff))   + zt(k)
-          else
-            call ijk2idx(icol(icoeff),ix,iy+1,idim,idim)
-            irow(icoeff) = glob_row
-            icoeff       = icoeff+1
-          endif
-          !  term depending on     (x+1,y)
-          val(icoeff)=-a1(x,y)/sqdeltah+b1(x,y)/deltah2
-          if (ix==idim) then
-            zt(k) = g(done,y)*(-val(icoeff))   + zt(k)
-          else
-            call ijk2idx(icol(icoeff),ix+1,iy,idim,idim)
-            irow(icoeff) = glob_row
-            icoeff       = icoeff+1
-          endif
+        endif
+        !  term depending on     (x,y-1)
+        val(icoeff)  = -a2(x,y)/sqdeltah-b2(x,y)/deltah2
+        if (iy == 1) then
+          zt(k) = g(x,dzero)*(-val(icoeff))   + zt(k)
+        else
+          call ijk2idx(icol(icoeff),ix,iy-1,idim,idim)
+          irow(icoeff) = glob_row
+          icoeff       = icoeff+1
+        endif
+
+        !  term depending on     (x,y)
+        val(icoeff)=(2*done)*(a1(x,y) + a2(x,y))/sqdeltah + c(x,y)
+        call ijk2idx(icol(icoeff),ix,iy,idim,idim)
+        irow(icoeff) = glob_row
+        icoeff       = icoeff+1
+        !  term depending on     (x,y+1)
+        val(icoeff)=-a2(x,y)/sqdeltah+b2(x,y)/deltah2
+        if (iy == idim) then
+          zt(k) = g(x,done)*(-val(icoeff))   + zt(k)
+        else
+          call ijk2idx(icol(icoeff),ix,iy+1,idim,idim)
+          irow(icoeff) = glob_row
+          icoeff       = icoeff+1
+        endif
+        !  term depending on     (x+1,y)
+        val(icoeff)=-a1(x,y)/sqdeltah+b1(x,y)/deltah2
+        if (ix==idim) then
+          zt(k) = g(done,y)*(-val(icoeff))   + zt(k)
+        else
+          call ijk2idx(icol(icoeff),ix+1,iy,idim,idim)
+          irow(icoeff) = glob_row
+          icoeff       = icoeff+1
+        endif
 
-        end do
-        call psb_spins(icoeff-1,irow,icol,val,a,desc_a,info)
-        if(info /= psb_success_) cycle
-        call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info)
-        if(info /= psb_success_) cycle
-        zt(:)=dzero
-        call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info)
-        if(info /= psb_success_) cycle
       end do
-      !$omp end do
-
-      deallocate(val,irow,icol)
-    end block
-    !$omp end parallel
+      call psb_spins(icoeff-1,irow,icol,val,a,desc_a,info)
+      if(info /= psb_success_) exit
+      call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info)
+      if(info /= psb_success_) exit
+      zt(:)=dzero
+      call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info)
+      if(info /= psb_success_) exit
+    end do
 
     tgen = psb_wtime()-t1
     if(info /= psb_success_) then
@@ -938,6 +912,8 @@ contains
       goto 9999
     end if
 
+    deallocate(val,irow,icol)
+
     call psb_barrier(ctxt)
     t1 = psb_wtime()
     call psb_cdasb(desc_a,info)

samples/advanced/pdegen/amg_s_genpde_mod.F90

@@ -93,9 +93,6 @@ contains
        & a1,a2,a3,b1,b2,b3,c,g,info,f,amold,vmold,partition, nrl,iv)
     use psb_base_mod
     use psb_util_mod
-#if defined(OPENMP)
-    use omp_lib
-#endif
     !
     !   Discretizes the partial differential equation
     !
@@ -131,6 +128,7 @@ contains
     type(psb_s_csc_sparse_mat)  :: acsc
     type(psb_s_coo_sparse_mat)  :: acoo
     type(psb_s_csr_sparse_mat)  :: acsr
+    real(psb_spk_)           :: zt(nb),x,y,z,xph,xmh,yph,ymh,zph,zmh
     integer(psb_ipk_) :: nnz,nr,nlr,i,j,ii,ib,k, partition_
     integer(psb_lpk_) :: m,n,glob_row,nt
     integer(psb_ipk_) :: ix,iy,iz,ia,indx_owner
@@ -143,7 +141,8 @@ contains
     ! Process grid
     integer(psb_ipk_) :: np, iam
     integer(psb_ipk_) :: icoeff
-    integer(psb_lpk_), allocatable     :: myidx(:)
+    integer(psb_lpk_), allocatable     :: irow(:),icol(:),myidx(:)
+    real(psb_spk_), allocatable :: val(:)
     ! deltah dimension of each grid cell
     ! deltat discretization time
     real(psb_spk_)            :: deltah, sqdeltah, deltah2
@@ -369,128 +368,119 @@ contains
     call psb_barrier(ctxt)
     talc = psb_wtime()-t0
 
+    if (info /= psb_success_) then
+      info=psb_err_from_subroutine_
+      ch_err='allocation rout.'
+      call psb_errpush(info,name,a_err=ch_err)
+      goto 9999
+    end if
+
+    ! we build an auxiliary matrix consisting of one row at a
+    ! time; just a small matrix. might be extended to generate
+    ! a bunch of rows per call.
+    !
+    allocate(val(20*nb),irow(20*nb),&
+         &icol(20*nb),stat=info)
+    if (info /= psb_success_ ) then
+      info=psb_err_alloc_dealloc_
+      call psb_errpush(info,name)
+      goto 9999
+    endif
+
+
+    ! loop over rows belonging to current process in a block
+    ! distribution.
+
     call psb_barrier(ctxt)
     t1 = psb_wtime()
-    !$omp parallel shared(deltah,myidx,a,desc_a)
-    !
-    block 
-      integer(psb_ipk_) :: i,j,k,ii,ib,icoeff, ix,iy,iz, ith,nth
-      integer(psb_lpk_) :: glob_row
-      integer(psb_lpk_), allocatable :: irow(:),icol(:)
-      real(psb_spk_), allocatable :: val(:)
-      real(psb_spk_)     :: x,y,z, zt(nb)
-#if defined(OPENMP)
-      nth = omp_get_num_threads()
-      ith = omp_get_thread_num()
-#else
-      nth = 1
-      ith = 0
-#endif
-      allocate(val(20*nb),irow(20*nb),&
-           &icol(20*nb),stat=info)
-      if (info /= psb_success_ ) then
-        info=psb_err_alloc_dealloc_
-        call psb_errpush(info,name)
-        !goto 9999
-      endif
-
-      !$omp  do schedule(dynamic)
-      !     
-      do ii=1, nlr, nb
-        if (info /= psb_success_) cycle
-        ib = min(nb,nlr-ii+1)
-        icoeff = 1
-        do k=1,ib
-          i=ii+k-1
-          ! local matrix pointer
-          glob_row=myidx(i)
-          ! compute gridpoint coordinates
-          call idx2ijk(ix,iy,iz,glob_row,idim,idim,idim)
-          ! x, y, z coordinates
-          x = (ix-1)*deltah
-          y = (iy-1)*deltah
-          z = (iz-1)*deltah
-          zt(k) = f_(x,y,z)
-          ! internal point: build discretization
-          !
-          !  term depending on   (x-1,y,z)
-          !
-          val(icoeff) = -a1(x,y,z)/sqdeltah-b1(x,y,z)/deltah2
-          if (ix == 1) then
-            zt(k) = g(szero,y,z)*(-val(icoeff)) + zt(k)
-          else
-            call ijk2idx(icol(icoeff),ix-1,iy,iz,idim,idim,idim)
-            irow(icoeff) = glob_row
-            icoeff       = icoeff+1
-          endif
-          !  term depending on     (x,y-1,z)
-          val(icoeff)  = -a2(x,y,z)/sqdeltah-b2(x,y,z)/deltah2
-          if (iy == 1) then
-            zt(k) = g(x,szero,z)*(-val(icoeff))   + zt(k)
-          else
-            call ijk2idx(icol(icoeff),ix,iy-1,iz,idim,idim,idim)
-            irow(icoeff) = glob_row
-            icoeff       = icoeff+1
-          endif
-          !  term depending on     (x,y,z-1)
-          val(icoeff)=-a3(x,y,z)/sqdeltah-b3(x,y,z)/deltah2
-          if (iz == 1) then
-            zt(k) = g(x,y,szero)*(-val(icoeff))   + zt(k)
-          else
-            call ijk2idx(icol(icoeff),ix,iy,iz-1,idim,idim,idim)
-            irow(icoeff) = glob_row
-            icoeff       = icoeff+1
-          endif
-
-          !  term depending on     (x,y,z)
-          val(icoeff)=(2*sone)*(a1(x,y,z)+a2(x,y,z)+a3(x,y,z))/sqdeltah &
-               & + c(x,y,z)
-          call ijk2idx(icol(icoeff),ix,iy,iz,idim,idim,idim)
+    do ii=1, nlr,nb
+      ib = min(nb,nlr-ii+1)
+      icoeff = 1
+      do k=1,ib
+        i=ii+k-1
+        ! local matrix pointer
+        glob_row=myidx(i)
+        ! compute gridpoint coordinates
+        call idx2ijk(ix,iy,iz,glob_row,idim,idim,idim)
+        ! x, y, z coordinates
+        x = (ix-1)*deltah
+        y = (iy-1)*deltah
+        z = (iz-1)*deltah
+        zt(k) = f_(x,y,z)
+        ! internal point: build discretization
+        !
+        !  term depending on   (x-1,y,z)
+        !
+        val(icoeff) = -a1(x,y,z)/sqdeltah-b1(x,y,z)/deltah2
+        if (ix == 1) then
+          zt(k) = g(szero,y,z)*(-val(icoeff)) + zt(k)
+        else
+          call ijk2idx(icol(icoeff),ix-1,iy,iz,idim,idim,idim)
           irow(icoeff) = glob_row
           icoeff       = icoeff+1
-          !  term depending on     (x,y,z+1)
-          val(icoeff)=-a3(x,y,z)/sqdeltah+b3(x,y,z)/deltah2
-          if (iz == idim) then
-            zt(k) = g(x,y,sone)*(-val(icoeff))   + zt(k)
-          else
-            call ijk2idx(icol(icoeff),ix,iy,iz+1,idim,idim,idim)
-            irow(icoeff) = glob_row
-            icoeff       = icoeff+1
-          endif
-          !  term depending on     (x,y+1,z)
-          val(icoeff)=-a2(x,y,z)/sqdeltah+b2(x,y,z)/deltah2
-          if (iy == idim) then
-            zt(k) = g(x,sone,z)*(-val(icoeff))   + zt(k)
-          else
-            call ijk2idx(icol(icoeff),ix,iy+1,iz,idim,idim,idim)
-            irow(icoeff) = glob_row
-            icoeff       = icoeff+1
-          endif
-          !  term depending on     (x+1,y,z)
-          val(icoeff)=-a1(x,y,z)/sqdeltah+b1(x,y,z)/deltah2
-          if (ix==idim) then
-            zt(k) = g(sone,y,z)*(-val(icoeff))   + zt(k)
-          else
-            call ijk2idx(icol(icoeff),ix+1,iy,iz,idim,idim,idim)
-            irow(icoeff) = glob_row
-            icoeff       = icoeff+1
-          endif
+        endif
+        !  term depending on     (x,y-1,z)
+        val(icoeff)  = -a2(x,y,z)/sqdeltah-b2(x,y,z)/deltah2
+        if (iy == 1) then
+          zt(k) = g(x,szero,z)*(-val(icoeff))   + zt(k)
+        else
+          call ijk2idx(icol(icoeff),ix,iy-1,iz,idim,idim,idim)
+          irow(icoeff) = glob_row
+          icoeff       = icoeff+1
+        endif
+        !  term depending on     (x,y,z-1)
+        val(icoeff)=-a3(x,y,z)/sqdeltah-b3(x,y,z)/deltah2
+        if (iz == 1) then
+          zt(k) = g(x,y,szero)*(-val(icoeff))   + zt(k)
+        else
+          call ijk2idx(icol(icoeff),ix,iy,iz-1,idim,idim,idim)
+          irow(icoeff) = glob_row
+          icoeff       = icoeff+1
+        endif
+
+        !  term depending on     (x,y,z)
+        val(icoeff)=(2*sone)*(a1(x,y,z)+a2(x,y,z)+a3(x,y,z))/sqdeltah &
+             & + c(x,y,z)
+        call ijk2idx(icol(icoeff),ix,iy,iz,idim,idim,idim)
+        irow(icoeff) = glob_row
+        icoeff       = icoeff+1
+        !  term depending on     (x,y,z+1)
+        val(icoeff)=-a3(x,y,z)/sqdeltah+b3(x,y,z)/deltah2
+        if (iz == idim) then
+          zt(k) = g(x,y,sone)*(-val(icoeff))   + zt(k)
+        else
+          call ijk2idx(icol(icoeff),ix,iy,iz+1,idim,idim,idim)
+          irow(icoeff) = glob_row
+          icoeff       = icoeff+1
+        endif
+        !  term depending on     (x,y+1,z)
+        val(icoeff)=-a2(x,y,z)/sqdeltah+b2(x,y,z)/deltah2
+        if (iy == idim) then
+          zt(k) = g(x,sone,z)*(-val(icoeff))   + zt(k)
+        else
+          call ijk2idx(icol(icoeff),ix,iy+1,iz,idim,idim,idim)
+          irow(icoeff) = glob_row
+          icoeff       = icoeff+1
+        endif
+        !  term depending on     (x+1,y,z)
+        val(icoeff)=-a1(x,y,z)/sqdeltah+b1(x,y,z)/deltah2
+        if (ix==idim) then
+          zt(k) = g(sone,y,z)*(-val(icoeff))   + zt(k)
+        else
+          call ijk2idx(icol(icoeff),ix+1,iy,iz,idim,idim,idim)
+          irow(icoeff) = glob_row
+          icoeff       = icoeff+1
+        endif
 
-        end do
-        !write(0,*) ' Outer in_parallel ',omp_in_parallel()
-        call psb_spins(icoeff-1,irow,icol,val,a,desc_a,info)
-        if(info /= psb_success_) cycle
-        call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info)
-        if(info /= psb_success_) cycle
-        zt(:)=szero
-        call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info)
-        if(info /= psb_success_) cycle
       end do
-      !$omp end do
-
-      deallocate(val,irow,icol)
-    end block
-    !$omp end parallel
+      call psb_spins(icoeff-1,irow,icol,val,a,desc_a,info)
+      if(info /= psb_success_) exit
+      call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info)
+      if(info /= psb_success_) exit
+      zt(:)=szero
+      call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info)
+      if(info /= psb_success_) exit
+    end do
 
     tgen = psb_wtime()-t1
     if(info /= psb_success_) then
@@ -500,6 +490,7 @@ contains
       goto 9999
     end if
 
+    deallocate(val,irow,icol)
 
     call psb_barrier(ctxt)
     t1 = psb_wtime()
@@ -566,9 +557,6 @@ contains
        & a1,a2,b1,b2,c,g,info,f,amold,vmold,partition, nrl,iv)
     use psb_base_mod
     use psb_util_mod
-#if defined(OPENMP)
-    use omp_lib
-#endif
     !
     !   Discretizes the partial differential equation
     !
@@ -603,6 +591,7 @@ contains
     type(psb_s_csc_sparse_mat)  :: acsc
     type(psb_s_coo_sparse_mat)  :: acoo
     type(psb_s_csr_sparse_mat)  :: acsr
+    real(psb_spk_)           :: zt(nb),x,y,z,xph,xmh,yph,ymh,zph,zmh
     integer(psb_ipk_) :: nnz,nr,nlr,i,j,ii,ib,k, partition_
     integer(psb_lpk_) :: m,n,glob_row,nt
     integer(psb_ipk_) :: ix,iy,iz,ia,indx_owner
@@ -615,7 +604,8 @@ contains
     ! Process grid
     integer(psb_ipk_) :: np, iam
     integer(psb_ipk_) :: icoeff
-    integer(psb_lpk_), allocatable     :: myidx(:)
+    integer(psb_lpk_), allocatable     :: irow(:),icol(:),myidx(:)
+    real(psb_spk_), allocatable :: val(:)
     ! deltah dimension of each grid cell
     ! deltat discretization time
     real(psb_spk_)            :: deltah, sqdeltah, deltah2, dd
@@ -801,7 +791,7 @@ contains
           !write(0,*) iam,' Check on neighbours: ',desc_a%get_p_adjcncy()
         end if
       end block
-
+      
     case default
       write(psb_err_unit,*) iam, 'Initialization error: should not get here'
       info = -1
@@ -826,109 +816,93 @@ contains
       goto 9999
     end if
 
+    ! we build an auxiliary matrix consisting of one row at a
+    ! time; just a small matrix. might be extended to generate
+    ! a bunch of rows per call.
+    !
+    allocate(val(20*nb),irow(20*nb),&
+         &icol(20*nb),stat=info)
+    if (info /= psb_success_ ) then
+      info=psb_err_alloc_dealloc_
+      call psb_errpush(info,name)
+      goto 9999
+    endif
+
+
+    ! loop over rows belonging to current process in a block
+    ! distribution.
+
     call psb_barrier(ctxt)
     t1 = psb_wtime()
-    !$omp parallel shared(deltah,myidx,a,desc_a)
-    !
-    block 
-      integer(psb_ipk_) :: i,j,k,ii,ib,icoeff, ix,iy,iz, ith,nth
-      integer(psb_lpk_) :: glob_row
-      integer(psb_lpk_), allocatable :: irow(:),icol(:)
-      real(psb_spk_), allocatable :: val(:)
-      real(psb_spk_)     :: x,y,z, zt(nb)
-#if defined(OPENMP)
-      nth = omp_get_num_threads()
-      ith = omp_get_thread_num()
-#else
-      nth = 1
-      ith = 0
-#endif
-      allocate(val(20*nb),irow(20*nb),&
-           &icol(20*nb),stat=info)
-      if (info /= psb_success_ ) then
-        info=psb_err_alloc_dealloc_
-        call psb_errpush(info,name)
-        !goto 9999
-      endif
+    do ii=1, nlr,nb
+      ib = min(nb,nlr-ii+1)
+      icoeff = 1
+      do k=1,ib
+        i=ii+k-1
+        ! local matrix pointer
+        glob_row=myidx(i)
+        ! compute gridpoint coordinates
+        call idx2ijk(ix,iy,glob_row,idim,idim)
+        ! x, y coordinates
+        x = (ix-1)*deltah
+        y = (iy-1)*deltah
 
-      ! loop over rows belonging to current process in a block
-      ! distribution.
-      !$omp  do schedule(dynamic)
-      !     
-      do ii=1, nlr,nb
-        ib = min(nb,nlr-ii+1)
-        icoeff = 1
-        do k=1,ib
-          i=ii+k-1
-          ! local matrix pointer
-          glob_row=myidx(i)
-          ! compute gridpoint coordinates
-          call idx2ijk(ix,iy,glob_row,idim,idim)
-          ! x, y coordinates
-          x = (ix-1)*deltah
-          y = (iy-1)*deltah
-
-          zt(k) = f_(x,y)
-          ! internal point: build discretization
-          !
-          !  term depending on   (x-1,y)
-          !
-          val(icoeff) = -a1(x,y)/sqdeltah-b1(x,y)/deltah2
-          if (ix == 1) then
-            zt(k) = g(szero,y)*(-val(icoeff)) + zt(k)
-          else
-            call ijk2idx(icol(icoeff),ix-1,iy,idim,idim)
-            irow(icoeff) = glob_row
-            icoeff       = icoeff+1
-          endif
-          !  term depending on     (x,y-1)
-          val(icoeff)  = -a2(x,y)/sqdeltah-b2(x,y)/deltah2
-          if (iy == 1) then
-            zt(k) = g(x,szero)*(-val(icoeff))   + zt(k)
-          else
-            call ijk2idx(icol(icoeff),ix,iy-1,idim,idim)
-            irow(icoeff) = glob_row
-            icoeff       = icoeff+1
-          endif
-
-          !  term depending on     (x,y)
-          val(icoeff)=(2*sone)*(a1(x,y) + a2(x,y))/sqdeltah + c(x,y)
-          call ijk2idx(icol(icoeff),ix,iy,idim,idim)
+        zt(k) = f_(x,y)
+        ! internal point: build discretization
+        !
+        !  term depending on   (x-1,y)
+        !
+        val(icoeff) = -a1(x,y)/sqdeltah-b1(x,y)/deltah2
+        if (ix == 1) then
+          zt(k) = g(szero,y)*(-val(icoeff)) + zt(k)
+        else
+          call ijk2idx(icol(icoeff),ix-1,iy,idim,idim)
           irow(icoeff) = glob_row
           icoeff       = icoeff+1
-          !  term depending on     (x,y+1)
-          val(icoeff)=-a2(x,y)/sqdeltah+b2(x,y)/deltah2
-          if (iy == idim) then
-            zt(k) = g(x,sone)*(-val(icoeff))   + zt(k)
-          else
-            call ijk2idx(icol(icoeff),ix,iy+1,idim,idim)
-            irow(icoeff) = glob_row
-            icoeff       = icoeff+1
-          endif
-          !  term depending on     (x+1,y)
-          val(icoeff)=-a1(x,y)/sqdeltah+b1(x,y)/deltah2
-          if (ix==idim) then
-            zt(k) = g(sone,y)*(-val(icoeff))   + zt(k)
-          else
-            call ijk2idx(icol(icoeff),ix+1,iy,idim,idim)
-            irow(icoeff) = glob_row
-            icoeff       = icoeff+1
-          endif
+        endif
+        !  term depending on     (x,y-1)
+        val(icoeff)  = -a2(x,y)/sqdeltah-b2(x,y)/deltah2
+        if (iy == 1) then
+          zt(k) = g(x,szero)*(-val(icoeff))   + zt(k)
+        else
+          call ijk2idx(icol(icoeff),ix,iy-1,idim,idim)
+          irow(icoeff) = glob_row
+          icoeff       = icoeff+1
+        endif
+
+        !  term depending on     (x,y)
+        val(icoeff)=(2*sone)*(a1(x,y) + a2(x,y))/sqdeltah + c(x,y)
+        call ijk2idx(icol(icoeff),ix,iy,idim,idim)
+        irow(icoeff) = glob_row
+        icoeff       = icoeff+1
+        !  term depending on     (x,y+1)
+        val(icoeff)=-a2(x,y)/sqdeltah+b2(x,y)/deltah2
+        if (iy == idim) then
+          zt(k) = g(x,sone)*(-val(icoeff))   + zt(k)
+        else
+          call ijk2idx(icol(icoeff),ix,iy+1,idim,idim)
+          irow(icoeff) = glob_row
+          icoeff       = icoeff+1
+        endif
+        !  term depending on     (x+1,y)
+        val(icoeff)=-a1(x,y)/sqdeltah+b1(x,y)/deltah2
+        if (ix==idim) then
+          zt(k) = g(sone,y)*(-val(icoeff))   + zt(k)
+        else
+          call ijk2idx(icol(icoeff),ix+1,iy,idim,idim)
+          irow(icoeff) = glob_row
+          icoeff       = icoeff+1
+        endif
 
-        end do
-        call psb_spins(icoeff-1,irow,icol,val,a,desc_a,info)
-        if(info /= psb_success_) cycle
-        call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info)
-        if(info /= psb_success_) cycle
-        zt(:)=szero
-        call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info)
-        if(info /= psb_success_) cycle
       end do
-      !$omp end do
-
-      deallocate(val,irow,icol)
-    end block
-    !$omp end parallel
+      call psb_spins(icoeff-1,irow,icol,val,a,desc_a,info)
+      if(info /= psb_success_) exit
+      call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info)
+      if(info /= psb_success_) exit
+      zt(:)=szero
+      call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info)
+      if(info /= psb_success_) exit
+    end do
 
     tgen = psb_wtime()-t1
     if(info /= psb_success_) then
@@ -938,6 +912,8 @@ contains
       goto 9999
     end if
 
+    deallocate(val,irow,icol)
+
     call psb_barrier(ctxt)
     t1 = psb_wtime()
     call psb_cdasb(desc_a,info)

samples/advanced/pdegen/runs/amg_pde3d.inp

@@ -1,6 +1,6 @@
 %%%%%%%%%%%  General  arguments % Lines starting with % are ignored.
 CSR                         ! Storage format CSR COO JAD
-0200                       ! IDIM; domain size. Linear system size is IDIM**3
+0080                        ! IDIM; domain size. Linear system size is IDIM**3
 CONST                       ! PDECOEFF: CONST, EXP, GAUSS Coefficients of the PDE
 BICGSTAB                    ! Iterative method: BiCGSTAB BiCGSTABL BiCG CG CGS FCG GCR RGMRES
 2                           ! ISTOPC