mld2p4-2:

Fixes for compilation and printout of preconditioner description.

mlprec/mld_base_prec_type.f90

@@ -606,6 +606,87 @@ contains
   end subroutine mld_ml_coarse_descr
 
 
+  subroutine mld_ml_new_coarse_descr(iout,ilev,iprcparm,nlaggr,info,&
+       & rprcparm,dprcparm)
+    implicit none 
+    integer, intent(in) :: iprcparm(:),iout,ilev
+    integer, intent(in), allocatable :: nlaggr(:)
+    integer, intent(out) :: info
+    real(psb_spk_), intent(in), optional :: rprcparm(:)
+    real(psb_dpk_), intent(in), optional :: dprcparm(:)
+
+    info = psb_success_
+    if (count((/ present(rprcparm),present(dprcparm) /)) /= 1) then 
+      info=psb_err_no_optional_arg_
+!!$      call psb_errpush(info,name,a_err=" rprcparm, dprcparm")
+      return
+    endif
+!!$    if (count((/ present(rprcparm2),present(dprcparm2) /)) /= 1) then 
+!!$      info=psb_err_no_optional_arg_
+! !$      call psb_errpush(info,name,a_err=" rprcparm, dprcparm")
+!!$      return
+!!$    endif
+
+    if (iprcparm(mld_ml_type_)>mld_no_ml_) then
+
+      write(iout,*) ' Level ',ilev,' (coarsest)'
+      write(iout,*) '  Coarsest matrix: ',&
+           & matrix_names(iprcparm(mld_coarse_mat_))
+      if (allocated(nlaggr)) then 
+        write(iout,*) '  Size of coarsest matrix: ', &
+             &  sum( nlaggr(:))
+        write(iout,*) '  Sizes of aggregates: ', &
+             &  nlaggr(:)
+      end if
+      if (iprcparm(mld_aggr_kind_) /= mld_no_smooth_) then 
+
+        if (present(rprcparm)) then 
+          write(iout,*) '  Damping omega: ', &
+               & rprcparm(mld_aggr_omega_val_)  
+        else
+          write(iout,*) '  Damping omega: ', &
+               & dprcparm(mld_aggr_omega_val_)  
+        end if
+      end if
+!!$      if (iprcparm(mld_coarse_mat_) == mld_distr_mat_ .and. &
+!!$           & iprcparm(mld_sub_solve_) /= mld_sludist_) then
+! !$        write(iout,*) '  Coarsest matrix solver: ',&
+! !$             & smoother_names(iprcparm2(mld_smoother_type_))
+!!$        select case (iprcparm2(mld_smoother_type_))
+!!$        case(mld_bjac_,mld_as_)
+!!$          write(iout,*) '  subdomain solver: ',&          
+!!$               &  fact_names(iprcparm2(mld_sub_solve_))
+!!$          write(iout,*) '  Number of smoother sweeps: ', &
+!!$               &   (iprcparm2(mld_smoother_sweeps_))
+!!$        case(mld_jac_) 
+!!$          write(iout,*) '  Number of smoother sweeps: ', &
+!!$               &   (iprcparm2(mld_smoother_sweeps_))
+!!$        end select
+!!$      else
+!!$        write(iout,*) '  Coarsest matrix solver: ', &
+!!$             &  fact_names(iprcparm2(mld_sub_solve_))
+!!$      end if
+!!$      select case(iprcparm2(mld_sub_solve_))
+!!$      case(mld_ilu_n_,mld_milu_n_)      
+!!$        write(iout,*) '  Fill level:',iprcparm2(mld_sub_fillin_)
+!!$      case(mld_ilu_t_)
+!!$        write(iout,*) '  Fill level:',iprcparm2(mld_sub_fillin_)
+!!$        if (present(rprcparm2)) then 
+!!$          write(iout,*) '  Fill threshold :',rprcparm2(mld_sub_iluthrs_)
+!!$        else if (present(dprcparm2)) then 
+!!$          write(iout,*) '  Fill threshold :',dprcparm2(mld_sub_iluthrs_)
+!!$        end if
+!!$      case(mld_slu_,mld_umf_,mld_sludist_,mld_diag_scale_) 
+!!$      case default
+!!$        write(iout,*) '  Should never get here!'
+!!$      end select
+    end if
+
+
+    return
+  end subroutine mld_ml_new_coarse_descr
+
+
   !
   ! Functions/subroutines checking if the preconditioner is correctly defined
   !

mlprec/mld_d_prec_type.f03

@@ -435,13 +435,13 @@ contains
           !
           ! Print description of base preconditioner
           !
+          if (nlev > 1) then
+            write(iout_,*) 'Multilevel Schwarz'
+            write(iout_,*) 
+            write(iout_,*) 'Base preconditioner (smoother) details'
+          endif
           call p%precv(1)%sm%descr(info,iout=iout_)
 !!$
-!!$          if (nlev > 1) then
-!!$            write(iout_,*) 'Multilevel Schwarz'
-!!$            write(iout_,*) 
-!!$            write(iout_,*) 'Base preconditioner (smoother) details'
-!!$          endif
 !!$
 !!$          ilev = 1 
 !!$          call mld_base_prec_descr(iout_,p%precv(ilev)%prec%iprcparm,info,&
@@ -450,56 +450,58 @@ contains
         end if
 
         if (nlev > 1) then
-!!$
+
-!!$          !
+          !
-!!$          ! Print multilevel details
+          ! Print multilevel details
-!!$          !
+          !
-!!$          write(iout_,*) 
+          write(iout_,*) 
-!!$          write(iout_,*) 'Multilevel details'
+          write(iout_,*) 'Multilevel details'
-!!$
+
-!!$          do ilev = 2, nlev 
+          do ilev = 2, nlev 
-!!$            if (.not.allocated(p%precv(ilev)%iprcparm)) then 
+            if (.not.allocated(p%precv(ilev)%iprcparm)) then 
-!!$              info = 3111
+              info = 3111
-!!$              write(iout_,*) ' ',name,&
+              write(iout_,*) ' ',name,&
-!!$                   & ': error: inconsistent MLPREC part, should call MLD_PRECINIT'
+                   & ': error: inconsistent MLPREC part, should call MLD_PRECINIT'
-!!$              return
+              return
-!!$            endif
+            endif
-!!$          end do
+          end do
-!!$
+
-!!$          write(iout_,*) ' Number of levels: ',nlev
+          write(iout_,*) ' Number of levels: ',nlev
-!!$
+
-!!$          !
+          !
-!!$          ! Currently, all the preconditioner parameters must have
+          ! Currently, all the preconditioner parameters must have
-!!$          ! the same value at levels
+          ! the same value at levels
-!!$          ! 2,...,nlev-1, hence only the values at level 2 are printed
+          ! 2,...,nlev-1, hence only the values at level 2 are printed
-!!$          !
+          !
-!!$
+
-!!$          ilev=2
+          ilev=2
-!!$          call mld_ml_alg_descr(iout_,ilev,p%precv(ilev)%iprcparm, info,&
+          call mld_ml_alg_descr(iout_,ilev,p%precv(ilev)%iprcparm, info,&
-!!$               & dprcparm=p%precv(ilev)%rprcparm)
+               & dprcparm=p%precv(ilev)%rprcparm)
 !!$
 !!$          !
 !!$          ! Coarse matrices are different at levels 2,...,nlev-1, hence related
 !!$          ! info is printed separately
 !!$          !
-!!$          write(iout_,*) 
+          write(iout_,*) 
-!!$          do ilev = 2, nlev-1
+          do ilev = 2, nlev-1
-!!$            call mld_ml_level_descr(iout_,ilev,p%precv(ilev)%iprcparm,&
+            call mld_ml_level_descr(iout_,ilev,p%precv(ilev)%iprcparm,&
-!!$                 & p%precv(ilev)%map%naggr,info,&
+                 & p%precv(ilev)%map%naggr,info,&
-!!$                 & dprcparm=p%precv(ilev)%rprcparm)
+                 & dprcparm=p%precv(ilev)%rprcparm)
-!!$          end do
+            call p%precv(ilev)%sm%descr(info,iout=iout_)
+          
+          end do
 !!$
 !!$          !
 !!$          ! Print coarsest level details
 !!$          !
 !!$
-!!$          ilev = nlev
+          ilev = nlev
-!!$          write(iout_,*) 
+          write(iout_,*) 
-!!$          call mld_ml_coarse_descr(iout_,ilev,&
+          call mld_ml_new_coarse_descr(iout_,ilev,&
-!!$               & p%precv(ilev)%iprcparm,p%precv(ilev)%prec%iprcparm,&
+               & p%precv(ilev)%iprcparm,&
-!!$               & p%precv(ilev)%map%naggr,info,&
+               & p%precv(ilev)%map%naggr,info,&
-!!$               & dprcparm=p%precv(ilev)%rprcparm,&
+               & dprcparm=p%precv(ilev)%rprcparm)
-!!$               & dprcparm2=p%precv(ilev)%prec%rprcparm)
+          call p%precv(ilev)%sm%descr(info,iout=iout_)
         end if
         
       endif

mlprec/mld_dprecaply.f90

@@ -75,7 +75,7 @@ subroutine mld_dprecaply(prec,x,y,desc_data,info,trans,work)
 
   use psb_sparse_mod
   use mld_inner_mod, mld_protect_name => mld_dprecaply
- !  use mld_prec_mod, mld_protect_name => mld_dprecaply
+  !use mld_prec_mod, mld_protect_name2 => mld_dprecaply
   
   implicit none