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

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

@ -488,18 +488,26 @@ contains
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) goto 9999
if (level < nlev) then
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
!
call psb_map_Y2X(cone,mlprec_wrk(level+1)%y2l,&
& cone,mlprec_wrk(level)%y2l,&
& 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
@ -534,14 +542,23 @@ contains
if (level < nlev) then
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
!
call psb_map_Y2X(cone,mlprec_wrk(level+1)%y2l,&
& czero,mlprec_wrk(level)%y2l,&
& 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
!
@ -608,13 +625,25 @@ contains
& mlprec_wrk(level)%y2l,cone,mlprec_wrk(level)%x2l,&
& p%precv(level)%base_desc,info,work=work,trans=trans)
if (info /= psb_success_) goto 9999
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,&
& cone,mlprec_wrk(level)%y2l,&
& 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
@ -669,12 +698,23 @@ contains
& p%precv(level)%base_desc,info,work=work,trans=trans)
if (info /= psb_success_) goto 9999
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,&
& cone,mlprec_wrk(level)%y2l,&
& 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
@ -700,14 +740,24 @@ contains
if (level < nlev) then
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
!
call psb_map_Y2X(cone,mlprec_wrk(level+1)%y2l,&
& czero,mlprec_wrk(level)%y2l,&
& 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
!
@ -788,6 +838,11 @@ contains
& p%precv(level)%base_desc,info,work=work,trans=trans)
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
!
@ -796,10 +851,10 @@ contains
call psb_map_Y2X(cone,mlprec_wrk(level+1)%y2l,&
& cone,mlprec_wrk(level)%y2l,&
& 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,&
& a_err='Error during restriction')
& a_err='Error during prolongation')
goto 9999
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 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
class(psb_c_base_sparse_mat), intent(in), optional :: amold
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
! Local Variables

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

@ -58,7 +58,7 @@
! info - integer, output.
! 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 mld_c_inner_mod
@ -73,6 +73,7 @@ subroutine mld_cprecbld(a,desc_a,p,info,amold,vmold)
integer(psb_ipk_), intent(out) :: info
class(psb_c_base_sparse_mat), intent(in), optional :: amold
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
! Local Variables

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

@ -362,8 +362,7 @@ subroutine mld_dmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
nr2l = p%precv(level)%base_desc%get_local_rows()
allocate(mlprec_wrk(level)%x2l(nc2l),mlprec_wrk(level)%y2l(nc2l),&
& stat=info)
if (info /= psb_success_) then
write(0,*) 'Allocation Error at level ',0
if (info /= psb_success_) then
info=psb_err_alloc_request_
call psb_errpush(info,name,&
& i_err=(/ione*(size(x)+size(y)),izero,izero,izero,izero/),&
@ -447,7 +446,6 @@ contains
& mlprec_wrk(level)%y2l(nc2l),&
& stat=info)
if (info /= psb_success_) then
write(0,*) 'Allocation Error at level',level, nc2l
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/2*nc2l,izero,izero,izero,izero/),&
& a_err='real(psb_dpk_)')
@ -490,18 +488,26 @@ contains
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) goto 9999
if (level < nlev) then
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
!
call psb_map_Y2X(done,mlprec_wrk(level+1)%y2l,&
& done,mlprec_wrk(level)%y2l,&
& 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
@ -524,7 +530,7 @@ contains
call psb_map_X2Y(done,mlprec_wrk(level-1)%x2l,&
& dzero,mlprec_wrk(level)%x2l,&
& p%precv(level)%map,info,work=work)
!!$ write(0,*) 'inner_ml map_x2y :',level,info
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during restriction')
@ -619,13 +625,25 @@ contains
& mlprec_wrk(level)%y2l,done,mlprec_wrk(level)%x2l,&
& p%precv(level)%base_desc,info,work=work,trans=trans)
if (info /= psb_success_) goto 9999
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,&
& done,mlprec_wrk(level)%y2l,&
& 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
@ -680,12 +698,23 @@ contains
& p%precv(level)%base_desc,info,work=work,trans=trans)
if (info /= psb_success_) goto 9999
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,&
& done,mlprec_wrk(level)%y2l,&
& 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
@ -711,14 +740,24 @@ contains
if (level < nlev) then
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
!
call psb_map_Y2X(done,mlprec_wrk(level+1)%y2l,&
& dzero,mlprec_wrk(level)%y2l,&
& 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
!
@ -799,6 +838,11 @@ contains
& p%precv(level)%base_desc,info,work=work,trans=trans)
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
!
@ -807,10 +851,10 @@ contains
call psb_map_Y2X(done,mlprec_wrk(level+1)%y2l,&
& done,mlprec_wrk(level)%y2l,&
& 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,&
& a_err='Error during restriction')
& a_err='Error during prolongation')
goto 9999
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
nc2l = p%precv(level)%base_desc%get_local_cols()
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/),&
& a_err='real(psb_dpk_)')
goto 9999
@ -1101,7 +1144,7 @@ contains
call psb_map_X2Y(done,mlprec_wrk(level-1)%vx2l,&
& dzero,mlprec_wrk(level)%vx2l,&
& p%precv(level)%map,info,work=work)
!!$ write(0,*) 'inner_ml map_x2y :',level,info
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during restriction')
@ -1113,11 +1156,6 @@ contains
if (level < nlev) then
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
!
! Apply the prolongator
@ -1125,11 +1163,6 @@ contains
call psb_map_Y2X(done,mlprec_wrk(level+1)%vy2l,&
& dzero,mlprec_wrk(level)%vy2l,&
& 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
!
! 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 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
class(psb_d_base_sparse_mat), intent(in), optional :: amold
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
! Local Variables
@ -175,7 +176,7 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold)
endif
!!$ write(0,*) 'DMLPRECBLD: CASIZE ',casize
if (casize>0) then
!
! 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
! First do a move_alloc.
! 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_) &
& call mld_move_alloc(current%item,p%precv(i),info)
! 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_Y => p%precv(i)%base_desc
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
deallocate(current)
@ -511,14 +502,6 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold)
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& '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

34
mlprec/impl/mld_dprecbld.f90
Unescape Escape View File

@ -165,22 +165,22 @@ subroutine mld_dprecbld(a,desc_a,p,info,amold,vmold,imold)
call psb_errpush(psb_err_internal_error_,name,a_err='Base level precbuild.')
goto 9999
end if
call p%precv(1)%check(info)
if (info /= psb_success_) then
write(0,*) ' Smoother check error',info
call psb_errpush(psb_err_internal_error_,name,&
& a_err='One level preconditioner check.')
goto 9999
endif
call p%precv(1)%sm%build(a,desc_a,upd_,info,amold=amold,vmold=vmold)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='One level preconditioner build.')
goto 9999
endif
call p%precv(1)%check(info)
if (info /= psb_success_) then
write(0,*) ' Smoother check error',info
call psb_errpush(psb_err_internal_error_,name,&
& a_err='One level preconditioner check.')
goto 9999
endif
call p%precv(1)%sm%build(a,desc_a,upd_,info,amold=amold,vmold=vmold)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='One level preconditioner build.')
goto 9999
endif
!
! Number of levels > 1
!
@ -189,7 +189,7 @@ subroutine mld_dprecbld(a,desc_a,p,info,amold,vmold,imold)
! Build the multilevel preconditioner
!
call mld_mlprec_bld(a,desc_a,p,info,amold=amold,vmold=vmold)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Multilevel preconditioner build.')

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

@ -488,18 +488,26 @@ contains
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) goto 9999
if (level < nlev) then
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
!
call psb_map_Y2X(sone,mlprec_wrk(level+1)%y2l,&
& sone,mlprec_wrk(level)%y2l,&
& 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
@ -534,14 +542,23 @@ contains
if (level < nlev) then
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
!
call psb_map_Y2X(sone,mlprec_wrk(level+1)%y2l,&
& szero,mlprec_wrk(level)%y2l,&
& 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
!
@ -608,13 +625,25 @@ contains
& mlprec_wrk(level)%y2l,sone,mlprec_wrk(level)%x2l,&
& p%precv(level)%base_desc,info,work=work,trans=trans)
if (info /= psb_success_) goto 9999
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,&
& sone,mlprec_wrk(level)%y2l,&
& 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
@ -669,12 +698,23 @@ contains
& p%precv(level)%base_desc,info,work=work,trans=trans)
if (info /= psb_success_) goto 9999
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,&
& sone,mlprec_wrk(level)%y2l,&
& 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
@ -700,14 +740,24 @@ contains
if (level < nlev) then
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
!
call psb_map_Y2X(sone,mlprec_wrk(level+1)%y2l,&
& szero,mlprec_wrk(level)%y2l,&
& 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
!
@ -788,6 +838,11 @@ contains
& p%precv(level)%base_desc,info,work=work,trans=trans)
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
!
@ -796,10 +851,10 @@ contains
call psb_map_Y2X(sone,mlprec_wrk(level+1)%y2l,&
& sone,mlprec_wrk(level)%y2l,&
& 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,&
& a_err='Error during restriction')
& a_err='Error during prolongation')
goto 9999
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 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
class(psb_s_base_sparse_mat), intent(in), optional :: amold
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
! Local Variables

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

@ -58,7 +58,7 @@
! info - integer, output.
! 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 mld_s_inner_mod
@ -73,6 +73,7 @@ subroutine mld_sprecbld(a,desc_a,p,info,amold,vmold)
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_sparse_mat), intent(in), optional :: amold
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
! Local Variables

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

@ -488,18 +488,26 @@ contains
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) goto 9999
if (level < nlev) then
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
!
call psb_map_Y2X(zone,mlprec_wrk(level+1)%y2l,&
& zone,mlprec_wrk(level)%y2l,&
& 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
@ -534,14 +542,23 @@ contains
if (level < nlev) then
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
!
call psb_map_Y2X(zone,mlprec_wrk(level+1)%y2l,&
& zzero,mlprec_wrk(level)%y2l,&
& 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
!
@ -608,13 +625,25 @@ contains
& mlprec_wrk(level)%y2l,zone,mlprec_wrk(level)%x2l,&
& p%precv(level)%base_desc,info,work=work,trans=trans)
if (info /= psb_success_) goto 9999
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,&
& zone,mlprec_wrk(level)%y2l,&
& 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
@ -669,12 +698,23 @@ contains
& p%precv(level)%base_desc,info,work=work,trans=trans)
if (info /= psb_success_) goto 9999
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,&
& zone,mlprec_wrk(level)%y2l,&
& 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
@ -700,14 +740,24 @@ contains
if (level < nlev) then
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
!
call psb_map_Y2X(zone,mlprec_wrk(level+1)%y2l,&
& zzero,mlprec_wrk(level)%y2l,&
& 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
!
@ -788,6 +838,11 @@ contains
& p%precv(level)%base_desc,info,work=work,trans=trans)
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
!
@ -796,10 +851,10 @@ contains
call psb_map_Y2X(zone,mlprec_wrk(level+1)%y2l,&
& zone,mlprec_wrk(level)%y2l,&
& 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,&
& a_err='Error during restriction')
& a_err='Error during prolongation')
goto 9999
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 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
class(psb_z_base_sparse_mat), intent(in), optional :: amold
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
! Local Variables

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

@ -58,7 +58,7 @@
! info - integer, output.
! 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 mld_z_inner_mod
@ -73,6 +73,7 @@ subroutine mld_zprecbld(a,desc_a,p,info,amold,vmold)
integer(psb_ipk_), intent(out) :: info
class(psb_z_base_sparse_mat), intent(in), optional :: amold
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
! 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
interface mld_mlprec_bld
subroutine mld_cmlprec_bld(a,desc_a,prec,info, amold, vmold)
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, &
subroutine mld_cmlprec_bld(a,desc_a,prec,info, amold, vmold,imold)
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_
use mld_c_prec_type, only : mld_cprec_type
implicit none
@ -59,6 +59,7 @@ module mld_c_inner_mod
integer(psb_ipk_), intent(out) :: info
class(psb_c_base_sparse_mat), intent(in), optional :: amold
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
end subroutine mld_cmlprec_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_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_, &
& 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
type(psb_cspmat_type), intent(in), target :: 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
class(psb_c_base_sparse_mat), intent(in), optional :: amold
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
end subroutine mld_cprecbld
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
interface mld_mlprec_bld
subroutine mld_smlprec_bld(a,desc_a,prec,info, amold, vmold)
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, &
subroutine mld_smlprec_bld(a,desc_a,prec,info, amold, vmold,imold)
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_
use mld_s_prec_type, only : mld_sprec_type
implicit none
@ -59,6 +59,7 @@ module mld_s_inner_mod
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_sparse_mat), intent(in), optional :: amold
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
end subroutine mld_smlprec_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_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_, &
& 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
type(psb_sspmat_type), intent(in), target :: 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
class(psb_s_base_sparse_mat), intent(in), optional :: amold
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
end subroutine mld_sprecbld
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
interface mld_mlprec_bld
subroutine mld_zmlprec_bld(a,desc_a,prec,info, amold, vmold)
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, &
subroutine mld_zmlprec_bld(a,desc_a,prec,info, amold, vmold,imold)
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_
use mld_z_prec_type, only : mld_zprec_type
implicit none
@ -59,6 +59,7 @@ module mld_z_inner_mod
integer(psb_ipk_), intent(out) :: info
class(psb_z_base_sparse_mat), intent(in), optional :: amold
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
end subroutine mld_zmlprec_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_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_, &
& 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
type(psb_zspmat_type), intent(in), target :: 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
class(psb_z_base_sparse_mat), intent(in), optional :: amold
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
end subroutine mld_zprecbld
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)
1.d-6 ! EPS
3L-MUL-RAS-BJAC4-ILU ! Descriptive name for preconditioner (up to 40 chars)
ML ! Preconditioner NONE JACOBI BJAC AS ML
1 ! Number of overlap layers for AS preconditioner at finest level
AS ! Preconditioner NONE JACOBI BJAC AS ML
2 ! Number of overlap layers for AS preconditioner at finest level
HALO ! Restriction operator NONE HALO
NONE ! Prolongation operator NONE SUM AVG
ILU ! Subdomain solver DSCALE ILU MILU ILUT UMF SLU

Write Preview
Loading…
Cancel
Save