fdurastante/amg4psblas
1
0
Fork 0
mirror of https://github.com/sfilippone/amg4psblas.git synced 2026-10-07 07:04:59 +00:00
Code Issues Packages Projects Releases Wiki Activity

mld2p4-2:

Browse Source 
mlprec/mld_d_ilu_solver.f90
 mlprec/mld_d_jac_smoother.f90
 mlprec/mld_dmlprec_aply.f90
 tests/pdegen/runs/ppde.inp

Fix for performace issues related to _Vect.
This commit is contained in:
Salvatore Filippone
2011-11-08 12:12:30 +00:00
parent aa674f69ef
commit b1c849653a
4 changed files with 41 additions and 65 deletions
Download Patch File Download Diff File Expand all files Collapse all files
mlprec/mld_d_ilu_solver.f90
+3 -3
View File
@@ -216,7 +216,8 @@ contains
else
allocate(ww(n_col),aux(4*n_col),stat=info)
endif
if (info == psb_success_) allocate(wv%v,mold=x%v)
call wv%bld(n_col,mold=x%v)
if (info /= psb_success_) then
info=psb_err_alloc_request_
@@ -224,7 +225,6 @@ contains
& a_err='real(psb_dpk_)')
goto 9999
end if
call wv%bld(n_col)
@@ -261,7 +261,7 @@ contains
call psb_errpush(psb_err_internal_error_,name,a_err='Error in subsolve')
goto 9999
endif
call wv%free(info)
if (n_col <= size(work)) then
if ((4*n_col+n_col) <= size(work)) then
else
mlprec/mld_d_jac_smoother.f90
+2 -12
View File
@@ -160,19 +160,9 @@ contains
! to compute an approximate solution of a linear system.
!
!
allocate(tx%v,mold=x%v,stat=info)
if (info == psb_success_) allocate(ty%v,mold=x%v,stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/2*n_col,0,0,0,0/),&
& a_err='real(psb_dpk_)')
goto 9999
end if
call tx%bld(x%get_nrows())
call tx%bld(x%get_nrows(),mold=x%v)
call tx%set(dzero)
call ty%bld(x%get_nrows())
call ty%set(dzero)
call ty%bld(x%get_nrows(),mold=x%v)
do i=1, sweeps
!
mlprec/mld_dmlprec_aply.f90
+31 -45
View File
@@ -908,19 +908,24 @@ subroutine mld_dmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
goto 9999
end if
level = 1
do level = 1, nlev
nc2l = p%precv(level)%base_desc%get_local_cols()
nr2l = p%precv(level)%base_desc%get_local_rows()
call mlprec_wrk(level)%vx2l%bld(nc2l,mold=x%v)
call mlprec_wrk(level)%vy2l%bld(nc2l,mold=x%v)
!!$ if (p%precv(level)%parms%ml_type == mld_twoside_smooth_) then
call mlprec_wrk(level)%vtx%bld(nc2l,mold=x%v)
call mlprec_wrk(level)%vty%bld(nc2l,mold=x%v)
!!$ end if
if (psb_errstatus_fatal()) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/2*nc2l,0,0,0,0/),&
& a_err='real(psb_dpk_)')
goto 9999
end if
end do
nc2l = p%precv(level)%base_desc%get_local_cols()
nr2l = p%precv(level)%base_desc%get_local_rows()
call psb_geall(mlprec_wrk(level)%vx2l,p%precv(level)%base_desc,info)
call psb_geasb(mlprec_wrk(level)%vx2l,p%precv(level)%base_desc,info,mold=x%v)
call psb_geall(mlprec_wrk(level)%vy2l,p%precv(level)%base_desc,info)
call psb_geasb(mlprec_wrk(level)%vy2l,p%precv(level)%base_desc,info,mold=x%v)
if (psb_errstatus_fatal()) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/2*nc2l,0,0,0,0/),&
& a_err='real(psb_dpk_)')
goto 9999
end if
level = 1
call psb_geaxpby(done,x,dzero,mlprec_wrk(level)%vx2l,p%precv(level)%base_desc,info)
call mlprec_wrk(level)%vy2l%set(dzero)
@@ -935,6 +940,18 @@ subroutine mld_dmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
call psb_geaxpby(alpha,mlprec_wrk(level)%vy2l,beta,y,&
& p%precv(level)%base_desc,info)
do level = 1, nlev
call mlprec_wrk(level)%vx2l%free(info)
call mlprec_wrk(level)%vy2l%free(info)
call mlprec_wrk(level)%vtx%free(info)
call mlprec_wrk(level)%vty%free(info)
if (psb_errstatus_fatal()) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/2*nc2l,0,0,0,0/),&
& a_err='real(psb_dpk_)')
goto 9999
end if
end do
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
@@ -993,22 +1010,6 @@ contains
nc2l = p%precv(level)%base_desc%get_local_cols()
nr2l = p%precv(level)%base_desc%get_local_rows()
if (level > 1) then
call psb_geall(mlprec_wrk(level)%vx2l,p%precv(level)%base_desc,info)
call psb_geasb(mlprec_wrk(level)%vx2l,p%precv(level)%base_desc,info, &
& mold=mlprec_wrk(1)%vx2l%v)
call psb_geall(mlprec_wrk(level)%vy2l,p%precv(level)%base_desc,info)
call psb_geasb(mlprec_wrk(level)%vy2l,p%precv(level)%base_desc,info, &
& mold=mlprec_wrk(1)%vx2l%v)
if (psb_errstatus_fatal()) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/2*nc2l,0,0,0,0/),&
& a_err='real(psb_dpk_)')
goto 9999
end if
end if
select case(p%precv(level)%parms%ml_type)
@@ -1112,7 +1113,7 @@ contains
& mlprec_wrk(level)%vx2l,done,mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
else
sweeps = p%precv(level)%parms%sweeps
call p%precv(level)%sm%apply(done,&
@@ -1294,21 +1295,6 @@ contains
case(mld_twoside_smooth_)
call psb_geall(mlprec_wrk(level)%vtx,p%precv(level)%base_desc,info)
call psb_geasb(mlprec_wrk(level)%vtx,p%precv(level)%base_desc,info, &
& mold=mlprec_wrk(1)%vx2l%v)
call psb_geall(mlprec_wrk(level)%vty,p%precv(level)%base_desc,info)
call psb_geasb(mlprec_wrk(level)%vty,p%precv(level)%base_desc,info, &
& mold=mlprec_wrk(1)%vx2l%v)
if (psb_errstatus_fatal()) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/2*nc2l,0,0,0,0/),&
& a_err='real(psb_dpk_)')
goto 9999
end if
if (level > 1) then
! Apply the restriction
call psb_map_X2Y(done,mlprec_wrk(level-1)%vty,&
@@ -1350,7 +1336,7 @@ contains
call psb_geaxpby(done,mlprec_wrk(level)%vx2l,&
& dzero,mlprec_wrk(level)%vty,&
& p%precv(level)%base_desc,info)
if (info == psb_success_) call psb_spmm(-done,p%precv(level)%base_a,&
& mlprec_wrk(level)%vy2l,done,mlprec_wrk(level)%vty,&
& p%precv(level)%base_desc,info,work=work,trans=trans)
tests/pdegen/runs/ppde.inp
+5 -5
View File
@@ -1,8 +1,8 @@
BICGSTAB ! Iterative method: BiCGSTAB BiCG CGS RGMRES BiCGSTABL CG
CSR ! Storage format CSR COO JAD
005 ! IDIM; domain size is idim**3
100 ! IDIM; domain size is idim**3
2 ! ISTOPC
0010 ! ITMAX
0100 ! ITMAX
01 ! ITRACE
30 ! IRST (restart for RGMRES and BiCGSTABL)
1.d-9 ! EPS
@@ -12,7 +12,7 @@ ML ! Preconditioner NONE JACOBI BJAC AS ML
HALO ! Restriction operator NONE HALO
NONE ! Prolongation operator NONE SUM AVG
ILU ! Subdomain solver DSCALE ILU MILU ILUT UMF SLU
1 ! Level-set N for ILU(N)
0 ! Level-set N for ILU(N)
1.d-5 ! Threshold T for ILU(T,P)
1 ! Smoother/Jacobi sweeps
BJAC ! Smoother type JACOBI BJAC AS; ignored for non-ML
@@ -20,11 +20,11 @@ BJAC ! Smoother type JACOBI BJAC AS; ignored for non-ML
MINENERGY ! Kind of aggregation: SMOOTHED, NONSMOOTHED
DEC ! Type of aggregation DEC SYMDEC GLB
MULT ! Type of multilevel correction: ADD MULT
POST ! Side of correction PRE POST TWOSIDE (ignored for ADD)
TWOSIDE ! Side of correction PRE POST TWOSIDE (ignored for ADD)
DIST ! Coarse level: matrix distribution DIST REPL
BJAC ! Coarse level: solver JACOBI BJAC UMF SLU SLUDIST
ILU ! Coarse level: subsolver DSCALE ILU UMF SLU SLUDIST
1 ! Coarse level: Level-set N for ILU(N)
1.d-4 ! Coarse level: Threshold T for ILU(T,P)
4 ! Coarse level: Number of Jacobi sweeps
-0.10d0 ! Smoother Aggregation Threshold: >= 0.0 default if < 0.0
-0.10d0 ! Smoother Aggregation Threshold: >= 0.0 default if <0