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

mld2p4-299

Browse Source 
Fixes for integer vecors in DESC (even inside maps)
Added imold to interface. Implementation is still incomplete.
stopcriterion
Salvatore Filippone 12 years ago
parent 21e38e140c
commit 3d6537ed21
19 changed files with 320 additions and 127 deletions
Show Stats Download Patch File Download Diff File

81
mlprec/impl/mld_cmlprec_aply.f90
Unescape Escape View File

@ -488,18 +488,26 @@ contains
& p%precv(level)%base_desc, trans,& & p%precv(level)%base_desc, trans,&
& sweeps,work,info) & sweeps,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
if (level < nlev) then if (level < nlev) then
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
! !
! Apply the prolongator ! Apply the prolongator
! !
call psb_map_Y2X(cone,mlprec_wrk(level+1)%y2l,& call psb_map_Y2X(cone,mlprec_wrk(level+1)%y2l,&
& cone,mlprec_wrk(level)%y2l,& & cone,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work) & p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
end if end if
@ -534,14 +542,23 @@ contains
if (level < nlev) then if (level < nlev) then
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
! !
! Apply the prolongator ! Apply the prolongator
! !
call psb_map_Y2X(cone,mlprec_wrk(level+1)%y2l,& call psb_map_Y2X(cone,mlprec_wrk(level+1)%y2l,&
& czero,mlprec_wrk(level)%y2l,& & czero,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work) & p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
! !
! Compute the residual ! Compute the residual
! !
@ -608,13 +625,25 @@ contains
& mlprec_wrk(level)%y2l,cone,mlprec_wrk(level)%x2l,& & mlprec_wrk(level)%y2l,cone,mlprec_wrk(level)%x2l,&
& p%precv(level)%base_desc,info,work=work,trans=trans) & p%precv(level)%base_desc,info,work=work,trans=trans)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
call psb_map_Y2X(cone,mlprec_wrk(level+1)%y2l,& call psb_map_Y2X(cone,mlprec_wrk(level+1)%y2l,&
& cone,mlprec_wrk(level)%y2l,& & cone,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work) & p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
end if end if
@ -669,12 +698,23 @@ contains
& p%precv(level)%base_desc,info,work=work,trans=trans) & p%precv(level)%base_desc,info,work=work,trans=trans)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
call psb_map_Y2X(cone,mlprec_wrk(level+1)%y2l,& call psb_map_Y2X(cone,mlprec_wrk(level+1)%y2l,&
& cone,mlprec_wrk(level)%y2l,& & cone,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work) & p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
end if end if
@ -700,14 +740,24 @@ contains
if (level < nlev) then if (level < nlev) then
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
! !
! Apply the prolongator ! Apply the prolongator
! !
call psb_map_Y2X(cone,mlprec_wrk(level+1)%y2l,& call psb_map_Y2X(cone,mlprec_wrk(level+1)%y2l,&
& czero,mlprec_wrk(level)%y2l,& & czero,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work) & p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
! !
! Compute the residual ! Compute the residual
! !
@ -788,6 +838,11 @@ contains
& p%precv(level)%base_desc,info,work=work,trans=trans) & p%precv(level)%base_desc,info,work=work,trans=trans)
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
! !
@ -797,9 +852,9 @@ contains
& cone,mlprec_wrk(level)%y2l,& & cone,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work) & p%precv(level+1)%map,info,work=work)
if (info /= psb_success_ ) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during restriction') & a_err='Error during prolongation')
goto 9999 goto 9999
end if end if

3
mlprec/impl/mld_cmlprec_bld.f90
Unescape Escape View File

@ -74,7 +74,7 @@
! !
! !
! !
subroutine mld_cmlprec_bld(a,desc_a,p,info,amold,vmold) subroutine mld_cmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
use psb_base_mod use psb_base_mod
use mld_c_inner_mod, mld_protect_name => mld_cmlprec_bld use mld_c_inner_mod, mld_protect_name => mld_cmlprec_bld
@ -89,6 +89,7 @@ subroutine mld_cmlprec_bld(a,desc_a,p,info,amold,vmold)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_sparse_mat), intent(in), optional :: amold
class(psb_c_base_vect_type), intent(in), optional :: vmold class(psb_c_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
!!$ character, intent(in), optional :: upd !!$ character, intent(in), optional :: upd
! Local Variables ! Local Variables

3
mlprec/impl/mld_cprecbld.f90
Unescape Escape View File

@ -58,7 +58,7 @@
! info - integer, output. ! info - integer, output.
! Error code. ! Error code.
! !
subroutine mld_cprecbld(a,desc_a,p,info,amold,vmold) subroutine mld_cprecbld(a,desc_a,p,info,amold,vmold,imold)
use psb_base_mod use psb_base_mod
use mld_c_inner_mod use mld_c_inner_mod
@ -73,6 +73,7 @@ subroutine mld_cprecbld(a,desc_a,p,info,amold,vmold)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_sparse_mat), intent(in), optional :: amold
class(psb_c_base_vect_type), intent(in), optional :: vmold class(psb_c_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
!!$ character, intent(in), optional :: upd !!$ character, intent(in), optional :: upd
! Local Variables ! Local Variables

85
mlprec/impl/mld_dmlprec_aply.f90
Unescape Escape View File

@ -363,7 +363,6 @@ subroutine mld_dmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
allocate(mlprec_wrk(level)%x2l(nc2l),mlprec_wrk(level)%y2l(nc2l),& allocate(mlprec_wrk(level)%x2l(nc2l),mlprec_wrk(level)%y2l(nc2l),&
& stat=info) & stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
write(0,*) 'Allocation Error at level ',0
info=psb_err_alloc_request_ info=psb_err_alloc_request_
call psb_errpush(info,name,& call psb_errpush(info,name,&
& i_err=(/ione*(size(x)+size(y)),izero,izero,izero,izero/),& & i_err=(/ione*(size(x)+size(y)),izero,izero,izero,izero/),&
@ -447,7 +446,6 @@ contains
& mlprec_wrk(level)%y2l(nc2l),& & mlprec_wrk(level)%y2l(nc2l),&
& stat=info) & stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
write(0,*) 'Allocation Error at level',level, nc2l
info=psb_err_alloc_request_ info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/2*nc2l,izero,izero,izero,izero/),& call psb_errpush(info,name,i_err=(/2*nc2l,izero,izero,izero,izero/),&
& a_err='real(psb_dpk_)') & a_err='real(psb_dpk_)')
@ -490,18 +488,26 @@ contains
& p%precv(level)%base_desc, trans,& & p%precv(level)%base_desc, trans,&
& sweeps,work,info) & sweeps,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
if (level < nlev) then if (level < nlev) then
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
! !
! Apply the prolongator ! Apply the prolongator
! !
call psb_map_Y2X(done,mlprec_wrk(level+1)%y2l,& call psb_map_Y2X(done,mlprec_wrk(level+1)%y2l,&
& done,mlprec_wrk(level)%y2l,& & done,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work) & p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
end if end if
@ -524,7 +530,7 @@ contains
call psb_map_X2Y(done,mlprec_wrk(level-1)%x2l,& call psb_map_X2Y(done,mlprec_wrk(level-1)%x2l,&
& dzero,mlprec_wrk(level)%x2l,& & dzero,mlprec_wrk(level)%x2l,&
& p%precv(level)%map,info,work=work) & p%precv(level)%map,info,work=work)
!!$ write(0,*) 'inner_ml map_x2y :',level,info
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during restriction') & a_err='Error during restriction')
@ -619,13 +625,25 @@ contains
& mlprec_wrk(level)%y2l,done,mlprec_wrk(level)%x2l,& & mlprec_wrk(level)%y2l,done,mlprec_wrk(level)%x2l,&
& p%precv(level)%base_desc,info,work=work,trans=trans) & p%precv(level)%base_desc,info,work=work,trans=trans)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
call psb_map_Y2X(done,mlprec_wrk(level+1)%y2l,& call psb_map_Y2X(done,mlprec_wrk(level+1)%y2l,&
& done,mlprec_wrk(level)%y2l,& & done,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work) & p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
end if end if
@ -680,12 +698,23 @@ contains
& p%precv(level)%base_desc,info,work=work,trans=trans) & p%precv(level)%base_desc,info,work=work,trans=trans)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
call psb_map_Y2X(done,mlprec_wrk(level+1)%y2l,& call psb_map_Y2X(done,mlprec_wrk(level+1)%y2l,&
& done,mlprec_wrk(level)%y2l,& & done,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work) & p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
end if end if
@ -711,14 +740,24 @@ contains
if (level < nlev) then if (level < nlev) then
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
! !
! Apply the prolongator ! Apply the prolongator
! !
call psb_map_Y2X(done,mlprec_wrk(level+1)%y2l,& call psb_map_Y2X(done,mlprec_wrk(level+1)%y2l,&
& dzero,mlprec_wrk(level)%y2l,& & dzero,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work) & p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
! !
! Compute the residual ! Compute the residual
! !
@ -799,6 +838,11 @@ contains
& p%precv(level)%base_desc,info,work=work,trans=trans) & p%precv(level)%base_desc,info,work=work,trans=trans)
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
! !
@ -808,9 +852,9 @@ contains
& done,mlprec_wrk(level)%y2l,& & done,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work) & p%precv(level+1)%map,info,work=work)
if (info /= psb_success_ ) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during restriction') & a_err='Error during prolongation')
goto 9999 goto 9999
end if end if
@ -937,7 +981,6 @@ subroutine mld_dmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
nc2l = p%precv(level)%base_desc%get_local_cols() nc2l = p%precv(level)%base_desc%get_local_cols()
info=psb_err_alloc_request_ info=psb_err_alloc_request_
write(0,*) 'Allocation Error at level ',0
call psb_errpush(info,name,i_err=(/2*nc2l,izero,izero,izero,izero/),& call psb_errpush(info,name,i_err=(/2*nc2l,izero,izero,izero,izero/),&
& a_err='real(psb_dpk_)') & a_err='real(psb_dpk_)')
goto 9999 goto 9999
@ -1101,7 +1144,7 @@ contains
call psb_map_X2Y(done,mlprec_wrk(level-1)%vx2l,& call psb_map_X2Y(done,mlprec_wrk(level-1)%vx2l,&
& dzero,mlprec_wrk(level)%vx2l,& & dzero,mlprec_wrk(level)%vx2l,&
& p%precv(level)%map,info,work=work) & p%precv(level)%map,info,work=work)
!!$ write(0,*) 'inner_ml map_x2y :',level,info
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during restriction') & a_err='Error during restriction')
@ -1113,11 +1156,6 @@ contains
if (level < nlev) then if (level < nlev) then
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
! !
! Apply the prolongator ! Apply the prolongator
@ -1125,11 +1163,6 @@ contains
call psb_map_Y2X(done,mlprec_wrk(level+1)%vy2l,& call psb_map_Y2X(done,mlprec_wrk(level+1)%vy2l,&
& dzero,mlprec_wrk(level)%vy2l,& & dzero,mlprec_wrk(level)%vy2l,&
& p%precv(level+1)%map,info,work=work) & p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
! !
! Compute the residual ! Compute the residual

23
mlprec/impl/mld_dmlprec_bld.f90
Unescape Escape View File

@ -74,7 +74,7 @@
! !
! !
! !
subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold) subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
use psb_base_mod use psb_base_mod
use mld_d_inner_mod, mld_protect_name => mld_dmlprec_bld use mld_d_inner_mod, mld_protect_name => mld_dmlprec_bld
@ -89,6 +89,7 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
class(psb_d_base_sparse_mat), intent(in), optional :: amold class(psb_d_base_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold class(psb_d_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
!!$ character, intent(in), optional :: upd !!$ character, intent(in), optional :: upd
! Local Variables ! Local Variables
@ -175,7 +176,7 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold)
endif endif
!!$ write(0,*) 'DMLPRECBLD: CASIZE ',casize
if (casize>0) then if (casize>0) then
! !
! New strategy to build according to coarse size. ! New strategy to build according to coarse size.
@ -291,11 +292,6 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold)
current => newnode current => newnode
! First do a move_alloc. ! First do a move_alloc.
! This handles the AC, DESC_AC and MAP fields ! This handles the AC, DESC_AC and MAP fields
!!$ associate(this=>current%item%map)
!!$ if (i>1) write(0,*) 'List realloc loop input:',i,&
!!$ & allocated(this%p_desc_X%v_halo_index%v),&
!!$ & allocated(this%p_desc_Y%v_halo_index%v)
!!$ end associate
if (info == psb_success_) & if (info == psb_success_) &
& call mld_move_alloc(current%item,p%precv(i),info) & call mld_move_alloc(current%item,p%precv(i),info)
! Now set the smoother/solver parts. ! Now set the smoother/solver parts.
@ -325,11 +321,6 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold)
p%precv(i)%map%p_desc_X => p%precv(i-1)%base_desc p%precv(i)%map%p_desc_X => p%precv(i-1)%base_desc
p%precv(i)%map%p_desc_Y => p%precv(i)%base_desc p%precv(i)%map%p_desc_Y => p%precv(i)%base_desc
end if end if
!!$ associate(this =>p%precv(i)%map)
!!$ if (i>1) write(0,*) 'List realloc loop output:',i,&
!!$ & allocated(this%p_desc_X%v_halo_index%v),&
!!$ & allocated(this%p_desc_Y%v_halo_index%v)
!!$ end associate
newnode => current%next newnode => current%next
deallocate(current) deallocate(current)
@ -511,14 +502,6 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold)
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Return from ',i,' call to mlprcbld ',info & 'Return from ',i,' call to mlprcbld ',info
!!$ associate(this =>p%precv(i)%map)
!!$ if (i>1) write(0,*) 'After sm build at level:',i,&
!!$ & allocated(this%p_desc_X%v_halo_index%v),&
!!$ & allocated(this%p_desc_Y%v_halo_index%v)
!!$ end associate
end do end do

81
mlprec/impl/mld_smlprec_aply.f90
Unescape Escape View File

@ -488,18 +488,26 @@ contains
& p%precv(level)%base_desc, trans,& & p%precv(level)%base_desc, trans,&
& sweeps,work,info) & sweeps,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
if (level < nlev) then if (level < nlev) then
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
! !
! Apply the prolongator ! Apply the prolongator
! !
call psb_map_Y2X(sone,mlprec_wrk(level+1)%y2l,& call psb_map_Y2X(sone,mlprec_wrk(level+1)%y2l,&
& sone,mlprec_wrk(level)%y2l,& & sone,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work) & p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
end if end if
@ -534,14 +542,23 @@ contains
if (level < nlev) then if (level < nlev) then
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
! !
! Apply the prolongator ! Apply the prolongator
! !
call psb_map_Y2X(sone,mlprec_wrk(level+1)%y2l,& call psb_map_Y2X(sone,mlprec_wrk(level+1)%y2l,&
& szero,mlprec_wrk(level)%y2l,& & szero,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work) & p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
! !
! Compute the residual ! Compute the residual
! !
@ -608,13 +625,25 @@ contains
& mlprec_wrk(level)%y2l,sone,mlprec_wrk(level)%x2l,& & mlprec_wrk(level)%y2l,sone,mlprec_wrk(level)%x2l,&
& p%precv(level)%base_desc,info,work=work,trans=trans) & p%precv(level)%base_desc,info,work=work,trans=trans)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
call psb_map_Y2X(sone,mlprec_wrk(level+1)%y2l,& call psb_map_Y2X(sone,mlprec_wrk(level+1)%y2l,&
& sone,mlprec_wrk(level)%y2l,& & sone,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work) & p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
end if end if
@ -669,12 +698,23 @@ contains
& p%precv(level)%base_desc,info,work=work,trans=trans) & p%precv(level)%base_desc,info,work=work,trans=trans)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
call psb_map_Y2X(sone,mlprec_wrk(level+1)%y2l,& call psb_map_Y2X(sone,mlprec_wrk(level+1)%y2l,&
& sone,mlprec_wrk(level)%y2l,& & sone,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work) & p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
end if end if
@ -700,14 +740,24 @@ contains
if (level < nlev) then if (level < nlev) then
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
! !
! Apply the prolongator ! Apply the prolongator
! !
call psb_map_Y2X(sone,mlprec_wrk(level+1)%y2l,& call psb_map_Y2X(sone,mlprec_wrk(level+1)%y2l,&
& szero,mlprec_wrk(level)%y2l,& & szero,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work) & p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
! !
! Compute the residual ! Compute the residual
! !
@ -788,6 +838,11 @@ contains
& p%precv(level)%base_desc,info,work=work,trans=trans) & p%precv(level)%base_desc,info,work=work,trans=trans)
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
! !
@ -797,9 +852,9 @@ contains
& sone,mlprec_wrk(level)%y2l,& & sone,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work) & p%precv(level+1)%map,info,work=work)
if (info /= psb_success_ ) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during restriction') & a_err='Error during prolongation')
goto 9999 goto 9999
end if end if

3
mlprec/impl/mld_smlprec_bld.f90
Unescape Escape View File

@ -74,7 +74,7 @@
! !
! !
! !
subroutine mld_smlprec_bld(a,desc_a,p,info,amold,vmold) subroutine mld_smlprec_bld(a,desc_a,p,info,amold,vmold,imold)
use psb_base_mod use psb_base_mod
use mld_s_inner_mod, mld_protect_name => mld_smlprec_bld use mld_s_inner_mod, mld_protect_name => mld_smlprec_bld
@ -89,6 +89,7 @@ subroutine mld_smlprec_bld(a,desc_a,p,info,amold,vmold)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_sparse_mat), intent(in), optional :: amold
class(psb_s_base_vect_type), intent(in), optional :: vmold class(psb_s_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
!!$ character, intent(in), optional :: upd !!$ character, intent(in), optional :: upd
! Local Variables ! Local Variables

3
mlprec/impl/mld_sprecbld.f90
Unescape Escape View File

@ -58,7 +58,7 @@
! info - integer, output. ! info - integer, output.
! Error code. ! Error code.
! !
subroutine mld_sprecbld(a,desc_a,p,info,amold,vmold) subroutine mld_sprecbld(a,desc_a,p,info,amold,vmold,imold)
use psb_base_mod use psb_base_mod
use mld_s_inner_mod use mld_s_inner_mod
@ -73,6 +73,7 @@ subroutine mld_sprecbld(a,desc_a,p,info,amold,vmold)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_sparse_mat), intent(in), optional :: amold
class(psb_s_base_vect_type), intent(in), optional :: vmold class(psb_s_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
!!$ character, intent(in), optional :: upd !!$ character, intent(in), optional :: upd
! Local Variables ! Local Variables

81
mlprec/impl/mld_zmlprec_aply.f90
Unescape Escape View File

@ -488,18 +488,26 @@ contains
& p%precv(level)%base_desc, trans,& & p%precv(level)%base_desc, trans,&
& sweeps,work,info) & sweeps,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
if (level < nlev) then if (level < nlev) then
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
! !
! Apply the prolongator ! Apply the prolongator
! !
call psb_map_Y2X(zone,mlprec_wrk(level+1)%y2l,& call psb_map_Y2X(zone,mlprec_wrk(level+1)%y2l,&
& zone,mlprec_wrk(level)%y2l,& & zone,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work) & p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
end if end if
@ -534,14 +542,23 @@ contains
if (level < nlev) then if (level < nlev) then
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
! !
! Apply the prolongator ! Apply the prolongator
! !
call psb_map_Y2X(zone,mlprec_wrk(level+1)%y2l,& call psb_map_Y2X(zone,mlprec_wrk(level+1)%y2l,&
& zzero,mlprec_wrk(level)%y2l,& & zzero,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work) & p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
! !
! Compute the residual ! Compute the residual
! !
@ -608,13 +625,25 @@ contains
& mlprec_wrk(level)%y2l,zone,mlprec_wrk(level)%x2l,& & mlprec_wrk(level)%y2l,zone,mlprec_wrk(level)%x2l,&
& p%precv(level)%base_desc,info,work=work,trans=trans) & p%precv(level)%base_desc,info,work=work,trans=trans)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
call psb_map_Y2X(zone,mlprec_wrk(level+1)%y2l,& call psb_map_Y2X(zone,mlprec_wrk(level+1)%y2l,&
& zone,mlprec_wrk(level)%y2l,& & zone,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work) & p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
end if end if
@ -669,12 +698,23 @@ contains
& p%precv(level)%base_desc,info,work=work,trans=trans) & p%precv(level)%base_desc,info,work=work,trans=trans)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
call psb_map_Y2X(zone,mlprec_wrk(level+1)%y2l,& call psb_map_Y2X(zone,mlprec_wrk(level+1)%y2l,&
& zone,mlprec_wrk(level)%y2l,& & zone,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work) & p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
end if end if
@ -700,14 +740,24 @@ contains
if (level < nlev) then if (level < nlev) then
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
! !
! Apply the prolongator ! Apply the prolongator
! !
call psb_map_Y2X(zone,mlprec_wrk(level+1)%y2l,& call psb_map_Y2X(zone,mlprec_wrk(level+1)%y2l,&
& zzero,mlprec_wrk(level)%y2l,& & zzero,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work) & p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
! !
! Compute the residual ! Compute the residual
! !
@ -788,6 +838,11 @@ contains
& p%precv(level)%base_desc,info,work=work,trans=trans) & p%precv(level)%base_desc,info,work=work,trans=trans)
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
! !
@ -797,9 +852,9 @@ contains
& zone,mlprec_wrk(level)%y2l,& & zone,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work) & p%precv(level+1)%map,info,work=work)
if (info /= psb_success_ ) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during restriction') & a_err='Error during prolongation')
goto 9999 goto 9999
end if end if

3
mlprec/impl/mld_zmlprec_bld.f90
Unescape Escape View File

@ -74,7 +74,7 @@
! !
! !
! !
subroutine mld_zmlprec_bld(a,desc_a,p,info,amold,vmold) subroutine mld_zmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
use psb_base_mod use psb_base_mod
use mld_z_inner_mod, mld_protect_name => mld_zmlprec_bld use mld_z_inner_mod, mld_protect_name => mld_zmlprec_bld
@ -89,6 +89,7 @@ subroutine mld_zmlprec_bld(a,desc_a,p,info,amold,vmold)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_sparse_mat), intent(in), optional :: amold
class(psb_z_base_vect_type), intent(in), optional :: vmold class(psb_z_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
!!$ character, intent(in), optional :: upd !!$ character, intent(in), optional :: upd
! Local Variables ! Local Variables

3
mlprec/impl/mld_zprecbld.f90
Unescape Escape View File

@ -58,7 +58,7 @@
! info - integer, output. ! info - integer, output.
! Error code. ! Error code.
! !
subroutine mld_zprecbld(a,desc_a,p,info,amold,vmold) subroutine mld_zprecbld(a,desc_a,p,info,amold,vmold,imold)
use psb_base_mod use psb_base_mod
use mld_z_inner_mod use mld_z_inner_mod
@ -73,6 +73,7 @@ subroutine mld_zprecbld(a,desc_a,p,info,amold,vmold)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_sparse_mat), intent(in), optional :: amold
class(psb_z_base_vect_type), intent(in), optional :: vmold class(psb_z_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
!!$ character, intent(in), optional :: upd !!$ character, intent(in), optional :: upd
! Local Variables ! Local Variables

5
mlprec/mld_c_inner_mod.f90
Unescape Escape View File

@ -48,8 +48,8 @@ module mld_c_inner_mod
use mld_c_prec_type use mld_c_prec_type
interface mld_mlprec_bld interface mld_mlprec_bld
subroutine mld_cmlprec_bld(a,desc_a,prec,info, amold, vmold) subroutine mld_cmlprec_bld(a,desc_a,prec,info, amold, vmold,imold)
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, & use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_i_base_vect_type, &
& psb_spk_, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_ & psb_spk_, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_
use mld_c_prec_type, only : mld_cprec_type use mld_c_prec_type, only : mld_cprec_type
implicit none implicit none
@ -59,6 +59,7 @@ module mld_c_inner_mod
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_sparse_mat), intent(in), optional :: amold
class(psb_c_base_vect_type), intent(in), optional :: vmold class(psb_c_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
!!$ character, intent(in),optional :: upd !!$ character, intent(in),optional :: upd
end subroutine mld_cmlprec_bld end subroutine mld_cmlprec_bld
end interface mld_mlprec_bld end interface mld_mlprec_bld

5
mlprec/mld_c_prec_mod.f90
Unescape Escape View File

@ -72,10 +72,10 @@ module mld_c_prec_mod
!!$ interface mld_inner_precset !!$ interface mld_inner_precset
interface mld_precbld interface mld_precbld
subroutine mld_cprecbld(a,desc_a,prec,info,amold,vmold) subroutine mld_cprecbld(a,desc_a,prec,info,amold,vmold,imold)
import :: psb_cspmat_type, psb_desc_type, psb_spk_, & import :: psb_cspmat_type, psb_desc_type, psb_spk_, &
& psb_c_base_sparse_mat, psb_c_base_vect_type, & & psb_c_base_sparse_mat, psb_c_base_vect_type, &
& mld_cprec_type, psb_ipk_ & psb_i_base_vect_type, mld_cprec_type, psb_ipk_
implicit none implicit none
type(psb_cspmat_type), intent(in), target :: a type(psb_cspmat_type), intent(in), target :: a
type(psb_desc_type), intent(inout), target :: desc_a type(psb_desc_type), intent(inout), target :: desc_a
@ -83,6 +83,7 @@ module mld_c_prec_mod
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_sparse_mat), intent(in), optional :: amold
class(psb_c_base_vect_type), intent(in), optional :: vmold class(psb_c_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
!!$ character, intent(in),optional :: upd !!$ character, intent(in),optional :: upd
end subroutine mld_cprecbld end subroutine mld_cprecbld
end interface end interface

5
mlprec/mld_s_inner_mod.f90
Unescape Escape View File

@ -48,8 +48,8 @@ module mld_s_inner_mod
use mld_s_prec_type use mld_s_prec_type
interface mld_mlprec_bld interface mld_mlprec_bld
subroutine mld_smlprec_bld(a,desc_a,prec,info, amold, vmold) subroutine mld_smlprec_bld(a,desc_a,prec,info, amold, vmold,imold)
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, & use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_i_base_vect_type, &
& psb_spk_, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_ & psb_spk_, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_
use mld_s_prec_type, only : mld_sprec_type use mld_s_prec_type, only : mld_sprec_type
implicit none implicit none
@ -59,6 +59,7 @@ module mld_s_inner_mod
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_sparse_mat), intent(in), optional :: amold
class(psb_s_base_vect_type), intent(in), optional :: vmold class(psb_s_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
!!$ character, intent(in),optional :: upd !!$ character, intent(in),optional :: upd
end subroutine mld_smlprec_bld end subroutine mld_smlprec_bld
end interface mld_mlprec_bld end interface mld_mlprec_bld

5
mlprec/mld_s_prec_mod.f90
Unescape Escape View File

@ -72,10 +72,10 @@ module mld_s_prec_mod
!!$ interface mld_inner_precset !!$ interface mld_inner_precset
interface mld_precbld interface mld_precbld
subroutine mld_sprecbld(a,desc_a,prec,info,amold,vmold) subroutine mld_sprecbld(a,desc_a,prec,info,amold,vmold,imold)
import :: psb_sspmat_type, psb_desc_type, psb_spk_, & import :: psb_sspmat_type, psb_desc_type, psb_spk_, &
& psb_s_base_sparse_mat, psb_s_base_vect_type, & & psb_s_base_sparse_mat, psb_s_base_vect_type, &
& mld_sprec_type, psb_ipk_ & psb_i_base_vect_type, mld_sprec_type, psb_ipk_
implicit none implicit none
type(psb_sspmat_type), intent(in), target :: a type(psb_sspmat_type), intent(in), target :: a
type(psb_desc_type), intent(inout), target :: desc_a type(psb_desc_type), intent(inout), target :: desc_a
@ -83,6 +83,7 @@ module mld_s_prec_mod
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_sparse_mat), intent(in), optional :: amold
class(psb_s_base_vect_type), intent(in), optional :: vmold class(psb_s_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
!!$ character, intent(in),optional :: upd !!$ character, intent(in),optional :: upd
end subroutine mld_sprecbld end subroutine mld_sprecbld
end interface end interface

5
mlprec/mld_z_inner_mod.f90
Unescape Escape View File

@ -48,8 +48,8 @@ module mld_z_inner_mod
use mld_z_prec_type use mld_z_prec_type
interface mld_mlprec_bld interface mld_mlprec_bld
subroutine mld_zmlprec_bld(a,desc_a,prec,info, amold, vmold) subroutine mld_zmlprec_bld(a,desc_a,prec,info, amold, vmold,imold)
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, & use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_i_base_vect_type, &
& psb_dpk_, psb_z_base_sparse_mat, psb_z_base_vect_type, psb_ipk_ & psb_dpk_, psb_z_base_sparse_mat, psb_z_base_vect_type, psb_ipk_
use mld_z_prec_type, only : mld_zprec_type use mld_z_prec_type, only : mld_zprec_type
implicit none implicit none
@ -59,6 +59,7 @@ module mld_z_inner_mod
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_sparse_mat), intent(in), optional :: amold
class(psb_z_base_vect_type), intent(in), optional :: vmold class(psb_z_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
!!$ character, intent(in),optional :: upd !!$ character, intent(in),optional :: upd
end subroutine mld_zmlprec_bld end subroutine mld_zmlprec_bld
end interface mld_mlprec_bld end interface mld_mlprec_bld

5
mlprec/mld_z_prec_mod.f90
Unescape Escape View File

@ -72,10 +72,10 @@ module mld_z_prec_mod
!!$ interface mld_inner_precset !!$ interface mld_inner_precset
interface mld_precbld interface mld_precbld
subroutine mld_zprecbld(a,desc_a,prec,info,amold,vmold) subroutine mld_zprecbld(a,desc_a,prec,info,amold,vmold,imold)
import :: psb_zspmat_type, psb_desc_type, psb_dpk_, & import :: psb_zspmat_type, psb_desc_type, psb_dpk_, &
& psb_z_base_sparse_mat, psb_z_base_vect_type, & & psb_z_base_sparse_mat, psb_z_base_vect_type, &
& mld_zprec_type, psb_ipk_ & psb_i_base_vect_type, mld_zprec_type, psb_ipk_
implicit none implicit none
type(psb_zspmat_type), intent(in), target :: a type(psb_zspmat_type), intent(in), target :: a
type(psb_desc_type), intent(inout), target :: desc_a type(psb_desc_type), intent(inout), target :: desc_a
@ -83,6 +83,7 @@ module mld_z_prec_mod
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_sparse_mat), intent(in), optional :: amold
class(psb_z_base_vect_type), intent(in), optional :: vmold class(psb_z_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
!!$ character, intent(in),optional :: upd !!$ character, intent(in),optional :: upd
end subroutine mld_zprecbld end subroutine mld_zprecbld
end interface end interface

4
tests/pdegen/runs/ppde.inp
Unescape Escape View File

@ -7,8 +7,8 @@ CSR ! Storage format CSR COO JAD
30 ! IRST (restart for RGMRES and BiCGSTABL) 30 ! IRST (restart for RGMRES and BiCGSTABL)
1.d-6 ! EPS 1.d-6 ! EPS
3L-MUL-RAS-BJAC4-ILU ! Descriptive name for preconditioner (up to 40 chars) 3L-MUL-RAS-BJAC4-ILU ! Descriptive name for preconditioner (up to 40 chars)
ML ! Preconditioner NONE JACOBI BJAC AS ML AS ! Preconditioner NONE JACOBI BJAC AS ML
1 ! Number of overlap layers for AS preconditioner at finest level 2 ! Number of overlap layers for AS preconditioner at finest level
HALO ! Restriction operator NONE HALO HALO ! Restriction operator NONE HALO
NONE ! Prolongation operator NONE SUM AVG NONE ! Prolongation operator NONE SUM AVG
ILU ! Subdomain solver DSCALE ILU MILU ILUT UMF SLU ILU ! Subdomain solver DSCALE ILU MILU ILUT UMF SLU

Write Preview
Loading…
Cancel
Save