Define PTAP and use in aggregation.

mlprec/impl/aggregator/mld_c_ptap.f90

@@ -36,7 +36,7 @@
 !
 !
 subroutine mld_c_ptap(a_csr,desc_a,nlaggr,parms,ac,&
-     & coo_prol,desc_ac,coo_restr,info)
+     & coo_prol,desc_ac,coo_restr,info,desc_ax)
   use psb_base_mod
   use mld_c_inner_mod
   use mld_c_base_aggregator_mod, mld_protect_name => mld_c_ptap
@@ -44,13 +44,14 @@ subroutine mld_c_ptap(a_csr,desc_a,nlaggr,parms,ac,&
 
   ! Arguments
   type(psb_c_csr_sparse_mat), intent(inout) :: a_csr
-  type(psb_desc_type), intent(in)            :: desc_a
+  type(psb_desc_type), intent(inout)          :: desc_a
   integer(psb_lpk_), intent(inout)           :: nlaggr(:)
   type(mld_sml_parms), intent(inout)         :: parms 
   type(psb_lc_coo_sparse_mat), intent(inout)  :: coo_prol, coo_restr
   type(psb_desc_type), intent(inout)         :: desc_ac
   type(psb_lcspmat_type), intent(out)        :: ac
   integer(psb_ipk_), intent(out)             :: info
+  type(psb_desc_type), intent(inout), optional :: desc_ax
 
   ! Local variables
   integer(psb_ipk_)  :: err_act
@@ -115,6 +116,47 @@ subroutine mld_c_ptap(a_csr,desc_a,nlaggr,parms,ac,&
 
   !
   ! Ok first product done.
+
+  if (present(desc_ax)) then
+    block 
+      type(psb_c_coo_sparse_mat) :: icoo_restr
+
+      call coo_prol%cp_to_icoo(icoo_restr,info)
+      call icoo_restr%set_ncols(desc_ac%get_local_cols())
+      call icoo_restr%set_nrows(desc_a%get_local_rows())
+      call psb_c_coo_glob_transpose(icoo_restr,desc_a,info,desc_c=desc_ac,desc_rx=desc_ax)
+      call icoo_restr%set_nrows(desc_ac%get_local_rows())
+      call icoo_restr%set_ncols(desc_ax%get_local_cols())
+      write(0,*) me,' ',trim(name),' check on glob_transpose 1: ',&
+           & desc_a%get_local_cols(),desc_ax%get_local_cols(),icoo_restr%get_nzeros()
+      if (desc_a%get_local_cols()<desc_ax%get_local_cols()) then
+        write(0,*) me,' ',trim(name),' WARNING: GLOB_TRANSPOSE NEW INDICES '
+      end if
+      call coo_restr%cp_from_icoo(icoo_restr,info)
+    end block
+    call csr_restr%cp_from_lcoo(coo_restr,info)
+
+!!$      write(0,*)me,' ',name,' after transposition ',coo_restr%get_nrows(),coo_restr%get_ncols(),coo_restr%get_nzeros()
+
+    if (info /= psb_success_) then 
+      call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
+      goto 9999
+    end if
+    if (debug_level >= psb_debug_outer_) &
+         & write(debug_unit,*) me,' ',trim(name),&
+         & 'starting sphalo/ rwxtd'
+
+    if (debug) write(0,*) me,trim(name),' Product RESTRxAP ',&
+         & csr_restr%get_nrows(),csr_restr%get_ncols(), &
+         & desc_ac%get_local_rows(),desc_a%get_local_cols(),&
+         & acsr3%get_nrows(),acsr3%get_ncols()
+    if (do_timings) call psb_tic(idx_spspmm)      
+    call psb_par_spspmm(csr_restr,desc_ax,acsr3,ac_csr,desc_ac,info)
+    if (do_timings) call psb_toc(idx_spspmm)      
+    call acsr3%free()
+
+  else
+
     !
     ! Remember that RESTR must be built from PROL after halo extension,
     ! which is done above in psb_par_spspmm
@@ -166,6 +208,7 @@ subroutine mld_c_ptap(a_csr,desc_a,nlaggr,parms,ac,&
     call psb_par_spspmm(csr_restr,desc_a,acsr3,ac_csr,desc_ac,info)
     if (do_timings) call psb_toc(idx_spspmm)      
     call acsr3%free()
+  end if
 
   call psb_cdasb(desc_ac,info)
 
@@ -175,11 +218,10 @@ subroutine mld_c_ptap(a_csr,desc_a,nlaggr,parms,ac,&
   call ac%set_asb()
 
   if (debug) write(0,*)  me,' ',trim(name),' After  mv_from',psb_get_errstatus()
-  if (debug) write(0,*)  me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),&
-       & ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr
+  if (debug) write(0,*)  me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr
+  ! write(0,*)  me,' ',trim(name),' Final AC newstyle ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros()
 
   call coo_prol%set_ncols(desc_ac%get_local_cols())
-  
   if (debug) call check_coo(me,trim(name)//' Check 3 on coo_restr:',coo_restr)
 
   if (debug_level >= psb_debug_outer_) &
@@ -211,7 +253,7 @@ contains
 end subroutine mld_c_ptap
 
 subroutine mld_lc_ptap(a_csr,desc_a,nlaggr,parms,ac,&
-     & coo_prol,desc_ac,coo_restr,info)
+     & coo_prol,desc_ac,coo_restr,info,desc_ax)
   use psb_base_mod
   use mld_c_inner_mod
   use mld_c_base_aggregator_mod, mld_protect_name => mld_lc_ptap
@@ -219,13 +261,14 @@ subroutine mld_lc_ptap(a_csr,desc_a,nlaggr,parms,ac,&
 
   ! Arguments
   type(psb_lc_csr_sparse_mat), intent(inout) :: a_csr
-  type(psb_desc_type), intent(in)            :: desc_a
+  type(psb_desc_type), intent(inout)           :: desc_a
   integer(psb_lpk_), intent(inout)           :: nlaggr(:)
   type(mld_sml_parms), intent(inout)         :: parms 
   type(psb_lc_coo_sparse_mat), intent(inout)  :: coo_prol, coo_restr
   type(psb_desc_type), intent(inout)         :: desc_ac
   type(psb_lcspmat_type), intent(out)        :: ac
   integer(psb_ipk_), intent(out)             :: info
+  type(psb_desc_type), intent(inout), optional :: desc_ax
 
   ! Local variables
   integer(psb_ipk_)  :: err_act
@@ -290,6 +333,47 @@ subroutine mld_lc_ptap(a_csr,desc_a,nlaggr,parms,ac,&
 
   !
   ! Ok first product done.
+
+  if (present(desc_ax)) then
+    block 
+      type(psb_c_coo_sparse_mat) :: icoo_restr
+
+      call coo_prol%cp_to_icoo(icoo_restr,info)
+      call icoo_restr%set_ncols(desc_ac%get_local_cols())
+      call icoo_restr%set_nrows(desc_a%get_local_rows())
+      call psb_c_coo_glob_transpose(icoo_restr,desc_a,info,desc_c=desc_ac,desc_rx=desc_ax)
+      call icoo_restr%set_nrows(desc_ac%get_local_rows())
+      call icoo_restr%set_ncols(desc_ax%get_local_cols())
+      write(0,*) me,' ',trim(name),' check on glob_transpose 1: ',&
+           & desc_a%get_local_cols(),desc_ax%get_local_cols(),icoo_restr%get_nzeros()
+      if (desc_a%get_local_cols()<desc_ax%get_local_cols()) then
+        write(0,*) me,' ',trim(name),' WARNING: GLOB_TRANSPOSE NEW INDICES '
+      end if
+      call coo_restr%cp_from_icoo(icoo_restr,info)
+    end block
+    call csr_restr%cp_from_coo(coo_restr,info)
+
+!!$      write(0,*)me,' ',name,' after transposition ',coo_restr%get_nrows(),coo_restr%get_ncols(),coo_restr%get_nzeros()
+
+    if (info /= psb_success_) then 
+      call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
+      goto 9999
+    end if
+    if (debug_level >= psb_debug_outer_) &
+         & write(debug_unit,*) me,' ',trim(name),&
+         & 'starting sphalo/ rwxtd'
+
+    if (debug) write(0,*) me,trim(name),' Product RESTRxAP ',&
+         & csr_restr%get_nrows(),csr_restr%get_ncols(), &
+         & desc_ac%get_local_rows(),desc_a%get_local_cols(),&
+         & acsr3%get_nrows(),acsr3%get_ncols()
+    if (do_timings) call psb_tic(idx_spspmm)      
+    call psb_par_spspmm(csr_restr,desc_ax,acsr3,ac_csr,desc_ac,info)
+    if (do_timings) call psb_toc(idx_spspmm)      
+    call acsr3%free()
+
+  else
+
     !
     ! Remember that RESTR must be built from PROL after halo extension,
     ! which is done above in psb_par_spspmm
@@ -341,6 +425,7 @@ subroutine mld_lc_ptap(a_csr,desc_a,nlaggr,parms,ac,&
     call psb_par_spspmm(csr_restr,desc_a,acsr3,ac_csr,desc_ac,info)
     if (do_timings) call psb_toc(idx_spspmm)      
     call acsr3%free()
+  end if
 
   call psb_cdasb(desc_ac,info)
 

mlprec/impl/aggregator/mld_caggrmat_minnrg_bld.f90

@@ -104,7 +104,8 @@
 !                  Error code.
 !
 !
-subroutine mld_caggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
+subroutine mld_caggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
+     & ac,desc_ac,op_prol,op_restr,info)
   use psb_base_mod
   use mld_base_prec_type
   use mld_c_inner_mod, mld_protect_name => mld_caggrmat_minnrg_bld
@@ -113,11 +114,12 @@ subroutine mld_caggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
 
   ! Arguments
   type(psb_cspmat_type), intent(in)           :: a
-  type(psb_desc_type), intent(in)               :: desc_a
+  type(psb_desc_type), intent(inout)            :: desc_a
   integer(psb_lpk_), intent(inout)              :: ilaggr(:), nlaggr(:)
   type(mld_sml_parms), intent(inout)         :: parms 
   type(psb_lcspmat_type), intent(inout)       :: op_prol
   type(psb_lcspmat_type), intent(out)         :: ac,op_restr
+  type(psb_desc_type), intent(inout)            :: desc_ac
   integer(psb_ipk_), intent(out)                :: info
 
   ! Local variables

mlprec/impl/aggregator/mld_caggrmat_nosmth_bld.f90

@@ -106,7 +106,7 @@ subroutine mld_caggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,&
 
   ! Arguments
   type(psb_cspmat_type), intent(in)        :: a
-  type(psb_desc_type), intent(in)            :: desc_a
+  type(psb_desc_type), intent(inout)         :: desc_a
   integer(psb_lpk_), intent(inout)           :: ilaggr(:), nlaggr(:)
   type(mld_sml_parms), intent(inout)      :: parms 
   type(psb_lcspmat_type), intent(inout)    :: op_prol

mlprec/impl/aggregator/mld_caggrmat_smth_bld.f90

@@ -113,7 +113,7 @@ subroutine mld_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
 
   ! Arguments
   type(psb_cspmat_type), intent(in)      :: a
-  type(psb_desc_type), intent(in)          :: desc_a
+  type(psb_desc_type), intent(inout)       :: desc_a
   integer(psb_lpk_), intent(inout)         :: ilaggr(:), nlaggr(:)
   type(mld_sml_parms), intent(inout)      :: parms 
   type(psb_lcspmat_type), intent(inout)    :: op_prol

mlprec/impl/aggregator/mld_d_ptap.f90

@@ -36,7 +36,7 @@
 !
 !
 subroutine mld_d_ptap(a_csr,desc_a,nlaggr,parms,ac,&
-     & coo_prol,desc_ac,coo_restr,info)
+     & coo_prol,desc_ac,coo_restr,info,desc_ax)
   use psb_base_mod
   use mld_d_inner_mod
   use mld_d_base_aggregator_mod, mld_protect_name => mld_d_ptap
@@ -44,13 +44,14 @@ subroutine mld_d_ptap(a_csr,desc_a,nlaggr,parms,ac,&
 
   ! Arguments
   type(psb_d_csr_sparse_mat), intent(inout) :: a_csr
-  type(psb_desc_type), intent(in)            :: desc_a
+  type(psb_desc_type), intent(inout)          :: desc_a
   integer(psb_lpk_), intent(inout)           :: nlaggr(:)
   type(mld_dml_parms), intent(inout)         :: parms 
   type(psb_ld_coo_sparse_mat), intent(inout)  :: coo_prol, coo_restr
   type(psb_desc_type), intent(inout)         :: desc_ac
   type(psb_ldspmat_type), intent(out)        :: ac
   integer(psb_ipk_), intent(out)             :: info
+  type(psb_desc_type), intent(inout), optional :: desc_ax
 
   ! Local variables
   integer(psb_ipk_)  :: err_act
@@ -115,6 +116,47 @@ subroutine mld_d_ptap(a_csr,desc_a,nlaggr,parms,ac,&
 
   !
   ! Ok first product done.
+
+  if (present(desc_ax)) then
+    block 
+      type(psb_d_coo_sparse_mat) :: icoo_restr
+
+      call coo_prol%cp_to_icoo(icoo_restr,info)
+      call icoo_restr%set_ncols(desc_ac%get_local_cols())
+      call icoo_restr%set_nrows(desc_a%get_local_rows())
+      call psb_d_coo_glob_transpose(icoo_restr,desc_a,info,desc_c=desc_ac,desc_rx=desc_ax)
+      call icoo_restr%set_nrows(desc_ac%get_local_rows())
+      call icoo_restr%set_ncols(desc_ax%get_local_cols())
+      write(0,*) me,' ',trim(name),' check on glob_transpose 1: ',&
+           & desc_a%get_local_cols(),desc_ax%get_local_cols(),icoo_restr%get_nzeros()
+      if (desc_a%get_local_cols()<desc_ax%get_local_cols()) then
+        write(0,*) me,' ',trim(name),' WARNING: GLOB_TRANSPOSE NEW INDICES '
+      end if
+      call coo_restr%cp_from_icoo(icoo_restr,info)
+    end block
+    call csr_restr%cp_from_lcoo(coo_restr,info)
+
+!!$      write(0,*)me,' ',name,' after transposition ',coo_restr%get_nrows(),coo_restr%get_ncols(),coo_restr%get_nzeros()
+
+    if (info /= psb_success_) then 
+      call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
+      goto 9999
+    end if
+    if (debug_level >= psb_debug_outer_) &
+         & write(debug_unit,*) me,' ',trim(name),&
+         & 'starting sphalo/ rwxtd'
+
+    if (debug) write(0,*) me,trim(name),' Product RESTRxAP ',&
+         & csr_restr%get_nrows(),csr_restr%get_ncols(), &
+         & desc_ac%get_local_rows(),desc_a%get_local_cols(),&
+         & acsr3%get_nrows(),acsr3%get_ncols()
+    if (do_timings) call psb_tic(idx_spspmm)      
+    call psb_par_spspmm(csr_restr,desc_ax,acsr3,ac_csr,desc_ac,info)
+    if (do_timings) call psb_toc(idx_spspmm)      
+    call acsr3%free()
+
+  else
+
     !
     ! Remember that RESTR must be built from PROL after halo extension,
     ! which is done above in psb_par_spspmm
@@ -166,6 +208,7 @@ subroutine mld_d_ptap(a_csr,desc_a,nlaggr,parms,ac,&
     call psb_par_spspmm(csr_restr,desc_a,acsr3,ac_csr,desc_ac,info)
     if (do_timings) call psb_toc(idx_spspmm)      
     call acsr3%free()
+  end if
 
   call psb_cdasb(desc_ac,info)
 
@@ -175,11 +218,10 @@ subroutine mld_d_ptap(a_csr,desc_a,nlaggr,parms,ac,&
   call ac%set_asb()
 
   if (debug) write(0,*)  me,' ',trim(name),' After  mv_from',psb_get_errstatus()
-  if (debug) write(0,*)  me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),&
-       & ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr
+  if (debug) write(0,*)  me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr
+  ! write(0,*)  me,' ',trim(name),' Final AC newstyle ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros()
 
   call coo_prol%set_ncols(desc_ac%get_local_cols())
-  
   if (debug) call check_coo(me,trim(name)//' Check 3 on coo_restr:',coo_restr)
 
   if (debug_level >= psb_debug_outer_) &
@@ -211,7 +253,7 @@ contains
 end subroutine mld_d_ptap
 
 subroutine mld_ld_ptap(a_csr,desc_a,nlaggr,parms,ac,&
-     & coo_prol,desc_ac,coo_restr,info)
+     & coo_prol,desc_ac,coo_restr,info,desc_ax)
   use psb_base_mod
   use mld_d_inner_mod
   use mld_d_base_aggregator_mod, mld_protect_name => mld_ld_ptap
@@ -219,13 +261,14 @@ subroutine mld_ld_ptap(a_csr,desc_a,nlaggr,parms,ac,&
 
   ! Arguments
   type(psb_ld_csr_sparse_mat), intent(inout) :: a_csr
-  type(psb_desc_type), intent(in)            :: desc_a
+  type(psb_desc_type), intent(inout)           :: desc_a
   integer(psb_lpk_), intent(inout)           :: nlaggr(:)
   type(mld_dml_parms), intent(inout)         :: parms 
   type(psb_ld_coo_sparse_mat), intent(inout)  :: coo_prol, coo_restr
   type(psb_desc_type), intent(inout)         :: desc_ac
   type(psb_ldspmat_type), intent(out)        :: ac
   integer(psb_ipk_), intent(out)             :: info
+  type(psb_desc_type), intent(inout), optional :: desc_ax
 
   ! Local variables
   integer(psb_ipk_)  :: err_act
@@ -290,6 +333,47 @@ subroutine mld_ld_ptap(a_csr,desc_a,nlaggr,parms,ac,&
 
   !
   ! Ok first product done.
+
+  if (present(desc_ax)) then
+    block 
+      type(psb_d_coo_sparse_mat) :: icoo_restr
+
+      call coo_prol%cp_to_icoo(icoo_restr,info)
+      call icoo_restr%set_ncols(desc_ac%get_local_cols())
+      call icoo_restr%set_nrows(desc_a%get_local_rows())
+      call psb_d_coo_glob_transpose(icoo_restr,desc_a,info,desc_c=desc_ac,desc_rx=desc_ax)
+      call icoo_restr%set_nrows(desc_ac%get_local_rows())
+      call icoo_restr%set_ncols(desc_ax%get_local_cols())
+      write(0,*) me,' ',trim(name),' check on glob_transpose 1: ',&
+           & desc_a%get_local_cols(),desc_ax%get_local_cols(),icoo_restr%get_nzeros()
+      if (desc_a%get_local_cols()<desc_ax%get_local_cols()) then
+        write(0,*) me,' ',trim(name),' WARNING: GLOB_TRANSPOSE NEW INDICES '
+      end if
+      call coo_restr%cp_from_icoo(icoo_restr,info)
+    end block
+    call csr_restr%cp_from_coo(coo_restr,info)
+
+!!$      write(0,*)me,' ',name,' after transposition ',coo_restr%get_nrows(),coo_restr%get_ncols(),coo_restr%get_nzeros()
+
+    if (info /= psb_success_) then 
+      call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
+      goto 9999
+    end if
+    if (debug_level >= psb_debug_outer_) &
+         & write(debug_unit,*) me,' ',trim(name),&
+         & 'starting sphalo/ rwxtd'
+
+    if (debug) write(0,*) me,trim(name),' Product RESTRxAP ',&
+         & csr_restr%get_nrows(),csr_restr%get_ncols(), &
+         & desc_ac%get_local_rows(),desc_a%get_local_cols(),&
+         & acsr3%get_nrows(),acsr3%get_ncols()
+    if (do_timings) call psb_tic(idx_spspmm)      
+    call psb_par_spspmm(csr_restr,desc_ax,acsr3,ac_csr,desc_ac,info)
+    if (do_timings) call psb_toc(idx_spspmm)      
+    call acsr3%free()
+
+  else
+
     !
     ! Remember that RESTR must be built from PROL after halo extension,
     ! which is done above in psb_par_spspmm
@@ -341,6 +425,7 @@ subroutine mld_ld_ptap(a_csr,desc_a,nlaggr,parms,ac,&
     call psb_par_spspmm(csr_restr,desc_a,acsr3,ac_csr,desc_ac,info)
     if (do_timings) call psb_toc(idx_spspmm)      
     call acsr3%free()
+  end if
 
   call psb_cdasb(desc_ac,info)
 

mlprec/impl/aggregator/mld_daggrmat_minnrg_bld.f90

@@ -104,7 +104,8 @@
 !                  Error code.
 !
 !
-subroutine mld_daggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
+subroutine mld_daggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
+     & ac,desc_ac,op_prol,op_restr,info)
   use psb_base_mod
   use mld_base_prec_type
   use mld_d_inner_mod, mld_protect_name => mld_daggrmat_minnrg_bld
@@ -113,11 +114,12 @@ subroutine mld_daggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
 
   ! Arguments
   type(psb_dspmat_type), intent(in)           :: a
-  type(psb_desc_type), intent(in)               :: desc_a
+  type(psb_desc_type), intent(inout)            :: desc_a
   integer(psb_lpk_), intent(inout)              :: ilaggr(:), nlaggr(:)
   type(mld_dml_parms), intent(inout)         :: parms 
   type(psb_ldspmat_type), intent(inout)       :: op_prol
   type(psb_ldspmat_type), intent(out)         :: ac,op_restr
+  type(psb_desc_type), intent(inout)            :: desc_ac
   integer(psb_ipk_), intent(out)                :: info
 
   ! Local variables

mlprec/impl/aggregator/mld_daggrmat_nosmth_bld.f90

@@ -106,7 +106,7 @@ subroutine mld_daggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,&
 
   ! Arguments
   type(psb_dspmat_type), intent(in)        :: a
-  type(psb_desc_type), intent(in)            :: desc_a
+  type(psb_desc_type), intent(inout)         :: desc_a
   integer(psb_lpk_), intent(inout)           :: ilaggr(:), nlaggr(:)
   type(mld_dml_parms), intent(inout)      :: parms 
   type(psb_ldspmat_type), intent(inout)    :: op_prol

mlprec/impl/aggregator/mld_daggrmat_smth_bld.f90

@@ -113,7 +113,7 @@ subroutine mld_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
 
   ! Arguments
   type(psb_dspmat_type), intent(in)      :: a
-  type(psb_desc_type), intent(in)          :: desc_a
+  type(psb_desc_type), intent(inout)       :: desc_a
   integer(psb_lpk_), intent(inout)         :: ilaggr(:), nlaggr(:)
   type(mld_dml_parms), intent(inout)      :: parms 
   type(psb_ldspmat_type), intent(inout)    :: op_prol

mlprec/impl/aggregator/mld_s_ptap.f90

@@ -36,7 +36,7 @@
 !
 !
 subroutine mld_s_ptap(a_csr,desc_a,nlaggr,parms,ac,&
-     & coo_prol,desc_ac,coo_restr,info)
+     & coo_prol,desc_ac,coo_restr,info,desc_ax)
   use psb_base_mod
   use mld_s_inner_mod
   use mld_s_base_aggregator_mod, mld_protect_name => mld_s_ptap
@@ -44,13 +44,14 @@ subroutine mld_s_ptap(a_csr,desc_a,nlaggr,parms,ac,&
 
   ! Arguments
   type(psb_s_csr_sparse_mat), intent(inout) :: a_csr
-  type(psb_desc_type), intent(in)            :: desc_a
+  type(psb_desc_type), intent(inout)          :: desc_a
   integer(psb_lpk_), intent(inout)           :: nlaggr(:)
   type(mld_sml_parms), intent(inout)         :: parms 
   type(psb_ls_coo_sparse_mat), intent(inout)  :: coo_prol, coo_restr
   type(psb_desc_type), intent(inout)         :: desc_ac
   type(psb_lsspmat_type), intent(out)        :: ac
   integer(psb_ipk_), intent(out)             :: info
+  type(psb_desc_type), intent(inout), optional :: desc_ax
 
   ! Local variables
   integer(psb_ipk_)  :: err_act
@@ -115,6 +116,47 @@ subroutine mld_s_ptap(a_csr,desc_a,nlaggr,parms,ac,&
 
   !
   ! Ok first product done.
+
+  if (present(desc_ax)) then
+    block 
+      type(psb_s_coo_sparse_mat) :: icoo_restr
+
+      call coo_prol%cp_to_icoo(icoo_restr,info)
+      call icoo_restr%set_ncols(desc_ac%get_local_cols())
+      call icoo_restr%set_nrows(desc_a%get_local_rows())
+      call psb_s_coo_glob_transpose(icoo_restr,desc_a,info,desc_c=desc_ac,desc_rx=desc_ax)
+      call icoo_restr%set_nrows(desc_ac%get_local_rows())
+      call icoo_restr%set_ncols(desc_ax%get_local_cols())
+      write(0,*) me,' ',trim(name),' check on glob_transpose 1: ',&
+           & desc_a%get_local_cols(),desc_ax%get_local_cols(),icoo_restr%get_nzeros()
+      if (desc_a%get_local_cols()<desc_ax%get_local_cols()) then
+        write(0,*) me,' ',trim(name),' WARNING: GLOB_TRANSPOSE NEW INDICES '
+      end if
+      call coo_restr%cp_from_icoo(icoo_restr,info)
+    end block
+    call csr_restr%cp_from_lcoo(coo_restr,info)
+
+!!$      write(0,*)me,' ',name,' after transposition ',coo_restr%get_nrows(),coo_restr%get_ncols(),coo_restr%get_nzeros()
+
+    if (info /= psb_success_) then 
+      call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
+      goto 9999
+    end if
+    if (debug_level >= psb_debug_outer_) &
+         & write(debug_unit,*) me,' ',trim(name),&
+         & 'starting sphalo/ rwxtd'
+
+    if (debug) write(0,*) me,trim(name),' Product RESTRxAP ',&
+         & csr_restr%get_nrows(),csr_restr%get_ncols(), &
+         & desc_ac%get_local_rows(),desc_a%get_local_cols(),&
+         & acsr3%get_nrows(),acsr3%get_ncols()
+    if (do_timings) call psb_tic(idx_spspmm)      
+    call psb_par_spspmm(csr_restr,desc_ax,acsr3,ac_csr,desc_ac,info)
+    if (do_timings) call psb_toc(idx_spspmm)      
+    call acsr3%free()
+
+  else
+
     !
     ! Remember that RESTR must be built from PROL after halo extension,
     ! which is done above in psb_par_spspmm
@@ -166,6 +208,7 @@ subroutine mld_s_ptap(a_csr,desc_a,nlaggr,parms,ac,&
     call psb_par_spspmm(csr_restr,desc_a,acsr3,ac_csr,desc_ac,info)
     if (do_timings) call psb_toc(idx_spspmm)      
     call acsr3%free()
+  end if
 
   call psb_cdasb(desc_ac,info)
 
@@ -175,11 +218,10 @@ subroutine mld_s_ptap(a_csr,desc_a,nlaggr,parms,ac,&
   call ac%set_asb()
 
   if (debug) write(0,*)  me,' ',trim(name),' After  mv_from',psb_get_errstatus()
-  if (debug) write(0,*)  me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),&
-       & ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr
+  if (debug) write(0,*)  me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr
+  ! write(0,*)  me,' ',trim(name),' Final AC newstyle ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros()
 
   call coo_prol%set_ncols(desc_ac%get_local_cols())
-  
   if (debug) call check_coo(me,trim(name)//' Check 3 on coo_restr:',coo_restr)
 
   if (debug_level >= psb_debug_outer_) &
@@ -211,7 +253,7 @@ contains
 end subroutine mld_s_ptap
 
 subroutine mld_ls_ptap(a_csr,desc_a,nlaggr,parms,ac,&
-     & coo_prol,desc_ac,coo_restr,info)
+     & coo_prol,desc_ac,coo_restr,info,desc_ax)
   use psb_base_mod
   use mld_s_inner_mod
   use mld_s_base_aggregator_mod, mld_protect_name => mld_ls_ptap
@@ -219,13 +261,14 @@ subroutine mld_ls_ptap(a_csr,desc_a,nlaggr,parms,ac,&
 
   ! Arguments
   type(psb_ls_csr_sparse_mat), intent(inout) :: a_csr
-  type(psb_desc_type), intent(in)            :: desc_a
+  type(psb_desc_type), intent(inout)           :: desc_a
   integer(psb_lpk_), intent(inout)           :: nlaggr(:)
   type(mld_sml_parms), intent(inout)         :: parms 
   type(psb_ls_coo_sparse_mat), intent(inout)  :: coo_prol, coo_restr
   type(psb_desc_type), intent(inout)         :: desc_ac
   type(psb_lsspmat_type), intent(out)        :: ac
   integer(psb_ipk_), intent(out)             :: info
+  type(psb_desc_type), intent(inout), optional :: desc_ax
 
   ! Local variables
   integer(psb_ipk_)  :: err_act
@@ -290,6 +333,47 @@ subroutine mld_ls_ptap(a_csr,desc_a,nlaggr,parms,ac,&
 
   !
   ! Ok first product done.
+
+  if (present(desc_ax)) then
+    block 
+      type(psb_s_coo_sparse_mat) :: icoo_restr
+
+      call coo_prol%cp_to_icoo(icoo_restr,info)
+      call icoo_restr%set_ncols(desc_ac%get_local_cols())
+      call icoo_restr%set_nrows(desc_a%get_local_rows())
+      call psb_s_coo_glob_transpose(icoo_restr,desc_a,info,desc_c=desc_ac,desc_rx=desc_ax)
+      call icoo_restr%set_nrows(desc_ac%get_local_rows())
+      call icoo_restr%set_ncols(desc_ax%get_local_cols())
+      write(0,*) me,' ',trim(name),' check on glob_transpose 1: ',&
+           & desc_a%get_local_cols(),desc_ax%get_local_cols(),icoo_restr%get_nzeros()
+      if (desc_a%get_local_cols()<desc_ax%get_local_cols()) then
+        write(0,*) me,' ',trim(name),' WARNING: GLOB_TRANSPOSE NEW INDICES '
+      end if
+      call coo_restr%cp_from_icoo(icoo_restr,info)
+    end block
+    call csr_restr%cp_from_coo(coo_restr,info)
+
+!!$      write(0,*)me,' ',name,' after transposition ',coo_restr%get_nrows(),coo_restr%get_ncols(),coo_restr%get_nzeros()
+
+    if (info /= psb_success_) then 
+      call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
+      goto 9999
+    end if
+    if (debug_level >= psb_debug_outer_) &
+         & write(debug_unit,*) me,' ',trim(name),&
+         & 'starting sphalo/ rwxtd'
+
+    if (debug) write(0,*) me,trim(name),' Product RESTRxAP ',&
+         & csr_restr%get_nrows(),csr_restr%get_ncols(), &
+         & desc_ac%get_local_rows(),desc_a%get_local_cols(),&
+         & acsr3%get_nrows(),acsr3%get_ncols()
+    if (do_timings) call psb_tic(idx_spspmm)      
+    call psb_par_spspmm(csr_restr,desc_ax,acsr3,ac_csr,desc_ac,info)
+    if (do_timings) call psb_toc(idx_spspmm)      
+    call acsr3%free()
+
+  else
+
     !
     ! Remember that RESTR must be built from PROL after halo extension,
     ! which is done above in psb_par_spspmm
@@ -341,6 +425,7 @@ subroutine mld_ls_ptap(a_csr,desc_a,nlaggr,parms,ac,&
     call psb_par_spspmm(csr_restr,desc_a,acsr3,ac_csr,desc_ac,info)
     if (do_timings) call psb_toc(idx_spspmm)      
     call acsr3%free()
+  end if
 
   call psb_cdasb(desc_ac,info)
 

mlprec/impl/aggregator/mld_saggrmat_minnrg_bld.f90

@@ -104,7 +104,8 @@
 !                  Error code.
 !
 !
-subroutine mld_saggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
+subroutine mld_saggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
+     & ac,desc_ac,op_prol,op_restr,info)
   use psb_base_mod
   use mld_base_prec_type
   use mld_s_inner_mod, mld_protect_name => mld_saggrmat_minnrg_bld
@@ -113,11 +114,12 @@ subroutine mld_saggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
 
   ! Arguments
   type(psb_sspmat_type), intent(in)           :: a
-  type(psb_desc_type), intent(in)               :: desc_a
+  type(psb_desc_type), intent(inout)            :: desc_a
   integer(psb_lpk_), intent(inout)              :: ilaggr(:), nlaggr(:)
   type(mld_sml_parms), intent(inout)         :: parms 
   type(psb_lsspmat_type), intent(inout)       :: op_prol
   type(psb_lsspmat_type), intent(out)         :: ac,op_restr
+  type(psb_desc_type), intent(inout)            :: desc_ac
   integer(psb_ipk_), intent(out)                :: info
 
   ! Local variables

mlprec/impl/aggregator/mld_saggrmat_nosmth_bld.f90

@@ -106,7 +106,7 @@ subroutine mld_saggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,&
 
   ! Arguments
   type(psb_sspmat_type), intent(in)        :: a
-  type(psb_desc_type), intent(in)            :: desc_a
+  type(psb_desc_type), intent(inout)         :: desc_a
   integer(psb_lpk_), intent(inout)           :: ilaggr(:), nlaggr(:)
   type(mld_sml_parms), intent(inout)      :: parms 
   type(psb_lsspmat_type), intent(inout)    :: op_prol

mlprec/impl/aggregator/mld_saggrmat_smth_bld.f90

@@ -113,7 +113,7 @@ subroutine mld_saggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
 
   ! Arguments
   type(psb_sspmat_type), intent(in)      :: a
-  type(psb_desc_type), intent(in)          :: desc_a
+  type(psb_desc_type), intent(inout)       :: desc_a
   integer(psb_lpk_), intent(inout)         :: ilaggr(:), nlaggr(:)
   type(mld_sml_parms), intent(inout)      :: parms 
   type(psb_lsspmat_type), intent(inout)    :: op_prol

mlprec/impl/aggregator/mld_z_ptap.f90

@@ -36,7 +36,7 @@
 !
 !
 subroutine mld_z_ptap(a_csr,desc_a,nlaggr,parms,ac,&
-     & coo_prol,desc_ac,coo_restr,info)
+     & coo_prol,desc_ac,coo_restr,info,desc_ax)
   use psb_base_mod
   use mld_z_inner_mod
   use mld_z_base_aggregator_mod, mld_protect_name => mld_z_ptap
@@ -44,13 +44,14 @@ subroutine mld_z_ptap(a_csr,desc_a,nlaggr,parms,ac,&
 
   ! Arguments
   type(psb_z_csr_sparse_mat), intent(inout) :: a_csr
-  type(psb_desc_type), intent(in)            :: desc_a
+  type(psb_desc_type), intent(inout)          :: desc_a
   integer(psb_lpk_), intent(inout)           :: nlaggr(:)
   type(mld_dml_parms), intent(inout)         :: parms 
   type(psb_lz_coo_sparse_mat), intent(inout)  :: coo_prol, coo_restr
   type(psb_desc_type), intent(inout)         :: desc_ac
   type(psb_lzspmat_type), intent(out)        :: ac
   integer(psb_ipk_), intent(out)             :: info
+  type(psb_desc_type), intent(inout), optional :: desc_ax
 
   ! Local variables
   integer(psb_ipk_)  :: err_act
@@ -115,6 +116,47 @@ subroutine mld_z_ptap(a_csr,desc_a,nlaggr,parms,ac,&
 
   !
   ! Ok first product done.
+
+  if (present(desc_ax)) then
+    block 
+      type(psb_z_coo_sparse_mat) :: icoo_restr
+
+      call coo_prol%cp_to_icoo(icoo_restr,info)
+      call icoo_restr%set_ncols(desc_ac%get_local_cols())
+      call icoo_restr%set_nrows(desc_a%get_local_rows())
+      call psb_z_coo_glob_transpose(icoo_restr,desc_a,info,desc_c=desc_ac,desc_rx=desc_ax)
+      call icoo_restr%set_nrows(desc_ac%get_local_rows())
+      call icoo_restr%set_ncols(desc_ax%get_local_cols())
+      write(0,*) me,' ',trim(name),' check on glob_transpose 1: ',&
+           & desc_a%get_local_cols(),desc_ax%get_local_cols(),icoo_restr%get_nzeros()
+      if (desc_a%get_local_cols()<desc_ax%get_local_cols()) then
+        write(0,*) me,' ',trim(name),' WARNING: GLOB_TRANSPOSE NEW INDICES '
+      end if
+      call coo_restr%cp_from_icoo(icoo_restr,info)
+    end block
+    call csr_restr%cp_from_lcoo(coo_restr,info)
+
+!!$      write(0,*)me,' ',name,' after transposition ',coo_restr%get_nrows(),coo_restr%get_ncols(),coo_restr%get_nzeros()
+
+    if (info /= psb_success_) then 
+      call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
+      goto 9999
+    end if
+    if (debug_level >= psb_debug_outer_) &
+         & write(debug_unit,*) me,' ',trim(name),&
+         & 'starting sphalo/ rwxtd'
+
+    if (debug) write(0,*) me,trim(name),' Product RESTRxAP ',&
+         & csr_restr%get_nrows(),csr_restr%get_ncols(), &
+         & desc_ac%get_local_rows(),desc_a%get_local_cols(),&
+         & acsr3%get_nrows(),acsr3%get_ncols()
+    if (do_timings) call psb_tic(idx_spspmm)      
+    call psb_par_spspmm(csr_restr,desc_ax,acsr3,ac_csr,desc_ac,info)
+    if (do_timings) call psb_toc(idx_spspmm)      
+    call acsr3%free()
+
+  else
+
     !
     ! Remember that RESTR must be built from PROL after halo extension,
     ! which is done above in psb_par_spspmm
@@ -166,6 +208,7 @@ subroutine mld_z_ptap(a_csr,desc_a,nlaggr,parms,ac,&
     call psb_par_spspmm(csr_restr,desc_a,acsr3,ac_csr,desc_ac,info)
     if (do_timings) call psb_toc(idx_spspmm)      
     call acsr3%free()
+  end if
 
   call psb_cdasb(desc_ac,info)
 
@@ -175,11 +218,10 @@ subroutine mld_z_ptap(a_csr,desc_a,nlaggr,parms,ac,&
   call ac%set_asb()
 
   if (debug) write(0,*)  me,' ',trim(name),' After  mv_from',psb_get_errstatus()
-  if (debug) write(0,*)  me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),&
-       & ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr
+  if (debug) write(0,*)  me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr
+  ! write(0,*)  me,' ',trim(name),' Final AC newstyle ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros()
 
   call coo_prol%set_ncols(desc_ac%get_local_cols())
-  
   if (debug) call check_coo(me,trim(name)//' Check 3 on coo_restr:',coo_restr)
 
   if (debug_level >= psb_debug_outer_) &
@@ -211,7 +253,7 @@ contains
 end subroutine mld_z_ptap
 
 subroutine mld_lz_ptap(a_csr,desc_a,nlaggr,parms,ac,&
-     & coo_prol,desc_ac,coo_restr,info)
+     & coo_prol,desc_ac,coo_restr,info,desc_ax)
   use psb_base_mod
   use mld_z_inner_mod
   use mld_z_base_aggregator_mod, mld_protect_name => mld_lz_ptap
@@ -219,13 +261,14 @@ subroutine mld_lz_ptap(a_csr,desc_a,nlaggr,parms,ac,&
 
   ! Arguments
   type(psb_lz_csr_sparse_mat), intent(inout) :: a_csr
-  type(psb_desc_type), intent(in)            :: desc_a
+  type(psb_desc_type), intent(inout)           :: desc_a
   integer(psb_lpk_), intent(inout)           :: nlaggr(:)
   type(mld_dml_parms), intent(inout)         :: parms 
   type(psb_lz_coo_sparse_mat), intent(inout)  :: coo_prol, coo_restr
   type(psb_desc_type), intent(inout)         :: desc_ac
   type(psb_lzspmat_type), intent(out)        :: ac
   integer(psb_ipk_), intent(out)             :: info
+  type(psb_desc_type), intent(inout), optional :: desc_ax
 
   ! Local variables
   integer(psb_ipk_)  :: err_act
@@ -290,6 +333,47 @@ subroutine mld_lz_ptap(a_csr,desc_a,nlaggr,parms,ac,&
 
   !
   ! Ok first product done.
+
+  if (present(desc_ax)) then
+    block 
+      type(psb_z_coo_sparse_mat) :: icoo_restr
+
+      call coo_prol%cp_to_icoo(icoo_restr,info)
+      call icoo_restr%set_ncols(desc_ac%get_local_cols())
+      call icoo_restr%set_nrows(desc_a%get_local_rows())
+      call psb_z_coo_glob_transpose(icoo_restr,desc_a,info,desc_c=desc_ac,desc_rx=desc_ax)
+      call icoo_restr%set_nrows(desc_ac%get_local_rows())
+      call icoo_restr%set_ncols(desc_ax%get_local_cols())
+      write(0,*) me,' ',trim(name),' check on glob_transpose 1: ',&
+           & desc_a%get_local_cols(),desc_ax%get_local_cols(),icoo_restr%get_nzeros()
+      if (desc_a%get_local_cols()<desc_ax%get_local_cols()) then
+        write(0,*) me,' ',trim(name),' WARNING: GLOB_TRANSPOSE NEW INDICES '
+      end if
+      call coo_restr%cp_from_icoo(icoo_restr,info)
+    end block
+    call csr_restr%cp_from_coo(coo_restr,info)
+
+!!$      write(0,*)me,' ',name,' after transposition ',coo_restr%get_nrows(),coo_restr%get_ncols(),coo_restr%get_nzeros()
+
+    if (info /= psb_success_) then 
+      call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
+      goto 9999
+    end if
+    if (debug_level >= psb_debug_outer_) &
+         & write(debug_unit,*) me,' ',trim(name),&
+         & 'starting sphalo/ rwxtd'
+
+    if (debug) write(0,*) me,trim(name),' Product RESTRxAP ',&
+         & csr_restr%get_nrows(),csr_restr%get_ncols(), &
+         & desc_ac%get_local_rows(),desc_a%get_local_cols(),&
+         & acsr3%get_nrows(),acsr3%get_ncols()
+    if (do_timings) call psb_tic(idx_spspmm)      
+    call psb_par_spspmm(csr_restr,desc_ax,acsr3,ac_csr,desc_ac,info)
+    if (do_timings) call psb_toc(idx_spspmm)      
+    call acsr3%free()
+
+  else
+
     !
     ! Remember that RESTR must be built from PROL after halo extension,
     ! which is done above in psb_par_spspmm
@@ -341,6 +425,7 @@ subroutine mld_lz_ptap(a_csr,desc_a,nlaggr,parms,ac,&
     call psb_par_spspmm(csr_restr,desc_a,acsr3,ac_csr,desc_ac,info)
     if (do_timings) call psb_toc(idx_spspmm)      
     call acsr3%free()
+  end if
 
   call psb_cdasb(desc_ac,info)
 

mlprec/impl/aggregator/mld_zaggrmat_minnrg_bld.f90

@@ -104,7 +104,8 @@
 !                  Error code.
 !
 !
-subroutine mld_zaggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
+subroutine mld_zaggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
+     & ac,desc_ac,op_prol,op_restr,info)
   use psb_base_mod
   use mld_base_prec_type
   use mld_z_inner_mod, mld_protect_name => mld_zaggrmat_minnrg_bld
@@ -113,11 +114,12 @@ subroutine mld_zaggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
 
   ! Arguments
   type(psb_zspmat_type), intent(in)           :: a
-  type(psb_desc_type), intent(in)               :: desc_a
+  type(psb_desc_type), intent(inout)            :: desc_a
   integer(psb_lpk_), intent(inout)              :: ilaggr(:), nlaggr(:)
   type(mld_dml_parms), intent(inout)         :: parms 
   type(psb_lzspmat_type), intent(inout)       :: op_prol
   type(psb_lzspmat_type), intent(out)         :: ac,op_restr
+  type(psb_desc_type), intent(inout)            :: desc_ac
   integer(psb_ipk_), intent(out)                :: info
 
   ! Local variables

mlprec/impl/aggregator/mld_zaggrmat_nosmth_bld.f90

@@ -106,7 +106,7 @@ subroutine mld_zaggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,&
 
   ! Arguments
   type(psb_zspmat_type), intent(in)        :: a
-  type(psb_desc_type), intent(in)            :: desc_a
+  type(psb_desc_type), intent(inout)         :: desc_a
   integer(psb_lpk_), intent(inout)           :: ilaggr(:), nlaggr(:)
   type(mld_dml_parms), intent(inout)      :: parms 
   type(psb_lzspmat_type), intent(inout)    :: op_prol

mlprec/impl/aggregator/mld_zaggrmat_smth_bld.f90

@@ -113,7 +113,7 @@ subroutine mld_zaggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
 
   ! Arguments
   type(psb_zspmat_type), intent(in)      :: a
-  type(psb_desc_type), intent(in)          :: desc_a
+  type(psb_desc_type), intent(inout)       :: desc_a
   integer(psb_lpk_), intent(inout)         :: ilaggr(:), nlaggr(:)
   type(mld_dml_parms), intent(inout)      :: parms 
   type(psb_lzspmat_type), intent(inout)    :: op_prol

mlprec/mld_c_base_aggregator_mod.f90

@@ -152,7 +152,7 @@ module mld_c_base_aggregator_mod
 
   interface mld_ptap
     subroutine mld_c_ptap(a_csr,desc_a,nlaggr,parms,ac,&
-         & coo_prol,desc_cprol,coo_restr,info)
+         & coo_prol,desc_cprol,coo_restr,info,desc_ax)
       import :: psb_c_csr_sparse_mat, psb_lcspmat_type, psb_desc_type, &
            & psb_lc_coo_sparse_mat, mld_sml_parms, psb_spk_, psb_ipk_, psb_lpk_
       implicit none
@@ -164,9 +164,10 @@ module mld_c_base_aggregator_mod
       type(psb_desc_type), intent(inout)         :: desc_cprol
       type(psb_lcspmat_type), intent(out)        :: ac
       integer(psb_ipk_), intent(out)             :: info
+      type(psb_desc_type), intent(inout), optional :: desc_ax
     end subroutine mld_c_ptap
     subroutine mld_lc_ptap(a_csr,desc_a,nlaggr,parms,ac,&
-         & coo_prol,desc_cprol,coo_restr,info)
+         & coo_prol,desc_cprol,coo_restr,info,desc_ax)
       import :: psb_lc_csr_sparse_mat, psb_lcspmat_type, psb_desc_type, &
            & psb_lc_coo_sparse_mat, mld_sml_parms, psb_spk_, psb_ipk_, psb_lpk_
       implicit none
@@ -178,6 +179,7 @@ module mld_c_base_aggregator_mod
       type(psb_desc_type), intent(inout)         :: desc_cprol
       type(psb_lcspmat_type), intent(out)        :: ac
       integer(psb_ipk_), intent(out)             :: info
+      type(psb_desc_type), intent(inout), optional :: desc_ax
     end subroutine mld_lc_ptap
   end interface mld_ptap
   

mlprec/mld_c_inner_mod.f90

@@ -115,7 +115,7 @@ module mld_c_inner_mod
       import ::  mld_c_onelev_type, mld_sml_parms
       implicit none 
       type(psb_cspmat_type), intent(in)         :: a
-      type(psb_desc_type), intent(in)             :: desc_a
+      type(psb_desc_type), intent(inout)          :: desc_a
       integer(psb_lpk_), intent(inout)            :: ilaggr(:), nlaggr(:)
       type(mld_sml_parms), intent(inout)        :: parms 
       type(psb_lcspmat_type), intent(inout)     :: op_prol

mlprec/mld_d_base_aggregator_mod.f90

@@ -152,7 +152,7 @@ module mld_d_base_aggregator_mod
 
   interface mld_ptap
     subroutine mld_d_ptap(a_csr,desc_a,nlaggr,parms,ac,&
-         & coo_prol,desc_cprol,coo_restr,info)
+         & coo_prol,desc_cprol,coo_restr,info,desc_ax)
       import :: psb_d_csr_sparse_mat, psb_ldspmat_type, psb_desc_type, &
            & psb_ld_coo_sparse_mat, mld_dml_parms, psb_dpk_, psb_ipk_, psb_lpk_
       implicit none
@@ -164,9 +164,10 @@ module mld_d_base_aggregator_mod
       type(psb_desc_type), intent(inout)         :: desc_cprol
       type(psb_ldspmat_type), intent(out)        :: ac
       integer(psb_ipk_), intent(out)             :: info
+      type(psb_desc_type), intent(inout), optional :: desc_ax
     end subroutine mld_d_ptap
     subroutine mld_ld_ptap(a_csr,desc_a,nlaggr,parms,ac,&
-         & coo_prol,desc_cprol,coo_restr,info)
+         & coo_prol,desc_cprol,coo_restr,info,desc_ax)
       import :: psb_ld_csr_sparse_mat, psb_ldspmat_type, psb_desc_type, &
            & psb_ld_coo_sparse_mat, mld_dml_parms, psb_dpk_, psb_ipk_, psb_lpk_
       implicit none
@@ -178,6 +179,7 @@ module mld_d_base_aggregator_mod
       type(psb_desc_type), intent(inout)         :: desc_cprol
       type(psb_ldspmat_type), intent(out)        :: ac
       integer(psb_ipk_), intent(out)             :: info
+      type(psb_desc_type), intent(inout), optional :: desc_ax
     end subroutine mld_ld_ptap
   end interface mld_ptap
   

mlprec/mld_d_inner_mod.f90

@@ -115,7 +115,7 @@ module mld_d_inner_mod
       import ::  mld_d_onelev_type, mld_dml_parms
       implicit none 
       type(psb_dspmat_type), intent(in)         :: a
-      type(psb_desc_type), intent(in)             :: desc_a
+      type(psb_desc_type), intent(inout)          :: desc_a
       integer(psb_lpk_), intent(inout)            :: ilaggr(:), nlaggr(:)
       type(mld_dml_parms), intent(inout)        :: parms 
       type(psb_ldspmat_type), intent(inout)     :: op_prol

mlprec/mld_s_base_aggregator_mod.f90

@@ -152,7 +152,7 @@ module mld_s_base_aggregator_mod
 
   interface mld_ptap
     subroutine mld_s_ptap(a_csr,desc_a,nlaggr,parms,ac,&
-         & coo_prol,desc_cprol,coo_restr,info)
+         & coo_prol,desc_cprol,coo_restr,info,desc_ax)
       import :: psb_s_csr_sparse_mat, psb_lsspmat_type, psb_desc_type, &
            & psb_ls_coo_sparse_mat, mld_sml_parms, psb_spk_, psb_ipk_, psb_lpk_
       implicit none
@@ -164,9 +164,10 @@ module mld_s_base_aggregator_mod
       type(psb_desc_type), intent(inout)         :: desc_cprol
       type(psb_lsspmat_type), intent(out)        :: ac
       integer(psb_ipk_), intent(out)             :: info
+      type(psb_desc_type), intent(inout), optional :: desc_ax
     end subroutine mld_s_ptap
     subroutine mld_ls_ptap(a_csr,desc_a,nlaggr,parms,ac,&
-         & coo_prol,desc_cprol,coo_restr,info)
+         & coo_prol,desc_cprol,coo_restr,info,desc_ax)
       import :: psb_ls_csr_sparse_mat, psb_lsspmat_type, psb_desc_type, &
            & psb_ls_coo_sparse_mat, mld_sml_parms, psb_spk_, psb_ipk_, psb_lpk_
       implicit none
@@ -178,6 +179,7 @@ module mld_s_base_aggregator_mod
       type(psb_desc_type), intent(inout)         :: desc_cprol
       type(psb_lsspmat_type), intent(out)        :: ac
       integer(psb_ipk_), intent(out)             :: info
+      type(psb_desc_type), intent(inout), optional :: desc_ax
     end subroutine mld_ls_ptap
   end interface mld_ptap
   

mlprec/mld_s_inner_mod.f90

@@ -115,7 +115,7 @@ module mld_s_inner_mod
       import ::  mld_s_onelev_type, mld_sml_parms
       implicit none 
       type(psb_sspmat_type), intent(in)         :: a
-      type(psb_desc_type), intent(in)             :: desc_a
+      type(psb_desc_type), intent(inout)          :: desc_a
       integer(psb_lpk_), intent(inout)            :: ilaggr(:), nlaggr(:)
       type(mld_sml_parms), intent(inout)        :: parms 
       type(psb_lsspmat_type), intent(inout)     :: op_prol

mlprec/mld_z_base_aggregator_mod.f90

@@ -152,7 +152,7 @@ module mld_z_base_aggregator_mod
 
   interface mld_ptap
     subroutine mld_z_ptap(a_csr,desc_a,nlaggr,parms,ac,&
-         & coo_prol,desc_cprol,coo_restr,info)
+         & coo_prol,desc_cprol,coo_restr,info,desc_ax)
       import :: psb_z_csr_sparse_mat, psb_lzspmat_type, psb_desc_type, &
            & psb_lz_coo_sparse_mat, mld_dml_parms, psb_dpk_, psb_ipk_, psb_lpk_
       implicit none
@@ -164,9 +164,10 @@ module mld_z_base_aggregator_mod
       type(psb_desc_type), intent(inout)         :: desc_cprol
       type(psb_lzspmat_type), intent(out)        :: ac
       integer(psb_ipk_), intent(out)             :: info
+      type(psb_desc_type), intent(inout), optional :: desc_ax
     end subroutine mld_z_ptap
     subroutine mld_lz_ptap(a_csr,desc_a,nlaggr,parms,ac,&
-         & coo_prol,desc_cprol,coo_restr,info)
+         & coo_prol,desc_cprol,coo_restr,info,desc_ax)
       import :: psb_lz_csr_sparse_mat, psb_lzspmat_type, psb_desc_type, &
            & psb_lz_coo_sparse_mat, mld_dml_parms, psb_dpk_, psb_ipk_, psb_lpk_
       implicit none
@@ -178,6 +179,7 @@ module mld_z_base_aggregator_mod
       type(psb_desc_type), intent(inout)         :: desc_cprol
       type(psb_lzspmat_type), intent(out)        :: ac
       integer(psb_ipk_), intent(out)             :: info
+      type(psb_desc_type), intent(inout), optional :: desc_ax
     end subroutine mld_lz_ptap
   end interface mld_ptap
   

mlprec/mld_z_inner_mod.f90

@@ -115,7 +115,7 @@ module mld_z_inner_mod
       import ::  mld_z_onelev_type, mld_dml_parms
       implicit none 
       type(psb_zspmat_type), intent(in)         :: a
-      type(psb_desc_type), intent(in)             :: desc_a
+      type(psb_desc_type), intent(inout)          :: desc_a
       integer(psb_lpk_), intent(inout)            :: ilaggr(:), nlaggr(:)
       type(mld_dml_parms), intent(inout)        :: parms 
       type(psb_lzspmat_type), intent(inout)     :: op_prol