diff --git a/base/modules/comm/psb_base_linmap_mod.f90 b/base/modules/comm/psb_base_linmap_mod.f90 index 760ec3ce..864d87e9 100644 --- a/base/modules/comm/psb_base_linmap_mod.f90 +++ b/base/modules/comm/psb_base_linmap_mod.f90 @@ -33,7 +33,8 @@ ! ! package: psb_linmap_type_mod ! Defines data types for mapping between vectors belonging -! to different spaces. +! to different spaces U and V. +! As used in MLD2P4, U is the fine space and V is the coarse space. ! module psb_base_linmap_mod use psb_const_mod @@ -43,8 +44,8 @@ module psb_base_linmap_mod type psb_base_linmap_type integer(psb_ipk_) :: kind integer(psb_ipk_), allocatable :: iaggr(:), naggr(:) - type(psb_desc_type), pointer :: p_desc_X=>null(), p_desc_Y=>null() - type(psb_desc_type) :: desc_X, desc_Y + type(psb_desc_type), pointer :: p_desc_U=>null(), p_desc_V=>null() + type(psb_desc_type) :: desc_U, desc_V contains procedure, pass(map) :: sizeof => base_map_sizeof procedure, pass(map) :: is_ok => base_is_ok @@ -93,11 +94,11 @@ contains select case(map%get_kind()) case (psb_map_aggr_) - if (.not.associated(map%p_desc_X)) return - if (.not.associated(map%p_desc_Y)) return - res = map%p_desc_X%is_ok().and.map%p_desc_Y%is_ok() + 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() case(psb_map_gen_linear_) - res = map%desc_X%is_ok().and.map%desc_Y%is_ok() + res = map%desc_U%is_ok().and.map%desc_V%is_ok() end select end function base_is_ok @@ -111,11 +112,11 @@ contains select case(map%get_kind()) case (psb_map_aggr_) - if (.not.associated(map%p_desc_X)) return - if (.not.associated(map%p_desc_Y)) return - res = map%p_desc_X%is_asb().and.map%p_desc_Y%is_asb() + 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() case(psb_map_gen_linear_) - res = map%desc_X%is_asb().and.map%desc_Y%is_asb() + res = map%desc_U%is_asb().and.map%desc_V%is_asb() end select end function base_is_asb @@ -131,8 +132,8 @@ contains & val = val + psb_sizeof_int*size(map%iaggr) if (allocated(map%naggr)) & & val = val + psb_sizeof_int*size(map%naggr) - val = val + map%desc_X%sizeof() - val = val + map%desc_Y%sizeof() + val = val + map%desc_U%sizeof() + val = val + map%desc_V%sizeof() end function base_map_sizeof @@ -147,12 +148,12 @@ contains mapout%kind = mapin%kind call psb_move_alloc(mapin%iaggr,mapout%iaggr,info) call psb_move_alloc(mapin%naggr,mapout%naggr,info) - mapout%p_desc_X => mapin%p_desc_X - mapin%p_desc_X => null() - mapout%p_desc_Y => mapin%p_desc_Y - mapin%p_desc_Y => null() - call psb_move_alloc(mapin%desc_X,mapout%desc_X,info) - call psb_move_alloc(mapin%desc_Y,mapout%desc_Y,info) + mapout%p_desc_U => mapin%p_desc_U + mapin%p_desc_U => null() + mapout%p_desc_V => mapin%p_desc_V + mapin%p_desc_V => null() + call psb_move_alloc(mapin%desc_U,mapout%desc_U,info) + call psb_move_alloc(mapin%desc_V,mapout%desc_V,info) end subroutine psb_base_linmap_transfer @@ -169,10 +170,10 @@ contains mapout%kind = map%kind call psb_safe_ab_cpy(map%iaggr,mapout%iaggr,info) call psb_safe_ab_cpy(map%naggr,mapout%naggr,info) - mapout%p_desc_X => map%p_desc_X - mapout%p_desc_Y => map%p_desc_Y - call map%desc_X%clone(mapout%desc_X,info) - call map%desc_Y%clone(mapout%desc_Y,info) + mapout%p_desc_U => map%p_desc_U + mapout%p_desc_V => map%p_desc_V + call map%desc_U%clone(mapout%desc_U,info) + call map%desc_V%clone(mapout%desc_V,info) end subroutine base_clone @@ -186,10 +187,10 @@ contains & deallocate(map%iaggr,stat=info) if (allocated(map%naggr)) & & deallocate(map%naggr,stat=info) - map%p_desc_X => null() - map%p_desc_Y => null() - if (map%desc_X%is_ok()) call map%desc_X%free(info) - if (map%desc_Y%is_ok()) call map%desc_Y%free(info) + map%p_desc_U => null() + map%p_desc_V => null() + if (map%desc_U%is_ok()) call map%desc_U%free(info) + if (map%desc_V%is_ok()) call map%desc_V%free(info) end subroutine base_free diff --git a/base/modules/comm/psb_c_linmap_mod.f90 b/base/modules/comm/psb_c_linmap_mod.f90 index 90301141..27e469a5 100644 --- a/base/modules/comm/psb_c_linmap_mod.f90 +++ b/base/modules/comm/psb_c_linmap_mod.f90 @@ -44,8 +44,16 @@ module psb_c_linmap_mod type, extends(psb_base_linmap_type) :: psb_clinmap_type - type(psb_cspmat_type) :: map_X2Y, map_Y2X + type(psb_cspmat_type) :: mat_U2V, mat_V2U contains + procedure, pass(map) :: map_U2V_a => psb_c_map_U2V_a + procedure, pass(map) :: map_U2V_v => psb_c_map_U2V_v + generic, public :: map_U2V => map_U2V_a, map_U2V_v + + procedure, pass(map) :: map_V2U_a => psb_c_map_V2U_a + procedure, pass(map) :: map_V2U_v => psb_c_map_V2U_v + generic, public :: map_V2U => map_V2U_a, map_V2U_v + procedure, pass(map) :: sizeof => c_map_sizeof procedure, pass(map) :: is_asb => c_is_asb procedure, pass(map) :: free => c_free @@ -54,52 +62,52 @@ module psb_c_linmap_mod end type psb_clinmap_type - interface psb_map_X2Y - subroutine psb_c_map_X2Y(alpha,x,beta,y,map,info,work) + interface psb_map_U2V + subroutine psb_c_map_U2V_a(alpha,x,beta,y,map,info,work) import :: psb_ipk_, psb_spk_, psb_clinmap_type implicit none - type(psb_clinmap_type), intent(in) :: map + class(psb_clinmap_type), intent(in) :: map complex(psb_spk_), intent(in) :: alpha,beta complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(out) :: y(:) integer(psb_ipk_), intent(out) :: info complex(psb_spk_), optional :: work(:) - end subroutine psb_c_map_X2Y - subroutine psb_c_map_X2Y_vect(alpha,x,beta,y,map,info,work,vtx,vty) + end subroutine psb_c_map_U2V_a + subroutine psb_c_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) use psb_c_vect_mod, only : psb_c_vect_type import :: psb_ipk_, psb_spk_, psb_clinmap_type implicit none - type(psb_clinmap_type), intent(in) :: map + class(psb_clinmap_type), intent(in) :: map complex(psb_spk_), intent(in) :: alpha,beta type(psb_c_vect_type), intent(inout) :: x,y integer(psb_ipk_), intent(out) :: info complex(psb_spk_), optional :: work(:) type(psb_c_vect_type), optional, target, intent(inout) :: vtx,vty - end subroutine psb_c_map_X2Y_vect + end subroutine psb_c_map_U2V_v end interface - interface psb_map_Y2X - subroutine psb_c_map_Y2X(alpha,x,beta,y,map,info,work) + interface psb_map_V2U + subroutine psb_c_map_V2U_a(alpha,x,beta,y,map,info,work) import :: psb_ipk_, psb_spk_, psb_clinmap_type implicit none - type(psb_clinmap_type), intent(in) :: map + class(psb_clinmap_type), intent(in) :: map complex(psb_spk_), intent(in) :: alpha,beta complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(out) :: y(:) integer(psb_ipk_), intent(out) :: info complex(psb_spk_), optional :: work(:) - end subroutine psb_c_map_Y2X - subroutine psb_c_map_Y2X_vect(alpha,x,beta,y,map,info,work,vtx,vty) + end subroutine psb_c_map_V2U_a + subroutine psb_c_map_V2U_v(alpha,x,beta,y,map,info,work,vtx,vty) use psb_c_vect_mod, only : psb_c_vect_type import :: psb_ipk_, psb_spk_, psb_clinmap_type implicit none - type(psb_clinmap_type), intent(in) :: map + class(psb_clinmap_type), intent(in) :: map complex(psb_spk_), intent(in) :: alpha,beta type(psb_c_vect_type), intent(inout) :: x,y integer(psb_ipk_), intent(out) :: info complex(psb_spk_), optional :: work(:) type(psb_c_vect_type), optional, target, intent(inout) :: vtx,vty - end subroutine psb_c_map_Y2X_vect + end subroutine psb_c_map_V2U_v end interface @@ -116,13 +124,13 @@ module psb_c_linmap_mod end interface interface psb_linmap - function psb_c_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) + function psb_c_linmap(map_kind,desc_U, desc_V, mat_U2V, mat_V2U,iaggr,naggr) use psb_c_mat_mod, only : psb_cspmat_type import :: psb_ipk_, psb_clinmap_type, psb_desc_type implicit none type(psb_clinmap_type) :: psb_c_linmap - type(psb_desc_type), target :: desc_X, desc_Y - type(psb_cspmat_type), intent(inout) :: map_X2Y, map_Y2X + type(psb_desc_type), target :: desc_U, desc_V + type(psb_cspmat_type), intent(inout) :: mat_U2V, mat_V2U integer(psb_ipk_), intent(in) :: map_kind integer(psb_ipk_), intent(in), optional :: iaggr(:), naggr(:) end function psb_c_linmap @@ -144,8 +152,8 @@ contains integer(psb_long_int_k_) :: val val = map%psb_base_linmap_type%sizeof() - val = val + map%map_X2Y%sizeof() - val = val + map%map_Y2X%sizeof() + val = val + map%mat_U2V%sizeof() + val = val + map%mat_V2U%sizeof() end function c_map_sizeof @@ -157,7 +165,7 @@ contains logical :: val val = map%psb_base_linmap_type%is_asb() .and. & - & map%map_X2Y%is_asb() .and.map%map_Y2X%is_asb() + & map%mat_U2V%is_asb() .and.map%mat_V2U%is_asb() end function c_is_asb @@ -172,27 +180,27 @@ contains class(psb_c_base_sparse_mat), intent(in), optional :: mold class(psb_i_base_vect_type), intent(in), optional :: imold - if (map%map_X2Y%is_asb())& - & call map%map_X2Y%cscnv(info,type=type,mold=mold) - if (info == psb_success_ .and.map%map_Y2X%is_asb())& - & call map%map_Y2X%cscnv(info,type=type,mold=mold) + if (map%mat_U2V%is_asb())& + & call map%mat_U2V%cscnv(info,type=type,mold=mold) + if (info == psb_success_ .and.map%mat_V2U%is_asb())& + & call map%mat_V2U%cscnv(info,type=type,mold=mold) if (present(imold)) then - call map%desc_X%cnv(mold=imold) - call map%desc_Y%cnv(mold=imold) + call map%desc_U%cnv(mold=imold) + call map%desc_V%cnv(mold=imold) end if end subroutine psb_c_map_cscnv - subroutine psb_c_linmap_sub(out_map,map_kind,desc_X, desc_Y,& - & map_X2Y, map_Y2X,iaggr,naggr) + subroutine psb_c_linmap_sub(out_map,map_kind,desc_U, desc_V,& + & mat_U2V, mat_V2U,iaggr,naggr) use psb_c_mat_mod implicit none type(psb_clinmap_type), intent(out) :: out_map - type(psb_desc_type), target :: desc_X, desc_Y - type(psb_cspmat_type), intent(inout) :: map_X2Y, map_Y2X + type(psb_desc_type), target :: desc_U, desc_V + type(psb_cspmat_type), intent(inout) :: mat_U2V, mat_V2U integer(psb_ipk_), intent(in) :: map_kind integer(psb_ipk_), intent(in), optional :: iaggr(:), naggr(:) - out_map = psb_linmap(map_kind,desc_X,desc_Y,map_X2Y,map_Y2X,iaggr,naggr) + out_map = psb_linmap(map_kind,desc_U,desc_V,mat_U2V,mat_V2U,iaggr,naggr) end subroutine psb_c_linmap_sub subroutine psb_clinmap_transfer(mapin,mapout,info) @@ -205,8 +213,8 @@ contains call psb_move_alloc(mapin%psb_base_linmap_type, & & mapout%psb_base_linmap_type,info) - call psb_move_alloc(mapin%map_X2Y,mapout%map_X2Y,info) - call psb_move_alloc(mapin%map_Y2X,mapout%map_Y2X,info) + call psb_move_alloc(mapin%mat_U2V,mapout%mat_U2V,info) + call psb_move_alloc(mapin%mat_V2U,mapout%mat_V2U,info) end subroutine psb_clinmap_transfer @@ -218,8 +226,8 @@ contains call map%psb_base_linmap_type%free(info) - call map%map_X2Y%free() - call map%map_Y2X%free() + call map%mat_U2V%free() + call map%mat_V2U%free() end subroutine c_free @@ -243,8 +251,8 @@ contains ! Base clone! if (info == 0) call & & map%psb_base_linmap_type%clone(mout%psb_base_linmap_type,info) - if (info == 0) call map%map_X2Y%clone(mout%map_X2Y,info) - if (info == 0) call map%map_Y2X%clone(mout%map_Y2X,info) + if (info == 0) call map%mat_U2V%clone(mout%mat_U2V,info) + if (info == 0) call map%mat_V2U%clone(mout%mat_V2U,info) class default info = psb_err_invalid_dynamic_type_ ierr(1) = 2 diff --git a/base/modules/comm/psb_d_linmap_mod.f90 b/base/modules/comm/psb_d_linmap_mod.f90 index 9fd661d8..388f4388 100644 --- a/base/modules/comm/psb_d_linmap_mod.f90 +++ b/base/modules/comm/psb_d_linmap_mod.f90 @@ -44,8 +44,16 @@ module psb_d_linmap_mod type, extends(psb_base_linmap_type) :: psb_dlinmap_type - type(psb_dspmat_type) :: map_X2Y, map_Y2X + type(psb_dspmat_type) :: mat_U2V, mat_V2U contains + procedure, pass(map) :: map_U2V_a => psb_d_map_U2V_a + procedure, pass(map) :: map_U2V_v => psb_d_map_U2V_v + generic, public :: map_U2V => map_U2V_a, map_U2V_v + + procedure, pass(map) :: map_V2U_a => psb_d_map_V2U_a + procedure, pass(map) :: map_V2U_v => psb_d_map_V2U_v + generic, public :: map_V2U => map_V2U_a, map_V2U_v + procedure, pass(map) :: sizeof => d_map_sizeof procedure, pass(map) :: is_asb => d_is_asb procedure, pass(map) :: free => d_free @@ -54,52 +62,52 @@ module psb_d_linmap_mod end type psb_dlinmap_type - interface psb_map_X2Y - subroutine psb_d_map_X2Y(alpha,x,beta,y,map,info,work) + interface psb_map_U2V + subroutine psb_d_map_U2V_a(alpha,x,beta,y,map,info,work) import :: psb_ipk_, psb_dpk_, psb_dlinmap_type implicit none - type(psb_dlinmap_type), intent(in) :: map + class(psb_dlinmap_type), intent(in) :: map real(psb_dpk_), intent(in) :: alpha,beta real(psb_dpk_), intent(inout) :: x(:) real(psb_dpk_), intent(out) :: y(:) integer(psb_ipk_), intent(out) :: info real(psb_dpk_), optional :: work(:) - end subroutine psb_d_map_X2Y - subroutine psb_d_map_X2Y_vect(alpha,x,beta,y,map,info,work,vtx,vty) + end subroutine psb_d_map_U2V_a + subroutine psb_d_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) use psb_d_vect_mod, only : psb_d_vect_type import :: psb_ipk_, psb_dpk_, psb_dlinmap_type implicit none - type(psb_dlinmap_type), intent(in) :: map + class(psb_dlinmap_type), intent(in) :: map real(psb_dpk_), intent(in) :: alpha,beta type(psb_d_vect_type), intent(inout) :: x,y integer(psb_ipk_), intent(out) :: info real(psb_dpk_), optional :: work(:) type(psb_d_vect_type), optional, target, intent(inout) :: vtx,vty - end subroutine psb_d_map_X2Y_vect + end subroutine psb_d_map_U2V_v end interface - interface psb_map_Y2X - subroutine psb_d_map_Y2X(alpha,x,beta,y,map,info,work) + interface psb_map_V2U + subroutine psb_d_map_V2U_a(alpha,x,beta,y,map,info,work) import :: psb_ipk_, psb_dpk_, psb_dlinmap_type implicit none - type(psb_dlinmap_type), intent(in) :: map + class(psb_dlinmap_type), intent(in) :: map real(psb_dpk_), intent(in) :: alpha,beta real(psb_dpk_), intent(inout) :: x(:) real(psb_dpk_), intent(out) :: y(:) integer(psb_ipk_), intent(out) :: info real(psb_dpk_), optional :: work(:) - end subroutine psb_d_map_Y2X - subroutine psb_d_map_Y2X_vect(alpha,x,beta,y,map,info,work,vtx,vty) + end subroutine psb_d_map_V2U_a + subroutine psb_d_map_V2U_v(alpha,x,beta,y,map,info,work,vtx,vty) use psb_d_vect_mod, only : psb_d_vect_type import :: psb_ipk_, psb_dpk_, psb_dlinmap_type implicit none - type(psb_dlinmap_type), intent(in) :: map + class(psb_dlinmap_type), intent(in) :: map real(psb_dpk_), intent(in) :: alpha,beta type(psb_d_vect_type), intent(inout) :: x,y integer(psb_ipk_), intent(out) :: info real(psb_dpk_), optional :: work(:) type(psb_d_vect_type), optional, target, intent(inout) :: vtx,vty - end subroutine psb_d_map_Y2X_vect + end subroutine psb_d_map_V2U_v end interface @@ -116,13 +124,13 @@ module psb_d_linmap_mod end interface interface psb_linmap - function psb_d_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) + function psb_d_linmap(map_kind,desc_U, desc_V, mat_U2V, mat_V2U,iaggr,naggr) use psb_d_mat_mod, only : psb_dspmat_type import :: psb_ipk_, psb_dlinmap_type, psb_desc_type implicit none type(psb_dlinmap_type) :: psb_d_linmap - type(psb_desc_type), target :: desc_X, desc_Y - type(psb_dspmat_type), intent(inout) :: map_X2Y, map_Y2X + type(psb_desc_type), target :: desc_U, desc_V + type(psb_dspmat_type), intent(inout) :: mat_U2V, mat_V2U integer(psb_ipk_), intent(in) :: map_kind integer(psb_ipk_), intent(in), optional :: iaggr(:), naggr(:) end function psb_d_linmap @@ -144,8 +152,8 @@ contains integer(psb_long_int_k_) :: val val = map%psb_base_linmap_type%sizeof() - val = val + map%map_X2Y%sizeof() - val = val + map%map_Y2X%sizeof() + val = val + map%mat_U2V%sizeof() + val = val + map%mat_V2U%sizeof() end function d_map_sizeof @@ -157,7 +165,7 @@ contains logical :: val val = map%psb_base_linmap_type%is_asb() .and. & - & map%map_X2Y%is_asb() .and.map%map_Y2X%is_asb() + & map%mat_U2V%is_asb() .and.map%mat_V2U%is_asb() end function d_is_asb @@ -172,27 +180,27 @@ contains class(psb_d_base_sparse_mat), intent(in), optional :: mold class(psb_i_base_vect_type), intent(in), optional :: imold - if (map%map_X2Y%is_asb())& - & call map%map_X2Y%cscnv(info,type=type,mold=mold) - if (info == psb_success_ .and.map%map_Y2X%is_asb())& - & call map%map_Y2X%cscnv(info,type=type,mold=mold) + if (map%mat_U2V%is_asb())& + & call map%mat_U2V%cscnv(info,type=type,mold=mold) + if (info == psb_success_ .and.map%mat_V2U%is_asb())& + & call map%mat_V2U%cscnv(info,type=type,mold=mold) if (present(imold)) then - call map%desc_X%cnv(mold=imold) - call map%desc_Y%cnv(mold=imold) + call map%desc_U%cnv(mold=imold) + call map%desc_V%cnv(mold=imold) end if end subroutine psb_d_map_cscnv - subroutine psb_d_linmap_sub(out_map,map_kind,desc_X, desc_Y,& - & map_X2Y, map_Y2X,iaggr,naggr) + subroutine psb_d_linmap_sub(out_map,map_kind,desc_U, desc_V,& + & mat_U2V, mat_V2U,iaggr,naggr) use psb_d_mat_mod implicit none type(psb_dlinmap_type), intent(out) :: out_map - type(psb_desc_type), target :: desc_X, desc_Y - type(psb_dspmat_type), intent(inout) :: map_X2Y, map_Y2X + type(psb_desc_type), target :: desc_U, desc_V + type(psb_dspmat_type), intent(inout) :: mat_U2V, mat_V2U integer(psb_ipk_), intent(in) :: map_kind integer(psb_ipk_), intent(in), optional :: iaggr(:), naggr(:) - out_map = psb_linmap(map_kind,desc_X,desc_Y,map_X2Y,map_Y2X,iaggr,naggr) + out_map = psb_linmap(map_kind,desc_U,desc_V,mat_U2V,mat_V2U,iaggr,naggr) end subroutine psb_d_linmap_sub subroutine psb_dlinmap_transfer(mapin,mapout,info) @@ -205,8 +213,8 @@ contains call psb_move_alloc(mapin%psb_base_linmap_type, & & mapout%psb_base_linmap_type,info) - call psb_move_alloc(mapin%map_X2Y,mapout%map_X2Y,info) - call psb_move_alloc(mapin%map_Y2X,mapout%map_Y2X,info) + call psb_move_alloc(mapin%mat_U2V,mapout%mat_U2V,info) + call psb_move_alloc(mapin%mat_V2U,mapout%mat_V2U,info) end subroutine psb_dlinmap_transfer @@ -218,8 +226,8 @@ contains call map%psb_base_linmap_type%free(info) - call map%map_X2Y%free() - call map%map_Y2X%free() + call map%mat_U2V%free() + call map%mat_V2U%free() end subroutine d_free @@ -243,8 +251,8 @@ contains ! Base clone! if (info == 0) call & & map%psb_base_linmap_type%clone(mout%psb_base_linmap_type,info) - if (info == 0) call map%map_X2Y%clone(mout%map_X2Y,info) - if (info == 0) call map%map_Y2X%clone(mout%map_Y2X,info) + if (info == 0) call map%mat_U2V%clone(mout%mat_U2V,info) + if (info == 0) call map%mat_V2U%clone(mout%mat_V2U,info) class default info = psb_err_invalid_dynamic_type_ ierr(1) = 2 diff --git a/base/modules/comm/psb_s_linmap_mod.f90 b/base/modules/comm/psb_s_linmap_mod.f90 index 5e44e2c9..ad0276db 100644 --- a/base/modules/comm/psb_s_linmap_mod.f90 +++ b/base/modules/comm/psb_s_linmap_mod.f90 @@ -44,8 +44,16 @@ module psb_s_linmap_mod type, extends(psb_base_linmap_type) :: psb_slinmap_type - type(psb_sspmat_type) :: map_X2Y, map_Y2X + type(psb_sspmat_type) :: mat_U2V, mat_V2U contains + procedure, pass(map) :: map_U2V_a => psb_s_map_U2V_a + procedure, pass(map) :: map_U2V_v => psb_s_map_U2V_v + generic, public :: map_U2V => map_U2V_a, map_U2V_v + + procedure, pass(map) :: map_V2U_a => psb_s_map_V2U_a + procedure, pass(map) :: map_V2U_v => psb_s_map_V2U_v + generic, public :: map_V2U => map_V2U_a, map_V2U_v + procedure, pass(map) :: sizeof => s_map_sizeof procedure, pass(map) :: is_asb => s_is_asb procedure, pass(map) :: free => s_free @@ -54,52 +62,52 @@ module psb_s_linmap_mod end type psb_slinmap_type - interface psb_map_X2Y - subroutine psb_s_map_X2Y(alpha,x,beta,y,map,info,work) + interface psb_map_U2V + subroutine psb_s_map_U2V_a(alpha,x,beta,y,map,info,work) import :: psb_ipk_, psb_spk_, psb_slinmap_type implicit none - type(psb_slinmap_type), intent(in) :: map + class(psb_slinmap_type), intent(in) :: map real(psb_spk_), intent(in) :: alpha,beta real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(out) :: y(:) integer(psb_ipk_), intent(out) :: info real(psb_spk_), optional :: work(:) - end subroutine psb_s_map_X2Y - subroutine psb_s_map_X2Y_vect(alpha,x,beta,y,map,info,work,vtx,vty) + end subroutine psb_s_map_U2V_a + subroutine psb_s_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) use psb_s_vect_mod, only : psb_s_vect_type import :: psb_ipk_, psb_spk_, psb_slinmap_type implicit none - type(psb_slinmap_type), intent(in) :: map + class(psb_slinmap_type), intent(in) :: map real(psb_spk_), intent(in) :: alpha,beta type(psb_s_vect_type), intent(inout) :: x,y integer(psb_ipk_), intent(out) :: info real(psb_spk_), optional :: work(:) type(psb_s_vect_type), optional, target, intent(inout) :: vtx,vty - end subroutine psb_s_map_X2Y_vect + end subroutine psb_s_map_U2V_v end interface - interface psb_map_Y2X - subroutine psb_s_map_Y2X(alpha,x,beta,y,map,info,work) + interface psb_map_V2U + subroutine psb_s_map_V2U_a(alpha,x,beta,y,map,info,work) import :: psb_ipk_, psb_spk_, psb_slinmap_type implicit none - type(psb_slinmap_type), intent(in) :: map + class(psb_slinmap_type), intent(in) :: map real(psb_spk_), intent(in) :: alpha,beta real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(out) :: y(:) integer(psb_ipk_), intent(out) :: info real(psb_spk_), optional :: work(:) - end subroutine psb_s_map_Y2X - subroutine psb_s_map_Y2X_vect(alpha,x,beta,y,map,info,work,vtx,vty) + end subroutine psb_s_map_V2U_a + subroutine psb_s_map_V2U_v(alpha,x,beta,y,map,info,work,vtx,vty) use psb_s_vect_mod, only : psb_s_vect_type import :: psb_ipk_, psb_spk_, psb_slinmap_type implicit none - type(psb_slinmap_type), intent(in) :: map + class(psb_slinmap_type), intent(in) :: map real(psb_spk_), intent(in) :: alpha,beta type(psb_s_vect_type), intent(inout) :: x,y integer(psb_ipk_), intent(out) :: info real(psb_spk_), optional :: work(:) type(psb_s_vect_type), optional, target, intent(inout) :: vtx,vty - end subroutine psb_s_map_Y2X_vect + end subroutine psb_s_map_V2U_v end interface @@ -116,13 +124,13 @@ module psb_s_linmap_mod end interface interface psb_linmap - function psb_s_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) + function psb_s_linmap(map_kind,desc_U, desc_V, mat_U2V, mat_V2U,iaggr,naggr) use psb_s_mat_mod, only : psb_sspmat_type import :: psb_ipk_, psb_slinmap_type, psb_desc_type implicit none type(psb_slinmap_type) :: psb_s_linmap - type(psb_desc_type), target :: desc_X, desc_Y - type(psb_sspmat_type), intent(inout) :: map_X2Y, map_Y2X + type(psb_desc_type), target :: desc_U, desc_V + type(psb_sspmat_type), intent(inout) :: mat_U2V, mat_V2U integer(psb_ipk_), intent(in) :: map_kind integer(psb_ipk_), intent(in), optional :: iaggr(:), naggr(:) end function psb_s_linmap @@ -144,8 +152,8 @@ contains integer(psb_long_int_k_) :: val val = map%psb_base_linmap_type%sizeof() - val = val + map%map_X2Y%sizeof() - val = val + map%map_Y2X%sizeof() + val = val + map%mat_U2V%sizeof() + val = val + map%mat_V2U%sizeof() end function s_map_sizeof @@ -157,7 +165,7 @@ contains logical :: val val = map%psb_base_linmap_type%is_asb() .and. & - & map%map_X2Y%is_asb() .and.map%map_Y2X%is_asb() + & map%mat_U2V%is_asb() .and.map%mat_V2U%is_asb() end function s_is_asb @@ -172,27 +180,27 @@ contains class(psb_s_base_sparse_mat), intent(in), optional :: mold class(psb_i_base_vect_type), intent(in), optional :: imold - if (map%map_X2Y%is_asb())& - & call map%map_X2Y%cscnv(info,type=type,mold=mold) - if (info == psb_success_ .and.map%map_Y2X%is_asb())& - & call map%map_Y2X%cscnv(info,type=type,mold=mold) + if (map%mat_U2V%is_asb())& + & call map%mat_U2V%cscnv(info,type=type,mold=mold) + if (info == psb_success_ .and.map%mat_V2U%is_asb())& + & call map%mat_V2U%cscnv(info,type=type,mold=mold) if (present(imold)) then - call map%desc_X%cnv(mold=imold) - call map%desc_Y%cnv(mold=imold) + call map%desc_U%cnv(mold=imold) + call map%desc_V%cnv(mold=imold) end if end subroutine psb_s_map_cscnv - subroutine psb_s_linmap_sub(out_map,map_kind,desc_X, desc_Y,& - & map_X2Y, map_Y2X,iaggr,naggr) + subroutine psb_s_linmap_sub(out_map,map_kind,desc_U, desc_V,& + & mat_U2V, mat_V2U,iaggr,naggr) use psb_s_mat_mod implicit none type(psb_slinmap_type), intent(out) :: out_map - type(psb_desc_type), target :: desc_X, desc_Y - type(psb_sspmat_type), intent(inout) :: map_X2Y, map_Y2X + type(psb_desc_type), target :: desc_U, desc_V + type(psb_sspmat_type), intent(inout) :: mat_U2V, mat_V2U integer(psb_ipk_), intent(in) :: map_kind integer(psb_ipk_), intent(in), optional :: iaggr(:), naggr(:) - out_map = psb_linmap(map_kind,desc_X,desc_Y,map_X2Y,map_Y2X,iaggr,naggr) + out_map = psb_linmap(map_kind,desc_U,desc_V,mat_U2V,mat_V2U,iaggr,naggr) end subroutine psb_s_linmap_sub subroutine psb_slinmap_transfer(mapin,mapout,info) @@ -205,8 +213,8 @@ contains call psb_move_alloc(mapin%psb_base_linmap_type, & & mapout%psb_base_linmap_type,info) - call psb_move_alloc(mapin%map_X2Y,mapout%map_X2Y,info) - call psb_move_alloc(mapin%map_Y2X,mapout%map_Y2X,info) + call psb_move_alloc(mapin%mat_U2V,mapout%mat_U2V,info) + call psb_move_alloc(mapin%mat_V2U,mapout%mat_V2U,info) end subroutine psb_slinmap_transfer @@ -218,8 +226,8 @@ contains call map%psb_base_linmap_type%free(info) - call map%map_X2Y%free() - call map%map_Y2X%free() + call map%mat_U2V%free() + call map%mat_V2U%free() end subroutine s_free @@ -243,8 +251,8 @@ contains ! Base clone! if (info == 0) call & & map%psb_base_linmap_type%clone(mout%psb_base_linmap_type,info) - if (info == 0) call map%map_X2Y%clone(mout%map_X2Y,info) - if (info == 0) call map%map_Y2X%clone(mout%map_Y2X,info) + if (info == 0) call map%mat_U2V%clone(mout%mat_U2V,info) + if (info == 0) call map%mat_V2U%clone(mout%mat_V2U,info) class default info = psb_err_invalid_dynamic_type_ ierr(1) = 2 diff --git a/base/modules/comm/psb_z_linmap_mod.f90 b/base/modules/comm/psb_z_linmap_mod.f90 index d7159433..c9e008d1 100644 --- a/base/modules/comm/psb_z_linmap_mod.f90 +++ b/base/modules/comm/psb_z_linmap_mod.f90 @@ -44,8 +44,16 @@ module psb_z_linmap_mod type, extends(psb_base_linmap_type) :: psb_zlinmap_type - type(psb_zspmat_type) :: map_X2Y, map_Y2X + type(psb_zspmat_type) :: mat_U2V, mat_V2U contains + procedure, pass(map) :: map_U2V_a => psb_z_map_U2V_a + procedure, pass(map) :: map_U2V_v => psb_z_map_U2V_v + generic, public :: map_U2V => map_U2V_a, map_U2V_v + + procedure, pass(map) :: map_V2U_a => psb_z_map_V2U_a + procedure, pass(map) :: map_V2U_v => psb_z_map_V2U_v + generic, public :: map_V2U => map_V2U_a, map_V2U_v + procedure, pass(map) :: sizeof => z_map_sizeof procedure, pass(map) :: is_asb => z_is_asb procedure, pass(map) :: free => z_free @@ -54,52 +62,52 @@ module psb_z_linmap_mod end type psb_zlinmap_type - interface psb_map_X2Y - subroutine psb_z_map_X2Y(alpha,x,beta,y,map,info,work) + interface psb_map_U2V + subroutine psb_z_map_U2V_a(alpha,x,beta,y,map,info,work) import :: psb_ipk_, psb_dpk_, psb_zlinmap_type implicit none - type(psb_zlinmap_type), intent(in) :: map + class(psb_zlinmap_type), intent(in) :: map complex(psb_dpk_), intent(in) :: alpha,beta complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(out) :: y(:) integer(psb_ipk_), intent(out) :: info complex(psb_dpk_), optional :: work(:) - end subroutine psb_z_map_X2Y - subroutine psb_z_map_X2Y_vect(alpha,x,beta,y,map,info,work,vtx,vty) + end subroutine psb_z_map_U2V_a + subroutine psb_z_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) use psb_z_vect_mod, only : psb_z_vect_type import :: psb_ipk_, psb_dpk_, psb_zlinmap_type implicit none - type(psb_zlinmap_type), intent(in) :: map + class(psb_zlinmap_type), intent(in) :: map complex(psb_dpk_), intent(in) :: alpha,beta type(psb_z_vect_type), intent(inout) :: x,y integer(psb_ipk_), intent(out) :: info complex(psb_dpk_), optional :: work(:) type(psb_z_vect_type), optional, target, intent(inout) :: vtx,vty - end subroutine psb_z_map_X2Y_vect + end subroutine psb_z_map_U2V_v end interface - interface psb_map_Y2X - subroutine psb_z_map_Y2X(alpha,x,beta,y,map,info,work) + interface psb_map_V2U + subroutine psb_z_map_V2U_a(alpha,x,beta,y,map,info,work) import :: psb_ipk_, psb_dpk_, psb_zlinmap_type implicit none - type(psb_zlinmap_type), intent(in) :: map + class(psb_zlinmap_type), intent(in) :: map complex(psb_dpk_), intent(in) :: alpha,beta complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(out) :: y(:) integer(psb_ipk_), intent(out) :: info complex(psb_dpk_), optional :: work(:) - end subroutine psb_z_map_Y2X - subroutine psb_z_map_Y2X_vect(alpha,x,beta,y,map,info,work,vtx,vty) + end subroutine psb_z_map_V2U_a + subroutine psb_z_map_V2U_v(alpha,x,beta,y,map,info,work,vtx,vty) use psb_z_vect_mod, only : psb_z_vect_type import :: psb_ipk_, psb_dpk_, psb_zlinmap_type implicit none - type(psb_zlinmap_type), intent(in) :: map + class(psb_zlinmap_type), intent(in) :: map complex(psb_dpk_), intent(in) :: alpha,beta type(psb_z_vect_type), intent(inout) :: x,y integer(psb_ipk_), intent(out) :: info complex(psb_dpk_), optional :: work(:) type(psb_z_vect_type), optional, target, intent(inout) :: vtx,vty - end subroutine psb_z_map_Y2X_vect + end subroutine psb_z_map_V2U_v end interface @@ -116,13 +124,13 @@ module psb_z_linmap_mod end interface interface psb_linmap - function psb_z_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) + function psb_z_linmap(map_kind,desc_U, desc_V, mat_U2V, mat_V2U,iaggr,naggr) use psb_z_mat_mod, only : psb_zspmat_type import :: psb_ipk_, psb_zlinmap_type, psb_desc_type implicit none type(psb_zlinmap_type) :: psb_z_linmap - type(psb_desc_type), target :: desc_X, desc_Y - type(psb_zspmat_type), intent(inout) :: map_X2Y, map_Y2X + type(psb_desc_type), target :: desc_U, desc_V + type(psb_zspmat_type), intent(inout) :: mat_U2V, mat_V2U integer(psb_ipk_), intent(in) :: map_kind integer(psb_ipk_), intent(in), optional :: iaggr(:), naggr(:) end function psb_z_linmap @@ -144,8 +152,8 @@ contains integer(psb_long_int_k_) :: val val = map%psb_base_linmap_type%sizeof() - val = val + map%map_X2Y%sizeof() - val = val + map%map_Y2X%sizeof() + val = val + map%mat_U2V%sizeof() + val = val + map%mat_V2U%sizeof() end function z_map_sizeof @@ -157,7 +165,7 @@ contains logical :: val val = map%psb_base_linmap_type%is_asb() .and. & - & map%map_X2Y%is_asb() .and.map%map_Y2X%is_asb() + & map%mat_U2V%is_asb() .and.map%mat_V2U%is_asb() end function z_is_asb @@ -172,27 +180,27 @@ contains class(psb_z_base_sparse_mat), intent(in), optional :: mold class(psb_i_base_vect_type), intent(in), optional :: imold - if (map%map_X2Y%is_asb())& - & call map%map_X2Y%cscnv(info,type=type,mold=mold) - if (info == psb_success_ .and.map%map_Y2X%is_asb())& - & call map%map_Y2X%cscnv(info,type=type,mold=mold) + if (map%mat_U2V%is_asb())& + & call map%mat_U2V%cscnv(info,type=type,mold=mold) + if (info == psb_success_ .and.map%mat_V2U%is_asb())& + & call map%mat_V2U%cscnv(info,type=type,mold=mold) if (present(imold)) then - call map%desc_X%cnv(mold=imold) - call map%desc_Y%cnv(mold=imold) + call map%desc_U%cnv(mold=imold) + call map%desc_V%cnv(mold=imold) end if end subroutine psb_z_map_cscnv - subroutine psb_z_linmap_sub(out_map,map_kind,desc_X, desc_Y,& - & map_X2Y, map_Y2X,iaggr,naggr) + subroutine psb_z_linmap_sub(out_map,map_kind,desc_U, desc_V,& + & mat_U2V, mat_V2U,iaggr,naggr) use psb_z_mat_mod implicit none type(psb_zlinmap_type), intent(out) :: out_map - type(psb_desc_type), target :: desc_X, desc_Y - type(psb_zspmat_type), intent(inout) :: map_X2Y, map_Y2X + type(psb_desc_type), target :: desc_U, desc_V + type(psb_zspmat_type), intent(inout) :: mat_U2V, mat_V2U integer(psb_ipk_), intent(in) :: map_kind integer(psb_ipk_), intent(in), optional :: iaggr(:), naggr(:) - out_map = psb_linmap(map_kind,desc_X,desc_Y,map_X2Y,map_Y2X,iaggr,naggr) + out_map = psb_linmap(map_kind,desc_U,desc_V,mat_U2V,mat_V2U,iaggr,naggr) end subroutine psb_z_linmap_sub subroutine psb_zlinmap_transfer(mapin,mapout,info) @@ -205,8 +213,8 @@ contains call psb_move_alloc(mapin%psb_base_linmap_type, & & mapout%psb_base_linmap_type,info) - call psb_move_alloc(mapin%map_X2Y,mapout%map_X2Y,info) - call psb_move_alloc(mapin%map_Y2X,mapout%map_Y2X,info) + call psb_move_alloc(mapin%mat_U2V,mapout%mat_U2V,info) + call psb_move_alloc(mapin%mat_V2U,mapout%mat_V2U,info) end subroutine psb_zlinmap_transfer @@ -218,8 +226,8 @@ contains call map%psb_base_linmap_type%free(info) - call map%map_X2Y%free() - call map%map_Y2X%free() + call map%mat_U2V%free() + call map%mat_V2U%free() end subroutine z_free @@ -243,8 +251,8 @@ contains ! Base clone! if (info == 0) call & & map%psb_base_linmap_type%clone(mout%psb_base_linmap_type,info) - if (info == 0) call map%map_X2Y%clone(mout%map_X2Y,info) - if (info == 0) call map%map_Y2X%clone(mout%map_Y2X,info) + if (info == 0) call map%mat_U2V%clone(mout%mat_U2V,info) + if (info == 0) call map%mat_V2U%clone(mout%mat_V2U,info) class default info = psb_err_invalid_dynamic_type_ ierr(1) = 2 diff --git a/base/tools/psb_c_map.f90 b/base/tools/psb_c_map.f90 index 88745c4d..afbf189a 100644 --- a/base/tools/psb_c_map.f90 +++ b/base/tools/psb_c_map.f90 @@ -33,15 +33,15 @@ ! ! ! -! Takes a vector x from space map%p_desc_X and maps it onto -! map%p_desc_Y under map%map_X2Y possibly with communication +! Takes a vector x from space map%p_desc_U and maps it onto +! map%p_desc_V under map%mat_U2V possibly with communication ! due to exch_fw_idx ! -subroutine psb_c_map_X2Y(alpha,x,beta,y,map,info,work) - use psb_base_mod, psb_protect_name => psb_c_map_X2Y +subroutine psb_c_map_U2V_a(alpha,x,beta,y,map,info,work) + use psb_base_mod, psb_protect_name => psb_c_map_U2V_a implicit none - type(psb_clinmap_type), intent(in) :: map + class(psb_clinmap_type), intent(in) :: map complex(psb_spk_), intent(in) :: alpha,beta complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(out) :: y(:) @@ -52,7 +52,7 @@ subroutine psb_c_map_X2Y(alpha,x,beta,y,map,info,work) complex(psb_spk_), allocatable :: xt(:), yt(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2,& & map_kind, nr, ictxt - character(len=20), parameter :: name='psb_map_X2Y' + character(len=20), parameter :: name='psb_map_U2V' info = psb_success_ if (.not.map%is_asb()) then @@ -66,16 +66,16 @@ subroutine psb_c_map_X2Y(alpha,x,beta,y,map,info,work) select case(map_kind) case(psb_map_aggr_) - ictxt = map%p_desc_Y%get_context() - nr2 = map%p_desc_Y%get_global_rows() - nc2 = map%p_desc_Y%get_local_cols() + ictxt = map%p_desc_V%get_context() + nr2 = map%p_desc_V%get_global_rows() + nc2 = map%p_desc_V%get_local_cols() allocate(yt(nc2),stat=info) - if (info == psb_success_) call psb_halo(x,map%p_desc_X,info,work=work) - if (info == psb_success_) call psb_csmm(cone,map%map_X2Y,x,czero,yt,info) - if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_Y)) then + if (info == psb_success_) call psb_halo(x,map%p_desc_U,info,work=work) + if (info == psb_success_) call psb_csmm(cone,map%mat_U2V,x,czero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_V)) then call psb_sum(ictxt,yt(1:nr2)) end if - if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_Y,info) + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_V,info) if (info /= psb_success_) then write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 @@ -83,19 +83,19 @@ subroutine psb_c_map_X2Y(alpha,x,beta,y,map,info,work) case(psb_map_gen_linear_) - ictxt = map%desc_Y%get_context() - nr1 = map%desc_X%get_local_rows() - nc1 = map%desc_X%get_local_cols() - nr2 = map%desc_Y%get_global_rows() - nc2 = map%desc_Y%get_local_cols() + ictxt = map%desc_V%get_context() + nr1 = map%desc_U%get_local_rows() + nc1 = map%desc_U%get_local_cols() + nr2 = map%desc_V%get_global_rows() + nc2 = map%desc_V%get_local_cols() allocate(xt(nc1),yt(nc2),stat=info) xt(1:nr1) = x(1:nr1) - if (info == psb_success_) call psb_halo(xt,map%desc_X,info,work=work) - if (info == psb_success_) call psb_csmm(cone,map%map_X2Y,xt,czero,yt,info) - if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_Y)) then + if (info == psb_success_) call psb_halo(xt,map%desc_U,info,work=work) + if (info == psb_success_) call psb_csmm(cone,map%mat_U2V,xt,czero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_V)) then call psb_sum(ictxt,yt(1:nr2)) end if - if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_Y,info) + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_V,info) if (info /= psb_success_) then write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 @@ -109,12 +109,12 @@ subroutine psb_c_map_X2Y(alpha,x,beta,y,map,info,work) return end select -end subroutine psb_c_map_X2Y +end subroutine psb_c_map_U2V_a -subroutine psb_c_map_X2Y_vect(alpha,x,beta,y,map,info,work,vtx,vty) - use psb_base_mod, psb_protect_name => psb_c_map_X2Y_vect +subroutine psb_c_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) + use psb_base_mod, psb_protect_name => psb_c_map_U2V_v implicit none - type(psb_clinmap_type), intent(in) :: map + class(psb_clinmap_type), intent(in) :: map complex(psb_spk_), intent(in) :: alpha,beta type(psb_c_vect_type), intent(inout) :: x,y integer(psb_ipk_), intent(out) :: info @@ -126,7 +126,7 @@ subroutine psb_c_map_X2Y_vect(alpha,x,beta,y,map,info,work,vtx,vty) complex(psb_spk_), allocatable :: xta(:), yta(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2 ,& & map_kind, nr, ictxt, iam, np - character(len=20), parameter :: name='psb_map_X2Yv' + character(len=20), parameter :: name='psb_map_U2V_v' info = psb_success_ if (.not.map%is_asb()) then @@ -140,24 +140,24 @@ subroutine psb_c_map_X2Y_vect(alpha,x,beta,y,map,info,work,vtx,vty) select case(map_kind) case(psb_map_aggr_) - ictxt = map%p_desc_Y%get_context() + ictxt = map%p_desc_V%get_context() call psb_info(ictxt,iam,np) - nr2 = map%p_desc_Y%get_global_rows() - nc2 = map%p_desc_Y%get_local_cols() + nr2 = map%p_desc_V%get_global_rows() + nc2 = map%p_desc_V%get_local_cols() if (present(vty)) then pty => vty else - call psb_geasb(yt,map%p_desc_Y,info,scratch=.true.,mold=x%v) + call psb_geasb(yt,map%p_desc_V,info,scratch=.true.,mold=x%v) pty => yt end if - if (info == psb_success_) call psb_halo(x,map%p_desc_X,info,work=work) - if (info == psb_success_) call psb_csmm(cone,map%map_X2Y,x,czero,pty,info) - if ((info == psb_success_) .and. map%p_desc_Y%is_repl().and.(np>1)) then + if (info == psb_success_) call psb_halo(x,map%p_desc_U,info,work=work) + if (info == psb_success_) call psb_csmm(cone,map%mat_U2V,x,czero,pty,info) + if ((info == psb_success_) .and. map%p_desc_V%is_repl().and.(np>1)) then yta = pty%get_vect() call psb_sum(ictxt,yta(1:nr2)) call pty%set(yta) end if - if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%p_desc_Y,info) + if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%p_desc_V,info) if (info /= psb_success_) then write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 @@ -167,32 +167,32 @@ subroutine psb_c_map_X2Y_vect(alpha,x,beta,y,map,info,work,vtx,vty) case(psb_map_gen_linear_) - ictxt = map%desc_Y%get_context() + ictxt = map%desc_V%get_context() call psb_info(ictxt,iam,np) - nr1 = map%desc_X%get_local_rows() - nc1 = map%desc_X%get_local_cols() - nr2 = map%desc_Y%get_global_rows() - nc2 = map%desc_Y%get_local_cols() + nr1 = map%desc_U%get_local_rows() + nc1 = map%desc_U%get_local_cols() + nr2 = map%desc_V%get_global_rows() + nc2 = map%desc_V%get_local_cols() if (present(vtx).and.present(vty)) then ptx => vtx pty => vty else - call psb_geasb(xt,map%desc_X,info,scratch=.true.,mold=x%v) - call psb_geasb(yt,map%desc_Y,info,scratch=.true.,mold=x%v) + call psb_geasb(xt,map%desc_U,info,scratch=.true.,mold=x%v) + call psb_geasb(yt,map%desc_V,info,scratch=.true.,mold=x%v) ptx => xt pty => yt end if - call psb_geaxpby(cone,x,czero,ptx,map%desc_X,info) - if (info == psb_success_) call psb_halo(ptx,map%desc_X,info,work=work) - if (info == psb_success_) call psb_csmm(cone,map%map_X2Y,ptx,czero,pty,info) - if ((info == psb_success_) .and. map%desc_Y%is_repl().and.(np>1)) then + call psb_geaxpby(cone,x,czero,ptx,map%desc_U,info) + if (info == psb_success_) call psb_halo(ptx,map%desc_U,info,work=work) + if (info == psb_success_) call psb_csmm(cone,map%mat_U2V,ptx,czero,pty,info) + if ((info == psb_success_) .and. map%desc_V%is_repl().and.(np>1)) then yta = pty%get_vect() call psb_sum(ictxt,yta(1:nr2)) call pty%set(yta) end if - if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%desc_Y,info) + if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%desc_V,info) if (info /= psb_success_) then write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 @@ -211,19 +211,19 @@ subroutine psb_c_map_X2Y_vect(alpha,x,beta,y,map,info,work,vtx,vty) end select return -end subroutine psb_c_map_X2Y_vect +end subroutine psb_c_map_U2V_v ! -! Takes a vector x from space map%p_desc_Y and maps it onto -! map%p_desc_X under map%map_Y2X possibly with communication +! Takes a vector x from space map%p_desc_V and maps it onto +! map%p_desc_U under map%mat_V2U possibly with communication ! due to exch_bk_idx ! -subroutine psb_c_map_Y2X(alpha,x,beta,y,map,info,work) - use psb_base_mod, psb_protect_name => psb_c_map_Y2X +subroutine psb_c_map_V2U_a(alpha,x,beta,y,map,info,work) + use psb_base_mod, psb_protect_name => psb_c_map_V2U_a implicit none - type(psb_clinmap_type), intent(in) :: map + class(psb_clinmap_type), intent(in) :: map complex(psb_spk_), intent(in) :: alpha,beta complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(out) :: y(:) @@ -234,7 +234,7 @@ subroutine psb_c_map_Y2X(alpha,x,beta,y,map,info,work) complex(psb_spk_), allocatable :: xt(:), yt(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2,& & map_kind, nr, ictxt - character(len=20), parameter :: name='psb_map_Y2X' + character(len=20), parameter :: name='psb_map_V2U' info = psb_success_ if (.not.map%is_asb()) then @@ -248,16 +248,16 @@ subroutine psb_c_map_Y2X(alpha,x,beta,y,map,info,work) select case(map_kind) case(psb_map_aggr_) - ictxt = map%p_desc_X%get_context() - nr2 = map%p_desc_X%get_global_rows() - nc2 = map%p_desc_X%get_local_cols() + ictxt = map%p_desc_U%get_context() + nr2 = map%p_desc_U%get_global_rows() + nc2 = map%p_desc_U%get_local_cols() allocate(yt(nc2),stat=info) - if (info == psb_success_) call psb_halo(x,map%p_desc_Y,info,work=work) - if (info == psb_success_) call psb_csmm(cone,map%map_Y2X,x,czero,yt,info) - if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_X)) then + if (info == psb_success_) call psb_halo(x,map%p_desc_V,info,work=work) + if (info == psb_success_) call psb_csmm(cone,map%mat_V2U,x,czero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_U)) then call psb_sum(ictxt,yt(1:nr2)) end if - if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_X,info) + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_U,info) if (info /= psb_success_) then write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 @@ -265,19 +265,19 @@ subroutine psb_c_map_Y2X(alpha,x,beta,y,map,info,work) case(psb_map_gen_linear_) - ictxt = map%desc_X%get_context() - nr1 = map%desc_Y%get_local_rows() - nc1 = map%desc_Y%get_local_cols() - nr2 = map%desc_X%get_global_rows() - nc2 = map%desc_X%get_local_cols() + ictxt = map%desc_U%get_context() + nr1 = map%desc_V%get_local_rows() + nc1 = map%desc_V%get_local_cols() + nr2 = map%desc_U%get_global_rows() + nc2 = map%desc_U%get_local_cols() allocate(xt(nc1),yt(nc2),stat=info) xt(1:nr1) = x(1:nr1) - if (info == psb_success_) call psb_halo(xt,map%desc_Y,info,work=work) - if (info == psb_success_) call psb_csmm(cone,map%map_Y2X,xt,czero,yt,info) - if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_X)) then + if (info == psb_success_) call psb_halo(xt,map%desc_V,info,work=work) + if (info == psb_success_) call psb_csmm(cone,map%mat_V2U,xt,czero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_U)) then call psb_sum(ictxt,yt(1:nr2)) end if - if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_X,info) + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_U,info) if (info /= psb_success_) then write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 @@ -290,12 +290,12 @@ subroutine psb_c_map_Y2X(alpha,x,beta,y,map,info,work) return end select -end subroutine psb_c_map_Y2X +end subroutine psb_c_map_V2U_a -subroutine psb_c_map_Y2X_vect(alpha,x,beta,y,map,info,work,vtx,vty) - use psb_base_mod, psb_protect_name => psb_c_map_Y2X_vect +subroutine psb_c_map_V2U_v(alpha,x,beta,y,map,info,work,vtx,vty) + use psb_base_mod, psb_protect_name => psb_c_map_V2U_v implicit none - type(psb_clinmap_type), intent(in) :: map + class(psb_clinmap_type), intent(in) :: map complex(psb_spk_), intent(in) :: alpha,beta type(psb_c_vect_type), intent(inout) :: x,y integer(psb_ipk_), intent(out) :: info @@ -307,7 +307,7 @@ subroutine psb_c_map_Y2X_vect(alpha,x,beta,y,map,info,work,vtx,vty) complex(psb_spk_), allocatable :: xta(:), yta(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2,& & map_kind, nr, ictxt, iam, np - character(len=20), parameter :: name='psb_map_Y2Xv' + character(len=20), parameter :: name='psb_map_V2U_v' info = psb_success_ if (.not.map%is_asb()) then @@ -321,24 +321,24 @@ subroutine psb_c_map_Y2X_vect(alpha,x,beta,y,map,info,work,vtx,vty) select case(map_kind) case(psb_map_aggr_) - ictxt = map%p_desc_X%get_context() + ictxt = map%p_desc_U%get_context() call psb_info(ictxt,iam,np) - nr2 = map%p_desc_X%get_global_rows() - nc2 = map%p_desc_X%get_local_cols() + nr2 = map%p_desc_U%get_global_rows() + nc2 = map%p_desc_U%get_local_cols() if (present(vty)) then pty => vty else - call psb_geasb(yt,map%p_desc_X,info,scratch=.true.,mold=x%v) + call psb_geasb(yt,map%p_desc_U,info,scratch=.true.,mold=x%v) pty => yt end if - if (info == psb_success_) call psb_halo(x,map%p_desc_Y,info,work=work) - if (info == psb_success_) call psb_csmm(cone,map%map_Y2X,x,czero,pty,info) - if ((info == psb_success_) .and. map%p_desc_X%is_repl().and.(np>1)) then + if (info == psb_success_) call psb_halo(x,map%p_desc_V,info,work=work) + if (info == psb_success_) call psb_csmm(cone,map%mat_V2U,x,czero,pty,info) + if ((info == psb_success_) .and. map%p_desc_U%is_repl().and.(np>1)) then yta = pty%get_vect() call psb_sum(ictxt,yta(1:nr2)) call pty%set(yta) end if - if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%p_desc_X,info) + if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%p_desc_U,info) if (info /= psb_success_) then write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 @@ -348,32 +348,32 @@ subroutine psb_c_map_Y2X_vect(alpha,x,beta,y,map,info,work,vtx,vty) case(psb_map_gen_linear_) - ictxt = map%desc_X%get_context() + ictxt = map%desc_U%get_context() call psb_info(ictxt,iam,np) - nr1 = map%desc_Y%get_local_rows() - nc1 = map%desc_Y%get_local_cols() - nr2 = map%desc_X%get_global_rows() - nc2 = map%desc_X%get_local_cols() + nr1 = map%desc_V%get_local_rows() + nc1 = map%desc_V%get_local_cols() + nr2 = map%desc_U%get_global_rows() + nc2 = map%desc_U%get_local_cols() if (present(vtx).and.present(vty)) then ptx => vtx pty => vty else - call psb_geasb(xt,map%desc_Y,info,scratch=.true.,mold=x%v) - call psb_geasb(yt,map%desc_X,info,scratch=.true.,mold=x%v) + call psb_geasb(xt,map%desc_V,info,scratch=.true.,mold=x%v) + call psb_geasb(yt,map%desc_U,info,scratch=.true.,mold=x%v) ptx => xt pty => yt end if - call psb_geaxpby(cone,x,czero,ptx,map%desc_Y,info) + call psb_geaxpby(cone,x,czero,ptx,map%desc_V,info) - if (info == psb_success_) call psb_halo(ptx,map%desc_Y,info,work=work) - if (info == psb_success_) call psb_csmm(cone,map%map_Y2X,ptx,czero,pty,info) - if ((info == psb_success_) .and. map%desc_X%is_repl().and.(np>1)) then + if (info == psb_success_) call psb_halo(ptx,map%desc_V,info,work=work) + if (info == psb_success_) call psb_csmm(cone,map%mat_V2U,ptx,czero,pty,info) + if ((info == psb_success_) .and. map%desc_U%is_repl().and.(np>1)) then yta = pty%get_vect() call psb_sum(ictxt,yta(1:nr2)) call pty%set(yta) end if - if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%desc_X,info) + if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%desc_U,info) if (info /= psb_success_) then write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 @@ -390,16 +390,16 @@ subroutine psb_c_map_Y2X_vect(alpha,x,beta,y,map,info,work,vtx,vty) return end select -end subroutine psb_c_map_Y2X_vect +end subroutine psb_c_map_V2U_v -function psb_c_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) & +function psb_c_linmap(map_kind,desc_U, desc_V, mat_U2V, mat_V2U,iaggr,naggr) & & result(this) use psb_base_mod, psb_protect_name => psb_c_linmap implicit none type(psb_clinmap_type) :: this - type(psb_desc_type), target :: desc_X, desc_Y - type(psb_cspmat_type), intent(inout) :: map_X2Y, map_Y2X + type(psb_desc_type), target :: desc_U, desc_V + type(psb_cspmat_type), intent(inout) :: mat_U2V, mat_V2U integer(psb_ipk_), intent(in) :: map_kind integer(psb_ipk_), intent(in), optional :: iaggr(:), naggr(:) ! @@ -411,15 +411,15 @@ function psb_c_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) & case (psb_map_aggr_) ! OK - if (psb_is_ok_desc(desc_X)) then - this%p_desc_X=>desc_X + if (psb_is_ok_desc(desc_U)) then + this%p_desc_U=>desc_U else - info = psb_err_pivot_too_small_ + info = psb_err_invalid_cd_state_ endif - if (psb_is_ok_desc(desc_Y)) then - this%p_desc_Y=>desc_Y + if (psb_is_ok_desc(desc_V)) then + this%p_desc_V=>desc_V else - info = psb_err_invalid_ovr_num_ + info = psb_err_invalid_cd_state_ endif if (present(iaggr)) then if (.not.present(naggr)) then @@ -438,15 +438,15 @@ function psb_c_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) & case(psb_map_gen_linear_) - if (desc_X%is_ok()) then - call desc_X%clone(this%desc_X,info) + if (desc_U%is_ok()) then + call desc_U%clone(this%desc_U,info) else - info = psb_err_pivot_too_small_ + info = psb_err_invalid_cd_state_ endif - if (desc_Y%is_ok()) then - call desc_Y%clone(this%desc_Y,info) + if (desc_V%is_ok()) then + call desc_V%clone(this%desc_V,info) else - info = psb_err_invalid_ovr_num_ + info = psb_err_invalid_cd_state_ endif ! If iaggr/naggr are present, copy them anyway. if (present(iaggr)) then @@ -469,8 +469,8 @@ function psb_c_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) & info = 1 end select - if (info == psb_success_) call map_X2Y%clone(this%map_X2Y,info) - if (info == psb_success_) call map_Y2X%clone(this%map_Y2X,info) + if (info == psb_success_) call mat_U2V%clone(this%mat_U2V,info) + if (info == psb_success_) call mat_V2U%clone(this%mat_V2U,info) if (info == psb_success_) then call this%set_kind(map_kind) end if diff --git a/base/tools/psb_d_map.f90 b/base/tools/psb_d_map.f90 index ecb12834..6e0430f5 100644 --- a/base/tools/psb_d_map.f90 +++ b/base/tools/psb_d_map.f90 @@ -33,15 +33,15 @@ ! ! ! -! Takes a vector x from space map%p_desc_X and maps it onto -! map%p_desc_Y under map%map_X2Y possibly with communication +! Takes a vector x from space map%p_desc_U and maps it onto +! map%p_desc_V under map%mat_U2V possibly with communication ! due to exch_fw_idx ! -subroutine psb_d_map_X2Y(alpha,x,beta,y,map,info,work) - use psb_base_mod, psb_protect_name => psb_d_map_X2Y +subroutine psb_d_map_U2V_a(alpha,x,beta,y,map,info,work) + use psb_base_mod, psb_protect_name => psb_d_map_U2V_a implicit none - type(psb_dlinmap_type), intent(in) :: map + class(psb_dlinmap_type), intent(in) :: map real(psb_dpk_), intent(in) :: alpha,beta real(psb_dpk_), intent(inout) :: x(:) real(psb_dpk_), intent(out) :: y(:) @@ -52,7 +52,7 @@ subroutine psb_d_map_X2Y(alpha,x,beta,y,map,info,work) real(psb_dpk_), allocatable :: xt(:), yt(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2,& & map_kind, nr, ictxt - character(len=20), parameter :: name='psb_map_X2Y' + character(len=20), parameter :: name='psb_map_U2V' info = psb_success_ if (.not.map%is_asb()) then @@ -66,16 +66,16 @@ subroutine psb_d_map_X2Y(alpha,x,beta,y,map,info,work) select case(map_kind) case(psb_map_aggr_) - ictxt = map%p_desc_Y%get_context() - nr2 = map%p_desc_Y%get_global_rows() - nc2 = map%p_desc_Y%get_local_cols() + ictxt = map%p_desc_V%get_context() + nr2 = map%p_desc_V%get_global_rows() + nc2 = map%p_desc_V%get_local_cols() allocate(yt(nc2),stat=info) - if (info == psb_success_) call psb_halo(x,map%p_desc_X,info,work=work) - if (info == psb_success_) call psb_csmm(done,map%map_X2Y,x,dzero,yt,info) - if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_Y)) then + if (info == psb_success_) call psb_halo(x,map%p_desc_U,info,work=work) + if (info == psb_success_) call psb_csmm(done,map%mat_U2V,x,dzero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_V)) then call psb_sum(ictxt,yt(1:nr2)) end if - if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_Y,info) + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_V,info) if (info /= psb_success_) then write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 @@ -83,19 +83,19 @@ subroutine psb_d_map_X2Y(alpha,x,beta,y,map,info,work) case(psb_map_gen_linear_) - ictxt = map%desc_Y%get_context() - nr1 = map%desc_X%get_local_rows() - nc1 = map%desc_X%get_local_cols() - nr2 = map%desc_Y%get_global_rows() - nc2 = map%desc_Y%get_local_cols() + ictxt = map%desc_V%get_context() + nr1 = map%desc_U%get_local_rows() + nc1 = map%desc_U%get_local_cols() + nr2 = map%desc_V%get_global_rows() + nc2 = map%desc_V%get_local_cols() allocate(xt(nc1),yt(nc2),stat=info) xt(1:nr1) = x(1:nr1) - if (info == psb_success_) call psb_halo(xt,map%desc_X,info,work=work) - if (info == psb_success_) call psb_csmm(done,map%map_X2Y,xt,dzero,yt,info) - if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_Y)) then + if (info == psb_success_) call psb_halo(xt,map%desc_U,info,work=work) + if (info == psb_success_) call psb_csmm(done,map%mat_U2V,xt,dzero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_V)) then call psb_sum(ictxt,yt(1:nr2)) end if - if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_Y,info) + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_V,info) if (info /= psb_success_) then write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 @@ -109,12 +109,12 @@ subroutine psb_d_map_X2Y(alpha,x,beta,y,map,info,work) return end select -end subroutine psb_d_map_X2Y +end subroutine psb_d_map_U2V_a -subroutine psb_d_map_X2Y_vect(alpha,x,beta,y,map,info,work,vtx,vty) - use psb_base_mod, psb_protect_name => psb_d_map_X2Y_vect +subroutine psb_d_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) + use psb_base_mod, psb_protect_name => psb_d_map_U2V_v implicit none - type(psb_dlinmap_type), intent(in) :: map + class(psb_dlinmap_type), intent(in) :: map real(psb_dpk_), intent(in) :: alpha,beta type(psb_d_vect_type), intent(inout) :: x,y integer(psb_ipk_), intent(out) :: info @@ -126,7 +126,7 @@ subroutine psb_d_map_X2Y_vect(alpha,x,beta,y,map,info,work,vtx,vty) real(psb_dpk_), allocatable :: xta(:), yta(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2 ,& & map_kind, nr, ictxt, iam, np - character(len=20), parameter :: name='psb_map_X2Yv' + character(len=20), parameter :: name='psb_map_U2V_v' info = psb_success_ if (.not.map%is_asb()) then @@ -140,24 +140,24 @@ subroutine psb_d_map_X2Y_vect(alpha,x,beta,y,map,info,work,vtx,vty) select case(map_kind) case(psb_map_aggr_) - ictxt = map%p_desc_Y%get_context() + ictxt = map%p_desc_V%get_context() call psb_info(ictxt,iam,np) - nr2 = map%p_desc_Y%get_global_rows() - nc2 = map%p_desc_Y%get_local_cols() + nr2 = map%p_desc_V%get_global_rows() + nc2 = map%p_desc_V%get_local_cols() if (present(vty)) then pty => vty else - call psb_geasb(yt,map%p_desc_Y,info,scratch=.true.,mold=x%v) + call psb_geasb(yt,map%p_desc_V,info,scratch=.true.,mold=x%v) pty => yt end if - if (info == psb_success_) call psb_halo(x,map%p_desc_X,info,work=work) - if (info == psb_success_) call psb_csmm(done,map%map_X2Y,x,dzero,pty,info) - if ((info == psb_success_) .and. map%p_desc_Y%is_repl().and.(np>1)) then + if (info == psb_success_) call psb_halo(x,map%p_desc_U,info,work=work) + if (info == psb_success_) call psb_csmm(done,map%mat_U2V,x,dzero,pty,info) + if ((info == psb_success_) .and. map%p_desc_V%is_repl().and.(np>1)) then yta = pty%get_vect() call psb_sum(ictxt,yta(1:nr2)) call pty%set(yta) end if - if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%p_desc_Y,info) + if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%p_desc_V,info) if (info /= psb_success_) then write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 @@ -167,32 +167,32 @@ subroutine psb_d_map_X2Y_vect(alpha,x,beta,y,map,info,work,vtx,vty) case(psb_map_gen_linear_) - ictxt = map%desc_Y%get_context() + ictxt = map%desc_V%get_context() call psb_info(ictxt,iam,np) - nr1 = map%desc_X%get_local_rows() - nc1 = map%desc_X%get_local_cols() - nr2 = map%desc_Y%get_global_rows() - nc2 = map%desc_Y%get_local_cols() + nr1 = map%desc_U%get_local_rows() + nc1 = map%desc_U%get_local_cols() + nr2 = map%desc_V%get_global_rows() + nc2 = map%desc_V%get_local_cols() if (present(vtx).and.present(vty)) then ptx => vtx pty => vty else - call psb_geasb(xt,map%desc_X,info,scratch=.true.,mold=x%v) - call psb_geasb(yt,map%desc_Y,info,scratch=.true.,mold=x%v) + call psb_geasb(xt,map%desc_U,info,scratch=.true.,mold=x%v) + call psb_geasb(yt,map%desc_V,info,scratch=.true.,mold=x%v) ptx => xt pty => yt end if - call psb_geaxpby(done,x,dzero,ptx,map%desc_X,info) - if (info == psb_success_) call psb_halo(ptx,map%desc_X,info,work=work) - if (info == psb_success_) call psb_csmm(done,map%map_X2Y,ptx,dzero,pty,info) - if ((info == psb_success_) .and. map%desc_Y%is_repl().and.(np>1)) then + call psb_geaxpby(done,x,dzero,ptx,map%desc_U,info) + if (info == psb_success_) call psb_halo(ptx,map%desc_U,info,work=work) + if (info == psb_success_) call psb_csmm(done,map%mat_U2V,ptx,dzero,pty,info) + if ((info == psb_success_) .and. map%desc_V%is_repl().and.(np>1)) then yta = pty%get_vect() call psb_sum(ictxt,yta(1:nr2)) call pty%set(yta) end if - if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%desc_Y,info) + if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%desc_V,info) if (info /= psb_success_) then write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 @@ -211,19 +211,19 @@ subroutine psb_d_map_X2Y_vect(alpha,x,beta,y,map,info,work,vtx,vty) end select return -end subroutine psb_d_map_X2Y_vect +end subroutine psb_d_map_U2V_v ! -! Takes a vector x from space map%p_desc_Y and maps it onto -! map%p_desc_X under map%map_Y2X possibly with communication +! Takes a vector x from space map%p_desc_V and maps it onto +! map%p_desc_U under map%mat_V2U possibly with communication ! due to exch_bk_idx ! -subroutine psb_d_map_Y2X(alpha,x,beta,y,map,info,work) - use psb_base_mod, psb_protect_name => psb_d_map_Y2X +subroutine psb_d_map_V2U_a(alpha,x,beta,y,map,info,work) + use psb_base_mod, psb_protect_name => psb_d_map_V2U_a implicit none - type(psb_dlinmap_type), intent(in) :: map + class(psb_dlinmap_type), intent(in) :: map real(psb_dpk_), intent(in) :: alpha,beta real(psb_dpk_), intent(inout) :: x(:) real(psb_dpk_), intent(out) :: y(:) @@ -234,7 +234,7 @@ subroutine psb_d_map_Y2X(alpha,x,beta,y,map,info,work) real(psb_dpk_), allocatable :: xt(:), yt(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2,& & map_kind, nr, ictxt - character(len=20), parameter :: name='psb_map_Y2X' + character(len=20), parameter :: name='psb_map_V2U' info = psb_success_ if (.not.map%is_asb()) then @@ -248,16 +248,16 @@ subroutine psb_d_map_Y2X(alpha,x,beta,y,map,info,work) select case(map_kind) case(psb_map_aggr_) - ictxt = map%p_desc_X%get_context() - nr2 = map%p_desc_X%get_global_rows() - nc2 = map%p_desc_X%get_local_cols() + ictxt = map%p_desc_U%get_context() + nr2 = map%p_desc_U%get_global_rows() + nc2 = map%p_desc_U%get_local_cols() allocate(yt(nc2),stat=info) - if (info == psb_success_) call psb_halo(x,map%p_desc_Y,info,work=work) - if (info == psb_success_) call psb_csmm(done,map%map_Y2X,x,dzero,yt,info) - if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_X)) then + if (info == psb_success_) call psb_halo(x,map%p_desc_V,info,work=work) + if (info == psb_success_) call psb_csmm(done,map%mat_V2U,x,dzero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_U)) then call psb_sum(ictxt,yt(1:nr2)) end if - if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_X,info) + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_U,info) if (info /= psb_success_) then write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 @@ -265,19 +265,19 @@ subroutine psb_d_map_Y2X(alpha,x,beta,y,map,info,work) case(psb_map_gen_linear_) - ictxt = map%desc_X%get_context() - nr1 = map%desc_Y%get_local_rows() - nc1 = map%desc_Y%get_local_cols() - nr2 = map%desc_X%get_global_rows() - nc2 = map%desc_X%get_local_cols() + ictxt = map%desc_U%get_context() + nr1 = map%desc_V%get_local_rows() + nc1 = map%desc_V%get_local_cols() + nr2 = map%desc_U%get_global_rows() + nc2 = map%desc_U%get_local_cols() allocate(xt(nc1),yt(nc2),stat=info) xt(1:nr1) = x(1:nr1) - if (info == psb_success_) call psb_halo(xt,map%desc_Y,info,work=work) - if (info == psb_success_) call psb_csmm(done,map%map_Y2X,xt,dzero,yt,info) - if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_X)) then + if (info == psb_success_) call psb_halo(xt,map%desc_V,info,work=work) + if (info == psb_success_) call psb_csmm(done,map%mat_V2U,xt,dzero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_U)) then call psb_sum(ictxt,yt(1:nr2)) end if - if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_X,info) + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_U,info) if (info /= psb_success_) then write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 @@ -290,12 +290,12 @@ subroutine psb_d_map_Y2X(alpha,x,beta,y,map,info,work) return end select -end subroutine psb_d_map_Y2X +end subroutine psb_d_map_V2U_a -subroutine psb_d_map_Y2X_vect(alpha,x,beta,y,map,info,work,vtx,vty) - use psb_base_mod, psb_protect_name => psb_d_map_Y2X_vect +subroutine psb_d_map_V2U_v(alpha,x,beta,y,map,info,work,vtx,vty) + use psb_base_mod, psb_protect_name => psb_d_map_V2U_v implicit none - type(psb_dlinmap_type), intent(in) :: map + class(psb_dlinmap_type), intent(in) :: map real(psb_dpk_), intent(in) :: alpha,beta type(psb_d_vect_type), intent(inout) :: x,y integer(psb_ipk_), intent(out) :: info @@ -307,7 +307,7 @@ subroutine psb_d_map_Y2X_vect(alpha,x,beta,y,map,info,work,vtx,vty) real(psb_dpk_), allocatable :: xta(:), yta(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2,& & map_kind, nr, ictxt, iam, np - character(len=20), parameter :: name='psb_map_Y2Xv' + character(len=20), parameter :: name='psb_map_V2U_v' info = psb_success_ if (.not.map%is_asb()) then @@ -321,24 +321,24 @@ subroutine psb_d_map_Y2X_vect(alpha,x,beta,y,map,info,work,vtx,vty) select case(map_kind) case(psb_map_aggr_) - ictxt = map%p_desc_X%get_context() + ictxt = map%p_desc_U%get_context() call psb_info(ictxt,iam,np) - nr2 = map%p_desc_X%get_global_rows() - nc2 = map%p_desc_X%get_local_cols() + nr2 = map%p_desc_U%get_global_rows() + nc2 = map%p_desc_U%get_local_cols() if (present(vty)) then pty => vty else - call psb_geasb(yt,map%p_desc_X,info,scratch=.true.,mold=x%v) + call psb_geasb(yt,map%p_desc_U,info,scratch=.true.,mold=x%v) pty => yt end if - if (info == psb_success_) call psb_halo(x,map%p_desc_Y,info,work=work) - if (info == psb_success_) call psb_csmm(done,map%map_Y2X,x,dzero,pty,info) - if ((info == psb_success_) .and. map%p_desc_X%is_repl().and.(np>1)) then + if (info == psb_success_) call psb_halo(x,map%p_desc_V,info,work=work) + if (info == psb_success_) call psb_csmm(done,map%mat_V2U,x,dzero,pty,info) + if ((info == psb_success_) .and. map%p_desc_U%is_repl().and.(np>1)) then yta = pty%get_vect() call psb_sum(ictxt,yta(1:nr2)) call pty%set(yta) end if - if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%p_desc_X,info) + if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%p_desc_U,info) if (info /= psb_success_) then write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 @@ -348,32 +348,32 @@ subroutine psb_d_map_Y2X_vect(alpha,x,beta,y,map,info,work,vtx,vty) case(psb_map_gen_linear_) - ictxt = map%desc_X%get_context() + ictxt = map%desc_U%get_context() call psb_info(ictxt,iam,np) - nr1 = map%desc_Y%get_local_rows() - nc1 = map%desc_Y%get_local_cols() - nr2 = map%desc_X%get_global_rows() - nc2 = map%desc_X%get_local_cols() + nr1 = map%desc_V%get_local_rows() + nc1 = map%desc_V%get_local_cols() + nr2 = map%desc_U%get_global_rows() + nc2 = map%desc_U%get_local_cols() if (present(vtx).and.present(vty)) then ptx => vtx pty => vty else - call psb_geasb(xt,map%desc_Y,info,scratch=.true.,mold=x%v) - call psb_geasb(yt,map%desc_X,info,scratch=.true.,mold=x%v) + call psb_geasb(xt,map%desc_V,info,scratch=.true.,mold=x%v) + call psb_geasb(yt,map%desc_U,info,scratch=.true.,mold=x%v) ptx => xt pty => yt end if - call psb_geaxpby(done,x,dzero,ptx,map%desc_Y,info) + call psb_geaxpby(done,x,dzero,ptx,map%desc_V,info) - if (info == psb_success_) call psb_halo(ptx,map%desc_Y,info,work=work) - if (info == psb_success_) call psb_csmm(done,map%map_Y2X,ptx,dzero,pty,info) - if ((info == psb_success_) .and. map%desc_X%is_repl().and.(np>1)) then + if (info == psb_success_) call psb_halo(ptx,map%desc_V,info,work=work) + if (info == psb_success_) call psb_csmm(done,map%mat_V2U,ptx,dzero,pty,info) + if ((info == psb_success_) .and. map%desc_U%is_repl().and.(np>1)) then yta = pty%get_vect() call psb_sum(ictxt,yta(1:nr2)) call pty%set(yta) end if - if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%desc_X,info) + if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%desc_U,info) if (info /= psb_success_) then write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 @@ -390,16 +390,16 @@ subroutine psb_d_map_Y2X_vect(alpha,x,beta,y,map,info,work,vtx,vty) return end select -end subroutine psb_d_map_Y2X_vect +end subroutine psb_d_map_V2U_v -function psb_d_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) & +function psb_d_linmap(map_kind,desc_U, desc_V, mat_U2V, mat_V2U,iaggr,naggr) & & result(this) use psb_base_mod, psb_protect_name => psb_d_linmap implicit none type(psb_dlinmap_type) :: this - type(psb_desc_type), target :: desc_X, desc_Y - type(psb_dspmat_type), intent(inout) :: map_X2Y, map_Y2X + type(psb_desc_type), target :: desc_U, desc_V + type(psb_dspmat_type), intent(inout) :: mat_U2V, mat_V2U integer(psb_ipk_), intent(in) :: map_kind integer(psb_ipk_), intent(in), optional :: iaggr(:), naggr(:) ! @@ -411,15 +411,15 @@ function psb_d_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) & case (psb_map_aggr_) ! OK - if (psb_is_ok_desc(desc_X)) then - this%p_desc_X=>desc_X + if (psb_is_ok_desc(desc_U)) then + this%p_desc_U=>desc_U else - info = psb_err_pivot_too_small_ + info = psb_err_invalid_cd_state_ endif - if (psb_is_ok_desc(desc_Y)) then - this%p_desc_Y=>desc_Y + if (psb_is_ok_desc(desc_V)) then + this%p_desc_V=>desc_V else - info = psb_err_invalid_ovr_num_ + info = psb_err_invalid_cd_state_ endif if (present(iaggr)) then if (.not.present(naggr)) then @@ -438,15 +438,15 @@ function psb_d_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) & case(psb_map_gen_linear_) - if (desc_X%is_ok()) then - call desc_X%clone(this%desc_X,info) + if (desc_U%is_ok()) then + call desc_U%clone(this%desc_U,info) else - info = psb_err_pivot_too_small_ + info = psb_err_invalid_cd_state_ endif - if (desc_Y%is_ok()) then - call desc_Y%clone(this%desc_Y,info) + if (desc_V%is_ok()) then + call desc_V%clone(this%desc_V,info) else - info = psb_err_invalid_ovr_num_ + info = psb_err_invalid_cd_state_ endif ! If iaggr/naggr are present, copy them anyway. if (present(iaggr)) then @@ -469,8 +469,8 @@ function psb_d_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) & info = 1 end select - if (info == psb_success_) call map_X2Y%clone(this%map_X2Y,info) - if (info == psb_success_) call map_Y2X%clone(this%map_Y2X,info) + if (info == psb_success_) call mat_U2V%clone(this%mat_U2V,info) + if (info == psb_success_) call mat_V2U%clone(this%mat_V2U,info) if (info == psb_success_) then call this%set_kind(map_kind) end if diff --git a/base/tools/psb_s_map.f90 b/base/tools/psb_s_map.f90 index 823743c8..323025c2 100644 --- a/base/tools/psb_s_map.f90 +++ b/base/tools/psb_s_map.f90 @@ -33,15 +33,15 @@ ! ! ! -! Takes a vector x from space map%p_desc_X and maps it onto -! map%p_desc_Y under map%map_X2Y possibly with communication +! Takes a vector x from space map%p_desc_U and maps it onto +! map%p_desc_V under map%mat_U2V possibly with communication ! due to exch_fw_idx ! -subroutine psb_s_map_X2Y(alpha,x,beta,y,map,info,work) - use psb_base_mod, psb_protect_name => psb_s_map_X2Y +subroutine psb_s_map_U2V_a(alpha,x,beta,y,map,info,work) + use psb_base_mod, psb_protect_name => psb_s_map_U2V_a implicit none - type(psb_slinmap_type), intent(in) :: map + class(psb_slinmap_type), intent(in) :: map real(psb_spk_), intent(in) :: alpha,beta real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(out) :: y(:) @@ -52,7 +52,7 @@ subroutine psb_s_map_X2Y(alpha,x,beta,y,map,info,work) real(psb_spk_), allocatable :: xt(:), yt(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2,& & map_kind, nr, ictxt - character(len=20), parameter :: name='psb_map_X2Y' + character(len=20), parameter :: name='psb_map_U2V' info = psb_success_ if (.not.map%is_asb()) then @@ -66,16 +66,16 @@ subroutine psb_s_map_X2Y(alpha,x,beta,y,map,info,work) select case(map_kind) case(psb_map_aggr_) - ictxt = map%p_desc_Y%get_context() - nr2 = map%p_desc_Y%get_global_rows() - nc2 = map%p_desc_Y%get_local_cols() + ictxt = map%p_desc_V%get_context() + nr2 = map%p_desc_V%get_global_rows() + nc2 = map%p_desc_V%get_local_cols() allocate(yt(nc2),stat=info) - if (info == psb_success_) call psb_halo(x,map%p_desc_X,info,work=work) - if (info == psb_success_) call psb_csmm(sone,map%map_X2Y,x,szero,yt,info) - if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_Y)) then + if (info == psb_success_) call psb_halo(x,map%p_desc_U,info,work=work) + if (info == psb_success_) call psb_csmm(sone,map%mat_U2V,x,szero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_V)) then call psb_sum(ictxt,yt(1:nr2)) end if - if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_Y,info) + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_V,info) if (info /= psb_success_) then write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 @@ -83,19 +83,19 @@ subroutine psb_s_map_X2Y(alpha,x,beta,y,map,info,work) case(psb_map_gen_linear_) - ictxt = map%desc_Y%get_context() - nr1 = map%desc_X%get_local_rows() - nc1 = map%desc_X%get_local_cols() - nr2 = map%desc_Y%get_global_rows() - nc2 = map%desc_Y%get_local_cols() + ictxt = map%desc_V%get_context() + nr1 = map%desc_U%get_local_rows() + nc1 = map%desc_U%get_local_cols() + nr2 = map%desc_V%get_global_rows() + nc2 = map%desc_V%get_local_cols() allocate(xt(nc1),yt(nc2),stat=info) xt(1:nr1) = x(1:nr1) - if (info == psb_success_) call psb_halo(xt,map%desc_X,info,work=work) - if (info == psb_success_) call psb_csmm(sone,map%map_X2Y,xt,szero,yt,info) - if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_Y)) then + if (info == psb_success_) call psb_halo(xt,map%desc_U,info,work=work) + if (info == psb_success_) call psb_csmm(sone,map%mat_U2V,xt,szero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_V)) then call psb_sum(ictxt,yt(1:nr2)) end if - if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_Y,info) + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_V,info) if (info /= psb_success_) then write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 @@ -109,12 +109,12 @@ subroutine psb_s_map_X2Y(alpha,x,beta,y,map,info,work) return end select -end subroutine psb_s_map_X2Y +end subroutine psb_s_map_U2V_a -subroutine psb_s_map_X2Y_vect(alpha,x,beta,y,map,info,work,vtx,vty) - use psb_base_mod, psb_protect_name => psb_s_map_X2Y_vect +subroutine psb_s_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) + use psb_base_mod, psb_protect_name => psb_s_map_U2V_v implicit none - type(psb_slinmap_type), intent(in) :: map + class(psb_slinmap_type), intent(in) :: map real(psb_spk_), intent(in) :: alpha,beta type(psb_s_vect_type), intent(inout) :: x,y integer(psb_ipk_), intent(out) :: info @@ -126,7 +126,7 @@ subroutine psb_s_map_X2Y_vect(alpha,x,beta,y,map,info,work,vtx,vty) real(psb_spk_), allocatable :: xta(:), yta(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2 ,& & map_kind, nr, ictxt, iam, np - character(len=20), parameter :: name='psb_map_X2Yv' + character(len=20), parameter :: name='psb_map_U2V_v' info = psb_success_ if (.not.map%is_asb()) then @@ -140,24 +140,24 @@ subroutine psb_s_map_X2Y_vect(alpha,x,beta,y,map,info,work,vtx,vty) select case(map_kind) case(psb_map_aggr_) - ictxt = map%p_desc_Y%get_context() + ictxt = map%p_desc_V%get_context() call psb_info(ictxt,iam,np) - nr2 = map%p_desc_Y%get_global_rows() - nc2 = map%p_desc_Y%get_local_cols() + nr2 = map%p_desc_V%get_global_rows() + nc2 = map%p_desc_V%get_local_cols() if (present(vty)) then pty => vty else - call psb_geasb(yt,map%p_desc_Y,info,scratch=.true.,mold=x%v) + call psb_geasb(yt,map%p_desc_V,info,scratch=.true.,mold=x%v) pty => yt end if - if (info == psb_success_) call psb_halo(x,map%p_desc_X,info,work=work) - if (info == psb_success_) call psb_csmm(sone,map%map_X2Y,x,szero,pty,info) - if ((info == psb_success_) .and. map%p_desc_Y%is_repl().and.(np>1)) then + if (info == psb_success_) call psb_halo(x,map%p_desc_U,info,work=work) + if (info == psb_success_) call psb_csmm(sone,map%mat_U2V,x,szero,pty,info) + if ((info == psb_success_) .and. map%p_desc_V%is_repl().and.(np>1)) then yta = pty%get_vect() call psb_sum(ictxt,yta(1:nr2)) call pty%set(yta) end if - if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%p_desc_Y,info) + if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%p_desc_V,info) if (info /= psb_success_) then write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 @@ -167,32 +167,32 @@ subroutine psb_s_map_X2Y_vect(alpha,x,beta,y,map,info,work,vtx,vty) case(psb_map_gen_linear_) - ictxt = map%desc_Y%get_context() + ictxt = map%desc_V%get_context() call psb_info(ictxt,iam,np) - nr1 = map%desc_X%get_local_rows() - nc1 = map%desc_X%get_local_cols() - nr2 = map%desc_Y%get_global_rows() - nc2 = map%desc_Y%get_local_cols() + nr1 = map%desc_U%get_local_rows() + nc1 = map%desc_U%get_local_cols() + nr2 = map%desc_V%get_global_rows() + nc2 = map%desc_V%get_local_cols() if (present(vtx).and.present(vty)) then ptx => vtx pty => vty else - call psb_geasb(xt,map%desc_X,info,scratch=.true.,mold=x%v) - call psb_geasb(yt,map%desc_Y,info,scratch=.true.,mold=x%v) + call psb_geasb(xt,map%desc_U,info,scratch=.true.,mold=x%v) + call psb_geasb(yt,map%desc_V,info,scratch=.true.,mold=x%v) ptx => xt pty => yt end if - call psb_geaxpby(sone,x,szero,ptx,map%desc_X,info) - if (info == psb_success_) call psb_halo(ptx,map%desc_X,info,work=work) - if (info == psb_success_) call psb_csmm(sone,map%map_X2Y,ptx,szero,pty,info) - if ((info == psb_success_) .and. map%desc_Y%is_repl().and.(np>1)) then + call psb_geaxpby(sone,x,szero,ptx,map%desc_U,info) + if (info == psb_success_) call psb_halo(ptx,map%desc_U,info,work=work) + if (info == psb_success_) call psb_csmm(sone,map%mat_U2V,ptx,szero,pty,info) + if ((info == psb_success_) .and. map%desc_V%is_repl().and.(np>1)) then yta = pty%get_vect() call psb_sum(ictxt,yta(1:nr2)) call pty%set(yta) end if - if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%desc_Y,info) + if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%desc_V,info) if (info /= psb_success_) then write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 @@ -211,19 +211,19 @@ subroutine psb_s_map_X2Y_vect(alpha,x,beta,y,map,info,work,vtx,vty) end select return -end subroutine psb_s_map_X2Y_vect +end subroutine psb_s_map_U2V_v ! -! Takes a vector x from space map%p_desc_Y and maps it onto -! map%p_desc_X under map%map_Y2X possibly with communication +! Takes a vector x from space map%p_desc_V and maps it onto +! map%p_desc_U under map%mat_V2U possibly with communication ! due to exch_bk_idx ! -subroutine psb_s_map_Y2X(alpha,x,beta,y,map,info,work) - use psb_base_mod, psb_protect_name => psb_s_map_Y2X +subroutine psb_s_map_V2U_a(alpha,x,beta,y,map,info,work) + use psb_base_mod, psb_protect_name => psb_s_map_V2U_a implicit none - type(psb_slinmap_type), intent(in) :: map + class(psb_slinmap_type), intent(in) :: map real(psb_spk_), intent(in) :: alpha,beta real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(out) :: y(:) @@ -234,7 +234,7 @@ subroutine psb_s_map_Y2X(alpha,x,beta,y,map,info,work) real(psb_spk_), allocatable :: xt(:), yt(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2,& & map_kind, nr, ictxt - character(len=20), parameter :: name='psb_map_Y2X' + character(len=20), parameter :: name='psb_map_V2U' info = psb_success_ if (.not.map%is_asb()) then @@ -248,16 +248,16 @@ subroutine psb_s_map_Y2X(alpha,x,beta,y,map,info,work) select case(map_kind) case(psb_map_aggr_) - ictxt = map%p_desc_X%get_context() - nr2 = map%p_desc_X%get_global_rows() - nc2 = map%p_desc_X%get_local_cols() + ictxt = map%p_desc_U%get_context() + nr2 = map%p_desc_U%get_global_rows() + nc2 = map%p_desc_U%get_local_cols() allocate(yt(nc2),stat=info) - if (info == psb_success_) call psb_halo(x,map%p_desc_Y,info,work=work) - if (info == psb_success_) call psb_csmm(sone,map%map_Y2X,x,szero,yt,info) - if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_X)) then + if (info == psb_success_) call psb_halo(x,map%p_desc_V,info,work=work) + if (info == psb_success_) call psb_csmm(sone,map%mat_V2U,x,szero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_U)) then call psb_sum(ictxt,yt(1:nr2)) end if - if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_X,info) + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_U,info) if (info /= psb_success_) then write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 @@ -265,19 +265,19 @@ subroutine psb_s_map_Y2X(alpha,x,beta,y,map,info,work) case(psb_map_gen_linear_) - ictxt = map%desc_X%get_context() - nr1 = map%desc_Y%get_local_rows() - nc1 = map%desc_Y%get_local_cols() - nr2 = map%desc_X%get_global_rows() - nc2 = map%desc_X%get_local_cols() + ictxt = map%desc_U%get_context() + nr1 = map%desc_V%get_local_rows() + nc1 = map%desc_V%get_local_cols() + nr2 = map%desc_U%get_global_rows() + nc2 = map%desc_U%get_local_cols() allocate(xt(nc1),yt(nc2),stat=info) xt(1:nr1) = x(1:nr1) - if (info == psb_success_) call psb_halo(xt,map%desc_Y,info,work=work) - if (info == psb_success_) call psb_csmm(sone,map%map_Y2X,xt,szero,yt,info) - if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_X)) then + if (info == psb_success_) call psb_halo(xt,map%desc_V,info,work=work) + if (info == psb_success_) call psb_csmm(sone,map%mat_V2U,xt,szero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_U)) then call psb_sum(ictxt,yt(1:nr2)) end if - if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_X,info) + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_U,info) if (info /= psb_success_) then write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 @@ -290,12 +290,12 @@ subroutine psb_s_map_Y2X(alpha,x,beta,y,map,info,work) return end select -end subroutine psb_s_map_Y2X +end subroutine psb_s_map_V2U_a -subroutine psb_s_map_Y2X_vect(alpha,x,beta,y,map,info,work,vtx,vty) - use psb_base_mod, psb_protect_name => psb_s_map_Y2X_vect +subroutine psb_s_map_V2U_v(alpha,x,beta,y,map,info,work,vtx,vty) + use psb_base_mod, psb_protect_name => psb_s_map_V2U_v implicit none - type(psb_slinmap_type), intent(in) :: map + class(psb_slinmap_type), intent(in) :: map real(psb_spk_), intent(in) :: alpha,beta type(psb_s_vect_type), intent(inout) :: x,y integer(psb_ipk_), intent(out) :: info @@ -307,7 +307,7 @@ subroutine psb_s_map_Y2X_vect(alpha,x,beta,y,map,info,work,vtx,vty) real(psb_spk_), allocatable :: xta(:), yta(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2,& & map_kind, nr, ictxt, iam, np - character(len=20), parameter :: name='psb_map_Y2Xv' + character(len=20), parameter :: name='psb_map_V2U_v' info = psb_success_ if (.not.map%is_asb()) then @@ -321,24 +321,24 @@ subroutine psb_s_map_Y2X_vect(alpha,x,beta,y,map,info,work,vtx,vty) select case(map_kind) case(psb_map_aggr_) - ictxt = map%p_desc_X%get_context() + ictxt = map%p_desc_U%get_context() call psb_info(ictxt,iam,np) - nr2 = map%p_desc_X%get_global_rows() - nc2 = map%p_desc_X%get_local_cols() + nr2 = map%p_desc_U%get_global_rows() + nc2 = map%p_desc_U%get_local_cols() if (present(vty)) then pty => vty else - call psb_geasb(yt,map%p_desc_X,info,scratch=.true.,mold=x%v) + call psb_geasb(yt,map%p_desc_U,info,scratch=.true.,mold=x%v) pty => yt end if - if (info == psb_success_) call psb_halo(x,map%p_desc_Y,info,work=work) - if (info == psb_success_) call psb_csmm(sone,map%map_Y2X,x,szero,pty,info) - if ((info == psb_success_) .and. map%p_desc_X%is_repl().and.(np>1)) then + if (info == psb_success_) call psb_halo(x,map%p_desc_V,info,work=work) + if (info == psb_success_) call psb_csmm(sone,map%mat_V2U,x,szero,pty,info) + if ((info == psb_success_) .and. map%p_desc_U%is_repl().and.(np>1)) then yta = pty%get_vect() call psb_sum(ictxt,yta(1:nr2)) call pty%set(yta) end if - if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%p_desc_X,info) + if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%p_desc_U,info) if (info /= psb_success_) then write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 @@ -348,32 +348,32 @@ subroutine psb_s_map_Y2X_vect(alpha,x,beta,y,map,info,work,vtx,vty) case(psb_map_gen_linear_) - ictxt = map%desc_X%get_context() + ictxt = map%desc_U%get_context() call psb_info(ictxt,iam,np) - nr1 = map%desc_Y%get_local_rows() - nc1 = map%desc_Y%get_local_cols() - nr2 = map%desc_X%get_global_rows() - nc2 = map%desc_X%get_local_cols() + nr1 = map%desc_V%get_local_rows() + nc1 = map%desc_V%get_local_cols() + nr2 = map%desc_U%get_global_rows() + nc2 = map%desc_U%get_local_cols() if (present(vtx).and.present(vty)) then ptx => vtx pty => vty else - call psb_geasb(xt,map%desc_Y,info,scratch=.true.,mold=x%v) - call psb_geasb(yt,map%desc_X,info,scratch=.true.,mold=x%v) + call psb_geasb(xt,map%desc_V,info,scratch=.true.,mold=x%v) + call psb_geasb(yt,map%desc_U,info,scratch=.true.,mold=x%v) ptx => xt pty => yt end if - call psb_geaxpby(sone,x,szero,ptx,map%desc_Y,info) + call psb_geaxpby(sone,x,szero,ptx,map%desc_V,info) - if (info == psb_success_) call psb_halo(ptx,map%desc_Y,info,work=work) - if (info == psb_success_) call psb_csmm(sone,map%map_Y2X,ptx,szero,pty,info) - if ((info == psb_success_) .and. map%desc_X%is_repl().and.(np>1)) then + if (info == psb_success_) call psb_halo(ptx,map%desc_V,info,work=work) + if (info == psb_success_) call psb_csmm(sone,map%mat_V2U,ptx,szero,pty,info) + if ((info == psb_success_) .and. map%desc_U%is_repl().and.(np>1)) then yta = pty%get_vect() call psb_sum(ictxt,yta(1:nr2)) call pty%set(yta) end if - if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%desc_X,info) + if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%desc_U,info) if (info /= psb_success_) then write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 @@ -390,16 +390,16 @@ subroutine psb_s_map_Y2X_vect(alpha,x,beta,y,map,info,work,vtx,vty) return end select -end subroutine psb_s_map_Y2X_vect +end subroutine psb_s_map_V2U_v -function psb_s_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) & +function psb_s_linmap(map_kind,desc_U, desc_V, mat_U2V, mat_V2U,iaggr,naggr) & & result(this) use psb_base_mod, psb_protect_name => psb_s_linmap implicit none type(psb_slinmap_type) :: this - type(psb_desc_type), target :: desc_X, desc_Y - type(psb_sspmat_type), intent(inout) :: map_X2Y, map_Y2X + type(psb_desc_type), target :: desc_U, desc_V + type(psb_sspmat_type), intent(inout) :: mat_U2V, mat_V2U integer(psb_ipk_), intent(in) :: map_kind integer(psb_ipk_), intent(in), optional :: iaggr(:), naggr(:) ! @@ -411,15 +411,15 @@ function psb_s_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) & case (psb_map_aggr_) ! OK - if (psb_is_ok_desc(desc_X)) then - this%p_desc_X=>desc_X + if (psb_is_ok_desc(desc_U)) then + this%p_desc_U=>desc_U else - info = psb_err_pivot_too_small_ + info = psb_err_invalid_cd_state_ endif - if (psb_is_ok_desc(desc_Y)) then - this%p_desc_Y=>desc_Y + if (psb_is_ok_desc(desc_V)) then + this%p_desc_V=>desc_V else - info = psb_err_invalid_ovr_num_ + info = psb_err_invalid_cd_state_ endif if (present(iaggr)) then if (.not.present(naggr)) then @@ -438,15 +438,15 @@ function psb_s_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) & case(psb_map_gen_linear_) - if (desc_X%is_ok()) then - call desc_X%clone(this%desc_X,info) + if (desc_U%is_ok()) then + call desc_U%clone(this%desc_U,info) else - info = psb_err_pivot_too_small_ + info = psb_err_invalid_cd_state_ endif - if (desc_Y%is_ok()) then - call desc_Y%clone(this%desc_Y,info) + if (desc_V%is_ok()) then + call desc_V%clone(this%desc_V,info) else - info = psb_err_invalid_ovr_num_ + info = psb_err_invalid_cd_state_ endif ! If iaggr/naggr are present, copy them anyway. if (present(iaggr)) then @@ -469,8 +469,8 @@ function psb_s_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) & info = 1 end select - if (info == psb_success_) call map_X2Y%clone(this%map_X2Y,info) - if (info == psb_success_) call map_Y2X%clone(this%map_Y2X,info) + if (info == psb_success_) call mat_U2V%clone(this%mat_U2V,info) + if (info == psb_success_) call mat_V2U%clone(this%mat_V2U,info) if (info == psb_success_) then call this%set_kind(map_kind) end if diff --git a/base/tools/psb_z_map.f90 b/base/tools/psb_z_map.f90 index 3e31beff..fe53ba7f 100644 --- a/base/tools/psb_z_map.f90 +++ b/base/tools/psb_z_map.f90 @@ -33,15 +33,15 @@ ! ! ! -! Takes a vector x from space map%p_desc_X and maps it onto -! map%p_desc_Y under map%map_X2Y possibly with communication +! Takes a vector x from space map%p_desc_U and maps it onto +! map%p_desc_V under map%mat_U2V possibly with communication ! due to exch_fw_idx ! -subroutine psb_z_map_X2Y(alpha,x,beta,y,map,info,work) - use psb_base_mod, psb_protect_name => psb_z_map_X2Y +subroutine psb_z_map_U2V_a(alpha,x,beta,y,map,info,work) + use psb_base_mod, psb_protect_name => psb_z_map_U2V_a implicit none - type(psb_zlinmap_type), intent(in) :: map + class(psb_zlinmap_type), intent(in) :: map complex(psb_dpk_), intent(in) :: alpha,beta complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(out) :: y(:) @@ -52,7 +52,7 @@ subroutine psb_z_map_X2Y(alpha,x,beta,y,map,info,work) complex(psb_dpk_), allocatable :: xt(:), yt(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2,& & map_kind, nr, ictxt - character(len=20), parameter :: name='psb_map_X2Y' + character(len=20), parameter :: name='psb_map_U2V' info = psb_success_ if (.not.map%is_asb()) then @@ -66,16 +66,16 @@ subroutine psb_z_map_X2Y(alpha,x,beta,y,map,info,work) select case(map_kind) case(psb_map_aggr_) - ictxt = map%p_desc_Y%get_context() - nr2 = map%p_desc_Y%get_global_rows() - nc2 = map%p_desc_Y%get_local_cols() + ictxt = map%p_desc_V%get_context() + nr2 = map%p_desc_V%get_global_rows() + nc2 = map%p_desc_V%get_local_cols() allocate(yt(nc2),stat=info) - if (info == psb_success_) call psb_halo(x,map%p_desc_X,info,work=work) - if (info == psb_success_) call psb_csmm(zone,map%map_X2Y,x,zzero,yt,info) - if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_Y)) then + if (info == psb_success_) call psb_halo(x,map%p_desc_U,info,work=work) + if (info == psb_success_) call psb_csmm(zone,map%mat_U2V,x,zzero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_V)) then call psb_sum(ictxt,yt(1:nr2)) end if - if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_Y,info) + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_V,info) if (info /= psb_success_) then write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 @@ -83,19 +83,19 @@ subroutine psb_z_map_X2Y(alpha,x,beta,y,map,info,work) case(psb_map_gen_linear_) - ictxt = map%desc_Y%get_context() - nr1 = map%desc_X%get_local_rows() - nc1 = map%desc_X%get_local_cols() - nr2 = map%desc_Y%get_global_rows() - nc2 = map%desc_Y%get_local_cols() + ictxt = map%desc_V%get_context() + nr1 = map%desc_U%get_local_rows() + nc1 = map%desc_U%get_local_cols() + nr2 = map%desc_V%get_global_rows() + nc2 = map%desc_V%get_local_cols() allocate(xt(nc1),yt(nc2),stat=info) xt(1:nr1) = x(1:nr1) - if (info == psb_success_) call psb_halo(xt,map%desc_X,info,work=work) - if (info == psb_success_) call psb_csmm(zone,map%map_X2Y,xt,zzero,yt,info) - if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_Y)) then + if (info == psb_success_) call psb_halo(xt,map%desc_U,info,work=work) + if (info == psb_success_) call psb_csmm(zone,map%mat_U2V,xt,zzero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_V)) then call psb_sum(ictxt,yt(1:nr2)) end if - if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_Y,info) + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_V,info) if (info /= psb_success_) then write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 @@ -109,12 +109,12 @@ subroutine psb_z_map_X2Y(alpha,x,beta,y,map,info,work) return end select -end subroutine psb_z_map_X2Y +end subroutine psb_z_map_U2V_a -subroutine psb_z_map_X2Y_vect(alpha,x,beta,y,map,info,work,vtx,vty) - use psb_base_mod, psb_protect_name => psb_z_map_X2Y_vect +subroutine psb_z_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) + use psb_base_mod, psb_protect_name => psb_z_map_U2V_v implicit none - type(psb_zlinmap_type), intent(in) :: map + class(psb_zlinmap_type), intent(in) :: map complex(psb_dpk_), intent(in) :: alpha,beta type(psb_z_vect_type), intent(inout) :: x,y integer(psb_ipk_), intent(out) :: info @@ -126,7 +126,7 @@ subroutine psb_z_map_X2Y_vect(alpha,x,beta,y,map,info,work,vtx,vty) complex(psb_dpk_), allocatable :: xta(:), yta(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2 ,& & map_kind, nr, ictxt, iam, np - character(len=20), parameter :: name='psb_map_X2Yv' + character(len=20), parameter :: name='psb_map_U2V_v' info = psb_success_ if (.not.map%is_asb()) then @@ -140,24 +140,24 @@ subroutine psb_z_map_X2Y_vect(alpha,x,beta,y,map,info,work,vtx,vty) select case(map_kind) case(psb_map_aggr_) - ictxt = map%p_desc_Y%get_context() + ictxt = map%p_desc_V%get_context() call psb_info(ictxt,iam,np) - nr2 = map%p_desc_Y%get_global_rows() - nc2 = map%p_desc_Y%get_local_cols() + nr2 = map%p_desc_V%get_global_rows() + nc2 = map%p_desc_V%get_local_cols() if (present(vty)) then pty => vty else - call psb_geasb(yt,map%p_desc_Y,info,scratch=.true.,mold=x%v) + call psb_geasb(yt,map%p_desc_V,info,scratch=.true.,mold=x%v) pty => yt end if - if (info == psb_success_) call psb_halo(x,map%p_desc_X,info,work=work) - if (info == psb_success_) call psb_csmm(zone,map%map_X2Y,x,zzero,pty,info) - if ((info == psb_success_) .and. map%p_desc_Y%is_repl().and.(np>1)) then + if (info == psb_success_) call psb_halo(x,map%p_desc_U,info,work=work) + if (info == psb_success_) call psb_csmm(zone,map%mat_U2V,x,zzero,pty,info) + if ((info == psb_success_) .and. map%p_desc_V%is_repl().and.(np>1)) then yta = pty%get_vect() call psb_sum(ictxt,yta(1:nr2)) call pty%set(yta) end if - if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%p_desc_Y,info) + if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%p_desc_V,info) if (info /= psb_success_) then write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 @@ -167,32 +167,32 @@ subroutine psb_z_map_X2Y_vect(alpha,x,beta,y,map,info,work,vtx,vty) case(psb_map_gen_linear_) - ictxt = map%desc_Y%get_context() + ictxt = map%desc_V%get_context() call psb_info(ictxt,iam,np) - nr1 = map%desc_X%get_local_rows() - nc1 = map%desc_X%get_local_cols() - nr2 = map%desc_Y%get_global_rows() - nc2 = map%desc_Y%get_local_cols() + nr1 = map%desc_U%get_local_rows() + nc1 = map%desc_U%get_local_cols() + nr2 = map%desc_V%get_global_rows() + nc2 = map%desc_V%get_local_cols() if (present(vtx).and.present(vty)) then ptx => vtx pty => vty else - call psb_geasb(xt,map%desc_X,info,scratch=.true.,mold=x%v) - call psb_geasb(yt,map%desc_Y,info,scratch=.true.,mold=x%v) + call psb_geasb(xt,map%desc_U,info,scratch=.true.,mold=x%v) + call psb_geasb(yt,map%desc_V,info,scratch=.true.,mold=x%v) ptx => xt pty => yt end if - call psb_geaxpby(zone,x,zzero,ptx,map%desc_X,info) - if (info == psb_success_) call psb_halo(ptx,map%desc_X,info,work=work) - if (info == psb_success_) call psb_csmm(zone,map%map_X2Y,ptx,zzero,pty,info) - if ((info == psb_success_) .and. map%desc_Y%is_repl().and.(np>1)) then + call psb_geaxpby(zone,x,zzero,ptx,map%desc_U,info) + if (info == psb_success_) call psb_halo(ptx,map%desc_U,info,work=work) + if (info == psb_success_) call psb_csmm(zone,map%mat_U2V,ptx,zzero,pty,info) + if ((info == psb_success_) .and. map%desc_V%is_repl().and.(np>1)) then yta = pty%get_vect() call psb_sum(ictxt,yta(1:nr2)) call pty%set(yta) end if - if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%desc_Y,info) + if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%desc_V,info) if (info /= psb_success_) then write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 @@ -211,19 +211,19 @@ subroutine psb_z_map_X2Y_vect(alpha,x,beta,y,map,info,work,vtx,vty) end select return -end subroutine psb_z_map_X2Y_vect +end subroutine psb_z_map_U2V_v ! -! Takes a vector x from space map%p_desc_Y and maps it onto -! map%p_desc_X under map%map_Y2X possibly with communication +! Takes a vector x from space map%p_desc_V and maps it onto +! map%p_desc_U under map%mat_V2U possibly with communication ! due to exch_bk_idx ! -subroutine psb_z_map_Y2X(alpha,x,beta,y,map,info,work) - use psb_base_mod, psb_protect_name => psb_z_map_Y2X +subroutine psb_z_map_V2U_a(alpha,x,beta,y,map,info,work) + use psb_base_mod, psb_protect_name => psb_z_map_V2U_a implicit none - type(psb_zlinmap_type), intent(in) :: map + class(psb_zlinmap_type), intent(in) :: map complex(psb_dpk_), intent(in) :: alpha,beta complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(out) :: y(:) @@ -234,7 +234,7 @@ subroutine psb_z_map_Y2X(alpha,x,beta,y,map,info,work) complex(psb_dpk_), allocatable :: xt(:), yt(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2,& & map_kind, nr, ictxt - character(len=20), parameter :: name='psb_map_Y2X' + character(len=20), parameter :: name='psb_map_V2U' info = psb_success_ if (.not.map%is_asb()) then @@ -248,16 +248,16 @@ subroutine psb_z_map_Y2X(alpha,x,beta,y,map,info,work) select case(map_kind) case(psb_map_aggr_) - ictxt = map%p_desc_X%get_context() - nr2 = map%p_desc_X%get_global_rows() - nc2 = map%p_desc_X%get_local_cols() + ictxt = map%p_desc_U%get_context() + nr2 = map%p_desc_U%get_global_rows() + nc2 = map%p_desc_U%get_local_cols() allocate(yt(nc2),stat=info) - if (info == psb_success_) call psb_halo(x,map%p_desc_Y,info,work=work) - if (info == psb_success_) call psb_csmm(zone,map%map_Y2X,x,zzero,yt,info) - if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_X)) then + if (info == psb_success_) call psb_halo(x,map%p_desc_V,info,work=work) + if (info == psb_success_) call psb_csmm(zone,map%mat_V2U,x,zzero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_U)) then call psb_sum(ictxt,yt(1:nr2)) end if - if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_X,info) + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_U,info) if (info /= psb_success_) then write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 @@ -265,19 +265,19 @@ subroutine psb_z_map_Y2X(alpha,x,beta,y,map,info,work) case(psb_map_gen_linear_) - ictxt = map%desc_X%get_context() - nr1 = map%desc_Y%get_local_rows() - nc1 = map%desc_Y%get_local_cols() - nr2 = map%desc_X%get_global_rows() - nc2 = map%desc_X%get_local_cols() + ictxt = map%desc_U%get_context() + nr1 = map%desc_V%get_local_rows() + nc1 = map%desc_V%get_local_cols() + nr2 = map%desc_U%get_global_rows() + nc2 = map%desc_U%get_local_cols() allocate(xt(nc1),yt(nc2),stat=info) xt(1:nr1) = x(1:nr1) - if (info == psb_success_) call psb_halo(xt,map%desc_Y,info,work=work) - if (info == psb_success_) call psb_csmm(zone,map%map_Y2X,xt,zzero,yt,info) - if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_X)) then + if (info == psb_success_) call psb_halo(xt,map%desc_V,info,work=work) + if (info == psb_success_) call psb_csmm(zone,map%mat_V2U,xt,zzero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_U)) then call psb_sum(ictxt,yt(1:nr2)) end if - if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_X,info) + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_U,info) if (info /= psb_success_) then write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 @@ -290,12 +290,12 @@ subroutine psb_z_map_Y2X(alpha,x,beta,y,map,info,work) return end select -end subroutine psb_z_map_Y2X +end subroutine psb_z_map_V2U_a -subroutine psb_z_map_Y2X_vect(alpha,x,beta,y,map,info,work,vtx,vty) - use psb_base_mod, psb_protect_name => psb_z_map_Y2X_vect +subroutine psb_z_map_V2U_v(alpha,x,beta,y,map,info,work,vtx,vty) + use psb_base_mod, psb_protect_name => psb_z_map_V2U_v implicit none - type(psb_zlinmap_type), intent(in) :: map + class(psb_zlinmap_type), intent(in) :: map complex(psb_dpk_), intent(in) :: alpha,beta type(psb_z_vect_type), intent(inout) :: x,y integer(psb_ipk_), intent(out) :: info @@ -307,7 +307,7 @@ subroutine psb_z_map_Y2X_vect(alpha,x,beta,y,map,info,work,vtx,vty) complex(psb_dpk_), allocatable :: xta(:), yta(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2,& & map_kind, nr, ictxt, iam, np - character(len=20), parameter :: name='psb_map_Y2Xv' + character(len=20), parameter :: name='psb_map_V2U_v' info = psb_success_ if (.not.map%is_asb()) then @@ -321,24 +321,24 @@ subroutine psb_z_map_Y2X_vect(alpha,x,beta,y,map,info,work,vtx,vty) select case(map_kind) case(psb_map_aggr_) - ictxt = map%p_desc_X%get_context() + ictxt = map%p_desc_U%get_context() call psb_info(ictxt,iam,np) - nr2 = map%p_desc_X%get_global_rows() - nc2 = map%p_desc_X%get_local_cols() + nr2 = map%p_desc_U%get_global_rows() + nc2 = map%p_desc_U%get_local_cols() if (present(vty)) then pty => vty else - call psb_geasb(yt,map%p_desc_X,info,scratch=.true.,mold=x%v) + call psb_geasb(yt,map%p_desc_U,info,scratch=.true.,mold=x%v) pty => yt end if - if (info == psb_success_) call psb_halo(x,map%p_desc_Y,info,work=work) - if (info == psb_success_) call psb_csmm(zone,map%map_Y2X,x,zzero,pty,info) - if ((info == psb_success_) .and. map%p_desc_X%is_repl().and.(np>1)) then + if (info == psb_success_) call psb_halo(x,map%p_desc_V,info,work=work) + if (info == psb_success_) call psb_csmm(zone,map%mat_V2U,x,zzero,pty,info) + if ((info == psb_success_) .and. map%p_desc_U%is_repl().and.(np>1)) then yta = pty%get_vect() call psb_sum(ictxt,yta(1:nr2)) call pty%set(yta) end if - if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%p_desc_X,info) + if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%p_desc_U,info) if (info /= psb_success_) then write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 @@ -348,32 +348,32 @@ subroutine psb_z_map_Y2X_vect(alpha,x,beta,y,map,info,work,vtx,vty) case(psb_map_gen_linear_) - ictxt = map%desc_X%get_context() + ictxt = map%desc_U%get_context() call psb_info(ictxt,iam,np) - nr1 = map%desc_Y%get_local_rows() - nc1 = map%desc_Y%get_local_cols() - nr2 = map%desc_X%get_global_rows() - nc2 = map%desc_X%get_local_cols() + nr1 = map%desc_V%get_local_rows() + nc1 = map%desc_V%get_local_cols() + nr2 = map%desc_U%get_global_rows() + nc2 = map%desc_U%get_local_cols() if (present(vtx).and.present(vty)) then ptx => vtx pty => vty else - call psb_geasb(xt,map%desc_Y,info,scratch=.true.,mold=x%v) - call psb_geasb(yt,map%desc_X,info,scratch=.true.,mold=x%v) + call psb_geasb(xt,map%desc_V,info,scratch=.true.,mold=x%v) + call psb_geasb(yt,map%desc_U,info,scratch=.true.,mold=x%v) ptx => xt pty => yt end if - call psb_geaxpby(zone,x,zzero,ptx,map%desc_Y,info) + call psb_geaxpby(zone,x,zzero,ptx,map%desc_V,info) - if (info == psb_success_) call psb_halo(ptx,map%desc_Y,info,work=work) - if (info == psb_success_) call psb_csmm(zone,map%map_Y2X,ptx,zzero,pty,info) - if ((info == psb_success_) .and. map%desc_X%is_repl().and.(np>1)) then + if (info == psb_success_) call psb_halo(ptx,map%desc_V,info,work=work) + if (info == psb_success_) call psb_csmm(zone,map%mat_V2U,ptx,zzero,pty,info) + if ((info == psb_success_) .and. map%desc_U%is_repl().and.(np>1)) then yta = pty%get_vect() call psb_sum(ictxt,yta(1:nr2)) call pty%set(yta) end if - if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%desc_X,info) + if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%desc_U,info) if (info /= psb_success_) then write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 @@ -390,16 +390,16 @@ subroutine psb_z_map_Y2X_vect(alpha,x,beta,y,map,info,work,vtx,vty) return end select -end subroutine psb_z_map_Y2X_vect +end subroutine psb_z_map_V2U_v -function psb_z_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) & +function psb_z_linmap(map_kind,desc_U, desc_V, mat_U2V, mat_V2U,iaggr,naggr) & & result(this) use psb_base_mod, psb_protect_name => psb_z_linmap implicit none type(psb_zlinmap_type) :: this - type(psb_desc_type), target :: desc_X, desc_Y - type(psb_zspmat_type), intent(inout) :: map_X2Y, map_Y2X + type(psb_desc_type), target :: desc_U, desc_V + type(psb_zspmat_type), intent(inout) :: mat_U2V, mat_V2U integer(psb_ipk_), intent(in) :: map_kind integer(psb_ipk_), intent(in), optional :: iaggr(:), naggr(:) ! @@ -411,15 +411,15 @@ function psb_z_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) & case (psb_map_aggr_) ! OK - if (psb_is_ok_desc(desc_X)) then - this%p_desc_X=>desc_X + if (psb_is_ok_desc(desc_U)) then + this%p_desc_U=>desc_U else - info = psb_err_pivot_too_small_ + info = psb_err_invalid_cd_state_ endif - if (psb_is_ok_desc(desc_Y)) then - this%p_desc_Y=>desc_Y + if (psb_is_ok_desc(desc_V)) then + this%p_desc_V=>desc_V else - info = psb_err_invalid_ovr_num_ + info = psb_err_invalid_cd_state_ endif if (present(iaggr)) then if (.not.present(naggr)) then @@ -438,15 +438,15 @@ function psb_z_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) & case(psb_map_gen_linear_) - if (desc_X%is_ok()) then - call desc_X%clone(this%desc_X,info) + if (desc_U%is_ok()) then + call desc_U%clone(this%desc_U,info) else - info = psb_err_pivot_too_small_ + info = psb_err_invalid_cd_state_ endif - if (desc_Y%is_ok()) then - call desc_Y%clone(this%desc_Y,info) + if (desc_V%is_ok()) then + call desc_V%clone(this%desc_V,info) else - info = psb_err_invalid_ovr_num_ + info = psb_err_invalid_cd_state_ endif ! If iaggr/naggr are present, copy them anyway. if (present(iaggr)) then @@ -469,8 +469,8 @@ function psb_z_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) & info = 1 end select - if (info == psb_success_) call map_X2Y%clone(this%map_X2Y,info) - if (info == psb_success_) call map_Y2X%clone(this%map_Y2X,info) + if (info == psb_success_) call mat_U2V%clone(this%mat_U2V,info) + if (info == psb_success_) call mat_V2U%clone(this%mat_V2U,info) if (info == psb_success_) then call this%set_kind(map_kind) end if