You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
psblas3/prec/impl/psb_s_nullprec_impl.f90

108 lines
2.9 KiB
Fortran

psblas3: prec/Makefile prec/impl/Makefile prec/impl/psb_c_bjacprec_impl.f90 prec/impl/psb_c_diagprec_impl.f90 prec/impl/psb_c_nullprec_impl.f90 prec/impl/psb_cilu_fct.f90 prec/impl/psb_cprecbld.f90 prec/impl/psb_cprecinit.f90 prec/impl/psb_cprecset.f90 prec/impl/psb_d_bjacprec_impl.f90 prec/impl/psb_d_diagprec_impl.f90 prec/impl/psb_d_nullprec_impl.f90 prec/impl/psb_dilu_fct.f90 prec/impl/psb_dprecbld.f90 prec/impl/psb_dprecinit.f90 prec/impl/psb_dprecset.f90 prec/impl/psb_s_bjacprec_impl.f90 prec/impl/psb_s_diagprec_impl.f90 prec/impl/psb_s_nullprec_impl.f90 prec/impl/psb_silu_fct.f90 prec/impl/psb_sprecbld.f90 prec/impl/psb_sprecinit.f90 prec/impl/psb_sprecset.f90 prec/impl/psb_z_bjacprec_impl.f90 prec/impl/psb_z_diagprec_impl.f90 prec/impl/psb_z_nullprec_impl.f90 prec/impl/psb_zilu_fct.f90 prec/impl/psb_zprecbld.f90 prec/impl/psb_zprecinit.f90 prec/impl/psb_zprecset.f90 prec/psb_c_base_prec_mod.f90 prec/psb_c_bjacprec.f90 prec/psb_c_diagprec.f90 prec/psb_c_nullprec.f90 prec/psb_cilu_fct.f90 prec/psb_cprecbld.f90 prec/psb_cprecinit.f90 prec/psb_cprecset.f90 prec/psb_d_base_prec_mod.f90 prec/psb_d_bjacprec.f90 prec/psb_d_diagprec.f90 prec/psb_d_nullprec.f90 prec/psb_dilu_fct.f90 prec/psb_dprecbld.f90 prec/psb_dprecinit.f90 prec/psb_dprecset.f90 prec/psb_s_base_prec_mod.f90 prec/psb_s_bjacprec.f90 prec/psb_s_diagprec.f90 prec/psb_s_nullprec.f90 prec/psb_silu_fct.f90 prec/psb_sprecbld.f90 prec/psb_sprecinit.f90 prec/psb_sprecset.f90 prec/psb_z_base_prec_mod.f90 prec/psb_z_bjacprec.f90 prec/psb_z_diagprec.f90 prec/psb_z_nullprec.f90 prec/psb_zilu_fct.f90 prec/psb_zprecbld.f90 prec/psb_zprecinit.f90 prec/psb_zprecset.f90 Split and reorganization of PREC subdir (from preprocessing). Split of preconditioners into interface/implementation.
13 years ago
subroutine psb_s_null_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
use psb_base_mod
use psb_s_nullprec, psb_protect_name => psb_s_null_apply_vect
implicit none
type(psb_desc_type),intent(in) :: desc_data
class(psb_s_null_prec_type), intent(inout) :: prec
type(psb_s_vect_type),intent(inout) :: x
real(psb_spk_),intent(in) :: alpha, beta
type(psb_s_vect_type),intent(inout) :: y
integer, intent(out) :: info
character(len=1), optional :: trans
real(psb_spk_),intent(inout), optional, target :: work(:)
Integer :: err_act, nrow
character(len=20) :: name='c_null_prec_apply'
call psb_erractionsave(err_act)
!
! This is the base version and we should throw an error.
! Or should it be the NULL preonditioner???
!
info = psb_success_
nrow = desc_data%get_local_rows()
if (x%get_nrows() < nrow) then
info = 36
call psb_errpush(info,name,i_err=(/2,nrow,0,0,0/))
goto 9999
end if
if (y%get_nrows() < nrow) then
info = 36
call psb_errpush(info,name,i_err=(/3,nrow,0,0,0/))
goto 9999
end if
call psb_geaxpby(alpha,x,beta,y,desc_data,info)
if (info /= psb_success_ ) then
info = psb_err_from_subroutine_
call psb_errpush(info,name,a_err="psb_geaxpby")
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_s_null_apply_vect
subroutine psb_s_null_apply(alpha,prec,x,beta,y,desc_data,info,trans,work)
use psb_base_mod
use psb_s_nullprec, psb_protect_name => psb_s_null_apply
implicit none
type(psb_desc_type),intent(in) :: desc_data
class(psb_s_null_prec_type), intent(in) :: prec
real(psb_spk_),intent(inout) :: x(:)
real(psb_spk_),intent(in) :: alpha, beta
real(psb_spk_),intent(inout) :: y(:)
integer, intent(out) :: info
character(len=1), optional :: trans
real(psb_spk_),intent(inout), optional, target :: work(:)
Integer :: err_act, nrow
character(len=20) :: name='c_null_prec_apply'
call psb_erractionsave(err_act)
!
!
info = psb_success_
nrow = desc_data%get_local_rows()
if (size(x) < nrow) then
info = 36
call psb_errpush(info,name,i_err=(/2,nrow,0,0,0/))
goto 9999
end if
if (size(y) < nrow) then
info = 36
call psb_errpush(info,name,i_err=(/3,nrow,0,0,0/))
goto 9999
end if
call psb_geaxpby(alpha,x,beta,y,desc_data,info)
if (info /= psb_success_ ) then
info = psb_err_from_subroutine_
call psb_errpush(info,name,a_err="psb_geaxpby")
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_s_null_apply