mld2p4-2:


			
			
				stopcriterion
			
			
		
Salvatore Filippone 14 years ago
parent 453003f5f6
commit 055664826d

@ -585,7 +585,7 @@ contains
end subroutine d_as_smoother_apply
subroutine d_as_smoother_bld(a,desc_a,sm,upd,info)
subroutine d_as_smoother_bld(a,desc_a,sm,upd,info,mold)
use psb_base_mod
@ -597,6 +597,7 @@ contains
class(mld_d_as_smoother_type), intent(inout) :: sm
character, intent(in) :: upd
integer, intent(out) :: info
class(psb_d_base_sparse_mat), intent(in), optional :: mold
! Local variables
type(psb_dspmat_type) :: blck, atmp
integer :: n_row,n_col, nrow_a, nhalo, novr, data_, nzeros
@ -687,7 +688,7 @@ contains
End if
if (info == psb_success_) &
& call sm%sv%build(a,sm%desc_data,upd,info,blck)
& call sm%sv%build(a,sm%desc_data,upd,info,blck,mold=mold)
nrow_a = a%get_nrows()
n_row = psb_cd_get_local_rows(sm%desc_data)

@ -189,7 +189,7 @@ contains
end subroutine d_diag_solver_apply
subroutine d_diag_solver_bld(a,desc_a,sv,upd,info,b)
subroutine d_diag_solver_bld(a,desc_a,sv,upd,info,b,mold)
use psb_base_mod
@ -202,6 +202,7 @@ contains
character, intent(in) :: upd
integer, intent(out) :: info
type(psb_dspmat_type), intent(in), target, optional :: b
class(psb_d_base_sparse_mat), intent(in), optional :: mold
! Local variables
integer :: n_row,n_col, nrow_a, nztota
real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)

@ -113,7 +113,7 @@ contains
end subroutine d_id_solver_apply
subroutine d_id_solver_bld(a,desc_a,sv,upd,info,b)
subroutine d_id_solver_bld(a,desc_a,sv,upd,info,b,mold)
use psb_base_mod
@ -125,6 +125,7 @@ contains
class(mld_d_id_solver_type), intent(inout) :: sv
character, intent(in) :: upd
integer, intent(out) :: info
class(psb_d_base_sparse_mat), intent(in), optional :: mold
type(psb_dspmat_type), intent(in), target, optional :: b
! Local variables
integer :: n_row,n_col, nrow_a, nztota

@ -246,7 +246,7 @@ contains
end subroutine d_ilu_solver_apply
subroutine d_ilu_solver_bld(a,desc_a,sv,upd,info,b)
subroutine d_ilu_solver_bld(a,desc_a,sv,upd,info,b,mold)
use psb_base_mod
@ -258,6 +258,7 @@ contains
class(mld_d_ilu_solver_type), intent(inout) :: sv
character, intent(in) :: upd
integer, intent(out) :: info
class(psb_d_base_sparse_mat), intent(in), optional :: mold
type(psb_dspmat_type), intent(in), target, optional :: b
! Local variables
integer :: n_row,n_col, nrow_a, nztota
@ -403,6 +404,13 @@ contains
call sv%u%set_asb()
call sv%u%trim()
if (present(mold)) then
call sv%l%cscnv(info,mold=mold)
call sv%u%cscnv(info,mold=mold)
Write(0,*) 'Converted L into ',sv%l%get_fmt(),&
&' and U into ',sv%u%get_fmt()
end if
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),' end'

@ -50,14 +50,16 @@ module mld_d_inner_mod
interface mld_mlprec_bld
subroutine mld_dmlprec_bld(a,desc_a,prec,info)
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_
subroutine mld_dmlprec_bld(a,desc_a,prec,info, mold)
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, &
& psb_dpk_, psb_d_base_sparse_mat
use mld_d_prec_type, only : mld_dprec_type
implicit none
type(psb_dspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_dprec_type), intent(inout), target :: prec
integer, intent(out) :: info
class(psb_d_base_sparse_mat), intent(in), optional :: mold
!!$ character, intent(in),optional :: upd
end subroutine mld_dmlprec_bld
end interface mld_mlprec_bld

@ -228,7 +228,7 @@ contains
end subroutine d_jac_smoother_apply
subroutine d_jac_smoother_bld(a,desc_a,sm,upd,info)
subroutine d_jac_smoother_bld(a,desc_a,sm,upd,info,mold)
use psb_base_mod
use mld_d_diag_solver
@ -240,6 +240,7 @@ contains
class(mld_d_jac_smoother_type), intent(inout) :: sm
character, intent(in) :: upd
integer, intent(out) :: info
class(psb_d_base_sparse_mat), intent(in), optional :: mold
! Local variables
integer :: n_row,n_col, nrow_a, nztota, nzeros
real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
@ -275,7 +276,7 @@ contains
goto 9999
end if
call sm%sv%build(a,desc_a,upd,info)
call sm%sv%build(a,desc_a,upd,info,mold=mold)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,&
& a_err='solver build')

@ -111,14 +111,16 @@ module mld_d_prec_mod
end interface
interface mld_precbld
subroutine mld_dprecbld(a,desc_a,prec,info)
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_
subroutine mld_dprecbld(a,desc_a,prec,info,mold)
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, &
& psb_dpk_, psb_d_base_sparse_mat
use mld_d_prec_type, only : mld_dprec_type
implicit none
type(psb_dspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_dprec_type), intent(inout), target :: prec
integer, intent(out) :: info
class(psb_d_base_sparse_mat), intent(in), optional :: mold
!!$ character, intent(in),optional :: upd
end subroutine mld_dprecbld
end interface

@ -828,7 +828,7 @@ contains
return
end subroutine d_base_smoother_setr
subroutine d_base_smoother_bld(a,desc_a,sm,upd,info)
subroutine d_base_smoother_bld(a,desc_a,sm,upd,info,mold)
use psb_base_mod
@ -840,6 +840,7 @@ contains
class(mld_d_base_smoother_type), intent(inout) :: sm
character, intent(in) :: upd
integer, intent(out) :: info
class(psb_d_base_sparse_mat), intent(in), optional :: mold
Integer :: err_act
character(len=20) :: name='d_base_smoother_bld'
@ -847,7 +848,7 @@ contains
info = psb_success_
if (allocated(sm%sv)) then
call sm%sv%build(a,desc_a,upd,info)
call sm%sv%build(a,desc_a,upd,info,mold=mold)
else
info = 1121
call psb_errpush(info,name)
@ -1020,7 +1021,7 @@ contains
end subroutine d_base_solver_apply
subroutine d_base_solver_bld(a,desc_a,sv,upd,info,b)
subroutine d_base_solver_bld(a,desc_a,sv,upd,info,b,mold)
use psb_base_mod
@ -1033,6 +1034,8 @@ contains
character, intent(in) :: upd
integer, intent(out) :: info
type(psb_dspmat_type), intent(in), target, optional :: b
class(psb_d_base_sparse_mat), intent(in), optional :: mold
Integer :: err_act
character(len=20) :: name='d_base_solver_bld'

@ -185,7 +185,7 @@ contains
end subroutine d_slu_solver_apply
subroutine d_slu_solver_bld(a,desc_a,sv,upd,info,b)
subroutine d_slu_solver_bld(a,desc_a,sv,upd,info,b,mold)
use psb_base_mod
@ -197,6 +197,7 @@ contains
class(mld_d_slu_solver_type), intent(inout) :: sv
character, intent(in) :: upd
integer, intent(out) :: info
class(psb_d_base_sparse_mat), intent(in), optional :: mold
type(psb_dspmat_type), intent(in), target, optional :: b
! Local variables
type(psb_dspmat_type) :: atmp

@ -185,7 +185,7 @@ contains
end subroutine d_sludist_solver_apply
subroutine d_sludist_solver_bld(a,desc_a,sv,upd,info,b)
subroutine d_sludist_solver_bld(a,desc_a,sv,upd,info,b,mold)
use psb_base_mod
@ -197,6 +197,7 @@ contains
class(mld_d_sludist_solver_type), intent(inout) :: sv
character, intent(in) :: upd
integer, intent(out) :: info
class(psb_d_base_sparse_mat), intent(in), optional :: mold
type(psb_dspmat_type), intent(in), target, optional :: b
! Local variables
type(psb_dspmat_type) :: atmp

@ -185,7 +185,7 @@ contains
end subroutine d_umf_solver_apply
subroutine d_umf_solver_bld(a,desc_a,sv,upd,info,b)
subroutine d_umf_solver_bld(a,desc_a,sv,upd,info,b,mold)
use psb_base_mod
@ -197,6 +197,7 @@ contains
class(mld_d_umf_solver_type), intent(inout) :: sv
character, intent(in) :: upd
integer, intent(out) :: info
class(psb_d_base_sparse_mat), intent(in), optional :: mold
type(psb_dspmat_type), intent(in), target, optional :: b
! Local variables
type(psb_dspmat_type) :: atmp

@ -656,6 +656,7 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,p,info)
! am2 => PR^T i.e. restriction operator
! am1 => PR i.e. prolongation operator
!
p%map = psb_linmap(psb_map_aggr_,desc_a,&
& p%desc_ac,am2,am1,ilaggr,nlaggr)
if (info == psb_success_) call am1%free()

@ -63,7 +63,7 @@
! info - integer, output.
! Error code.
!
subroutine mld_dmlprec_bld(a,desc_a,p,info)
subroutine mld_dmlprec_bld(a,desc_a,p,info,mold)
use psb_base_mod
use mld_d_inner_mod, mld_protect_name => mld_dmlprec_bld
@ -76,6 +76,7 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info)
type(psb_desc_type), intent(in), target :: desc_a
type(mld_dprec_type),intent(inout),target :: p
integer, intent(out) :: info
class(psb_d_base_sparse_mat), intent(in), optional :: mold
!!$ character, intent(in), optional :: upd
! Local Variables
@ -303,12 +304,16 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info)
goto 9999
end if
!
! Test version for beginning of OO stuff.
!
call p%precv(i)%sm%build(p%precv(i)%base_a,p%precv(i)%base_desc,'F',info)
call p%precv(i)%sm%build(p%precv(i)%base_a,p%precv(i)%base_desc,&
& 'F',info,mold=mold)
if ((info == psb_success_).and.(i>1).and.(present(mold))) then
call psb_map_cscnv(p%precv(i)%map,info,mold=mold)
end if
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='One level preconditioner build.')

@ -58,7 +58,7 @@
! info - integer, output.
! Error code.
!
subroutine mld_dprecbld(a,desc_a,p,info)
subroutine mld_dprecbld(a,desc_a,p,info,mold)
use psb_base_mod
use mld_d_inner_mod
@ -71,6 +71,7 @@ subroutine mld_dprecbld(a,desc_a,p,info)
type(psb_desc_type), intent(in), target :: desc_a
type(mld_dprec_type),intent(inout),target :: p
integer, intent(out) :: info
class(psb_d_base_sparse_mat), intent(in), optional :: mold
!!$ character, intent(in), optional :: upd
! Local Variables
@ -170,9 +171,8 @@ subroutine mld_dprecbld(a,desc_a,p,info)
goto 9999
endif
call p%precv(1)%sm%build(a,desc_a,upd_,info)
call p%precv(1)%sm%build(a,desc_a,upd_,info,mold=mold)
if (info /= psb_success_) then
write(0,*) ' Smoother build error',info
call psb_errpush(psb_err_internal_error_,name,&
& a_err='One level preconditioner build.')
goto 9999
@ -185,7 +185,7 @@ subroutine mld_dprecbld(a,desc_a,p,info)
!
! Build the multilevel preconditioner
!
call mld_mlprec_bld(a,desc_a,p,info)
call mld_mlprec_bld(a,desc_a,p,info,mold=mold)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&

@ -125,6 +125,7 @@ program ppde
real(psb_dpk_) :: athres ! smoother aggregation threshold
end type precdata
type(precdata) :: prectype
type(psb_d_coo_sparse_mat) :: acoo
! other variables
integer :: info
character(len=20) :: name,ch_err
@ -216,7 +217,7 @@ program ppde
end if
call psb_barrier(ictxt)
t1 = psb_wtime()
call mld_precbld(a,desc_a,prec,info)
call mld_precbld(a,desc_a,prec,info,mold=acoo)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_precbld'

Loading…
Cancel
Save