mld2p4-dev

Fixed checks on multilevel aggregation stall.
Fixed printout of multilevle preconditioner description.

mlprec/mld_cprecbld.f90

@@ -252,13 +252,20 @@ subroutine mld_cprecbld(a,desc_a,p,info)
     end do
     ! Check on sizes from level 2 onwards
     if (me==0) then 
-      do i=3, iszv 
+      k = iszv+1
+      do i=iszv,3,-1
         if (all(p%baseprecv(i)%nlaggr == p%baseprecv(i-1)%nlaggr)) then 
-          write(debug_unit,*) me,name,&
+          k=i-1
-             &': Warning: aggregates at levels ',&
-             &i-1, ' and ',i,' coincide.'
         end if
       end do
+      if (k<=iszv) then 
+        write(debug_unit,*) me,trim(name),&
+             &': Warning: aggregates from level ',&
+             & k, ' to ',iszv,' coincide.'
+        write(debug_unit,*) me,trim(name),&
+             &': Maximum recommended NLEV:',k
+        write(debug_unit,*)
+      end if
     end if
     
   endif

mlprec/mld_dprecbld.f90

@@ -252,13 +252,20 @@ subroutine mld_dprecbld(a,desc_a,p,info)
     end do
     ! Check on sizes from level 2 onwards
     if (me==0) then 
-      do i=3, iszv 
+      k = iszv+1
+      do i=iszv,3,-1
         if (all(p%baseprecv(i)%nlaggr == p%baseprecv(i-1)%nlaggr)) then 
-          write(debug_unit,*) me,name,&
+          k=i-1
-             &': Warning: aggregates at levels ',&
-             &i-1, ' and ',i,' coincide.'
         end if
       end do
+      if (k<=iszv) then 
+        write(debug_unit,*) me,trim(name),&
+             &': Warning: aggregates from level ',&
+             & k, ' to ',iszv,' coincide.'
+        write(debug_unit,*) me,trim(name),&
+             &': Maximum recommended NLEV:',k
+        write(debug_unit,*)
+      end if
     end if
     
   endif

mlprec/mld_prec_type.f90

@@ -345,7 +345,7 @@ module mld_prec_type
   ! Character constants used by mld_file_prec_descr
   !
   character(len=19), parameter, private :: &
-       &  eigen_estimates(0:0)=(/'Infinity norm     '/)
+       &  eigen_estimates(0:0)=(/'infinity norm     '/)
   character(len=19), parameter, private :: &
        &  smooth_names(1:3)=(/'pre-smoothing     ','post-smoothing    ',&
        & 'pre/post-smoothing'/)
@@ -806,6 +806,17 @@ contains
         write(iout,*) '  Aggregation threshold: ', &
              &  dprcparm(mld_aggr_thresh_)
       end if
+      if (iprcparm(mld_aggr_kind_) /= mld_no_smooth_) then
+         if (iprcparm(mld_aggr_omega_alg_) == mld_eig_est_) then 
+          write(iout,*) '  Damping omega computation: spectral radius estimate'
+          write(iout,*) '  Spectral radius estimate: ', &
+               & eigen_estimates(iprcparm(mld_aggr_eig_))
+        else if (iprcparm(mld_aggr_omega_alg_) == mld_user_choice_) then 
+          write(iout,*) '  Damping omega computation: user defined value.'
+        else 
+          write(iout,*) '  Damping omega computation: unknown value in iprcparm!!'
+        end if
+      end if
     end if
 
     return
@@ -835,16 +846,6 @@ contains
              &  nlaggr(:)
       end if
       if (iprcparm(mld_aggr_kind_) /= mld_no_smooth_) then
-         if (iprcparm(mld_aggr_omega_alg_) == mld_eig_est_) then 
-          write(iout,*) '  Algorithm for damping omega: eigenvalue estimate'
-          write(iout,*) '  Eigenvalue estimate: ', &
-               & eigen_estimates(iprcparm(mld_aggr_eig_))
-        else if (iprcparm(mld_aggr_omega_alg_) == mld_user_choice_) then 
-          write(iout,*) '  Algorithm for damping omega: user defined value.'
-        else 
-          write(iout,*) '  Algorithm for damping omega: unknown value in iprcparm!!'
-        end if
-          
         if (present(rprcparm)) then 
           write(iout,*) '  Damping omega: ', &
                & rprcparm(mld_aggr_omega_val_)  
@@ -885,15 +886,7 @@ contains
              &  nlaggr(:)
       end if
       if (iprcparm(mld_aggr_kind_) /= mld_no_smooth_) then 
-        if (iprcparm(mld_aggr_omega_alg_) == mld_eig_est_) then 
+
-          write(iout,*) '  Algorithm for damping omega: eigenvalue estimate'
-          write(iout,*) '  Eigenvalue estimate: ', &
-               & eigen_estimates(iprcparm(mld_aggr_eig_))
-        else if (iprcparm(mld_aggr_omega_alg_) == mld_user_choice_) then 
-          write(iout,*) '  Algorithm for damping omega: user defined value.'
-        else 
-          write(iout,*) '  Algorithm for damping omega: unknown value in iprcparm!!'
-        end if
         if (present(rprcparm)) then 
           write(iout,*) '  Damping omega: ', &
                & rprcparm(mld_aggr_omega_val_)  
@@ -986,6 +979,7 @@ contains
       !
       if (me==psb_root_) then
         
+        write(iout_,*) 
         write(iout_,*) 'Preconditioner description'
         nlev = size(p%baseprecv)
         if (nlev >= 1) then
@@ -997,6 +991,7 @@ contains
 
           if (nlev > 1) then
             write(iout_,*) 'Multilevel Schwarz'
+            write(iout_,*) 
             write(iout_,*) 'Base preconditioner (smoother) details'
           endif
 
@@ -1011,7 +1006,7 @@ contains
           !
           ! Print multilevel details
           !
-
+          write(iout_,*) 
           write(iout_,*) 'Multilevel details'
 
           do ilev = 2, nlev 
@@ -1037,7 +1032,7 @@ contains
           ! Coarse matrices are different at levels 2,...,nlev-1, hence related
           ! info is printed separately
           !
-
+          write(iout_,*) 
           do ilev = 2, nlev-1
             call mld_ml_level_descr(iout_,ilev,p%baseprecv(ilev)%iprcparm,&
                  & p%baseprecv(ilev)%nlaggr,info,&
@@ -1049,15 +1044,18 @@ contains
           !
 
           ilev = nlev
+          write(iout_,*) 
           call mld_ml_coarse_descr(iout_,ilev,p%baseprecv(ilev)%iprcparm,&
                & p%baseprecv(ilev)%nlaggr,info,&
                & dprcparm=p%baseprecv(ilev)%rprcparm)
+          
         end if
         
       endif
+      write(iout_,*) 
     else
-
+      write(iout_,*) trim(name), &
-      write(iout_,*) trim(name),': Error: no base preconditioner available, something is wrong!'
+           & ': Error: no base preconditioner available, something is wrong!'
       info = -2
       return
     endif
@@ -1100,6 +1098,7 @@ contains
       !
       if (me==psb_root_) then
         
+        write(iout_,*) 
         write(iout_,*) 'Preconditioner description'
         nlev = size(p%baseprecv)
         if (nlev >= 1) then
@@ -1111,6 +1110,7 @@ contains
 
           if (nlev > 1) then
             write(iout_,*) 'Multilevel Schwarz'
+            write(iout_,*) 
             write(iout_,*) 'Base preconditioner (smoother) details'
           endif
 
@@ -1125,7 +1125,7 @@ contains
           !
           ! Print multilevel details
           !
-
+          write(iout_,*) 
           write(iout_,*) 'Multilevel details'
 
           do ilev = 2, nlev 
@@ -1151,7 +1151,7 @@ contains
           ! Coarse matrices are different at levels 2,...,nlev-1, hence related
           ! info is printed separately
           !
-
+          write(iout_,*)                       
           do ilev = 2, nlev-1
             call mld_ml_level_descr(iout_,ilev,p%baseprecv(ilev)%iprcparm,&
                  & p%baseprecv(ilev)%nlaggr,info,&
@@ -1163,15 +1163,18 @@ contains
           !
 
           ilev = nlev
+          write(iout_,*) 
           call mld_ml_coarse_descr(iout_,ilev,p%baseprecv(ilev)%iprcparm,&
                & p%baseprecv(ilev)%nlaggr,info,&
                & rprcparm=p%baseprecv(ilev)%rprcparm)
         end if
         
       endif
+      write(iout_,*) 
     else
 
-      write(iout_,*) trim(name),': Error: no base preconditioner available, something is wrong!'
+      write(iout_,*) trim(name), &
+           & ': Error: no base preconditioner available, something is wrong!'
       info = -2
       return
     endif
@@ -1236,6 +1239,7 @@ contains
       !
       if (me==psb_root_) then
         
+        write(iout_,*) 
         write(iout_,*) 'Preconditioner description'
         nlev = size(p%baseprecv)
         if (nlev >= 1) then
@@ -1247,6 +1251,7 @@ contains
 
           if (nlev > 1) then
             write(iout_,*) 'Multilevel Schwarz'
+            write(iout_,*) 
             write(iout_,*) 'Base preconditioner (smoother) details'
           endif
 
@@ -1261,7 +1266,7 @@ contains
           !
           ! Print multilevel details
           !
-
+          write(iout_,*) 
           write(iout_,*) 'Multilevel details'
 
           do ilev = 2, nlev 
@@ -1287,7 +1292,7 @@ contains
           ! Coarse matrices are different at levels 2,...,nlev-1, hence related
           ! info is printed separately
           !
-
+          write(iout_,*) 
           do ilev = 2, nlev-1
             call mld_ml_level_descr(iout_,ilev,p%baseprecv(ilev)%iprcparm,&
                  & p%baseprecv(ilev)%nlaggr,info,&
@@ -1299,15 +1304,17 @@ contains
           !
 
           ilev = nlev
+          write(iout_,*) 
           call mld_ml_coarse_descr(iout_,ilev,p%baseprecv(ilev)%iprcparm,&
                & p%baseprecv(ilev)%nlaggr,info,&
                & dprcparm=p%baseprecv(ilev)%rprcparm)
         end if
         
       endif
+      write(iout_,*) 
     else
-
+      write(iout_,*) trim(name), &
-      write(iout_,*) trim(name),': Error: no base preconditioner available, something is wrong!'
+           & ': Error: no base preconditioner available, something is wrong!'
       info = -2
       return
     endif
@@ -1348,7 +1355,7 @@ contains
       ! ensured by mld_precbld).
       !
       if (me==psb_root_) then
-        
+        write(iout_,*)            
         write(iout_,*) 'Preconditioner description'
         nlev = size(p%baseprecv)
         if (nlev >= 1) then
@@ -1360,6 +1367,7 @@ contains
 
           if (nlev > 1) then
             write(iout_,*) 'Multilevel Schwarz'
+            write(iout_,*) 
             write(iout_,*) 'Base preconditioner (smoother) details'
           endif
 
@@ -1374,7 +1382,7 @@ contains
           !
           ! Print multilevel details
           !
-
+          write(iout_,*) 
           write(iout_,*) 'Multilevel details'
 
           do ilev = 2, nlev 
@@ -1400,6 +1408,7 @@ contains
           ! Coarse matrices are different at levels 2,...,nlev-1, hence related
           ! info is printed separately
           !
+          write(iout_,*) 
 
           do ilev = 2, nlev-1
             call mld_ml_level_descr(iout_,ilev,p%baseprecv(ilev)%iprcparm,&
@@ -1412,15 +1421,17 @@ contains
           !
 
           ilev = nlev
+          write(iout_,*) 
           call mld_ml_coarse_descr(iout_,ilev,p%baseprecv(ilev)%iprcparm,&
                & p%baseprecv(ilev)%nlaggr,info,&
                & rprcparm=p%baseprecv(ilev)%rprcparm)
         end if
         
       endif
+      write(iout_,*) 
     else
-
+      write(iout_,*) trim(name), &
-      write(iout_,*) trim(name),': Error: no base preconditioner available, something is wrong!'
+           & ': Error: no base preconditioner available, something is wrong!'
       info = -2
       return
     endif

mlprec/mld_sprecbld.f90

@@ -252,13 +252,20 @@ subroutine mld_sprecbld(a,desc_a,p,info)
     end do
     ! Check on sizes from level 2 onwards
     if (me==0) then 
-      do i=3, iszv 
+      k = iszv+1
+      do i=iszv,3,-1
         if (all(p%baseprecv(i)%nlaggr == p%baseprecv(i-1)%nlaggr)) then 
-          write(debug_unit,*) me,name,&
+          k=i-1
-             &': Warning: aggregates at levels ',&
-             &i-1, ' and ',i,' coincide.'
         end if
       end do
+      if (k<=iszv) then 
+        write(debug_unit,*) me,trim(name),&
+             &': Warning: aggregates from level ',&
+             & k, ' to ',iszv,' coincide.'
+        write(debug_unit,*) me,trim(name),&
+             &': Maximum recommended NLEV:',k
+        write(debug_unit,*)
+      end if
     end if
     
   endif

mlprec/mld_zprecbld.f90

@@ -252,13 +252,20 @@ subroutine mld_zprecbld(a,desc_a,p,info)
     end do
     ! Check on sizes from level 2 onwards
     if (me==0) then 
-      do i=3, iszv 
+      k = iszv+1
+      do i=iszv,3,-1
         if (all(p%baseprecv(i)%nlaggr == p%baseprecv(i-1)%nlaggr)) then 
-          write(debug_unit,*) me,name,&
+          k=i-1
-             &': Warning: aggregates at levels ',&
-             &i-1, ' and ',i,' coincide.'
         end if
       end do
+      if (k<=iszv) then 
+        write(debug_unit,*) me,trim(name),&
+             &': Warning: aggregates from level ',&
+             & k, ' to ',iszv,' coincide.'
+        write(debug_unit,*) me,trim(name),&
+             &': Maximum recommended NLEV:',k
+        write(debug_unit,*)
+      end if
     end if
     
   endif