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

psblas3-newdesc:

Browse Source 
Merged changes from trunk
psblas3-newdesc
Salvatore Filippone 9 years ago
parent 3827109f9d ff492a8dae
commit 1079fdae6c
31 changed files with 50 additions and 2555 deletions
Show Stats Download Patch File Download Diff File

6
base/comm/Makefile
Unescape Escape View File

@ -14,16 +14,18 @@ INCDIR=..
MODDIR=../modules
FINCLUDES=$(FMFLAG). $(FMFLAG)$(MODDIR) $(FMFLAG)$(INCDIR)
lib: mpfobjs $(OBJS)
lib: interns mpfobjs $(OBJS)
$(AR) $(LIBDIR)/$(LIBNAME) $(MPFOBJS) $(OBJS)
$(RANLIB) $(LIBDIR)/$(LIBNAME)
interns:
cd internals && $(MAKE) lib
mpfobjs:
$(MAKE) $(MPFOBJS) F90="$(MPF90)" FC="$(MPF90)" FCOPT="$(F90COPT)"
clean:
cd internals && $(MAKE) clean
/bin/rm -f $(MPFOBJS) $(OBJS)
veryclean: clean

31
base/comm/internals/Makefile
Unescape Escape View File

@ -0,0 +1,31 @@
include ../../../Make.inc
FOBJS = psi_iovrl_restr.o psi_iovrl_save.o psi_iovrl_upd.o \
psi_sovrl_restr.o psi_sovrl_save.o psi_sovrl_upd.o \
psi_dovrl_restr.o psi_dovrl_save.o psi_dovrl_upd.o \
psi_covrl_restr.o psi_covrl_save.o psi_covrl_upd.o \
psi_zovrl_restr.o psi_zovrl_save.o psi_zovrl_upd.o
MPFOBJS = psi_dswapdata.o psi_dswaptran.o\
psi_sswapdata.o psi_sswaptran.o \
psi_iswapdata.o psi_iswaptran.o \
psi_cswapdata.o psi_cswaptran.o \
psi_zswapdata.o psi_zswaptran.o
LIBDIR=../..
INCDIR=../..
MODDIR=../../modules
FINCLUDES=$(FMFLAG). $(FMFLAG)$(MODDIR) $(FMFLAG)$(INCDIR)
CINCLUDES=-I.
lib: mpfobjs $(FOBJS) $(MPFOBJS)
$(AR) $(LIBDIR)/$(LIBNAME) $(MPFOBJS) $(MPFOBJS2) $(FOBJS) $(FOBJS2) $(COBJS)
$(RANLIB) $(LIBDIR)/$(LIBNAME)
$(FOBJS) $(FBOJS2): $(MODDIR)/psi_mod.o
mpfobjs:
(make $(MPFOBJS) F90="$(MPF90)" FC="$(MPF90)" FCOPT="$(F90COPT)")
clean:
/bin/rm -f $(MPFOBJS) $(FOBJS) $(COBJS) $(FOBJS2) $(MPFOBJS2) *$(.mod)
veryclean: clean

0
base/internals/psi_covrl_restr.f90 → base/comm/internals/psi_covrl_restr.f90
Unescape Escape View File

0
base/internals/psi_covrl_save.f90 → base/comm/internals/psi_covrl_save.f90
Unescape Escape View File

0
base/internals/psi_covrl_upd.f90 → base/comm/internals/psi_covrl_upd.f90
Unescape Escape View File

0
base/internals/psi_cswapdata.F90 → base/comm/internals/psi_cswapdata.F90
Unescape Escape View File

0
base/internals/psi_cswaptran.F90 → base/comm/internals/psi_cswaptran.F90
Unescape Escape View File

0
base/internals/psi_dovrl_restr.f90 → base/comm/internals/psi_dovrl_restr.f90
Unescape Escape View File

0
base/internals/psi_dovrl_save.f90 → base/comm/internals/psi_dovrl_save.f90
Unescape Escape View File

0
base/internals/psi_dovrl_upd.f90 → base/comm/internals/psi_dovrl_upd.f90
Unescape Escape View File

0
base/internals/psi_dswapdata.F90 → base/comm/internals/psi_dswapdata.F90
Unescape Escape View File

0
base/internals/psi_dswaptran.F90 → base/comm/internals/psi_dswaptran.F90
Unescape Escape View File

0
base/internals/psi_iovrl_restr.f90 → base/comm/internals/psi_iovrl_restr.f90
Unescape Escape View File

0
base/internals/psi_iovrl_save.f90 → base/comm/internals/psi_iovrl_save.f90
Unescape Escape View File

0
base/internals/psi_iovrl_upd.f90 → base/comm/internals/psi_iovrl_upd.f90
Unescape Escape View File

0
base/internals/psi_iswapdata.F90 → base/comm/internals/psi_iswapdata.F90
Unescape Escape View File

0
base/internals/psi_iswaptran.F90 → base/comm/internals/psi_iswaptran.F90
Unescape Escape View File

0
base/internals/psi_sovrl_restr.f90 → base/comm/internals/psi_sovrl_restr.f90
Unescape Escape View File

0
base/internals/psi_sovrl_save.f90 → base/comm/internals/psi_sovrl_save.f90
Unescape Escape View File

0
base/internals/psi_sovrl_upd.f90 → base/comm/internals/psi_sovrl_upd.f90
Unescape Escape View File

0
base/internals/psi_sswapdata.F90 → base/comm/internals/psi_sswapdata.F90
Unescape Escape View File

0
base/internals/psi_sswaptran.F90 → base/comm/internals/psi_sswaptran.F90
Unescape Escape View File

0
base/internals/psi_zovrl_restr.f90 → base/comm/internals/psi_zovrl_restr.f90
Unescape Escape View File

0
base/internals/psi_zovrl_save.f90 → base/comm/internals/psi_zovrl_save.f90
Unescape Escape View File

0
base/internals/psi_zovrl_upd.f90 → base/comm/internals/psi_zovrl_upd.f90
Unescape Escape View File

0
base/internals/psi_zswapdata.F90 → base/comm/internals/psi_zswapdata.F90
Unescape Escape View File

0
base/internals/psi_zswaptran.F90 → base/comm/internals/psi_zswaptran.F90
Unescape Escape View File

26
base/internals/Makefile
Unescape Escape View File

@ -5,23 +5,27 @@ FOBJS = psi_compute_size.o psi_crea_bnd_elem.o psi_crea_index.o \
psi_sort_dl.o \
psi_bld_tmphalo.o\
psi_sort_dl.o \
psi_desc_impl.o \
psi_iovrl_restr.o psi_iovrl_save.o psi_iovrl_upd.o \
psi_sovrl_restr.o psi_sovrl_save.o psi_sovrl_upd.o \
psi_dovrl_restr.o psi_dovrl_save.o psi_dovrl_upd.o \
psi_covrl_restr.o psi_covrl_save.o psi_covrl_upd.o \
psi_desc_impl.o
#\
# psi_iovrl_restr.o psi_iovrl_save.o psi_iovrl_upd.o \
# psi_sovrl_restr.o psi_sovrl_save.o psi_sovrl_upd.o \
# psi_dovrl_restr.o psi_dovrl_save.o psi_dovrl_upd.o \
# psi_covrl_restr.o psi_covrl_save.o psi_covrl_upd.o \
psi_zovrl_restr.o psi_zovrl_save.o psi_zovrl_upd.o
FOBJS2 = psi_exist_ovr_elem.o psi_list_search.o srtlist.o
#COBJS = avltree.o srcht.o
MPFOBJS = psi_dswapdata.o psi_dswaptran.o\
psi_sswapdata.o psi_sswaptran.o \
psi_iswapdata.o psi_iswaptran.o \
psi_cswapdata.o psi_cswaptran.o \
psi_zswapdata.o psi_zswaptran.o \
psi_desc_index.o psi_extrct_dl.o \
MPFOBJS = psi_desc_index.o psi_extrct_dl.o \
psi_fnd_owner.o psb_indx_map_fnd_owner.o
#psi_dswapdata.o psi_dswaptran.o\
# psi_sswapdata.o psi_sswaptran.o \
# psi_iswapdata.o psi_iswaptran.o \
# psi_cswapdata.o psi_cswaptran.o \
# psi_zswapdata.o psi_zswaptran.o \
LIBDIR=..
INCDIR=..
MODDIR=../modules

685
base/internals/psi_ovrl_restr.f90
Unescape Escape View File

@ -1,685 +0,0 @@
!!$
!!$ Parallel Sparse BLAS version 3.4
!!$ (C) Copyright 2006, 2010, 2015
!!$ 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.
!!$
!!$
subroutine psi_sovrl_restrr1(x,xs,desc_a,info)
use psi_mod, psi_protect_name => psi_sovrl_restrr1
implicit none
real(psb_spk_), intent(inout) :: x(:)
real(psb_spk_) :: xs(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err
name='psi_sovrl_restrr1'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
isz = size(desc_a%ovrlap_elem,1)
do i=1, isz
idx = desc_a%ovrlap_elem(i,1)
x(idx) = xs(i)
end do
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psi_sovrl_restrr1
subroutine psi_sovrl_restrr2(x,xs,desc_a,info)
use psi_mod, psi_protect_name => psi_sovrl_restrr2
implicit none
real(psb_spk_), intent(inout) :: x(:,:)
real(psb_spk_) :: xs(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err
name='psi_sovrl_restrr2'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
if (size(x,2) /= size(xs,2)) then
info = psb_err_internal_error_
call psb_errpush(info,name, a_err='Mismacth columns X vs XS')
goto 9999
endif
isz = size(desc_a%ovrlap_elem,1)
do i=1, isz
idx = desc_a%ovrlap_elem(i,1)
x(idx,:) = xs(i,:)
end do
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psi_sovrl_restrr2
subroutine psi_dovrl_restrr1(x,xs,desc_a,info)
use psi_mod, psi_protect_name => psi_dovrl_restrr1
implicit none
real(psb_dpk_), intent(inout) :: x(:)
real(psb_dpk_) :: xs(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err
name='psi_dovrl_restrr1'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
isz = size(desc_a%ovrlap_elem,1)
do i=1, isz
idx = desc_a%ovrlap_elem(i,1)
x(idx) = xs(i)
end do
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psi_dovrl_restrr1
subroutine psi_dovrl_restrr2(x,xs,desc_a,info)
use psi_mod, psi_protect_name => psi_dovrl_restrr2
implicit none
real(psb_dpk_), intent(inout) :: x(:,:)
real(psb_dpk_) :: xs(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err
name='psi_dovrl_restrr2'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
if (size(x,2) /= size(xs,2)) then
info = psb_err_internal_error_
call psb_errpush(info,name, a_err='Mismacth columns X vs XS')
goto 9999
endif
isz = size(desc_a%ovrlap_elem,1)
do i=1, isz
idx = desc_a%ovrlap_elem(i,1)
x(idx,:) = xs(i,:)
end do
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psi_dovrl_restrr2
subroutine psi_covrl_restrr1(x,xs,desc_a,info)
use psi_mod, psi_protect_name => psi_covrl_restrr1
implicit none
complex(psb_spk_), intent(inout) :: x(:)
complex(psb_spk_) :: xs(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err
name='psi_covrl_restrr1'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
isz = size(desc_a%ovrlap_elem,1)
do i=1, isz
idx = desc_a%ovrlap_elem(i,1)
x(idx) = xs(i)
end do
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psi_covrl_restrr1
subroutine psi_covrl_restrr2(x,xs,desc_a,info)
use psi_mod, psi_protect_name => psi_covrl_restrr2
implicit none
complex(psb_spk_), intent(inout) :: x(:,:)
complex(psb_spk_) :: xs(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err
name='psi_covrl_restrr2'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
if (size(x,2) /= size(xs,2)) then
info = psb_err_internal_error_
call psb_errpush(info,name, a_err='Mismacth columns X vs XS')
goto 9999
endif
isz = size(desc_a%ovrlap_elem,1)
do i=1, isz
idx = desc_a%ovrlap_elem(i,1)
x(idx,:) = xs(i,:)
end do
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psi_covrl_restrr2
subroutine psi_zovrl_restrr1(x,xs,desc_a,info)
use psi_mod, psi_protect_name => psi_zovrl_restrr1
implicit none
complex(psb_dpk_), intent(inout) :: x(:)
complex(psb_dpk_) :: xs(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err
name='psi_zovrl_restrr1'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
isz = size(desc_a%ovrlap_elem,1)
do i=1, isz
idx = desc_a%ovrlap_elem(i,1)
x(idx) = xs(i)
end do
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psi_zovrl_restrr1
subroutine psi_zovrl_restrr2(x,xs,desc_a,info)
use psi_mod, psi_protect_name => psi_zovrl_restrr2
implicit none
complex(psb_dpk_), intent(inout) :: x(:,:)
complex(psb_dpk_) :: xs(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err
name='psi_zovrl_restrr2'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
if (size(x,2) /= size(xs,2)) then
info = psb_err_internal_error_
call psb_errpush(info,name, a_err='Mismacth columns X vs XS')
goto 9999
endif
isz = size(desc_a%ovrlap_elem,1)
do i=1, isz
idx = desc_a%ovrlap_elem(i,1)
x(idx,:) = xs(i,:)
end do
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psi_zovrl_restrr2
subroutine psi_iovrl_restrr1(x,xs,desc_a,info)
use psi_mod, psi_protect_name => psi_iovrl_restrr1
implicit none
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_) :: xs(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err
name='psi_iovrl_restrr1'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
isz = size(desc_a%ovrlap_elem,1)
do i=1, isz
idx = desc_a%ovrlap_elem(i,1)
x(idx) = xs(i)
end do
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psi_iovrl_restrr1
subroutine psi_iovrl_restrr2(x,xs,desc_a,info)
use psi_mod, psi_protect_name => psi_iovrl_restrr2
implicit none
integer(psb_ipk_), intent(inout) :: x(:,:)
integer(psb_ipk_) :: xs(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err
name='psi_iovrl_restrr2'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
if (size(x,2) /= size(xs,2)) then
info = psb_err_internal_error_
call psb_errpush(info,name, a_err='Mismacth columns X vs XS')
goto 9999
endif
isz = size(desc_a%ovrlap_elem,1)
do i=1, isz
idx = desc_a%ovrlap_elem(i,1)
x(idx,:) = xs(i,:)
end do
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psi_iovrl_restrr2
subroutine psi_iovrl_restr_vect(x,xs,desc_a,info)
use psi_mod, psi_protect_name => psi_iovrl_restr_vect
use psb_i_base_vect_mod
implicit none
class(psb_i_base_vect_type) :: x
integer(psb_ipk_) :: xs(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err
name='psi_iovrl_restrr1'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
isz = size(desc_a%ovrlap_elem,1)
call x%sct(isz,desc_a%ovrlap_elem(:,1),xs,izero)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psi_iovrl_restr_vect
subroutine psi_sovrl_restr_vect(x,xs,desc_a,info)
use psi_mod, psi_protect_name => psi_sovrl_restr_vect
use psb_s_base_vect_mod
implicit none
class(psb_s_base_vect_type) :: x
real(psb_spk_) :: xs(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err
name='psi_sovrl_restrr1'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
isz = size(desc_a%ovrlap_elem,1)
call x%sct(isz,desc_a%ovrlap_elem(:,1),xs,szero)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psi_sovrl_restr_vect
subroutine psi_dovrl_restr_vect(x,xs,desc_a,info)
use psi_mod, psi_protect_name => psi_dovrl_restr_vect
use psb_d_base_vect_mod
implicit none
class(psb_d_base_vect_type) :: x
real(psb_dpk_) :: xs(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err
name='psi_dovrl_restrr1'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
isz = size(desc_a%ovrlap_elem,1)
call x%sct(isz,desc_a%ovrlap_elem(:,1),xs,dzero)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psi_dovrl_restr_vect
subroutine psi_covrl_restr_vect(x,xs,desc_a,info)
use psi_mod, psi_protect_name => psi_covrl_restr_vect
use psb_c_base_vect_mod
implicit none
class(psb_c_base_vect_type) :: x
complex(psb_spk_) :: xs(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err
name='psi_covrl_restrr1'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
isz = size(desc_a%ovrlap_elem,1)
call x%sct(isz,desc_a%ovrlap_elem(:,1),xs,czero)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psi_covrl_restr_vect
subroutine psi_zovrl_restr_vect(x,xs,desc_a,info)
use psi_mod, psi_protect_name => psi_zovrl_restr_vect
use psb_z_base_vect_mod
implicit none
class(psb_z_base_vect_type) :: x
complex(psb_dpk_) :: xs(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err
name='psi_zovrl_restrr1'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
isz = size(desc_a%ovrlap_elem,1)
call x%sct(isz,desc_a%ovrlap_elem(:,1),xs,zzero)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psi_zovrl_restr_vect

760
base/internals/psi_ovrl_save.f90
Unescape Escape View File

@ -1,760 +0,0 @@
!!$
!!$ Parallel Sparse BLAS version 3.4
!!$ (C) Copyright 2006, 2010, 2015
!!$ 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.
!!$
!!$
subroutine psi_sovrl_saver1(x,xs,desc_a,info)
use psi_mod, psi_protect_name => psi_sovrl_saver1
use psb_realloc_mod
implicit none
real(psb_spk_), intent(inout) :: x(:)
real(psb_spk_), allocatable :: xs(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err
name='psi_sovrl_saver1'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
isz = size(desc_a%ovrlap_elem,1)
call psb_realloc(isz,xs,info)
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
endif
do i=1, isz
idx = desc_a%ovrlap_elem(i,1)
xs(i) = x(idx)
end do
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psi_sovrl_saver1
subroutine psi_sovrl_saver2(x,xs,desc_a,info)
use psi_mod, psi_protect_name => psi_sovrl_saver2
use psb_realloc_mod
implicit none
real(psb_spk_), intent(inout) :: x(:,:)
real(psb_spk_), allocatable :: xs(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz, nc
character(len=20) :: name, ch_err
name='psi_sovrl_saver2'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
isz = size(desc_a%ovrlap_elem,1)
nc = size(x,2)
call psb_realloc(isz,nc,xs,info)
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
endif
do i=1, isz
idx = desc_a%ovrlap_elem(i,1)
xs(i,:) = x(idx,:)
end do
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psi_sovrl_saver2
subroutine psi_dovrl_saver1(x,xs,desc_a,info)
use psi_mod, psi_protect_name => psi_dovrl_saver1
use psb_realloc_mod
implicit none
real(psb_dpk_), intent(inout) :: x(:)
real(psb_dpk_), allocatable :: xs(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err
name='psi_dovrl_saver1'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
isz = size(desc_a%ovrlap_elem,1)
call psb_realloc(isz,xs,info)
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
endif
do i=1, isz
idx = desc_a%ovrlap_elem(i,1)
xs(i) = x(idx)
end do
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psi_dovrl_saver1
subroutine psi_dovrl_saver2(x,xs,desc_a,info)
use psi_mod, psi_protect_name => psi_dovrl_saver2
use psb_realloc_mod
implicit none
real(psb_dpk_), intent(inout) :: x(:,:)
real(psb_dpk_), allocatable :: xs(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz, nc
character(len=20) :: name, ch_err
name='psi_dovrl_saver2'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
isz = size(desc_a%ovrlap_elem,1)
nc = size(x,2)
call psb_realloc(isz,nc,xs,info)
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
endif
do i=1, isz
idx = desc_a%ovrlap_elem(i,1)
xs(i,:) = x(idx,:)
end do
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psi_dovrl_saver2
subroutine psi_covrl_saver1(x,xs,desc_a,info)
use psi_mod, psi_protect_name => psi_covrl_saver1
use psb_realloc_mod
implicit none
complex(psb_spk_), intent(inout) :: x(:)
complex(psb_spk_), allocatable :: xs(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err
name='psi_covrl_saver1'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
isz = size(desc_a%ovrlap_elem,1)
call psb_realloc(isz,xs,info)
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
endif
do i=1, isz
idx = desc_a%ovrlap_elem(i,1)
xs(i) = x(idx)
end do
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psi_covrl_saver1
subroutine psi_covrl_saver2(x,xs,desc_a,info)
use psi_mod, psi_protect_name => psi_covrl_saver2
use psb_realloc_mod
implicit none
complex(psb_spk_), intent(inout) :: x(:,:)
complex(psb_spk_), allocatable :: xs(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz, nc
character(len=20) :: name, ch_err
name='psi_covrl_saver2'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
isz = size(desc_a%ovrlap_elem,1)
nc = size(x,2)
call psb_realloc(isz,nc,xs,info)
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
endif
do i=1, isz
idx = desc_a%ovrlap_elem(i,1)
xs(i,:) = x(idx,:)
end do
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psi_covrl_saver2
subroutine psi_zovrl_saver1(x,xs,desc_a,info)
use psi_mod, psi_protect_name => psi_zovrl_saver1
use psb_realloc_mod
implicit none
complex(psb_dpk_), intent(inout) :: x(:)
complex(psb_dpk_), allocatable :: xs(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err
name='psi_zovrl_saver1'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
isz = size(desc_a%ovrlap_elem,1)
call psb_realloc(isz,xs,info)
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
endif
do i=1, isz
idx = desc_a%ovrlap_elem(i,1)
xs(i) = x(idx)
end do
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psi_zovrl_saver1
subroutine psi_zovrl_saver2(x,xs,desc_a,info)
use psi_mod, psi_protect_name => psi_zovrl_saver2
use psb_realloc_mod
implicit none
complex(psb_dpk_), intent(inout) :: x(:,:)
complex(psb_dpk_), allocatable :: xs(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz, nc
character(len=20) :: name, ch_err
name='psi_zovrl_saver2'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
isz = size(desc_a%ovrlap_elem,1)
nc = size(x,2)
call psb_realloc(isz,nc,xs,info)
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
endif
do i=1, isz
idx = desc_a%ovrlap_elem(i,1)
xs(i,:) = x(idx,:)
end do
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psi_zovrl_saver2
subroutine psi_iovrl_saver1(x,xs,desc_a,info)
use psi_mod, psi_protect_name => psi_iovrl_saver1
use psb_realloc_mod
implicit none
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), allocatable :: xs(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err
name='psi_iovrl_saver1'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
isz = size(desc_a%ovrlap_elem,1)
call psb_realloc(isz,xs,info)
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
endif
do i=1, isz
idx = desc_a%ovrlap_elem(i,1)
xs(i) = x(idx)
end do
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psi_iovrl_saver1
subroutine psi_iovrl_saver2(x,xs,desc_a,info)
use psi_mod, psi_protect_name => psi_iovrl_saver2
use psb_desc_mod
use psb_const_mod
use psb_error_mod
use psb_realloc_mod
use psb_penv_mod
implicit none
integer(psb_ipk_), intent(inout) :: x(:,:)
integer(psb_ipk_), allocatable :: xs(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz, nc
character(len=20) :: name, ch_err
name='psi_iovrl_saver2'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
isz = size(desc_a%ovrlap_elem,1)
nc = size(x,2)
call psb_realloc(isz,nc,xs,info)
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
endif
do i=1, isz
idx = desc_a%ovrlap_elem(i,1)
xs(i,:) = x(idx,:)
end do
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psi_iovrl_saver2
subroutine psi_iovrl_save_vect(x,xs,desc_a,info)
use psi_mod, psi_protect_name => psi_iovrl_save_vect
use psb_realloc_mod
use psb_i_base_vect_mod
implicit none
class(psb_i_base_vect_type) :: x
integer(psb_ipk_), allocatable :: xs(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err
name='psi_iovrl_saver1'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
isz = size(desc_a%ovrlap_elem,1)
call psb_realloc(isz,xs,info)
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
endif
call x%gth(isz,desc_a%ovrlap_elem(:,1),xs)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psi_iovrl_save_vect
subroutine psi_sovrl_save_vect(x,xs,desc_a,info)
use psi_mod, psi_protect_name => psi_sovrl_save_vect
use psb_realloc_mod
use psb_s_base_vect_mod
implicit none
class(psb_s_base_vect_type) :: x
real(psb_spk_), allocatable :: xs(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err
name='psi_sovrl_saver1'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
isz = size(desc_a%ovrlap_elem,1)
call psb_realloc(isz,xs,info)
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
endif
call x%gth(isz,desc_a%ovrlap_elem(:,1),xs)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psi_sovrl_save_vect
subroutine psi_dovrl_save_vect(x,xs,desc_a,info)
use psi_mod, psi_protect_name => psi_dovrl_save_vect
use psb_realloc_mod
use psb_d_base_vect_mod
implicit none
class(psb_d_base_vect_type) :: x
real(psb_dpk_), allocatable :: xs(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err
name='psi_dovrl_saver1'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
isz = size(desc_a%ovrlap_elem,1)
call psb_realloc(isz,xs,info)
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
endif
call x%gth(isz,desc_a%ovrlap_elem(:,1),xs)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psi_dovrl_save_vect
subroutine psi_covrl_save_vect(x,xs,desc_a,info)
use psi_mod, psi_protect_name => psi_covrl_save_vect
use psb_realloc_mod
use psb_c_base_vect_mod
implicit none
class(psb_c_base_vect_type) :: x
complex(psb_spk_), allocatable :: xs(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err
name='psi_sovrl_saver1'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
isz = size(desc_a%ovrlap_elem,1)
call psb_realloc(isz,xs,info)
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
endif
call x%gth(isz,desc_a%ovrlap_elem(:,1),xs)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psi_covrl_save_vect
subroutine psi_zovrl_save_vect(x,xs,desc_a,info)
use psi_mod, psi_protect_name => psi_zovrl_save_vect
use psb_realloc_mod
use psb_z_base_vect_mod
implicit none
class(psb_z_base_vect_type) :: x
complex(psb_dpk_), allocatable :: xs(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err
name='psi_dovrl_saver1'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
isz = size(desc_a%ovrlap_elem,1)
call psb_realloc(isz,xs,info)
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
endif
call x%gth(isz,desc_a%ovrlap_elem(:,1),xs)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psi_zovrl_save_vect

1097
base/internals/psi_ovrl_upd.f90
View File

File diff suppressed because it is too large Load Diff
Write Preview
Loading…
Cancel
Save