Redefine map_bld interfaces.

2026-10-06 22:55:12 +00:00 · 2018-05-11 12:55:50 +01:00
parent cce189c450
commit 9f2c23b2a4
21 changed files with 105 additions and 120 deletions
@@ -110,7 +110,7 @@ subroutine  mld_c_dec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_
  call mld_check_def(parms%aggr_thresh,'Aggr_Thresh',szero,is_legal_s_aggr_thrs)


-  call mld_vmb_map_bld(parms%aggr_ord,parms%aggr_thresh,a,desc_a,nlaggr,ilaggr,info)
+  call mld_c_vmb_map_bld(parms%aggr_ord,parms%aggr_thresh,a,desc_a,nlaggr,ilaggr,info)

  if (info==psb_success_) call mld_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
  if (info /= psb_success_) then
@@ -112,7 +112,7 @@ subroutine  mld_c_hybrid_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,
  call mld_check_def(parms%aggr_thresh,'Aggr_Thresh',szero,is_legal_s_aggr_thrs)


-  call mld_hyb_map_bld(parms%aggr_ord,parms%aggr_thresh,a,desc_a,nlaggr,ilaggr,info)
+  call mld_c_hyb_map_bld(parms%aggr_ord,parms%aggr_thresh,a,desc_a,nlaggr,ilaggr,info)

  if (info==psb_success_) call mld_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
  if (info /= psb_success_) then
@@ -127,7 +127,7 @@ subroutine  mld_c_symdec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,
  if (info == psb_success_) call atmp%cscnv(info,type='CSR')

  if (info == psb_success_) &
-       & call mld_vmb_map_bld(parms%aggr_ord,parms%aggr_thresh,atmp,desc_a,nlaggr,ilaggr,info)
+       & call mld_c_vmb_map_bld(parms%aggr_ord,parms%aggr_thresh,atmp,desc_a,nlaggr,ilaggr,info)
  if (info == psb_success_) call atmp%free()

  if (info == psb_success_) call mld_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)    
@@ -110,7 +110,7 @@ subroutine  mld_d_dec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_
  call mld_check_def(parms%aggr_thresh,'Aggr_Thresh',dzero,is_legal_d_aggr_thrs)


-  call mld_vmb_map_bld(parms%aggr_ord,parms%aggr_thresh,a,desc_a,nlaggr,ilaggr,info)
+  call mld_d_vmb_map_bld(parms%aggr_ord,parms%aggr_thresh,a,desc_a,nlaggr,ilaggr,info)

  if (info==psb_success_) call mld_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
  if (info /= psb_success_) then
@@ -112,7 +112,7 @@ subroutine  mld_d_hybrid_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,
  call mld_check_def(parms%aggr_thresh,'Aggr_Thresh',dzero,is_legal_d_aggr_thrs)


-  call mld_hyb_map_bld(parms%aggr_ord,parms%aggr_thresh,a,desc_a,nlaggr,ilaggr,info)
+  call mld_d_hyb_map_bld(parms%aggr_ord,parms%aggr_thresh,a,desc_a,nlaggr,ilaggr,info)

  if (info==psb_success_) call mld_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
  if (info /= psb_success_) then
@@ -127,7 +127,7 @@ subroutine  mld_d_symdec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,
  if (info == psb_success_) call atmp%cscnv(info,type='CSR')

  if (info == psb_success_) &
-       & call mld_vmb_map_bld(parms%aggr_ord,parms%aggr_thresh,atmp,desc_a,nlaggr,ilaggr,info)
+       & call mld_d_vmb_map_bld(parms%aggr_ord,parms%aggr_thresh,atmp,desc_a,nlaggr,ilaggr,info)
  if (info == psb_success_) call atmp%free()

  if (info == psb_success_) call mld_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)    
@@ -110,7 +110,7 @@ subroutine  mld_s_dec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_
  call mld_check_def(parms%aggr_thresh,'Aggr_Thresh',szero,is_legal_s_aggr_thrs)


-  call mld_vmb_map_bld(parms%aggr_ord,parms%aggr_thresh,a,desc_a,nlaggr,ilaggr,info)
+  call mld_s_vmb_map_bld(parms%aggr_ord,parms%aggr_thresh,a,desc_a,nlaggr,ilaggr,info)

  if (info==psb_success_) call mld_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
  if (info /= psb_success_) then
@@ -112,7 +112,7 @@ subroutine  mld_s_hybrid_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,
  call mld_check_def(parms%aggr_thresh,'Aggr_Thresh',szero,is_legal_s_aggr_thrs)


-  call mld_hyb_map_bld(parms%aggr_ord,parms%aggr_thresh,a,desc_a,nlaggr,ilaggr,info)
+  call mld_s_hyb_map_bld(parms%aggr_ord,parms%aggr_thresh,a,desc_a,nlaggr,ilaggr,info)

  if (info==psb_success_) call mld_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
  if (info /= psb_success_) then
@@ -127,7 +127,7 @@ subroutine  mld_s_symdec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,
  if (info == psb_success_) call atmp%cscnv(info,type='CSR')

  if (info == psb_success_) &
-       & call mld_vmb_map_bld(parms%aggr_ord,parms%aggr_thresh,atmp,desc_a,nlaggr,ilaggr,info)
+       & call mld_s_vmb_map_bld(parms%aggr_ord,parms%aggr_thresh,atmp,desc_a,nlaggr,ilaggr,info)
  if (info == psb_success_) call atmp%free()

  if (info == psb_success_) call mld_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)    
@@ -110,7 +110,7 @@ subroutine  mld_z_dec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_
  call mld_check_def(parms%aggr_thresh,'Aggr_Thresh',dzero,is_legal_d_aggr_thrs)


-  call mld_vmb_map_bld(parms%aggr_ord,parms%aggr_thresh,a,desc_a,nlaggr,ilaggr,info)
+  call mld_z_vmb_map_bld(parms%aggr_ord,parms%aggr_thresh,a,desc_a,nlaggr,ilaggr,info)

  if (info==psb_success_) call mld_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
  if (info /= psb_success_) then
@@ -112,7 +112,7 @@ subroutine  mld_z_hybrid_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,
  call mld_check_def(parms%aggr_thresh,'Aggr_Thresh',dzero,is_legal_d_aggr_thrs)


-  call mld_hyb_map_bld(parms%aggr_ord,parms%aggr_thresh,a,desc_a,nlaggr,ilaggr,info)
+  call mld_z_hyb_map_bld(parms%aggr_ord,parms%aggr_thresh,a,desc_a,nlaggr,ilaggr,info)

  if (info==psb_success_) call mld_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
  if (info /= psb_success_) then
@@ -127,7 +127,7 @@ subroutine  mld_z_symdec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,
  if (info == psb_success_) call atmp%cscnv(info,type='CSR')

  if (info == psb_success_) &
-       & call mld_vmb_map_bld(parms%aggr_ord,parms%aggr_thresh,atmp,desc_a,nlaggr,ilaggr,info)
+       & call mld_z_vmb_map_bld(parms%aggr_ord,parms%aggr_thresh,atmp,desc_a,nlaggr,ilaggr,info)
  if (info == psb_success_) call atmp%free()

  if (info == psb_success_) call mld_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)    
@@ -66,9 +66,18 @@ subroutine mld_c_base_onelev_descr(lv,il,nl,ilmin,info,iout)

  write(iout_,*) 
  if (il == ilmin) then 
-    call lv%parms%mldescr(iout_,info)
+    call lv%parms%mlcycledsc(iout_,info)
+    if (allocated(lv%aggr)) then
+      call lv%aggr%descr(lv%parms,iout_,info)
+    else
+      write(iout_,*) 'Internal error: unallocated aggregator object'
+      info = psb_err_internal_error_
+      call psb_errpush(info,name)
+      goto 9999
+    end if
    write(iout_,*) 
  end if
+  
  if (il > 1) then 

    if (coarse)  then 
@@ -66,9 +66,18 @@ subroutine mld_d_base_onelev_descr(lv,il,nl,ilmin,info,iout)

  write(iout_,*) 
  if (il == ilmin) then 
-    call lv%parms%mldescr(iout_,info)
+    call lv%parms%mlcycledsc(iout_,info)
+    if (allocated(lv%aggr)) then
+      call lv%aggr%descr(lv%parms,iout_,info)
+    else
+      write(iout_,*) 'Internal error: unallocated aggregator object'
+      info = psb_err_internal_error_
+      call psb_errpush(info,name)
+      goto 9999
+    end if
    write(iout_,*) 
  end if
+  
  if (il > 1) then 

    if (coarse)  then 
@@ -66,9 +66,18 @@ subroutine mld_s_base_onelev_descr(lv,il,nl,ilmin,info,iout)

  write(iout_,*) 
  if (il == ilmin) then 
-    call lv%parms%mldescr(iout_,info)
+    call lv%parms%mlcycledsc(iout_,info)
+    if (allocated(lv%aggr)) then
+      call lv%aggr%descr(lv%parms,iout_,info)
+    else
+      write(iout_,*) 'Internal error: unallocated aggregator object'
+      info = psb_err_internal_error_
+      call psb_errpush(info,name)
+      goto 9999
+    end if
    write(iout_,*) 
  end if
+  
  if (il > 1) then 

    if (coarse)  then 
@@ -66,9 +66,18 @@ subroutine mld_z_base_onelev_descr(lv,il,nl,ilmin,info,iout)

  write(iout_,*) 
  if (il == ilmin) then 
-    call lv%parms%mldescr(iout_,info)
+    call lv%parms%mlcycledsc(iout_,info)
+    if (allocated(lv%aggr)) then
+      call lv%aggr%descr(lv%parms,iout_,info)
+    else
+      write(iout_,*) 'Internal error: unallocated aggregator object'
+      info = psb_err_internal_error_
+      call psb_errpush(info,name)
+      goto 9999
+    end if
    write(iout_,*) 
  end if
+  
  if (il > 1) then 

    if (coarse)  then 
@@ -569,10 +569,10 @@ contains
    if ((pm%ml_cycle>=mld_no_ml_).and.(pm%ml_cycle<=mld_max_ml_cycle_)) then

      
+      write(iout,*) '  Parallel aggregation algorithm: ',&
+           &   par_aggr_alg_names(pm%par_aggr_alg)
      write(iout,*) '  Aggregation type: ',&
           & aggr_type_names(pm%aggr_type)
-      write(iout,*) '  parallel algorithm: ',&
-           &   par_aggr_alg_names(pm%par_aggr_alg)
      if (pm%par_aggr_alg /= mld_ext_aggr_) then
        if ( pm%aggr_ord /= mld_aggr_ord_nat_) &
             & write(iout,*) '               with initial ordering: ',&
@@ -601,6 +601,33 @@ contains

  end subroutine ml_parms_mldescr

+  subroutine ml_parms_descr(pm,iout,info,coarse)
+
+    Implicit None
+
+    ! Arguments
+    class(mld_ml_parms), intent(in) :: pm
+    integer(psb_ipk_), intent(in)             :: iout
+    integer(psb_ipk_), intent(out)            :: info
+    logical, intent(in), optional   :: coarse
+    logical :: coarse_
+
+    info = psb_success_
+    if (present(coarse)) then 
+      coarse_ = coarse
+    else
+      coarse_ = .false.
+    end if
+
+    if (coarse_) then 
+      call pm%coarsedescr(iout,info)
+    end if
+
+    return
+
+  end subroutine ml_parms_descr
+
+
  subroutine ml_parms_coarsedescr(pm,iout,info)


@@ -632,32 +659,6 @@ contains

  end subroutine ml_parms_coarsedescr

-  subroutine ml_parms_descr(pm,iout,info,coarse)
-
-    Implicit None
-
-    ! Arguments
-    class(mld_ml_parms), intent(in) :: pm
-    integer(psb_ipk_), intent(in)             :: iout
-    integer(psb_ipk_), intent(out)            :: info
-    logical, intent(in), optional   :: coarse
-    logical :: coarse_
-
-    info = psb_success_
-    if (present(coarse)) then 
-      coarse_ = coarse
-    else
-      coarse_ = .false.
-    end if
-
-    if (coarse_) then 
-      call pm%coarsedescr(iout,info)
-    end if
-
-    return
-
-  end subroutine ml_parms_descr
-
  subroutine s_ml_parms_descr(pm,iout,info,coarse)

    Implicit None
@@ -123,9 +123,8 @@ module mld_c_inner_mod
    end subroutine mld_caggrmap_bld
  end interface mld_aggrmap_bld

-
-  interface  mld_vmb_map_bld
-    subroutine mld_c_vmb_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
+  abstract interface  
+    subroutine mld_c_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
      import :: psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_
      implicit none 
      integer(psb_ipk_), intent(in)     :: iorder
@@ -134,22 +133,11 @@ module mld_c_inner_mod
      real(psb_spk_), intent(in)         :: theta
      integer(psb_ipk_), allocatable, intent(out)  :: ilaggr(:),nlaggr(:)
      integer(psb_ipk_), intent(out)               :: info
-    end subroutine mld_c_vmb_map_bld
-  end interface mld_vmb_map_bld
-
-  interface  mld_hyb_map_bld
-    subroutine mld_c_hyb_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
-      use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_
-      implicit none 
-      integer(psb_ipk_), intent(in)     :: iorder
-      type(psb_cspmat_type), intent(in) :: a
-      type(psb_desc_type), intent(in)    :: desc_a
-      real(psb_spk_), intent(in)         :: theta
-      integer(psb_ipk_), allocatable, intent(out)  :: ilaggr(:),nlaggr(:)
-      integer(psb_ipk_), intent(out)               :: info
-    end subroutine mld_c_hyb_map_bld
-  end interface mld_hyb_map_bld
+    end subroutine mld_c_map_bld
+  end interface

+  procedure(mld_c_map_bld) ::  mld_c_vmb_map_bld, mld_c_hyb_map_bld
+  
  interface mld_map_to_tprol
    subroutine mld_c_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
      use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_
@@ -162,7 +150,6 @@ module mld_c_inner_mod
    end subroutine mld_c_map_to_tprol
  end interface mld_map_to_tprol
  
-
  interface mld_lev_mat_asb
    subroutine mld_c_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
      import :: psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_
@@ -123,9 +123,8 @@ module mld_d_inner_mod
    end subroutine mld_daggrmap_bld
  end interface mld_aggrmap_bld

-
-  interface  mld_vmb_map_bld
-    subroutine mld_d_vmb_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
+  abstract interface  
+    subroutine mld_d_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
      import :: psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
      implicit none 
      integer(psb_ipk_), intent(in)     :: iorder
@@ -134,22 +133,11 @@ module mld_d_inner_mod
      real(psb_dpk_), intent(in)         :: theta
      integer(psb_ipk_), allocatable, intent(out)  :: ilaggr(:),nlaggr(:)
      integer(psb_ipk_), intent(out)               :: info
-    end subroutine mld_d_vmb_map_bld
-  end interface mld_vmb_map_bld
-
-  interface  mld_hyb_map_bld
-    subroutine mld_d_hyb_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
-      use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
-      implicit none 
-      integer(psb_ipk_), intent(in)     :: iorder
-      type(psb_dspmat_type), intent(in) :: a
-      type(psb_desc_type), intent(in)    :: desc_a
-      real(psb_dpk_), intent(in)         :: theta
-      integer(psb_ipk_), allocatable, intent(out)  :: ilaggr(:),nlaggr(:)
-      integer(psb_ipk_), intent(out)               :: info
-    end subroutine mld_d_hyb_map_bld
-  end interface mld_hyb_map_bld
+    end subroutine mld_d_map_bld
+  end interface

+  procedure(mld_d_map_bld) ::  mld_d_vmb_map_bld, mld_d_hyb_map_bld
+  
  interface mld_map_to_tprol
    subroutine mld_d_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
      use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
@@ -162,7 +150,6 @@ module mld_d_inner_mod
    end subroutine mld_d_map_to_tprol
  end interface mld_map_to_tprol
  
-
  interface mld_lev_mat_asb
    subroutine mld_d_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
      import :: psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
@@ -123,9 +123,8 @@ module mld_s_inner_mod
    end subroutine mld_saggrmap_bld
  end interface mld_aggrmap_bld

-
-  interface  mld_vmb_map_bld
-    subroutine mld_s_vmb_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
+  abstract interface  
+    subroutine mld_s_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
      import :: psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_
      implicit none 
      integer(psb_ipk_), intent(in)     :: iorder
@@ -134,22 +133,11 @@ module mld_s_inner_mod
      real(psb_spk_), intent(in)         :: theta
      integer(psb_ipk_), allocatable, intent(out)  :: ilaggr(:),nlaggr(:)
      integer(psb_ipk_), intent(out)               :: info
-    end subroutine mld_s_vmb_map_bld
-  end interface mld_vmb_map_bld
-
-  interface  mld_hyb_map_bld
-    subroutine mld_s_hyb_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
-      use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_
-      implicit none 
-      integer(psb_ipk_), intent(in)     :: iorder
-      type(psb_sspmat_type), intent(in) :: a
-      type(psb_desc_type), intent(in)    :: desc_a
-      real(psb_spk_), intent(in)         :: theta
-      integer(psb_ipk_), allocatable, intent(out)  :: ilaggr(:),nlaggr(:)
-      integer(psb_ipk_), intent(out)               :: info
-    end subroutine mld_s_hyb_map_bld
-  end interface mld_hyb_map_bld
+    end subroutine mld_s_map_bld
+  end interface

+  procedure(mld_s_map_bld) ::  mld_s_vmb_map_bld, mld_s_hyb_map_bld
+  
  interface mld_map_to_tprol
    subroutine mld_s_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
      use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_
@@ -162,7 +150,6 @@ module mld_s_inner_mod
    end subroutine mld_s_map_to_tprol
  end interface mld_map_to_tprol
  
-
  interface mld_lev_mat_asb
    subroutine mld_s_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
      import :: psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_
@@ -123,9 +123,8 @@ module mld_z_inner_mod
    end subroutine mld_zaggrmap_bld
  end interface mld_aggrmap_bld

-
-  interface  mld_vmb_map_bld
-    subroutine mld_z_vmb_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
+  abstract interface  
+    subroutine mld_z_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
      import :: psb_zspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
      implicit none 
      integer(psb_ipk_), intent(in)     :: iorder
@@ -134,22 +133,11 @@ module mld_z_inner_mod
      real(psb_dpk_), intent(in)         :: theta
      integer(psb_ipk_), allocatable, intent(out)  :: ilaggr(:),nlaggr(:)
      integer(psb_ipk_), intent(out)               :: info
-    end subroutine mld_z_vmb_map_bld
-  end interface mld_vmb_map_bld
-
-  interface  mld_hyb_map_bld
-    subroutine mld_z_hyb_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
-      use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
-      implicit none 
-      integer(psb_ipk_), intent(in)     :: iorder
-      type(psb_zspmat_type), intent(in) :: a
-      type(psb_desc_type), intent(in)    :: desc_a
-      real(psb_dpk_), intent(in)         :: theta
-      integer(psb_ipk_), allocatable, intent(out)  :: ilaggr(:),nlaggr(:)
-      integer(psb_ipk_), intent(out)               :: info
-    end subroutine mld_z_hyb_map_bld
-  end interface mld_hyb_map_bld
+    end subroutine mld_z_map_bld
+  end interface

+  procedure(mld_z_map_bld) ::  mld_z_vmb_map_bld, mld_z_hyb_map_bld
+  
  interface mld_map_to_tprol
    subroutine mld_z_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
      use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
@@ -162,7 +150,6 @@ module mld_z_inner_mod
    end subroutine mld_z_map_to_tprol
  end interface mld_map_to_tprol
  
-
  interface mld_lev_mat_asb
    subroutine mld_z_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
      import :: psb_zspmat_type, psb_desc_type, psb_dpk_, psb_ipk_