From 641e933716b8d0b58f5c4d00a841fe36efe000e7 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Sat, 31 Aug 2013 15:23:22 +0000 Subject: [PATCH] psblas-3.99 Fixes for integer vecors in DESC (even inside maps) --- base/modules/psb_c_linmap_mod.f90 | 8 +++++++- base/modules/psb_c_vect_mod.F90 | 1 - base/modules/psb_s_linmap_mod.f90 | 8 +++++++- base/modules/psb_s_vect_mod.F90 | 1 - base/modules/psb_z_linmap_mod.f90 | 8 +++++++- base/modules/psb_z_vect_mod.F90 | 1 - base/tools/psb_c_map.f90 | 21 ++++++++++++--------- base/tools/psb_d_map.f90 | 18 +++++++----------- base/tools/psb_s_map.f90 | 21 ++++++++++++--------- base/tools/psb_z_map.f90 | 21 ++++++++++++--------- test/pargen/Makefile | 6 +++++- 11 files changed, 69 insertions(+), 45 deletions(-) diff --git a/base/modules/psb_c_linmap_mod.f90 b/base/modules/psb_c_linmap_mod.f90 index 623f42a1..24801dac 100644 --- a/base/modules/psb_c_linmap_mod.f90 +++ b/base/modules/psb_c_linmap_mod.f90 @@ -159,17 +159,23 @@ contains end function c_is_asb - subroutine psb_c_map_cscnv(map,info,type,mold) + subroutine psb_c_map_cscnv(map,info,type,mold,imold) + use psb_i_vect_mod use psb_c_mat_mod implicit none type(psb_clinmap_type), intent(inout) :: map integer(psb_ipk_), intent(out) :: info character(len=*), intent(in), optional :: type class(psb_c_base_sparse_mat), intent(in), optional :: mold + class(psb_i_base_vect_type), intent(in), optional :: imold call map%map_X2Y%cscnv(info,type=type,mold=mold) if (info == psb_success_)& & call map%map_Y2X%cscnv(info,type=type,mold=mold) + if (present(imold)) then + call map%desc_X%cnv(mold=imold) + call map%desc_Y%cnv(mold=imold) + end if end subroutine psb_c_map_cscnv diff --git a/base/modules/psb_c_vect_mod.F90 b/base/modules/psb_c_vect_mod.F90 index 231a9b33..68da4bc2 100644 --- a/base/modules/psb_c_vect_mod.F90 +++ b/base/modules/psb_c_vect_mod.F90 @@ -564,7 +564,6 @@ contains class(psb_c_vect_type), intent(inout) :: x class(psb_c_base_vect_type), intent(in) :: mold class(psb_c_base_vect_type), allocatable :: tmp - complex(psb_spk_), allocatable :: invect(:) integer(psb_ipk_) :: info #ifdef HAVE_MOLD diff --git a/base/modules/psb_s_linmap_mod.f90 b/base/modules/psb_s_linmap_mod.f90 index 44bd6cff..2c8131c6 100644 --- a/base/modules/psb_s_linmap_mod.f90 +++ b/base/modules/psb_s_linmap_mod.f90 @@ -159,17 +159,23 @@ contains end function s_is_asb - subroutine psb_s_map_cscnv(map,info,type,mold) + subroutine psb_s_map_cscnv(map,info,type,mold,imold) + use psb_i_vect_mod use psb_s_mat_mod implicit none type(psb_slinmap_type), intent(inout) :: map integer(psb_ipk_), intent(out) :: info character(len=*), intent(in), optional :: type class(psb_s_base_sparse_mat), intent(in), optional :: mold + class(psb_i_base_vect_type), intent(in), optional :: imold call map%map_X2Y%cscnv(info,type=type,mold=mold) if (info == psb_success_)& & call map%map_Y2X%cscnv(info,type=type,mold=mold) + if (present(imold)) then + call map%desc_X%cnv(mold=imold) + call map%desc_Y%cnv(mold=imold) + end if end subroutine psb_s_map_cscnv diff --git a/base/modules/psb_s_vect_mod.F90 b/base/modules/psb_s_vect_mod.F90 index 29d7ca08..1f14558d 100644 --- a/base/modules/psb_s_vect_mod.F90 +++ b/base/modules/psb_s_vect_mod.F90 @@ -564,7 +564,6 @@ contains class(psb_s_vect_type), intent(inout) :: x class(psb_s_base_vect_type), intent(in) :: mold class(psb_s_base_vect_type), allocatable :: tmp - real(psb_spk_), allocatable :: invect(:) integer(psb_ipk_) :: info #ifdef HAVE_MOLD diff --git a/base/modules/psb_z_linmap_mod.f90 b/base/modules/psb_z_linmap_mod.f90 index ef1ec4b1..eab413fe 100644 --- a/base/modules/psb_z_linmap_mod.f90 +++ b/base/modules/psb_z_linmap_mod.f90 @@ -159,17 +159,23 @@ contains end function z_is_asb - subroutine psb_z_map_cscnv(map,info,type,mold) + subroutine psb_z_map_cscnv(map,info,type,mold,imold) + use psb_i_vect_mod use psb_z_mat_mod implicit none type(psb_zlinmap_type), intent(inout) :: map integer(psb_ipk_), intent(out) :: info character(len=*), intent(in), optional :: type class(psb_z_base_sparse_mat), intent(in), optional :: mold + class(psb_i_base_vect_type), intent(in), optional :: imold call map%map_X2Y%cscnv(info,type=type,mold=mold) if (info == psb_success_)& & call map%map_Y2X%cscnv(info,type=type,mold=mold) + if (present(imold)) then + call map%desc_X%cnv(mold=imold) + call map%desc_Y%cnv(mold=imold) + end if end subroutine psb_z_map_cscnv diff --git a/base/modules/psb_z_vect_mod.F90 b/base/modules/psb_z_vect_mod.F90 index 1d84cd95..e448f9ed 100644 --- a/base/modules/psb_z_vect_mod.F90 +++ b/base/modules/psb_z_vect_mod.F90 @@ -564,7 +564,6 @@ contains class(psb_z_vect_type), intent(inout) :: x class(psb_z_base_vect_type), intent(in) :: mold class(psb_z_base_vect_type), allocatable :: tmp - complex(psb_dpk_), allocatable :: invect(:) integer(psb_ipk_) :: info #ifdef HAVE_MOLD diff --git a/base/tools/psb_c_map.f90 b/base/tools/psb_c_map.f90 index ac68043d..319a03e4 100644 --- a/base/tools/psb_c_map.f90 +++ b/base/tools/psb_c_map.f90 @@ -124,7 +124,7 @@ subroutine psb_c_map_X2Y_vect(alpha,x,beta,y,map,info,work) complex(psb_spk_), allocatable :: xta(:), yta(:) 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_X2Yv' info = psb_success_ if (.not.map%is_asb()) then @@ -153,8 +153,9 @@ subroutine psb_c_map_X2Y_vect(alpha,x,beta,y,map,info,work) if (info /= psb_success_) then write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 + else + call yt%free(info) end if - call yt%free(info) case(psb_map_gen_linear_) @@ -180,10 +181,11 @@ subroutine psb_c_map_X2Y_vect(alpha,x,beta,y,map,info,work) if (info /= psb_success_) then write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 + else + call xt%free(info) + call yt%free(info) end if - call xt%free(info) - call yt%free(info) case default write(psb_err_unit,*) trim(name),' Invalid descriptor input', & @@ -287,7 +289,7 @@ subroutine psb_c_map_Y2X_vect(alpha,x,beta,y,map,info,work) complex(psb_spk_), allocatable :: xta(:), yta(:) 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_Y2Xv' info = psb_success_ if (.not.map%is_asb()) then @@ -316,8 +318,9 @@ subroutine psb_c_map_Y2X_vect(alpha,x,beta,y,map,info,work) if (info /= psb_success_) then write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 + else + call yt%free(info) end if - call yt%free(info) case(psb_map_gen_linear_) @@ -342,10 +345,10 @@ subroutine psb_c_map_Y2X_vect(alpha,x,beta,y,map,info,work) if (info /= psb_success_) then write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 + else + call xt%free(info) + call yt%free(info) end if - - call xt%free(info) - call yt%free(info) case default write(psb_err_unit,*) trim(name),' Invalid descriptor input' diff --git a/base/tools/psb_d_map.f90 b/base/tools/psb_d_map.f90 index b3c72d49..0a0f67f9 100644 --- a/base/tools/psb_d_map.f90 +++ b/base/tools/psb_d_map.f90 @@ -137,8 +137,7 @@ subroutine psb_d_map_X2Y_vect(alpha,x,beta,y,map,info,work) select case(map_kind) case(psb_map_aggr_) -!!$ write(0,*) 'Using a map_aggr_ map',allocated(map%p_desc_X%v_halo_index%v),& -!!$ & allocated(map%p_desc_Y%v_halo_index%v) + ictxt = map%p_desc_Y%get_context() nr2 = map%p_desc_Y%get_global_rows() nc2 = map%p_desc_Y%get_local_cols() @@ -159,7 +158,7 @@ subroutine psb_d_map_X2Y_vect(alpha,x,beta,y,map,info,work) end if case(psb_map_gen_linear_) -!!$ write(0,*) 'Using a gen_linear_ map' + ictxt = map%desc_Y%get_context() nr1 = map%desc_X%get_local_rows() nc1 = map%desc_X%get_local_cols() @@ -267,7 +266,7 @@ subroutine psb_d_map_Y2X(alpha,x,beta,y,map,info,work) write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 end if - + case default write(psb_err_unit,*) trim(name),' Invalid descriptor input' @@ -303,7 +302,7 @@ subroutine psb_d_map_Y2X_vect(alpha,x,beta,y,map,info,work) select case(map_kind) case(psb_map_aggr_) -!!$ write(0,*) 'Using a map_aggr_ map' + ictxt = map%p_desc_X%get_context() nr2 = map%p_desc_X%get_global_rows() nc2 = map%p_desc_X%get_local_cols() @@ -324,7 +323,7 @@ subroutine psb_d_map_Y2X_vect(alpha,x,beta,y,map,info,work) end if case(psb_map_gen_linear_) -!!$ write(0,*) 'Using a gen_linear_ map' + ictxt = map%desc_X%get_context() nr1 = map%desc_Y%get_local_rows() nc1 = map%desc_Y%get_local_cols() @@ -377,7 +376,7 @@ function psb_d_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) & select case(map_kind) case (psb_map_aggr_) ! OK -!!$ write(0,*) 'Creating a map_aggr_ map' + if (psb_is_ok_desc(desc_X)) then this%p_desc_X=>desc_X else @@ -388,9 +387,6 @@ function psb_d_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) & else info = psb_err_invalid_ovr_num_ endif -!!$ write(0,*) 'Creating a map_aggr_ map 2:',allocated(this%p_desc_X%v_halo_index%v),& -!!$ & allocated(this%p_desc_Y%v_halo_index%v) - if (present(iaggr)) then if (.not.present(naggr)) then info = 7 @@ -407,7 +403,7 @@ function psb_d_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) & end if case(psb_map_gen_linear_) -!!$ write(0,*) 'Creating a gen_linear_ map' + if (desc_X%is_ok()) then call psb_cdcpy(desc_X, this%desc_X,info) else diff --git a/base/tools/psb_s_map.f90 b/base/tools/psb_s_map.f90 index f945fb42..dfa4454f 100644 --- a/base/tools/psb_s_map.f90 +++ b/base/tools/psb_s_map.f90 @@ -124,7 +124,7 @@ subroutine psb_s_map_X2Y_vect(alpha,x,beta,y,map,info,work) real(psb_spk_), allocatable :: xta(:), yta(:) 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_X2Yv' info = psb_success_ if (.not.map%is_asb()) then @@ -153,8 +153,9 @@ subroutine psb_s_map_X2Y_vect(alpha,x,beta,y,map,info,work) if (info /= psb_success_) then write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 + else + call yt%free(info) end if - call yt%free(info) case(psb_map_gen_linear_) @@ -180,10 +181,11 @@ subroutine psb_s_map_X2Y_vect(alpha,x,beta,y,map,info,work) if (info /= psb_success_) then write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 + else + call xt%free(info) + call yt%free(info) end if - call xt%free(info) - call yt%free(info) case default write(psb_err_unit,*) trim(name),' Invalid descriptor input', & @@ -287,7 +289,7 @@ subroutine psb_s_map_Y2X_vect(alpha,x,beta,y,map,info,work) real(psb_spk_), allocatable :: xta(:), yta(:) 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_Y2Xv' info = psb_success_ if (.not.map%is_asb()) then @@ -316,8 +318,9 @@ subroutine psb_s_map_Y2X_vect(alpha,x,beta,y,map,info,work) if (info /= psb_success_) then write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 + else + call yt%free(info) end if - call yt%free(info) case(psb_map_gen_linear_) @@ -342,10 +345,10 @@ subroutine psb_s_map_Y2X_vect(alpha,x,beta,y,map,info,work) if (info /= psb_success_) then write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 + else + call xt%free(info) + call yt%free(info) end if - - call xt%free(info) - call yt%free(info) case default write(psb_err_unit,*) trim(name),' Invalid descriptor input' diff --git a/base/tools/psb_z_map.f90 b/base/tools/psb_z_map.f90 index 305c729b..548a5d38 100644 --- a/base/tools/psb_z_map.f90 +++ b/base/tools/psb_z_map.f90 @@ -124,7 +124,7 @@ subroutine psb_z_map_X2Y_vect(alpha,x,beta,y,map,info,work) complex(psb_dpk_), allocatable :: xta(:), yta(:) 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_X2Yv' info = psb_success_ if (.not.map%is_asb()) then @@ -153,8 +153,9 @@ subroutine psb_z_map_X2Y_vect(alpha,x,beta,y,map,info,work) if (info /= psb_success_) then write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 + else + call yt%free(info) end if - call yt%free(info) case(psb_map_gen_linear_) @@ -180,10 +181,11 @@ subroutine psb_z_map_X2Y_vect(alpha,x,beta,y,map,info,work) if (info /= psb_success_) then write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 + else + call xt%free(info) + call yt%free(info) end if - call xt%free(info) - call yt%free(info) case default write(psb_err_unit,*) trim(name),' Invalid descriptor input', & @@ -287,7 +289,7 @@ subroutine psb_z_map_Y2X_vect(alpha,x,beta,y,map,info,work) complex(psb_dpk_), allocatable :: xta(:), yta(:) 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_Y2Xv' info = psb_success_ if (.not.map%is_asb()) then @@ -316,8 +318,9 @@ subroutine psb_z_map_Y2X_vect(alpha,x,beta,y,map,info,work) if (info /= psb_success_) then write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 + else + call yt%free(info) end if - call yt%free(info) case(psb_map_gen_linear_) @@ -342,10 +345,10 @@ subroutine psb_z_map_Y2X_vect(alpha,x,beta,y,map,info,work) if (info /= psb_success_) then write(psb_err_unit,*) trim(name),' Error from inner routines',info info = -1 + else + call xt%free(info) + call yt%free(info) end if - - call xt%free(info) - call yt%free(info) case default write(psb_err_unit,*) trim(name),' Invalid descriptor input' diff --git a/test/pargen/Makefile b/test/pargen/Makefile index 8e670ac7..9946b52f 100644 --- a/test/pargen/Makefile +++ b/test/pargen/Makefile @@ -21,6 +21,10 @@ ppde3d: ppde3d.o $(F90LINK) ppde3d.o -o ppde3d $(PSBLAS_LIB) $(LDLIBS) /bin/mv ppde3d $(EXEDIR) +ppde3d_ext: ppde3d_ext.o + $(F90LINK) ppde3d_ext.o -o ppde3d_ext $(PSBLAS_LIB) $(LDLIBS) + /bin/mv ppde3d_ext $(EXEDIR) + spde3d: spde3d.o $(F90LINK) spde3d.o -o spde3d $(PSBLAS_LIB) $(LDLIBS) @@ -37,7 +41,7 @@ spde2d: spde2d.o clean: - /bin/rm -f ppde3d.o spde3d.o ppde2d.o spde2d.o \ + /bin/rm -f ppde3d.o spde3d.o ppde2d.o spde2d.o ppde3d_ext.o \ $(EXEDIR)/ppde3d $(EXEDIR)/spde3d $(EXEDIR)/ppde2d $(EXEDIR)/spde2d verycleanlib: (cd ../..; make veryclean)