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.
psblas-testmv
Salvatore Filippone 11 years ago
parent 868b5742ce
commit cfc6255040

@ -231,6 +231,29 @@ module psb_desc_mod
procedure, pass(desc) :: destroy => psb_cd_destroy procedure, pass(desc) :: destroy => psb_cd_destroy
procedure, pass(desc) :: nullify => nullify_desc 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 end type psb_desc_type
@ -256,7 +279,11 @@ module psb_desc_mod
end interface psb_free 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 integer(psb_ipk_), private, save :: cd_large_threshold=psb_default_large_threshold
@ -464,6 +491,19 @@ contains
end function psb_cd_get_global_cols 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) function psb_cd_get_context(desc) result(val)
use psb_error_mod use psb_error_mod
implicit none implicit none
@ -910,5 +950,488 @@ contains
end Subroutine psb_cd_get_recv_idx 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 end module psb_desc_mod

@ -62,7 +62,6 @@ subroutine psb_glob_to_loc2v(x,y,desc_a,info,iact,owned)
integer(psb_ipk_) :: n, ictxt, iam, np integer(psb_ipk_) :: n, ictxt, iam, np
character :: act character :: act
integer(psb_ipk_) :: int_err(5), err_act integer(psb_ipk_) :: int_err(5), err_act
logical :: owned_
integer(psb_ipk_), parameter :: zero=0 integer(psb_ipk_), parameter :: zero=0
character(len=20) :: name character(len=20) :: name
@ -191,7 +190,6 @@ subroutine psb_glob_to_loc1v(x,desc_a,info,iact,owned)
integer(psb_ipk_) :: n integer(psb_ipk_) :: n
character :: act character :: act
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
logical :: owned_
integer(psb_ipk_), parameter :: zero=0 integer(psb_ipk_), parameter :: zero=0
character(len=20) :: name character(len=20) :: name
integer(psb_ipk_) :: ictxt, iam, np integer(psb_ipk_) :: ictxt, iam, np

@ -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 A: ",i12)')amatsize
write(psb_out_unit,'("Total memory occupation for PREC: ",i12)')precsize 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,'("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 end if

@ -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 A: ",i12)')amatsize
write(psb_out_unit,'("Total memory occupation for PREC: ",i12)')precsize 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,'("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 end if

@ -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 A: ",i12)')amatsize
write(psb_out_unit,'("Total memory occupation for PREC: ",i12)')precsize 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,'("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 end if

@ -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 A: ",i12)')amatsize
write(psb_out_unit,'("Total memory occupation for PREC: ",i12)')precsize 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,'("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 end if

Loading…
Cancel
Save