base/internals/psi_bld_tmphalo.f90
 base/internals/psi_idx_cnv.f90
 base/internals/psi_idx_ins_cnv.f90
 base/modules/psb_c_base_vect_mod.f90
 base/modules/psb_c_vect_mod.F90
 base/modules/psb_d_base_vect_mod.f90
 base/modules/psb_d_linmap_mod.f90
 base/modules/psb_d_vect_mod.F90
 base/modules/psb_i_base_vect_mod.f90
 base/modules/psb_i_vect_mod.F90
 base/modules/psb_s_base_vect_mod.f90
 base/modules/psb_s_vect_mod.F90
 base/modules/psb_z_base_vect_mod.f90
 base/modules/psb_z_vect_mod.F90
 base/tools/psb_cd_switch_ovl_indxmap.f90
 base/tools/psb_loc_to_glob.f90

Fixes for G2L/L2G with IP versions.
Fixes for MOLD on vectors. 
New sed scripts.
psblas3-final
Salvatore Filippone 13 years ago
parent 4568e1b287
commit 987c8e8819

@ -100,7 +100,7 @@ subroutine psi_bld_tmphalo(desc,info)
helem(i) = n_row+i ! desc%loc_to_glob(n_row+i)
end do
call desc%indxmap%l2g(helem(1:nh),info)
call desc%indxmap%l2gip(helem(1:nh),info)
call desc%indxmap%fnd_owner(helem(1:nh),hproc,info)
if (info /= psb_success_) then

@ -112,7 +112,7 @@ subroutine psi_idx_cnv1(nv,idxin,desc,info,mask,owned)
end if
endif
call desc%indxmap%g2l(idxin(1:nv),info,mask=mask,owned=owned)
call desc%indxmap%g2lip(idxin(1:nv),info,mask=mask,owned=owned)
if (info /= 0) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='g2l')

@ -113,7 +113,7 @@ subroutine psi_idx_ins_cnv1(nv,idxin,desc,info,mask,lidx)
endif
call desc%indxmap%g2l_ins(idxin(1:nv),info,mask=mask,lidx=lidx)
call desc%indxmap%g2lip_ins(idxin(1:nv),info,mask=mask,lidx=lidx)
if (info /= 0) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='g2l_ins')

@ -68,6 +68,7 @@ module psb_c_base_vect_mod
procedure, pass(x) :: bld_n => c_base_bld_n
generic, public :: bld => bld_x, bld_n
procedure, pass(x) :: all => c_base_all
procedure, pass(x) :: mold => c_base_mold
!
! Insert/set. Assembly and free.
! Assembly does almost nothing here, but is important
@ -219,6 +220,18 @@ contains
end subroutine c_base_all
subroutine c_base_mold(x, y, info)
use psi_serial_mod
use psb_realloc_mod
implicit none
class(psb_c_base_vect_type), intent(in) :: x
class(psb_c_base_vect_type), intent(out), allocatable :: y
integer(psb_ipk_), intent(out) :: info
allocate(psb_c_base_vect_type :: y, stat=info)
end subroutine c_base_mold
!
! Insert a bunch of values at specified positions.
!

@ -100,7 +100,11 @@ contains
integer(psb_ipk_) :: info
if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else
allocate(psb_c_base_vect_type :: x%v,stat=info)
endif
@ -117,7 +121,11 @@ contains
integer(psb_ipk_) :: info
if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else
allocate(psb_c_base_vect_type :: x%v,stat=info)
endif
@ -411,7 +419,11 @@ contains
integer(psb_ipk_), intent(out) :: info
if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else
allocate(psb_c_base_vect_type :: x%v,stat=info)
endif
@ -531,7 +543,11 @@ contains
complex(psb_spk_), allocatable :: invect(:)
integer(psb_ipk_) :: info
allocate(tmp,stat=info,mold=mold)
#ifdef HAVE_MOLD
allocate(tmp,stat=info,mold=mold)
#else
call mold%mold(tmp,info)
#endif
call x%v%sync()
if (info == psb_success_) call tmp%bld(x%v%v)
call x%v%free(info)

@ -68,6 +68,7 @@ module psb_d_base_vect_mod
procedure, pass(x) :: bld_n => d_base_bld_n
generic, public :: bld => bld_x, bld_n
procedure, pass(x) :: all => d_base_all
procedure, pass(x) :: mold => d_base_mold
!
! Insert/set. Assembly and free.
! Assembly does almost nothing here, but is important
@ -219,6 +220,18 @@ contains
end subroutine d_base_all
subroutine d_base_mold(x, y, info)
use psi_serial_mod
use psb_realloc_mod
implicit none
class(psb_d_base_vect_type), intent(in) :: x
class(psb_d_base_vect_type), intent(out), allocatable :: y
integer(psb_ipk_), intent(out) :: info
allocate(psb_d_base_vect_type :: y, stat=info)
end subroutine d_base_mold
!
! Insert a bunch of values at specified positions.
!

@ -124,19 +124,6 @@ module psb_d_linmap_mod
end function psb_d_linmap
end interface
interface psb_linmaps
subroutine psb_d_linmaps(mapout,map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,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), intent(inout) :: mapout
type(psb_desc_type), target :: desc_X, desc_Y
type(psb_dspmat_type), intent(in) :: map_X2Y, map_Y2X
integer(psb_ipk_), intent(in) :: map_kind
integer(psb_ipk_), intent(in), optional :: iaggr(:), naggr(:)
end subroutine psb_d_linmaps
end interface
private :: d_map_sizeof, d_is_asb, d_free

@ -100,7 +100,11 @@ contains
integer(psb_ipk_) :: info
if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else
allocate(psb_d_base_vect_type :: x%v,stat=info)
endif
@ -117,7 +121,11 @@ contains
integer(psb_ipk_) :: info
if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else
allocate(psb_d_base_vect_type :: x%v,stat=info)
endif
@ -411,7 +419,11 @@ contains
integer(psb_ipk_), intent(out) :: info
if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else
allocate(psb_d_base_vect_type :: x%v,stat=info)
endif
@ -531,7 +543,11 @@ contains
real(psb_dpk_), allocatable :: invect(:)
integer(psb_ipk_) :: info
allocate(tmp,stat=info,mold=mold)
#ifdef HAVE_MOLD
allocate(tmp,stat=info,mold=mold)
#else
call mold%mold(tmp,info)
#endif
call x%v%sync()
if (info == psb_success_) call tmp%bld(x%v%v)
call x%v%free(info)

@ -68,6 +68,7 @@ module psb_i_base_vect_mod
procedure, pass(x) :: bld_n => i_base_bld_n
generic, public :: bld => bld_x, bld_n
procedure, pass(x) :: all => i_base_all
procedure, pass(x) :: mold => i_base_mold
!
! Insert/set. Assembly and free.
! Assembly does almost nothing here, but is important
@ -219,6 +220,18 @@ contains
end subroutine i_base_all
subroutine i_base_mold(x, y, info)
use psi_serial_mod
use psb_realloc_mod
implicit none
class(psb_i_base_vect_type), intent(in) :: x
class(psb_i_base_vect_type), intent(out), allocatable :: y
integer(psb_ipk_), intent(out) :: info
allocate(psb_i_base_vect_type :: y, stat=info)
end subroutine i_base_mold
!
! Insert a bunch of values at specified positions.
!

@ -100,7 +100,11 @@ contains
integer(psb_ipk_) :: info
if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else
allocate(psb_i_base_vect_type :: x%v,stat=info)
endif
@ -117,7 +121,11 @@ contains
integer(psb_ipk_) :: info
if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else
allocate(psb_i_base_vect_type :: x%v,stat=info)
endif
@ -411,7 +419,11 @@ contains
integer(psb_ipk_), intent(out) :: info
if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else
allocate(psb_i_base_vect_type :: x%v,stat=info)
endif
@ -531,7 +543,11 @@ contains
integer(psb_ipk_), allocatable :: invect(:)
integer(psb_ipk_) :: info
allocate(tmp,stat=info,mold=mold)
#ifdef HAVE_MOLD
allocate(tmp,stat=info,mold=mold)
#else
call mold%mold(tmp,info)
#endif
call x%v%sync()
if (info == psb_success_) call tmp%bld(x%v%v)
call x%v%free(info)

@ -68,6 +68,7 @@ module psb_s_base_vect_mod
procedure, pass(x) :: bld_n => s_base_bld_n
generic, public :: bld => bld_x, bld_n
procedure, pass(x) :: all => s_base_all
procedure, pass(x) :: mold => s_base_mold
!
! Insert/set. Assembly and free.
! Assembly does almost nothing here, but is important
@ -219,6 +220,18 @@ contains
end subroutine s_base_all
subroutine s_base_mold(x, y, info)
use psi_serial_mod
use psb_realloc_mod
implicit none
class(psb_s_base_vect_type), intent(in) :: x
class(psb_s_base_vect_type), intent(out), allocatable :: y
integer(psb_ipk_), intent(out) :: info
allocate(psb_s_base_vect_type :: y, stat=info)
end subroutine s_base_mold
!
! Insert a bunch of values at specified positions.
!

@ -100,7 +100,11 @@ contains
integer(psb_ipk_) :: info
if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else
allocate(psb_s_base_vect_type :: x%v,stat=info)
endif
@ -117,7 +121,11 @@ contains
integer(psb_ipk_) :: info
if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else
allocate(psb_s_base_vect_type :: x%v,stat=info)
endif
@ -411,7 +419,11 @@ contains
integer(psb_ipk_), intent(out) :: info
if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else
allocate(psb_s_base_vect_type :: x%v,stat=info)
endif
@ -531,7 +543,11 @@ contains
real(psb_spk_), allocatable :: invect(:)
integer(psb_ipk_) :: info
allocate(tmp,stat=info,mold=mold)
#ifdef HAVE_MOLD
allocate(tmp,stat=info,mold=mold)
#else
call mold%mold(tmp,info)
#endif
call x%v%sync()
if (info == psb_success_) call tmp%bld(x%v%v)
call x%v%free(info)

@ -68,6 +68,7 @@ module psb_z_base_vect_mod
procedure, pass(x) :: bld_n => z_base_bld_n
generic, public :: bld => bld_x, bld_n
procedure, pass(x) :: all => z_base_all
procedure, pass(x) :: mold => z_base_mold
!
! Insert/set. Assembly and free.
! Assembly does almost nothing here, but is important
@ -219,6 +220,18 @@ contains
end subroutine z_base_all
subroutine z_base_mold(x, y, info)
use psi_serial_mod
use psb_realloc_mod
implicit none
class(psb_z_base_vect_type), intent(in) :: x
class(psb_z_base_vect_type), intent(out), allocatable :: y
integer(psb_ipk_), intent(out) :: info
allocate(psb_z_base_vect_type :: y, stat=info)
end subroutine z_base_mold
!
! Insert a bunch of values at specified positions.
!

@ -100,7 +100,11 @@ contains
integer(psb_ipk_) :: info
if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else
allocate(psb_z_base_vect_type :: x%v,stat=info)
endif
@ -117,7 +121,11 @@ contains
integer(psb_ipk_) :: info
if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else
allocate(psb_z_base_vect_type :: x%v,stat=info)
endif
@ -411,7 +419,11 @@ contains
integer(psb_ipk_), intent(out) :: info
if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else
allocate(psb_z_base_vect_type :: x%v,stat=info)
endif
@ -531,7 +543,11 @@ contains
complex(psb_dpk_), allocatable :: invect(:)
integer(psb_ipk_) :: info
allocate(tmp,stat=info,mold=mold)
#ifdef HAVE_MOLD
allocate(tmp,stat=info,mold=mold)
#else
call mold%mold(tmp,info)
#endif
call x%v%sync()
if (info == psb_success_) call tmp%bld(x%v%v)
call x%v%free(info)

@ -79,7 +79,7 @@ Subroutine psb_cd_switch_ovl_indxmap(desc,info)
do i=1,n_col
vl(i) = i
end do
call desc%indxmap%l2g(vl(1:n_col),info)
call desc%indxmap%l2gip(vl(1:n_col),info)
if (info /= psb_success_) then
ierr(1)=info
@ -101,7 +101,7 @@ Subroutine psb_cd_switch_ovl_indxmap(desc,info)
& call desc%indxmap%init(iictxt,vl(1:n_row),info)
if (info == psb_success_) call psb_cd_set_bld(desc,info)
if (info == psb_success_) &
& call desc%indxmap%g2l_ins(vl(n_row+1:n_col),info)
& call desc%indxmap%g2lip_ins(vl(n_row+1:n_col),info)
if (info /= psb_success_) then
ierr(1) = info
call psb_errpush(psb_err_from_subroutine_ai_,name,&

@ -179,7 +179,7 @@ subroutine psb_loc_to_glob(x,desc_a,info,iact)
endif
act = psb_toupper(act)
call desc_a%indxmap%l2g(x,info)
call desc_a%indxmap%l2gip(x,info)
if (info /= psb_success_) then
select case(act)

Loading…
Cancel
Save