From cfc6255040790cac35380a158ffb93862a891224 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Wed, 2 Oct 2013 08:24:01 +0000 Subject: [PATCH] psblas3: base/modules/psb_desc_mod.F90 base/tools/psb_glob_to_loc.f90 test/pargen/ppde2d.f90 test/pargen/ppde3d.f90 test/pargen/spde2d.f90 test/pargen/spde3d.f90 New get_fmt, g2l, l2g methods in desc_type. --- base/modules/psb_desc_mod.F90 | 525 ++++++++++++++++++++++++++++++++- base/tools/psb_glob_to_loc.f90 | 2 - test/pargen/ppde2d.f90 | 2 +- test/pargen/ppde3d.f90 | 2 +- test/pargen/spde2d.f90 | 2 +- test/pargen/spde3d.f90 | 2 +- 6 files changed, 528 insertions(+), 7 deletions(-) diff --git a/base/modules/psb_desc_mod.F90 b/base/modules/psb_desc_mod.F90 index 4878e59e..de8020ef 100644 --- a/base/modules/psb_desc_mod.F90 +++ b/base/modules/psb_desc_mod.F90 @@ -231,6 +231,29 @@ module psb_desc_mod procedure, pass(desc) :: destroy => psb_cd_destroy procedure, pass(desc) :: nullify => nullify_desc + procedure, pass(desc) :: get_fmt => cd_get_fmt + procedure, pass(desc) :: l2gs1 => cd_l2gs1 + procedure, pass(desc) :: l2gs2 => cd_l2gs2 + procedure, pass(desc) :: l2gv1 => cd_l2gv1 + procedure, pass(desc) :: l2gv2 => cd_l2gv2 + generic, public :: l2g => l2gs2, l2gv2 + generic, public :: l2gip => l2gs1, l2gv1 + + procedure, pass(desc) :: g2ls1 => cd_g2ls1 + procedure, pass(desc) :: g2ls2 => cd_g2ls2 + procedure, pass(desc) :: g2lv1 => cd_g2lv1 + procedure, pass(desc) :: g2lv2 => cd_g2lv2 + generic, public :: g2l => g2ls2, g2lv2 + generic, public :: g2lip => g2ls1, g2lv1 + + procedure, pass(desc) :: g2ls1_ins => cd_g2ls1_ins + procedure, pass(desc) :: g2ls2_ins => cd_g2ls2_ins + procedure, pass(desc) :: g2lv1_ins => cd_g2lv1_ins + procedure, pass(desc) :: g2lv2_ins => cd_g2lv2_ins + generic, public :: g2l_ins => g2ls2_ins, g2lv2_ins + generic, public :: g2lip_ins => g2ls1_ins, g2lv1_ins + + end type psb_desc_type @@ -256,7 +279,11 @@ module psb_desc_mod end interface psb_free - private :: nullify_desc + private :: nullify_desc, cd_get_fmt,& + & cd_l2gs1, cd_l2gs2, cd_l2gv1, cd_l2gv2, cd_g2ls1,& + & cd_g2ls2, cd_g2lv1, cd_g2lv2, cd_g2ls1_ins,& + & cd_g2ls2_ins, cd_g2lv1_ins, cd_g2lv2_ins + integer(psb_ipk_), private, save :: cd_large_threshold=psb_default_large_threshold @@ -464,6 +491,19 @@ contains end function psb_cd_get_global_cols + function cd_get_fmt(desc) result(val) + implicit none + character(len=5) :: val + class(psb_desc_type), intent(in) :: desc + + if (allocated(desc%indxmap)) then + val = desc%indxmap%get_fmt() + else + val = 'NULL' + endif + + end function cd_get_fmt + function psb_cd_get_context(desc) result(val) use psb_error_mod implicit none @@ -910,5 +950,488 @@ contains end Subroutine psb_cd_get_recv_idx + subroutine cd_l2gs1(idx,desc,info,mask,owned) + use psb_error_mod + implicit none + class(psb_desc_type), intent(in) :: desc + integer(psb_ipk_), intent(inout) :: idx + integer(psb_ipk_), intent(out) :: info + logical, intent(in), optional :: mask + logical, intent(in), optional :: owned + integer(psb_ipk_) :: err_act + character(len=20) :: name='cd_l2g' + + info = psb_success_ + call psb_erractionsave(err_act) + + if (allocated(desc%indxmap)) then + call desc%indxmap%l2gs1(idx,info,mask=mask,owned=owned) + else + info = psb_err_invalid_cd_state_ + end if + if (info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + Return + + end subroutine cd_l2gs1 + + subroutine cd_l2gs2(idxin,idxout,desc,info,mask,owned) + use psb_error_mod + implicit none + class(psb_desc_type), intent(in) :: desc + integer(psb_ipk_), intent(in) :: idxin + integer(psb_ipk_), intent(out) :: idxout + integer(psb_ipk_), intent(out) :: info + logical, intent(in), optional :: mask + logical, intent(in), optional :: owned + + integer(psb_ipk_) :: err_act + character(len=20) :: name='cd_l2g' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (allocated(desc%indxmap)) then + call desc%indxmap%l2gs2(idxin,idxout,info,mask=mask,owned=owned) + else + info = psb_err_invalid_cd_state_ + end if + if (info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + Return + + + end subroutine cd_l2gs2 + + + subroutine cd_l2gv1(idx,desc,info,mask,owned) + use psb_error_mod + implicit none + class(psb_desc_type), intent(in) :: desc + integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(out) :: info + logical, intent(in), optional :: mask(:) + logical, intent(in), optional :: owned + integer(psb_ipk_) :: err_act + character(len=20) :: name='cd_l2g' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (allocated(desc%indxmap)) then + call desc%indxmap%l2gv1(idx,info,mask=mask,owned=owned) + else + info = psb_err_invalid_cd_state_ + end if + if (info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + Return + + end subroutine cd_l2gv1 + + subroutine cd_l2gv2(idxin,idxout,desc,info,mask,owned) + use psb_error_mod + implicit none + class(psb_desc_type), intent(in) :: desc + integer(psb_ipk_), intent(in) :: idxin(:) + integer(psb_ipk_), intent(out) :: idxout(:) + integer(psb_ipk_), intent(out) :: info + logical, intent(in), optional :: mask(:) + logical, intent(in), optional :: owned + integer(psb_ipk_) :: err_act + character(len=20) :: name='cd_l2g' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (allocated(desc%indxmap)) then + call desc%indxmap%l2gv2(idxin,idxout,info,mask=mask,owned=owned) + else + info = psb_err_invalid_cd_state_ + end if + if (info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + Return + + end subroutine cd_l2gv2 + + + subroutine cd_g2ls1(idx,desc,info,mask,owned) + use psb_error_mod + implicit none + class(psb_desc_type), intent(in) :: desc + integer(psb_ipk_), intent(inout) :: idx + integer(psb_ipk_), intent(out) :: info + logical, intent(in), optional :: mask + logical, intent(in), optional :: owned + integer(psb_ipk_) :: err_act + character(len=20) :: name='cd_g2l' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (allocated(desc%indxmap)) then + call desc%indxmap%g2ls1(idx,info,mask=mask,owned=owned) + else + info = psb_err_invalid_cd_state_ + end if + if (info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + Return + + end subroutine cd_g2ls1 + + subroutine cd_g2ls2(idxin,idxout,desc,info,mask,owned) + use psb_error_mod + implicit none + class(psb_desc_type), intent(in) :: desc + integer(psb_ipk_), intent(in) :: idxin + integer(psb_ipk_), intent(out) :: idxout + integer(psb_ipk_), intent(out) :: info + logical, intent(in), optional :: mask + logical, intent(in), optional :: owned + + integer(psb_ipk_) :: err_act + character(len=20) :: name='cd_g2l' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (allocated(desc%indxmap)) then + call desc%indxmap%g2ls2(idxin,idxout,info,mask=mask,owned=owned) + else + info = psb_err_invalid_cd_state_ + end if + if (info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + Return + + + end subroutine cd_g2ls2 + + + subroutine cd_g2lv1(idx,desc,info,mask,owned) + use psb_error_mod + implicit none + class(psb_desc_type), intent(in) :: desc + integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(out) :: info + logical, intent(in), optional :: mask(:) + logical, intent(in), optional :: owned + integer(psb_ipk_) :: err_act + character(len=20) :: name='cd_g2l' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (allocated(desc%indxmap)) then + call desc%indxmap%g2lv1(idx,info,mask=mask,owned=owned) + else + info = psb_err_invalid_cd_state_ + end if + if (info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + Return + + + end subroutine cd_g2lv1 + + subroutine cd_g2lv2(idxin,idxout,desc,info,mask,owned) + use psb_error_mod + implicit none + class(psb_desc_type), intent(in) :: desc + integer(psb_ipk_), intent(in) :: idxin(:) + integer(psb_ipk_), intent(out) :: idxout(:) + integer(psb_ipk_), intent(out) :: info + logical, intent(in), optional :: mask(:) + logical, intent(in), optional :: owned + + integer(psb_ipk_) :: err_act + character(len=20) :: name='cd_g2l' + logical, parameter :: debug=.false. + + + info = psb_success_ + call psb_erractionsave(err_act) + + if (allocated(desc%indxmap)) then + call desc%indxmap%g2lv2(idxin,idxout,info,mask=mask,owned=owned) + else + info = psb_err_invalid_cd_state_ + end if + if (info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + Return + + + end subroutine cd_g2lv2 + + + + subroutine cd_g2ls1_ins(idx,desc,info,mask, lidx) + use psb_error_mod + implicit none + class(psb_desc_type), intent(inout) :: desc + integer(psb_ipk_), intent(inout) :: idx + integer(psb_ipk_), intent(out) :: info + logical, intent(in), optional :: mask + integer(psb_ipk_), intent(in), optional :: lidx + integer(psb_ipk_) :: err_act + character(len=20) :: name='cd_g2l_ins' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (allocated(desc%indxmap)) then + call desc%indxmap%g2ls1_ins(idx,info,mask=mask,lidx=lidx) + else + info = psb_err_invalid_cd_state_ + end if + if (info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + Return + + + end subroutine cd_g2ls1_ins + + subroutine cd_g2ls2_ins(idxin,idxout,desc,info,mask, lidx) + use psb_error_mod + implicit none + class(psb_desc_type), intent(inout) :: desc + integer(psb_ipk_), intent(in) :: idxin + integer(psb_ipk_), intent(out) :: idxout + integer(psb_ipk_), intent(out) :: info + logical, intent(in), optional :: mask + integer(psb_ipk_), intent(in), optional :: lidx + + integer(psb_ipk_) :: err_act + character(len=20) :: name='cd_g2l_ins' + logical, parameter :: debug=.false. + + + info = psb_success_ + call psb_erractionsave(err_act) + + if (allocated(desc%indxmap)) then + call desc%indxmap%g2ls2_ins(idxin,idxout,info,mask=mask,lidx=lidx) + else + info = psb_err_invalid_cd_state_ + end if + if (info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + Return + + + end subroutine cd_g2ls2_ins + + + subroutine cd_g2lv1_ins(idx,desc,info,mask, lidx) + use psb_error_mod + implicit none + class(psb_desc_type), intent(inout) :: desc + integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(out) :: info + logical, intent(in), optional :: mask(:) + integer(psb_ipk_), intent(in), optional :: lidx(:) + + integer(psb_ipk_) :: err_act + character(len=20) :: name='cd_g2l_ins' + logical, parameter :: debug=.false. + + + info = psb_success_ + call psb_erractionsave(err_act) + + if (allocated(desc%indxmap)) then + call desc%indxmap%g2lv1_ins(idx,info,mask=mask,lidx=lidx) + else + info = psb_err_invalid_cd_state_ + end if + if (info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + Return + + + end subroutine cd_g2lv1_ins + + subroutine cd_g2lv2_ins(idxin,idxout,desc,info,mask,lidx) + use psb_error_mod + implicit none + class(psb_desc_type), intent(inout) :: desc + integer(psb_ipk_), intent(in) :: idxin(:) + integer(psb_ipk_), intent(out) :: idxout(:) + integer(psb_ipk_), intent(out) :: info + logical, intent(in), optional :: mask(:) + integer(psb_ipk_), intent(in), optional :: lidx(:) + + integer(psb_ipk_) :: err_act + character(len=20) :: name='cd_g2l_ins' + logical, parameter :: debug=.false. + + + info = psb_success_ + call psb_erractionsave(err_act) + + if (allocated(desc%indxmap)) then + call desc%indxmap%g2lv2_ins(idxin,idxout,info,mask=mask,lidx=lidx) + else + info = psb_err_invalid_cd_state_ + end if + if (info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + Return + + end subroutine cd_g2lv2_ins end module psb_desc_mod diff --git a/base/tools/psb_glob_to_loc.f90 b/base/tools/psb_glob_to_loc.f90 index 933ce15f..7a8a1a08 100644 --- a/base/tools/psb_glob_to_loc.f90 +++ b/base/tools/psb_glob_to_loc.f90 @@ -62,7 +62,6 @@ subroutine psb_glob_to_loc2v(x,y,desc_a,info,iact,owned) integer(psb_ipk_) :: n, ictxt, iam, np character :: act integer(psb_ipk_) :: int_err(5), err_act - logical :: owned_ integer(psb_ipk_), parameter :: zero=0 character(len=20) :: name @@ -191,7 +190,6 @@ subroutine psb_glob_to_loc1v(x,desc_a,info,iact,owned) integer(psb_ipk_) :: n character :: act integer(psb_ipk_) :: err_act - logical :: owned_ integer(psb_ipk_), parameter :: zero=0 character(len=20) :: name integer(psb_ipk_) :: ictxt, iam, np diff --git a/test/pargen/ppde2d.f90 b/test/pargen/ppde2d.f90 index 301e28c9..02d9031b 100644 --- a/test/pargen/ppde2d.f90 +++ b/test/pargen/ppde2d.f90 @@ -243,7 +243,7 @@ program ppde2d write(psb_out_unit,'("Total memory occupation for A: ",i12)')amatsize write(psb_out_unit,'("Total memory occupation for PREC: ",i12)')precsize write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)')descsize - write(psb_out_unit,'("Storage type for DESC_A: ",a)') desc_a%indxmap%get_fmt() + write(psb_out_unit,'("Storage type for DESC_A: ",a)') desc_a%get_fmt() end if diff --git a/test/pargen/ppde3d.f90 b/test/pargen/ppde3d.f90 index 00a7b499..7fb33f9d 100644 --- a/test/pargen/ppde3d.f90 +++ b/test/pargen/ppde3d.f90 @@ -256,7 +256,7 @@ program ppde3d write(psb_out_unit,'("Total memory occupation for A: ",i12)')amatsize write(psb_out_unit,'("Total memory occupation for PREC: ",i12)')precsize write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)')descsize - write(psb_out_unit,'("Storage type for DESC_A: ",a)') desc_a%indxmap%get_fmt() + write(psb_out_unit,'("Storage type for DESC_A: ",a)') desc_a%get_fmt() end if diff --git a/test/pargen/spde2d.f90 b/test/pargen/spde2d.f90 index 15037661..27dc18b3 100644 --- a/test/pargen/spde2d.f90 +++ b/test/pargen/spde2d.f90 @@ -242,7 +242,7 @@ program spde2d write(psb_out_unit,'("Total memory occupation for A: ",i12)')amatsize write(psb_out_unit,'("Total memory occupation for PREC: ",i12)')precsize write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)')descsize - write(psb_out_unit,'("Storage type for DESC_A: ",a)') desc_a%indxmap%get_fmt() + write(psb_out_unit,'("Storage type for DESC_A: ",a)') desc_a%get_fmt() end if diff --git a/test/pargen/spde3d.f90 b/test/pargen/spde3d.f90 index 5c5431e9..8c30a7df 100644 --- a/test/pargen/spde3d.f90 +++ b/test/pargen/spde3d.f90 @@ -256,7 +256,7 @@ program spde3d write(psb_out_unit,'("Total memory occupation for A: ",i12)')amatsize write(psb_out_unit,'("Total memory occupation for PREC: ",i12)')precsize write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)')descsize - write(psb_out_unit,'("Storage type for DESC_A: ",a)') desc_a%indxmap%get_fmt() + write(psb_out_unit,'("Storage type for DESC_A: ",a)') desc_a%get_fmt() end if