fdurastante
/
amg4psblas
mirror of https://github.com/sfilippone/amg4psblas.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

mld2p4-2:

Browse Source 
mlprec/impl/mld_cprecaply.f90
 mlprec/impl/mld_cprecinit.F90
 mlprec/impl/mld_cprecset.F90
 mlprec/impl/mld_dprecaply.f90
 mlprec/impl/mld_dprecinit.F90
 mlprec/impl/mld_dprecset.F90
 mlprec/impl/mld_sprecaply.f90
 mlprec/impl/mld_sprecinit.F90
 mlprec/impl/mld_sprecset.F90
 mlprec/impl/mld_zprecaply.f90
 mlprec/impl/mld_zprecinit.F90
 mlprec/impl/mld_zprecset.F90


precaply under preprocessing, and fix integer kinds for precinit/precset.
stopcriterion
Salvatore Filippone 12 years ago
parent 3906179e58
commit 983833679d
12 changed files with 298 additions and 266 deletions
Show Stats Download Patch File Download Diff File

46
mlprec/impl/mld_cprecaply.f90
Unescape Escape View File

@ -83,14 +83,15 @@ subroutine mld_cprecaply(prec,x,y,desc_data,info,trans,work)
type(mld_cprec_type), intent(in) :: prec type(mld_cprec_type), intent(in) :: prec
complex(psb_spk_),intent(inout) :: x(:) complex(psb_spk_),intent(inout) :: x(:)
complex(psb_spk_),intent(inout) :: y(:) complex(psb_spk_),intent(inout) :: y(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
complex(psb_spk_),intent(inout), optional, target :: work(:) complex(psb_spk_),intent(inout), optional, target :: work(:)
! Local variables ! Local variables
character :: trans_ character :: trans_
complex(psb_spk_), pointer :: work_(:) complex(psb_spk_), pointer :: work_(:)
integer :: ictxt,np,me,err_act,iwsz integer(psb_mpik_) :: ictxt,np,me
integer(psb_ipk_) :: err_act,iwsz
character(len=20) :: name character(len=20) :: name
name='mld_cprecaply' name='mld_cprecaply'
@ -112,7 +113,8 @@ subroutine mld_cprecaply(prec,x,y,desc_data,info,trans,work)
iwsz = max(1,4*desc_data%get_local_cols()) iwsz = max(1,4*desc_data%get_local_cols())
allocate(work_(iwsz),stat=info) allocate(work_(iwsz),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_request_,name,i_err=(/iwsz,0,0,0,0/),& call psb_errpush(psb_err_alloc_request_,name, &
& i_err=(/iwsz,izero,izero,izero,izero/),&
& a_err='complex(psb_spk_)') & a_err='complex(psb_spk_)')
goto 9999 goto 9999
end if end if
@ -145,7 +147,7 @@ subroutine mld_cprecaply(prec,x,y,desc_data,info,trans,work)
else else
info = psb_err_from_subroutine_ai_ info = psb_err_from_subroutine_ai_
call psb_errpush(info,name,a_err='Invalid size of precv',& call psb_errpush(info,name,a_err='Invalid size of precv',&
& i_Err=(/size(prec%precv),0,0,0,0/)) & i_Err=(/ione*size(prec%precv),izero,izero,izero,izero/))
goto 9999 goto 9999
endif endif
@ -215,11 +217,12 @@ subroutine mld_cprecaply1(prec,x,desc_data,info,trans)
type(psb_desc_type),intent(in) :: desc_data type(psb_desc_type),intent(in) :: desc_data
type(mld_cprec_type), intent(in) :: prec type(mld_cprec_type), intent(in) :: prec
complex(psb_spk_),intent(inout) :: x(:) complex(psb_spk_),intent(inout) :: x(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
! Local variables ! Local variables
integer :: ictxt,np,me, err_act integer(psb_mpik_) :: ictxt,np,me
integer(psb_ipk_) :: err_act
complex(psb_spk_), pointer :: WW(:), w1(:) complex(psb_spk_), pointer :: WW(:), w1(:)
character(len=20) :: name character(len=20) :: name
@ -234,7 +237,8 @@ subroutine mld_cprecaply1(prec,x,desc_data,info,trans)
allocate(ww(size(x)),w1(size(x)),stat=info) allocate(ww(size(x)),w1(size(x)),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/2*size(x),0,0,0,0/),& call psb_errpush(info,name, &
& i_err=(/itwo*size(x),izero,izero,izero,izero/),&
& a_err='complex(psb_spk_)') & a_err='complex(psb_spk_)')
goto 9999 goto 9999
end if end if
@ -279,21 +283,22 @@ subroutine mld_cprecaply2_vect(prec,x,y,desc_data,info,trans,work)
type(mld_cprec_type), intent(inout) :: prec type(mld_cprec_type), intent(inout) :: prec
type(psb_c_vect_type),intent(inout) :: x type(psb_c_vect_type),intent(inout) :: x
type(psb_c_vect_type),intent(inout) :: y type(psb_c_vect_type),intent(inout) :: y
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
complex(psb_spk_),intent(inout), optional, target :: work(:) complex(psb_spk_),intent(inout), optional, target :: work(:)
! Local variables ! Local variables
character :: trans_ character :: trans_
complex(psb_spk_), pointer :: work_(:) complex(psb_spk_), pointer :: work_(:)
integer :: ictxt,np,me,err_act,iwsz integer(psb_mpik_) :: ictxt,np,me
integer(psb_ipk_) :: err_act,iwsz
character(len=20) :: name character(len=20) :: name
name='mld_cprecaply' name='mld_cprecaply'
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = psb_cd_get_context(desc_data) ictxt = desc_data%get_context()
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (present(trans)) then if (present(trans)) then
@ -305,10 +310,11 @@ subroutine mld_cprecaply2_vect(prec,x,y,desc_data,info,trans,work)
if (present(work)) then if (present(work)) then
work_ => work work_ => work
else else
iwsz = max(1,4*psb_cd_get_local_cols(desc_data)) iwsz = max(1,4*desc_data%get_local_cols())
allocate(work_(iwsz),stat=info) allocate(work_(iwsz),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_request_,name,i_err=(/iwsz,0,0,0,0/),& call psb_errpush(psb_err_alloc_request_,name, &
& i_err=(/iwsz,izero,izero,izero,izero/),&
& a_err='complex(psb_spk_)') & a_err='complex(psb_spk_)')
goto 9999 goto 9999
end if end if
@ -343,7 +349,7 @@ subroutine mld_cprecaply2_vect(prec,x,y,desc_data,info,trans,work)
info = psb_err_from_subroutine_ai_ info = psb_err_from_subroutine_ai_
call psb_errpush(info,name,a_err='Invalid size of precv',& call psb_errpush(info,name,a_err='Invalid size of precv',&
& i_Err=(/size(prec%precv),0,0,0,0/)) & i_Err=(/ione*size(prec%precv),izero,izero,izero,izero/))
goto 9999 goto 9999
endif endif
@ -381,7 +387,7 @@ subroutine mld_cprecaply1_vect(prec,x,desc_data,info,trans,work)
type(psb_desc_type),intent(in) :: desc_data type(psb_desc_type),intent(in) :: desc_data
type(mld_cprec_type), intent(inout) :: prec type(mld_cprec_type), intent(inout) :: prec
type(psb_c_vect_type),intent(inout) :: x type(psb_c_vect_type),intent(inout) :: x
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
complex(psb_spk_),intent(inout), optional, target :: work(:) complex(psb_spk_),intent(inout), optional, target :: work(:)
@ -389,14 +395,15 @@ subroutine mld_cprecaply1_vect(prec,x,desc_data,info,trans,work)
character :: trans_ character :: trans_
type(psb_c_vect_type) :: ww type(psb_c_vect_type) :: ww
complex(psb_spk_), pointer :: work_(:) complex(psb_spk_), pointer :: work_(:)
integer :: ictxt,np,me,err_act,iwsz integer(psb_mpik_) :: ictxt,np,me
integer(psb_ipk_) :: err_act,iwsz
character(len=20) :: name character(len=20) :: name
name='mld_cprecaply' name='mld_cprecaply'
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = psb_cd_get_context(desc_data) ictxt = desc_data%get_context()
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (present(trans)) then if (present(trans)) then
@ -408,10 +415,11 @@ subroutine mld_cprecaply1_vect(prec,x,desc_data,info,trans,work)
if (present(work)) then if (present(work)) then
work_ => work work_ => work
else else
iwsz = max(1,4*psb_cd_get_local_cols(desc_data)) iwsz = max(1,4*desc_data%get_local_cols())
allocate(work_(iwsz),stat=info) allocate(work_(iwsz),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_request_,name,i_err=(/iwsz,0,0,0,0/),& call psb_errpush(psb_err_alloc_request_,name, &
& i_err=(/iwsz,izero,izero,izero,izero/),&
& a_err='complex(psb_spk_)') & a_err='complex(psb_spk_)')
goto 9999 goto 9999
end if end if
@ -447,7 +455,7 @@ subroutine mld_cprecaply1_vect(prec,x,desc_data,info,trans,work)
info = psb_err_from_subroutine_ai_ info = psb_err_from_subroutine_ai_
call psb_errpush(info,name,a_err='Invalid size of precv',& call psb_errpush(info,name,a_err='Invalid size of precv',&
& i_Err=(/size(prec%precv),0,0,0,0/)) & i_Err=(/ione*size(prec%precv),izero,izero,izero,izero/))
goto 9999 goto 9999
endif endif

10
mlprec/impl/mld_cprecinit.F90
Unescape Escape View File

@ -110,11 +110,11 @@ subroutine mld_cprecinit(p,ptype,info,nlev)
! Arguments ! Arguments
type(mld_cprec_type), intent(inout) :: p type(mld_cprec_type), intent(inout) :: p
character(len=*), intent(in) :: ptype character(len=*), intent(in) :: ptype
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: nlev integer(psb_ipk_), optional, intent(in) :: nlev
! Local variables ! Local variables
integer :: nlev_, ilev_ integer(psb_ipk_) :: nlev_, ilev_
real(psb_spk_) :: thr real(psb_spk_) :: thr
character(len=*), parameter :: name='mld_precinit' character(len=*), parameter :: name='mld_precinit'
info = psb_success_ info = psb_success_
@ -200,10 +200,10 @@ subroutine mld_cprecinit(p,ptype,info,nlev)
#endif #endif
call p%precv(ilev_)%default() call p%precv(ilev_)%default()
p%precv(ilev_)%parms%coarse_solve = mld_bjac_ p%precv(ilev_)%parms%coarse_solve = mld_bjac_
call p%precv(ilev_)%set(mld_smoother_sweeps_,4,info) call p%precv(ilev_)%set(mld_smoother_sweeps_,4_psb_ipk_,info)
call p%precv(ilev_)%set(mld_sub_restr_,psb_none_,info) call p%precv(ilev_)%set(mld_sub_restr_,psb_none_,info)
call p%precv(ilev_)%set(mld_sub_prol_,psb_none_,info) call p%precv(ilev_)%set(mld_sub_prol_,psb_none_,info)
call p%precv(ilev_)%set(mld_sub_ovr_,0,info) call p%precv(ilev_)%set(mld_sub_ovr_,izero,info)
thr = 0.16d0 thr = 0.16d0
do ilev_=1,nlev_ do ilev_=1,nlev_

48
mlprec/impl/mld_cprecset.F90
Unescape Escape View File

@ -36,7 +36,7 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
! File: mld_zprecset.f90 ! File: mld_cprecset.f90
! !
! Subroutine: mld_cprecseti ! Subroutine: mld_cprecseti
! Version: complex ! Version: complex
@ -96,13 +96,13 @@ subroutine mld_cprecseti(p,what,val,info,ilev)
! Arguments ! Arguments
type(mld_cprec_type), intent(inout) :: p type(mld_cprec_type), intent(inout) :: p
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: ilev integer(psb_ipk_), optional, intent(in) :: ilev
! Local variables ! Local variables
integer :: ilev_, nlev_ integer(psb_ipk_) :: ilev_, nlev_
character(len=*), parameter :: name='mld_precseti' character(len=*), parameter :: name='mld_precseti'
info = psb_success_ info = psb_success_
@ -347,8 +347,8 @@ contains
subroutine onelev_set_smoother(level,val,info) subroutine onelev_set_smoother(level,val,info)
type(mld_c_onelev_type), intent(inout) :: level type(mld_c_onelev_type), intent(inout) :: level
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
info = psb_success_ info = psb_success_
! !
@ -444,8 +444,8 @@ contains
subroutine onelev_set_solver(level,val,info) subroutine onelev_set_solver(level,val,info)
type(mld_c_onelev_type), intent(inout) :: level type(mld_c_onelev_type), intent(inout) :: level
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
info = psb_success_ info = psb_success_
! !
@ -573,11 +573,11 @@ subroutine mld_cprecsetsm(p,val,info,ilev)
! Arguments ! Arguments
type(mld_cprec_type), intent(inout) :: p type(mld_cprec_type), intent(inout) :: p
class(mld_c_base_smoother_type), intent(in) :: val class(mld_c_base_smoother_type), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: ilev integer(psb_ipk_), optional, intent(in) :: ilev
! Local variables ! Local variables
integer :: ilev_, nlev_, ilmin, ilmax integer(psb_ipk_) :: ilev_, nlev_, ilmin, ilmax
character(len=*), parameter :: name='mld_precseti' character(len=*), parameter :: name='mld_precseti'
info = psb_success_ info = psb_success_
@ -636,11 +636,11 @@ subroutine mld_cprecsetsv(p,val,info,ilev)
! Arguments ! Arguments
type(mld_cprec_type), intent(inout) :: p type(mld_cprec_type), intent(inout) :: p
class(mld_c_base_solver_type), intent(in) :: val class(mld_c_base_solver_type), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: ilev integer(psb_ipk_), optional, intent(in) :: ilev
! Local variables ! Local variables
integer :: ilev_, nlev_, ilmin, ilmax integer(psb_ipk_) :: ilev_, nlev_, ilmin, ilmax
character(len=*), parameter :: name='mld_precseti' character(len=*), parameter :: name='mld_precseti'
info = psb_success_ info = psb_success_
@ -746,13 +746,13 @@ subroutine mld_cprecsetc(p,what,string,info,ilev)
! Arguments ! Arguments
type(mld_cprec_type), intent(inout) :: p type(mld_cprec_type), intent(inout) :: p
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: string character(len=*), intent(in) :: string
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: ilev integer(psb_ipk_), optional, intent(in) :: ilev
! Local variables ! Local variables
integer :: ilev_, nlev_,val integer(psb_ipk_) :: ilev_, nlev_,val
character(len=*), parameter :: name='mld_precsetc' character(len=*), parameter :: name='mld_precsetc'
info = psb_success_ info = psb_success_
@ -830,13 +830,13 @@ subroutine mld_cprecsetr(p,what,val,info,ilev)
! Arguments ! Arguments
type(mld_cprec_type), intent(inout) :: p type(mld_cprec_type), intent(inout) :: p
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val real(psb_spk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: ilev integer(psb_ipk_), optional, intent(in) :: ilev
! Local variables ! Local variables
integer :: ilev_,nlev_ integer(psb_ipk_) :: ilev_,nlev_
character(len=*), parameter :: name='mld_precsetr' character(len=*), parameter :: name='mld_precsetr'
info = psb_success_ info = psb_success_

47
mlprec/impl/mld_dprecaply.f90
Unescape Escape View File

@ -83,14 +83,15 @@ subroutine mld_dprecaply(prec,x,y,desc_data,info,trans,work)
type(mld_dprec_type), intent(in) :: prec type(mld_dprec_type), intent(in) :: prec
real(psb_dpk_),intent(inout) :: x(:) real(psb_dpk_),intent(inout) :: x(:)
real(psb_dpk_),intent(inout) :: y(:) real(psb_dpk_),intent(inout) :: y(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
real(psb_dpk_),intent(inout), optional, target :: work(:) real(psb_dpk_),intent(inout), optional, target :: work(:)
! Local variables ! Local variables
character :: trans_ character :: trans_
real(psb_dpk_), pointer :: work_(:) real(psb_dpk_), pointer :: work_(:)
integer :: ictxt,np,me,err_act,iwsz integer(psb_mpik_) :: ictxt,np,me
integer(psb_ipk_) :: err_act,iwsz
character(len=20) :: name character(len=20) :: name
name='mld_dprecaply' name='mld_dprecaply'
@ -112,7 +113,8 @@ subroutine mld_dprecaply(prec,x,y,desc_data,info,trans,work)
iwsz = max(1,4*desc_data%get_local_cols()) iwsz = max(1,4*desc_data%get_local_cols())
allocate(work_(iwsz),stat=info) allocate(work_(iwsz),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_request_,name,i_err=(/iwsz,0,0,0,0/),& call psb_errpush(psb_err_alloc_request_,name, &
& i_err=(/iwsz,izero,izero,izero,izero/),&
& a_err='real(psb_dpk_)') & a_err='real(psb_dpk_)')
goto 9999 goto 9999
end if end if
@ -145,7 +147,7 @@ subroutine mld_dprecaply(prec,x,y,desc_data,info,trans,work)
else else
info = psb_err_from_subroutine_ai_ info = psb_err_from_subroutine_ai_
call psb_errpush(info,name,a_err='Invalid size of precv',& call psb_errpush(info,name,a_err='Invalid size of precv',&
& i_Err=(/size(prec%precv),0,0,0,0/)) & i_Err=(/ione*size(prec%precv),izero,izero,izero,izero/))
goto 9999 goto 9999
endif endif
@ -215,11 +217,12 @@ subroutine mld_dprecaply1(prec,x,desc_data,info,trans)
type(psb_desc_type),intent(in) :: desc_data type(psb_desc_type),intent(in) :: desc_data
type(mld_dprec_type), intent(in) :: prec type(mld_dprec_type), intent(in) :: prec
real(psb_dpk_),intent(inout) :: x(:) real(psb_dpk_),intent(inout) :: x(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
! Local variables ! Local variables
integer :: ictxt,np,me, err_act integer(psb_mpik_) :: ictxt,np,me
integer(psb_ipk_) :: err_act
real(psb_dpk_), pointer :: WW(:), w1(:) real(psb_dpk_), pointer :: WW(:), w1(:)
character(len=20) :: name character(len=20) :: name
@ -234,7 +237,8 @@ subroutine mld_dprecaply1(prec,x,desc_data,info,trans)
allocate(ww(size(x)),w1(size(x)),stat=info) allocate(ww(size(x)),w1(size(x)),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/2*size(x),0,0,0,0/),& call psb_errpush(info,name, &
& i_err=(/itwo*size(x),izero,izero,izero,izero/),&
& a_err='real(psb_dpk_)') & a_err='real(psb_dpk_)')
goto 9999 goto 9999
end if end if
@ -279,21 +283,22 @@ subroutine mld_dprecaply2_vect(prec,x,y,desc_data,info,trans,work)
type(mld_dprec_type), intent(inout) :: prec type(mld_dprec_type), intent(inout) :: prec
type(psb_d_vect_type),intent(inout) :: x type(psb_d_vect_type),intent(inout) :: x
type(psb_d_vect_type),intent(inout) :: y type(psb_d_vect_type),intent(inout) :: y
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
real(psb_dpk_),intent(inout), optional, target :: work(:) real(psb_dpk_),intent(inout), optional, target :: work(:)
! Local variables ! Local variables
character :: trans_ character :: trans_
real(psb_dpk_), pointer :: work_(:) real(psb_dpk_), pointer :: work_(:)
integer :: ictxt,np,me,err_act,iwsz integer(psb_mpik_) :: ictxt,np,me
integer(psb_ipk_) :: err_act,iwsz
character(len=20) :: name character(len=20) :: name
name='mld_dprecaply' name='mld_dprecaply'
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = psb_cd_get_context(desc_data) ictxt = desc_data%get_context()
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (present(trans)) then if (present(trans)) then
@ -305,10 +310,11 @@ subroutine mld_dprecaply2_vect(prec,x,y,desc_data,info,trans,work)
if (present(work)) then if (present(work)) then
work_ => work work_ => work
else else
iwsz = max(1,4*psb_cd_get_local_cols(desc_data)) iwsz = max(1,4*desc_data%get_local_cols())
allocate(work_(iwsz),stat=info) allocate(work_(iwsz),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_request_,name,i_err=(/iwsz,0,0,0,0/),& call psb_errpush(psb_err_alloc_request_,name, &
& i_err=(/iwsz,izero,izero,izero,izero/),&
& a_err='real(psb_dpk_)') & a_err='real(psb_dpk_)')
goto 9999 goto 9999
end if end if
@ -343,7 +349,7 @@ subroutine mld_dprecaply2_vect(prec,x,y,desc_data,info,trans,work)
info = psb_err_from_subroutine_ai_ info = psb_err_from_subroutine_ai_
call psb_errpush(info,name,a_err='Invalid size of precv',& call psb_errpush(info,name,a_err='Invalid size of precv',&
& i_Err=(/size(prec%precv),0,0,0,0/)) & i_Err=(/ione*size(prec%precv),izero,izero,izero,izero/))
goto 9999 goto 9999
endif endif
@ -370,7 +376,6 @@ subroutine mld_dprecaply2_vect(prec,x,y,desc_data,info,trans,work)
end subroutine mld_dprecaply2_vect end subroutine mld_dprecaply2_vect
subroutine mld_dprecaply1_vect(prec,x,desc_data,info,trans,work) subroutine mld_dprecaply1_vect(prec,x,desc_data,info,trans,work)
use psb_base_mod use psb_base_mod
@ -382,7 +387,7 @@ subroutine mld_dprecaply1_vect(prec,x,desc_data,info,trans,work)
type(psb_desc_type),intent(in) :: desc_data type(psb_desc_type),intent(in) :: desc_data
type(mld_dprec_type), intent(inout) :: prec type(mld_dprec_type), intent(inout) :: prec
type(psb_d_vect_type),intent(inout) :: x type(psb_d_vect_type),intent(inout) :: x
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
real(psb_dpk_),intent(inout), optional, target :: work(:) real(psb_dpk_),intent(inout), optional, target :: work(:)
@ -390,14 +395,15 @@ subroutine mld_dprecaply1_vect(prec,x,desc_data,info,trans,work)
character :: trans_ character :: trans_
type(psb_d_vect_type) :: ww type(psb_d_vect_type) :: ww
real(psb_dpk_), pointer :: work_(:) real(psb_dpk_), pointer :: work_(:)
integer :: ictxt,np,me,err_act,iwsz integer(psb_mpik_) :: ictxt,np,me
integer(psb_ipk_) :: err_act,iwsz
character(len=20) :: name character(len=20) :: name
name='mld_dprecaply' name='mld_dprecaply'
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = psb_cd_get_context(desc_data) ictxt = desc_data%get_context()
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (present(trans)) then if (present(trans)) then
@ -409,10 +415,11 @@ subroutine mld_dprecaply1_vect(prec,x,desc_data,info,trans,work)
if (present(work)) then if (present(work)) then
work_ => work work_ => work
else else
iwsz = max(1,4*psb_cd_get_local_cols(desc_data)) iwsz = max(1,4*desc_data%get_local_cols())
allocate(work_(iwsz),stat=info) allocate(work_(iwsz),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_request_,name,i_err=(/iwsz,0,0,0,0/),& call psb_errpush(psb_err_alloc_request_,name, &
& i_err=(/iwsz,izero,izero,izero,izero/),&
& a_err='real(psb_dpk_)') & a_err='real(psb_dpk_)')
goto 9999 goto 9999
end if end if
@ -448,7 +455,7 @@ subroutine mld_dprecaply1_vect(prec,x,desc_data,info,trans,work)
info = psb_err_from_subroutine_ai_ info = psb_err_from_subroutine_ai_
call psb_errpush(info,name,a_err='Invalid size of precv',& call psb_errpush(info,name,a_err='Invalid size of precv',&
& i_Err=(/size(prec%precv),0,0,0,0/)) & i_Err=(/ione*size(prec%precv),izero,izero,izero,izero/))
goto 9999 goto 9999
endif endif

10
mlprec/impl/mld_dprecinit.F90
Unescape Escape View File

@ -110,11 +110,11 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
! Arguments ! Arguments
type(mld_dprec_type), intent(inout) :: p type(mld_dprec_type), intent(inout) :: p
character(len=*), intent(in) :: ptype character(len=*), intent(in) :: ptype
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: nlev integer(psb_ipk_), optional, intent(in) :: nlev
! Local variables ! Local variables
integer :: nlev_, ilev_ integer(psb_ipk_) :: nlev_, ilev_
real(psb_dpk_) :: thr real(psb_dpk_) :: thr
character(len=*), parameter :: name='mld_precinit' character(len=*), parameter :: name='mld_precinit'
info = psb_success_ info = psb_success_
@ -200,10 +200,10 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
#endif #endif
call p%precv(ilev_)%default() call p%precv(ilev_)%default()
p%precv(ilev_)%parms%coarse_solve = mld_bjac_ p%precv(ilev_)%parms%coarse_solve = mld_bjac_
call p%precv(ilev_)%set(mld_smoother_sweeps_,4,info) call p%precv(ilev_)%set(mld_smoother_sweeps_,4_psb_ipk_,info)
call p%precv(ilev_)%set(mld_sub_restr_,psb_none_,info) call p%precv(ilev_)%set(mld_sub_restr_,psb_none_,info)
call p%precv(ilev_)%set(mld_sub_prol_,psb_none_,info) call p%precv(ilev_)%set(mld_sub_prol_,psb_none_,info)
call p%precv(ilev_)%set(mld_sub_ovr_,0,info) call p%precv(ilev_)%set(mld_sub_ovr_,izero,info)
thr = 0.16d0 thr = 0.16d0
do ilev_=1,nlev_ do ilev_=1,nlev_

46
mlprec/impl/mld_dprecset.F90
Unescape Escape View File

@ -96,13 +96,13 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
! Arguments ! Arguments
type(mld_dprec_type), intent(inout) :: p type(mld_dprec_type), intent(inout) :: p
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: ilev integer(psb_ipk_), optional, intent(in) :: ilev
! Local variables ! Local variables
integer :: ilev_, nlev_ integer(psb_ipk_) :: ilev_, nlev_
character(len=*), parameter :: name='mld_precseti' character(len=*), parameter :: name='mld_precseti'
info = psb_success_ info = psb_success_
@ -347,8 +347,8 @@ contains
subroutine onelev_set_smoother(level,val,info) subroutine onelev_set_smoother(level,val,info)
type(mld_d_onelev_type), intent(inout) :: level type(mld_d_onelev_type), intent(inout) :: level
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
info = psb_success_ info = psb_success_
! !
@ -444,8 +444,8 @@ contains
subroutine onelev_set_solver(level,val,info) subroutine onelev_set_solver(level,val,info)
type(mld_d_onelev_type), intent(inout) :: level type(mld_d_onelev_type), intent(inout) :: level
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
info = psb_success_ info = psb_success_
! !
@ -573,11 +573,11 @@ subroutine mld_dprecsetsm(p,val,info,ilev)
! Arguments ! Arguments
type(mld_dprec_type), intent(inout) :: p type(mld_dprec_type), intent(inout) :: p
class(mld_d_base_smoother_type), intent(in) :: val class(mld_d_base_smoother_type), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: ilev integer(psb_ipk_), optional, intent(in) :: ilev
! Local variables ! Local variables
integer :: ilev_, nlev_, ilmin, ilmax integer(psb_ipk_) :: ilev_, nlev_, ilmin, ilmax
character(len=*), parameter :: name='mld_precseti' character(len=*), parameter :: name='mld_precseti'
info = psb_success_ info = psb_success_
@ -636,11 +636,11 @@ subroutine mld_dprecsetsv(p,val,info,ilev)
! Arguments ! Arguments
type(mld_dprec_type), intent(inout) :: p type(mld_dprec_type), intent(inout) :: p
class(mld_d_base_solver_type), intent(in) :: val class(mld_d_base_solver_type), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: ilev integer(psb_ipk_), optional, intent(in) :: ilev
! Local variables ! Local variables
integer :: ilev_, nlev_, ilmin, ilmax integer(psb_ipk_) :: ilev_, nlev_, ilmin, ilmax
character(len=*), parameter :: name='mld_precseti' character(len=*), parameter :: name='mld_precseti'
info = psb_success_ info = psb_success_
@ -746,13 +746,13 @@ subroutine mld_dprecsetc(p,what,string,info,ilev)
! Arguments ! Arguments
type(mld_dprec_type), intent(inout) :: p type(mld_dprec_type), intent(inout) :: p
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: string character(len=*), intent(in) :: string
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: ilev integer(psb_ipk_), optional, intent(in) :: ilev
! Local variables ! Local variables
integer :: ilev_, nlev_,val integer(psb_ipk_) :: ilev_, nlev_,val
character(len=*), parameter :: name='mld_precsetc' character(len=*), parameter :: name='mld_precsetc'
info = psb_success_ info = psb_success_
@ -830,13 +830,13 @@ subroutine mld_dprecsetr(p,what,val,info,ilev)
! Arguments ! Arguments
type(mld_dprec_type), intent(inout) :: p type(mld_dprec_type), intent(inout) :: p
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: ilev integer(psb_ipk_), optional, intent(in) :: ilev
! Local variables ! Local variables
integer :: ilev_,nlev_ integer(psb_ipk_) :: ilev_,nlev_
character(len=*), parameter :: name='mld_precsetr' character(len=*), parameter :: name='mld_precsetr'
info = psb_success_ info = psb_success_

51
mlprec/impl/mld_sprecaply.f90
Unescape Escape View File

@ -83,14 +83,15 @@ subroutine mld_sprecaply(prec,x,y,desc_data,info,trans,work)
type(mld_sprec_type), intent(in) :: prec type(mld_sprec_type), intent(in) :: prec
real(psb_spk_),intent(inout) :: x(:) real(psb_spk_),intent(inout) :: x(:)
real(psb_spk_),intent(inout) :: y(:) real(psb_spk_),intent(inout) :: y(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
real(psb_spk_),intent(inout), optional, target :: work(:) real(psb_spk_),intent(inout), optional, target :: work(:)
! Local variables ! Local variables
character :: trans_ character :: trans_
real(psb_spk_), pointer :: work_(:) real(psb_spk_), pointer :: work_(:)
integer :: ictxt,np,me,err_act,iwsz integer(psb_mpik_) :: ictxt,np,me
integer(psb_ipk_) :: err_act,iwsz
character(len=20) :: name character(len=20) :: name
name='mld_sprecaply' name='mld_sprecaply'
@ -112,7 +113,8 @@ subroutine mld_sprecaply(prec,x,y,desc_data,info,trans,work)
iwsz = max(1,4*desc_data%get_local_cols()) iwsz = max(1,4*desc_data%get_local_cols())
allocate(work_(iwsz),stat=info) allocate(work_(iwsz),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_request_,name,i_err=(/iwsz,0,0,0,0/),& call psb_errpush(psb_err_alloc_request_,name, &
& i_err=(/iwsz,izero,izero,izero,izero/),&
& a_err='real(psb_spk_)') & a_err='real(psb_spk_)')
goto 9999 goto 9999
end if end if
@ -145,7 +147,7 @@ subroutine mld_sprecaply(prec,x,y,desc_data,info,trans,work)
else else
info = psb_err_from_subroutine_ai_ info = psb_err_from_subroutine_ai_
call psb_errpush(info,name,a_err='Invalid size of precv',& call psb_errpush(info,name,a_err='Invalid size of precv',&
& i_Err=(/size(prec%precv),0,0,0,0/)) & i_Err=(/ione*size(prec%precv),izero,izero,izero,izero/))
goto 9999 goto 9999
endif endif
@ -215,11 +217,12 @@ subroutine mld_sprecaply1(prec,x,desc_data,info,trans)
type(psb_desc_type),intent(in) :: desc_data type(psb_desc_type),intent(in) :: desc_data
type(mld_sprec_type), intent(in) :: prec type(mld_sprec_type), intent(in) :: prec
real(psb_spk_),intent(inout) :: x(:) real(psb_spk_),intent(inout) :: x(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
! Local variables ! Local variables
integer :: ictxt,np,me, err_act integer(psb_mpik_) :: ictxt,np,me
integer(psb_ipk_) :: err_act
real(psb_spk_), pointer :: WW(:), w1(:) real(psb_spk_), pointer :: WW(:), w1(:)
character(len=20) :: name character(len=20) :: name
@ -234,7 +237,8 @@ subroutine mld_sprecaply1(prec,x,desc_data,info,trans)
allocate(ww(size(x)),w1(size(x)),stat=info) allocate(ww(size(x)),w1(size(x)),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/2*size(x),0,0,0,0/),& call psb_errpush(info,name, &
& i_err=(/itwo*size(x),izero,izero,izero,izero/),&
& a_err='real(psb_spk_)') & a_err='real(psb_spk_)')
goto 9999 goto 9999
end if end if
@ -279,21 +283,22 @@ subroutine mld_sprecaply2_vect(prec,x,y,desc_data,info,trans,work)
type(mld_sprec_type), intent(inout) :: prec type(mld_sprec_type), intent(inout) :: prec
type(psb_s_vect_type),intent(inout) :: x type(psb_s_vect_type),intent(inout) :: x
type(psb_s_vect_type),intent(inout) :: y type(psb_s_vect_type),intent(inout) :: y
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
real(psb_spk_),intent(inout), optional, target :: work(:) real(psb_spk_),intent(inout), optional, target :: work(:)
! Local variables ! Local variables
character :: trans_ character :: trans_
real(psb_spk_), pointer :: work_(:) real(psb_spk_), pointer :: work_(:)
integer :: ictxt,np,me,err_act,iwsz integer(psb_mpik_) :: ictxt,np,me
integer(psb_ipk_) :: err_act,iwsz
character(len=20) :: name character(len=20) :: name
name='mld_sprecaply' name='mld_sprecaply'
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = psb_cd_get_context(desc_data) ictxt = desc_data%get_context()
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (present(trans)) then if (present(trans)) then
@ -305,10 +310,11 @@ subroutine mld_sprecaply2_vect(prec,x,y,desc_data,info,trans,work)
if (present(work)) then if (present(work)) then
work_ => work work_ => work
else else
iwsz = max(1,4*psb_cd_get_local_cols(desc_data)) iwsz = max(1,4*desc_data%get_local_cols())
allocate(work_(iwsz),stat=info) allocate(work_(iwsz),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_request_,name,i_err=(/iwsz,0,0,0,0/),& call psb_errpush(psb_err_alloc_request_,name, &
& i_err=(/iwsz,izero,izero,izero,izero/),&
& a_err='real(psb_spk_)') & a_err='real(psb_spk_)')
goto 9999 goto 9999
end if end if
@ -343,7 +349,7 @@ subroutine mld_sprecaply2_vect(prec,x,y,desc_data,info,trans,work)
info = psb_err_from_subroutine_ai_ info = psb_err_from_subroutine_ai_
call psb_errpush(info,name,a_err='Invalid size of precv',& call psb_errpush(info,name,a_err='Invalid size of precv',&
& i_Err=(/size(prec%precv),0,0,0,0/)) & i_Err=(/ione*size(prec%precv),izero,izero,izero,izero/))
goto 9999 goto 9999
endif endif
@ -369,6 +375,7 @@ subroutine mld_sprecaply2_vect(prec,x,y,desc_data,info,trans,work)
end subroutine mld_sprecaply2_vect end subroutine mld_sprecaply2_vect
subroutine mld_sprecaply1_vect(prec,x,desc_data,info,trans,work) subroutine mld_sprecaply1_vect(prec,x,desc_data,info,trans,work)
use psb_base_mod use psb_base_mod
@ -380,7 +387,7 @@ subroutine mld_sprecaply1_vect(prec,x,desc_data,info,trans,work)
type(psb_desc_type),intent(in) :: desc_data type(psb_desc_type),intent(in) :: desc_data
type(mld_sprec_type), intent(inout) :: prec type(mld_sprec_type), intent(inout) :: prec
type(psb_s_vect_type),intent(inout) :: x type(psb_s_vect_type),intent(inout) :: x
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
real(psb_spk_),intent(inout), optional, target :: work(:) real(psb_spk_),intent(inout), optional, target :: work(:)
@ -388,14 +395,15 @@ subroutine mld_sprecaply1_vect(prec,x,desc_data,info,trans,work)
character :: trans_ character :: trans_
type(psb_s_vect_type) :: ww type(psb_s_vect_type) :: ww
real(psb_spk_), pointer :: work_(:) real(psb_spk_), pointer :: work_(:)
integer :: ictxt,np,me,err_act,iwsz integer(psb_mpik_) :: ictxt,np,me
integer(psb_ipk_) :: err_act,iwsz
character(len=20) :: name character(len=20) :: name
name='mld_sprecaply' name='mld_sprecaply'
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = psb_cd_get_context(desc_data) ictxt = desc_data%get_context()
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (present(trans)) then if (present(trans)) then
@ -407,18 +415,19 @@ subroutine mld_sprecaply1_vect(prec,x,desc_data,info,trans,work)
if (present(work)) then if (present(work)) then
work_ => work work_ => work
else else
iwsz = max(1,4*psb_cd_get_local_cols(desc_data)) iwsz = max(1,4*desc_data%get_local_cols())
allocate(work_(iwsz),stat=info) allocate(work_(iwsz),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_request_,name,i_err=(/iwsz,0,0,0,0/),& call psb_errpush(psb_err_alloc_request_,name, &
&a_err='real(psb_dpk_)') & i_err=(/iwsz,izero,izero,izero,izero/),&
& a_err='real(psb_spk_)')
goto 9999 goto 9999
end if end if
end if end if
if (.not.(allocated(prec%precv))) then if (.not.(allocated(prec%precv))) then
!! Error 1: should call mld_dprecbld !! Error 1: should call mld_sprecbld
info=3112 info=3112
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
@ -446,7 +455,7 @@ subroutine mld_sprecaply1_vect(prec,x,desc_data,info,trans,work)
info = psb_err_from_subroutine_ai_ info = psb_err_from_subroutine_ai_
call psb_errpush(info,name,a_err='Invalid size of precv',& call psb_errpush(info,name,a_err='Invalid size of precv',&
& i_Err=(/size(prec%precv),0,0,0,0/)) & i_Err=(/ione*size(prec%precv),izero,izero,izero,izero/))
goto 9999 goto 9999
endif endif

10
mlprec/impl/mld_sprecinit.F90
Unescape Escape View File

@ -110,11 +110,11 @@ subroutine mld_sprecinit(p,ptype,info,nlev)
! Arguments ! Arguments
type(mld_sprec_type), intent(inout) :: p type(mld_sprec_type), intent(inout) :: p
character(len=*), intent(in) :: ptype character(len=*), intent(in) :: ptype
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: nlev integer(psb_ipk_), optional, intent(in) :: nlev
! Local variables ! Local variables
integer :: nlev_, ilev_ integer(psb_ipk_) :: nlev_, ilev_
real(psb_spk_) :: thr real(psb_spk_) :: thr
character(len=*), parameter :: name='mld_precinit' character(len=*), parameter :: name='mld_precinit'
info = psb_success_ info = psb_success_
@ -200,10 +200,10 @@ subroutine mld_sprecinit(p,ptype,info,nlev)
#endif #endif
call p%precv(ilev_)%default() call p%precv(ilev_)%default()
p%precv(ilev_)%parms%coarse_solve = mld_bjac_ p%precv(ilev_)%parms%coarse_solve = mld_bjac_
call p%precv(ilev_)%set(mld_smoother_sweeps_,4,info) call p%precv(ilev_)%set(mld_smoother_sweeps_,4_psb_ipk_,info)
call p%precv(ilev_)%set(mld_sub_restr_,psb_none_,info) call p%precv(ilev_)%set(mld_sub_restr_,psb_none_,info)
call p%precv(ilev_)%set(mld_sub_prol_,psb_none_,info) call p%precv(ilev_)%set(mld_sub_prol_,psb_none_,info)
call p%precv(ilev_)%set(mld_sub_ovr_,0,info) call p%precv(ilev_)%set(mld_sub_ovr_,izero,info)
thr = 0.16d0 thr = 0.16d0
do ilev_=1,nlev_ do ilev_=1,nlev_

48
mlprec/impl/mld_sprecset.F90
Unescape Escape View File

@ -36,7 +36,7 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
! File: mld_dprecset.f90 ! File: mld_sprecset.f90
! !
! Subroutine: mld_sprecseti ! Subroutine: mld_sprecseti
! Version: real ! Version: real
@ -96,13 +96,13 @@ subroutine mld_sprecseti(p,what,val,info,ilev)
! Arguments ! Arguments
type(mld_sprec_type), intent(inout) :: p type(mld_sprec_type), intent(inout) :: p
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: ilev integer(psb_ipk_), optional, intent(in) :: ilev
! Local variables ! Local variables
integer :: ilev_, nlev_ integer(psb_ipk_) :: ilev_, nlev_
character(len=*), parameter :: name='mld_precseti' character(len=*), parameter :: name='mld_precseti'
info = psb_success_ info = psb_success_
@ -347,8 +347,8 @@ contains
subroutine onelev_set_smoother(level,val,info) subroutine onelev_set_smoother(level,val,info)
type(mld_s_onelev_type), intent(inout) :: level type(mld_s_onelev_type), intent(inout) :: level
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
info = psb_success_ info = psb_success_
! !
@ -444,8 +444,8 @@ contains
subroutine onelev_set_solver(level,val,info) subroutine onelev_set_solver(level,val,info)
type(mld_s_onelev_type), intent(inout) :: level type(mld_s_onelev_type), intent(inout) :: level
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
info = psb_success_ info = psb_success_
! !
@ -573,11 +573,11 @@ subroutine mld_sprecsetsm(p,val,info,ilev)
! Arguments ! Arguments
type(mld_sprec_type), intent(inout) :: p type(mld_sprec_type), intent(inout) :: p
class(mld_s_base_smoother_type), intent(in) :: val class(mld_s_base_smoother_type), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: ilev integer(psb_ipk_), optional, intent(in) :: ilev
! Local variables ! Local variables
integer :: ilev_, nlev_, ilmin, ilmax integer(psb_ipk_) :: ilev_, nlev_, ilmin, ilmax
character(len=*), parameter :: name='mld_precseti' character(len=*), parameter :: name='mld_precseti'
info = psb_success_ info = psb_success_
@ -636,11 +636,11 @@ subroutine mld_sprecsetsv(p,val,info,ilev)
! Arguments ! Arguments
type(mld_sprec_type), intent(inout) :: p type(mld_sprec_type), intent(inout) :: p
class(mld_s_base_solver_type), intent(in) :: val class(mld_s_base_solver_type), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: ilev integer(psb_ipk_), optional, intent(in) :: ilev
! Local variables ! Local variables
integer :: ilev_, nlev_, ilmin, ilmax integer(psb_ipk_) :: ilev_, nlev_, ilmin, ilmax
character(len=*), parameter :: name='mld_precseti' character(len=*), parameter :: name='mld_precseti'
info = psb_success_ info = psb_success_
@ -746,13 +746,13 @@ subroutine mld_sprecsetc(p,what,string,info,ilev)
! Arguments ! Arguments
type(mld_sprec_type), intent(inout) :: p type(mld_sprec_type), intent(inout) :: p
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: string character(len=*), intent(in) :: string
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: ilev integer(psb_ipk_), optional, intent(in) :: ilev
! Local variables ! Local variables
integer :: ilev_, nlev_,val integer(psb_ipk_) :: ilev_, nlev_,val
character(len=*), parameter :: name='mld_precsetc' character(len=*), parameter :: name='mld_precsetc'
info = psb_success_ info = psb_success_
@ -830,13 +830,13 @@ subroutine mld_sprecsetr(p,what,val,info,ilev)
! Arguments ! Arguments
type(mld_sprec_type), intent(inout) :: p type(mld_sprec_type), intent(inout) :: p
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val real(psb_spk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: ilev integer(psb_ipk_), optional, intent(in) :: ilev
! Local variables ! Local variables
integer :: ilev_,nlev_ integer(psb_ipk_) :: ilev_,nlev_
character(len=*), parameter :: name='mld_precsetr' character(len=*), parameter :: name='mld_precsetr'
info = psb_success_ info = psb_success_

46
mlprec/impl/mld_zprecaply.f90
Unescape Escape View File

@ -83,14 +83,15 @@ subroutine mld_zprecaply(prec,x,y,desc_data,info,trans,work)
type(mld_zprec_type), intent(in) :: prec type(mld_zprec_type), intent(in) :: prec
complex(psb_dpk_),intent(inout) :: x(:) complex(psb_dpk_),intent(inout) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:) complex(psb_dpk_),intent(inout) :: y(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
complex(psb_dpk_),intent(inout), optional, target :: work(:) complex(psb_dpk_),intent(inout), optional, target :: work(:)
! Local variables ! Local variables
character :: trans_ character :: trans_
complex(psb_dpk_), pointer :: work_(:) complex(psb_dpk_), pointer :: work_(:)
integer :: ictxt,np,me,err_act,iwsz integer(psb_mpik_) :: ictxt,np,me
integer(psb_ipk_) :: err_act,iwsz
character(len=20) :: name character(len=20) :: name
name='mld_zprecaply' name='mld_zprecaply'
@ -112,7 +113,8 @@ subroutine mld_zprecaply(prec,x,y,desc_data,info,trans,work)
iwsz = max(1,4*desc_data%get_local_cols()) iwsz = max(1,4*desc_data%get_local_cols())
allocate(work_(iwsz),stat=info) allocate(work_(iwsz),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_request_,name,i_err=(/iwsz,0,0,0,0/),& call psb_errpush(psb_err_alloc_request_,name, &
& i_err=(/iwsz,izero,izero,izero,izero/),&
& a_err='complex(psb_dpk_)') & a_err='complex(psb_dpk_)')
goto 9999 goto 9999
end if end if
@ -145,7 +147,7 @@ subroutine mld_zprecaply(prec,x,y,desc_data,info,trans,work)
else else
info = psb_err_from_subroutine_ai_ info = psb_err_from_subroutine_ai_
call psb_errpush(info,name,a_err='Invalid size of precv',& call psb_errpush(info,name,a_err='Invalid size of precv',&
& i_Err=(/size(prec%precv),0,0,0,0/)) & i_Err=(/ione*size(prec%precv),izero,izero,izero,izero/))
goto 9999 goto 9999
endif endif
@ -215,11 +217,12 @@ subroutine mld_zprecaply1(prec,x,desc_data,info,trans)
type(psb_desc_type),intent(in) :: desc_data type(psb_desc_type),intent(in) :: desc_data
type(mld_zprec_type), intent(in) :: prec type(mld_zprec_type), intent(in) :: prec
complex(psb_dpk_),intent(inout) :: x(:) complex(psb_dpk_),intent(inout) :: x(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
! Local variables ! Local variables
integer :: ictxt,np,me, err_act integer(psb_mpik_) :: ictxt,np,me
integer(psb_ipk_) :: err_act
complex(psb_dpk_), pointer :: WW(:), w1(:) complex(psb_dpk_), pointer :: WW(:), w1(:)
character(len=20) :: name character(len=20) :: name
@ -234,7 +237,8 @@ subroutine mld_zprecaply1(prec,x,desc_data,info,trans)
allocate(ww(size(x)),w1(size(x)),stat=info) allocate(ww(size(x)),w1(size(x)),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/2*size(x),0,0,0,0/),& call psb_errpush(info,name, &
& i_err=(/itwo*size(x),izero,izero,izero,izero/),&
& a_err='complex(psb_dpk_)') & a_err='complex(psb_dpk_)')
goto 9999 goto 9999
end if end if
@ -279,21 +283,22 @@ subroutine mld_zprecaply2_vect(prec,x,y,desc_data,info,trans,work)
type(mld_zprec_type), intent(inout) :: prec type(mld_zprec_type), intent(inout) :: prec
type(psb_z_vect_type),intent(inout) :: x type(psb_z_vect_type),intent(inout) :: x
type(psb_z_vect_type),intent(inout) :: y type(psb_z_vect_type),intent(inout) :: y
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
complex(psb_dpk_),intent(inout), optional, target :: work(:) complex(psb_dpk_),intent(inout), optional, target :: work(:)
! Local variables ! Local variables
character :: trans_ character :: trans_
complex(psb_dpk_), pointer :: work_(:) complex(psb_dpk_), pointer :: work_(:)
integer :: ictxt,np,me,err_act,iwsz integer(psb_mpik_) :: ictxt,np,me
integer(psb_ipk_) :: err_act,iwsz
character(len=20) :: name character(len=20) :: name
name='mld_zprecaply' name='mld_zprecaply'
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = psb_cd_get_context(desc_data) ictxt = desc_data%get_context()
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (present(trans)) then if (present(trans)) then
@ -305,10 +310,11 @@ subroutine mld_zprecaply2_vect(prec,x,y,desc_data,info,trans,work)
if (present(work)) then if (present(work)) then
work_ => work work_ => work
else else
iwsz = max(1,4*psb_cd_get_local_cols(desc_data)) iwsz = max(1,4*desc_data%get_local_cols())
allocate(work_(iwsz),stat=info) allocate(work_(iwsz),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_request_,name,i_err=(/iwsz,0,0,0,0/),& call psb_errpush(psb_err_alloc_request_,name, &
& i_err=(/iwsz,izero,izero,izero,izero/),&
& a_err='complex(psb_dpk_)') & a_err='complex(psb_dpk_)')
goto 9999 goto 9999
end if end if
@ -343,7 +349,7 @@ subroutine mld_zprecaply2_vect(prec,x,y,desc_data,info,trans,work)
info = psb_err_from_subroutine_ai_ info = psb_err_from_subroutine_ai_
call psb_errpush(info,name,a_err='Invalid size of precv',& call psb_errpush(info,name,a_err='Invalid size of precv',&
& i_Err=(/size(prec%precv),0,0,0,0/)) & i_Err=(/ione*size(prec%precv),izero,izero,izero,izero/))
goto 9999 goto 9999
endif endif
@ -381,7 +387,7 @@ subroutine mld_zprecaply1_vect(prec,x,desc_data,info,trans,work)
type(psb_desc_type),intent(in) :: desc_data type(psb_desc_type),intent(in) :: desc_data
type(mld_zprec_type), intent(inout) :: prec type(mld_zprec_type), intent(inout) :: prec
type(psb_z_vect_type),intent(inout) :: x type(psb_z_vect_type),intent(inout) :: x
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
complex(psb_dpk_),intent(inout), optional, target :: work(:) complex(psb_dpk_),intent(inout), optional, target :: work(:)
@ -389,14 +395,15 @@ subroutine mld_zprecaply1_vect(prec,x,desc_data,info,trans,work)
character :: trans_ character :: trans_
type(psb_z_vect_type) :: ww type(psb_z_vect_type) :: ww
complex(psb_dpk_), pointer :: work_(:) complex(psb_dpk_), pointer :: work_(:)
integer :: ictxt,np,me,err_act,iwsz integer(psb_mpik_) :: ictxt,np,me
integer(psb_ipk_) :: err_act,iwsz
character(len=20) :: name character(len=20) :: name
name='mld_zprecaply' name='mld_zprecaply'
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = psb_cd_get_context(desc_data) ictxt = desc_data%get_context()
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (present(trans)) then if (present(trans)) then
@ -408,10 +415,11 @@ subroutine mld_zprecaply1_vect(prec,x,desc_data,info,trans,work)
if (present(work)) then if (present(work)) then
work_ => work work_ => work
else else
iwsz = max(1,4*psb_cd_get_local_cols(desc_data)) iwsz = max(1,4*desc_data%get_local_cols())
allocate(work_(iwsz),stat=info) allocate(work_(iwsz),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_request_,name,i_err=(/iwsz,0,0,0,0/),& call psb_errpush(psb_err_alloc_request_,name, &
& i_err=(/iwsz,izero,izero,izero,izero/),&
& a_err='complex(psb_dpk_)') & a_err='complex(psb_dpk_)')
goto 9999 goto 9999
end if end if
@ -447,7 +455,7 @@ subroutine mld_zprecaply1_vect(prec,x,desc_data,info,trans,work)
info = psb_err_from_subroutine_ai_ info = psb_err_from_subroutine_ai_
call psb_errpush(info,name,a_err='Invalid size of precv',& call psb_errpush(info,name,a_err='Invalid size of precv',&
& i_Err=(/size(prec%precv),0,0,0,0/)) & i_Err=(/ione*size(prec%precv),izero,izero,izero,izero/))
goto 9999 goto 9999
endif endif

10
mlprec/impl/mld_zprecinit.F90
Unescape Escape View File

@ -110,11 +110,11 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
! Arguments ! Arguments
type(mld_zprec_type), intent(inout) :: p type(mld_zprec_type), intent(inout) :: p
character(len=*), intent(in) :: ptype character(len=*), intent(in) :: ptype
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: nlev integer(psb_ipk_), optional, intent(in) :: nlev
! Local variables ! Local variables
integer :: nlev_, ilev_ integer(psb_ipk_) :: nlev_, ilev_
real(psb_dpk_) :: thr real(psb_dpk_) :: thr
character(len=*), parameter :: name='mld_precinit' character(len=*), parameter :: name='mld_precinit'
info = psb_success_ info = psb_success_
@ -200,10 +200,10 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
#endif #endif
call p%precv(ilev_)%default() call p%precv(ilev_)%default()
p%precv(ilev_)%parms%coarse_solve = mld_bjac_ p%precv(ilev_)%parms%coarse_solve = mld_bjac_
call p%precv(ilev_)%set(mld_smoother_sweeps_,4,info) call p%precv(ilev_)%set(mld_smoother_sweeps_,4_psb_ipk_,info)
call p%precv(ilev_)%set(mld_sub_restr_,psb_none_,info) call p%precv(ilev_)%set(mld_sub_restr_,psb_none_,info)
call p%precv(ilev_)%set(mld_sub_prol_,psb_none_,info) call p%precv(ilev_)%set(mld_sub_prol_,psb_none_,info)
call p%precv(ilev_)%set(mld_sub_ovr_,0,info) call p%precv(ilev_)%set(mld_sub_ovr_,izero,info)
thr = 0.16d0 thr = 0.16d0
do ilev_=1,nlev_ do ilev_=1,nlev_

46
mlprec/impl/mld_zprecset.F90
Unescape Escape View File

@ -96,13 +96,13 @@ subroutine mld_zprecseti(p,what,val,info,ilev)
! Arguments ! Arguments
type(mld_zprec_type), intent(inout) :: p type(mld_zprec_type), intent(inout) :: p
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: ilev integer(psb_ipk_), optional, intent(in) :: ilev
! Local variables ! Local variables
integer :: ilev_, nlev_ integer(psb_ipk_) :: ilev_, nlev_
character(len=*), parameter :: name='mld_precseti' character(len=*), parameter :: name='mld_precseti'
info = psb_success_ info = psb_success_
@ -347,8 +347,8 @@ contains
subroutine onelev_set_smoother(level,val,info) subroutine onelev_set_smoother(level,val,info)
type(mld_z_onelev_type), intent(inout) :: level type(mld_z_onelev_type), intent(inout) :: level
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
info = psb_success_ info = psb_success_
! !
@ -444,8 +444,8 @@ contains
subroutine onelev_set_solver(level,val,info) subroutine onelev_set_solver(level,val,info)
type(mld_z_onelev_type), intent(inout) :: level type(mld_z_onelev_type), intent(inout) :: level
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
info = psb_success_ info = psb_success_
! !
@ -573,11 +573,11 @@ subroutine mld_zprecsetsm(p,val,info,ilev)
! Arguments ! Arguments
type(mld_zprec_type), intent(inout) :: p type(mld_zprec_type), intent(inout) :: p
class(mld_z_base_smoother_type), intent(in) :: val class(mld_z_base_smoother_type), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: ilev integer(psb_ipk_), optional, intent(in) :: ilev
! Local variables ! Local variables
integer :: ilev_, nlev_, ilmin, ilmax integer(psb_ipk_) :: ilev_, nlev_, ilmin, ilmax
character(len=*), parameter :: name='mld_precseti' character(len=*), parameter :: name='mld_precseti'
info = psb_success_ info = psb_success_
@ -636,11 +636,11 @@ subroutine mld_zprecsetsv(p,val,info,ilev)
! Arguments ! Arguments
type(mld_zprec_type), intent(inout) :: p type(mld_zprec_type), intent(inout) :: p
class(mld_z_base_solver_type), intent(in) :: val class(mld_z_base_solver_type), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: ilev integer(psb_ipk_), optional, intent(in) :: ilev
! Local variables ! Local variables
integer :: ilev_, nlev_, ilmin, ilmax integer(psb_ipk_) :: ilev_, nlev_, ilmin, ilmax
character(len=*), parameter :: name='mld_precseti' character(len=*), parameter :: name='mld_precseti'
info = psb_success_ info = psb_success_
@ -746,13 +746,13 @@ subroutine mld_zprecsetc(p,what,string,info,ilev)
! Arguments ! Arguments
type(mld_zprec_type), intent(inout) :: p type(mld_zprec_type), intent(inout) :: p
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: string character(len=*), intent(in) :: string
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: ilev integer(psb_ipk_), optional, intent(in) :: ilev
! Local variables ! Local variables
integer :: ilev_, nlev_,val integer(psb_ipk_) :: ilev_, nlev_,val
character(len=*), parameter :: name='mld_precsetc' character(len=*), parameter :: name='mld_precsetc'
info = psb_success_ info = psb_success_
@ -830,13 +830,13 @@ subroutine mld_zprecsetr(p,what,val,info,ilev)
! Arguments ! Arguments
type(mld_zprec_type), intent(inout) :: p type(mld_zprec_type), intent(inout) :: p
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: ilev integer(psb_ipk_), optional, intent(in) :: ilev
! Local variables ! Local variables
integer :: ilev_,nlev_ integer(psb_ipk_) :: ilev_,nlev_
character(len=*), parameter :: name='mld_precsetr' character(len=*), parameter :: name='mld_precsetr'
info = psb_success_ info = psb_success_

Write Preview
Loading…
Cancel
Save