mirror of
https://github.com/sfilippone/amg4psblas.git
synced 2026-10-06 22:55:12 +00:00
mld2p4-2:
mlprec/impl/mld_cprecaply.f90 mlprec/impl/mld_dprecaply.f90 mlprec/impl/mld_sprecaply.f90 mlprec/impl/mld_zprecaply.f90 mlprec/mld_c_prec_type.f90 mlprec/mld_d_prec_type.f90 mlprec/mld_s_prec_type.f90 mlprec/mld_z_prec_type.f90 In mld_prec override the "right" methods, and create apply1_vect
This commit is contained in:
Salvatore Filippone
@@ -267,10 +267,10 @@ end subroutine mld_cprecaply1
|
||||
|
||||
|
||||
|
||||
subroutine mld_cprecaply_vect(prec,x,y,desc_data,info,trans,work)
|
||||
subroutine mld_cprecaply2_vect(prec,x,y,desc_data,info,trans,work)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_c_inner_mod, mld_protect_name => mld_cprecaply_vect
|
||||
use mld_c_inner_mod, mld_protect_name => mld_cprecaply2_vect
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -367,4 +367,111 @@ subroutine mld_cprecaply_vect(prec,x,y,desc_data,info,trans,work)
|
||||
end if
|
||||
return
|
||||
|
||||
end subroutine mld_cprecaply_vect
|
||||
end subroutine mld_cprecaply2_vect
|
||||
|
||||
|
||||
subroutine mld_cprecaply1_vect(prec,x,desc_data,info,trans,work)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_c_inner_mod, mld_protect_name => mld_cprecaply1_vect
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
type(psb_desc_type),intent(in) :: desc_data
|
||||
type(mld_cprec_type), intent(inout) :: prec
|
||||
type(psb_c_vect_type),intent(inout) :: x
|
||||
integer, intent(out) :: info
|
||||
character(len=1), optional :: trans
|
||||
complex(psb_spk_),intent(inout), optional, target :: work(:)
|
||||
|
||||
! Local variables
|
||||
character :: trans_
|
||||
type(psb_c_vect_type) :: ww
|
||||
complex(psb_spk_), pointer :: work_(:)
|
||||
integer :: ictxt,np,me,err_act,iwsz
|
||||
character(len=20) :: name
|
||||
|
||||
name='mld_cprecaply'
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
ictxt = psb_cd_get_context(desc_data)
|
||||
call psb_info(ictxt, me, np)
|
||||
|
||||
if (present(trans)) then
|
||||
trans_=psb_toupper(trans)
|
||||
else
|
||||
trans_='N'
|
||||
end if
|
||||
|
||||
if (present(work)) then
|
||||
work_ => work
|
||||
else
|
||||
iwsz = max(1,4*psb_cd_get_local_cols(desc_data))
|
||||
allocate(work_(iwsz),stat=info)
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_alloc_request_,name,i_err=(/iwsz,0,0,0,0/),&
|
||||
&a_err='complex(psb_spk_)')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
end if
|
||||
|
||||
if (.not.(allocated(prec%precv))) then
|
||||
!! Error 1: should call mld_cprecbld
|
||||
info=3112
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
call psb_geasb(ww,desc_data,info,mold=x%v,scratch=.true.)
|
||||
if (size(prec%precv) >1) then
|
||||
!
|
||||
! Number of levels > 1: apply the multilevel preconditioner
|
||||
!
|
||||
call mld_mlprec_aply(cone,prec,x,czero,ww,desc_data,trans_,work_,info)
|
||||
|
||||
if(info /= psb_success_) then
|
||||
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_cmlprec_aply')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
else if (size(prec%precv) == 1) then
|
||||
!
|
||||
! Number of levels = 1: apply the base preconditioner
|
||||
!
|
||||
call prec%precv(1)%sm%apply(cone,x,czero,ww,desc_data,trans_,&
|
||||
& prec%precv(1)%parms%sweeps, work_,info)
|
||||
|
||||
else
|
||||
|
||||
info = psb_err_from_subroutine_ai_
|
||||
call psb_errpush(info,name,a_err='Invalid size of precv',&
|
||||
& i_Err=(/size(prec%precv),0,0,0,0/))
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (info == 0) call psb_geaxpby(cone,ww,czero,x,desc_data,info)
|
||||
if (info == 0) call psb_gefree(ww,desc_data,info)
|
||||
|
||||
! If the original distribution has an overlap we should fix that.
|
||||
call psb_halo(x,desc_data,info,data=psb_comm_mov_)
|
||||
|
||||
|
||||
if (present(work)) then
|
||||
else
|
||||
deallocate(work_)
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act.eq.psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
|
||||
end subroutine mld_cprecaply1_vect
|
||||
|
||||
@@ -267,10 +267,10 @@ end subroutine mld_dprecaply1
|
||||
|
||||
|
||||
|
||||
subroutine mld_dprecaply_vect(prec,x,y,desc_data,info,trans,work)
|
||||
subroutine mld_dprecaply2_vect(prec,x,y,desc_data,info,trans,work)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_d_inner_mod, mld_protect_name => mld_dprecaply_vect
|
||||
use mld_d_inner_mod, mld_protect_name => mld_dprecaply2_vect
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -367,4 +367,112 @@ subroutine mld_dprecaply_vect(prec,x,y,desc_data,info,trans,work)
|
||||
end if
|
||||
return
|
||||
|
||||
end subroutine mld_dprecaply_vect
|
||||
end subroutine mld_dprecaply2_vect
|
||||
|
||||
|
||||
|
||||
subroutine mld_dprecaply1_vect(prec,x,desc_data,info,trans,work)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_d_inner_mod, mld_protect_name => mld_dprecaply1_vect
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
type(psb_desc_type),intent(in) :: desc_data
|
||||
type(mld_dprec_type), intent(inout) :: prec
|
||||
type(psb_d_vect_type),intent(inout) :: x
|
||||
integer, intent(out) :: info
|
||||
character(len=1), optional :: trans
|
||||
real(psb_dpk_),intent(inout), optional, target :: work(:)
|
||||
|
||||
! Local variables
|
||||
character :: trans_
|
||||
type(psb_d_vect_type) :: ww
|
||||
real(psb_dpk_), pointer :: work_(:)
|
||||
integer :: ictxt,np,me,err_act,iwsz
|
||||
character(len=20) :: name
|
||||
|
||||
name='mld_dprecaply'
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
ictxt = psb_cd_get_context(desc_data)
|
||||
call psb_info(ictxt, me, np)
|
||||
|
||||
if (present(trans)) then
|
||||
trans_=psb_toupper(trans)
|
||||
else
|
||||
trans_='N'
|
||||
end if
|
||||
|
||||
if (present(work)) then
|
||||
work_ => work
|
||||
else
|
||||
iwsz = max(1,4*psb_cd_get_local_cols(desc_data))
|
||||
allocate(work_(iwsz),stat=info)
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_alloc_request_,name,i_err=(/iwsz,0,0,0,0/),&
|
||||
&a_err='real(psb_dpk_)')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
end if
|
||||
|
||||
if (.not.(allocated(prec%precv))) then
|
||||
!! Error 1: should call mld_dprecbld
|
||||
info=3112
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
call psb_geasb(ww,desc_data,info,mold=x%v,scratch=.true.)
|
||||
if (size(prec%precv) >1) then
|
||||
!
|
||||
! Number of levels > 1: apply the multilevel preconditioner
|
||||
!
|
||||
call mld_mlprec_aply(done,prec,x,dzero,ww,desc_data,trans_,work_,info)
|
||||
|
||||
if(info /= psb_success_) then
|
||||
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_dmlprec_aply')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
else if (size(prec%precv) == 1) then
|
||||
!
|
||||
! Number of levels = 1: apply the base preconditioner
|
||||
!
|
||||
call prec%precv(1)%sm%apply(done,x,dzero,ww,desc_data,trans_,&
|
||||
& prec%precv(1)%parms%sweeps, work_,info)
|
||||
|
||||
else
|
||||
|
||||
info = psb_err_from_subroutine_ai_
|
||||
call psb_errpush(info,name,a_err='Invalid size of precv',&
|
||||
& i_Err=(/size(prec%precv),0,0,0,0/))
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (info == 0) call psb_geaxpby(done,ww,dzero,x,desc_data,info)
|
||||
if (info == 0) call psb_gefree(ww,desc_data,info)
|
||||
|
||||
! If the original distribution has an overlap we should fix that.
|
||||
call psb_halo(x,desc_data,info,data=psb_comm_mov_)
|
||||
|
||||
|
||||
if (present(work)) then
|
||||
else
|
||||
deallocate(work_)
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act.eq.psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
|
||||
end subroutine mld_dprecaply1_vect
|
||||
|
||||
@@ -267,10 +267,10 @@ end subroutine mld_sprecaply1
|
||||
|
||||
|
||||
|
||||
subroutine mld_sprecaply_vect(prec,x,y,desc_data,info,trans,work)
|
||||
subroutine mld_sprecaply2_vect(prec,x,y,desc_data,info,trans,work)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_s_inner_mod, mld_protect_name => mld_sprecaply_vect
|
||||
use mld_s_inner_mod, mld_protect_name => mld_sprecaply2_vect
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -367,4 +367,110 @@ subroutine mld_sprecaply_vect(prec,x,y,desc_data,info,trans,work)
|
||||
end if
|
||||
return
|
||||
|
||||
end subroutine mld_sprecaply_vect
|
||||
end subroutine mld_sprecaply2_vect
|
||||
|
||||
subroutine mld_sprecaply1_vect(prec,x,desc_data,info,trans,work)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_s_inner_mod, mld_protect_name => mld_sprecaply1_vect
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
type(psb_desc_type),intent(in) :: desc_data
|
||||
type(mld_sprec_type), intent(inout) :: prec
|
||||
type(psb_s_vect_type),intent(inout) :: x
|
||||
integer, intent(out) :: info
|
||||
character(len=1), optional :: trans
|
||||
real(psb_spk_),intent(inout), optional, target :: work(:)
|
||||
|
||||
! Local variables
|
||||
character :: trans_
|
||||
type(psb_s_vect_type) :: ww
|
||||
real(psb_spk_), pointer :: work_(:)
|
||||
integer :: ictxt,np,me,err_act,iwsz
|
||||
character(len=20) :: name
|
||||
|
||||
name='mld_sprecaply'
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
ictxt = psb_cd_get_context(desc_data)
|
||||
call psb_info(ictxt, me, np)
|
||||
|
||||
if (present(trans)) then
|
||||
trans_=psb_toupper(trans)
|
||||
else
|
||||
trans_='N'
|
||||
end if
|
||||
|
||||
if (present(work)) then
|
||||
work_ => work
|
||||
else
|
||||
iwsz = max(1,4*psb_cd_get_local_cols(desc_data))
|
||||
allocate(work_(iwsz),stat=info)
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_alloc_request_,name,i_err=(/iwsz,0,0,0,0/),&
|
||||
&a_err='real(psb_dpk_)')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
end if
|
||||
|
||||
if (.not.(allocated(prec%precv))) then
|
||||
!! Error 1: should call mld_dprecbld
|
||||
info=3112
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
call psb_geasb(ww,desc_data,info,mold=x%v,scratch=.true.)
|
||||
if (size(prec%precv) >1) then
|
||||
!
|
||||
! Number of levels > 1: apply the multilevel preconditioner
|
||||
!
|
||||
call mld_mlprec_aply(sone,prec,x,szero,ww,desc_data,trans_,work_,info)
|
||||
|
||||
if(info /= psb_success_) then
|
||||
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_smlprec_aply')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
else if (size(prec%precv) == 1) then
|
||||
!
|
||||
! Number of levels = 1: apply the base preconditioner
|
||||
!
|
||||
call prec%precv(1)%sm%apply(sone,x,szero,ww,desc_data,trans_,&
|
||||
& prec%precv(1)%parms%sweeps, work_,info)
|
||||
|
||||
else
|
||||
|
||||
info = psb_err_from_subroutine_ai_
|
||||
call psb_errpush(info,name,a_err='Invalid size of precv',&
|
||||
& i_Err=(/size(prec%precv),0,0,0,0/))
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (info == 0) call psb_geaxpby(sone,ww,szero,x,desc_data,info)
|
||||
if (info == 0) call psb_gefree(ww,desc_data,info)
|
||||
|
||||
! If the original distribution has an overlap we should fix that.
|
||||
call psb_halo(x,desc_data,info,data=psb_comm_mov_)
|
||||
|
||||
|
||||
if (present(work)) then
|
||||
else
|
||||
deallocate(work_)
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act.eq.psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
|
||||
end subroutine mld_sprecaply1_vect
|
||||
|
||||
@@ -267,10 +267,10 @@ end subroutine mld_zprecaply1
|
||||
|
||||
|
||||
|
||||
subroutine mld_zprecaply_vect(prec,x,y,desc_data,info,trans,work)
|
||||
subroutine mld_zprecaply2_vect(prec,x,y,desc_data,info,trans,work)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_z_inner_mod, mld_protect_name => mld_zprecaply_vect
|
||||
use mld_z_inner_mod, mld_protect_name => mld_zprecaply2_vect
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -367,4 +367,111 @@ subroutine mld_zprecaply_vect(prec,x,y,desc_data,info,trans,work)
|
||||
end if
|
||||
return
|
||||
|
||||
end subroutine mld_zprecaply_vect
|
||||
end subroutine mld_zprecaply2_vect
|
||||
|
||||
|
||||
subroutine mld_zprecaply1_vect(prec,x,desc_data,info,trans,work)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_z_inner_mod, mld_protect_name => mld_zprecaply1_vect
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
type(psb_desc_type),intent(in) :: desc_data
|
||||
type(mld_zprec_type), intent(inout) :: prec
|
||||
type(psb_z_vect_type),intent(inout) :: x
|
||||
integer, intent(out) :: info
|
||||
character(len=1), optional :: trans
|
||||
complex(psb_dpk_),intent(inout), optional, target :: work(:)
|
||||
|
||||
! Local variables
|
||||
character :: trans_
|
||||
type(psb_z_vect_type) :: ww
|
||||
complex(psb_dpk_), pointer :: work_(:)
|
||||
integer :: ictxt,np,me,err_act,iwsz
|
||||
character(len=20) :: name
|
||||
|
||||
name='mld_zprecaply'
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
ictxt = psb_cd_get_context(desc_data)
|
||||
call psb_info(ictxt, me, np)
|
||||
|
||||
if (present(trans)) then
|
||||
trans_=psb_toupper(trans)
|
||||
else
|
||||
trans_='N'
|
||||
end if
|
||||
|
||||
if (present(work)) then
|
||||
work_ => work
|
||||
else
|
||||
iwsz = max(1,4*psb_cd_get_local_cols(desc_data))
|
||||
allocate(work_(iwsz),stat=info)
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_alloc_request_,name,i_err=(/iwsz,0,0,0,0/),&
|
||||
&a_err='complex(psb_dpk_)')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
end if
|
||||
|
||||
if (.not.(allocated(prec%precv))) then
|
||||
!! Error 1: should call mld_zprecbld
|
||||
info=3112
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
call psb_geasb(ww,desc_data,info,mold=x%v,scratch=.true.)
|
||||
if (size(prec%precv) >1) then
|
||||
!
|
||||
! Number of levels > 1: apply the multilevel preconditioner
|
||||
!
|
||||
call mld_mlprec_aply(zone,prec,x,zzero,ww,desc_data,trans_,work_,info)
|
||||
|
||||
if(info /= psb_success_) then
|
||||
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_zmlprec_aply')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
else if (size(prec%precv) == 1) then
|
||||
!
|
||||
! Number of levels = 1: apply the base preconditioner
|
||||
!
|
||||
call prec%precv(1)%sm%apply(zone,x,zzero,ww,desc_data,trans_,&
|
||||
& prec%precv(1)%parms%sweeps, work_,info)
|
||||
|
||||
else
|
||||
|
||||
info = psb_err_from_subroutine_ai_
|
||||
call psb_errpush(info,name,a_err='Invalid size of precv',&
|
||||
& i_Err=(/size(prec%precv),0,0,0,0/))
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (info == 0) call psb_geaxpby(zone,ww,zzero,x,desc_data,info)
|
||||
if (info == 0) call psb_gefree(ww,desc_data,info)
|
||||
|
||||
! If the original distribution has an overlap we should fix that.
|
||||
call psb_halo(x,desc_data,info,data=psb_comm_mov_)
|
||||
|
||||
|
||||
if (present(work)) then
|
||||
else
|
||||
deallocate(work_)
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act.eq.psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
|
||||
end subroutine mld_zprecaply1_vect
|
||||
|
||||
@@ -84,9 +84,10 @@ module mld_c_prec_type
|
||||
real(psb_spk_) :: op_complexity=szero
|
||||
type(mld_c_onelev_type), allocatable :: precv(:)
|
||||
contains
|
||||
procedure, pass(prec) :: c_apply2_vect => mld_c_apply2_vect
|
||||
procedure, pass(prec) :: c_apply2v => mld_c_apply2v
|
||||
procedure, pass(prec) :: c_apply1v => mld_c_apply1v
|
||||
procedure, pass(prec) :: psb_c_apply2_vect => mld_c_apply2_vect
|
||||
procedure, pass(prec) :: psb_c_apply1_vect => mld_c_apply1_vect
|
||||
procedure, pass(prec) :: psb_c_apply2v => mld_c_apply2v
|
||||
procedure, pass(prec) :: psb_c_apply1v => mld_c_apply1v
|
||||
procedure, pass(prec) :: dump => mld_c_dump
|
||||
procedure, pass(prec) :: get_complexity => mld_c_get_compl
|
||||
procedure, pass(prec) :: cmp_complexity => mld_c_cmp_compl
|
||||
@@ -116,7 +117,7 @@ module mld_c_prec_type
|
||||
end interface
|
||||
|
||||
interface mld_precaply
|
||||
subroutine mld_cprecaply_vect(prec,x,y,desc_data,info,trans,work)
|
||||
subroutine mld_cprecaply2_vect(prec,x,y,desc_data,info,trans,work)
|
||||
import :: psb_cspmat_type, psb_desc_type, &
|
||||
& psb_spk_, psb_c_vect_type, mld_cprec_type
|
||||
type(psb_desc_type),intent(in) :: desc_data
|
||||
@@ -126,7 +127,17 @@ module mld_c_prec_type
|
||||
integer, intent(out) :: info
|
||||
character(len=1), optional :: trans
|
||||
complex(psb_spk_),intent(inout), optional, target :: work(:)
|
||||
end subroutine mld_cprecaply_vect
|
||||
end subroutine mld_cprecaply2_vect
|
||||
subroutine mld_cprecaply1_vect(prec,x,desc_data,info,trans,work)
|
||||
import :: psb_cspmat_type, psb_desc_type, &
|
||||
& psb_spk_, psb_c_vect_type, mld_cprec_type
|
||||
type(psb_desc_type),intent(in) :: desc_data
|
||||
type(mld_cprec_type), intent(inout) :: prec
|
||||
type(psb_c_vect_type),intent(inout) :: x
|
||||
integer, intent(out) :: info
|
||||
character(len=1), optional :: trans
|
||||
complex(psb_spk_),intent(inout), optional, target :: work(:)
|
||||
end subroutine mld_cprecaply1_vect
|
||||
subroutine mld_cprecaply(prec,x,y,desc_data,info,trans,work)
|
||||
import :: psb_cspmat_type, psb_desc_type, psb_spk_, mld_cprec_type
|
||||
type(psb_desc_type),intent(in) :: desc_data
|
||||
@@ -428,6 +439,41 @@ contains
|
||||
|
||||
end subroutine mld_c_apply2_vect
|
||||
|
||||
subroutine mld_c_apply1_vect(prec,x,desc_data,info,trans,work)
|
||||
use psb_base_mod
|
||||
type(psb_desc_type),intent(in) :: desc_data
|
||||
class(mld_cprec_type), intent(inout) :: prec
|
||||
type(psb_c_vect_type),intent(inout) :: x
|
||||
integer, intent(out) :: info
|
||||
character(len=1), optional :: trans
|
||||
complex(psb_spk_),intent(inout), optional, target :: work(:)
|
||||
Integer :: err_act
|
||||
character(len=20) :: name='d_prec_apply'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select type(prec)
|
||||
type is (mld_cprec_type)
|
||||
call mld_precaply(prec,x,desc_data,info,trans,work)
|
||||
class default
|
||||
info = psb_err_missing_override_method_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end select
|
||||
|
||||
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 mld_c_apply1_vect
|
||||
|
||||
|
||||
subroutine mld_c_apply2v(prec,x,y,desc_data,info,trans,work)
|
||||
use psb_base_mod
|
||||
|
||||
@@ -84,9 +84,10 @@ module mld_d_prec_type
|
||||
real(psb_dpk_) :: op_complexity=dzero
|
||||
type(mld_d_onelev_type), allocatable :: precv(:)
|
||||
contains
|
||||
procedure, pass(prec) :: d_apply2_vect => mld_d_apply2_vect
|
||||
procedure, pass(prec) :: d_apply2v => mld_d_apply2v
|
||||
procedure, pass(prec) :: d_apply1v => mld_d_apply1v
|
||||
procedure, pass(prec) :: psb_d_apply2_vect => mld_d_apply2_vect
|
||||
procedure, pass(prec) :: psb_d_apply1_vect => mld_d_apply1_vect
|
||||
procedure, pass(prec) :: psb_d_apply2v => mld_d_apply2v
|
||||
procedure, pass(prec) :: psb_d_apply1v => mld_d_apply1v
|
||||
procedure, pass(prec) :: dump => mld_d_dump
|
||||
procedure, pass(prec) :: get_complexity => mld_d_get_compl
|
||||
procedure, pass(prec) :: cmp_complexity => mld_d_cmp_compl
|
||||
@@ -116,7 +117,7 @@ module mld_d_prec_type
|
||||
end interface
|
||||
|
||||
interface mld_precaply
|
||||
subroutine mld_dprecaply_vect(prec,x,y,desc_data,info,trans,work)
|
||||
subroutine mld_dprecaply2_vect(prec,x,y,desc_data,info,trans,work)
|
||||
import :: psb_dspmat_type, psb_desc_type, &
|
||||
& psb_dpk_, psb_d_vect_type, mld_dprec_type
|
||||
type(psb_desc_type),intent(in) :: desc_data
|
||||
@@ -126,7 +127,17 @@ module mld_d_prec_type
|
||||
integer, intent(out) :: info
|
||||
character(len=1), optional :: trans
|
||||
real(psb_dpk_),intent(inout), optional, target :: work(:)
|
||||
end subroutine mld_dprecaply_vect
|
||||
end subroutine mld_dprecaply2_vect
|
||||
subroutine mld_dprecaply1_vect(prec,x,desc_data,info,trans,work)
|
||||
import :: psb_dspmat_type, psb_desc_type, &
|
||||
& psb_dpk_, psb_d_vect_type, mld_dprec_type
|
||||
type(psb_desc_type),intent(in) :: desc_data
|
||||
type(mld_dprec_type), intent(inout) :: prec
|
||||
type(psb_d_vect_type),intent(inout) :: x
|
||||
integer, intent(out) :: info
|
||||
character(len=1), optional :: trans
|
||||
real(psb_dpk_),intent(inout), optional, target :: work(:)
|
||||
end subroutine mld_dprecaply1_vect
|
||||
subroutine mld_dprecaply(prec,x,y,desc_data,info,trans,work)
|
||||
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, mld_dprec_type
|
||||
type(psb_desc_type),intent(in) :: desc_data
|
||||
@@ -428,6 +439,41 @@ contains
|
||||
|
||||
end subroutine mld_d_apply2_vect
|
||||
|
||||
subroutine mld_d_apply1_vect(prec,x,desc_data,info,trans,work)
|
||||
use psb_base_mod
|
||||
type(psb_desc_type),intent(in) :: desc_data
|
||||
class(mld_dprec_type), intent(inout) :: prec
|
||||
type(psb_d_vect_type),intent(inout) :: x
|
||||
integer, intent(out) :: info
|
||||
character(len=1), optional :: trans
|
||||
real(psb_dpk_),intent(inout), optional, target :: work(:)
|
||||
Integer :: err_act
|
||||
character(len=20) :: name='d_prec_apply'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select type(prec)
|
||||
type is (mld_dprec_type)
|
||||
call mld_precaply(prec,x,desc_data,info,trans,work)
|
||||
class default
|
||||
info = psb_err_missing_override_method_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end select
|
||||
|
||||
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 mld_d_apply1_vect
|
||||
|
||||
|
||||
subroutine mld_d_apply2v(prec,x,y,desc_data,info,trans,work)
|
||||
use psb_base_mod
|
||||
|
||||
@@ -84,9 +84,10 @@ module mld_s_prec_type
|
||||
real(psb_spk_) :: op_complexity=szero
|
||||
type(mld_s_onelev_type), allocatable :: precv(:)
|
||||
contains
|
||||
procedure, pass(prec) :: s_apply2_vect => mld_s_apply2_vect
|
||||
procedure, pass(prec) :: s_apply2v => mld_s_apply2v
|
||||
procedure, pass(prec) :: s_apply1v => mld_s_apply1v
|
||||
procedure, pass(prec) :: psb_s_apply2_vect => mld_s_apply2_vect
|
||||
procedure, pass(prec) :: psb_s_apply1_vect => mld_s_apply1_vect
|
||||
procedure, pass(prec) :: psb_s_apply2v => mld_s_apply2v
|
||||
procedure, pass(prec) :: psb_s_apply1v => mld_s_apply1v
|
||||
procedure, pass(prec) :: dump => mld_s_dump
|
||||
procedure, pass(prec) :: get_complexity => mld_s_get_compl
|
||||
procedure, pass(prec) :: cmp_complexity => mld_s_cmp_compl
|
||||
@@ -116,7 +117,7 @@ module mld_s_prec_type
|
||||
end interface
|
||||
|
||||
interface mld_precaply
|
||||
subroutine mld_sprecaply_vect(prec,x,y,desc_data,info,trans,work)
|
||||
subroutine mld_sprecaply2_vect(prec,x,y,desc_data,info,trans,work)
|
||||
import :: psb_sspmat_type, psb_desc_type, &
|
||||
& psb_spk_, psb_s_vect_type, mld_sprec_type
|
||||
type(psb_desc_type),intent(in) :: desc_data
|
||||
@@ -126,7 +127,17 @@ module mld_s_prec_type
|
||||
integer, intent(out) :: info
|
||||
character(len=1), optional :: trans
|
||||
real(psb_spk_),intent(inout), optional, target :: work(:)
|
||||
end subroutine mld_sprecaply_vect
|
||||
end subroutine mld_sprecaply2_vect
|
||||
subroutine mld_sprecaply1_vect(prec,x,desc_data,info,trans,work)
|
||||
import :: psb_sspmat_type, psb_desc_type, &
|
||||
& psb_spk_, psb_s_vect_type, mld_sprec_type
|
||||
type(psb_desc_type),intent(in) :: desc_data
|
||||
type(mld_sprec_type), intent(inout) :: prec
|
||||
type(psb_s_vect_type),intent(inout) :: x
|
||||
integer, intent(out) :: info
|
||||
character(len=1), optional :: trans
|
||||
real(psb_spk_),intent(inout), optional, target :: work(:)
|
||||
end subroutine mld_sprecaply1_vect
|
||||
subroutine mld_sprecaply(prec,x,y,desc_data,info,trans,work)
|
||||
import :: psb_sspmat_type, psb_desc_type, psb_spk_, mld_sprec_type
|
||||
type(psb_desc_type),intent(in) :: desc_data
|
||||
@@ -428,6 +439,41 @@ contains
|
||||
|
||||
end subroutine mld_s_apply2_vect
|
||||
|
||||
subroutine mld_s_apply1_vect(prec,x,desc_data,info,trans,work)
|
||||
use psb_base_mod
|
||||
type(psb_desc_type),intent(in) :: desc_data
|
||||
class(mld_sprec_type), intent(inout) :: prec
|
||||
type(psb_s_vect_type),intent(inout) :: x
|
||||
integer, intent(out) :: info
|
||||
character(len=1), optional :: trans
|
||||
real(psb_spk_),intent(inout), optional, target :: work(:)
|
||||
Integer :: err_act
|
||||
character(len=20) :: name='d_prec_apply'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select type(prec)
|
||||
type is (mld_sprec_type)
|
||||
call mld_precaply(prec,x,desc_data,info,trans,work)
|
||||
class default
|
||||
info = psb_err_missing_override_method_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end select
|
||||
|
||||
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 mld_s_apply1_vect
|
||||
|
||||
|
||||
subroutine mld_s_apply2v(prec,x,y,desc_data,info,trans,work)
|
||||
use psb_base_mod
|
||||
|
||||
@@ -84,9 +84,10 @@ module mld_z_prec_type
|
||||
real(psb_dpk_) :: op_complexity=dzero
|
||||
type(mld_z_onelev_type), allocatable :: precv(:)
|
||||
contains
|
||||
procedure, pass(prec) :: z_apply2_vect => mld_z_apply2_vect
|
||||
procedure, pass(prec) :: z_apply2v => mld_z_apply2v
|
||||
procedure, pass(prec) :: z_apply1v => mld_z_apply1v
|
||||
procedure, pass(prec) :: psb_z_apply2_vect => mld_z_apply2_vect
|
||||
procedure, pass(prec) :: psb_z_apply1_vect => mld_z_apply1_vect
|
||||
procedure, pass(prec) :: psb_z_apply2v => mld_z_apply2v
|
||||
procedure, pass(prec) :: psb_z_apply1v => mld_z_apply1v
|
||||
procedure, pass(prec) :: dump => mld_z_dump
|
||||
procedure, pass(prec) :: get_complexity => mld_z_get_compl
|
||||
procedure, pass(prec) :: cmp_complexity => mld_z_cmp_compl
|
||||
@@ -116,7 +117,7 @@ module mld_z_prec_type
|
||||
end interface
|
||||
|
||||
interface mld_precaply
|
||||
subroutine mld_zprecaply_vect(prec,x,y,desc_data,info,trans,work)
|
||||
subroutine mld_zprecaply2_vect(prec,x,y,desc_data,info,trans,work)
|
||||
import :: psb_zspmat_type, psb_desc_type, &
|
||||
& psb_dpk_, psb_z_vect_type, mld_zprec_type
|
||||
type(psb_desc_type),intent(in) :: desc_data
|
||||
@@ -126,7 +127,17 @@ module mld_z_prec_type
|
||||
integer, intent(out) :: info
|
||||
character(len=1), optional :: trans
|
||||
complex(psb_dpk_),intent(inout), optional, target :: work(:)
|
||||
end subroutine mld_zprecaply_vect
|
||||
end subroutine mld_zprecaply2_vect
|
||||
subroutine mld_zprecaply1_vect(prec,x,desc_data,info,trans,work)
|
||||
import :: psb_zspmat_type, psb_desc_type, &
|
||||
& psb_dpk_, psb_z_vect_type, mld_zprec_type
|
||||
type(psb_desc_type),intent(in) :: desc_data
|
||||
type(mld_zprec_type), intent(inout) :: prec
|
||||
type(psb_z_vect_type),intent(inout) :: x
|
||||
integer, intent(out) :: info
|
||||
character(len=1), optional :: trans
|
||||
complex(psb_dpk_),intent(inout), optional, target :: work(:)
|
||||
end subroutine mld_zprecaply1_vect
|
||||
subroutine mld_zprecaply(prec,x,y,desc_data,info,trans,work)
|
||||
import :: psb_zspmat_type, psb_desc_type, psb_dpk_, mld_zprec_type
|
||||
type(psb_desc_type),intent(in) :: desc_data
|
||||
@@ -428,6 +439,41 @@ contains
|
||||
|
||||
end subroutine mld_z_apply2_vect
|
||||
|
||||
subroutine mld_z_apply1_vect(prec,x,desc_data,info,trans,work)
|
||||
use psb_base_mod
|
||||
type(psb_desc_type),intent(in) :: desc_data
|
||||
class(mld_zprec_type), intent(inout) :: prec
|
||||
type(psb_z_vect_type),intent(inout) :: x
|
||||
integer, intent(out) :: info
|
||||
character(len=1), optional :: trans
|
||||
complex(psb_dpk_),intent(inout), optional, target :: work(:)
|
||||
Integer :: err_act
|
||||
character(len=20) :: name='d_prec_apply'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select type(prec)
|
||||
type is (mld_zprec_type)
|
||||
call mld_precaply(prec,x,desc_data,info,trans,work)
|
||||
class default
|
||||
info = psb_err_missing_override_method_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end select
|
||||
|
||||
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 mld_z_apply1_vect
|
||||
|
||||
|
||||
subroutine mld_z_apply2v(prec,x,y,desc_data,info,trans,work)
|
||||
use psb_base_mod
|
||||
|
||||
Reference in New Issue
Block a user