Unify build of unsmoothed, adjust map_to_tprol.

mlprec/impl/aggregator/mld_c_map_to_tprol.f90

@@ -124,9 +124,9 @@ subroutine mld_c_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
     goto 9999
   end if
 
-  call tmpcoo%allocate(ncol,ntaggr,ncol)
+  call tmpcoo%allocate(nrow,ntaggr,ncol)
   k = 0 
-  do i=1,ncol
+  do i=1,nrow
     !
     ! Note: at this point, a value ilaggr(i)<=0
     ! tags a "singleton" row, and it has to be

mlprec/impl/aggregator/mld_c_spmm_bld_inner.f90

@@ -63,7 +63,7 @@ subroutine mld_c_spmm_bld_inner(a_csr,desc_a,nlaggr,parms,ac,&
   integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzl, ip, &
        &  nzt, naggrm1, naggrp1, i, k
   integer(psb_lpk_) ::  nrsave, ncsave, nzsave, nza
-  logical, parameter :: do_timings=.true., oldstyle=.false., debug=.false.  
+  logical, parameter :: do_timings=.false., oldstyle=.false., debug=.false.  
   integer(psb_ipk_), save :: idx_spspmm=-1
 
   name='mld_spmm_bld_inner'

mlprec/impl/aggregator/mld_caggrmat_nosmth_bld.f90

@@ -145,10 +145,6 @@ subroutine mld_caggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
   naggrm1 = sum(nlaggr(1:me))
   naggrp1 = sum(nlaggr(1:me+1))
 
-  if (.false.) then
-    !
-    ! If we ever want to switch to explicit product when building this..
-    !
   call a%cp_to(acsr)
   call op_prol%mv_to(coo_prol)
   inaggr = naggr
@@ -162,55 +158,6 @@ subroutine mld_caggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
   call op_prol%mv_from(coo_prol)
   call op_restr%mv_from(coo_restr)
 
-
-  else
-    
-    call a%cp_to(ac_coo)
-    nzt = ac_coo%get_nzeros()
-    k   = 0
-    do i = 1, nzt 
-      k = k + 1 
-      ac_coo%ia(k)  = ilaggr(ac_coo%ia(i))
-      ac_coo%ja(k)  = ilaggr(ac_coo%ja(i))
-      ac_coo%val(k) = ac_coo%val(i)
-      ! At this point, there may be negative entries,
-      ! because that's how ILAGGR marks singletons
-      ! If this is the case, roll back K
-      if ((ac_coo%ia(k)<=0).or.(ac_coo%ja(k)<=0)) k = k-1      
-    enddo
-    call ac_coo%set_nrows(naggr)
-    call ac_coo%set_ncols(naggr)
-    call ac_coo%set_nzeros(k)
-    call ac_coo%set_dupl(psb_dupl_add_)
-    call ac_coo%fix(info)
-    call ac_coo%trim()
-    call ac%mv_from(ac_coo) 
-
-    call op_prol%cp_to(tmpcoo)
-
-    call tmpcoo%transp()
-    !
-    ! Now we have to fix this.  The only rows of tmpcoo/op_restr that are correct 
-    ! are those corresponding to "local" aggregates, i.e. indices in ilaggr(:)
-    !
-    nzl = tmpcoo%get_nzeros()
-    i   = 0
-    do k = 1, nzl
-      if ((naggrm1 < tmpcoo%ia(k)) .and.(tmpcoo%ia(k) <= naggrp1)) then
-        i = i+1
-        tmpcoo%val(i) = tmpcoo%val(k)
-        tmpcoo%ia(i)  = tmpcoo%ia(k)
-        tmpcoo%ja(i)  = tmpcoo%ja(k)
-      end if
-    end do
-    call tmpcoo%set_nzeros(i)
-    call tmpcoo%trim()
-    call op_restr%mv_from(tmpcoo)
-
-    if (info /= psb_success_) goto 9999
-
-  end if
-
   call psb_erractionrestore(err_act)
   return
 

mlprec/impl/aggregator/mld_d_map_to_tprol.f90

@@ -124,9 +124,9 @@ subroutine mld_d_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
     goto 9999
   end if
 
-  call tmpcoo%allocate(ncol,ntaggr,ncol)
+  call tmpcoo%allocate(nrow,ntaggr,ncol)
   k = 0 
-  do i=1,ncol
+  do i=1,nrow
     !
     ! Note: at this point, a value ilaggr(i)<=0
     ! tags a "singleton" row, and it has to be

mlprec/impl/aggregator/mld_d_spmm_bld_inner.f90

@@ -63,7 +63,7 @@ subroutine mld_d_spmm_bld_inner(a_csr,desc_a,nlaggr,parms,ac,&
   integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzl, ip, &
        &  nzt, naggrm1, naggrp1, i, k
   integer(psb_lpk_) ::  nrsave, ncsave, nzsave, nza
-  logical, parameter :: do_timings=.true., oldstyle=.false., debug=.false.  
+  logical, parameter :: do_timings=.false., oldstyle=.false., debug=.false.  
   integer(psb_ipk_), save :: idx_spspmm=-1
 
   name='mld_spmm_bld_inner'

mlprec/impl/aggregator/mld_daggrmat_nosmth_bld.f90

@@ -145,10 +145,6 @@ subroutine mld_daggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
   naggrm1 = sum(nlaggr(1:me))
   naggrp1 = sum(nlaggr(1:me+1))
 
-  if (.false.) then
-    !
-    ! If we ever want to switch to explicit product when building this..
-    !
   call a%cp_to(acsr)
   call op_prol%mv_to(coo_prol)
   inaggr = naggr
@@ -162,55 +158,6 @@ subroutine mld_daggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
   call op_prol%mv_from(coo_prol)
   call op_restr%mv_from(coo_restr)
 
-
-  else
-    
-    call a%cp_to(ac_coo)
-    nzt = ac_coo%get_nzeros()
-    k   = 0
-    do i = 1, nzt 
-      k = k + 1 
-      ac_coo%ia(k)  = ilaggr(ac_coo%ia(i))
-      ac_coo%ja(k)  = ilaggr(ac_coo%ja(i))
-      ac_coo%val(k) = ac_coo%val(i)
-      ! At this point, there may be negative entries,
-      ! because that's how ILAGGR marks singletons
-      ! If this is the case, roll back K
-      if ((ac_coo%ia(k)<=0).or.(ac_coo%ja(k)<=0)) k = k-1      
-    enddo
-    call ac_coo%set_nrows(naggr)
-    call ac_coo%set_ncols(naggr)
-    call ac_coo%set_nzeros(k)
-    call ac_coo%set_dupl(psb_dupl_add_)
-    call ac_coo%fix(info)
-    call ac_coo%trim()
-    call ac%mv_from(ac_coo) 
-
-    call op_prol%cp_to(tmpcoo)
-
-    call tmpcoo%transp()
-    !
-    ! Now we have to fix this.  The only rows of tmpcoo/op_restr that are correct 
-    ! are those corresponding to "local" aggregates, i.e. indices in ilaggr(:)
-    !
-    nzl = tmpcoo%get_nzeros()
-    i   = 0
-    do k = 1, nzl
-      if ((naggrm1 < tmpcoo%ia(k)) .and.(tmpcoo%ia(k) <= naggrp1)) then
-        i = i+1
-        tmpcoo%val(i) = tmpcoo%val(k)
-        tmpcoo%ia(i)  = tmpcoo%ia(k)
-        tmpcoo%ja(i)  = tmpcoo%ja(k)
-      end if
-    end do
-    call tmpcoo%set_nzeros(i)
-    call tmpcoo%trim()
-    call op_restr%mv_from(tmpcoo)
-
-    if (info /= psb_success_) goto 9999
-
-  end if
-
   call psb_erractionrestore(err_act)
   return
 

mlprec/impl/aggregator/mld_s_map_to_tprol.f90

@@ -124,9 +124,9 @@ subroutine mld_s_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
     goto 9999
   end if
 
-  call tmpcoo%allocate(ncol,ntaggr,ncol)
+  call tmpcoo%allocate(nrow,ntaggr,ncol)
   k = 0 
-  do i=1,ncol
+  do i=1,nrow
     !
     ! Note: at this point, a value ilaggr(i)<=0
     ! tags a "singleton" row, and it has to be

mlprec/impl/aggregator/mld_s_spmm_bld_inner.f90

@@ -63,7 +63,7 @@ subroutine mld_s_spmm_bld_inner(a_csr,desc_a,nlaggr,parms,ac,&
   integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzl, ip, &
        &  nzt, naggrm1, naggrp1, i, k
   integer(psb_lpk_) ::  nrsave, ncsave, nzsave, nza
-  logical, parameter :: do_timings=.true., oldstyle=.false., debug=.false.  
+  logical, parameter :: do_timings=.false., oldstyle=.false., debug=.false.  
   integer(psb_ipk_), save :: idx_spspmm=-1
 
   name='mld_spmm_bld_inner'

mlprec/impl/aggregator/mld_saggrmat_nosmth_bld.f90

@@ -145,10 +145,6 @@ subroutine mld_saggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
   naggrm1 = sum(nlaggr(1:me))
   naggrp1 = sum(nlaggr(1:me+1))
 
-  if (.false.) then
-    !
-    ! If we ever want to switch to explicit product when building this..
-    !
   call a%cp_to(acsr)
   call op_prol%mv_to(coo_prol)
   inaggr = naggr
@@ -162,55 +158,6 @@ subroutine mld_saggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
   call op_prol%mv_from(coo_prol)
   call op_restr%mv_from(coo_restr)
 
-
-  else
-    
-    call a%cp_to(ac_coo)
-    nzt = ac_coo%get_nzeros()
-    k   = 0
-    do i = 1, nzt 
-      k = k + 1 
-      ac_coo%ia(k)  = ilaggr(ac_coo%ia(i))
-      ac_coo%ja(k)  = ilaggr(ac_coo%ja(i))
-      ac_coo%val(k) = ac_coo%val(i)
-      ! At this point, there may be negative entries,
-      ! because that's how ILAGGR marks singletons
-      ! If this is the case, roll back K
-      if ((ac_coo%ia(k)<=0).or.(ac_coo%ja(k)<=0)) k = k-1      
-    enddo
-    call ac_coo%set_nrows(naggr)
-    call ac_coo%set_ncols(naggr)
-    call ac_coo%set_nzeros(k)
-    call ac_coo%set_dupl(psb_dupl_add_)
-    call ac_coo%fix(info)
-    call ac_coo%trim()
-    call ac%mv_from(ac_coo) 
-
-    call op_prol%cp_to(tmpcoo)
-
-    call tmpcoo%transp()
-    !
-    ! Now we have to fix this.  The only rows of tmpcoo/op_restr that are correct 
-    ! are those corresponding to "local" aggregates, i.e. indices in ilaggr(:)
-    !
-    nzl = tmpcoo%get_nzeros()
-    i   = 0
-    do k = 1, nzl
-      if ((naggrm1 < tmpcoo%ia(k)) .and.(tmpcoo%ia(k) <= naggrp1)) then
-        i = i+1
-        tmpcoo%val(i) = tmpcoo%val(k)
-        tmpcoo%ia(i)  = tmpcoo%ia(k)
-        tmpcoo%ja(i)  = tmpcoo%ja(k)
-      end if
-    end do
-    call tmpcoo%set_nzeros(i)
-    call tmpcoo%trim()
-    call op_restr%mv_from(tmpcoo)
-
-    if (info /= psb_success_) goto 9999
-
-  end if
-
   call psb_erractionrestore(err_act)
   return
 

mlprec/impl/aggregator/mld_z_map_to_tprol.f90

@@ -124,9 +124,9 @@ subroutine mld_z_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
     goto 9999
   end if
 
-  call tmpcoo%allocate(ncol,ntaggr,ncol)
+  call tmpcoo%allocate(nrow,ntaggr,ncol)
   k = 0 
-  do i=1,ncol
+  do i=1,nrow
     !
     ! Note: at this point, a value ilaggr(i)<=0
     ! tags a "singleton" row, and it has to be

mlprec/impl/aggregator/mld_z_spmm_bld_inner.f90

@@ -63,7 +63,7 @@ subroutine mld_z_spmm_bld_inner(a_csr,desc_a,nlaggr,parms,ac,&
   integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzl, ip, &
        &  nzt, naggrm1, naggrp1, i, k
   integer(psb_lpk_) ::  nrsave, ncsave, nzsave, nza
-  logical, parameter :: do_timings=.true., oldstyle=.false., debug=.false.  
+  logical, parameter :: do_timings=.false., oldstyle=.false., debug=.false.  
   integer(psb_ipk_), save :: idx_spspmm=-1
 
   name='mld_spmm_bld_inner'

mlprec/impl/aggregator/mld_zaggrmat_nosmth_bld.f90

@@ -145,10 +145,6 @@ subroutine mld_zaggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
   naggrm1 = sum(nlaggr(1:me))
   naggrp1 = sum(nlaggr(1:me+1))
 
-  if (.false.) then
-    !
-    ! If we ever want to switch to explicit product when building this..
-    !
   call a%cp_to(acsr)
   call op_prol%mv_to(coo_prol)
   inaggr = naggr
@@ -162,55 +158,6 @@ subroutine mld_zaggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
   call op_prol%mv_from(coo_prol)
   call op_restr%mv_from(coo_restr)
 
-
-  else
-    
-    call a%cp_to(ac_coo)
-    nzt = ac_coo%get_nzeros()
-    k   = 0
-    do i = 1, nzt 
-      k = k + 1 
-      ac_coo%ia(k)  = ilaggr(ac_coo%ia(i))
-      ac_coo%ja(k)  = ilaggr(ac_coo%ja(i))
-      ac_coo%val(k) = ac_coo%val(i)
-      ! At this point, there may be negative entries,
-      ! because that's how ILAGGR marks singletons
-      ! If this is the case, roll back K
-      if ((ac_coo%ia(k)<=0).or.(ac_coo%ja(k)<=0)) k = k-1      
-    enddo
-    call ac_coo%set_nrows(naggr)
-    call ac_coo%set_ncols(naggr)
-    call ac_coo%set_nzeros(k)
-    call ac_coo%set_dupl(psb_dupl_add_)
-    call ac_coo%fix(info)
-    call ac_coo%trim()
-    call ac%mv_from(ac_coo) 
-
-    call op_prol%cp_to(tmpcoo)
-
-    call tmpcoo%transp()
-    !
-    ! Now we have to fix this.  The only rows of tmpcoo/op_restr that are correct 
-    ! are those corresponding to "local" aggregates, i.e. indices in ilaggr(:)
-    !
-    nzl = tmpcoo%get_nzeros()
-    i   = 0
-    do k = 1, nzl
-      if ((naggrm1 < tmpcoo%ia(k)) .and.(tmpcoo%ia(k) <= naggrp1)) then
-        i = i+1
-        tmpcoo%val(i) = tmpcoo%val(k)
-        tmpcoo%ia(i)  = tmpcoo%ia(k)
-        tmpcoo%ja(i)  = tmpcoo%ja(k)
-      end if
-    end do
-    call tmpcoo%set_nzeros(i)
-    call tmpcoo%trim()
-    call op_restr%mv_from(tmpcoo)
-
-    if (info /= psb_success_) goto 9999
-
-  end if
-
   call psb_erractionrestore(err_act)
   return