mld2p4-2:

mlprec/impl/smoother/mld_d_jac_smoother_apply_vect.f90
 mlprec/mld_base_prec_type.F90
 mlprec/mld_d_base_solver_mod.f90
 mlprec/mld_d_gs_solver.f90
 mlprec/mld_d_prec_type.f90

Now GS seems to be working properly.

mlprec/impl/smoother/mld_d_jac_smoother_apply_vect.f90

@@ -109,20 +109,17 @@ subroutine mld_d_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
 
 !!$  write(0,*) 'Jacobi   smoother with ',sweeps
   
-!!$  if (sweeps == 1) then 
-!!$
-!!$    call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,info) 
-!!$
-!!$    if (info /= psb_success_) then
-!!$      call psb_errpush(psb_err_internal_error_,&
-!!$           & name,a_err='Error in sub_aply Jacobi Sweeps = 1')
-!!$      goto 9999
-!!$    endif
-!!$
-!!$  else if (sweeps  > 1) then
-  ! Note: I had to take out the ==1 optimization for the sake of GS. 
-  if (sweeps  >= 1) then 
+  if ((.not.sm%sv%is_iterative()).and.((sweeps == 1).or.(sm%nnz_nd_tot==0))) then 
+
+    call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,info) 
+
+    if (info /= psb_success_) then
+      call psb_errpush(psb_err_internal_error_,&
+           & name,a_err='Error in sub_aply Jacobi Sweeps = 1')
+      goto 9999
+    endif
 
+  else if (sweeps >= 1) then 
     !
     !
     ! Apply multiple sweeps of a block-Jacobi solver

mlprec/mld_base_prec_type.F90

@@ -494,18 +494,18 @@ contains
       write(iout,*) '  Smoother position: ',&
            & smooth_pos_names(pm%smoother_pos)
       if (pm%ml_type == mld_add_ml_) then
-        write(iout,*) '  Number of sweeps : ',&
+        write(iout,*) '  Number of smoother sweeps : ',&
              & pm%sweeps 
       else 
         select case (pm%smoother_pos)
         case (mld_pre_smooth_)
-          write(iout,*) '  Number of sweeps : ',&
+          write(iout,*) '  Number of smoother sweeps : ',&
                & pm%sweeps_pre
         case (mld_post_smooth_)
-          write(iout,*) '  Number of sweeps : ',&
+          write(iout,*) '  Number of smoother sweeps : ',&
                &  pm%sweeps_post
         case (mld_twoside_smooth_)
-          write(iout,*) '  Number of sweeps : pre: ',&
+          write(iout,*) '  Number of smoother sweeps : pre: ',&
                &  pm%sweeps_pre ,&
                &  '  post: ',&
                &  pm%sweeps_post

mlprec/mld_d_base_solver_mod.f90

@@ -107,10 +107,12 @@ module mld_d_base_solver_mod
     procedure, pass(sv) :: get_nzeros => d_base_solver_get_nzeros
     procedure, nopass   :: stringval => mld_stringval
     procedure, nopass   :: get_fmt   => d_base_solver_get_fmt
+    procedure, nopass   :: is_iterative => d_base_solver_is_iterative
   end type mld_d_base_solver_type
 
   private :: d_base_solver_sizeof, d_base_solver_default,&
-       &  d_base_solver_get_nzeros, d_base_solver_get_fmt
+       & d_base_solver_get_nzeros, d_base_solver_get_fmt, &
+       & d_base_solver_is_iterative
 
 
   interface  
@@ -386,5 +388,15 @@ contains
     val = "Base solver"
   end function d_base_solver_get_fmt
 
+  !
+  ! If this is true, then the solver needs a starting
+  ! guess. Currently only handled in JAC smoother. 
+  ! 
+  function d_base_solver_is_iterative() result(val)
+    implicit none 
+    logical  :: val
+
+    val = .false.
+  end function d_base_solver_is_iterative
 
 end module mld_d_base_solver_mod

mlprec/mld_d_gs_solver.f90

@@ -71,6 +71,7 @@ module mld_d_gs_solver
     procedure, pass(sv) :: sizeof  => d_gs_solver_sizeof
     procedure, pass(sv) :: get_nzeros => d_gs_solver_get_nzeros
     procedure, nopass   :: get_fmt    => d_gs_solver_get_fmt
+    procedure, nopass   :: is_iterative => d_gs_solver_is_iterative
   end type mld_d_gs_solver_type
 
 
@@ -80,7 +81,8 @@ module mld_d_gs_solver
        &  d_gs_solver_descr,  d_gs_solver_sizeof, &
        &  d_gs_solver_default, d_gs_solver_dmp, &
        &  d_gs_solver_apply_vect, d_gs_solver_get_nzeros, &
-       &  d_gs_solver_get_fmt, d_gs_solver_check
+       &  d_gs_solver_get_fmt, d_gs_solver_check,&
+       &  d_gs_solver_is_iterative
 
 
   interface 
@@ -501,4 +503,16 @@ contains
     val = "Gauss-Seidel solver"
   end function d_gs_solver_get_fmt
 
+
+  !
+  ! If this is true, then the solver needs a starting
+  ! guess. Currently only handled in JAC smoother. 
+  ! 
+  function d_gs_solver_is_iterative() result(val)
+    implicit none 
+    logical  :: val
+
+    val = .true.
+  end function d_gs_solver_is_iterative
+
 end module mld_d_gs_solver

mlprec/mld_d_prec_type.f90

@@ -471,7 +471,7 @@ contains
           call p%precv(1)%sm%descr(info,iout=iout_)
           if (nlev == 1) then 
             if (p%precv(1)%parms%sweeps > 1) then 
-              write(iout_,*) '  Number of sweeps : ',&
+              write(iout_,*) '  Number of smoother sweeps : ',&
                    & p%precv(1)%parms%sweeps 
             end if
             write(iout_,*)