fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'psblas-paraggr' of https://github.com/sfilippone/psblas3 into psblas-paraggr

Browse Source
psblas-paraggr
Salvatore Filippone 6 years ago
parent acfbc29fb7 2478dc55ba
commit d88dc28bd6
6 changed files with 61 additions and 40 deletions
Show Stats Download Patch File Download Diff File

27
base/modules/comm/psb_base_linmap_mod.f90
Unescape Escape View File

@ -52,6 +52,8 @@ module psb_base_linmap_mod
procedure, pass(map) :: is_asb => base_is_asb
procedure, pass(map) :: get_kind => base_get_kind
procedure, pass(map) :: set_kind => base_set_kind
procedure, pass(map) :: is_dec_aggr => base_is_dec_aggr
procedure, pass(map) :: is_gen_linear => base_is_gen_linear
procedure, pass(map) :: free => base_free
procedure, pass(map) :: clone => base_clone
end type psb_base_linmap_type
@ -62,7 +64,8 @@ module psb_base_linmap_mod
end interface
private :: base_map_sizeof, base_is_ok, base_is_asb,&
& base_get_kind, base_set_kind, base_free, base_clone
& base_get_kind, base_set_kind, base_free, base_clone,&
& base_is_dec_aggr, base_is_gen_linear
contains
@ -93,7 +96,7 @@ contains
res = .false.
select case(map%get_kind())
case (psb_map_aggr_)
case (psb_map_dec_aggr_)
if (.not.associated(map%p_desc_U)) return
if (.not.associated(map%p_desc_V)) return
res = map%p_desc_U%is_ok().and.map%p_desc_V%is_ok()
@ -111,7 +114,7 @@ contains
res = .false.
select case(map%get_kind())
case (psb_map_aggr_)
case (psb_map_dec_aggr_)
if (.not.associated(map%p_desc_U)) return
if (.not.associated(map%p_desc_V)) return
res = map%p_desc_U%is_asb().and.map%p_desc_V%is_asb()
@ -121,6 +124,24 @@ contains
end function base_is_asb
function base_is_dec_aggr(map) result(res)
use psb_desc_mod
implicit none
class(psb_base_linmap_type), intent(in) :: map
logical :: res
res = (map%get_kind() == psb_map_dec_aggr_)
end function base_is_dec_aggr
function base_is_gen_linear(map) result(res)
use psb_desc_mod
implicit none
class(psb_base_linmap_type), intent(in) :: map
logical :: res
res = (map%get_kind() == psb_map_gen_linear_)
end function base_is_gen_linear
function base_map_sizeof(map) result(val)
use psb_desc_mod
implicit none

4
base/modules/desc/psb_desc_const_mod.f90
Unescape Escape View File

@ -55,8 +55,8 @@ module psb_desc_const_mod
! Types of mapping between descriptors.
integer(psb_ipk_), parameter :: psb_map_xhal_ = 123
integer(psb_ipk_), parameter :: psb_map_asov_ = psb_map_xhal_+1
integer(psb_ipk_), parameter :: psb_map_aggr_ = psb_map_asov_+1
integer(psb_ipk_), parameter :: psb_map_gen_linear_ = psb_map_aggr_+1
integer(psb_ipk_), parameter :: psb_map_dec_aggr_ = psb_map_asov_+1
integer(psb_ipk_), parameter :: psb_map_gen_linear_ = psb_map_dec_aggr_+1
integer(psb_ipk_), parameter :: psb_ovt_xhal_ = psb_map_xhal_, psb_ovt_asov_=psb_map_asov_
!

14
base/tools/psb_c_map.f90
Unescape Escape View File

@ -64,7 +64,7 @@ subroutine psb_c_map_U2V_a(alpha,x,beta,y,map,info,work)
map_kind = map%get_kind()
select case(map_kind)
case(psb_map_aggr_)
case(psb_map_dec_aggr_)
ictxt = map%p_desc_V%get_context()
nr2 = map%p_desc_V%get_global_rows()
@ -104,7 +104,7 @@ subroutine psb_c_map_U2V_a(alpha,x,beta,y,map,info,work)
case default
write(psb_err_unit,*) trim(name),' Invalid descriptor input', &
& map_kind, psb_map_aggr_, psb_map_gen_linear_
& map_kind, psb_map_dec_aggr_, psb_map_gen_linear_
info = 1
return
end select
@ -138,7 +138,7 @@ subroutine psb_c_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty)
map_kind = map%get_kind()
select case(map_kind)
case(psb_map_aggr_)
case(psb_map_dec_aggr_)
ictxt = map%p_desc_V%get_context()
call psb_info(ictxt,iam,np)
@ -205,7 +205,7 @@ subroutine psb_c_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty)
case default
write(psb_err_unit,*) trim(name),' Invalid descriptor input', &
& map_kind, psb_map_aggr_, psb_map_gen_linear_
& map_kind, psb_map_dec_aggr_, psb_map_gen_linear_
info = 1
return
end select
@ -246,7 +246,7 @@ subroutine psb_c_map_V2U_a(alpha,x,beta,y,map,info,work)
map_kind = map%get_kind()
select case(map_kind)
case(psb_map_aggr_)
case(psb_map_dec_aggr_)
ictxt = map%p_desc_U%get_context()
nr2 = map%p_desc_U%get_global_rows()
@ -319,7 +319,7 @@ subroutine psb_c_map_V2U_v(alpha,x,beta,y,map,info,work,vtx,vty)
map_kind = map%get_kind()
select case(map_kind)
case(psb_map_aggr_)
case(psb_map_dec_aggr_)
ictxt = map%p_desc_U%get_context()
call psb_info(ictxt,iam,np)
@ -408,7 +408,7 @@ function psb_c_linmap(map_kind,desc_U, desc_V, mat_U2V, mat_V2U,iaggr,naggr) &
info = psb_success_
select case(map_kind)
case (psb_map_aggr_)
case (psb_map_dec_aggr_)
! OK
if (psb_is_ok_desc(desc_U)) then

14
base/tools/psb_d_map.f90
Unescape Escape View File

@ -64,7 +64,7 @@ subroutine psb_d_map_U2V_a(alpha,x,beta,y,map,info,work)
map_kind = map%get_kind()
select case(map_kind)
case(psb_map_aggr_)
case(psb_map_dec_aggr_)
ictxt = map%p_desc_V%get_context()
nr2 = map%p_desc_V%get_global_rows()
@ -104,7 +104,7 @@ subroutine psb_d_map_U2V_a(alpha,x,beta,y,map,info,work)
case default
write(psb_err_unit,*) trim(name),' Invalid descriptor input', &
& map_kind, psb_map_aggr_, psb_map_gen_linear_
& map_kind, psb_map_dec_aggr_, psb_map_gen_linear_
info = 1
return
end select
@ -138,7 +138,7 @@ subroutine psb_d_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty)
map_kind = map%get_kind()
select case(map_kind)
case(psb_map_aggr_)
case(psb_map_dec_aggr_)
ictxt = map%p_desc_V%get_context()
call psb_info(ictxt,iam,np)
@ -205,7 +205,7 @@ subroutine psb_d_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty)
case default
write(psb_err_unit,*) trim(name),' Invalid descriptor input', &
& map_kind, psb_map_aggr_, psb_map_gen_linear_
& map_kind, psb_map_dec_aggr_, psb_map_gen_linear_
info = 1
return
end select
@ -246,7 +246,7 @@ subroutine psb_d_map_V2U_a(alpha,x,beta,y,map,info,work)
map_kind = map%get_kind()
select case(map_kind)
case(psb_map_aggr_)
case(psb_map_dec_aggr_)
ictxt = map%p_desc_U%get_context()
nr2 = map%p_desc_U%get_global_rows()
@ -319,7 +319,7 @@ subroutine psb_d_map_V2U_v(alpha,x,beta,y,map,info,work,vtx,vty)
map_kind = map%get_kind()
select case(map_kind)
case(psb_map_aggr_)
case(psb_map_dec_aggr_)
ictxt = map%p_desc_U%get_context()
call psb_info(ictxt,iam,np)
@ -408,7 +408,7 @@ function psb_d_linmap(map_kind,desc_U, desc_V, mat_U2V, mat_V2U,iaggr,naggr) &
info = psb_success_
select case(map_kind)
case (psb_map_aggr_)
case (psb_map_dec_aggr_)
! OK
if (psb_is_ok_desc(desc_U)) then

14
base/tools/psb_s_map.f90
Unescape Escape View File

@ -64,7 +64,7 @@ subroutine psb_s_map_U2V_a(alpha,x,beta,y,map,info,work)
map_kind = map%get_kind()
select case(map_kind)
case(psb_map_aggr_)
case(psb_map_dec_aggr_)
ictxt = map%p_desc_V%get_context()
nr2 = map%p_desc_V%get_global_rows()
@ -104,7 +104,7 @@ subroutine psb_s_map_U2V_a(alpha,x,beta,y,map,info,work)
case default
write(psb_err_unit,*) trim(name),' Invalid descriptor input', &
& map_kind, psb_map_aggr_, psb_map_gen_linear_
& map_kind, psb_map_dec_aggr_, psb_map_gen_linear_
info = 1
return
end select
@ -138,7 +138,7 @@ subroutine psb_s_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty)
map_kind = map%get_kind()
select case(map_kind)
case(psb_map_aggr_)
case(psb_map_dec_aggr_)
ictxt = map%p_desc_V%get_context()
call psb_info(ictxt,iam,np)
@ -205,7 +205,7 @@ subroutine psb_s_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty)
case default
write(psb_err_unit,*) trim(name),' Invalid descriptor input', &
& map_kind, psb_map_aggr_, psb_map_gen_linear_
& map_kind, psb_map_dec_aggr_, psb_map_gen_linear_
info = 1
return
end select
@ -246,7 +246,7 @@ subroutine psb_s_map_V2U_a(alpha,x,beta,y,map,info,work)
map_kind = map%get_kind()
select case(map_kind)
case(psb_map_aggr_)
case(psb_map_dec_aggr_)
ictxt = map%p_desc_U%get_context()
nr2 = map%p_desc_U%get_global_rows()
@ -319,7 +319,7 @@ subroutine psb_s_map_V2U_v(alpha,x,beta,y,map,info,work,vtx,vty)
map_kind = map%get_kind()
select case(map_kind)
case(psb_map_aggr_)
case(psb_map_dec_aggr_)
ictxt = map%p_desc_U%get_context()
call psb_info(ictxt,iam,np)
@ -408,7 +408,7 @@ function psb_s_linmap(map_kind,desc_U, desc_V, mat_U2V, mat_V2U,iaggr,naggr) &
info = psb_success_
select case(map_kind)
case (psb_map_aggr_)
case (psb_map_dec_aggr_)
! OK
if (psb_is_ok_desc(desc_U)) then

14
base/tools/psb_z_map.f90
Unescape Escape View File

@ -64,7 +64,7 @@ subroutine psb_z_map_U2V_a(alpha,x,beta,y,map,info,work)
map_kind = map%get_kind()
select case(map_kind)
case(psb_map_aggr_)
case(psb_map_dec_aggr_)
ictxt = map%p_desc_V%get_context()
nr2 = map%p_desc_V%get_global_rows()
@ -104,7 +104,7 @@ subroutine psb_z_map_U2V_a(alpha,x,beta,y,map,info,work)
case default
write(psb_err_unit,*) trim(name),' Invalid descriptor input', &
& map_kind, psb_map_aggr_, psb_map_gen_linear_
& map_kind, psb_map_dec_aggr_, psb_map_gen_linear_
info = 1
return
end select
@ -138,7 +138,7 @@ subroutine psb_z_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty)
map_kind = map%get_kind()
select case(map_kind)
case(psb_map_aggr_)
case(psb_map_dec_aggr_)
ictxt = map%p_desc_V%get_context()
call psb_info(ictxt,iam,np)
@ -205,7 +205,7 @@ subroutine psb_z_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty)
case default
write(psb_err_unit,*) trim(name),' Invalid descriptor input', &
& map_kind, psb_map_aggr_, psb_map_gen_linear_
& map_kind, psb_map_dec_aggr_, psb_map_gen_linear_
info = 1
return
end select
@ -246,7 +246,7 @@ subroutine psb_z_map_V2U_a(alpha,x,beta,y,map,info,work)
map_kind = map%get_kind()
select case(map_kind)
case(psb_map_aggr_)
case(psb_map_dec_aggr_)
ictxt = map%p_desc_U%get_context()
nr2 = map%p_desc_U%get_global_rows()
@ -319,7 +319,7 @@ subroutine psb_z_map_V2U_v(alpha,x,beta,y,map,info,work,vtx,vty)
map_kind = map%get_kind()
select case(map_kind)
case(psb_map_aggr_)
case(psb_map_dec_aggr_)
ictxt = map%p_desc_U%get_context()
call psb_info(ictxt,iam,np)
@ -408,7 +408,7 @@ function psb_z_linmap(map_kind,desc_U, desc_V, mat_U2V, mat_V2U,iaggr,naggr) &
info = psb_success_
select case(map_kind)
case (psb_map_aggr_)
case (psb_map_dec_aggr_)
! OK
if (psb_is_ok_desc(desc_U)) then

Write Preview
Loading…
Cancel
Save