From b1c849653a981af64586fc0f4e136ef2db49e49d Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Tue, 8 Nov 2011 12:12:30 +0000 Subject: [PATCH] mld2p4-2: 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. --- mlprec/mld_d_ilu_solver.f90 | 6 +-- mlprec/mld_d_jac_smoother.f90 | 14 +------ mlprec/mld_dmlprec_aply.f90 | 76 ++++++++++++++--------------------- tests/pdegen/runs/ppde.inp | 10 ++--- 4 files changed, 41 insertions(+), 65 deletions(-) diff --git a/mlprec/mld_d_ilu_solver.f90 b/mlprec/mld_d_ilu_solver.f90 index 7fd0c84d..e88f7c9b 100644 --- a/mlprec/mld_d_ilu_solver.f90 +++ b/mlprec/mld_d_ilu_solver.f90 @@ -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 diff --git a/mlprec/mld_d_jac_smoother.f90 b/mlprec/mld_d_jac_smoother.f90 index b60b8a09..8aed6d2b 100644 --- a/mlprec/mld_d_jac_smoother.f90 +++ b/mlprec/mld_d_jac_smoother.f90 @@ -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 ! diff --git a/mlprec/mld_dmlprec_aply.f90 b/mlprec/mld_dmlprec_aply.f90 index 7d575793..a5ed4018 100644 --- a/mlprec/mld_dmlprec_aply.f90 +++ b/mlprec/mld_dmlprec_aply.f90 @@ -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) diff --git a/tests/pdegen/runs/ppde.inp b/tests/pdegen/runs/ppde.inp index 7e344383..23b8a572 100644 --- a/tests/pdegen/runs/ppde.inp +++ b/tests/pdegen/runs/ppde.inp @@ -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