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

New name for map_aggr_ parm.

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

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

@ -47,13 +47,15 @@ module psb_base_linmap_mod
type(psb_desc_type), pointer :: p_desc_U=>null(), p_desc_V=>null() type(psb_desc_type), pointer :: p_desc_U=>null(), p_desc_V=>null()
type(psb_desc_type) :: desc_U, desc_V type(psb_desc_type) :: desc_U, desc_V
contains contains
procedure, pass(map) :: sizeof => base_map_sizeof procedure, pass(map) :: sizeof => base_map_sizeof
procedure, pass(map) :: is_ok => base_is_ok procedure, pass(map) :: is_ok => base_is_ok
procedure, pass(map) :: is_asb => base_is_asb procedure, pass(map) :: is_asb => base_is_asb
procedure, pass(map) :: get_kind => base_get_kind procedure, pass(map) :: get_kind => base_get_kind
procedure, pass(map) :: set_kind => base_set_kind procedure, pass(map) :: set_kind => base_set_kind
procedure, pass(map) :: free => base_free procedure, pass(map) :: is_dec_aggr => base_is_dec_aggr
procedure, pass(map) :: clone => base_clone 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 end type psb_base_linmap_type
@ -62,7 +64,8 @@ module psb_base_linmap_mod
end interface end interface
private :: base_map_sizeof, base_is_ok, base_is_asb,& 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 contains
@ -93,7 +96,7 @@ contains
res = .false. res = .false.
select case(map%get_kind()) 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_U)) return
if (.not.associated(map%p_desc_V)) return if (.not.associated(map%p_desc_V)) return
res = map%p_desc_U%is_ok().and.map%p_desc_V%is_ok() res = map%p_desc_U%is_ok().and.map%p_desc_V%is_ok()
@ -111,7 +114,7 @@ contains
res = .false. res = .false.
select case(map%get_kind()) 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_U)) return
if (.not.associated(map%p_desc_V)) return if (.not.associated(map%p_desc_V)) return
res = map%p_desc_U%is_asb().and.map%p_desc_V%is_asb() res = map%p_desc_U%is_asb().and.map%p_desc_V%is_asb()
@ -121,6 +124,24 @@ contains
end function base_is_asb 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) function base_map_sizeof(map) result(val)
use psb_desc_mod use psb_desc_mod
implicit none 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. ! Types of mapping between descriptors.
integer(psb_ipk_), parameter :: psb_map_xhal_ = 123 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_asov_ = psb_map_xhal_+1
integer(psb_ipk_), parameter :: psb_map_aggr_ = psb_map_asov_+1 integer(psb_ipk_), parameter :: psb_map_dec_aggr_ = psb_map_asov_+1
integer(psb_ipk_), parameter :: psb_map_gen_linear_ = psb_map_aggr_+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_ 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() map_kind = map%get_kind()
select case(map_kind) select case(map_kind)
case(psb_map_aggr_) case(psb_map_dec_aggr_)
ictxt = map%p_desc_V%get_context() ictxt = map%p_desc_V%get_context()
nr2 = map%p_desc_V%get_global_rows() 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 case default
write(psb_err_unit,*) trim(name),' Invalid descriptor input', & 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 info = 1
return return
end select 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() map_kind = map%get_kind()
select case(map_kind) select case(map_kind)
case(psb_map_aggr_) case(psb_map_dec_aggr_)
ictxt = map%p_desc_V%get_context() ictxt = map%p_desc_V%get_context()
call psb_info(ictxt,iam,np) 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 case default
write(psb_err_unit,*) trim(name),' Invalid descriptor input', & 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 info = 1
return return
end select end select
@ -246,7 +246,7 @@ subroutine psb_c_map_V2U_a(alpha,x,beta,y,map,info,work)
map_kind = map%get_kind() map_kind = map%get_kind()
select case(map_kind) select case(map_kind)
case(psb_map_aggr_) case(psb_map_dec_aggr_)
ictxt = map%p_desc_U%get_context() ictxt = map%p_desc_U%get_context()
nr2 = map%p_desc_U%get_global_rows() 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() map_kind = map%get_kind()
select case(map_kind) select case(map_kind)
case(psb_map_aggr_) case(psb_map_dec_aggr_)
ictxt = map%p_desc_U%get_context() ictxt = map%p_desc_U%get_context()
call psb_info(ictxt,iam,np) 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_ info = psb_success_
select case(map_kind) select case(map_kind)
case (psb_map_aggr_) case (psb_map_dec_aggr_)
! OK ! OK
if (psb_is_ok_desc(desc_U)) then 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() map_kind = map%get_kind()
select case(map_kind) select case(map_kind)
case(psb_map_aggr_) case(psb_map_dec_aggr_)
ictxt = map%p_desc_V%get_context() ictxt = map%p_desc_V%get_context()
nr2 = map%p_desc_V%get_global_rows() 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 case default
write(psb_err_unit,*) trim(name),' Invalid descriptor input', & 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 info = 1
return return
end select 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() map_kind = map%get_kind()
select case(map_kind) select case(map_kind)
case(psb_map_aggr_) case(psb_map_dec_aggr_)
ictxt = map%p_desc_V%get_context() ictxt = map%p_desc_V%get_context()
call psb_info(ictxt,iam,np) 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 case default
write(psb_err_unit,*) trim(name),' Invalid descriptor input', & 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 info = 1
return return
end select end select
@ -246,7 +246,7 @@ subroutine psb_d_map_V2U_a(alpha,x,beta,y,map,info,work)
map_kind = map%get_kind() map_kind = map%get_kind()
select case(map_kind) select case(map_kind)
case(psb_map_aggr_) case(psb_map_dec_aggr_)
ictxt = map%p_desc_U%get_context() ictxt = map%p_desc_U%get_context()
nr2 = map%p_desc_U%get_global_rows() 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() map_kind = map%get_kind()
select case(map_kind) select case(map_kind)
case(psb_map_aggr_) case(psb_map_dec_aggr_)
ictxt = map%p_desc_U%get_context() ictxt = map%p_desc_U%get_context()
call psb_info(ictxt,iam,np) 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_ info = psb_success_
select case(map_kind) select case(map_kind)
case (psb_map_aggr_) case (psb_map_dec_aggr_)
! OK ! OK
if (psb_is_ok_desc(desc_U)) then 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() map_kind = map%get_kind()
select case(map_kind) select case(map_kind)
case(psb_map_aggr_) case(psb_map_dec_aggr_)
ictxt = map%p_desc_V%get_context() ictxt = map%p_desc_V%get_context()
nr2 = map%p_desc_V%get_global_rows() 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 case default
write(psb_err_unit,*) trim(name),' Invalid descriptor input', & 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 info = 1
return return
end select 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() map_kind = map%get_kind()
select case(map_kind) select case(map_kind)
case(psb_map_aggr_) case(psb_map_dec_aggr_)
ictxt = map%p_desc_V%get_context() ictxt = map%p_desc_V%get_context()
call psb_info(ictxt,iam,np) 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 case default
write(psb_err_unit,*) trim(name),' Invalid descriptor input', & 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 info = 1
return return
end select end select
@ -246,7 +246,7 @@ subroutine psb_s_map_V2U_a(alpha,x,beta,y,map,info,work)
map_kind = map%get_kind() map_kind = map%get_kind()
select case(map_kind) select case(map_kind)
case(psb_map_aggr_) case(psb_map_dec_aggr_)
ictxt = map%p_desc_U%get_context() ictxt = map%p_desc_U%get_context()
nr2 = map%p_desc_U%get_global_rows() 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() map_kind = map%get_kind()
select case(map_kind) select case(map_kind)
case(psb_map_aggr_) case(psb_map_dec_aggr_)
ictxt = map%p_desc_U%get_context() ictxt = map%p_desc_U%get_context()
call psb_info(ictxt,iam,np) 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_ info = psb_success_
select case(map_kind) select case(map_kind)
case (psb_map_aggr_) case (psb_map_dec_aggr_)
! OK ! OK
if (psb_is_ok_desc(desc_U)) then 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() map_kind = map%get_kind()
select case(map_kind) select case(map_kind)
case(psb_map_aggr_) case(psb_map_dec_aggr_)
ictxt = map%p_desc_V%get_context() ictxt = map%p_desc_V%get_context()
nr2 = map%p_desc_V%get_global_rows() 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 case default
write(psb_err_unit,*) trim(name),' Invalid descriptor input', & 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 info = 1
return return
end select 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() map_kind = map%get_kind()
select case(map_kind) select case(map_kind)
case(psb_map_aggr_) case(psb_map_dec_aggr_)
ictxt = map%p_desc_V%get_context() ictxt = map%p_desc_V%get_context()
call psb_info(ictxt,iam,np) 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 case default
write(psb_err_unit,*) trim(name),' Invalid descriptor input', & 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 info = 1
return return
end select end select
@ -246,7 +246,7 @@ subroutine psb_z_map_V2U_a(alpha,x,beta,y,map,info,work)
map_kind = map%get_kind() map_kind = map%get_kind()
select case(map_kind) select case(map_kind)
case(psb_map_aggr_) case(psb_map_dec_aggr_)
ictxt = map%p_desc_U%get_context() ictxt = map%p_desc_U%get_context()
nr2 = map%p_desc_U%get_global_rows() 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() map_kind = map%get_kind()
select case(map_kind) select case(map_kind)
case(psb_map_aggr_) case(psb_map_dec_aggr_)
ictxt = map%p_desc_U%get_context() ictxt = map%p_desc_U%get_context()
call psb_info(ictxt,iam,np) 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_ info = psb_success_
select case(map_kind) select case(map_kind)
case (psb_map_aggr_) case (psb_map_dec_aggr_)
! OK ! OK
if (psb_is_ok_desc(desc_U)) then if (psb_is_ok_desc(desc_U)) then

Write Preview
Loading…
Cancel
Save