From f982986a1c2e958bd88b9bd88ef705746480ed11 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Thu, 7 Dec 2017 17:45:47 +0000 Subject: [PATCH] Initial methods to keep track of work vectors. --- mlprec/mld_c_as_smoother.f90 | 14 +++++++- mlprec/mld_c_base_smoother_mod.f90 | 17 +++++++++- mlprec/mld_c_base_solver_mod.f90 | 15 +++++++-- mlprec/mld_c_gs_solver.f90 | 10 +++++- mlprec/mld_c_ilu_solver.f90 | 11 ++++++- mlprec/mld_c_jac_smoother.f90 | 14 +++++++- mlprec/mld_c_onelev_mod.f90 | 53 ++++++++++++++++++++++++++++-- mlprec/mld_c_prec_type.f90 | 6 ---- mlprec/mld_d_as_smoother.f90 | 14 +++++++- mlprec/mld_d_base_smoother_mod.f90 | 17 +++++++++- mlprec/mld_d_base_solver_mod.f90 | 15 +++++++-- mlprec/mld_d_gs_solver.f90 | 10 +++++- mlprec/mld_d_ilu_solver.f90 | 11 ++++++- mlprec/mld_d_jac_smoother.f90 | 14 +++++++- mlprec/mld_d_onelev_mod.f90 | 53 ++++++++++++++++++++++++++++-- mlprec/mld_d_prec_type.f90 | 6 ---- mlprec/mld_s_as_smoother.f90 | 14 +++++++- mlprec/mld_s_base_smoother_mod.f90 | 17 +++++++++- mlprec/mld_s_base_solver_mod.f90 | 15 +++++++-- mlprec/mld_s_gs_solver.f90 | 10 +++++- mlprec/mld_s_ilu_solver.f90 | 11 ++++++- mlprec/mld_s_jac_smoother.f90 | 14 +++++++- mlprec/mld_s_onelev_mod.f90 | 53 ++++++++++++++++++++++++++++-- mlprec/mld_s_prec_type.f90 | 6 ---- mlprec/mld_z_as_smoother.f90 | 14 +++++++- mlprec/mld_z_base_smoother_mod.f90 | 17 +++++++++- mlprec/mld_z_base_solver_mod.f90 | 15 +++++++-- mlprec/mld_z_gs_solver.f90 | 10 +++++- mlprec/mld_z_ilu_solver.f90 | 11 ++++++- mlprec/mld_z_jac_smoother.f90 | 14 +++++++- mlprec/mld_z_onelev_mod.f90 | 53 ++++++++++++++++++++++++++++-- mlprec/mld_z_prec_type.f90 | 6 ---- 32 files changed, 496 insertions(+), 64 deletions(-) diff --git a/mlprec/mld_c_as_smoother.f90 b/mlprec/mld_c_as_smoother.f90 index 8f19d162..c7d5ccd6 100644 --- a/mlprec/mld_c_as_smoother.f90 +++ b/mlprec/mld_c_as_smoother.f90 @@ -91,6 +91,7 @@ module mld_c_as_smoother procedure, pass(sm) :: sizeof => c_as_smoother_sizeof procedure, pass(sm) :: default => c_as_smoother_default procedure, pass(sm) :: get_nzeros => c_as_smoother_get_nzeros + procedure, pass(sm) :: get_wrksz => c_as_smoother_get_wrksize procedure, nopass :: get_fmt => c_as_smoother_get_fmt procedure, nopass :: get_id => c_as_smoother_get_id end type mld_c_as_smoother_type @@ -98,7 +99,8 @@ module mld_c_as_smoother private :: c_as_smoother_descr, c_as_smoother_sizeof, & & c_as_smoother_default, c_as_smoother_get_nzeros, & - & c_as_smoother_get_fmt, c_as_smoother_get_id + & c_as_smoother_get_fmt, c_as_smoother_get_id, & + & c_as_smoother_get_wrksize character(len=6), parameter, private :: & & restrict_names(0:4)=(/'none ','halo ',' ',' ',' '/) @@ -458,6 +460,16 @@ contains end subroutine c_as_smoother_descr + function c_as_smoother_get_wrksize(sm) result(val) + implicit none + class(mld_c_as_smoother_type), intent(inout) :: sm + integer(psb_ipk_) :: val + + val = 3 + if (allocated(sm%sv)) val = val + sm%sv%get_wrksz() + + end function c_as_smoother_get_wrksize + function c_as_smoother_get_fmt() result(val) implicit none character(len=32) :: val diff --git a/mlprec/mld_c_base_smoother_mod.f90 b/mlprec/mld_c_base_smoother_mod.f90 index c442d048..9c542cbd 100644 --- a/mlprec/mld_c_base_smoother_mod.f90 +++ b/mlprec/mld_c_base_smoother_mod.f90 @@ -92,6 +92,10 @@ module mld_c_base_smoother_mod ! check - Sanity checks. ! sizeof - Total memory occupation in bytes ! get_nzeros - Number of nonzeros + ! stringval - convert string to val for internal parms + ! get_fmt - short string descriptor + ! get_id - numeric id descriptro + ! get_wrksz - How many workspace vector does apply_vect need ! ! ! @@ -119,6 +123,7 @@ module mld_c_base_smoother_mod procedure, pass(sm) :: descr => mld_c_base_smoother_descr procedure, pass(sm) :: sizeof => c_base_smoother_sizeof procedure, pass(sm) :: get_nzeros => c_base_smoother_get_nzeros + procedure, pass(sm) :: get_wrksz => c_base_smoother_get_wrksize procedure, nopass :: stringval => mld_stringval procedure, nopass :: get_fmt => c_base_smoother_get_fmt procedure, nopass :: get_id => c_base_smoother_get_id @@ -127,7 +132,7 @@ module mld_c_base_smoother_mod private :: c_base_smoother_sizeof, c_base_smoother_get_fmt, & & c_base_smoother_default, c_base_smoother_get_nzeros, & - & c_base_smoother_get_id + & c_base_smoother_get_id, c_base_smoother_get_wrksize @@ -387,6 +392,16 @@ contains return end subroutine c_base_smoother_default + function c_base_smoother_get_wrksize(sm) result(val) + implicit none + class(mld_c_base_smoother_type), intent(inout) :: sm + integer(psb_ipk_) :: val + + val = 0 + if (allocated(sm%sv)) val = val + sm%sv%get_wrksz() + + end function c_base_smoother_get_wrksize + function c_base_smoother_get_fmt() result(val) implicit none character(len=32) :: val diff --git a/mlprec/mld_c_base_solver_mod.f90 b/mlprec/mld_c_base_solver_mod.f90 index 6ebf1255..299f547c 100644 --- a/mlprec/mld_c_base_solver_mod.f90 +++ b/mlprec/mld_c_base_solver_mod.f90 @@ -78,7 +78,10 @@ module mld_c_base_solver_mod ! check - Sanity checks. ! sizeof - Total memory occupation in bytes ! get_nzeros - Number of nonzeros - ! + ! stringval - convert string to val for internal parms + ! get_fmt - short string descriptor + ! get_id - numeric id descriptro + ! get_wrksz - How many workspace vector does apply_vect need ! ! @@ -104,6 +107,7 @@ module mld_c_base_solver_mod procedure, pass(sv) :: descr => mld_c_base_solver_descr procedure, pass(sv) :: sizeof => c_base_solver_sizeof procedure, pass(sv) :: get_nzeros => c_base_solver_get_nzeros + procedure, nopass :: get_wrksz => c_base_solver_get_wrksize procedure, nopass :: stringval => mld_stringval procedure, nopass :: get_fmt => c_base_solver_get_fmt procedure, nopass :: get_id => c_base_solver_get_id @@ -112,7 +116,8 @@ module mld_c_base_solver_mod private :: c_base_solver_sizeof, c_base_solver_default,& & c_base_solver_get_nzeros, c_base_solver_get_fmt, & - & c_base_solver_is_iterative, c_base_solver_get_id + & c_base_solver_is_iterative, c_base_solver_get_id, & + & c_base_solver_get_wrksize interface @@ -411,5 +416,11 @@ contains val = mld_f_none_ end function c_base_solver_get_id + function c_base_solver_get_wrksize() result(val) + implicit none + integer(psb_ipk_) :: val + + val = 0 + end function c_base_solver_get_wrksize end module mld_c_base_solver_mod diff --git a/mlprec/mld_c_gs_solver.f90 b/mlprec/mld_c_gs_solver.f90 index 1e356bb8..f8a8d3bb 100644 --- a/mlprec/mld_c_gs_solver.f90 +++ b/mlprec/mld_c_gs_solver.f90 @@ -77,6 +77,7 @@ module mld_c_gs_solver procedure, pass(sv) :: default => c_gs_solver_default procedure, pass(sv) :: sizeof => c_gs_solver_sizeof procedure, pass(sv) :: get_nzeros => c_gs_solver_get_nzeros + procedure, nopass :: get_wrksz => c_gs_solver_get_wrksize procedure, nopass :: get_fmt => c_gs_solver_get_fmt procedure, nopass :: get_id => c_gs_solver_get_id procedure, nopass :: is_iterative => c_gs_solver_is_iterative @@ -102,7 +103,7 @@ module mld_c_gs_solver & c_gs_solver_get_fmt, c_gs_solver_check,& & c_gs_solver_is_iterative, & & c_bwgs_solver_get_fmt, c_bwgs_solver_descr, & - & c_gs_solver_get_id, c_bwgs_solver_get_id + & c_gs_solver_get_id, c_bwgs_solver_get_id, c_gs_solver_get_wrksize interface subroutine mld_c_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,& @@ -642,4 +643,11 @@ contains val = mld_bwgs_ end function c_bwgs_solver_get_id + function c_gs_solver_get_wrksize() result(val) + implicit none + integer(psb_ipk_) :: val + + val = 2 + end function c_gs_solver_get_wrksize + end module mld_c_gs_solver diff --git a/mlprec/mld_c_ilu_solver.f90 b/mlprec/mld_c_ilu_solver.f90 index 0e327750..f7a63066 100644 --- a/mlprec/mld_c_ilu_solver.f90 +++ b/mlprec/mld_c_ilu_solver.f90 @@ -85,6 +85,7 @@ module mld_c_ilu_solver procedure, pass(sv) :: default => c_ilu_solver_default procedure, pass(sv) :: sizeof => c_ilu_solver_sizeof procedure, pass(sv) :: get_nzeros => c_ilu_solver_get_nzeros + procedure, nopass :: get_wrksz => c_ilu_solver_get_wrksize procedure, nopass :: get_fmt => c_ilu_solver_get_fmt procedure, nopass :: get_id => c_ilu_solver_get_id end type mld_c_ilu_solver_type @@ -96,7 +97,8 @@ module mld_c_ilu_solver & c_ilu_solver_descr, c_ilu_solver_sizeof, & & c_ilu_solver_default, c_ilu_solver_dmp, & & c_ilu_solver_apply_vect, c_ilu_solver_get_nzeros, & - & c_ilu_solver_get_fmt, c_ilu_solver_check, c_ilu_solver_get_id + & c_ilu_solver_get_fmt, c_ilu_solver_check, & + & c_ilu_solver_get_id, c_ilu_solver_get_wrksize interface @@ -554,5 +556,12 @@ contains val = mld_ilu_n_ end function c_ilu_solver_get_id + + function c_ilu_solver_get_wrksize() result(val) + implicit none + integer(psb_ipk_) :: val + + val = 2 + end function c_ilu_solver_get_wrksize end module mld_c_ilu_solver diff --git a/mlprec/mld_c_jac_smoother.f90 b/mlprec/mld_c_jac_smoother.f90 index 50bf6f19..3b464b6d 100644 --- a/mlprec/mld_c_jac_smoother.f90 +++ b/mlprec/mld_c_jac_smoother.f90 @@ -71,6 +71,7 @@ module mld_c_jac_smoother procedure, pass(sm) :: descr => mld_c_jac_smoother_descr procedure, pass(sm) :: sizeof => c_jac_smoother_sizeof procedure, pass(sm) :: get_nzeros => c_jac_smoother_get_nzeros + procedure, pass(sm) :: get_wrksz => c_jac_smoother_get_wrksize procedure, nopass :: get_fmt => c_jac_smoother_get_fmt procedure, nopass :: get_id => c_jac_smoother_get_id end type mld_c_jac_smoother_type @@ -78,7 +79,8 @@ module mld_c_jac_smoother private :: c_jac_smoother_free, c_jac_smoother_descr, & & c_jac_smoother_sizeof, c_jac_smoother_get_nzeros, & - & c_jac_smoother_get_fmt, c_jac_smoother_get_id + & c_jac_smoother_get_fmt, c_jac_smoother_get_id, & + & c_jac_smoother_get_wrksize interface @@ -253,6 +255,16 @@ contains return end function c_jac_smoother_get_nzeros + function c_jac_smoother_get_wrksize(sm) result(val) + implicit none + class(mld_c_jac_smoother_type), intent(inout) :: sm + integer(psb_ipk_) :: val + + val = 2 + if (allocated(sm%sv)) val = val + sm%sv%get_wrksz() + + end function c_jac_smoother_get_wrksize + function c_jac_smoother_get_fmt() result(val) implicit none character(len=32) :: val diff --git a/mlprec/mld_c_onelev_mod.f90 b/mlprec/mld_c_onelev_mod.f90 index 01068337..f19ce582 100644 --- a/mlprec/mld_c_onelev_mod.f90 +++ b/mlprec/mld_c_onelev_mod.f90 @@ -117,11 +117,20 @@ module mld_c_onelev_mod ! check - Sanity checks. ! sizeof - Total memory occupation in bytes ! get_nzeros - Number of nonzeros + ! get_wrksz - How many workspace vector does apply_vect need ! - ! + ! + type mld_cmlprec_wrk_type + complex(psb_spk_), allocatable :: tx(:), ty(:), x2l(:), y2l(:) + type(psb_c_vect_type) :: vtx, vty, vx2l, vy2l + integer(psb_ipk_) :: wvsz = 0 + type(psb_c_vect_type), allocatable :: wv(:) + end type mld_cmlprec_wrk_type + type mld_c_onelev_type class(mld_c_base_smoother_type), allocatable :: sm, sm2a class(mld_c_base_smoother_type), pointer :: sm2 => null() + type(mld_cmlprec_wrk_type) :: wrk type(mld_sml_parms) :: parms type(psb_cspmat_type) :: ac integer(psb_ipk_) :: ac_nz_loc, ac_nz_tot @@ -153,6 +162,7 @@ module mld_c_onelev_mod & cseti, csetr, csetc, setsm, setsv procedure, pass(lv) :: sizeof => c_base_onelev_sizeof procedure, pass(lv) :: get_nzeros => c_base_onelev_get_nzeros + procedure, pass(lv) :: get_wrksz => c_base_onelev_get_wrksize procedure, nopass :: stringval => mld_stringval procedure, pass(lv) :: move_alloc => c_base_onelev_move_alloc end type mld_c_onelev_type @@ -164,7 +174,8 @@ module mld_c_onelev_mod private :: c_base_onelev_default, c_base_onelev_sizeof, & & c_base_onelev_nullify, c_base_onelev_get_nzeros, & - & c_base_onelev_clone, c_base_onelev_move_alloc + & c_base_onelev_clone, c_base_onelev_move_alloc, & + & c_base_onelev_get_wrksize @@ -498,7 +509,6 @@ contains end subroutine c_base_onelev_clone - subroutine c_base_onelev_move_alloc(lv, b,info) use psb_base_mod implicit none @@ -527,4 +537,41 @@ contains end subroutine c_base_onelev_move_alloc + + function c_base_onelev_get_wrksize(lv) result(val) + implicit none + class(mld_c_base_onelev_type), intent(inout) :: lv + integer(psb_ipk_) :: val + + val = 0 + ! SM and SM2A can share work vectors + if (allocated(lv%sm)) val = val + sm%get_wrksz() + if (allocated(lv%sm2a)) val = max(val,sm2a%get_wrksz()) + ! + ! Now for the ML application itself + ! + ! We have VTX/VTY/VX2L/VY2L + ! + val = val + 4 + ! + ! plus some additions for specific ML/cycles + ! + select case(lv%parms%ml_cycle) + case(mld_add_ml_,mld_mult_ml_,mld_vcycle_ml_, mld_wcycle_ml_) + ! We're good + + case(mld_kcycle_ml_, mld_kcyclesym_ml_) + ! + ! We need 7 in inneritkcycle, but we can reuse vtx + ! + val = val + 6 + + case default + ! Need a better error signaling ? + val = -1 + end select + + end function c_base_onelev_get_wrksize + + end module mld_c_onelev_mod diff --git a/mlprec/mld_c_prec_type.f90 b/mlprec/mld_c_prec_type.f90 index 83243309..092fe9ad 100644 --- a/mlprec/mld_c_prec_type.f90 +++ b/mlprec/mld_c_prec_type.f90 @@ -80,12 +80,6 @@ module mld_c_prec_type ! order, with level 0 being the id of the coarsest level. ! ! - - type mld_cmlprec_wrk_type - complex(psb_spk_), allocatable :: tx(:), ty(:), x2l(:), y2l(:) - type(psb_c_vect_type) :: vtx, vty, vx2l, vy2l - type(psb_c_vect_type), allocatable :: wv(:) - end type mld_cmlprec_wrk_type integer, parameter, private :: wv_size_=4 type, extends(psb_cprec_type) :: mld_cprec_type diff --git a/mlprec/mld_d_as_smoother.f90 b/mlprec/mld_d_as_smoother.f90 index 2f5b6633..18d2313c 100644 --- a/mlprec/mld_d_as_smoother.f90 +++ b/mlprec/mld_d_as_smoother.f90 @@ -91,6 +91,7 @@ module mld_d_as_smoother procedure, pass(sm) :: sizeof => d_as_smoother_sizeof procedure, pass(sm) :: default => d_as_smoother_default procedure, pass(sm) :: get_nzeros => d_as_smoother_get_nzeros + procedure, pass(sm) :: get_wrksz => d_as_smoother_get_wrksize procedure, nopass :: get_fmt => d_as_smoother_get_fmt procedure, nopass :: get_id => d_as_smoother_get_id end type mld_d_as_smoother_type @@ -98,7 +99,8 @@ module mld_d_as_smoother private :: d_as_smoother_descr, d_as_smoother_sizeof, & & d_as_smoother_default, d_as_smoother_get_nzeros, & - & d_as_smoother_get_fmt, d_as_smoother_get_id + & d_as_smoother_get_fmt, d_as_smoother_get_id, & + & d_as_smoother_get_wrksize character(len=6), parameter, private :: & & restrict_names(0:4)=(/'none ','halo ',' ',' ',' '/) @@ -458,6 +460,16 @@ contains end subroutine d_as_smoother_descr + function d_as_smoother_get_wrksize(sm) result(val) + implicit none + class(mld_d_as_smoother_type), intent(inout) :: sm + integer(psb_ipk_) :: val + + val = 3 + if (allocated(sm%sv)) val = val + sm%sv%get_wrksz() + + end function d_as_smoother_get_wrksize + function d_as_smoother_get_fmt() result(val) implicit none character(len=32) :: val diff --git a/mlprec/mld_d_base_smoother_mod.f90 b/mlprec/mld_d_base_smoother_mod.f90 index 36742af5..b42c96e6 100644 --- a/mlprec/mld_d_base_smoother_mod.f90 +++ b/mlprec/mld_d_base_smoother_mod.f90 @@ -92,6 +92,10 @@ module mld_d_base_smoother_mod ! check - Sanity checks. ! sizeof - Total memory occupation in bytes ! get_nzeros - Number of nonzeros + ! stringval - convert string to val for internal parms + ! get_fmt - short string descriptor + ! get_id - numeric id descriptro + ! get_wrksz - How many workspace vector does apply_vect need ! ! ! @@ -119,6 +123,7 @@ module mld_d_base_smoother_mod procedure, pass(sm) :: descr => mld_d_base_smoother_descr procedure, pass(sm) :: sizeof => d_base_smoother_sizeof procedure, pass(sm) :: get_nzeros => d_base_smoother_get_nzeros + procedure, pass(sm) :: get_wrksz => d_base_smoother_get_wrksize procedure, nopass :: stringval => mld_stringval procedure, nopass :: get_fmt => d_base_smoother_get_fmt procedure, nopass :: get_id => d_base_smoother_get_id @@ -127,7 +132,7 @@ module mld_d_base_smoother_mod private :: d_base_smoother_sizeof, d_base_smoother_get_fmt, & & d_base_smoother_default, d_base_smoother_get_nzeros, & - & d_base_smoother_get_id + & d_base_smoother_get_id, d_base_smoother_get_wrksize @@ -387,6 +392,16 @@ contains return end subroutine d_base_smoother_default + function d_base_smoother_get_wrksize(sm) result(val) + implicit none + class(mld_d_base_smoother_type), intent(inout) :: sm + integer(psb_ipk_) :: val + + val = 0 + if (allocated(sm%sv)) val = val + sm%sv%get_wrksz() + + end function d_base_smoother_get_wrksize + function d_base_smoother_get_fmt() result(val) implicit none character(len=32) :: val diff --git a/mlprec/mld_d_base_solver_mod.f90 b/mlprec/mld_d_base_solver_mod.f90 index 86a63d69..e3a0242c 100644 --- a/mlprec/mld_d_base_solver_mod.f90 +++ b/mlprec/mld_d_base_solver_mod.f90 @@ -78,7 +78,10 @@ module mld_d_base_solver_mod ! check - Sanity checks. ! sizeof - Total memory occupation in bytes ! get_nzeros - Number of nonzeros - ! + ! stringval - convert string to val for internal parms + ! get_fmt - short string descriptor + ! get_id - numeric id descriptro + ! get_wrksz - How many workspace vector does apply_vect need ! ! @@ -104,6 +107,7 @@ module mld_d_base_solver_mod procedure, pass(sv) :: descr => mld_d_base_solver_descr procedure, pass(sv) :: sizeof => d_base_solver_sizeof procedure, pass(sv) :: get_nzeros => d_base_solver_get_nzeros + procedure, nopass :: get_wrksz => d_base_solver_get_wrksize procedure, nopass :: stringval => mld_stringval procedure, nopass :: get_fmt => d_base_solver_get_fmt procedure, nopass :: get_id => d_base_solver_get_id @@ -112,7 +116,8 @@ module mld_d_base_solver_mod private :: d_base_solver_sizeof, d_base_solver_default,& & d_base_solver_get_nzeros, d_base_solver_get_fmt, & - & d_base_solver_is_iterative, d_base_solver_get_id + & d_base_solver_is_iterative, d_base_solver_get_id, & + & d_base_solver_get_wrksize interface @@ -411,5 +416,11 @@ contains val = mld_f_none_ end function d_base_solver_get_id + function d_base_solver_get_wrksize() result(val) + implicit none + integer(psb_ipk_) :: val + + val = 0 + end function d_base_solver_get_wrksize end module mld_d_base_solver_mod diff --git a/mlprec/mld_d_gs_solver.f90 b/mlprec/mld_d_gs_solver.f90 index 98d907ac..2c53ef10 100644 --- a/mlprec/mld_d_gs_solver.f90 +++ b/mlprec/mld_d_gs_solver.f90 @@ -77,6 +77,7 @@ module mld_d_gs_solver procedure, pass(sv) :: default => d_gs_solver_default procedure, pass(sv) :: sizeof => d_gs_solver_sizeof procedure, pass(sv) :: get_nzeros => d_gs_solver_get_nzeros + procedure, nopass :: get_wrksz => d_gs_solver_get_wrksize procedure, nopass :: get_fmt => d_gs_solver_get_fmt procedure, nopass :: get_id => d_gs_solver_get_id procedure, nopass :: is_iterative => d_gs_solver_is_iterative @@ -102,7 +103,7 @@ module mld_d_gs_solver & d_gs_solver_get_fmt, d_gs_solver_check,& & d_gs_solver_is_iterative, & & d_bwgs_solver_get_fmt, d_bwgs_solver_descr, & - & d_gs_solver_get_id, d_bwgs_solver_get_id + & d_gs_solver_get_id, d_bwgs_solver_get_id, d_gs_solver_get_wrksize interface subroutine mld_d_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,& @@ -642,4 +643,11 @@ contains val = mld_bwgs_ end function d_bwgs_solver_get_id + function d_gs_solver_get_wrksize() result(val) + implicit none + integer(psb_ipk_) :: val + + val = 2 + end function d_gs_solver_get_wrksize + end module mld_d_gs_solver diff --git a/mlprec/mld_d_ilu_solver.f90 b/mlprec/mld_d_ilu_solver.f90 index ad894962..6fff1dd9 100644 --- a/mlprec/mld_d_ilu_solver.f90 +++ b/mlprec/mld_d_ilu_solver.f90 @@ -85,6 +85,7 @@ module mld_d_ilu_solver procedure, pass(sv) :: default => d_ilu_solver_default procedure, pass(sv) :: sizeof => d_ilu_solver_sizeof procedure, pass(sv) :: get_nzeros => d_ilu_solver_get_nzeros + procedure, nopass :: get_wrksz => d_ilu_solver_get_wrksize procedure, nopass :: get_fmt => d_ilu_solver_get_fmt procedure, nopass :: get_id => d_ilu_solver_get_id end type mld_d_ilu_solver_type @@ -96,7 +97,8 @@ module mld_d_ilu_solver & d_ilu_solver_descr, d_ilu_solver_sizeof, & & d_ilu_solver_default, d_ilu_solver_dmp, & & d_ilu_solver_apply_vect, d_ilu_solver_get_nzeros, & - & d_ilu_solver_get_fmt, d_ilu_solver_check, d_ilu_solver_get_id + & d_ilu_solver_get_fmt, d_ilu_solver_check, & + & d_ilu_solver_get_id, d_ilu_solver_get_wrksize interface @@ -554,5 +556,12 @@ contains val = mld_ilu_n_ end function d_ilu_solver_get_id + + function d_ilu_solver_get_wrksize() result(val) + implicit none + integer(psb_ipk_) :: val + + val = 2 + end function d_ilu_solver_get_wrksize end module mld_d_ilu_solver diff --git a/mlprec/mld_d_jac_smoother.f90 b/mlprec/mld_d_jac_smoother.f90 index db3010b8..ef03d431 100644 --- a/mlprec/mld_d_jac_smoother.f90 +++ b/mlprec/mld_d_jac_smoother.f90 @@ -71,6 +71,7 @@ module mld_d_jac_smoother procedure, pass(sm) :: descr => mld_d_jac_smoother_descr procedure, pass(sm) :: sizeof => d_jac_smoother_sizeof procedure, pass(sm) :: get_nzeros => d_jac_smoother_get_nzeros + procedure, pass(sm) :: get_wrksz => d_jac_smoother_get_wrksize procedure, nopass :: get_fmt => d_jac_smoother_get_fmt procedure, nopass :: get_id => d_jac_smoother_get_id end type mld_d_jac_smoother_type @@ -78,7 +79,8 @@ module mld_d_jac_smoother private :: d_jac_smoother_free, d_jac_smoother_descr, & & d_jac_smoother_sizeof, d_jac_smoother_get_nzeros, & - & d_jac_smoother_get_fmt, d_jac_smoother_get_id + & d_jac_smoother_get_fmt, d_jac_smoother_get_id, & + & d_jac_smoother_get_wrksize interface @@ -253,6 +255,16 @@ contains return end function d_jac_smoother_get_nzeros + function d_jac_smoother_get_wrksize(sm) result(val) + implicit none + class(mld_d_jac_smoother_type), intent(inout) :: sm + integer(psb_ipk_) :: val + + val = 2 + if (allocated(sm%sv)) val = val + sm%sv%get_wrksz() + + end function d_jac_smoother_get_wrksize + function d_jac_smoother_get_fmt() result(val) implicit none character(len=32) :: val diff --git a/mlprec/mld_d_onelev_mod.f90 b/mlprec/mld_d_onelev_mod.f90 index cd656242..23c35311 100644 --- a/mlprec/mld_d_onelev_mod.f90 +++ b/mlprec/mld_d_onelev_mod.f90 @@ -117,11 +117,20 @@ module mld_d_onelev_mod ! check - Sanity checks. ! sizeof - Total memory occupation in bytes ! get_nzeros - Number of nonzeros + ! get_wrksz - How many workspace vector does apply_vect need ! - ! + ! + type mld_dmlprec_wrk_type + real(psb_dpk_), allocatable :: tx(:), ty(:), x2l(:), y2l(:) + type(psb_d_vect_type) :: vtx, vty, vx2l, vy2l + integer(psb_ipk_) :: wvsz = 0 + type(psb_d_vect_type), allocatable :: wv(:) + end type mld_dmlprec_wrk_type + type mld_d_onelev_type class(mld_d_base_smoother_type), allocatable :: sm, sm2a class(mld_d_base_smoother_type), pointer :: sm2 => null() + type(mld_dmlprec_wrk_type) :: wrk type(mld_dml_parms) :: parms type(psb_dspmat_type) :: ac integer(psb_ipk_) :: ac_nz_loc, ac_nz_tot @@ -153,6 +162,7 @@ module mld_d_onelev_mod & cseti, csetr, csetc, setsm, setsv procedure, pass(lv) :: sizeof => d_base_onelev_sizeof procedure, pass(lv) :: get_nzeros => d_base_onelev_get_nzeros + procedure, pass(lv) :: get_wrksz => d_base_onelev_get_wrksize procedure, nopass :: stringval => mld_stringval procedure, pass(lv) :: move_alloc => d_base_onelev_move_alloc end type mld_d_onelev_type @@ -164,7 +174,8 @@ module mld_d_onelev_mod private :: d_base_onelev_default, d_base_onelev_sizeof, & & d_base_onelev_nullify, d_base_onelev_get_nzeros, & - & d_base_onelev_clone, d_base_onelev_move_alloc + & d_base_onelev_clone, d_base_onelev_move_alloc, & + & d_base_onelev_get_wrksize @@ -498,7 +509,6 @@ contains end subroutine d_base_onelev_clone - subroutine d_base_onelev_move_alloc(lv, b,info) use psb_base_mod implicit none @@ -527,4 +537,41 @@ contains end subroutine d_base_onelev_move_alloc + + function d_base_onelev_get_wrksize(lv) result(val) + implicit none + class(mld_d_base_onelev_type), intent(inout) :: lv + integer(psb_ipk_) :: val + + val = 0 + ! SM and SM2A can share work vectors + if (allocated(lv%sm)) val = val + sm%get_wrksz() + if (allocated(lv%sm2a)) val = max(val,sm2a%get_wrksz()) + ! + ! Now for the ML application itself + ! + ! We have VTX/VTY/VX2L/VY2L + ! + val = val + 4 + ! + ! plus some additions for specific ML/cycles + ! + select case(lv%parms%ml_cycle) + case(mld_add_ml_,mld_mult_ml_,mld_vcycle_ml_, mld_wcycle_ml_) + ! We're good + + case(mld_kcycle_ml_, mld_kcyclesym_ml_) + ! + ! We need 7 in inneritkcycle, but we can reuse vtx + ! + val = val + 6 + + case default + ! Need a better error signaling ? + val = -1 + end select + + end function d_base_onelev_get_wrksize + + end module mld_d_onelev_mod diff --git a/mlprec/mld_d_prec_type.f90 b/mlprec/mld_d_prec_type.f90 index 64b74187..7cb2ff75 100644 --- a/mlprec/mld_d_prec_type.f90 +++ b/mlprec/mld_d_prec_type.f90 @@ -80,12 +80,6 @@ module mld_d_prec_type ! order, with level 0 being the id of the coarsest level. ! ! - - type mld_dmlprec_wrk_type - real(psb_dpk_), allocatable :: tx(:), ty(:), x2l(:), y2l(:) - type(psb_d_vect_type) :: vtx, vty, vx2l, vy2l - type(psb_d_vect_type), allocatable :: wv(:) - end type mld_dmlprec_wrk_type integer, parameter, private :: wv_size_=4 type, extends(psb_dprec_type) :: mld_dprec_type diff --git a/mlprec/mld_s_as_smoother.f90 b/mlprec/mld_s_as_smoother.f90 index 437af7d0..e800c279 100644 --- a/mlprec/mld_s_as_smoother.f90 +++ b/mlprec/mld_s_as_smoother.f90 @@ -91,6 +91,7 @@ module mld_s_as_smoother procedure, pass(sm) :: sizeof => s_as_smoother_sizeof procedure, pass(sm) :: default => s_as_smoother_default procedure, pass(sm) :: get_nzeros => s_as_smoother_get_nzeros + procedure, pass(sm) :: get_wrksz => s_as_smoother_get_wrksize procedure, nopass :: get_fmt => s_as_smoother_get_fmt procedure, nopass :: get_id => s_as_smoother_get_id end type mld_s_as_smoother_type @@ -98,7 +99,8 @@ module mld_s_as_smoother private :: s_as_smoother_descr, s_as_smoother_sizeof, & & s_as_smoother_default, s_as_smoother_get_nzeros, & - & s_as_smoother_get_fmt, s_as_smoother_get_id + & s_as_smoother_get_fmt, s_as_smoother_get_id, & + & s_as_smoother_get_wrksize character(len=6), parameter, private :: & & restrict_names(0:4)=(/'none ','halo ',' ',' ',' '/) @@ -458,6 +460,16 @@ contains end subroutine s_as_smoother_descr + function s_as_smoother_get_wrksize(sm) result(val) + implicit none + class(mld_s_as_smoother_type), intent(inout) :: sm + integer(psb_ipk_) :: val + + val = 3 + if (allocated(sm%sv)) val = val + sm%sv%get_wrksz() + + end function s_as_smoother_get_wrksize + function s_as_smoother_get_fmt() result(val) implicit none character(len=32) :: val diff --git a/mlprec/mld_s_base_smoother_mod.f90 b/mlprec/mld_s_base_smoother_mod.f90 index b8aa11e8..b5cb6020 100644 --- a/mlprec/mld_s_base_smoother_mod.f90 +++ b/mlprec/mld_s_base_smoother_mod.f90 @@ -92,6 +92,10 @@ module mld_s_base_smoother_mod ! check - Sanity checks. ! sizeof - Total memory occupation in bytes ! get_nzeros - Number of nonzeros + ! stringval - convert string to val for internal parms + ! get_fmt - short string descriptor + ! get_id - numeric id descriptro + ! get_wrksz - How many workspace vector does apply_vect need ! ! ! @@ -119,6 +123,7 @@ module mld_s_base_smoother_mod procedure, pass(sm) :: descr => mld_s_base_smoother_descr procedure, pass(sm) :: sizeof => s_base_smoother_sizeof procedure, pass(sm) :: get_nzeros => s_base_smoother_get_nzeros + procedure, pass(sm) :: get_wrksz => s_base_smoother_get_wrksize procedure, nopass :: stringval => mld_stringval procedure, nopass :: get_fmt => s_base_smoother_get_fmt procedure, nopass :: get_id => s_base_smoother_get_id @@ -127,7 +132,7 @@ module mld_s_base_smoother_mod private :: s_base_smoother_sizeof, s_base_smoother_get_fmt, & & s_base_smoother_default, s_base_smoother_get_nzeros, & - & s_base_smoother_get_id + & s_base_smoother_get_id, s_base_smoother_get_wrksize @@ -387,6 +392,16 @@ contains return end subroutine s_base_smoother_default + function s_base_smoother_get_wrksize(sm) result(val) + implicit none + class(mld_s_base_smoother_type), intent(inout) :: sm + integer(psb_ipk_) :: val + + val = 0 + if (allocated(sm%sv)) val = val + sm%sv%get_wrksz() + + end function s_base_smoother_get_wrksize + function s_base_smoother_get_fmt() result(val) implicit none character(len=32) :: val diff --git a/mlprec/mld_s_base_solver_mod.f90 b/mlprec/mld_s_base_solver_mod.f90 index 3feb4fc1..ebec407f 100644 --- a/mlprec/mld_s_base_solver_mod.f90 +++ b/mlprec/mld_s_base_solver_mod.f90 @@ -78,7 +78,10 @@ module mld_s_base_solver_mod ! check - Sanity checks. ! sizeof - Total memory occupation in bytes ! get_nzeros - Number of nonzeros - ! + ! stringval - convert string to val for internal parms + ! get_fmt - short string descriptor + ! get_id - numeric id descriptro + ! get_wrksz - How many workspace vector does apply_vect need ! ! @@ -104,6 +107,7 @@ module mld_s_base_solver_mod procedure, pass(sv) :: descr => mld_s_base_solver_descr procedure, pass(sv) :: sizeof => s_base_solver_sizeof procedure, pass(sv) :: get_nzeros => s_base_solver_get_nzeros + procedure, nopass :: get_wrksz => s_base_solver_get_wrksize procedure, nopass :: stringval => mld_stringval procedure, nopass :: get_fmt => s_base_solver_get_fmt procedure, nopass :: get_id => s_base_solver_get_id @@ -112,7 +116,8 @@ module mld_s_base_solver_mod private :: s_base_solver_sizeof, s_base_solver_default,& & s_base_solver_get_nzeros, s_base_solver_get_fmt, & - & s_base_solver_is_iterative, s_base_solver_get_id + & s_base_solver_is_iterative, s_base_solver_get_id, & + & s_base_solver_get_wrksize interface @@ -411,5 +416,11 @@ contains val = mld_f_none_ end function s_base_solver_get_id + function s_base_solver_get_wrksize() result(val) + implicit none + integer(psb_ipk_) :: val + + val = 0 + end function s_base_solver_get_wrksize end module mld_s_base_solver_mod diff --git a/mlprec/mld_s_gs_solver.f90 b/mlprec/mld_s_gs_solver.f90 index da7dc29e..b3619ebf 100644 --- a/mlprec/mld_s_gs_solver.f90 +++ b/mlprec/mld_s_gs_solver.f90 @@ -77,6 +77,7 @@ module mld_s_gs_solver procedure, pass(sv) :: default => s_gs_solver_default procedure, pass(sv) :: sizeof => s_gs_solver_sizeof procedure, pass(sv) :: get_nzeros => s_gs_solver_get_nzeros + procedure, nopass :: get_wrksz => s_gs_solver_get_wrksize procedure, nopass :: get_fmt => s_gs_solver_get_fmt procedure, nopass :: get_id => s_gs_solver_get_id procedure, nopass :: is_iterative => s_gs_solver_is_iterative @@ -102,7 +103,7 @@ module mld_s_gs_solver & s_gs_solver_get_fmt, s_gs_solver_check,& & s_gs_solver_is_iterative, & & s_bwgs_solver_get_fmt, s_bwgs_solver_descr, & - & s_gs_solver_get_id, s_bwgs_solver_get_id + & s_gs_solver_get_id, s_bwgs_solver_get_id, s_gs_solver_get_wrksize interface subroutine mld_s_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,& @@ -642,4 +643,11 @@ contains val = mld_bwgs_ end function s_bwgs_solver_get_id + function s_gs_solver_get_wrksize() result(val) + implicit none + integer(psb_ipk_) :: val + + val = 2 + end function s_gs_solver_get_wrksize + end module mld_s_gs_solver diff --git a/mlprec/mld_s_ilu_solver.f90 b/mlprec/mld_s_ilu_solver.f90 index 96128069..8c93fa8d 100644 --- a/mlprec/mld_s_ilu_solver.f90 +++ b/mlprec/mld_s_ilu_solver.f90 @@ -85,6 +85,7 @@ module mld_s_ilu_solver procedure, pass(sv) :: default => s_ilu_solver_default procedure, pass(sv) :: sizeof => s_ilu_solver_sizeof procedure, pass(sv) :: get_nzeros => s_ilu_solver_get_nzeros + procedure, nopass :: get_wrksz => s_ilu_solver_get_wrksize procedure, nopass :: get_fmt => s_ilu_solver_get_fmt procedure, nopass :: get_id => s_ilu_solver_get_id end type mld_s_ilu_solver_type @@ -96,7 +97,8 @@ module mld_s_ilu_solver & s_ilu_solver_descr, s_ilu_solver_sizeof, & & s_ilu_solver_default, s_ilu_solver_dmp, & & s_ilu_solver_apply_vect, s_ilu_solver_get_nzeros, & - & s_ilu_solver_get_fmt, s_ilu_solver_check, s_ilu_solver_get_id + & s_ilu_solver_get_fmt, s_ilu_solver_check, & + & s_ilu_solver_get_id, s_ilu_solver_get_wrksize interface @@ -554,5 +556,12 @@ contains val = mld_ilu_n_ end function s_ilu_solver_get_id + + function s_ilu_solver_get_wrksize() result(val) + implicit none + integer(psb_ipk_) :: val + + val = 2 + end function s_ilu_solver_get_wrksize end module mld_s_ilu_solver diff --git a/mlprec/mld_s_jac_smoother.f90 b/mlprec/mld_s_jac_smoother.f90 index ff8704bd..ccb7d896 100644 --- a/mlprec/mld_s_jac_smoother.f90 +++ b/mlprec/mld_s_jac_smoother.f90 @@ -71,6 +71,7 @@ module mld_s_jac_smoother procedure, pass(sm) :: descr => mld_s_jac_smoother_descr procedure, pass(sm) :: sizeof => s_jac_smoother_sizeof procedure, pass(sm) :: get_nzeros => s_jac_smoother_get_nzeros + procedure, pass(sm) :: get_wrksz => s_jac_smoother_get_wrksize procedure, nopass :: get_fmt => s_jac_smoother_get_fmt procedure, nopass :: get_id => s_jac_smoother_get_id end type mld_s_jac_smoother_type @@ -78,7 +79,8 @@ module mld_s_jac_smoother private :: s_jac_smoother_free, s_jac_smoother_descr, & & s_jac_smoother_sizeof, s_jac_smoother_get_nzeros, & - & s_jac_smoother_get_fmt, s_jac_smoother_get_id + & s_jac_smoother_get_fmt, s_jac_smoother_get_id, & + & s_jac_smoother_get_wrksize interface @@ -253,6 +255,16 @@ contains return end function s_jac_smoother_get_nzeros + function s_jac_smoother_get_wrksize(sm) result(val) + implicit none + class(mld_s_jac_smoother_type), intent(inout) :: sm + integer(psb_ipk_) :: val + + val = 2 + if (allocated(sm%sv)) val = val + sm%sv%get_wrksz() + + end function s_jac_smoother_get_wrksize + function s_jac_smoother_get_fmt() result(val) implicit none character(len=32) :: val diff --git a/mlprec/mld_s_onelev_mod.f90 b/mlprec/mld_s_onelev_mod.f90 index b5f630a0..df8b78b2 100644 --- a/mlprec/mld_s_onelev_mod.f90 +++ b/mlprec/mld_s_onelev_mod.f90 @@ -117,11 +117,20 @@ module mld_s_onelev_mod ! check - Sanity checks. ! sizeof - Total memory occupation in bytes ! get_nzeros - Number of nonzeros + ! get_wrksz - How many workspace vector does apply_vect need ! - ! + ! + type mld_smlprec_wrk_type + real(psb_spk_), allocatable :: tx(:), ty(:), x2l(:), y2l(:) + type(psb_s_vect_type) :: vtx, vty, vx2l, vy2l + integer(psb_ipk_) :: wvsz = 0 + type(psb_s_vect_type), allocatable :: wv(:) + end type mld_smlprec_wrk_type + type mld_s_onelev_type class(mld_s_base_smoother_type), allocatable :: sm, sm2a class(mld_s_base_smoother_type), pointer :: sm2 => null() + type(mld_smlprec_wrk_type) :: wrk type(mld_sml_parms) :: parms type(psb_sspmat_type) :: ac integer(psb_ipk_) :: ac_nz_loc, ac_nz_tot @@ -153,6 +162,7 @@ module mld_s_onelev_mod & cseti, csetr, csetc, setsm, setsv procedure, pass(lv) :: sizeof => s_base_onelev_sizeof procedure, pass(lv) :: get_nzeros => s_base_onelev_get_nzeros + procedure, pass(lv) :: get_wrksz => s_base_onelev_get_wrksize procedure, nopass :: stringval => mld_stringval procedure, pass(lv) :: move_alloc => s_base_onelev_move_alloc end type mld_s_onelev_type @@ -164,7 +174,8 @@ module mld_s_onelev_mod private :: s_base_onelev_default, s_base_onelev_sizeof, & & s_base_onelev_nullify, s_base_onelev_get_nzeros, & - & s_base_onelev_clone, s_base_onelev_move_alloc + & s_base_onelev_clone, s_base_onelev_move_alloc, & + & s_base_onelev_get_wrksize @@ -498,7 +509,6 @@ contains end subroutine s_base_onelev_clone - subroutine s_base_onelev_move_alloc(lv, b,info) use psb_base_mod implicit none @@ -527,4 +537,41 @@ contains end subroutine s_base_onelev_move_alloc + + function s_base_onelev_get_wrksize(lv) result(val) + implicit none + class(mld_s_base_onelev_type), intent(inout) :: lv + integer(psb_ipk_) :: val + + val = 0 + ! SM and SM2A can share work vectors + if (allocated(lv%sm)) val = val + sm%get_wrksz() + if (allocated(lv%sm2a)) val = max(val,sm2a%get_wrksz()) + ! + ! Now for the ML application itself + ! + ! We have VTX/VTY/VX2L/VY2L + ! + val = val + 4 + ! + ! plus some additions for specific ML/cycles + ! + select case(lv%parms%ml_cycle) + case(mld_add_ml_,mld_mult_ml_,mld_vcycle_ml_, mld_wcycle_ml_) + ! We're good + + case(mld_kcycle_ml_, mld_kcyclesym_ml_) + ! + ! We need 7 in inneritkcycle, but we can reuse vtx + ! + val = val + 6 + + case default + ! Need a better error signaling ? + val = -1 + end select + + end function s_base_onelev_get_wrksize + + end module mld_s_onelev_mod diff --git a/mlprec/mld_s_prec_type.f90 b/mlprec/mld_s_prec_type.f90 index 1cfd35c7..59145790 100644 --- a/mlprec/mld_s_prec_type.f90 +++ b/mlprec/mld_s_prec_type.f90 @@ -80,12 +80,6 @@ module mld_s_prec_type ! order, with level 0 being the id of the coarsest level. ! ! - - type mld_smlprec_wrk_type - real(psb_spk_), allocatable :: tx(:), ty(:), x2l(:), y2l(:) - type(psb_s_vect_type) :: vtx, vty, vx2l, vy2l - type(psb_s_vect_type), allocatable :: wv(:) - end type mld_smlprec_wrk_type integer, parameter, private :: wv_size_=4 type, extends(psb_sprec_type) :: mld_sprec_type diff --git a/mlprec/mld_z_as_smoother.f90 b/mlprec/mld_z_as_smoother.f90 index a7fba9eb..468026c3 100644 --- a/mlprec/mld_z_as_smoother.f90 +++ b/mlprec/mld_z_as_smoother.f90 @@ -91,6 +91,7 @@ module mld_z_as_smoother procedure, pass(sm) :: sizeof => z_as_smoother_sizeof procedure, pass(sm) :: default => z_as_smoother_default procedure, pass(sm) :: get_nzeros => z_as_smoother_get_nzeros + procedure, pass(sm) :: get_wrksz => z_as_smoother_get_wrksize procedure, nopass :: get_fmt => z_as_smoother_get_fmt procedure, nopass :: get_id => z_as_smoother_get_id end type mld_z_as_smoother_type @@ -98,7 +99,8 @@ module mld_z_as_smoother private :: z_as_smoother_descr, z_as_smoother_sizeof, & & z_as_smoother_default, z_as_smoother_get_nzeros, & - & z_as_smoother_get_fmt, z_as_smoother_get_id + & z_as_smoother_get_fmt, z_as_smoother_get_id, & + & z_as_smoother_get_wrksize character(len=6), parameter, private :: & & restrict_names(0:4)=(/'none ','halo ',' ',' ',' '/) @@ -458,6 +460,16 @@ contains end subroutine z_as_smoother_descr + function z_as_smoother_get_wrksize(sm) result(val) + implicit none + class(mld_z_as_smoother_type), intent(inout) :: sm + integer(psb_ipk_) :: val + + val = 3 + if (allocated(sm%sv)) val = val + sm%sv%get_wrksz() + + end function z_as_smoother_get_wrksize + function z_as_smoother_get_fmt() result(val) implicit none character(len=32) :: val diff --git a/mlprec/mld_z_base_smoother_mod.f90 b/mlprec/mld_z_base_smoother_mod.f90 index 98b01657..9b607ecf 100644 --- a/mlprec/mld_z_base_smoother_mod.f90 +++ b/mlprec/mld_z_base_smoother_mod.f90 @@ -92,6 +92,10 @@ module mld_z_base_smoother_mod ! check - Sanity checks. ! sizeof - Total memory occupation in bytes ! get_nzeros - Number of nonzeros + ! stringval - convert string to val for internal parms + ! get_fmt - short string descriptor + ! get_id - numeric id descriptro + ! get_wrksz - How many workspace vector does apply_vect need ! ! ! @@ -119,6 +123,7 @@ module mld_z_base_smoother_mod procedure, pass(sm) :: descr => mld_z_base_smoother_descr procedure, pass(sm) :: sizeof => z_base_smoother_sizeof procedure, pass(sm) :: get_nzeros => z_base_smoother_get_nzeros + procedure, pass(sm) :: get_wrksz => z_base_smoother_get_wrksize procedure, nopass :: stringval => mld_stringval procedure, nopass :: get_fmt => z_base_smoother_get_fmt procedure, nopass :: get_id => z_base_smoother_get_id @@ -127,7 +132,7 @@ module mld_z_base_smoother_mod private :: z_base_smoother_sizeof, z_base_smoother_get_fmt, & & z_base_smoother_default, z_base_smoother_get_nzeros, & - & z_base_smoother_get_id + & z_base_smoother_get_id, z_base_smoother_get_wrksize @@ -387,6 +392,16 @@ contains return end subroutine z_base_smoother_default + function z_base_smoother_get_wrksize(sm) result(val) + implicit none + class(mld_z_base_smoother_type), intent(inout) :: sm + integer(psb_ipk_) :: val + + val = 0 + if (allocated(sm%sv)) val = val + sm%sv%get_wrksz() + + end function z_base_smoother_get_wrksize + function z_base_smoother_get_fmt() result(val) implicit none character(len=32) :: val diff --git a/mlprec/mld_z_base_solver_mod.f90 b/mlprec/mld_z_base_solver_mod.f90 index cde508d9..9a2b3836 100644 --- a/mlprec/mld_z_base_solver_mod.f90 +++ b/mlprec/mld_z_base_solver_mod.f90 @@ -78,7 +78,10 @@ module mld_z_base_solver_mod ! check - Sanity checks. ! sizeof - Total memory occupation in bytes ! get_nzeros - Number of nonzeros - ! + ! stringval - convert string to val for internal parms + ! get_fmt - short string descriptor + ! get_id - numeric id descriptro + ! get_wrksz - How many workspace vector does apply_vect need ! ! @@ -104,6 +107,7 @@ module mld_z_base_solver_mod procedure, pass(sv) :: descr => mld_z_base_solver_descr procedure, pass(sv) :: sizeof => z_base_solver_sizeof procedure, pass(sv) :: get_nzeros => z_base_solver_get_nzeros + procedure, nopass :: get_wrksz => z_base_solver_get_wrksize procedure, nopass :: stringval => mld_stringval procedure, nopass :: get_fmt => z_base_solver_get_fmt procedure, nopass :: get_id => z_base_solver_get_id @@ -112,7 +116,8 @@ module mld_z_base_solver_mod private :: z_base_solver_sizeof, z_base_solver_default,& & z_base_solver_get_nzeros, z_base_solver_get_fmt, & - & z_base_solver_is_iterative, z_base_solver_get_id + & z_base_solver_is_iterative, z_base_solver_get_id, & + & z_base_solver_get_wrksize interface @@ -411,5 +416,11 @@ contains val = mld_f_none_ end function z_base_solver_get_id + function z_base_solver_get_wrksize() result(val) + implicit none + integer(psb_ipk_) :: val + + val = 0 + end function z_base_solver_get_wrksize end module mld_z_base_solver_mod diff --git a/mlprec/mld_z_gs_solver.f90 b/mlprec/mld_z_gs_solver.f90 index 6f408797..de494bfa 100644 --- a/mlprec/mld_z_gs_solver.f90 +++ b/mlprec/mld_z_gs_solver.f90 @@ -77,6 +77,7 @@ module mld_z_gs_solver procedure, pass(sv) :: default => z_gs_solver_default procedure, pass(sv) :: sizeof => z_gs_solver_sizeof procedure, pass(sv) :: get_nzeros => z_gs_solver_get_nzeros + procedure, nopass :: get_wrksz => z_gs_solver_get_wrksize procedure, nopass :: get_fmt => z_gs_solver_get_fmt procedure, nopass :: get_id => z_gs_solver_get_id procedure, nopass :: is_iterative => z_gs_solver_is_iterative @@ -102,7 +103,7 @@ module mld_z_gs_solver & z_gs_solver_get_fmt, z_gs_solver_check,& & z_gs_solver_is_iterative, & & z_bwgs_solver_get_fmt, z_bwgs_solver_descr, & - & z_gs_solver_get_id, z_bwgs_solver_get_id + & z_gs_solver_get_id, z_bwgs_solver_get_id, z_gs_solver_get_wrksize interface subroutine mld_z_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,& @@ -642,4 +643,11 @@ contains val = mld_bwgs_ end function z_bwgs_solver_get_id + function z_gs_solver_get_wrksize() result(val) + implicit none + integer(psb_ipk_) :: val + + val = 2 + end function z_gs_solver_get_wrksize + end module mld_z_gs_solver diff --git a/mlprec/mld_z_ilu_solver.f90 b/mlprec/mld_z_ilu_solver.f90 index 2fba0b53..c9635860 100644 --- a/mlprec/mld_z_ilu_solver.f90 +++ b/mlprec/mld_z_ilu_solver.f90 @@ -85,6 +85,7 @@ module mld_z_ilu_solver procedure, pass(sv) :: default => z_ilu_solver_default procedure, pass(sv) :: sizeof => z_ilu_solver_sizeof procedure, pass(sv) :: get_nzeros => z_ilu_solver_get_nzeros + procedure, nopass :: get_wrksz => z_ilu_solver_get_wrksize procedure, nopass :: get_fmt => z_ilu_solver_get_fmt procedure, nopass :: get_id => z_ilu_solver_get_id end type mld_z_ilu_solver_type @@ -96,7 +97,8 @@ module mld_z_ilu_solver & z_ilu_solver_descr, z_ilu_solver_sizeof, & & z_ilu_solver_default, z_ilu_solver_dmp, & & z_ilu_solver_apply_vect, z_ilu_solver_get_nzeros, & - & z_ilu_solver_get_fmt, z_ilu_solver_check, z_ilu_solver_get_id + & z_ilu_solver_get_fmt, z_ilu_solver_check, & + & z_ilu_solver_get_id, z_ilu_solver_get_wrksize interface @@ -554,5 +556,12 @@ contains val = mld_ilu_n_ end function z_ilu_solver_get_id + + function z_ilu_solver_get_wrksize() result(val) + implicit none + integer(psb_ipk_) :: val + + val = 2 + end function z_ilu_solver_get_wrksize end module mld_z_ilu_solver diff --git a/mlprec/mld_z_jac_smoother.f90 b/mlprec/mld_z_jac_smoother.f90 index 1e6146a7..08cf38f3 100644 --- a/mlprec/mld_z_jac_smoother.f90 +++ b/mlprec/mld_z_jac_smoother.f90 @@ -71,6 +71,7 @@ module mld_z_jac_smoother procedure, pass(sm) :: descr => mld_z_jac_smoother_descr procedure, pass(sm) :: sizeof => z_jac_smoother_sizeof procedure, pass(sm) :: get_nzeros => z_jac_smoother_get_nzeros + procedure, pass(sm) :: get_wrksz => z_jac_smoother_get_wrksize procedure, nopass :: get_fmt => z_jac_smoother_get_fmt procedure, nopass :: get_id => z_jac_smoother_get_id end type mld_z_jac_smoother_type @@ -78,7 +79,8 @@ module mld_z_jac_smoother private :: z_jac_smoother_free, z_jac_smoother_descr, & & z_jac_smoother_sizeof, z_jac_smoother_get_nzeros, & - & z_jac_smoother_get_fmt, z_jac_smoother_get_id + & z_jac_smoother_get_fmt, z_jac_smoother_get_id, & + & z_jac_smoother_get_wrksize interface @@ -253,6 +255,16 @@ contains return end function z_jac_smoother_get_nzeros + function z_jac_smoother_get_wrksize(sm) result(val) + implicit none + class(mld_z_jac_smoother_type), intent(inout) :: sm + integer(psb_ipk_) :: val + + val = 2 + if (allocated(sm%sv)) val = val + sm%sv%get_wrksz() + + end function z_jac_smoother_get_wrksize + function z_jac_smoother_get_fmt() result(val) implicit none character(len=32) :: val diff --git a/mlprec/mld_z_onelev_mod.f90 b/mlprec/mld_z_onelev_mod.f90 index 54be4ab0..4fe7351a 100644 --- a/mlprec/mld_z_onelev_mod.f90 +++ b/mlprec/mld_z_onelev_mod.f90 @@ -117,11 +117,20 @@ module mld_z_onelev_mod ! check - Sanity checks. ! sizeof - Total memory occupation in bytes ! get_nzeros - Number of nonzeros + ! get_wrksz - How many workspace vector does apply_vect need ! - ! + ! + type mld_zmlprec_wrk_type + complex(psb_dpk_), allocatable :: tx(:), ty(:), x2l(:), y2l(:) + type(psb_z_vect_type) :: vtx, vty, vx2l, vy2l + integer(psb_ipk_) :: wvsz = 0 + type(psb_z_vect_type), allocatable :: wv(:) + end type mld_zmlprec_wrk_type + type mld_z_onelev_type class(mld_z_base_smoother_type), allocatable :: sm, sm2a class(mld_z_base_smoother_type), pointer :: sm2 => null() + type(mld_zmlprec_wrk_type) :: wrk type(mld_dml_parms) :: parms type(psb_zspmat_type) :: ac integer(psb_ipk_) :: ac_nz_loc, ac_nz_tot @@ -153,6 +162,7 @@ module mld_z_onelev_mod & cseti, csetr, csetc, setsm, setsv procedure, pass(lv) :: sizeof => z_base_onelev_sizeof procedure, pass(lv) :: get_nzeros => z_base_onelev_get_nzeros + procedure, pass(lv) :: get_wrksz => z_base_onelev_get_wrksize procedure, nopass :: stringval => mld_stringval procedure, pass(lv) :: move_alloc => z_base_onelev_move_alloc end type mld_z_onelev_type @@ -164,7 +174,8 @@ module mld_z_onelev_mod private :: z_base_onelev_default, z_base_onelev_sizeof, & & z_base_onelev_nullify, z_base_onelev_get_nzeros, & - & z_base_onelev_clone, z_base_onelev_move_alloc + & z_base_onelev_clone, z_base_onelev_move_alloc, & + & z_base_onelev_get_wrksize @@ -498,7 +509,6 @@ contains end subroutine z_base_onelev_clone - subroutine z_base_onelev_move_alloc(lv, b,info) use psb_base_mod implicit none @@ -527,4 +537,41 @@ contains end subroutine z_base_onelev_move_alloc + + function z_base_onelev_get_wrksize(lv) result(val) + implicit none + class(mld_z_base_onelev_type), intent(inout) :: lv + integer(psb_ipk_) :: val + + val = 0 + ! SM and SM2A can share work vectors + if (allocated(lv%sm)) val = val + sm%get_wrksz() + if (allocated(lv%sm2a)) val = max(val,sm2a%get_wrksz()) + ! + ! Now for the ML application itself + ! + ! We have VTX/VTY/VX2L/VY2L + ! + val = val + 4 + ! + ! plus some additions for specific ML/cycles + ! + select case(lv%parms%ml_cycle) + case(mld_add_ml_,mld_mult_ml_,mld_vcycle_ml_, mld_wcycle_ml_) + ! We're good + + case(mld_kcycle_ml_, mld_kcyclesym_ml_) + ! + ! We need 7 in inneritkcycle, but we can reuse vtx + ! + val = val + 6 + + case default + ! Need a better error signaling ? + val = -1 + end select + + end function z_base_onelev_get_wrksize + + end module mld_z_onelev_mod diff --git a/mlprec/mld_z_prec_type.f90 b/mlprec/mld_z_prec_type.f90 index aa06cf25..1728a1b3 100644 --- a/mlprec/mld_z_prec_type.f90 +++ b/mlprec/mld_z_prec_type.f90 @@ -80,12 +80,6 @@ module mld_z_prec_type ! order, with level 0 being the id of the coarsest level. ! ! - - type mld_zmlprec_wrk_type - complex(psb_dpk_), allocatable :: tx(:), ty(:), x2l(:), y2l(:) - type(psb_z_vect_type) :: vtx, vty, vx2l, vy2l - type(psb_z_vect_type), allocatable :: wv(:) - end type mld_zmlprec_wrk_type integer, parameter, private :: wv_size_=4 type, extends(psb_zprec_type) :: mld_zprec_type