From 08040c455b462881036c1d84ec08c40b2b63ff85 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Fri, 8 Dec 2017 10:19:26 +0000 Subject: [PATCH] Added level%allocate_wrk. Fix wrksize calculation. --- mlprec/mld_c_onelev_mod.f90 | 35 ++++++++++++++++++++++++++++++----- mlprec/mld_c_prec_type.f90 | 2 ++ mlprec/mld_d_onelev_mod.f90 | 35 ++++++++++++++++++++++++++++++----- mlprec/mld_d_prec_type.f90 | 2 ++ mlprec/mld_s_onelev_mod.f90 | 35 ++++++++++++++++++++++++++++++----- mlprec/mld_s_prec_type.f90 | 2 ++ mlprec/mld_z_onelev_mod.f90 | 35 ++++++++++++++++++++++++++++++----- mlprec/mld_z_prec_type.f90 | 2 ++ 8 files changed, 128 insertions(+), 20 deletions(-) diff --git a/mlprec/mld_c_onelev_mod.f90 b/mlprec/mld_c_onelev_mod.f90 index f19ce582..d42b2b0e 100644 --- a/mlprec/mld_c_onelev_mod.f90 +++ b/mlprec/mld_c_onelev_mod.f90 @@ -163,6 +163,8 @@ module mld_c_onelev_mod 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, pass(lv) :: allocate_wrk => c_base_onelev_allocate_wrk + procedure, pass(lv) :: free_wrk => c_base_onelev_free_wrk procedure, nopass :: stringval => mld_stringval procedure, pass(lv) :: move_alloc => c_base_onelev_move_alloc end type mld_c_onelev_type @@ -175,7 +177,7 @@ 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_get_wrksize + & c_base_onelev_get_wrksize, c_base_onelev_allocate_wrk, c_base_onelev_free_wrk @@ -540,13 +542,13 @@ contains function c_base_onelev_get_wrksize(lv) result(val) implicit none - class(mld_c_base_onelev_type), intent(inout) :: lv + class(mld_c_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()) + if (allocated(lv%sm)) val = val + lv%sm%get_wrksz() + if (allocated(lv%sm2a)) val = max(val,lv%sm2a%get_wrksz()) ! ! Now for the ML application itself ! @@ -572,6 +574,29 @@ contains end select end function c_base_onelev_get_wrksize + + subroutine c_base_onelev_allocate_wrk(lv,info,vmold) + use psb_base_mod + implicit none + class(mld_c_onelev_type), target, intent(inout) :: lv + integer(psb_ipk_), intent(out) :: info + class(psb_c_base_vect_type), intent(in), optional :: vmold + ! + integer(psb_ipk_) :: nwv + info = psb_success_ + nwv = lv%get_wrksz() + write(0,*) 'Debug allocate_wrk: ',nwv + end subroutine c_base_onelev_allocate_wrk + - + subroutine c_base_onelev_free_wrk(lv,info) + use psb_base_mod + implicit none + class(mld_c_onelev_type), target, intent(inout) :: lv + integer(psb_ipk_), intent(out) :: info + ! + integer(psb_ipk_) :: nwv + info = psb_success_ + end subroutine c_base_onelev_free_wrk + end module mld_c_onelev_mod diff --git a/mlprec/mld_c_prec_type.f90 b/mlprec/mld_c_prec_type.f90 index 092fe9ad..2ebdbc1c 100644 --- a/mlprec/mld_c_prec_type.f90 +++ b/mlprec/mld_c_prec_type.f90 @@ -851,6 +851,7 @@ contains end if level = 1 do level = 1, nlev + call prec%precv(level)%allocate_wrk(info,vmold=vmold) call psb_geasb(prec%wrk(level)%vx2l,& & prec%precv(level)%base_desc,info,& & scratch=.true.,mold=vmold) @@ -909,6 +910,7 @@ contains nlev = size(prec%wrk) do level = 1, nlev + call prec%precv(level)%free_wrk(info) !write(0,*) 'Free at level ',level,': x2,y2,tx,ty' call prec%wrk(level)%vx2l%free(info) call prec%wrk(level)%vy2l%free(info) diff --git a/mlprec/mld_d_onelev_mod.f90 b/mlprec/mld_d_onelev_mod.f90 index 23c35311..bb6ae569 100644 --- a/mlprec/mld_d_onelev_mod.f90 +++ b/mlprec/mld_d_onelev_mod.f90 @@ -163,6 +163,8 @@ module mld_d_onelev_mod 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, pass(lv) :: allocate_wrk => d_base_onelev_allocate_wrk + procedure, pass(lv) :: free_wrk => d_base_onelev_free_wrk procedure, nopass :: stringval => mld_stringval procedure, pass(lv) :: move_alloc => d_base_onelev_move_alloc end type mld_d_onelev_type @@ -175,7 +177,7 @@ 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_get_wrksize + & d_base_onelev_get_wrksize, d_base_onelev_allocate_wrk, d_base_onelev_free_wrk @@ -540,13 +542,13 @@ contains function d_base_onelev_get_wrksize(lv) result(val) implicit none - class(mld_d_base_onelev_type), intent(inout) :: lv + class(mld_d_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()) + if (allocated(lv%sm)) val = val + lv%sm%get_wrksz() + if (allocated(lv%sm2a)) val = max(val,lv%sm2a%get_wrksz()) ! ! Now for the ML application itself ! @@ -572,6 +574,29 @@ contains end select end function d_base_onelev_get_wrksize + + subroutine d_base_onelev_allocate_wrk(lv,info,vmold) + use psb_base_mod + implicit none + class(mld_d_onelev_type), target, intent(inout) :: lv + integer(psb_ipk_), intent(out) :: info + class(psb_d_base_vect_type), intent(in), optional :: vmold + ! + integer(psb_ipk_) :: nwv + info = psb_success_ + nwv = lv%get_wrksz() + write(0,*) 'Debug allocate_wrk: ',nwv + end subroutine d_base_onelev_allocate_wrk + - + subroutine d_base_onelev_free_wrk(lv,info) + use psb_base_mod + implicit none + class(mld_d_onelev_type), target, intent(inout) :: lv + integer(psb_ipk_), intent(out) :: info + ! + integer(psb_ipk_) :: nwv + info = psb_success_ + end subroutine d_base_onelev_free_wrk + end module mld_d_onelev_mod diff --git a/mlprec/mld_d_prec_type.f90 b/mlprec/mld_d_prec_type.f90 index 7cb2ff75..aaefadfc 100644 --- a/mlprec/mld_d_prec_type.f90 +++ b/mlprec/mld_d_prec_type.f90 @@ -851,6 +851,7 @@ contains end if level = 1 do level = 1, nlev + call prec%precv(level)%allocate_wrk(info,vmold=vmold) call psb_geasb(prec%wrk(level)%vx2l,& & prec%precv(level)%base_desc,info,& & scratch=.true.,mold=vmold) @@ -909,6 +910,7 @@ contains nlev = size(prec%wrk) do level = 1, nlev + call prec%precv(level)%free_wrk(info) !write(0,*) 'Free at level ',level,': x2,y2,tx,ty' call prec%wrk(level)%vx2l%free(info) call prec%wrk(level)%vy2l%free(info) diff --git a/mlprec/mld_s_onelev_mod.f90 b/mlprec/mld_s_onelev_mod.f90 index df8b78b2..c81488ac 100644 --- a/mlprec/mld_s_onelev_mod.f90 +++ b/mlprec/mld_s_onelev_mod.f90 @@ -163,6 +163,8 @@ module mld_s_onelev_mod 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, pass(lv) :: allocate_wrk => s_base_onelev_allocate_wrk + procedure, pass(lv) :: free_wrk => s_base_onelev_free_wrk procedure, nopass :: stringval => mld_stringval procedure, pass(lv) :: move_alloc => s_base_onelev_move_alloc end type mld_s_onelev_type @@ -175,7 +177,7 @@ 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_get_wrksize + & s_base_onelev_get_wrksize, s_base_onelev_allocate_wrk, s_base_onelev_free_wrk @@ -540,13 +542,13 @@ contains function s_base_onelev_get_wrksize(lv) result(val) implicit none - class(mld_s_base_onelev_type), intent(inout) :: lv + class(mld_s_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()) + if (allocated(lv%sm)) val = val + lv%sm%get_wrksz() + if (allocated(lv%sm2a)) val = max(val,lv%sm2a%get_wrksz()) ! ! Now for the ML application itself ! @@ -572,6 +574,29 @@ contains end select end function s_base_onelev_get_wrksize + + subroutine s_base_onelev_allocate_wrk(lv,info,vmold) + use psb_base_mod + implicit none + class(mld_s_onelev_type), target, intent(inout) :: lv + integer(psb_ipk_), intent(out) :: info + class(psb_s_base_vect_type), intent(in), optional :: vmold + ! + integer(psb_ipk_) :: nwv + info = psb_success_ + nwv = lv%get_wrksz() + write(0,*) 'Debug allocate_wrk: ',nwv + end subroutine s_base_onelev_allocate_wrk + - + subroutine s_base_onelev_free_wrk(lv,info) + use psb_base_mod + implicit none + class(mld_s_onelev_type), target, intent(inout) :: lv + integer(psb_ipk_), intent(out) :: info + ! + integer(psb_ipk_) :: nwv + info = psb_success_ + end subroutine s_base_onelev_free_wrk + end module mld_s_onelev_mod diff --git a/mlprec/mld_s_prec_type.f90 b/mlprec/mld_s_prec_type.f90 index 59145790..9b1efb2e 100644 --- a/mlprec/mld_s_prec_type.f90 +++ b/mlprec/mld_s_prec_type.f90 @@ -851,6 +851,7 @@ contains end if level = 1 do level = 1, nlev + call prec%precv(level)%allocate_wrk(info,vmold=vmold) call psb_geasb(prec%wrk(level)%vx2l,& & prec%precv(level)%base_desc,info,& & scratch=.true.,mold=vmold) @@ -909,6 +910,7 @@ contains nlev = size(prec%wrk) do level = 1, nlev + call prec%precv(level)%free_wrk(info) !write(0,*) 'Free at level ',level,': x2,y2,tx,ty' call prec%wrk(level)%vx2l%free(info) call prec%wrk(level)%vy2l%free(info) diff --git a/mlprec/mld_z_onelev_mod.f90 b/mlprec/mld_z_onelev_mod.f90 index 4fe7351a..619c4053 100644 --- a/mlprec/mld_z_onelev_mod.f90 +++ b/mlprec/mld_z_onelev_mod.f90 @@ -163,6 +163,8 @@ module mld_z_onelev_mod 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, pass(lv) :: allocate_wrk => z_base_onelev_allocate_wrk + procedure, pass(lv) :: free_wrk => z_base_onelev_free_wrk procedure, nopass :: stringval => mld_stringval procedure, pass(lv) :: move_alloc => z_base_onelev_move_alloc end type mld_z_onelev_type @@ -175,7 +177,7 @@ 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_get_wrksize + & z_base_onelev_get_wrksize, z_base_onelev_allocate_wrk, z_base_onelev_free_wrk @@ -540,13 +542,13 @@ contains function z_base_onelev_get_wrksize(lv) result(val) implicit none - class(mld_z_base_onelev_type), intent(inout) :: lv + class(mld_z_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()) + if (allocated(lv%sm)) val = val + lv%sm%get_wrksz() + if (allocated(lv%sm2a)) val = max(val,lv%sm2a%get_wrksz()) ! ! Now for the ML application itself ! @@ -572,6 +574,29 @@ contains end select end function z_base_onelev_get_wrksize + + subroutine z_base_onelev_allocate_wrk(lv,info,vmold) + use psb_base_mod + implicit none + class(mld_z_onelev_type), target, intent(inout) :: lv + integer(psb_ipk_), intent(out) :: info + class(psb_z_base_vect_type), intent(in), optional :: vmold + ! + integer(psb_ipk_) :: nwv + info = psb_success_ + nwv = lv%get_wrksz() + write(0,*) 'Debug allocate_wrk: ',nwv + end subroutine z_base_onelev_allocate_wrk + - + subroutine z_base_onelev_free_wrk(lv,info) + use psb_base_mod + implicit none + class(mld_z_onelev_type), target, intent(inout) :: lv + integer(psb_ipk_), intent(out) :: info + ! + integer(psb_ipk_) :: nwv + info = psb_success_ + end subroutine z_base_onelev_free_wrk + end module mld_z_onelev_mod diff --git a/mlprec/mld_z_prec_type.f90 b/mlprec/mld_z_prec_type.f90 index 1728a1b3..d5662f15 100644 --- a/mlprec/mld_z_prec_type.f90 +++ b/mlprec/mld_z_prec_type.f90 @@ -851,6 +851,7 @@ contains end if level = 1 do level = 1, nlev + call prec%precv(level)%allocate_wrk(info,vmold=vmold) call psb_geasb(prec%wrk(level)%vx2l,& & prec%precv(level)%base_desc,info,& & scratch=.true.,mold=vmold) @@ -909,6 +910,7 @@ contains nlev = size(prec%wrk) do level = 1, nlev + call prec%precv(level)%free_wrk(info) !write(0,*) 'Free at level ',level,': x2,y2,tx,ty' call prec%wrk(level)%vx2l%free(info) call prec%wrk(level)%vy2l%free(info)