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

Merge branch 'unify_aggr_bld' into remap-coarse

Browse Source
implement-ainv
Salvatore Filippone 5 years ago
parent 07fe952426 49259c79b3
commit 2d51afb3c1
80 changed files with 1096 additions and 616 deletions
Show Stats Download Patch File Download Diff File

19
mlprec/impl/level/mld_c_base_onelev_dump.f90
Unescape Escape View File

@ -146,13 +146,24 @@ subroutine mld_c_base_onelev_dump(lv,level,info,prefix,head,ac,rp,&
end if end if
end if end if
if (level >= 2) then
if (allocated(lv%sm)) then if (allocated(lv%sm)) then
call lv%sm%dump(icontxt,level,info,smoother=smoother, & call lv%sm%dump(lv%desc_ac,level,info,smoother=smoother, &
& solver=solver,prefix=trim(prefix_)//"_sm") & solver=solver,prefix=trim(prefix_)//"_sm",global_num=global_num)
end if end if
if (allocated(lv%sm2a)) then if (allocated(lv%sm2a)) then
call lv%sm2a%dump(icontxt,level,info,smoother=smoother, & call lv%sm2a%dump(lv%desc_ac,level,info,smoother=smoother, &
& solver=solver,prefix=trim(prefix_)//"_sm2a") & solver=solver,prefix=trim(prefix_)//"_sm2a",global_num=global_num)
end if
else
if (allocated(lv%sm)) then
call lv%sm%dump(lv%base_desc,level,info,smoother=smoother, &
& solver=solver,prefix=trim(prefix_)//"_sm",global_num=global_num)
end if
if (allocated(lv%sm2a)) then
call lv%sm2a%dump(lv%base_desc,level,info,smoother=smoother, &
& solver=solver,prefix=trim(prefix_)//"_sm2a",global_num=global_num)
end if
end if end if
end subroutine mld_c_base_onelev_dump end subroutine mld_c_base_onelev_dump

19
mlprec/impl/level/mld_d_base_onelev_dump.f90
Unescape Escape View File

@ -146,13 +146,24 @@ subroutine mld_d_base_onelev_dump(lv,level,info,prefix,head,ac,rp,&
end if end if
end if end if
if (level >= 2) then
if (allocated(lv%sm)) then if (allocated(lv%sm)) then
call lv%sm%dump(icontxt,level,info,smoother=smoother, & call lv%sm%dump(lv%desc_ac,level,info,smoother=smoother, &
& solver=solver,prefix=trim(prefix_)//"_sm") & solver=solver,prefix=trim(prefix_)//"_sm",global_num=global_num)
end if end if
if (allocated(lv%sm2a)) then if (allocated(lv%sm2a)) then
call lv%sm2a%dump(icontxt,level,info,smoother=smoother, & call lv%sm2a%dump(lv%desc_ac,level,info,smoother=smoother, &
& solver=solver,prefix=trim(prefix_)//"_sm2a") & solver=solver,prefix=trim(prefix_)//"_sm2a",global_num=global_num)
end if
else
if (allocated(lv%sm)) then
call lv%sm%dump(lv%base_desc,level,info,smoother=smoother, &
& solver=solver,prefix=trim(prefix_)//"_sm",global_num=global_num)
end if
if (allocated(lv%sm2a)) then
call lv%sm2a%dump(lv%base_desc,level,info,smoother=smoother, &
& solver=solver,prefix=trim(prefix_)//"_sm2a",global_num=global_num)
end if
end if end if
end subroutine mld_d_base_onelev_dump end subroutine mld_d_base_onelev_dump

19
mlprec/impl/level/mld_s_base_onelev_dump.f90
Unescape Escape View File

@ -146,13 +146,24 @@ subroutine mld_s_base_onelev_dump(lv,level,info,prefix,head,ac,rp,&
end if end if
end if end if
if (level >= 2) then
if (allocated(lv%sm)) then if (allocated(lv%sm)) then
call lv%sm%dump(icontxt,level,info,smoother=smoother, & call lv%sm%dump(lv%desc_ac,level,info,smoother=smoother, &
& solver=solver,prefix=trim(prefix_)//"_sm") & solver=solver,prefix=trim(prefix_)//"_sm",global_num=global_num)
end if end if
if (allocated(lv%sm2a)) then if (allocated(lv%sm2a)) then
call lv%sm2a%dump(icontxt,level,info,smoother=smoother, & call lv%sm2a%dump(lv%desc_ac,level,info,smoother=smoother, &
& solver=solver,prefix=trim(prefix_)//"_sm2a") & solver=solver,prefix=trim(prefix_)//"_sm2a",global_num=global_num)
end if
else
if (allocated(lv%sm)) then
call lv%sm%dump(lv%base_desc,level,info,smoother=smoother, &
& solver=solver,prefix=trim(prefix_)//"_sm",global_num=global_num)
end if
if (allocated(lv%sm2a)) then
call lv%sm2a%dump(lv%base_desc,level,info,smoother=smoother, &
& solver=solver,prefix=trim(prefix_)//"_sm2a",global_num=global_num)
end if
end if end if
end subroutine mld_s_base_onelev_dump end subroutine mld_s_base_onelev_dump

19
mlprec/impl/level/mld_z_base_onelev_dump.f90
Unescape Escape View File

@ -146,13 +146,24 @@ subroutine mld_z_base_onelev_dump(lv,level,info,prefix,head,ac,rp,&
end if end if
end if end if
if (level >= 2) then
if (allocated(lv%sm)) then if (allocated(lv%sm)) then
call lv%sm%dump(icontxt,level,info,smoother=smoother, & call lv%sm%dump(lv%desc_ac,level,info,smoother=smoother, &
& solver=solver,prefix=trim(prefix_)//"_sm") & solver=solver,prefix=trim(prefix_)//"_sm",global_num=global_num)
end if end if
if (allocated(lv%sm2a)) then if (allocated(lv%sm2a)) then
call lv%sm2a%dump(icontxt,level,info,smoother=smoother, & call lv%sm2a%dump(lv%desc_ac,level,info,smoother=smoother, &
& solver=solver,prefix=trim(prefix_)//"_sm2a") & solver=solver,prefix=trim(prefix_)//"_sm2a",global_num=global_num)
end if
else
if (allocated(lv%sm)) then
call lv%sm%dump(lv%base_desc,level,info,smoother=smoother, &
& solver=solver,prefix=trim(prefix_)//"_sm",global_num=global_num)
end if
if (allocated(lv%sm2a)) then
call lv%sm2a%dump(lv%base_desc,level,info,smoother=smoother, &
& solver=solver,prefix=trim(prefix_)//"_sm2a",global_num=global_num)
end if
end if end if
end subroutine mld_z_base_onelev_dump end subroutine mld_z_base_onelev_dump

24
mlprec/impl/smoother/mld_c_as_smoother_dmp.f90
Unescape Escape View File

@ -35,21 +35,22 @@
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
subroutine mld_c_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver) subroutine mld_c_as_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
use psb_base_mod use psb_base_mod
use mld_c_as_smoother, mld_protect_nam => mld_c_as_smoother_dmp use mld_c_as_smoother, mld_protect_nam => mld_c_as_smoother_dmp
implicit none implicit none
class(mld_c_as_smoother_type), intent(in) :: sm class(mld_c_as_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(in) :: ictxt,level type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver logical, optional, intent(in) :: smoother, solver, global_num
integer(psb_ipk_) :: i, j, il1, iln, lname, lev integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np integer(psb_ipk_) :: ictxt,iam, np
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
logical :: smoother_ logical :: smoother_, global_num_
! len of prefix_ ! len of prefix_
info = 0 info = 0
@ -59,7 +60,7 @@ subroutine mld_c_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver
else else
prefix_ = "dump_smth_c" prefix_ = "dump_smth_c"
end if end if
ictxt = desc%get_context()
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
if (present(smoother)) then if (present(smoother)) then
@ -67,11 +68,18 @@ subroutine mld_c_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver
else else
smoother_ = .false. smoother_ = .false.
end if end if
if (present(global_num)) then
global_num_ = global_num
else
global_num_ = .false.
end if
lname = len_trim(prefix_) lname = len_trim(prefix_)
fname = trim(prefix_) fname = trim(prefix_)
write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam
lname = lname + 5 lname = lname + 5
if (global_num_) then
write(0,*) iam,' Warning: no global num with AS smoothers dump'
end if
if (smoother_) then if (smoother_) then
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_nd.mtx' write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_nd.mtx'
if (sm%nd%is_asb()) & if (sm%nd%is_asb()) &
@ -79,6 +87,6 @@ subroutine mld_c_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver
end if end if
! At base level do nothing for the smoother ! At base level do nothing for the smoother
if (allocated(sm%sv)) & if (allocated(sm%sv)) &
& call sm%sv%dump(ictxt,level,info,solver=solver,prefix=prefix) & call sm%sv%dump(desc,level,info,solver=solver,prefix=prefix,global_num=global_num)
end subroutine mld_c_as_smoother_dmp end subroutine mld_c_as_smoother_dmp

20
mlprec/impl/smoother/mld_c_base_smoother_dmp.f90
Unescape Escape View File

@ -35,21 +35,22 @@
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
subroutine mld_c_base_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver) subroutine mld_c_base_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
use psb_base_mod use psb_base_mod
use mld_c_base_smoother_mod, mld_protect_name => mld_c_base_smoother_dmp use mld_c_base_smoother_mod, mld_protect_name => mld_c_base_smoother_dmp
implicit none implicit none
class(mld_c_base_smoother_type), intent(in) :: sm class(mld_c_base_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(in) :: ictxt,level type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver logical, optional, intent(in) :: smoother, solver, global_num
integer(psb_ipk_) :: i, j, il1, iln, lname, lev integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np integer(psb_ipk_) :: ictxt,iam, np
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
logical :: smoother_ logical :: smoother_, global_num_
! len of prefix_ ! len of prefix_
info = 0 info = 0
@ -59,9 +60,14 @@ subroutine mld_c_base_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solv
else else
prefix_ = "dump_smth_c" prefix_ = "dump_smth_c"
end if end if
ictxt = desc%get_context()
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
if (present(global_num)) then
global_num_ = global_num
else
global_num_ = .false.
end if
if (present(smoother)) then if (present(smoother)) then
smoother_ = smoother smoother_ = smoother
else else
@ -74,6 +80,6 @@ subroutine mld_c_base_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solv
! At base level do nothing for the smoother ! At base level do nothing for the smoother
if (allocated(sm%sv)) & if (allocated(sm%sv)) &
& call sm%sv%dump(ictxt,level,info,solver=solver,prefix=prefix) & call sm%sv%dump(desc,level,info,solver=solver,prefix=prefix,global_num=global_num)
end subroutine mld_c_base_smoother_dmp end subroutine mld_c_base_smoother_dmp

5
mlprec/impl/smoother/mld_c_jac_smoother_clone.f90
Unescape Escape View File

@ -67,6 +67,11 @@ subroutine mld_c_jac_smoother_clone(sm,smout,info)
select type(smo => smout) select type(smo => smout)
type is (mld_c_jac_smoother_type) type is (mld_c_jac_smoother_type)
smo%nd_nnz_tot = sm%nd_nnz_tot smo%nd_nnz_tot = sm%nd_nnz_tot
smo%checkres = sm%checkres
smo%printres = sm%printres
smo%checkiter = sm%checkiter
smo%printiter = sm%printiter
smo%tol = sm%tol
call sm%nd%clone(smo%nd,info) call sm%nd%clone(smo%nd,info)
if ((info==psb_success_).and.(allocated(sm%sv))) then if ((info==psb_success_).and.(allocated(sm%sv))) then
allocate(smout%sv,mold=sm%sv,stat=info) allocate(smout%sv,mold=sm%sv,stat=info)

21
mlprec/impl/smoother/mld_c_jac_smoother_csetc.f90
Unescape Escape View File

@ -52,20 +52,25 @@ subroutine mld_c_jac_smoother_csetc(sm,what,val,info,idx)
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
select case(psb_toupper(trim(what)))
select case(psb_toupper(what))
case('SMOOTHER_STOP') case('SMOOTHER_STOP')
if((psb_toupper(trim(val)) == 'T').or.(psb_toupper(trim(val)) == 'TRUE')) then select case(psb_toupper(trim(val)))
case('T','TRUE')
sm%checkres = .true. sm%checkres = .true.
else case('F','FALSE')
sm%checkres = .false. sm%checkres = .false.
end if case default
write(0,*) 'Unknown value for smoother_stop : "',psb_toupper(trim(val)),'"'
end select
case('SMOOTHER_TRACE') case('SMOOTHER_TRACE')
if((psb_toupper(trim(val)) == 'T').or.(psb_toupper(trim(val)) == 'TRUE')) then select case(psb_toupper(trim(val)))
case('T','TRUE')
sm%printres = .true. sm%printres = .true.
else case('F','FALSE')
sm%printres = .false. sm%printres = .false.
end if case default
write(0,*) 'Unknown value for smoother_trace : "',psb_toupper(trim(val)),'"'
end select
case default case default
call sm%mld_c_base_smoother_type%set(what,val,info,idx=idx) call sm%mld_c_base_smoother_type%set(what,val,info,idx=idx)
end select end select

27
mlprec/impl/smoother/mld_c_jac_smoother_dmp.f90
Unescape Escape View File

@ -35,21 +35,23 @@
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
subroutine mld_c_jac_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver) subroutine mld_c_jac_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
use psb_base_mod use psb_base_mod
use mld_c_jac_smoother, mld_protect_nam => mld_c_jac_smoother_dmp use mld_c_jac_smoother, mld_protect_nam => mld_c_jac_smoother_dmp
implicit none implicit none
class(mld_c_jac_smoother_type), intent(in) :: sm class(mld_c_jac_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(in) :: ictxt,level type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver logical, optional, intent(in) :: smoother, solver, global_num
integer(psb_ipk_) :: i, j, il1, iln, lname, lev integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np integer(psb_ipk_) :: ictxt,iam, np
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
logical :: smoother_ integer(psb_lpk_), allocatable :: iv(:)
logical :: smoother_, global_num_
! len of prefix_ ! len of prefix_
info = 0 info = 0
@ -59,7 +61,7 @@ subroutine mld_c_jac_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solve
else else
prefix_ = "dump_smth_c" prefix_ = "dump_smth_c"
end if end if
ictxt = desc%get_context()
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
if (present(smoother)) then if (present(smoother)) then
@ -67,6 +69,11 @@ subroutine mld_c_jac_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solve
else else
smoother_ = .false. smoother_ = .false.
end if end if
if (present(global_num)) then
global_num_ = global_num
else
global_num_ = .false.
end if
lname = len_trim(prefix_) lname = len_trim(prefix_)
fname = trim(prefix_) fname = trim(prefix_)
write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam
@ -74,11 +81,17 @@ subroutine mld_c_jac_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solve
if (smoother_) then if (smoother_) then
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_nd.mtx' write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_nd.mtx'
if (global_num_) then
iv = desc%get_global_indices(owned=.false.)
if (sm%nd%is_asb()) &
& call sm%nd%print(fname,head=head,iv=iv)
else
if (sm%nd%is_asb()) & if (sm%nd%is_asb()) &
& call sm%nd%print(fname,head=head) & call sm%nd%print(fname,head=head)
end if end if
end if
! At base level do nothing for the smoother ! At base level do nothing for the smoother
if (allocated(sm%sv)) & if (allocated(sm%sv)) &
& call sm%sv%dump(ictxt,level,info,solver=solver,prefix=prefix) & call sm%sv%dump(desc,level,info,solver=solver,prefix=prefix,global_num=global_num)
end subroutine mld_c_jac_smoother_dmp end subroutine mld_c_jac_smoother_dmp

69
mlprec/impl/smoother/mld_c_l1_jac_smoother_bld.f90
Unescape Escape View File

@ -53,10 +53,8 @@ subroutine mld_c_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
! Local variables ! Local variables
integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nzeros integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nzeros
real(psb_spk_), allocatable :: arwsum(:) real(psb_spk_), allocatable :: arwsum(:)
type(psb_c_coo_sparse_mat) :: tmpcoo
type(psb_c_csr_sparse_mat) :: tmpcsr
type(psb_cspmat_type) :: tmpa type(psb_cspmat_type) :: tmpa
integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level, nz integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='c_l1_jac_smoother_bld', ch_err character(len=20) :: name='c_l1_jac_smoother_bld', ch_err
info=psb_success_ info=psb_success_
@ -94,8 +92,23 @@ subroutine mld_c_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
call psb_sum(ictxt,sm%nd_nnz_tot) call psb_sum(ictxt,sm%nd_nnz_tot)
call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold) call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
else else
call a%csclip(tmpa,info,&
& jmax=nrow_a,rscale=.false.,cscale=.false.)
call a%csclip(sm%nd,info,& call a%csclip(sm%nd,info,&
& jmin=nrow_a+1,rscale=.false.,cscale=.false.) & jmin=nrow_a+1,rscale=.false.,cscale=.false.)
arwsum = sm%nd%arwsum(info)
call combine_dl1(-sone,arwsum,sm%nd,info)
call combine_dl1(sone,arwsum,tmpa,info)
sm%nd_nnz_tot = sm%nd%get_nzeros()
call psb_sum(ictxt,sm%nd_nnz_tot)
call sm%sv%build(tmpa,desc_a,info,amold=amold,vmold=vmold)
if (info == psb_success_) then if (info == psb_success_) then
if (present(amold)) then if (present(amold)) then
call sm%nd%cscnv(info,& call sm%nd%cscnv(info,&
@ -105,25 +118,6 @@ subroutine mld_c_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
& type='csr',dupl=psb_dupl_add_) & type='csr',dupl=psb_dupl_add_)
endif endif
end if end if
sm%nd_nnz_tot = sm%nd%get_nzeros()
call psb_sum(ictxt,sm%nd_nnz_tot)
arwsum = sm%nd%arwsum(info)
call a%csclip(tmpa,info,&
& jmax=nrow_a,rscale=.false.,cscale=.false.)
call tmpa%mv_to(tmpcoo)
call tmpcoo%set_dupl(psb_dupl_add_)
nz = tmpcoo%get_nzeros()
call tmpcoo%reallocate(nz+n_row)
do i=1, n_row
tmpcoo%ia(nz+i) = i
tmpcoo%ja(nz+i) = i
tmpcoo%val(nz+i) = arwsum(i)
end do
call tmpcoo%set_nzeros(nz+n_row)
call tmpcoo%fix(info)
call tmpcoo%mv_to_fmt(tmpcsr,info)
call tmpa%mv_from(tmpcsr)
call sm%sv%build(tmpa,desc_a,info,amold=amold,vmold=vmold)
end if end if
end select end select
if (info /= psb_success_) then if (info /= psb_success_) then
@ -148,4 +142,35 @@ subroutine mld_c_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
return return
contains
subroutine combine_dl1(alpha,dl1,mat,info)
implicit none
real(psb_spk_), intent(in) :: alpha, dl1(:)
type(psb_cspmat_type), intent(inout) :: mat
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: k, nz, nrm, dp
type(psb_c_coo_sparse_mat) :: tcoo
call mat%mv_to(tcoo)
nz = tcoo%get_nzeros()
nrm = min(size(dl1),tcoo%get_nrows(),tcoo%get_ncols())
!!$ write(0,*) 'Check on combine_dl1: ',nrm, tcoo%get_nrows(),tcoo%get_ncols(), nz
call tcoo%ensure_size(nz+nrm)
call tcoo%set_dupl(psb_dupl_add_)
do k=1,nrm
if (dl1(k) /= szero) then
nz = nz + 1
tcoo%ia(nz) = k
tcoo%ja(nz) = k
tcoo%val(nz) = alpha*dl1(k)
end if
end do
call tcoo%set_nzeros(nz)
call tcoo%fix(info)
call mat%mv_from(tcoo)
end subroutine combine_dl1
end subroutine mld_c_l1_jac_smoother_bld end subroutine mld_c_l1_jac_smoother_bld

5
mlprec/impl/smoother/mld_c_l1_jac_smoother_clone.f90
Unescape Escape View File

@ -67,6 +67,11 @@ subroutine mld_c_l1_jac_smoother_clone(sm,smout,info)
select type(smo => smout) select type(smo => smout)
type is (mld_c_l1_jac_smoother_type) type is (mld_c_l1_jac_smoother_type)
smo%nd_nnz_tot = sm%nd_nnz_tot smo%nd_nnz_tot = sm%nd_nnz_tot
smo%checkres = sm%checkres
smo%printres = sm%printres
smo%checkiter = sm%checkiter
smo%printiter = sm%printiter
smo%tol = sm%tol
call sm%nd%clone(smo%nd,info) call sm%nd%clone(smo%nd,info)
if ((info==psb_success_).and.(allocated(sm%sv))) then if ((info==psb_success_).and.(allocated(sm%sv))) then
allocate(smout%sv,mold=sm%sv,stat=info) allocate(smout%sv,mold=sm%sv,stat=info)

24
mlprec/impl/smoother/mld_d_as_smoother_dmp.f90
Unescape Escape View File

@ -35,21 +35,22 @@
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
subroutine mld_d_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver) subroutine mld_d_as_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
use psb_base_mod use psb_base_mod
use mld_d_as_smoother, mld_protect_nam => mld_d_as_smoother_dmp use mld_d_as_smoother, mld_protect_nam => mld_d_as_smoother_dmp
implicit none implicit none
class(mld_d_as_smoother_type), intent(in) :: sm class(mld_d_as_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(in) :: ictxt,level type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver logical, optional, intent(in) :: smoother, solver, global_num
integer(psb_ipk_) :: i, j, il1, iln, lname, lev integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np integer(psb_ipk_) :: ictxt,iam, np
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
logical :: smoother_ logical :: smoother_, global_num_
! len of prefix_ ! len of prefix_
info = 0 info = 0
@ -59,7 +60,7 @@ subroutine mld_d_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver
else else
prefix_ = "dump_smth_d" prefix_ = "dump_smth_d"
end if end if
ictxt = desc%get_context()
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
if (present(smoother)) then if (present(smoother)) then
@ -67,11 +68,18 @@ subroutine mld_d_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver
else else
smoother_ = .false. smoother_ = .false.
end if end if
if (present(global_num)) then
global_num_ = global_num
else
global_num_ = .false.
end if
lname = len_trim(prefix_) lname = len_trim(prefix_)
fname = trim(prefix_) fname = trim(prefix_)
write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam
lname = lname + 5 lname = lname + 5
if (global_num_) then
write(0,*) iam,' Warning: no global num with AS smoothers dump'
end if
if (smoother_) then if (smoother_) then
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_nd.mtx' write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_nd.mtx'
if (sm%nd%is_asb()) & if (sm%nd%is_asb()) &
@ -79,6 +87,6 @@ subroutine mld_d_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver
end if end if
! At base level do nothing for the smoother ! At base level do nothing for the smoother
if (allocated(sm%sv)) & if (allocated(sm%sv)) &
& call sm%sv%dump(ictxt,level,info,solver=solver,prefix=prefix) & call sm%sv%dump(desc,level,info,solver=solver,prefix=prefix,global_num=global_num)
end subroutine mld_d_as_smoother_dmp end subroutine mld_d_as_smoother_dmp

20
mlprec/impl/smoother/mld_d_base_smoother_dmp.f90
Unescape Escape View File

@ -35,21 +35,22 @@
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
subroutine mld_d_base_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver) subroutine mld_d_base_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
use psb_base_mod use psb_base_mod
use mld_d_base_smoother_mod, mld_protect_name => mld_d_base_smoother_dmp use mld_d_base_smoother_mod, mld_protect_name => mld_d_base_smoother_dmp
implicit none implicit none
class(mld_d_base_smoother_type), intent(in) :: sm class(mld_d_base_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(in) :: ictxt,level type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver logical, optional, intent(in) :: smoother, solver, global_num
integer(psb_ipk_) :: i, j, il1, iln, lname, lev integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np integer(psb_ipk_) :: ictxt,iam, np
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
logical :: smoother_ logical :: smoother_, global_num_
! len of prefix_ ! len of prefix_
info = 0 info = 0
@ -59,9 +60,14 @@ subroutine mld_d_base_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solv
else else
prefix_ = "dump_smth_d" prefix_ = "dump_smth_d"
end if end if
ictxt = desc%get_context()
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
if (present(global_num)) then
global_num_ = global_num
else
global_num_ = .false.
end if
if (present(smoother)) then if (present(smoother)) then
smoother_ = smoother smoother_ = smoother
else else
@ -74,6 +80,6 @@ subroutine mld_d_base_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solv
! At base level do nothing for the smoother ! At base level do nothing for the smoother
if (allocated(sm%sv)) & if (allocated(sm%sv)) &
& call sm%sv%dump(ictxt,level,info,solver=solver,prefix=prefix) & call sm%sv%dump(desc,level,info,solver=solver,prefix=prefix,global_num=global_num)
end subroutine mld_d_base_smoother_dmp end subroutine mld_d_base_smoother_dmp

5
mlprec/impl/smoother/mld_d_jac_smoother_clone.f90
Unescape Escape View File

@ -67,6 +67,11 @@ subroutine mld_d_jac_smoother_clone(sm,smout,info)
select type(smo => smout) select type(smo => smout)
type is (mld_d_jac_smoother_type) type is (mld_d_jac_smoother_type)
smo%nd_nnz_tot = sm%nd_nnz_tot smo%nd_nnz_tot = sm%nd_nnz_tot
smo%checkres = sm%checkres
smo%printres = sm%printres
smo%checkiter = sm%checkiter
smo%printiter = sm%printiter
smo%tol = sm%tol
call sm%nd%clone(smo%nd,info) call sm%nd%clone(smo%nd,info)
if ((info==psb_success_).and.(allocated(sm%sv))) then if ((info==psb_success_).and.(allocated(sm%sv))) then
allocate(smout%sv,mold=sm%sv,stat=info) allocate(smout%sv,mold=sm%sv,stat=info)

21
mlprec/impl/smoother/mld_d_jac_smoother_csetc.f90
Unescape Escape View File

@ -52,20 +52,25 @@ subroutine mld_d_jac_smoother_csetc(sm,what,val,info,idx)
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
select case(psb_toupper(trim(what)))
select case(psb_toupper(what))
case('SMOOTHER_STOP') case('SMOOTHER_STOP')
if((psb_toupper(trim(val)) == 'T').or.(psb_toupper(trim(val)) == 'TRUE')) then select case(psb_toupper(trim(val)))
case('T','TRUE')
sm%checkres = .true. sm%checkres = .true.
else case('F','FALSE')
sm%checkres = .false. sm%checkres = .false.
end if case default
write(0,*) 'Unknown value for smoother_stop : "',psb_toupper(trim(val)),'"'
end select
case('SMOOTHER_TRACE') case('SMOOTHER_TRACE')
if((psb_toupper(trim(val)) == 'T').or.(psb_toupper(trim(val)) == 'TRUE')) then select case(psb_toupper(trim(val)))
case('T','TRUE')
sm%printres = .true. sm%printres = .true.
else case('F','FALSE')
sm%printres = .false. sm%printres = .false.
end if case default
write(0,*) 'Unknown value for smoother_trace : "',psb_toupper(trim(val)),'"'
end select
case default case default
call sm%mld_d_base_smoother_type%set(what,val,info,idx=idx) call sm%mld_d_base_smoother_type%set(what,val,info,idx=idx)
end select end select

27
mlprec/impl/smoother/mld_d_jac_smoother_dmp.f90
Unescape Escape View File

@ -35,21 +35,23 @@
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
subroutine mld_d_jac_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver) subroutine mld_d_jac_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
use psb_base_mod use psb_base_mod
use mld_d_jac_smoother, mld_protect_nam => mld_d_jac_smoother_dmp use mld_d_jac_smoother, mld_protect_nam => mld_d_jac_smoother_dmp
implicit none implicit none
class(mld_d_jac_smoother_type), intent(in) :: sm class(mld_d_jac_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(in) :: ictxt,level type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver logical, optional, intent(in) :: smoother, solver, global_num
integer(psb_ipk_) :: i, j, il1, iln, lname, lev integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np integer(psb_ipk_) :: ictxt,iam, np
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
logical :: smoother_ integer(psb_lpk_), allocatable :: iv(:)
logical :: smoother_, global_num_
! len of prefix_ ! len of prefix_
info = 0 info = 0
@ -59,7 +61,7 @@ subroutine mld_d_jac_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solve
else else
prefix_ = "dump_smth_d" prefix_ = "dump_smth_d"
end if end if
ictxt = desc%get_context()
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
if (present(smoother)) then if (present(smoother)) then
@ -67,6 +69,11 @@ subroutine mld_d_jac_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solve
else else
smoother_ = .false. smoother_ = .false.
end if end if
if (present(global_num)) then
global_num_ = global_num
else
global_num_ = .false.
end if
lname = len_trim(prefix_) lname = len_trim(prefix_)
fname = trim(prefix_) fname = trim(prefix_)
write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam
@ -74,11 +81,17 @@ subroutine mld_d_jac_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solve
if (smoother_) then if (smoother_) then
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_nd.mtx' write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_nd.mtx'
if (global_num_) then
iv = desc%get_global_indices(owned=.false.)
if (sm%nd%is_asb()) &
& call sm%nd%print(fname,head=head,iv=iv)
else
if (sm%nd%is_asb()) & if (sm%nd%is_asb()) &
& call sm%nd%print(fname,head=head) & call sm%nd%print(fname,head=head)
end if end if
end if
! At base level do nothing for the smoother ! At base level do nothing for the smoother
if (allocated(sm%sv)) & if (allocated(sm%sv)) &
& call sm%sv%dump(ictxt,level,info,solver=solver,prefix=prefix) & call sm%sv%dump(desc,level,info,solver=solver,prefix=prefix,global_num=global_num)
end subroutine mld_d_jac_smoother_dmp end subroutine mld_d_jac_smoother_dmp

69
mlprec/impl/smoother/mld_d_l1_jac_smoother_bld.f90
Unescape Escape View File

@ -53,10 +53,8 @@ subroutine mld_d_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
! Local variables ! Local variables
integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nzeros integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nzeros
real(psb_dpk_), allocatable :: arwsum(:) real(psb_dpk_), allocatable :: arwsum(:)
type(psb_d_coo_sparse_mat) :: tmpcoo
type(psb_d_csr_sparse_mat) :: tmpcsr
type(psb_dspmat_type) :: tmpa type(psb_dspmat_type) :: tmpa
integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level, nz integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='d_l1_jac_smoother_bld', ch_err character(len=20) :: name='d_l1_jac_smoother_bld', ch_err
info=psb_success_ info=psb_success_
@ -94,8 +92,23 @@ subroutine mld_d_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
call psb_sum(ictxt,sm%nd_nnz_tot) call psb_sum(ictxt,sm%nd_nnz_tot)
call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold) call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
else else
call a%csclip(tmpa,info,&
& jmax=nrow_a,rscale=.false.,cscale=.false.)
call a%csclip(sm%nd,info,& call a%csclip(sm%nd,info,&
& jmin=nrow_a+1,rscale=.false.,cscale=.false.) & jmin=nrow_a+1,rscale=.false.,cscale=.false.)
arwsum = sm%nd%arwsum(info)
call combine_dl1(-done,arwsum,sm%nd,info)
call combine_dl1(done,arwsum,tmpa,info)
sm%nd_nnz_tot = sm%nd%get_nzeros()
call psb_sum(ictxt,sm%nd_nnz_tot)
call sm%sv%build(tmpa,desc_a,info,amold=amold,vmold=vmold)
if (info == psb_success_) then if (info == psb_success_) then
if (present(amold)) then if (present(amold)) then
call sm%nd%cscnv(info,& call sm%nd%cscnv(info,&
@ -105,25 +118,6 @@ subroutine mld_d_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
& type='csr',dupl=psb_dupl_add_) & type='csr',dupl=psb_dupl_add_)
endif endif
end if end if
sm%nd_nnz_tot = sm%nd%get_nzeros()
call psb_sum(ictxt,sm%nd_nnz_tot)
arwsum = sm%nd%arwsum(info)
call a%csclip(tmpa,info,&
& jmax=nrow_a,rscale=.false.,cscale=.false.)
call tmpa%mv_to(tmpcoo)
call tmpcoo%set_dupl(psb_dupl_add_)
nz = tmpcoo%get_nzeros()
call tmpcoo%reallocate(nz+n_row)
do i=1, n_row
tmpcoo%ia(nz+i) = i
tmpcoo%ja(nz+i) = i
tmpcoo%val(nz+i) = arwsum(i)
end do
call tmpcoo%set_nzeros(nz+n_row)
call tmpcoo%fix(info)
call tmpcoo%mv_to_fmt(tmpcsr,info)
call tmpa%mv_from(tmpcsr)
call sm%sv%build(tmpa,desc_a,info,amold=amold,vmold=vmold)
end if end if
end select end select
if (info /= psb_success_) then if (info /= psb_success_) then
@ -148,4 +142,35 @@ subroutine mld_d_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
return return
contains
subroutine combine_dl1(alpha,dl1,mat,info)
implicit none
real(psb_dpk_), intent(in) :: alpha, dl1(:)
type(psb_dspmat_type), intent(inout) :: mat
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: k, nz, nrm, dp
type(psb_d_coo_sparse_mat) :: tcoo
call mat%mv_to(tcoo)
nz = tcoo%get_nzeros()
nrm = min(size(dl1),tcoo%get_nrows(),tcoo%get_ncols())
!!$ write(0,*) 'Check on combine_dl1: ',nrm, tcoo%get_nrows(),tcoo%get_ncols(), nz
call tcoo%ensure_size(nz+nrm)
call tcoo%set_dupl(psb_dupl_add_)
do k=1,nrm
if (dl1(k) /= dzero) then
nz = nz + 1
tcoo%ia(nz) = k
tcoo%ja(nz) = k
tcoo%val(nz) = alpha*dl1(k)
end if
end do
call tcoo%set_nzeros(nz)
call tcoo%fix(info)
call mat%mv_from(tcoo)
end subroutine combine_dl1
end subroutine mld_d_l1_jac_smoother_bld end subroutine mld_d_l1_jac_smoother_bld

5
mlprec/impl/smoother/mld_d_l1_jac_smoother_clone.f90
Unescape Escape View File

@ -67,6 +67,11 @@ subroutine mld_d_l1_jac_smoother_clone(sm,smout,info)
select type(smo => smout) select type(smo => smout)
type is (mld_d_l1_jac_smoother_type) type is (mld_d_l1_jac_smoother_type)
smo%nd_nnz_tot = sm%nd_nnz_tot smo%nd_nnz_tot = sm%nd_nnz_tot
smo%checkres = sm%checkres
smo%printres = sm%printres
smo%checkiter = sm%checkiter
smo%printiter = sm%printiter
smo%tol = sm%tol
call sm%nd%clone(smo%nd,info) call sm%nd%clone(smo%nd,info)
if ((info==psb_success_).and.(allocated(sm%sv))) then if ((info==psb_success_).and.(allocated(sm%sv))) then
allocate(smout%sv,mold=sm%sv,stat=info) allocate(smout%sv,mold=sm%sv,stat=info)

24
mlprec/impl/smoother/mld_s_as_smoother_dmp.f90
Unescape Escape View File

@ -35,21 +35,22 @@
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
subroutine mld_s_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver) subroutine mld_s_as_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
use psb_base_mod use psb_base_mod
use mld_s_as_smoother, mld_protect_nam => mld_s_as_smoother_dmp use mld_s_as_smoother, mld_protect_nam => mld_s_as_smoother_dmp
implicit none implicit none
class(mld_s_as_smoother_type), intent(in) :: sm class(mld_s_as_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(in) :: ictxt,level type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver logical, optional, intent(in) :: smoother, solver, global_num
integer(psb_ipk_) :: i, j, il1, iln, lname, lev integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np integer(psb_ipk_) :: ictxt,iam, np
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
logical :: smoother_ logical :: smoother_, global_num_
! len of prefix_ ! len of prefix_
info = 0 info = 0
@ -59,7 +60,7 @@ subroutine mld_s_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver
else else
prefix_ = "dump_smth_s" prefix_ = "dump_smth_s"
end if end if
ictxt = desc%get_context()
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
if (present(smoother)) then if (present(smoother)) then
@ -67,11 +68,18 @@ subroutine mld_s_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver
else else
smoother_ = .false. smoother_ = .false.
end if end if
if (present(global_num)) then
global_num_ = global_num
else
global_num_ = .false.
end if
lname = len_trim(prefix_) lname = len_trim(prefix_)
fname = trim(prefix_) fname = trim(prefix_)
write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam
lname = lname + 5 lname = lname + 5
if (global_num_) then
write(0,*) iam,' Warning: no global num with AS smoothers dump'
end if
if (smoother_) then if (smoother_) then
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_nd.mtx' write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_nd.mtx'
if (sm%nd%is_asb()) & if (sm%nd%is_asb()) &
@ -79,6 +87,6 @@ subroutine mld_s_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver
end if end if
! At base level do nothing for the smoother ! At base level do nothing for the smoother
if (allocated(sm%sv)) & if (allocated(sm%sv)) &
& call sm%sv%dump(ictxt,level,info,solver=solver,prefix=prefix) & call sm%sv%dump(desc,level,info,solver=solver,prefix=prefix,global_num=global_num)
end subroutine mld_s_as_smoother_dmp end subroutine mld_s_as_smoother_dmp

20
mlprec/impl/smoother/mld_s_base_smoother_dmp.f90
Unescape Escape View File

@ -35,21 +35,22 @@
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
subroutine mld_s_base_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver) subroutine mld_s_base_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
use psb_base_mod use psb_base_mod
use mld_s_base_smoother_mod, mld_protect_name => mld_s_base_smoother_dmp use mld_s_base_smoother_mod, mld_protect_name => mld_s_base_smoother_dmp
implicit none implicit none
class(mld_s_base_smoother_type), intent(in) :: sm class(mld_s_base_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(in) :: ictxt,level type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver logical, optional, intent(in) :: smoother, solver, global_num
integer(psb_ipk_) :: i, j, il1, iln, lname, lev integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np integer(psb_ipk_) :: ictxt,iam, np
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
logical :: smoother_ logical :: smoother_, global_num_
! len of prefix_ ! len of prefix_
info = 0 info = 0
@ -59,9 +60,14 @@ subroutine mld_s_base_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solv
else else
prefix_ = "dump_smth_s" prefix_ = "dump_smth_s"
end if end if
ictxt = desc%get_context()
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
if (present(global_num)) then
global_num_ = global_num
else
global_num_ = .false.
end if
if (present(smoother)) then if (present(smoother)) then
smoother_ = smoother smoother_ = smoother
else else
@ -74,6 +80,6 @@ subroutine mld_s_base_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solv
! At base level do nothing for the smoother ! At base level do nothing for the smoother
if (allocated(sm%sv)) & if (allocated(sm%sv)) &
& call sm%sv%dump(ictxt,level,info,solver=solver,prefix=prefix) & call sm%sv%dump(desc,level,info,solver=solver,prefix=prefix,global_num=global_num)
end subroutine mld_s_base_smoother_dmp end subroutine mld_s_base_smoother_dmp

5
mlprec/impl/smoother/mld_s_jac_smoother_clone.f90
Unescape Escape View File

@ -67,6 +67,11 @@ subroutine mld_s_jac_smoother_clone(sm,smout,info)
select type(smo => smout) select type(smo => smout)
type is (mld_s_jac_smoother_type) type is (mld_s_jac_smoother_type)
smo%nd_nnz_tot = sm%nd_nnz_tot smo%nd_nnz_tot = sm%nd_nnz_tot
smo%checkres = sm%checkres
smo%printres = sm%printres
smo%checkiter = sm%checkiter
smo%printiter = sm%printiter
smo%tol = sm%tol
call sm%nd%clone(smo%nd,info) call sm%nd%clone(smo%nd,info)
if ((info==psb_success_).and.(allocated(sm%sv))) then if ((info==psb_success_).and.(allocated(sm%sv))) then
allocate(smout%sv,mold=sm%sv,stat=info) allocate(smout%sv,mold=sm%sv,stat=info)

21
mlprec/impl/smoother/mld_s_jac_smoother_csetc.f90
Unescape Escape View File

@ -52,20 +52,25 @@ subroutine mld_s_jac_smoother_csetc(sm,what,val,info,idx)
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
select case(psb_toupper(trim(what)))
select case(psb_toupper(what))
case('SMOOTHER_STOP') case('SMOOTHER_STOP')
if((psb_toupper(trim(val)) == 'T').or.(psb_toupper(trim(val)) == 'TRUE')) then select case(psb_toupper(trim(val)))
case('T','TRUE')
sm%checkres = .true. sm%checkres = .true.
else case('F','FALSE')
sm%checkres = .false. sm%checkres = .false.
end if case default
write(0,*) 'Unknown value for smoother_stop : "',psb_toupper(trim(val)),'"'
end select
case('SMOOTHER_TRACE') case('SMOOTHER_TRACE')
if((psb_toupper(trim(val)) == 'T').or.(psb_toupper(trim(val)) == 'TRUE')) then select case(psb_toupper(trim(val)))
case('T','TRUE')
sm%printres = .true. sm%printres = .true.
else case('F','FALSE')
sm%printres = .false. sm%printres = .false.
end if case default
write(0,*) 'Unknown value for smoother_trace : "',psb_toupper(trim(val)),'"'
end select
case default case default
call sm%mld_s_base_smoother_type%set(what,val,info,idx=idx) call sm%mld_s_base_smoother_type%set(what,val,info,idx=idx)
end select end select

27
mlprec/impl/smoother/mld_s_jac_smoother_dmp.f90
Unescape Escape View File

@ -35,21 +35,23 @@
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
subroutine mld_s_jac_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver) subroutine mld_s_jac_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
use psb_base_mod use psb_base_mod
use mld_s_jac_smoother, mld_protect_nam => mld_s_jac_smoother_dmp use mld_s_jac_smoother, mld_protect_nam => mld_s_jac_smoother_dmp
implicit none implicit none
class(mld_s_jac_smoother_type), intent(in) :: sm class(mld_s_jac_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(in) :: ictxt,level type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver logical, optional, intent(in) :: smoother, solver, global_num
integer(psb_ipk_) :: i, j, il1, iln, lname, lev integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np integer(psb_ipk_) :: ictxt,iam, np
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
logical :: smoother_ integer(psb_lpk_), allocatable :: iv(:)
logical :: smoother_, global_num_
! len of prefix_ ! len of prefix_
info = 0 info = 0
@ -59,7 +61,7 @@ subroutine mld_s_jac_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solve
else else
prefix_ = "dump_smth_s" prefix_ = "dump_smth_s"
end if end if
ictxt = desc%get_context()
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
if (present(smoother)) then if (present(smoother)) then
@ -67,6 +69,11 @@ subroutine mld_s_jac_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solve
else else
smoother_ = .false. smoother_ = .false.
end if end if
if (present(global_num)) then
global_num_ = global_num
else
global_num_ = .false.
end if
lname = len_trim(prefix_) lname = len_trim(prefix_)
fname = trim(prefix_) fname = trim(prefix_)
write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam
@ -74,11 +81,17 @@ subroutine mld_s_jac_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solve
if (smoother_) then if (smoother_) then
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_nd.mtx' write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_nd.mtx'
if (global_num_) then
iv = desc%get_global_indices(owned=.false.)
if (sm%nd%is_asb()) &
& call sm%nd%print(fname,head=head,iv=iv)
else
if (sm%nd%is_asb()) & if (sm%nd%is_asb()) &
& call sm%nd%print(fname,head=head) & call sm%nd%print(fname,head=head)
end if end if
end if
! At base level do nothing for the smoother ! At base level do nothing for the smoother
if (allocated(sm%sv)) & if (allocated(sm%sv)) &
& call sm%sv%dump(ictxt,level,info,solver=solver,prefix=prefix) & call sm%sv%dump(desc,level,info,solver=solver,prefix=prefix,global_num=global_num)
end subroutine mld_s_jac_smoother_dmp end subroutine mld_s_jac_smoother_dmp

69
mlprec/impl/smoother/mld_s_l1_jac_smoother_bld.f90
Unescape Escape View File

@ -53,10 +53,8 @@ subroutine mld_s_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
! Local variables ! Local variables
integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nzeros integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nzeros
real(psb_spk_), allocatable :: arwsum(:) real(psb_spk_), allocatable :: arwsum(:)
type(psb_s_coo_sparse_mat) :: tmpcoo
type(psb_s_csr_sparse_mat) :: tmpcsr
type(psb_sspmat_type) :: tmpa type(psb_sspmat_type) :: tmpa
integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level, nz integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='s_l1_jac_smoother_bld', ch_err character(len=20) :: name='s_l1_jac_smoother_bld', ch_err
info=psb_success_ info=psb_success_
@ -94,8 +92,23 @@ subroutine mld_s_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
call psb_sum(ictxt,sm%nd_nnz_tot) call psb_sum(ictxt,sm%nd_nnz_tot)
call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold) call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
else else
call a%csclip(tmpa,info,&
& jmax=nrow_a,rscale=.false.,cscale=.false.)
call a%csclip(sm%nd,info,& call a%csclip(sm%nd,info,&
& jmin=nrow_a+1,rscale=.false.,cscale=.false.) & jmin=nrow_a+1,rscale=.false.,cscale=.false.)
arwsum = sm%nd%arwsum(info)
call combine_dl1(-sone,arwsum,sm%nd,info)
call combine_dl1(sone,arwsum,tmpa,info)
sm%nd_nnz_tot = sm%nd%get_nzeros()
call psb_sum(ictxt,sm%nd_nnz_tot)
call sm%sv%build(tmpa,desc_a,info,amold=amold,vmold=vmold)
if (info == psb_success_) then if (info == psb_success_) then
if (present(amold)) then if (present(amold)) then
call sm%nd%cscnv(info,& call sm%nd%cscnv(info,&
@ -105,25 +118,6 @@ subroutine mld_s_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
& type='csr',dupl=psb_dupl_add_) & type='csr',dupl=psb_dupl_add_)
endif endif
end if end if
sm%nd_nnz_tot = sm%nd%get_nzeros()
call psb_sum(ictxt,sm%nd_nnz_tot)
arwsum = sm%nd%arwsum(info)
call a%csclip(tmpa,info,&
& jmax=nrow_a,rscale=.false.,cscale=.false.)
call tmpa%mv_to(tmpcoo)
call tmpcoo%set_dupl(psb_dupl_add_)
nz = tmpcoo%get_nzeros()
call tmpcoo%reallocate(nz+n_row)
do i=1, n_row
tmpcoo%ia(nz+i) = i
tmpcoo%ja(nz+i) = i
tmpcoo%val(nz+i) = arwsum(i)
end do
call tmpcoo%set_nzeros(nz+n_row)
call tmpcoo%fix(info)
call tmpcoo%mv_to_fmt(tmpcsr,info)
call tmpa%mv_from(tmpcsr)
call sm%sv%build(tmpa,desc_a,info,amold=amold,vmold=vmold)
end if end if
end select end select
if (info /= psb_success_) then if (info /= psb_success_) then
@ -148,4 +142,35 @@ subroutine mld_s_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
return return
contains
subroutine combine_dl1(alpha,dl1,mat,info)
implicit none
real(psb_spk_), intent(in) :: alpha, dl1(:)
type(psb_sspmat_type), intent(inout) :: mat
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: k, nz, nrm, dp
type(psb_s_coo_sparse_mat) :: tcoo
call mat%mv_to(tcoo)
nz = tcoo%get_nzeros()
nrm = min(size(dl1),tcoo%get_nrows(),tcoo%get_ncols())
!!$ write(0,*) 'Check on combine_dl1: ',nrm, tcoo%get_nrows(),tcoo%get_ncols(), nz
call tcoo%ensure_size(nz+nrm)
call tcoo%set_dupl(psb_dupl_add_)
do k=1,nrm
if (dl1(k) /= szero) then
nz = nz + 1
tcoo%ia(nz) = k
tcoo%ja(nz) = k
tcoo%val(nz) = alpha*dl1(k)
end if
end do
call tcoo%set_nzeros(nz)
call tcoo%fix(info)
call mat%mv_from(tcoo)
end subroutine combine_dl1
end subroutine mld_s_l1_jac_smoother_bld end subroutine mld_s_l1_jac_smoother_bld

5
mlprec/impl/smoother/mld_s_l1_jac_smoother_clone.f90
Unescape Escape View File

@ -67,6 +67,11 @@ subroutine mld_s_l1_jac_smoother_clone(sm,smout,info)
select type(smo => smout) select type(smo => smout)
type is (mld_s_l1_jac_smoother_type) type is (mld_s_l1_jac_smoother_type)
smo%nd_nnz_tot = sm%nd_nnz_tot smo%nd_nnz_tot = sm%nd_nnz_tot
smo%checkres = sm%checkres
smo%printres = sm%printres
smo%checkiter = sm%checkiter
smo%printiter = sm%printiter
smo%tol = sm%tol
call sm%nd%clone(smo%nd,info) call sm%nd%clone(smo%nd,info)
if ((info==psb_success_).and.(allocated(sm%sv))) then if ((info==psb_success_).and.(allocated(sm%sv))) then
allocate(smout%sv,mold=sm%sv,stat=info) allocate(smout%sv,mold=sm%sv,stat=info)

24
mlprec/impl/smoother/mld_z_as_smoother_dmp.f90
Unescape Escape View File

@ -35,21 +35,22 @@
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
subroutine mld_z_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver) subroutine mld_z_as_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
use psb_base_mod use psb_base_mod
use mld_z_as_smoother, mld_protect_nam => mld_z_as_smoother_dmp use mld_z_as_smoother, mld_protect_nam => mld_z_as_smoother_dmp
implicit none implicit none
class(mld_z_as_smoother_type), intent(in) :: sm class(mld_z_as_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(in) :: ictxt,level type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver logical, optional, intent(in) :: smoother, solver, global_num
integer(psb_ipk_) :: i, j, il1, iln, lname, lev integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np integer(psb_ipk_) :: ictxt,iam, np
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
logical :: smoother_ logical :: smoother_, global_num_
! len of prefix_ ! len of prefix_
info = 0 info = 0
@ -59,7 +60,7 @@ subroutine mld_z_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver
else else
prefix_ = "dump_smth_z" prefix_ = "dump_smth_z"
end if end if
ictxt = desc%get_context()
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
if (present(smoother)) then if (present(smoother)) then
@ -67,11 +68,18 @@ subroutine mld_z_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver
else else
smoother_ = .false. smoother_ = .false.
end if end if
if (present(global_num)) then
global_num_ = global_num
else
global_num_ = .false.
end if
lname = len_trim(prefix_) lname = len_trim(prefix_)
fname = trim(prefix_) fname = trim(prefix_)
write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam
lname = lname + 5 lname = lname + 5
if (global_num_) then
write(0,*) iam,' Warning: no global num with AS smoothers dump'
end if
if (smoother_) then if (smoother_) then
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_nd.mtx' write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_nd.mtx'
if (sm%nd%is_asb()) & if (sm%nd%is_asb()) &
@ -79,6 +87,6 @@ subroutine mld_z_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver
end if end if
! At base level do nothing for the smoother ! At base level do nothing for the smoother
if (allocated(sm%sv)) & if (allocated(sm%sv)) &
& call sm%sv%dump(ictxt,level,info,solver=solver,prefix=prefix) & call sm%sv%dump(desc,level,info,solver=solver,prefix=prefix,global_num=global_num)
end subroutine mld_z_as_smoother_dmp end subroutine mld_z_as_smoother_dmp

20
mlprec/impl/smoother/mld_z_base_smoother_dmp.f90
Unescape Escape View File

@ -35,21 +35,22 @@
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
subroutine mld_z_base_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver) subroutine mld_z_base_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
use psb_base_mod use psb_base_mod
use mld_z_base_smoother_mod, mld_protect_name => mld_z_base_smoother_dmp use mld_z_base_smoother_mod, mld_protect_name => mld_z_base_smoother_dmp
implicit none implicit none
class(mld_z_base_smoother_type), intent(in) :: sm class(mld_z_base_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(in) :: ictxt,level type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver logical, optional, intent(in) :: smoother, solver, global_num
integer(psb_ipk_) :: i, j, il1, iln, lname, lev integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np integer(psb_ipk_) :: ictxt,iam, np
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
logical :: smoother_ logical :: smoother_, global_num_
! len of prefix_ ! len of prefix_
info = 0 info = 0
@ -59,9 +60,14 @@ subroutine mld_z_base_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solv
else else
prefix_ = "dump_smth_z" prefix_ = "dump_smth_z"
end if end if
ictxt = desc%get_context()
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
if (present(global_num)) then
global_num_ = global_num
else
global_num_ = .false.
end if
if (present(smoother)) then if (present(smoother)) then
smoother_ = smoother smoother_ = smoother
else else
@ -74,6 +80,6 @@ subroutine mld_z_base_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solv
! At base level do nothing for the smoother ! At base level do nothing for the smoother
if (allocated(sm%sv)) & if (allocated(sm%sv)) &
& call sm%sv%dump(ictxt,level,info,solver=solver,prefix=prefix) & call sm%sv%dump(desc,level,info,solver=solver,prefix=prefix,global_num=global_num)
end subroutine mld_z_base_smoother_dmp end subroutine mld_z_base_smoother_dmp

5
mlprec/impl/smoother/mld_z_jac_smoother_clone.f90
Unescape Escape View File

@ -67,6 +67,11 @@ subroutine mld_z_jac_smoother_clone(sm,smout,info)
select type(smo => smout) select type(smo => smout)
type is (mld_z_jac_smoother_type) type is (mld_z_jac_smoother_type)
smo%nd_nnz_tot = sm%nd_nnz_tot smo%nd_nnz_tot = sm%nd_nnz_tot
smo%checkres = sm%checkres
smo%printres = sm%printres
smo%checkiter = sm%checkiter
smo%printiter = sm%printiter
smo%tol = sm%tol
call sm%nd%clone(smo%nd,info) call sm%nd%clone(smo%nd,info)
if ((info==psb_success_).and.(allocated(sm%sv))) then if ((info==psb_success_).and.(allocated(sm%sv))) then
allocate(smout%sv,mold=sm%sv,stat=info) allocate(smout%sv,mold=sm%sv,stat=info)

21
mlprec/impl/smoother/mld_z_jac_smoother_csetc.f90
Unescape Escape View File

@ -52,20 +52,25 @@ subroutine mld_z_jac_smoother_csetc(sm,what,val,info,idx)
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
select case(psb_toupper(trim(what)))
select case(psb_toupper(what))
case('SMOOTHER_STOP') case('SMOOTHER_STOP')
if((psb_toupper(trim(val)) == 'T').or.(psb_toupper(trim(val)) == 'TRUE')) then select case(psb_toupper(trim(val)))
case('T','TRUE')
sm%checkres = .true. sm%checkres = .true.
else case('F','FALSE')
sm%checkres = .false. sm%checkres = .false.
end if case default
write(0,*) 'Unknown value for smoother_stop : "',psb_toupper(trim(val)),'"'
end select
case('SMOOTHER_TRACE') case('SMOOTHER_TRACE')
if((psb_toupper(trim(val)) == 'T').or.(psb_toupper(trim(val)) == 'TRUE')) then select case(psb_toupper(trim(val)))
case('T','TRUE')
sm%printres = .true. sm%printres = .true.
else case('F','FALSE')
sm%printres = .false. sm%printres = .false.
end if case default
write(0,*) 'Unknown value for smoother_trace : "',psb_toupper(trim(val)),'"'
end select
case default case default
call sm%mld_z_base_smoother_type%set(what,val,info,idx=idx) call sm%mld_z_base_smoother_type%set(what,val,info,idx=idx)
end select end select

27
mlprec/impl/smoother/mld_z_jac_smoother_dmp.f90
Unescape Escape View File

@ -35,21 +35,23 @@
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
subroutine mld_z_jac_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver) subroutine mld_z_jac_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
use psb_base_mod use psb_base_mod
use mld_z_jac_smoother, mld_protect_nam => mld_z_jac_smoother_dmp use mld_z_jac_smoother, mld_protect_nam => mld_z_jac_smoother_dmp
implicit none implicit none
class(mld_z_jac_smoother_type), intent(in) :: sm class(mld_z_jac_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(in) :: ictxt,level type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver logical, optional, intent(in) :: smoother, solver, global_num
integer(psb_ipk_) :: i, j, il1, iln, lname, lev integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np integer(psb_ipk_) :: ictxt,iam, np
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
logical :: smoother_ integer(psb_lpk_), allocatable :: iv(:)
logical :: smoother_, global_num_
! len of prefix_ ! len of prefix_
info = 0 info = 0
@ -59,7 +61,7 @@ subroutine mld_z_jac_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solve
else else
prefix_ = "dump_smth_z" prefix_ = "dump_smth_z"
end if end if
ictxt = desc%get_context()
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
if (present(smoother)) then if (present(smoother)) then
@ -67,6 +69,11 @@ subroutine mld_z_jac_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solve
else else
smoother_ = .false. smoother_ = .false.
end if end if
if (present(global_num)) then
global_num_ = global_num
else
global_num_ = .false.
end if
lname = len_trim(prefix_) lname = len_trim(prefix_)
fname = trim(prefix_) fname = trim(prefix_)
write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam
@ -74,11 +81,17 @@ subroutine mld_z_jac_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solve
if (smoother_) then if (smoother_) then
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_nd.mtx' write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_nd.mtx'
if (global_num_) then
iv = desc%get_global_indices(owned=.false.)
if (sm%nd%is_asb()) &
& call sm%nd%print(fname,head=head,iv=iv)
else
if (sm%nd%is_asb()) & if (sm%nd%is_asb()) &
& call sm%nd%print(fname,head=head) & call sm%nd%print(fname,head=head)
end if end if
end if
! At base level do nothing for the smoother ! At base level do nothing for the smoother
if (allocated(sm%sv)) & if (allocated(sm%sv)) &
& call sm%sv%dump(ictxt,level,info,solver=solver,prefix=prefix) & call sm%sv%dump(desc,level,info,solver=solver,prefix=prefix,global_num=global_num)
end subroutine mld_z_jac_smoother_dmp end subroutine mld_z_jac_smoother_dmp

69
mlprec/impl/smoother/mld_z_l1_jac_smoother_bld.f90
Unescape Escape View File

@ -53,10 +53,8 @@ subroutine mld_z_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
! Local variables ! Local variables
integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nzeros integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nzeros
real(psb_dpk_), allocatable :: arwsum(:) real(psb_dpk_), allocatable :: arwsum(:)
type(psb_z_coo_sparse_mat) :: tmpcoo
type(psb_z_csr_sparse_mat) :: tmpcsr
type(psb_zspmat_type) :: tmpa type(psb_zspmat_type) :: tmpa
integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level, nz integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='z_l1_jac_smoother_bld', ch_err character(len=20) :: name='z_l1_jac_smoother_bld', ch_err
info=psb_success_ info=psb_success_
@ -94,8 +92,23 @@ subroutine mld_z_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
call psb_sum(ictxt,sm%nd_nnz_tot) call psb_sum(ictxt,sm%nd_nnz_tot)
call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold) call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
else else
call a%csclip(tmpa,info,&
& jmax=nrow_a,rscale=.false.,cscale=.false.)
call a%csclip(sm%nd,info,& call a%csclip(sm%nd,info,&
& jmin=nrow_a+1,rscale=.false.,cscale=.false.) & jmin=nrow_a+1,rscale=.false.,cscale=.false.)
arwsum = sm%nd%arwsum(info)
call combine_dl1(-done,arwsum,sm%nd,info)
call combine_dl1(done,arwsum,tmpa,info)
sm%nd_nnz_tot = sm%nd%get_nzeros()
call psb_sum(ictxt,sm%nd_nnz_tot)
call sm%sv%build(tmpa,desc_a,info,amold=amold,vmold=vmold)
if (info == psb_success_) then if (info == psb_success_) then
if (present(amold)) then if (present(amold)) then
call sm%nd%cscnv(info,& call sm%nd%cscnv(info,&
@ -105,25 +118,6 @@ subroutine mld_z_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
& type='csr',dupl=psb_dupl_add_) & type='csr',dupl=psb_dupl_add_)
endif endif
end if end if
sm%nd_nnz_tot = sm%nd%get_nzeros()
call psb_sum(ictxt,sm%nd_nnz_tot)
arwsum = sm%nd%arwsum(info)
call a%csclip(tmpa,info,&
& jmax=nrow_a,rscale=.false.,cscale=.false.)
call tmpa%mv_to(tmpcoo)
call tmpcoo%set_dupl(psb_dupl_add_)
nz = tmpcoo%get_nzeros()
call tmpcoo%reallocate(nz+n_row)
do i=1, n_row
tmpcoo%ia(nz+i) = i
tmpcoo%ja(nz+i) = i
tmpcoo%val(nz+i) = arwsum(i)
end do
call tmpcoo%set_nzeros(nz+n_row)
call tmpcoo%fix(info)
call tmpcoo%mv_to_fmt(tmpcsr,info)
call tmpa%mv_from(tmpcsr)
call sm%sv%build(tmpa,desc_a,info,amold=amold,vmold=vmold)
end if end if
end select end select
if (info /= psb_success_) then if (info /= psb_success_) then
@ -148,4 +142,35 @@ subroutine mld_z_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
return return
contains
subroutine combine_dl1(alpha,dl1,mat,info)
implicit none
real(psb_dpk_), intent(in) :: alpha, dl1(:)
type(psb_zspmat_type), intent(inout) :: mat
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: k, nz, nrm, dp
type(psb_z_coo_sparse_mat) :: tcoo
call mat%mv_to(tcoo)
nz = tcoo%get_nzeros()
nrm = min(size(dl1),tcoo%get_nrows(),tcoo%get_ncols())
!!$ write(0,*) 'Check on combine_dl1: ',nrm, tcoo%get_nrows(),tcoo%get_ncols(), nz
call tcoo%ensure_size(nz+nrm)
call tcoo%set_dupl(psb_dupl_add_)
do k=1,nrm
if (dl1(k) /= dzero) then
nz = nz + 1
tcoo%ia(nz) = k
tcoo%ja(nz) = k
tcoo%val(nz) = alpha*dl1(k)
end if
end do
call tcoo%set_nzeros(nz)
call tcoo%fix(info)
call mat%mv_from(tcoo)
end subroutine combine_dl1
end subroutine mld_z_l1_jac_smoother_bld end subroutine mld_z_l1_jac_smoother_bld

5
mlprec/impl/smoother/mld_z_l1_jac_smoother_clone.f90
Unescape Escape View File

@ -67,6 +67,11 @@ subroutine mld_z_l1_jac_smoother_clone(sm,smout,info)
select type(smo => smout) select type(smo => smout)
type is (mld_z_l1_jac_smoother_type) type is (mld_z_l1_jac_smoother_type)
smo%nd_nnz_tot = sm%nd_nnz_tot smo%nd_nnz_tot = sm%nd_nnz_tot
smo%checkres = sm%checkres
smo%printres = sm%printres
smo%checkiter = sm%checkiter
smo%printiter = sm%printiter
smo%tol = sm%tol
call sm%nd%clone(smo%nd,info) call sm%nd%clone(smo%nd,info)
if ((info==psb_success_).and.(allocated(sm%sv))) then if ((info==psb_success_).and.(allocated(sm%sv))) then
allocate(smout%sv,mold=sm%sv,stat=info) allocate(smout%sv,mold=sm%sv,stat=info)

11
mlprec/impl/solver/mld_c_base_solver_dmp.f90
Unescape Escape View File

@ -35,18 +35,19 @@
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
subroutine mld_c_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver) subroutine mld_c_base_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
use psb_base_mod use psb_base_mod
use mld_c_base_solver_mod, mld_protect_name => mld_c_base_solver_dmp use mld_c_base_solver_mod, mld_protect_name => mld_c_base_solver_dmp
implicit none implicit none
class(mld_c_base_solver_type), intent(in) :: sv class(mld_c_base_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(in) :: ictxt,level type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver, global_num
integer(psb_ipk_) :: i, j, il1, iln, lname, lev integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np integer(psb_ipk_) :: ictxt,iam, np
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
logical :: solver_ logical :: solver_
@ -59,7 +60,7 @@ subroutine mld_c_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
else else
prefix_ = "dump_slv_c" prefix_ = "dump_slv_c"
end if end if
ictxt = desc%get_context()
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
if (present(solver)) then if (present(solver)) then

4
mlprec/impl/solver/mld_c_bwgs_solver_bld.f90
Unescape Escape View File

@ -70,9 +70,7 @@ subroutine mld_c_bwgs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
nrow_a = a%get_nrows() nrow_a = a%get_nrows()
nztota = a%get_nzeros() nztota = a%get_nzeros()
!!$ if (present(b)) then
!!$ nztota = nztota + b%get_nzeros()
!!$ end if
if (sv%eps <= dzero) then if (sv%eps <= dzero) then
! !
! This cuts out the off-diagonal part, because it's supposed to ! This cuts out the off-diagonal part, because it's supposed to

20
mlprec/impl/solver/mld_c_diag_solver_dmp.f90
Unescape Escape View File

@ -35,18 +35,19 @@
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
subroutine mld_c_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver) subroutine mld_c_diag_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
use psb_base_mod use psb_base_mod
use mld_c_diag_solver, mld_protect_name => mld_c_diag_solver_dmp use mld_c_diag_solver, mld_protect_name => mld_c_diag_solver_dmp
implicit none implicit none
class(mld_c_diag_solver_type), intent(in) :: sv class(mld_c_diag_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(in) :: ictxt,level type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver, global_num
integer(psb_ipk_) :: i, j, il1, iln, lname, lev integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np integer(psb_ipk_) :: ictxt,iam, np
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
logical :: solver_ logical :: solver_
@ -54,6 +55,7 @@ subroutine mld_c_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
info = 0 info = 0
ictxt = desc%get_context()
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
@ -81,18 +83,19 @@ subroutine mld_c_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
end if end if
end subroutine mld_c_diag_solver_dmp end subroutine mld_c_diag_solver_dmp
subroutine mld_c_l1_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver) subroutine mld_c_l1_diag_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
use psb_base_mod use psb_base_mod
use mld_c_l1_diag_solver, mld_protect_name => mld_c_l1_diag_solver_dmp use mld_c_l1_diag_solver, mld_protect_name => mld_c_l1_diag_solver_dmp
implicit none implicit none
class(mld_c_l1_diag_solver_type), intent(in) :: sv class(mld_c_l1_diag_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(in) :: ictxt,level type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver, global_num
integer(psb_ipk_) :: i, j, il1, iln, lname, lev integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np integer(psb_ipk_) :: ictxt,iam, np
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
logical :: solver_ logical :: solver_
@ -100,6 +103,7 @@ subroutine mld_c_l1_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
info = 0 info = 0
ictxt = desc%get_context()
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)

30
mlprec/impl/solver/mld_c_gs_solver_dmp.f90
Unescape Escape View File

@ -35,26 +35,28 @@
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
subroutine mld_c_gs_solver_dmp(sv,ictxt,level,info,prefix,head,solver) subroutine mld_c_gs_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
use psb_base_mod use psb_base_mod
use mld_c_gs_solver, mld_protect_name => mld_c_gs_solver_dmp use mld_c_gs_solver, mld_protect_name => mld_c_gs_solver_dmp
implicit none implicit none
class(mld_c_gs_solver_type), intent(in) :: sv class(mld_c_gs_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(in) :: ictxt,level type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver, global_num
integer(psb_ipk_) :: i, j, il1, iln, lname, lev integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np integer(psb_ipk_) :: ictxt,iam, np
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
logical :: solver_ integer(psb_lpk_), allocatable :: iv(:)
logical :: solver_, global_num_
! len of prefix_ ! len of prefix_
info = 0 info = 0
ictxt = desc%get_context()
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
if (present(solver)) then if (present(solver)) then
@ -62,6 +64,11 @@ subroutine mld_c_gs_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
else else
solver_ = .false. solver_ = .false.
end if end if
if (present(global_num)) then
global_num_ = global_num
else
global_num_ = .false.
end if
if (solver_) then if (solver_) then
if (present(prefix)) then if (present(prefix)) then
@ -74,13 +81,22 @@ subroutine mld_c_gs_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam
lname = lname + 5 lname = lname + 5
if (global_num_) then
iv = desc%get_global_indices(owned=.false.)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx'
if (sv%l%is_asb()) &
& call sv%l%print(fname,head=head,iv=iv)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx'
if (sv%u%is_asb()) &
& call sv%u%print(fname,head=head,iv=iv)
else
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx' write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx'
if (sv%l%is_asb()) & if (sv%l%is_asb()) &
& call sv%l%print(fname,head=head) & call sv%l%print(fname,head=head)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx' write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx'
if (sv%u%is_asb()) & if (sv%u%is_asb()) &
& call sv%u%print(fname,head=head) & call sv%u%print(fname,head=head)
end if
end if end if
end subroutine mld_c_gs_solver_dmp end subroutine mld_c_gs_solver_dmp

37
mlprec/impl/solver/mld_c_ilu_solver_dmp.f90
Unescape Escape View File

@ -35,26 +35,28 @@
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
subroutine mld_c_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver) subroutine mld_c_ilu_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
use psb_base_mod use psb_base_mod
use mld_c_ilu_solver, mld_protect_name => mld_c_ilu_solver_dmp use mld_c_ilu_solver, mld_protect_name => mld_c_ilu_solver_dmp
implicit none implicit none
class(mld_c_ilu_solver_type), intent(in) :: sv class(mld_c_ilu_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(in) :: ictxt,level type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver, global_num
integer(psb_ipk_) :: i, j, il1, iln, lname, lev integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np integer(psb_ipk_) :: ictxt,iam, np
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
logical :: solver_ logical :: solver_, global_num_
integer(psb_lpk_), allocatable :: iv(:)
! len of prefix_ ! len of prefix_
info = 0 info = 0
ictxt = desc%get_context()
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
if (present(solver)) then if (present(solver)) then
@ -62,6 +64,12 @@ subroutine mld_c_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
else else
solver_ = .false. solver_ = .false.
end if end if
if (present(global_num)) then
global_num_ = global_num
else
global_num_ = .false.
end if
if (solver_) then if (solver_) then
if (present(prefix)) then if (present(prefix)) then
@ -74,6 +82,21 @@ subroutine mld_c_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam
lname = lname + 5 lname = lname + 5
if (global_num_) then
iv = desc%get_global_indices(owned=.false.)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx'
if (sv%l%is_asb()) &
& call sv%l%print(fname,head=head,iv=iv)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_diag.mtx'
if (allocated(sv%d)) &
& call psb_geprt(fname,sv%d,head=head)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx'
if (sv%u%is_asb()) &
& call sv%u%print(fname,head=head,iv=iv)
else
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx' write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx'
if (sv%l%is_asb()) & if (sv%l%is_asb()) &
& call sv%l%print(fname,head=head) & call sv%l%print(fname,head=head)
@ -83,7 +106,7 @@ subroutine mld_c_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx' write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx'
if (sv%u%is_asb()) & if (sv%u%is_asb()) &
& call sv%u%print(fname,head=head) & call sv%u%print(fname,head=head)
end if
end if end if
end subroutine mld_c_ilu_solver_dmp end subroutine mld_c_ilu_solver_dmp

11
mlprec/impl/solver/mld_d_base_solver_dmp.f90
Unescape Escape View File

@ -35,18 +35,19 @@
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
subroutine mld_d_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver) subroutine mld_d_base_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
use psb_base_mod use psb_base_mod
use mld_d_base_solver_mod, mld_protect_name => mld_d_base_solver_dmp use mld_d_base_solver_mod, mld_protect_name => mld_d_base_solver_dmp
implicit none implicit none
class(mld_d_base_solver_type), intent(in) :: sv class(mld_d_base_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(in) :: ictxt,level type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver, global_num
integer(psb_ipk_) :: i, j, il1, iln, lname, lev integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np integer(psb_ipk_) :: ictxt,iam, np
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
logical :: solver_ logical :: solver_
@ -59,7 +60,7 @@ subroutine mld_d_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
else else
prefix_ = "dump_slv_d" prefix_ = "dump_slv_d"
end if end if
ictxt = desc%get_context()
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
if (present(solver)) then if (present(solver)) then

4
mlprec/impl/solver/mld_d_bwgs_solver_bld.f90
Unescape Escape View File

@ -70,9 +70,7 @@ subroutine mld_d_bwgs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
nrow_a = a%get_nrows() nrow_a = a%get_nrows()
nztota = a%get_nzeros() nztota = a%get_nzeros()
!!$ if (present(b)) then
!!$ nztota = nztota + b%get_nzeros()
!!$ end if
if (sv%eps <= dzero) then if (sv%eps <= dzero) then
! !
! This cuts out the off-diagonal part, because it's supposed to ! This cuts out the off-diagonal part, because it's supposed to

20
mlprec/impl/solver/mld_d_diag_solver_dmp.f90
Unescape Escape View File

@ -35,18 +35,19 @@
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
subroutine mld_d_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver) subroutine mld_d_diag_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
use psb_base_mod use psb_base_mod
use mld_d_diag_solver, mld_protect_name => mld_d_diag_solver_dmp use mld_d_diag_solver, mld_protect_name => mld_d_diag_solver_dmp
implicit none implicit none
class(mld_d_diag_solver_type), intent(in) :: sv class(mld_d_diag_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(in) :: ictxt,level type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver, global_num
integer(psb_ipk_) :: i, j, il1, iln, lname, lev integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np integer(psb_ipk_) :: ictxt,iam, np
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
logical :: solver_ logical :: solver_
@ -54,6 +55,7 @@ subroutine mld_d_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
info = 0 info = 0
ictxt = desc%get_context()
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
@ -81,18 +83,19 @@ subroutine mld_d_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
end if end if
end subroutine mld_d_diag_solver_dmp end subroutine mld_d_diag_solver_dmp
subroutine mld_d_l1_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver) subroutine mld_d_l1_diag_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
use psb_base_mod use psb_base_mod
use mld_d_l1_diag_solver, mld_protect_name => mld_d_l1_diag_solver_dmp use mld_d_l1_diag_solver, mld_protect_name => mld_d_l1_diag_solver_dmp
implicit none implicit none
class(mld_d_l1_diag_solver_type), intent(in) :: sv class(mld_d_l1_diag_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(in) :: ictxt,level type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver, global_num
integer(psb_ipk_) :: i, j, il1, iln, lname, lev integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np integer(psb_ipk_) :: ictxt,iam, np
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
logical :: solver_ logical :: solver_
@ -100,6 +103,7 @@ subroutine mld_d_l1_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
info = 0 info = 0
ictxt = desc%get_context()
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)

30
mlprec/impl/solver/mld_d_gs_solver_dmp.f90
Unescape Escape View File

@ -35,26 +35,28 @@
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
subroutine mld_d_gs_solver_dmp(sv,ictxt,level,info,prefix,head,solver) subroutine mld_d_gs_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
use psb_base_mod use psb_base_mod
use mld_d_gs_solver, mld_protect_name => mld_d_gs_solver_dmp use mld_d_gs_solver, mld_protect_name => mld_d_gs_solver_dmp
implicit none implicit none
class(mld_d_gs_solver_type), intent(in) :: sv class(mld_d_gs_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(in) :: ictxt,level type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver, global_num
integer(psb_ipk_) :: i, j, il1, iln, lname, lev integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np integer(psb_ipk_) :: ictxt,iam, np
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
logical :: solver_ integer(psb_lpk_), allocatable :: iv(:)
logical :: solver_, global_num_
! len of prefix_ ! len of prefix_
info = 0 info = 0
ictxt = desc%get_context()
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
if (present(solver)) then if (present(solver)) then
@ -62,6 +64,11 @@ subroutine mld_d_gs_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
else else
solver_ = .false. solver_ = .false.
end if end if
if (present(global_num)) then
global_num_ = global_num
else
global_num_ = .false.
end if
if (solver_) then if (solver_) then
if (present(prefix)) then if (present(prefix)) then
@ -74,13 +81,22 @@ subroutine mld_d_gs_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam
lname = lname + 5 lname = lname + 5
if (global_num_) then
iv = desc%get_global_indices(owned=.false.)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx'
if (sv%l%is_asb()) &
& call sv%l%print(fname,head=head,iv=iv)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx'
if (sv%u%is_asb()) &
& call sv%u%print(fname,head=head,iv=iv)
else
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx' write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx'
if (sv%l%is_asb()) & if (sv%l%is_asb()) &
& call sv%l%print(fname,head=head) & call sv%l%print(fname,head=head)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx' write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx'
if (sv%u%is_asb()) & if (sv%u%is_asb()) &
& call sv%u%print(fname,head=head) & call sv%u%print(fname,head=head)
end if
end if end if
end subroutine mld_d_gs_solver_dmp end subroutine mld_d_gs_solver_dmp

37
mlprec/impl/solver/mld_d_ilu_solver_dmp.f90
Unescape Escape View File

@ -35,26 +35,28 @@
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
subroutine mld_d_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver) subroutine mld_d_ilu_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
use psb_base_mod use psb_base_mod
use mld_d_ilu_solver, mld_protect_name => mld_d_ilu_solver_dmp use mld_d_ilu_solver, mld_protect_name => mld_d_ilu_solver_dmp
implicit none implicit none
class(mld_d_ilu_solver_type), intent(in) :: sv class(mld_d_ilu_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(in) :: ictxt,level type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver, global_num
integer(psb_ipk_) :: i, j, il1, iln, lname, lev integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np integer(psb_ipk_) :: ictxt,iam, np
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
logical :: solver_ logical :: solver_, global_num_
integer(psb_lpk_), allocatable :: iv(:)
! len of prefix_ ! len of prefix_
info = 0 info = 0
ictxt = desc%get_context()
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
if (present(solver)) then if (present(solver)) then
@ -62,6 +64,12 @@ subroutine mld_d_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
else else
solver_ = .false. solver_ = .false.
end if end if
if (present(global_num)) then
global_num_ = global_num
else
global_num_ = .false.
end if
if (solver_) then if (solver_) then
if (present(prefix)) then if (present(prefix)) then
@ -74,6 +82,21 @@ subroutine mld_d_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam
lname = lname + 5 lname = lname + 5
if (global_num_) then
iv = desc%get_global_indices(owned=.false.)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx'
if (sv%l%is_asb()) &
& call sv%l%print(fname,head=head,iv=iv)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_diag.mtx'
if (allocated(sv%d)) &
& call psb_geprt(fname,sv%d,head=head)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx'
if (sv%u%is_asb()) &
& call sv%u%print(fname,head=head,iv=iv)
else
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx' write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx'
if (sv%l%is_asb()) & if (sv%l%is_asb()) &
& call sv%l%print(fname,head=head) & call sv%l%print(fname,head=head)
@ -83,7 +106,7 @@ subroutine mld_d_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx' write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx'
if (sv%u%is_asb()) & if (sv%u%is_asb()) &
& call sv%u%print(fname,head=head) & call sv%u%print(fname,head=head)
end if
end if end if
end subroutine mld_d_ilu_solver_dmp end subroutine mld_d_ilu_solver_dmp

11
mlprec/impl/solver/mld_s_base_solver_dmp.f90
Unescape Escape View File

@ -35,18 +35,19 @@
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
subroutine mld_s_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver) subroutine mld_s_base_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
use psb_base_mod use psb_base_mod
use mld_s_base_solver_mod, mld_protect_name => mld_s_base_solver_dmp use mld_s_base_solver_mod, mld_protect_name => mld_s_base_solver_dmp
implicit none implicit none
class(mld_s_base_solver_type), intent(in) :: sv class(mld_s_base_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(in) :: ictxt,level type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver, global_num
integer(psb_ipk_) :: i, j, il1, iln, lname, lev integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np integer(psb_ipk_) :: ictxt,iam, np
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
logical :: solver_ logical :: solver_
@ -59,7 +60,7 @@ subroutine mld_s_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
else else
prefix_ = "dump_slv_s" prefix_ = "dump_slv_s"
end if end if
ictxt = desc%get_context()
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
if (present(solver)) then if (present(solver)) then

4
mlprec/impl/solver/mld_s_bwgs_solver_bld.f90
Unescape Escape View File

@ -70,9 +70,7 @@ subroutine mld_s_bwgs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
nrow_a = a%get_nrows() nrow_a = a%get_nrows()
nztota = a%get_nzeros() nztota = a%get_nzeros()
!!$ if (present(b)) then
!!$ nztota = nztota + b%get_nzeros()
!!$ end if
if (sv%eps <= dzero) then if (sv%eps <= dzero) then
! !
! This cuts out the off-diagonal part, because it's supposed to ! This cuts out the off-diagonal part, because it's supposed to

20
mlprec/impl/solver/mld_s_diag_solver_dmp.f90
Unescape Escape View File

@ -35,18 +35,19 @@
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
subroutine mld_s_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver) subroutine mld_s_diag_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
use psb_base_mod use psb_base_mod
use mld_s_diag_solver, mld_protect_name => mld_s_diag_solver_dmp use mld_s_diag_solver, mld_protect_name => mld_s_diag_solver_dmp
implicit none implicit none
class(mld_s_diag_solver_type), intent(in) :: sv class(mld_s_diag_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(in) :: ictxt,level type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver, global_num
integer(psb_ipk_) :: i, j, il1, iln, lname, lev integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np integer(psb_ipk_) :: ictxt,iam, np
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
logical :: solver_ logical :: solver_
@ -54,6 +55,7 @@ subroutine mld_s_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
info = 0 info = 0
ictxt = desc%get_context()
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
@ -81,18 +83,19 @@ subroutine mld_s_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
end if end if
end subroutine mld_s_diag_solver_dmp end subroutine mld_s_diag_solver_dmp
subroutine mld_s_l1_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver) subroutine mld_s_l1_diag_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
use psb_base_mod use psb_base_mod
use mld_s_l1_diag_solver, mld_protect_name => mld_s_l1_diag_solver_dmp use mld_s_l1_diag_solver, mld_protect_name => mld_s_l1_diag_solver_dmp
implicit none implicit none
class(mld_s_l1_diag_solver_type), intent(in) :: sv class(mld_s_l1_diag_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(in) :: ictxt,level type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver, global_num
integer(psb_ipk_) :: i, j, il1, iln, lname, lev integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np integer(psb_ipk_) :: ictxt,iam, np
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
logical :: solver_ logical :: solver_
@ -100,6 +103,7 @@ subroutine mld_s_l1_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
info = 0 info = 0
ictxt = desc%get_context()
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)

30
mlprec/impl/solver/mld_s_gs_solver_dmp.f90
Unescape Escape View File

@ -35,26 +35,28 @@
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
subroutine mld_s_gs_solver_dmp(sv,ictxt,level,info,prefix,head,solver) subroutine mld_s_gs_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
use psb_base_mod use psb_base_mod
use mld_s_gs_solver, mld_protect_name => mld_s_gs_solver_dmp use mld_s_gs_solver, mld_protect_name => mld_s_gs_solver_dmp
implicit none implicit none
class(mld_s_gs_solver_type), intent(in) :: sv class(mld_s_gs_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(in) :: ictxt,level type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver, global_num
integer(psb_ipk_) :: i, j, il1, iln, lname, lev integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np integer(psb_ipk_) :: ictxt,iam, np
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
logical :: solver_ integer(psb_lpk_), allocatable :: iv(:)
logical :: solver_, global_num_
! len of prefix_ ! len of prefix_
info = 0 info = 0
ictxt = desc%get_context()
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
if (present(solver)) then if (present(solver)) then
@ -62,6 +64,11 @@ subroutine mld_s_gs_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
else else
solver_ = .false. solver_ = .false.
end if end if
if (present(global_num)) then
global_num_ = global_num
else
global_num_ = .false.
end if
if (solver_) then if (solver_) then
if (present(prefix)) then if (present(prefix)) then
@ -74,13 +81,22 @@ subroutine mld_s_gs_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam
lname = lname + 5 lname = lname + 5
if (global_num_) then
iv = desc%get_global_indices(owned=.false.)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx'
if (sv%l%is_asb()) &
& call sv%l%print(fname,head=head,iv=iv)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx'
if (sv%u%is_asb()) &
& call sv%u%print(fname,head=head,iv=iv)
else
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx' write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx'
if (sv%l%is_asb()) & if (sv%l%is_asb()) &
& call sv%l%print(fname,head=head) & call sv%l%print(fname,head=head)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx' write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx'
if (sv%u%is_asb()) & if (sv%u%is_asb()) &
& call sv%u%print(fname,head=head) & call sv%u%print(fname,head=head)
end if
end if end if
end subroutine mld_s_gs_solver_dmp end subroutine mld_s_gs_solver_dmp

37
mlprec/impl/solver/mld_s_ilu_solver_dmp.f90
Unescape Escape View File

@ -35,26 +35,28 @@
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
subroutine mld_s_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver) subroutine mld_s_ilu_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
use psb_base_mod use psb_base_mod
use mld_s_ilu_solver, mld_protect_name => mld_s_ilu_solver_dmp use mld_s_ilu_solver, mld_protect_name => mld_s_ilu_solver_dmp
implicit none implicit none
class(mld_s_ilu_solver_type), intent(in) :: sv class(mld_s_ilu_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(in) :: ictxt,level type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver, global_num
integer(psb_ipk_) :: i, j, il1, iln, lname, lev integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np integer(psb_ipk_) :: ictxt,iam, np
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
logical :: solver_ logical :: solver_, global_num_
integer(psb_lpk_), allocatable :: iv(:)
! len of prefix_ ! len of prefix_
info = 0 info = 0
ictxt = desc%get_context()
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
if (present(solver)) then if (present(solver)) then
@ -62,6 +64,12 @@ subroutine mld_s_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
else else
solver_ = .false. solver_ = .false.
end if end if
if (present(global_num)) then
global_num_ = global_num
else
global_num_ = .false.
end if
if (solver_) then if (solver_) then
if (present(prefix)) then if (present(prefix)) then
@ -74,6 +82,21 @@ subroutine mld_s_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam
lname = lname + 5 lname = lname + 5
if (global_num_) then
iv = desc%get_global_indices(owned=.false.)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx'
if (sv%l%is_asb()) &
& call sv%l%print(fname,head=head,iv=iv)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_diag.mtx'
if (allocated(sv%d)) &
& call psb_geprt(fname,sv%d,head=head)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx'
if (sv%u%is_asb()) &
& call sv%u%print(fname,head=head,iv=iv)
else
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx' write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx'
if (sv%l%is_asb()) & if (sv%l%is_asb()) &
& call sv%l%print(fname,head=head) & call sv%l%print(fname,head=head)
@ -83,7 +106,7 @@ subroutine mld_s_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx' write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx'
if (sv%u%is_asb()) & if (sv%u%is_asb()) &
& call sv%u%print(fname,head=head) & call sv%u%print(fname,head=head)
end if
end if end if
end subroutine mld_s_ilu_solver_dmp end subroutine mld_s_ilu_solver_dmp

11
mlprec/impl/solver/mld_z_base_solver_dmp.f90
Unescape Escape View File

@ -35,18 +35,19 @@
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
subroutine mld_z_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver) subroutine mld_z_base_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
use psb_base_mod use psb_base_mod
use mld_z_base_solver_mod, mld_protect_name => mld_z_base_solver_dmp use mld_z_base_solver_mod, mld_protect_name => mld_z_base_solver_dmp
implicit none implicit none
class(mld_z_base_solver_type), intent(in) :: sv class(mld_z_base_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(in) :: ictxt,level type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver, global_num
integer(psb_ipk_) :: i, j, il1, iln, lname, lev integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np integer(psb_ipk_) :: ictxt,iam, np
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
logical :: solver_ logical :: solver_
@ -59,7 +60,7 @@ subroutine mld_z_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
else else
prefix_ = "dump_slv_z" prefix_ = "dump_slv_z"
end if end if
ictxt = desc%get_context()
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
if (present(solver)) then if (present(solver)) then

4
mlprec/impl/solver/mld_z_bwgs_solver_bld.f90
Unescape Escape View File

@ -70,9 +70,7 @@ subroutine mld_z_bwgs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
nrow_a = a%get_nrows() nrow_a = a%get_nrows()
nztota = a%get_nzeros() nztota = a%get_nzeros()
!!$ if (present(b)) then
!!$ nztota = nztota + b%get_nzeros()
!!$ end if
if (sv%eps <= dzero) then if (sv%eps <= dzero) then
! !
! This cuts out the off-diagonal part, because it's supposed to ! This cuts out the off-diagonal part, because it's supposed to

20
mlprec/impl/solver/mld_z_diag_solver_dmp.f90
Unescape Escape View File

@ -35,18 +35,19 @@
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
subroutine mld_z_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver) subroutine mld_z_diag_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
use psb_base_mod use psb_base_mod
use mld_z_diag_solver, mld_protect_name => mld_z_diag_solver_dmp use mld_z_diag_solver, mld_protect_name => mld_z_diag_solver_dmp
implicit none implicit none
class(mld_z_diag_solver_type), intent(in) :: sv class(mld_z_diag_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(in) :: ictxt,level type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver, global_num
integer(psb_ipk_) :: i, j, il1, iln, lname, lev integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np integer(psb_ipk_) :: ictxt,iam, np
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
logical :: solver_ logical :: solver_
@ -54,6 +55,7 @@ subroutine mld_z_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
info = 0 info = 0
ictxt = desc%get_context()
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
@ -81,18 +83,19 @@ subroutine mld_z_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
end if end if
end subroutine mld_z_diag_solver_dmp end subroutine mld_z_diag_solver_dmp
subroutine mld_z_l1_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver) subroutine mld_z_l1_diag_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
use psb_base_mod use psb_base_mod
use mld_z_l1_diag_solver, mld_protect_name => mld_z_l1_diag_solver_dmp use mld_z_l1_diag_solver, mld_protect_name => mld_z_l1_diag_solver_dmp
implicit none implicit none
class(mld_z_l1_diag_solver_type), intent(in) :: sv class(mld_z_l1_diag_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(in) :: ictxt,level type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver, global_num
integer(psb_ipk_) :: i, j, il1, iln, lname, lev integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np integer(psb_ipk_) :: ictxt,iam, np
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
logical :: solver_ logical :: solver_
@ -100,6 +103,7 @@ subroutine mld_z_l1_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
info = 0 info = 0
ictxt = desc%get_context()
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)

30
mlprec/impl/solver/mld_z_gs_solver_dmp.f90
Unescape Escape View File

@ -35,26 +35,28 @@
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
subroutine mld_z_gs_solver_dmp(sv,ictxt,level,info,prefix,head,solver) subroutine mld_z_gs_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
use psb_base_mod use psb_base_mod
use mld_z_gs_solver, mld_protect_name => mld_z_gs_solver_dmp use mld_z_gs_solver, mld_protect_name => mld_z_gs_solver_dmp
implicit none implicit none
class(mld_z_gs_solver_type), intent(in) :: sv class(mld_z_gs_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(in) :: ictxt,level type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver, global_num
integer(psb_ipk_) :: i, j, il1, iln, lname, lev integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np integer(psb_ipk_) :: ictxt,iam, np
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
logical :: solver_ integer(psb_lpk_), allocatable :: iv(:)
logical :: solver_, global_num_
! len of prefix_ ! len of prefix_
info = 0 info = 0
ictxt = desc%get_context()
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
if (present(solver)) then if (present(solver)) then
@ -62,6 +64,11 @@ subroutine mld_z_gs_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
else else
solver_ = .false. solver_ = .false.
end if end if
if (present(global_num)) then
global_num_ = global_num
else
global_num_ = .false.
end if
if (solver_) then if (solver_) then
if (present(prefix)) then if (present(prefix)) then
@ -74,13 +81,22 @@ subroutine mld_z_gs_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam
lname = lname + 5 lname = lname + 5
if (global_num_) then
iv = desc%get_global_indices(owned=.false.)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx'
if (sv%l%is_asb()) &
& call sv%l%print(fname,head=head,iv=iv)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx'
if (sv%u%is_asb()) &
& call sv%u%print(fname,head=head,iv=iv)
else
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx' write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx'
if (sv%l%is_asb()) & if (sv%l%is_asb()) &
& call sv%l%print(fname,head=head) & call sv%l%print(fname,head=head)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx' write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx'
if (sv%u%is_asb()) & if (sv%u%is_asb()) &
& call sv%u%print(fname,head=head) & call sv%u%print(fname,head=head)
end if
end if end if
end subroutine mld_z_gs_solver_dmp end subroutine mld_z_gs_solver_dmp

37
mlprec/impl/solver/mld_z_ilu_solver_dmp.f90
Unescape Escape View File

@ -35,26 +35,28 @@
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
subroutine mld_z_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver) subroutine mld_z_ilu_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
use psb_base_mod use psb_base_mod
use mld_z_ilu_solver, mld_protect_name => mld_z_ilu_solver_dmp use mld_z_ilu_solver, mld_protect_name => mld_z_ilu_solver_dmp
implicit none implicit none
class(mld_z_ilu_solver_type), intent(in) :: sv class(mld_z_ilu_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(in) :: ictxt,level type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver, global_num
integer(psb_ipk_) :: i, j, il1, iln, lname, lev integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np integer(psb_ipk_) :: ictxt,iam, np
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
logical :: solver_ logical :: solver_, global_num_
integer(psb_lpk_), allocatable :: iv(:)
! len of prefix_ ! len of prefix_
info = 0 info = 0
ictxt = desc%get_context()
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
if (present(solver)) then if (present(solver)) then
@ -62,6 +64,12 @@ subroutine mld_z_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
else else
solver_ = .false. solver_ = .false.
end if end if
if (present(global_num)) then
global_num_ = global_num
else
global_num_ = .false.
end if
if (solver_) then if (solver_) then
if (present(prefix)) then if (present(prefix)) then
@ -74,6 +82,21 @@ subroutine mld_z_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam
lname = lname + 5 lname = lname + 5
if (global_num_) then
iv = desc%get_global_indices(owned=.false.)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx'
if (sv%l%is_asb()) &
& call sv%l%print(fname,head=head,iv=iv)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_diag.mtx'
if (allocated(sv%d)) &
& call psb_geprt(fname,sv%d,head=head)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx'
if (sv%u%is_asb()) &
& call sv%u%print(fname,head=head,iv=iv)
else
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx' write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_lower.mtx'
if (sv%l%is_asb()) & if (sv%l%is_asb()) &
& call sv%l%print(fname,head=head) & call sv%l%print(fname,head=head)
@ -83,7 +106,7 @@ subroutine mld_z_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx' write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_upper.mtx'
if (sv%u%is_asb()) & if (sv%u%is_asb()) &
& call sv%u%print(fname,head=head) & call sv%u%print(fname,head=head)
end if
end if end if
end subroutine mld_z_ilu_solver_dmp end subroutine mld_z_ilu_solver_dmp

6
mlprec/mld_c_as_smoother.f90
Unescape Escape View File

@ -291,17 +291,17 @@ module mld_c_as_smoother
end interface end interface
interface interface
subroutine mld_c_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver) subroutine mld_c_as_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_spk_, mld_c_as_smoother_type, psb_epk_, psb_desc_type, & & psb_spk_, mld_c_as_smoother_type, psb_epk_, psb_desc_type, &
& psb_ipk_ & psb_ipk_
implicit none implicit none
class(mld_c_as_smoother_type), intent(in) :: sm class(mld_c_as_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(in) :: ictxt type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver logical, optional, intent(in) :: smoother, solver, global_num
end subroutine mld_c_as_smoother_dmp end subroutine mld_c_as_smoother_dmp
end interface end interface

6
mlprec/mld_c_base_smoother_mod.f90
Unescape Escape View File

@ -285,16 +285,16 @@ module mld_c_base_smoother_mod
end interface end interface
interface interface
subroutine mld_c_base_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver) subroutine mld_c_base_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, & & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& mld_c_base_smoother_type, psb_ipk_ & mld_c_base_smoother_type, psb_ipk_
class(mld_c_base_smoother_type), intent(in) :: sm class(mld_c_base_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(in) :: ictxt type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver logical, optional, intent(in) :: smoother, solver, global_num
end subroutine mld_c_base_smoother_dmp end subroutine mld_c_base_smoother_dmp
end interface end interface

6
mlprec/mld_c_base_solver_mod.f90
Unescape Escape View File

@ -286,17 +286,17 @@ module mld_c_base_solver_mod
end interface end interface
interface interface
subroutine mld_c_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver) subroutine mld_c_base_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, & & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& mld_c_base_solver_type, psb_ipk_ & mld_c_base_solver_type, psb_ipk_
implicit none implicit none
class(mld_c_base_solver_type), intent(in) :: sv class(mld_c_base_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(in) :: ictxt type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver, global_num
end subroutine mld_c_base_solver_dmp end subroutine mld_c_base_solver_dmp
end interface end interface

12
mlprec/mld_c_diag_solver.f90
Unescape Escape View File

@ -143,17 +143,17 @@ module mld_c_diag_solver
end interface end interface
interface interface
subroutine mld_c_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver) subroutine mld_c_diag_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
import :: psb_desc_type, mld_c_diag_solver_type, psb_c_vect_type, psb_spk_, & import :: psb_desc_type, mld_c_diag_solver_type, psb_c_vect_type, psb_spk_, &
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, & & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, &
& psb_ipk_ & psb_ipk_
implicit none implicit none
class(mld_c_diag_solver_type), intent(in) :: sv class(mld_c_diag_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(in) :: ictxt type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver, global_num
end subroutine mld_c_diag_solver_dmp end subroutine mld_c_diag_solver_dmp
end interface end interface
@ -336,17 +336,17 @@ module mld_c_l1_diag_solver
end interface end interface
interface interface
subroutine mld_c_l1_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver) subroutine mld_c_l1_diag_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
import :: psb_desc_type, mld_c_l1_diag_solver_type, psb_c_vect_type, psb_spk_, & import :: psb_desc_type, mld_c_l1_diag_solver_type, psb_c_vect_type, psb_spk_, &
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, & & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, &
& psb_ipk_ & psb_ipk_
implicit none implicit none
class(mld_c_l1_diag_solver_type), intent(in) :: sv class(mld_c_l1_diag_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(in) :: ictxt type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver, global_num
end subroutine mld_c_l1_diag_solver_dmp end subroutine mld_c_l1_diag_solver_dmp
end interface end interface

6
mlprec/mld_c_gs_solver.f90
Unescape Escape View File

@ -221,17 +221,17 @@ module mld_c_gs_solver
end interface end interface
interface interface
subroutine mld_c_gs_solver_dmp(sv,ictxt,level,info,prefix,head,solver) subroutine mld_c_gs_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
import :: psb_desc_type, mld_c_gs_solver_type, psb_c_vect_type, psb_spk_, & import :: psb_desc_type, mld_c_gs_solver_type, psb_c_vect_type, psb_spk_, &
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, & & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, &
& psb_ipk_ & psb_ipk_
implicit none implicit none
class(mld_c_gs_solver_type), intent(in) :: sv class(mld_c_gs_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(in) :: ictxt type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver, global_num
end subroutine mld_c_gs_solver_dmp end subroutine mld_c_gs_solver_dmp
end interface end interface

6
mlprec/mld_c_ilu_solver.f90
Unescape Escape View File

@ -170,17 +170,17 @@ module mld_c_ilu_solver
end interface end interface
interface interface
subroutine mld_c_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver) subroutine mld_c_ilu_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
import :: psb_desc_type, mld_c_ilu_solver_type, psb_c_vect_type, psb_spk_, & import :: psb_desc_type, mld_c_ilu_solver_type, psb_c_vect_type, psb_spk_, &
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, & & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, &
& psb_ipk_ & psb_ipk_
implicit none implicit none
class(mld_c_ilu_solver_type), intent(in) :: sv class(mld_c_ilu_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(in) :: ictxt type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver, global_num
end subroutine mld_c_ilu_solver_dmp end subroutine mld_c_ilu_solver_dmp
end interface end interface

6
mlprec/mld_c_jac_smoother.f90
Unescape Escape View File

@ -175,17 +175,17 @@ module mld_c_jac_smoother
end interface end interface
interface interface
subroutine mld_c_jac_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver) subroutine mld_c_jac_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_spk_, mld_c_jac_smoother_type, psb_epk_, psb_desc_type, & & psb_spk_, mld_c_jac_smoother_type, psb_epk_, psb_desc_type, &
& psb_ipk_ & psb_ipk_
implicit none implicit none
class(mld_c_jac_smoother_type), intent(in) :: sm class(mld_c_jac_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(in) :: ictxt type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver logical, optional, intent(in) :: smoother, solver, global_num
end subroutine mld_c_jac_smoother_dmp end subroutine mld_c_jac_smoother_dmp
end interface end interface

6
mlprec/mld_d_as_smoother.f90
Unescape Escape View File

@ -291,17 +291,17 @@ module mld_d_as_smoother
end interface end interface
interface interface
subroutine mld_d_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver) subroutine mld_d_as_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dpk_, mld_d_as_smoother_type, psb_epk_, psb_desc_type, & & psb_dpk_, mld_d_as_smoother_type, psb_epk_, psb_desc_type, &
& psb_ipk_ & psb_ipk_
implicit none implicit none
class(mld_d_as_smoother_type), intent(in) :: sm class(mld_d_as_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(in) :: ictxt type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver logical, optional, intent(in) :: smoother, solver, global_num
end subroutine mld_d_as_smoother_dmp end subroutine mld_d_as_smoother_dmp
end interface end interface

6
mlprec/mld_d_base_smoother_mod.f90
Unescape Escape View File

@ -285,16 +285,16 @@ module mld_d_base_smoother_mod
end interface end interface
interface interface
subroutine mld_d_base_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver) subroutine mld_d_base_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& mld_d_base_smoother_type, psb_ipk_ & mld_d_base_smoother_type, psb_ipk_
class(mld_d_base_smoother_type), intent(in) :: sm class(mld_d_base_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(in) :: ictxt type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver logical, optional, intent(in) :: smoother, solver, global_num
end subroutine mld_d_base_smoother_dmp end subroutine mld_d_base_smoother_dmp
end interface end interface

6
mlprec/mld_d_base_solver_mod.f90
Unescape Escape View File

@ -286,17 +286,17 @@ module mld_d_base_solver_mod
end interface end interface
interface interface
subroutine mld_d_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver) subroutine mld_d_base_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& mld_d_base_solver_type, psb_ipk_ & mld_d_base_solver_type, psb_ipk_
implicit none implicit none
class(mld_d_base_solver_type), intent(in) :: sv class(mld_d_base_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(in) :: ictxt type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver, global_num
end subroutine mld_d_base_solver_dmp end subroutine mld_d_base_solver_dmp
end interface end interface

12
mlprec/mld_d_diag_solver.f90
Unescape Escape View File

@ -143,17 +143,17 @@ module mld_d_diag_solver
end interface end interface
interface interface
subroutine mld_d_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver) subroutine mld_d_diag_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
import :: psb_desc_type, mld_d_diag_solver_type, psb_d_vect_type, psb_dpk_, & import :: psb_desc_type, mld_d_diag_solver_type, psb_d_vect_type, psb_dpk_, &
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, & & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, &
& psb_ipk_ & psb_ipk_
implicit none implicit none
class(mld_d_diag_solver_type), intent(in) :: sv class(mld_d_diag_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(in) :: ictxt type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver, global_num
end subroutine mld_d_diag_solver_dmp end subroutine mld_d_diag_solver_dmp
end interface end interface
@ -336,17 +336,17 @@ module mld_d_l1_diag_solver
end interface end interface
interface interface
subroutine mld_d_l1_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver) subroutine mld_d_l1_diag_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
import :: psb_desc_type, mld_d_l1_diag_solver_type, psb_d_vect_type, psb_dpk_, & import :: psb_desc_type, mld_d_l1_diag_solver_type, psb_d_vect_type, psb_dpk_, &
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, & & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, &
& psb_ipk_ & psb_ipk_
implicit none implicit none
class(mld_d_l1_diag_solver_type), intent(in) :: sv class(mld_d_l1_diag_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(in) :: ictxt type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver, global_num
end subroutine mld_d_l1_diag_solver_dmp end subroutine mld_d_l1_diag_solver_dmp
end interface end interface

6
mlprec/mld_d_gs_solver.f90
Unescape Escape View File

@ -221,17 +221,17 @@ module mld_d_gs_solver
end interface end interface
interface interface
subroutine mld_d_gs_solver_dmp(sv,ictxt,level,info,prefix,head,solver) subroutine mld_d_gs_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
import :: psb_desc_type, mld_d_gs_solver_type, psb_d_vect_type, psb_dpk_, & import :: psb_desc_type, mld_d_gs_solver_type, psb_d_vect_type, psb_dpk_, &
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, & & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, &
& psb_ipk_ & psb_ipk_
implicit none implicit none
class(mld_d_gs_solver_type), intent(in) :: sv class(mld_d_gs_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(in) :: ictxt type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver, global_num
end subroutine mld_d_gs_solver_dmp end subroutine mld_d_gs_solver_dmp
end interface end interface

6
mlprec/mld_d_ilu_solver.f90
Unescape Escape View File

@ -170,17 +170,17 @@ module mld_d_ilu_solver
end interface end interface
interface interface
subroutine mld_d_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver) subroutine mld_d_ilu_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
import :: psb_desc_type, mld_d_ilu_solver_type, psb_d_vect_type, psb_dpk_, & import :: psb_desc_type, mld_d_ilu_solver_type, psb_d_vect_type, psb_dpk_, &
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, & & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, &
& psb_ipk_ & psb_ipk_
implicit none implicit none
class(mld_d_ilu_solver_type), intent(in) :: sv class(mld_d_ilu_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(in) :: ictxt type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver, global_num
end subroutine mld_d_ilu_solver_dmp end subroutine mld_d_ilu_solver_dmp
end interface end interface

6
mlprec/mld_d_jac_smoother.f90
Unescape Escape View File

@ -175,17 +175,17 @@ module mld_d_jac_smoother
end interface end interface
interface interface
subroutine mld_d_jac_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver) subroutine mld_d_jac_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dpk_, mld_d_jac_smoother_type, psb_epk_, psb_desc_type, & & psb_dpk_, mld_d_jac_smoother_type, psb_epk_, psb_desc_type, &
& psb_ipk_ & psb_ipk_
implicit none implicit none
class(mld_d_jac_smoother_type), intent(in) :: sm class(mld_d_jac_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(in) :: ictxt type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver logical, optional, intent(in) :: smoother, solver, global_num
end subroutine mld_d_jac_smoother_dmp end subroutine mld_d_jac_smoother_dmp
end interface end interface

6
mlprec/mld_s_as_smoother.f90
Unescape Escape View File

@ -291,17 +291,17 @@ module mld_s_as_smoother
end interface end interface
interface interface
subroutine mld_s_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver) subroutine mld_s_as_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_spk_, mld_s_as_smoother_type, psb_epk_, psb_desc_type, & & psb_spk_, mld_s_as_smoother_type, psb_epk_, psb_desc_type, &
& psb_ipk_ & psb_ipk_
implicit none implicit none
class(mld_s_as_smoother_type), intent(in) :: sm class(mld_s_as_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(in) :: ictxt type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver logical, optional, intent(in) :: smoother, solver, global_num
end subroutine mld_s_as_smoother_dmp end subroutine mld_s_as_smoother_dmp
end interface end interface

6
mlprec/mld_s_base_smoother_mod.f90
Unescape Escape View File

@ -285,16 +285,16 @@ module mld_s_base_smoother_mod
end interface end interface
interface interface
subroutine mld_s_base_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver) subroutine mld_s_base_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, & & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& mld_s_base_smoother_type, psb_ipk_ & mld_s_base_smoother_type, psb_ipk_
class(mld_s_base_smoother_type), intent(in) :: sm class(mld_s_base_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(in) :: ictxt type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver logical, optional, intent(in) :: smoother, solver, global_num
end subroutine mld_s_base_smoother_dmp end subroutine mld_s_base_smoother_dmp
end interface end interface

6
mlprec/mld_s_base_solver_mod.f90
Unescape Escape View File

@ -286,17 +286,17 @@ module mld_s_base_solver_mod
end interface end interface
interface interface
subroutine mld_s_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver) subroutine mld_s_base_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, & & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& mld_s_base_solver_type, psb_ipk_ & mld_s_base_solver_type, psb_ipk_
implicit none implicit none
class(mld_s_base_solver_type), intent(in) :: sv class(mld_s_base_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(in) :: ictxt type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver, global_num
end subroutine mld_s_base_solver_dmp end subroutine mld_s_base_solver_dmp
end interface end interface

12
mlprec/mld_s_diag_solver.f90
Unescape Escape View File

@ -143,17 +143,17 @@ module mld_s_diag_solver
end interface end interface
interface interface
subroutine mld_s_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver) subroutine mld_s_diag_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
import :: psb_desc_type, mld_s_diag_solver_type, psb_s_vect_type, psb_spk_, & import :: psb_desc_type, mld_s_diag_solver_type, psb_s_vect_type, psb_spk_, &
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, & & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, &
& psb_ipk_ & psb_ipk_
implicit none implicit none
class(mld_s_diag_solver_type), intent(in) :: sv class(mld_s_diag_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(in) :: ictxt type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver, global_num
end subroutine mld_s_diag_solver_dmp end subroutine mld_s_diag_solver_dmp
end interface end interface
@ -336,17 +336,17 @@ module mld_s_l1_diag_solver
end interface end interface
interface interface
subroutine mld_s_l1_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver) subroutine mld_s_l1_diag_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
import :: psb_desc_type, mld_s_l1_diag_solver_type, psb_s_vect_type, psb_spk_, & import :: psb_desc_type, mld_s_l1_diag_solver_type, psb_s_vect_type, psb_spk_, &
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, & & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, &
& psb_ipk_ & psb_ipk_
implicit none implicit none
class(mld_s_l1_diag_solver_type), intent(in) :: sv class(mld_s_l1_diag_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(in) :: ictxt type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver, global_num
end subroutine mld_s_l1_diag_solver_dmp end subroutine mld_s_l1_diag_solver_dmp
end interface end interface

6
mlprec/mld_s_gs_solver.f90
Unescape Escape View File

@ -221,17 +221,17 @@ module mld_s_gs_solver
end interface end interface
interface interface
subroutine mld_s_gs_solver_dmp(sv,ictxt,level,info,prefix,head,solver) subroutine mld_s_gs_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
import :: psb_desc_type, mld_s_gs_solver_type, psb_s_vect_type, psb_spk_, & import :: psb_desc_type, mld_s_gs_solver_type, psb_s_vect_type, psb_spk_, &
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, & & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, &
& psb_ipk_ & psb_ipk_
implicit none implicit none
class(mld_s_gs_solver_type), intent(in) :: sv class(mld_s_gs_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(in) :: ictxt type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver, global_num
end subroutine mld_s_gs_solver_dmp end subroutine mld_s_gs_solver_dmp
end interface end interface

6
mlprec/mld_s_ilu_solver.f90
Unescape Escape View File

@ -170,17 +170,17 @@ module mld_s_ilu_solver
end interface end interface
interface interface
subroutine mld_s_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver) subroutine mld_s_ilu_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
import :: psb_desc_type, mld_s_ilu_solver_type, psb_s_vect_type, psb_spk_, & import :: psb_desc_type, mld_s_ilu_solver_type, psb_s_vect_type, psb_spk_, &
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, & & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, &
& psb_ipk_ & psb_ipk_
implicit none implicit none
class(mld_s_ilu_solver_type), intent(in) :: sv class(mld_s_ilu_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(in) :: ictxt type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver, global_num
end subroutine mld_s_ilu_solver_dmp end subroutine mld_s_ilu_solver_dmp
end interface end interface

6
mlprec/mld_s_jac_smoother.f90
Unescape Escape View File

@ -175,17 +175,17 @@ module mld_s_jac_smoother
end interface end interface
interface interface
subroutine mld_s_jac_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver) subroutine mld_s_jac_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_spk_, mld_s_jac_smoother_type, psb_epk_, psb_desc_type, & & psb_spk_, mld_s_jac_smoother_type, psb_epk_, psb_desc_type, &
& psb_ipk_ & psb_ipk_
implicit none implicit none
class(mld_s_jac_smoother_type), intent(in) :: sm class(mld_s_jac_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(in) :: ictxt type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver logical, optional, intent(in) :: smoother, solver, global_num
end subroutine mld_s_jac_smoother_dmp end subroutine mld_s_jac_smoother_dmp
end interface end interface

6
mlprec/mld_z_as_smoother.f90
Unescape Escape View File

@ -291,17 +291,17 @@ module mld_z_as_smoother
end interface end interface
interface interface
subroutine mld_z_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver) subroutine mld_z_as_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
& psb_dpk_, mld_z_as_smoother_type, psb_epk_, psb_desc_type, & & psb_dpk_, mld_z_as_smoother_type, psb_epk_, psb_desc_type, &
& psb_ipk_ & psb_ipk_
implicit none implicit none
class(mld_z_as_smoother_type), intent(in) :: sm class(mld_z_as_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(in) :: ictxt type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver logical, optional, intent(in) :: smoother, solver, global_num
end subroutine mld_z_as_smoother_dmp end subroutine mld_z_as_smoother_dmp
end interface end interface

6
mlprec/mld_z_base_smoother_mod.f90
Unescape Escape View File

@ -285,16 +285,16 @@ module mld_z_base_smoother_mod
end interface end interface
interface interface
subroutine mld_z_base_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver) subroutine mld_z_base_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, & & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
& mld_z_base_smoother_type, psb_ipk_ & mld_z_base_smoother_type, psb_ipk_
class(mld_z_base_smoother_type), intent(in) :: sm class(mld_z_base_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(in) :: ictxt type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver logical, optional, intent(in) :: smoother, solver, global_num
end subroutine mld_z_base_smoother_dmp end subroutine mld_z_base_smoother_dmp
end interface end interface

6
mlprec/mld_z_base_solver_mod.f90
Unescape Escape View File

@ -286,17 +286,17 @@ module mld_z_base_solver_mod
end interface end interface
interface interface
subroutine mld_z_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver) subroutine mld_z_base_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, & & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
& mld_z_base_solver_type, psb_ipk_ & mld_z_base_solver_type, psb_ipk_
implicit none implicit none
class(mld_z_base_solver_type), intent(in) :: sv class(mld_z_base_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(in) :: ictxt type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver, global_num
end subroutine mld_z_base_solver_dmp end subroutine mld_z_base_solver_dmp
end interface end interface

12
mlprec/mld_z_diag_solver.f90
Unescape Escape View File

@ -143,17 +143,17 @@ module mld_z_diag_solver
end interface end interface
interface interface
subroutine mld_z_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver) subroutine mld_z_diag_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
import :: psb_desc_type, mld_z_diag_solver_type, psb_z_vect_type, psb_dpk_, & import :: psb_desc_type, mld_z_diag_solver_type, psb_z_vect_type, psb_dpk_, &
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, & & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, &
& psb_ipk_ & psb_ipk_
implicit none implicit none
class(mld_z_diag_solver_type), intent(in) :: sv class(mld_z_diag_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(in) :: ictxt type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver, global_num
end subroutine mld_z_diag_solver_dmp end subroutine mld_z_diag_solver_dmp
end interface end interface
@ -336,17 +336,17 @@ module mld_z_l1_diag_solver
end interface end interface
interface interface
subroutine mld_z_l1_diag_solver_dmp(sv,ictxt,level,info,prefix,head,solver) subroutine mld_z_l1_diag_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
import :: psb_desc_type, mld_z_l1_diag_solver_type, psb_z_vect_type, psb_dpk_, & import :: psb_desc_type, mld_z_l1_diag_solver_type, psb_z_vect_type, psb_dpk_, &
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, & & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, &
& psb_ipk_ & psb_ipk_
implicit none implicit none
class(mld_z_l1_diag_solver_type), intent(in) :: sv class(mld_z_l1_diag_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(in) :: ictxt type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver, global_num
end subroutine mld_z_l1_diag_solver_dmp end subroutine mld_z_l1_diag_solver_dmp
end interface end interface

6
mlprec/mld_z_gs_solver.f90
Unescape Escape View File

@ -221,17 +221,17 @@ module mld_z_gs_solver
end interface end interface
interface interface
subroutine mld_z_gs_solver_dmp(sv,ictxt,level,info,prefix,head,solver) subroutine mld_z_gs_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
import :: psb_desc_type, mld_z_gs_solver_type, psb_z_vect_type, psb_dpk_, & import :: psb_desc_type, mld_z_gs_solver_type, psb_z_vect_type, psb_dpk_, &
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, & & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, &
& psb_ipk_ & psb_ipk_
implicit none implicit none
class(mld_z_gs_solver_type), intent(in) :: sv class(mld_z_gs_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(in) :: ictxt type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver, global_num
end subroutine mld_z_gs_solver_dmp end subroutine mld_z_gs_solver_dmp
end interface end interface

6
mlprec/mld_z_ilu_solver.f90
Unescape Escape View File

@ -170,17 +170,17 @@ module mld_z_ilu_solver
end interface end interface
interface interface
subroutine mld_z_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver) subroutine mld_z_ilu_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
import :: psb_desc_type, mld_z_ilu_solver_type, psb_z_vect_type, psb_dpk_, & import :: psb_desc_type, mld_z_ilu_solver_type, psb_z_vect_type, psb_dpk_, &
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, & & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, &
& psb_ipk_ & psb_ipk_
implicit none implicit none
class(mld_z_ilu_solver_type), intent(in) :: sv class(mld_z_ilu_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(in) :: ictxt type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver, global_num
end subroutine mld_z_ilu_solver_dmp end subroutine mld_z_ilu_solver_dmp
end interface end interface

6
mlprec/mld_z_jac_smoother.f90
Unescape Escape View File

@ -175,17 +175,17 @@ module mld_z_jac_smoother
end interface end interface
interface interface
subroutine mld_z_jac_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver) subroutine mld_z_jac_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
& psb_dpk_, mld_z_jac_smoother_type, psb_epk_, psb_desc_type, & & psb_dpk_, mld_z_jac_smoother_type, psb_epk_, psb_desc_type, &
& psb_ipk_ & psb_ipk_
implicit none implicit none
class(mld_z_jac_smoother_type), intent(in) :: sm class(mld_z_jac_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(in) :: ictxt type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver logical, optional, intent(in) :: smoother, solver, global_num
end subroutine mld_z_jac_smoother_dmp end subroutine mld_z_jac_smoother_dmp
end interface end interface

Write Preview
Loading…
Cancel
Save