Cleanup dead code

amgprec/impl/smoother/amg_d_poly_smoother_apply_vect.f90

@@ -108,11 +108,6 @@ subroutine amg_d_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
       goto 9999
     end if
   endif
-!!$  if (me == 0) write(0,*) name,' Unimplemented apply_vect '
-!!$  info =psb_err_internal_error_
-!!$  call psb_errpush(info,&
-!!$       & name,a_err='Error in sub_aply Polynomial not implemented')
-!!$  goto 9999
 
   if (size(wv) < 4) then
     info = psb_err_internal_error_
@@ -151,7 +146,7 @@ subroutine amg_d_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
             call psb_spmm(-done,sm%pa,tz,done,r,desc_data,info,work=aux,trans=trans_)
           end if
 !!$          res  = psb_genrm2(r,desc_data,info)
-!!$        write(0,*) 'Polynomial smoother ',i,res
+!!$          write(0,*) 'Polynomial smoother LOTTES ',i,res
           ! x_k =  x_{k-1} + z_k
         end do
       end block
@@ -187,7 +182,7 @@ subroutine amg_d_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
             call psb_spmm(-done,sm%pa,tz,done,r,desc_data,info,work=aux,trans=trans_)
           end if
 !!$          res  = psb_genrm2(r,desc_data,info)
-!!$        write(0,*) 'Polynomial smoother ',i,res
+!!$          write(0,*) 'Polynomial smoother LOTTES_BETA ',i,res
           ! x_k =  x_{k-1} + z_k
         end do
       end block
@@ -221,7 +216,7 @@ subroutine amg_d_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
           rho = done/(2*sigma - rho_old)
           call psb_geaxpby((2*rho/delta),r,(rho*rho_old),tz,desc_data,info)
 !!$          res  = psb_genrm2(r,desc_data,info)
-!!$          write(0,*) 'Polynomial smoother ',i,res
+!!$          write(0,*) 'Polynomial smoother NEW ',i,res
           ! x_k =  x_{k-1} + z_k
         end do
       end block
@@ -244,205 +239,10 @@ subroutine amg_d_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
     end if
   end associate
 
-
-
-
-!!$  if ((.not.sm%sv%is_iterative()).and.((sweeps == 1).or.(sm%nd_nnz_tot==0))) then
-!!$    !  if .not.sv%is_iterative, there's no need to pass init
-!!$    call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,wv,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 >= 0) then
-!!$    select type (smsv => sm%sv)
-!!$    class is (amg_d_diag_solver_type)
-!!$      !
-!!$      ! This means we are dealing with a pure Jacobi smoother/solver.
-!!$      !
-!!$      associate(tx => wv(1), ty => wv(2))
-!!$        select case (init_)
-!!$        case('Z')
-!!$
-!!$          call sm%sv%apply(done,x,dzero,ty,desc_data,trans_,aux,wv(3:),info,init='Z')
-!!$
-!!$        case('Y')
-!!$          call psb_geaxpby(done,x,dzero,tx,desc_data,info)
-!!$          call psb_geaxpby(done,y,dzero,ty,desc_data,info)
-!!$          call psb_spmm(-done,sm%pa,ty,done,tx,desc_data,info,work=aux,trans=trans_)
-!!$          call sm%sv%apply(done,tx,dzero,ty,desc_data,trans_,aux,wv(3:),info,init='Y')
-!!$
-!!$        case('U')
-!!$          if (.not.present(initu)) then
-!!$            call psb_errpush(psb_err_internal_error_,name,&
-!!$                 & a_err='missing initu to smoother_apply')
-!!$            goto 9999
-!!$          end if
-!!$          call psb_geaxpby(done,x,dzero,tx,desc_data,info)
-!!$          call psb_geaxpby(done,initu,dzero,ty,desc_data,info)
-!!$          call psb_spmm(-done,sm%pa,ty,done,tx,desc_data,info,work=aux,trans=trans_)
-!!$          call sm%sv%apply(done,tx,dzero,ty,desc_data,trans_,aux,wv(3:),info,init='Y')
-!!$
-!!$        case default
-!!$          call psb_errpush(psb_err_internal_error_,name,&
-!!$               & a_err='wrong  init to smoother_apply')
-!!$          goto 9999
-!!$        end select
-!!$
-!!$        do i=1, sweeps-1
-!!$          !
-!!$          ! Compute Y(j+1) =  Y(j)+ D^(-1)*(X-A*Y(j)),
-!!$          !  where is the diagonal and  A the matrix.
-!!$          !
-!!$          call psb_geaxpby(done,x,dzero,tx,desc_data,info)
-!!$          call psb_spmm(-done,sm%pa,ty,done,tx,desc_data,info,work=aux,trans=trans_)
-!!$
-!!$          if (info /= psb_success_) exit
-!!$
-!!$          call sm%sv%apply(done,tx,done,ty,desc_data,trans_,aux,wv(3:),info,init='Y')
-!!$
-!!$          if (info /= psb_success_) exit
-!!$
-!!$          if ( sm%checkres.and.(mod(i,sm%checkiter) == 0) ) then
-!!$            call psb_geaxpby(done,x,dzero,r,r,desc_data,info)
-!!$            call psb_spmm(-done,sm%pa,ty,done,r,desc_data,info)
-!!$            res  = psb_genrm2(r,desc_data,info)
-!!$            if( sm%printres ) then
-!!$              call log_conv("BJAC",me,i,sm%printiter,res,resdenum,sm%tol)
-!!$            end if
-!!$            if ( res < sm%tol*resdenum ) then
-!!$              if( (sm%printres).and.(mod(sm%printiter,sm%checkiter)/=0) ) &
-!!$               & call log_conv("BJAC",me,i,1,res,resdenum,sm%tol)
-!!$              exit
-!!$            end if
-!!$          end if
-!!$
-!!$        end do
-!!$
-!!$
-!!$        if (info == psb_success_) call psb_geaxpby(alpha,ty,beta,y,desc_data,info)
-!!$
-!!$        if (info /= psb_success_) then
-!!$          info=psb_err_internal_error_
-!!$          call psb_errpush(info,name,&
-!!$               & a_err='subsolve with Jacobi sweeps > 1')
-!!$          goto 9999
-!!$        end if
-!!$
-!!$
-!!$      end associate
-!!$
-!!$    class default
-!!$      !
-!!$      !
-!!$      ! Apply multiple sweeps of a block-Jacobi solver
-!!$      ! to compute an approximate solution of a linear system.
-!!$      !
-!!$      !
-!!$      if (size(wv) < 2) then
-!!$        info = psb_err_internal_error_
-!!$        call psb_errpush(info,name,&
-!!$             & a_err='invalid wv size in smoother_apply')
-!!$        goto 9999
-!!$      end if
-!!$      associate(tx => wv(1), ty => wv(2))
-!!$
-!!$        !
-!!$        !  Unroll  the first iteration and fold it inside SELECT CASE
-!!$        !  this will save one AXPBY and one SPMM when INIT=Z, and will be
-!!$        !  significant when sweeps=1 (a common case)
-!!$        !
-!!$        select case (init_)
-!!$        case('Z')
-!!$
-!!$          call sm%sv%apply(done,x,dzero,ty,desc_data,trans_,aux,wv(3:),info,init='Z')
-!!$
-!!$        case('Y')
-!!$          call psb_geaxpby(done,x,dzero,tx,desc_data,info)
-!!$          call psb_geaxpby(done,y,dzero,ty,desc_data,info)
-!!$          call psb_spmm(-done,sm%nd,ty,done,tx,desc_data,info,work=aux,trans=trans_)
-!!$          call sm%sv%apply(done,tx,dzero,ty,desc_data,trans_,aux,wv(3:),info,init='Y')
-!!$
-!!$        case('U')
-!!$          if (.not.present(initu)) then
-!!$            call psb_errpush(psb_err_internal_error_,name,&
-!!$                 & a_err='missing initu to smoother_apply')
-!!$            goto 9999
-!!$          end if
-!!$          call psb_geaxpby(done,x,dzero,tx,desc_data,info)
-!!$          call psb_geaxpby(done,initu,dzero,ty,desc_data,info)
-!!$          call psb_spmm(-done,sm%nd,ty,done,tx,desc_data,info,work=aux,trans=trans_)
-!!$          call sm%sv%apply(done,tx,dzero,ty,desc_data,trans_,aux,wv(3:),info,init='Y')
-!!$
-!!$        case default
-!!$          call psb_errpush(psb_err_internal_error_,name,&
-!!$               & a_err='wrong  init to smoother_apply')
-!!$          goto 9999
-!!$        end select
-!!$
-!!$        do i=1, sweeps-1
-!!$          !
-!!$          ! Compute Y(j+1) = D^(-1)*(X-ND*Y(j)), where D and ND are the
-!!$          ! block diagonal part and the remaining part of the local matrix
-!!$          ! and Y(j) is the approximate solution at sweep j.
-!!$          !
-!!$          call psb_geaxpby(done,x,dzero,tx,desc_data,info)
-!!$          call psb_spmm(-done,sm%nd,ty,done,tx,desc_data,info,work=aux,trans=trans_)
-!!$
-!!$          if (info /= psb_success_) exit
-!!$
-!!$          call sm%sv%apply(done,tx,dzero,ty,desc_data,trans_,aux,wv(3:),info,init='Y')
-!!$
-!!$          if (info /= psb_success_) exit
-!!$
-!!$          if ( sm%checkres.and.(mod(i,sm%checkiter) == 0) ) then
-!!$            call psb_geaxpby(done,x,dzero,r,r,desc_data,info)
-!!$            call psb_spmm(-done,sm%pa,ty,done,r,desc_data,info)
-!!$            res  = psb_genrm2(r,desc_data,info)
-!!$            if( sm%printres ) then
-!!$              call log_conv("BJAC",me,i,sm%printiter,res,resdenum,sm%tol)
-!!$            end if
-!!$            if (res < sm%tol*resdenum ) then
-!!$              if( (sm%printres).and.( mod(sm%printiter,sm%checkiter) /=0 ) ) &
-!!$                & call log_conv("BJAC",me,i,1,res,resdenum,sm%tol)
-!!$              exit
-!!$            end if
-!!$          end if
-!!$
-!!$        end do
-!!$
-!!$        if (info == psb_success_) call psb_geaxpby(alpha,ty,beta,y,desc_data,info)
-!!$
-!!$        if (info /= psb_success_) then
-!!$          info=psb_err_internal_error_
-!!$          call psb_errpush(info,name,&
-!!$               & a_err='subsolve with Jacobi sweeps > 1')
-!!$          goto 9999
-!!$        end if
-!!$
-!!$      end associate
-!!$    end select
-!!$
-!!$  else
-!!$
-!!$    info = psb_err_iarg_neg_
-!!$    call psb_errpush(info,name,&
-!!$         & i_err=(/itwo,sweeps,izero,izero,izero/))
-!!$    goto 9999
-!!$
-!!$  endif
-!!$
   if (.not.(4*n_col <= size(work))) then
     deallocate(aux)
   endif
 
-!!$  if(sm%checkres) then
-!!$    call psb_gefree(r,desc_data,info)
-!!$  end if
-
   call psb_erractionrestore(err_act)
   return
 

amgprec/impl/smoother/amg_s_poly_smoother_apply_vect.f90

@@ -108,11 +108,6 @@ subroutine amg_s_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
       goto 9999
     end if
   endif
-!!$  if (me == 0) write(0,*) name,' Unimplemented apply_vect '
-!!$  info =psb_err_internal_error_
-!!$  call psb_errpush(info,&
-!!$       & name,a_err='Error in sub_aply Polynomial not implemented')
-!!$  goto 9999
 
   if (size(wv) < 4) then
     info = psb_err_internal_error_
@@ -151,7 +146,7 @@ subroutine amg_s_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
             call psb_spmm(-sone,sm%pa,tz,sone,r,desc_data,info,work=aux,trans=trans_)
           end if
 !!$          res  = psb_genrm2(r,desc_data,info)
-!!$        write(0,*) 'Polynomial smoother ',i,res
+!!$          write(0,*) 'Polynomial smoother LOTTES ',i,res
           ! x_k =  x_{k-1} + z_k
         end do
       end block
@@ -187,7 +182,7 @@ subroutine amg_s_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
             call psb_spmm(-sone,sm%pa,tz,sone,r,desc_data,info,work=aux,trans=trans_)
           end if
 !!$          res  = psb_genrm2(r,desc_data,info)
-!!$        write(0,*) 'Polynomial smoother ',i,res
+!!$          write(0,*) 'Polynomial smoother LOTTES_BETA ',i,res
           ! x_k =  x_{k-1} + z_k
         end do
       end block
@@ -221,7 +216,7 @@ subroutine amg_s_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
           rho = sone/(2*sigma - rho_old)
           call psb_geaxpby((2*rho/delta),r,(rho*rho_old),tz,desc_data,info)
 !!$          res  = psb_genrm2(r,desc_data,info)
-!!$          write(0,*) 'Polynomial smoother ',i,res
+!!$          write(0,*) 'Polynomial smoother NEW ',i,res
           ! x_k =  x_{k-1} + z_k
         end do
       end block
@@ -244,205 +239,10 @@ subroutine amg_s_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
     end if
   end associate
 
-
-
-
-!!$  if ((.not.sm%sv%is_iterative()).and.((sweeps == 1).or.(sm%nd_nnz_tot==0))) then
-!!$    !  if .not.sv%is_iterative, there's no need to pass init
-!!$    call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,wv,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 >= 0) then
-!!$    select type (smsv => sm%sv)
-!!$    class is (amg_s_diag_solver_type)
-!!$      !
-!!$      ! This means we are dealing with a pure Jacobi smoother/solver.
-!!$      !
-!!$      associate(tx => wv(1), ty => wv(2))
-!!$        select case (init_)
-!!$        case('Z')
-!!$
-!!$          call sm%sv%apply(sone,x,szero,ty,desc_data,trans_,aux,wv(3:),info,init='Z')
-!!$
-!!$        case('Y')
-!!$          call psb_geaxpby(sone,x,szero,tx,desc_data,info)
-!!$          call psb_geaxpby(sone,y,szero,ty,desc_data,info)
-!!$          call psb_spmm(-sone,sm%pa,ty,sone,tx,desc_data,info,work=aux,trans=trans_)
-!!$          call sm%sv%apply(sone,tx,szero,ty,desc_data,trans_,aux,wv(3:),info,init='Y')
-!!$
-!!$        case('U')
-!!$          if (.not.present(initu)) then
-!!$            call psb_errpush(psb_err_internal_error_,name,&
-!!$                 & a_err='missing initu to smoother_apply')
-!!$            goto 9999
-!!$          end if
-!!$          call psb_geaxpby(sone,x,szero,tx,desc_data,info)
-!!$          call psb_geaxpby(sone,initu,szero,ty,desc_data,info)
-!!$          call psb_spmm(-sone,sm%pa,ty,sone,tx,desc_data,info,work=aux,trans=trans_)
-!!$          call sm%sv%apply(sone,tx,szero,ty,desc_data,trans_,aux,wv(3:),info,init='Y')
-!!$
-!!$        case default
-!!$          call psb_errpush(psb_err_internal_error_,name,&
-!!$               & a_err='wrong  init to smoother_apply')
-!!$          goto 9999
-!!$        end select
-!!$
-!!$        do i=1, sweeps-1
-!!$          !
-!!$          ! Compute Y(j+1) =  Y(j)+ D^(-1)*(X-A*Y(j)),
-!!$          !  where is the diagonal and  A the matrix.
-!!$          !
-!!$          call psb_geaxpby(sone,x,szero,tx,desc_data,info)
-!!$          call psb_spmm(-sone,sm%pa,ty,sone,tx,desc_data,info,work=aux,trans=trans_)
-!!$
-!!$          if (info /= psb_success_) exit
-!!$
-!!$          call sm%sv%apply(sone,tx,sone,ty,desc_data,trans_,aux,wv(3:),info,init='Y')
-!!$
-!!$          if (info /= psb_success_) exit
-!!$
-!!$          if ( sm%checkres.and.(mod(i,sm%checkiter) == 0) ) then
-!!$            call psb_geaxpby(sone,x,szero,r,r,desc_data,info)
-!!$            call psb_spmm(-sone,sm%pa,ty,sone,r,desc_data,info)
-!!$            res  = psb_genrm2(r,desc_data,info)
-!!$            if( sm%printres ) then
-!!$              call log_conv("BJAC",me,i,sm%printiter,res,resdenum,sm%tol)
-!!$            end if
-!!$            if ( res < sm%tol*resdenum ) then
-!!$              if( (sm%printres).and.(mod(sm%printiter,sm%checkiter)/=0) ) &
-!!$               & call log_conv("BJAC",me,i,1,res,resdenum,sm%tol)
-!!$              exit
-!!$            end if
-!!$          end if
-!!$
-!!$        end do
-!!$
-!!$
-!!$        if (info == psb_success_) call psb_geaxpby(alpha,ty,beta,y,desc_data,info)
-!!$
-!!$        if (info /= psb_success_) then
-!!$          info=psb_err_internal_error_
-!!$          call psb_errpush(info,name,&
-!!$               & a_err='subsolve with Jacobi sweeps > 1')
-!!$          goto 9999
-!!$        end if
-!!$
-!!$
-!!$      end associate
-!!$
-!!$    class default
-!!$      !
-!!$      !
-!!$      ! Apply multiple sweeps of a block-Jacobi solver
-!!$      ! to compute an approximate solution of a linear system.
-!!$      !
-!!$      !
-!!$      if (size(wv) < 2) then
-!!$        info = psb_err_internal_error_
-!!$        call psb_errpush(info,name,&
-!!$             & a_err='invalid wv size in smoother_apply')
-!!$        goto 9999
-!!$      end if
-!!$      associate(tx => wv(1), ty => wv(2))
-!!$
-!!$        !
-!!$        !  Unroll  the first iteration and fold it inside SELECT CASE
-!!$        !  this will save one AXPBY and one SPMM when INIT=Z, and will be
-!!$        !  significant when sweeps=1 (a common case)
-!!$        !
-!!$        select case (init_)
-!!$        case('Z')
-!!$
-!!$          call sm%sv%apply(sone,x,szero,ty,desc_data,trans_,aux,wv(3:),info,init='Z')
-!!$
-!!$        case('Y')
-!!$          call psb_geaxpby(sone,x,szero,tx,desc_data,info)
-!!$          call psb_geaxpby(sone,y,szero,ty,desc_data,info)
-!!$          call psb_spmm(-sone,sm%nd,ty,sone,tx,desc_data,info,work=aux,trans=trans_)
-!!$          call sm%sv%apply(sone,tx,szero,ty,desc_data,trans_,aux,wv(3:),info,init='Y')
-!!$
-!!$        case('U')
-!!$          if (.not.present(initu)) then
-!!$            call psb_errpush(psb_err_internal_error_,name,&
-!!$                 & a_err='missing initu to smoother_apply')
-!!$            goto 9999
-!!$          end if
-!!$          call psb_geaxpby(sone,x,szero,tx,desc_data,info)
-!!$          call psb_geaxpby(sone,initu,szero,ty,desc_data,info)
-!!$          call psb_spmm(-sone,sm%nd,ty,sone,tx,desc_data,info,work=aux,trans=trans_)
-!!$          call sm%sv%apply(sone,tx,szero,ty,desc_data,trans_,aux,wv(3:),info,init='Y')
-!!$
-!!$        case default
-!!$          call psb_errpush(psb_err_internal_error_,name,&
-!!$               & a_err='wrong  init to smoother_apply')
-!!$          goto 9999
-!!$        end select
-!!$
-!!$        do i=1, sweeps-1
-!!$          !
-!!$          ! Compute Y(j+1) = D^(-1)*(X-ND*Y(j)), where D and ND are the
-!!$          ! block diagonal part and the remaining part of the local matrix
-!!$          ! and Y(j) is the approximate solution at sweep j.
-!!$          !
-!!$          call psb_geaxpby(sone,x,szero,tx,desc_data,info)
-!!$          call psb_spmm(-sone,sm%nd,ty,sone,tx,desc_data,info,work=aux,trans=trans_)
-!!$
-!!$          if (info /= psb_success_) exit
-!!$
-!!$          call sm%sv%apply(sone,tx,szero,ty,desc_data,trans_,aux,wv(3:),info,init='Y')
-!!$
-!!$          if (info /= psb_success_) exit
-!!$
-!!$          if ( sm%checkres.and.(mod(i,sm%checkiter) == 0) ) then
-!!$            call psb_geaxpby(sone,x,szero,r,r,desc_data,info)
-!!$            call psb_spmm(-sone,sm%pa,ty,sone,r,desc_data,info)
-!!$            res  = psb_genrm2(r,desc_data,info)
-!!$            if( sm%printres ) then
-!!$              call log_conv("BJAC",me,i,sm%printiter,res,resdenum,sm%tol)
-!!$            end if
-!!$            if (res < sm%tol*resdenum ) then
-!!$              if( (sm%printres).and.( mod(sm%printiter,sm%checkiter) /=0 ) ) &
-!!$                & call log_conv("BJAC",me,i,1,res,resdenum,sm%tol)
-!!$              exit
-!!$            end if
-!!$          end if
-!!$
-!!$        end do
-!!$
-!!$        if (info == psb_success_) call psb_geaxpby(alpha,ty,beta,y,desc_data,info)
-!!$
-!!$        if (info /= psb_success_) then
-!!$          info=psb_err_internal_error_
-!!$          call psb_errpush(info,name,&
-!!$               & a_err='subsolve with Jacobi sweeps > 1')
-!!$          goto 9999
-!!$        end if
-!!$
-!!$      end associate
-!!$    end select
-!!$
-!!$  else
-!!$
-!!$    info = psb_err_iarg_neg_
-!!$    call psb_errpush(info,name,&
-!!$         & i_err=(/itwo,sweeps,izero,izero,izero/))
-!!$    goto 9999
-!!$
-!!$  endif
-!!$
   if (.not.(4*n_col <= size(work))) then
     deallocate(aux)
   endif
 
-!!$  if(sm%checkres) then
-!!$    call psb_gefree(r,desc_data,info)
-!!$  end if
-
   call psb_erractionrestore(err_act)
   return