From 41c6bfc15e0faf9ca9fb0309e5884b1dae76ed09 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Fri, 1 Nov 2013 16:45:09 +0000 Subject: [PATCH] psblas-3.99: base/internals/Makefile base/internals/psi_bld_tmphalo.f90 base/internals/psi_desc_impl.f90 base/internals/psi_ldsc_pre_halo.f90 base/modules/psi_i_mod.f90 base/tools/psb_icdasb.F90 Remove obsolete internal interface. --- base/internals/Makefile | 2 +- base/internals/psi_bld_tmphalo.f90 | 2 +- base/internals/psi_desc_impl.f90 | 13 --- base/internals/psi_ldsc_pre_halo.f90 | 113 --------------------------- base/modules/psi_i_mod.f90 | 9 --- base/tools/psb_icdasb.F90 | 10 ++- 6 files changed, 8 insertions(+), 141 deletions(-) delete mode 100644 base/internals/psi_ldsc_pre_halo.f90 diff --git a/base/internals/Makefile b/base/internals/Makefile index 2d3729bc..d1f37493 100644 --- a/base/internals/Makefile +++ b/base/internals/Makefile @@ -3,7 +3,7 @@ include ../../Make.inc FOBJS = psi_compute_size.o psi_crea_bnd_elem.o psi_crea_index.o \ psi_crea_ovr_elem.o psi_bld_tmpovrl.o psi_dl_check.o \ psi_sort_dl.o \ - psi_ldsc_pre_halo.o psi_bld_tmphalo.o\ + psi_bld_tmphalo.o\ psi_sort_dl.o \ psi_desc_impl.o psi_ovrl_restr.o psi_ovrl_save.o psi_ovrl_upd.o diff --git a/base/internals/psi_bld_tmphalo.f90 b/base/internals/psi_bld_tmphalo.f90 index 1842f92e..1a3e6588 100644 --- a/base/internals/psi_bld_tmphalo.f90 +++ b/base/internals/psi_bld_tmphalo.f90 @@ -81,7 +81,7 @@ subroutine psi_bld_tmphalo(desc,info) goto 9999 endif - if (.not.(psb_is_bld_desc(desc).and.allocated(desc%indxmap))) then + if (.not.(desc%is_bld())) then info = psb_err_invalid_cd_state_ call psb_errpush(info,name) goto 9999 diff --git a/base/internals/psi_desc_impl.f90 b/base/internals/psi_desc_impl.f90 index 0a48ec4a..9db4dc17 100644 --- a/base/internals/psi_desc_impl.f90 +++ b/base/internals/psi_desc_impl.f90 @@ -108,9 +108,6 @@ subroutine psi_cnv_dsc(halo_in,ovrlap_in,ext_in,cdesc, info, mold) goto 9999 end if call psb_move_alloc(idx_out,cdesc%halo_index,info) -!!$ cdesc%matrix_data(psb_thal_xch_) = nxch -!!$ cdesc%matrix_data(psb_thal_snd_) = nsnd -!!$ cdesc%matrix_data(psb_thal_rcv_) = nrcv if (debug_level>0) write(debug_unit,*) me,'Done crea_index on halo' if (debug_level>0) write(debug_unit,*) me,'Calling crea_index on ext' @@ -124,9 +121,6 @@ subroutine psi_cnv_dsc(halo_in,ovrlap_in,ext_in,cdesc, info, mold) goto 9999 end if call psb_move_alloc(idx_out,cdesc%ext_index,info) -!!$ cdesc%matrix_data(psb_text_xch_) = nxch -!!$ cdesc%matrix_data(psb_text_snd_) = nsnd -!!$ cdesc%matrix_data(psb_text_rcv_) = nrcv if (debug_level>0) write(debug_unit,*) me,'Done crea_index on ext' if (debug_level>0) write(debug_unit,*) me,'Calling crea_index on ovrlap' @@ -143,9 +137,6 @@ subroutine psi_cnv_dsc(halo_in,ovrlap_in,ext_in,cdesc, info, mold) goto 9999 end if -!!$ cdesc%matrix_data(psb_tovr_xch_) = nxch -!!$ cdesc%matrix_data(psb_tovr_snd_) = nsnd -!!$ cdesc%matrix_data(psb_tovr_rcv_) = nrcv ! next ovrlap_elem if (debug_level>0) write(debug_unit,*) me,'Calling crea_ovr_elem' @@ -171,10 +162,6 @@ subroutine psi_cnv_dsc(halo_in,ovrlap_in,ext_in,cdesc, info, mold) goto 9999 end if -!!$ cdesc%matrix_data(psb_tmov_xch_) = nxch -!!$ cdesc%matrix_data(psb_tmov_snd_) = nsnd -!!$ cdesc%matrix_data(psb_tmov_rcv_) = nrcv - ! finally bnd_elem call psi_crea_bnd_elem(idx_out,cdesc,info) if (info == psb_success_) call psb_move_alloc(idx_out,cdesc%bnd_elem,info) diff --git a/base/internals/psi_ldsc_pre_halo.f90 b/base/internals/psi_ldsc_pre_halo.f90 deleted file mode 100644 index d72934db..00000000 --- a/base/internals/psi_ldsc_pre_halo.f90 +++ /dev/null @@ -1,113 +0,0 @@ -!!$ -!!$ Parallel Sparse BLAS version 3.1 -!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012, 2013 -!!$ Salvatore Filippone University of Rome Tor Vergata -!!$ Alfredo Buttari CNRS-IRIT, Toulouse -!!$ -!!$ Redistribution and use in source and binary forms, with or without -!!$ modification, are permitted provided that the following conditions -!!$ are met: -!!$ 1. Redistributions of source code must retain the above copyright -!!$ notice, this list of conditions and the following disclaimer. -!!$ 2. Redistributions in binary form must reproduce the above copyright -!!$ notice, this list of conditions, and the following disclaimer in the -!!$ documentation and/or other materials provided with the distribution. -!!$ 3. The name of the PSBLAS group or the names of its contributors may -!!$ not be used to endorse or promote products derived from this -!!$ software without specific written permission. -!!$ -!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS -!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -!!$ POSSIBILITY OF SUCH DAMAGE. -!!$ -!!$ -! -! File: psi_ldsc_pre_halo.f90 -! -! Subroutine: psi_ldsc_pre_halo -! Build initial versions of data exchange lists for the -! large index space case. -! -! -! Arguments: -! desc - type(psb_desc_type). The communication descriptor. -! ext_hv - logical Should we work on the halo_index. -! info - integer. return code. -! -subroutine psi_ldsc_pre_halo(desc,ext_hv,info) - use psb_desc_mod - use psb_serial_mod - use psb_const_mod - use psb_error_mod - use psb_penv_mod - use psb_realloc_mod - use psi_mod, psb_protect_name => psi_ldsc_pre_halo - implicit none - type(psb_desc_type), intent(inout) :: desc - logical, intent(in) :: ext_hv - integer(psb_ipk_), intent(out) :: info - - integer(psb_ipk_),allocatable :: helem(:),hproc(:) - integer(psb_ipk_),allocatable :: tmphl(:) - - integer(psb_ipk_) :: i,j,np,me,lhalo,nhalo,& - & n_col, err_act, key, ih, nh, idx, nk,icomm - integer(psb_ipk_) :: ictxt,n_row - character(len=20) :: name,ch_err - - info = psb_success_ - name = 'psi_ldsc_pre_halo' - call psb_erractionsave(err_act) - - ictxt = desc%get_context() - icomm = desc%get_mpic() - n_row = desc%get_local_rows() - n_col = desc%get_local_cols() - - ! check on blacs grid - call psb_info(ictxt, me, np) - if (np == -1) then - info = psb_err_context_error_ - call psb_errpush(info,name) - goto 9999 - endif - - - if (.not.(psb_is_bld_desc(desc))) then - info = psb_err_invalid_cd_state_ - call psb_errpush(info,name) - goto 9999 - end if - - if (.not.ext_hv) then - call psi_bld_tmphalo(desc,info) - if (info /= psb_success_) then - ch_err='psi_bld_tmphalo' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - end if - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - - if (err_act == psb_act_ret_) then - return - else - call psb_error(ictxt) - end if - return - - -end subroutine psi_ldsc_pre_halo diff --git a/base/modules/psi_i_mod.f90 b/base/modules/psi_i_mod.f90 index 44268b18..b86b17bb 100644 --- a/base/modules/psi_i_mod.f90 +++ b/base/modules/psi_i_mod.f90 @@ -120,15 +120,6 @@ module psi_i_mod end subroutine psi_fnd_owner end interface - interface psi_ldsc_pre_halo - subroutine psi_ldsc_pre_halo(desc,ext_hv,info) - import :: psb_desc_type, psb_ipk_ - type(psb_desc_type), intent(inout) :: desc - logical, intent(in) :: ext_hv - integer(psb_ipk_), intent(out) :: info - end subroutine psi_ldsc_pre_halo - end interface - interface psi_bld_tmphalo subroutine psi_bld_tmphalo(desc,info) import :: psb_desc_type, psb_ipk_ diff --git a/base/tools/psb_icdasb.F90 b/base/tools/psb_icdasb.F90 index c0ba07c0..69649ca4 100644 --- a/base/tools/psb_icdasb.F90 +++ b/base/tools/psb_icdasb.F90 @@ -115,10 +115,12 @@ subroutine psb_icdasb(desc,info,ext_hv,mold) & write(debug_unit, *) me,' ',trim(name),': start' if (allocated(desc%indxmap)) then - call psi_ldsc_pre_halo(desc,ext_hv_,info) - if (info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='ldsc_pre_halo') - goto 9999 + if (.not.ext_hv_) then + call psi_bld_tmphalo(desc,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='bld_tmphalo') + goto 9999 + end if end if ! Take out the lists for ovrlap, halo and ext...