diff --git a/Changelog b/Changelog index 0e5380696..7cfc2997a 100644 --- a/Changelog +++ b/Changelog @@ -1,5 +1,21 @@ Changelog. A lot less detailed than usual, at least for past history. +2019/12/18: New internals and algorithms for FND_OWNER, faster and less + memory hungry. +2019/07/20: New SCAN collective; improve handling of SYMmetric +2019/07/08: Fix memory usage in conversions to/from coo +2019/07/01: Timer facility +2019/06/25: Fix memory footprint in spspmm and other borderline cases +2019/06/17: Make ADD default assembly action. +2019/05/30: new insertion routines in CSR mode +2019/05/27: Fix matrix generation. +2019/05/26: New timer facility (undocumented). +2019/05/20: Change checks on vectors +2019/05/05: Reworked linmap internals +2019/04/15: Improved sphalo and test programs printout +2019/04/09: bump version to 3.6.1 +2019/04/09: new fnd_owner_halo method +2019/03/31: New RENUM_BLK descriptor method 2019/01/16: In bldext, implement ALL_TO_ALLV by hand for certain compilers. 2018/10/10: New ICTXT argument in prec%init diff --git a/Makefile b/Makefile index 829d4fc17..41caa3cdc 100644 --- a/Makefile +++ b/Makefile @@ -15,15 +15,15 @@ libd: (if test ! -d include ; then mkdir include; fi; $(INSTALL_DATA) Make.inc include/Make.inc.psblas) (if test ! -d modules ; then mkdir modules; fi;) based: - cd base && $(MAKE) lib + $(MAKE) -C base lib precd: - cd prec && $(MAKE) lib + $(MAKE) -C prec lib kryld: - cd krylov && $(MAKE) lib + $(MAKE) -C krylov lib utild: - cd util&& $(MAKE) lib + $(MAKE) -C util lib cbindd: - cd cbind&& $(MAKE) lib + $(MAKE) -C cbind lib install: all mkdir -p $(INSTALL_INCLUDEDIR) &&\ @@ -42,11 +42,11 @@ install: all /bin/cp -fr test/pargen test/fileread test/kernel $(INSTALL_SAMPLESDIR) && \ mkdir -p $(INSTALL_SAMPLESDIR)/cbind && /bin/cp -fr cbind/test/pargen/* $(INSTALL_SAMPLESDIR)/cbind clean: - cd base && $(MAKE) clean - cd prec && $(MAKE) clean - cd krylov && $(MAKE) clean - cd util && $(MAKE) clean - cd cbind && $(MAKE) clean + $(MAKE) -C base clean + $(MAKE) -C prec clean + $(MAKE) -C krylov clean + $(MAKE) -C util clean + $(MAKE) -C cbind clean check: all make check -C test/serial diff --git a/base/Makefile b/base/Makefile index 3304176c9..039a59637 100644 --- a/base/Makefile +++ b/base/Makefile @@ -13,25 +13,25 @@ lib: mods sr cm in pb tl sr cm in pb tl: mods mods: - cd modules && $(MAKE) lib LIBNAME=$(BASELIBNAME) F90="$(MPF90)" F90COPT="$(F90COPT) $(MPI_OPT)" + $(MAKE) -C modules lib LIBNAME=$(BASELIBNAME) F90="$(MPF90)" F90COPT="$(F90COPT) $(MPI_OPT)" sr: - cd serial && $(MAKE) lib LIBNAME=$(BASELIBNAME) + $(MAKE) -C serial lib LIBNAME=$(BASELIBNAME) cm: - cd comm && $(MAKE) lib LIBNAME=$(BASELIBNAME) + $(MAKE) -C comm lib LIBNAME=$(BASELIBNAME) in: - cd internals && $(MAKE) lib LIBNAME=$(BASELIBNAME) + $(MAKE) -C internals lib LIBNAME=$(BASELIBNAME) pb: - cd psblas && $(MAKE) lib LIBNAME=$(BASELIBNAME) + $(MAKE) -C psblas lib LIBNAME=$(BASELIBNAME) tl: - cd tools && $(MAKE) lib LIBNAME=$(BASELIBNAME) + $(MAKE) -C tools lib LIBNAME=$(BASELIBNAME) clean: - (cd modules; $(MAKE) clean) - (cd comm; $(MAKE) clean) - (cd internals; $(MAKE) clean) - (cd tools; $(MAKE) clean) - (cd serial; $(MAKE) clean) - (cd psblas; $(MAKE) clean) + ($(MAKE) -C modules clean) + ($(MAKE) -C comm clean) + ($(MAKE) -C internals clean) + ($(MAKE) -C tools clean) + ($(MAKE) -C serial clean) + ($(MAKE) -C psblas clean) veryclean: clean /bin/rm -f $(HERE)/$(LIBNAME) $(LIBMOD) *$(.mod) diff --git a/base/comm/Makefile b/base/comm/Makefile index f27d38cfc..950a95a04 100644 --- a/base/comm/Makefile +++ b/base/comm/Makefile @@ -32,7 +32,7 @@ lib: interns mpfobjs $(OBJS) $(RANLIB) $(LIBDIR)/$(LIBNAME) interns: - cd internals && $(MAKE) lib + $(MAKE) -C internals lib mpfobjs: $(MAKE) $(MPFOBJS) FC="$(MPFC)" diff --git a/base/comm/internals/psi_i2ovrl_restr_a.f90 b/base/comm/internals/psi_i2ovrl_restr_a.f90 new file mode 100644 index 000000000..36bc25661 --- /dev/null +++ b/base/comm/internals/psi_i2ovrl_restr_a.f90 @@ -0,0 +1,129 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! 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_i2ovrl_restr +! These subroutines restore the overlap region of a vector; they are used +! for the transpose matrix-vector product when there is a nonempty overlap. +! +! +subroutine psi_i2ovrl_restrr1(x,xs,desc_a,info) + use psi_mod, psi_protect_name => psi_i2ovrl_restrr1 + + implicit none + + integer(psb_i2pk_), intent(inout) :: x(:) + integer(psb_i2pk_) :: 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_i2ovrl_restrr1' + info = psb_success_ + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + 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_i2ovrl_restrr1 + +subroutine psi_i2ovrl_restrr2(x,xs,desc_a,info) + use psi_mod, psi_protect_name => psi_i2ovrl_restrr2 + + implicit none + + integer(psb_i2pk_), intent(inout) :: x(:,:) + integer(psb_i2pk_) :: 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_i2ovrl_restrr2' + info = psb_success_ + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + 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_i2ovrl_restrr2 + diff --git a/base/comm/internals/psi_i2ovrl_save_a.f90 b/base/comm/internals/psi_i2ovrl_save_a.f90 new file mode 100644 index 000000000..55e9ae893 --- /dev/null +++ b/base/comm/internals/psi_i2ovrl_save_a.f90 @@ -0,0 +1,139 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! 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_i2ovrl_save +! These subroutines save the overlap region of a vector; they are used +! for the transpose matrix-vector product when there is a nonempty overlap. +! +subroutine psi_i2ovrl_saver1(x,xs,desc_a,info) + use psi_mod, psi_protect_name => psi_i2ovrl_saver1 + + use psb_realloc_mod + + implicit none + + integer(psb_i2pk_), intent(inout) :: x(:) + integer(psb_i2pk_), 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_i2ovrl_saver1' + info = psb_success_ + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + 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_i2ovrl_saver1 + + +subroutine psi_i2ovrl_saver2(x,xs,desc_a,info) + use psi_mod, psi_protect_name => psi_i2ovrl_saver2 + + use psb_realloc_mod + + implicit none + + integer(psb_i2pk_), intent(inout) :: x(:,:) + integer(psb_i2pk_), 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_i2ovrl_saver2' + info = psb_success_ + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + 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_i2ovrl_saver2 diff --git a/base/comm/internals/psi_i2ovrl_upd_a.f90 b/base/comm/internals/psi_i2ovrl_upd_a.f90 new file mode 100644 index 000000000..c41803ef3 --- /dev/null +++ b/base/comm/internals/psi_i2ovrl_upd_a.f90 @@ -0,0 +1,173 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! 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_i2ovrl_update +! These subroutines update the overlap region of a vector; they are used +! for the transpose matrix-vector product when there is a nonempty overlap, +! or for the application of Additive Schwarz preconditioners. +! +! +subroutine psi_i2ovrl_updr1(x,desc_a,update,info) + use psi_mod, psi_protect_name => psi_i2ovrl_updr1 + + implicit none + + integer(psb_i2pk_), intent(inout), target :: x(:) + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(in) :: update + integer(psb_ipk_), intent(out) :: info + + ! locals + integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm + integer(psb_ipk_) :: ierr(5) + character(len=20) :: name, ch_err + + name='psi_i2ovrl_updr1' + info = psb_success_ + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + 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 + + ! switch on update type + select case (update) + case(psb_square_root_) + do i=1,size(desc_a%ovrlap_elem,1) + idx = desc_a%ovrlap_elem(i,1) + ndm = desc_a%ovrlap_elem(i,2) + x(idx) = x(idx)/sqrt(real(ndm)) + end do + case(psb_avg_) + do i=1,size(desc_a%ovrlap_elem,1) + idx = desc_a%ovrlap_elem(i,1) + ndm = desc_a%ovrlap_elem(i,2) + x(idx) = x(idx)/real(ndm) + end do + case(psb_setzero_) + do i=1,size(desc_a%ovrlap_elem,1) + idx = desc_a%ovrlap_elem(i,1) + if (me /= desc_a%ovrlap_elem(i,3))& + & x(idx) = i2zero + end do + case(psb_sum_) + ! do nothing + + case default + ! wrong value for choice argument + info = psb_err_iarg_invalid_value_ + ierr(1) = 3; ierr(2)=update; + call psb_errpush(info,name,i_err=ierr) + goto 9999 + end select + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(ictxt,err_act) + + return +end subroutine psi_i2ovrl_updr1 + + +subroutine psi_i2ovrl_updr2(x,desc_a,update,info) + use psi_mod, psi_protect_name => psi_i2ovrl_updr2 + + implicit none + + integer(psb_i2pk_), intent(inout), target :: x(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(in) :: update + integer(psb_ipk_), intent(out) :: info + + ! locals + integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm + integer(psb_ipk_) :: ierr(5) + character(len=20) :: name, ch_err + + name='psi_i2ovrl_updr2' + info = psb_success_ + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + 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 + + ! switch on update type + select case (update) + case(psb_square_root_) + do i=1,size(desc_a%ovrlap_elem,1) + idx = desc_a%ovrlap_elem(i,1) + ndm = desc_a%ovrlap_elem(i,2) + x(idx,:) = x(idx,:)/sqrt(real(ndm)) + end do + case(psb_avg_) + do i=1,size(desc_a%ovrlap_elem,1) + idx = desc_a%ovrlap_elem(i,1) + ndm = desc_a%ovrlap_elem(i,2) + x(idx,:) = x(idx,:)/real(ndm) + end do + case(psb_setzero_) + do i=1,size(desc_a%ovrlap_elem,1) + idx = desc_a%ovrlap_elem(i,1) + if (me /= desc_a%ovrlap_elem(i,3))& + & x(idx,:) = i2zero + end do + case(psb_sum_) + ! do nothing + + case default + ! wrong value for choice argument + info = psb_err_iarg_invalid_value_ + ierr(1) = 3; ierr(2)=update; + call psb_errpush(info,name,i_err=ierr) + goto 9999 + end select + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(ictxt,err_act) + + return +end subroutine psi_i2ovrl_updr2 diff --git a/base/comm/internals/psi_i2swapdata_a.F90 b/base/comm/internals/psi_i2swapdata_a.F90 new file mode 100644 index 000000000..479042c4f --- /dev/null +++ b/base/comm/internals/psi_i2swapdata_a.F90 @@ -0,0 +1,990 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! 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_i2swapdata.F90 +! +! Subroutine: psi_i2swapdatam +! Implements the data exchange among processes. Essentially this is doing +! a variable all-to-all data exchange (ALLTOALLV in MPI parlance), but +! it is capable of pruning empty exchanges, which are very likely in our +! application environment. All the variants have the same structure +! In all these subroutines X may be: I Integer +! S real(psb_spk_) +! D real(psb_dpk_) +! C complex(psb_spk_) +! Z complex(psb_dpk_) +! Basically the operation is as follows: on each process, we identify +! sections SND(Y) and RCV(Y); then we do a send on (PACK(SND(Y))); +! then we receive, and we do an update with Y = UNPACK(RCV(Y)) + BETA * Y +! but only on the elements involved in the UNPACK operation. +! Thus: for halo data exchange, the receive section is confined in the +! halo indices, and BETA=0, whereas for overlap exchange the receive section +! is scattered in the owned indices, and BETA=1. +! The first routine picks the desired exchange index list and passes it to the second. +! +! Arguments: +! flag - integer Choose the algorithm for data exchange: +! this is chosen through bit fields. +! swap_mpi = iand(flag,psb_swap_mpi_) /= 0 +! swap_sync = iand(flag,psb_swap_sync_) /= 0 +! swap_send = iand(flag,psb_swap_send_) /= 0 +! swap_recv = iand(flag,psb_swap_recv_) /= 0 +! if (swap_mpi): use underlying MPI_ALLTOALLV. +! if (swap_sync): use PSB_SND and PSB_RCV in +! synchronized pairs +! if (swap_send .and. swap_recv): use mpi_irecv +! and mpi_send +! if (swap_send): use psb_snd (but need another +! call with swap_recv to complete) +! if (swap_recv): use psb_rcv (completing a +! previous call with swap_send) +! +! +! n - integer Number of columns in Y +! beta - integer Choose overwrite or sum. +! y(:,:) - integer The data area +! desc_a - type(psb_desc_type). The communication descriptor. +! work(:) - integer Buffer space. If not sufficient, will do +! our own internal allocation. +! info - integer. return code. +! data - integer which list is to be used to exchange data +! default psb_comm_halo_ +! psb_comm_halo_ use halo_index +! psb_comm_ext_ use ext_index +! psb_comm_ovrl_ use ovrl_index +! psb_comm_mov_ use ovr_mst_idx +! +! +subroutine psi_i2swapdatam(flag,n,beta,y,desc_a,work,info,data) + + use psi_mod, psb_protect_name => psi_i2swapdatam + use psb_error_mod + use psb_desc_mod + use psb_penv_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + + integer(psb_ipk_), intent(in) :: flag, n + integer(psb_ipk_), intent(out) :: info + integer(psb_i2pk_) :: y(:,:), beta + integer(psb_i2pk_), target :: work(:) + type(psb_desc_type),target :: desc_a + integer(psb_ipk_), optional :: data + + ! locals + integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, data_, err_act + integer(psb_ipk_), pointer :: d_idx(:) + character(len=20) :: name + + info=psb_success_ + name='psi_swap_data' + call psb_erractionsave(err_act) + + ictxt = desc_a%get_context() + icomm = desc_a%get_mpic() + 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_asb_desc(desc_a)) then + info=psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + endif + + if(present(data)) then + data_ = data + else + data_ = psb_comm_halo_ + end if + + call desc_a%get_list(data_,d_idx,totxch,idxr,idxs,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,a_err='psb_cd_get_list') + goto 9999 + end if + + call psi_swapdata(ictxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info) + if (info /= psb_success_) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(ictxt,err_act) + + return +end subroutine psi_i2swapdatam + +subroutine psi_i2swapidxm(iictxt,iicomm,flag,n,beta,y,idx, & + & totxch,totsnd,totrcv,work,info) + + use psi_mod, psb_protect_name => psi_i2swapidxm + use psb_error_mod + use psb_desc_mod + use psb_penv_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + + integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag,n + integer(psb_ipk_), intent(out) :: info + integer(psb_i2pk_) :: y(:,:), beta + integer(psb_i2pk_), target :: work(:) + integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv + + ! locals + integer(psb_mpk_) :: ictxt, icomm, np, me,& + & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret + integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& + & sdsz, rvsz, prcid, rvhd, sdhd + integer(psb_ipk_) :: nesd, nerv,& + & err_act, i, idx_pt, totsnd_, totrcv_,& + & snd_pt, rcv_pt, pnti + logical :: swap_mpi, swap_sync, swap_send, swap_recv,& + & albf,do_send,do_recv + logical, parameter :: usersend=.false. + + integer(psb_i2pk_), pointer, dimension(:) :: sndbuf, rcvbuf +#ifdef HAVE_VOLATILE + volatile :: sndbuf, rcvbuf +#endif + character(len=20) :: name + + info=psb_success_ + name='psi_swap_data' + call psb_erractionsave(err_act) + ictxt = iictxt + icomm = iicomm + + call psb_info(ictxt,me,np) + if (np == -1) then + info=psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + swap_mpi = iand(flag,psb_swap_mpi_) /= 0 + swap_sync = iand(flag,psb_swap_sync_) /= 0 + swap_send = iand(flag,psb_swap_send_) /= 0 + swap_recv = iand(flag,psb_swap_recv_) /= 0 + + do_send = swap_mpi .or. swap_sync .or. swap_send + do_recv = swap_mpi .or. swap_sync .or. swap_recv + + totrcv_ = totrcv * n + totsnd_ = totsnd * n + + if (swap_mpi) then + allocate(sdsz(0:np-1), rvsz(0:np-1), bsdidx(0:np-1),& + & brvidx(0:np-1), rvhd(0:np-1), sdhd(0:np-1), prcid(0:np-1),& + & stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + + rvhd(:) = mpi_request_null + sdsz(:) = 0 + rvsz(:) = 0 + + ! prepare info for communications + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) + + brvidx(proc_to_comm) = rcv_pt + rvsz(proc_to_comm) = n*nerv + + bsdidx(proc_to_comm) = snd_pt + sdsz(proc_to_comm) = n*nesd + + rcv_pt = rcv_pt + n*nerv + snd_pt = snd_pt + n*nesd + pnti = pnti + nerv + nesd + 3 + end do + + else + allocate(rvhd(totxch),prcid(totxch),stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + end if + + totrcv_ = max(totrcv_,1) + totsnd_ = max(totsnd_,1) + if((totrcv_+totsnd_) < size(work)) then + sndbuf => work(1:totsnd_) + rcvbuf => work(totsnd_+1:totsnd_+totrcv_) + albf=.false. + else + allocate(sndbuf(totsnd_),rcvbuf(totrcv_), stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + albf=.true. + end if + + if (do_send) then + + ! Pack send buffers + pnti = 1 + snd_pt = 1 + do i=1, totxch + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + idx_pt = 1+pnti+nerv+psb_n_elem_send_ + call psi_gth(nesd,n,idx(idx_pt:idx_pt+nesd-1),& + & y,sndbuf(snd_pt:snd_pt+n*nesd-1)) + snd_pt = snd_pt + n*nesd + pnti = pnti + nerv + nesd + 3 + end do + + end if + + + + ! Case SWAP_MPI + if (swap_mpi) then + + ! swap elements using mpi_alltoallv + call mpi_alltoallv(sndbuf,sdsz,bsdidx,& + & psb_mpi_i2pk_,rcvbuf,rvsz,& + & brvidx,psb_mpi_i2pk_,icomm,iret) + if(iret /= mpi_success) then + info=psb_err_mpi_error_ + call psb_errpush(info,name,m_err=(/iret/)) + goto 9999 + end if + + else if (swap_sync) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + + if (proc_to_comm < me) then + if (nesd>0) call psb_snd(ictxt,& + & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) + if (nerv>0) call psb_rcv(ictxt,& + & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) + else if (proc_to_comm > me) then + if (nerv>0) call psb_rcv(ictxt,& + & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) + if (nesd>0) call psb_snd(ictxt,& + & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) + else if (proc_to_comm == me) then + if (nesd /= nerv) then + write(psb_err_unit,*) & + & 'Fatal error in swapdata: mismatch on self send',& + & nerv,nesd + end if + rcvbuf(rcv_pt:rcv_pt+n*nerv-1) = sndbuf(snd_pt:snd_pt+n*nesd-1) + end if + rcv_pt = rcv_pt + n*nerv + snd_pt = snd_pt + n*nesd + pnti = pnti + nerv + nesd + 3 + + end do + + + else if (swap_send .and. swap_recv) then + + ! First I post all the non blocking receives + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + if ((nerv>0).and.(proc_to_comm /= me)) then + p2ptag = psb_int2_swap_tag + call mpi_irecv(rcvbuf(rcv_pt),n*nerv,& + & psb_mpi_i2pk_,prcid(i),& + & p2ptag, icomm,rvhd(i),iret) + end if + rcv_pt = rcv_pt + n*nerv + snd_pt = snd_pt + n*nesd + pnti = pnti + nerv + nesd + 3 + end do + + + ! Then I post all the blocking sends + if (usersend) call mpi_barrier(icomm,iret) + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + + p2ptag = psb_int2_swap_tag + if ((nesd>0).and.(proc_to_comm /= me)) then + if (usersend) then + call mpi_rsend(sndbuf(snd_pt),n*nesd,& + & psb_mpi_i2pk_,prcid(i),& + & p2ptag,icomm,iret) + else + call mpi_send(sndbuf(snd_pt),n*nesd,& + & psb_mpi_i2pk_,prcid(i),& + & p2ptag,icomm,iret) + end if + + if(iret /= mpi_success) then + info=psb_err_mpi_error_ + call psb_errpush(info,name,m_err=(/iret/)) + goto 9999 + end if + end if + rcv_pt = rcv_pt + n*nerv + snd_pt = snd_pt + n*nesd + pnti = pnti + nerv + nesd + 3 + + end do + + + pnti = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + + p2ptag = psb_int2_swap_tag + + if ((proc_to_comm /= me).and.(nerv>0)) then + call mpi_wait(rvhd(i),p2pstat,iret) + if(iret /= mpi_success) then + info=psb_err_mpi_error_ + call psb_errpush(info,name,m_err=(/iret/)) + goto 9999 + end if + else if (proc_to_comm == me) then + if (nesd /= nerv) then + write(psb_err_unit,*)& + & 'Fatal error in swapdata: mismatch on self send', & + & nerv,nesd + end if + rcvbuf(rcv_pt:rcv_pt+n*nerv-1) = sndbuf(snd_pt:snd_pt+n*nesd-1) + end if + pnti = pnti + nerv + nesd + 3 + end do + + + else if (swap_send) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + if (nesd>0) call psb_snd(ictxt,& + & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) + rcv_pt = rcv_pt + n*nerv + snd_pt = snd_pt + n*nesd + pnti = pnti + nerv + nesd + 3 + + end do + + else if (swap_recv) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + if (nerv>0) call psb_rcv(ictxt,& + & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) + rcv_pt = rcv_pt + n*nerv + snd_pt = snd_pt + n*nesd + pnti = pnti + nerv + nesd + 3 + end do + + end if + + if (do_recv) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + idx_pt = 1+pnti+psb_n_elem_recv_ + call psi_sct(nerv,n,idx(idx_pt:idx_pt+nerv-1),& + & rcvbuf(rcv_pt:rcv_pt+n*nerv-1),beta,y) + rcv_pt = rcv_pt + n*nerv + snd_pt = snd_pt + n*nesd + pnti = pnti + nerv + nesd + 3 + end do + + end if + + + if (swap_mpi) then + deallocate(sdsz,rvsz,bsdidx,brvidx,rvhd,prcid,sdhd,& + & stat=info) + else + deallocate(rvhd,prcid,stat=info) + end if + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + if(albf) deallocate(sndbuf,rcvbuf,stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(iictxt,err_act) + + return +end subroutine psi_i2swapidxm + +! +! +! Subroutine: psi_i2swapdatav +! Implements the data exchange among processes. Essentially this is doing +! a variable all-to-all data exchange (ALLTOALLV in MPI parlance), but +! it is capable of pruning empty exchanges, which are very likely in out +! application environment. All the variants have the same structure +! In all these subroutines X may be: I Integer +! S real(psb_spk_) +! D real(psb_dpk_) +! C complex(psb_spk_) +! Z complex(psb_dpk_) +! Basically the operation is as follows: on each process, we identify +! sections SND(Y) and RCV(Y); then we do a SEND(PACK(SND(Y))); +! then we receive, and we do an update with Y = UNPACK(RCV(Y)) + BETA * Y +! but only on the elements involved in the UNPACK operation. +! Thus: for halo data exchange, the receive section is confined in the +! halo indices, and BETA=0, whereas for overlap exchange the receive section +! is scattered in the owned indices, and BETA=1. +! The first routine picks the desired exchange index list and passes it to the second. +! +! Arguments: +! flag - integer Choose the algorithm for data exchange: +! this is chosen through bit fields. +! swap_mpi = iand(flag,psb_swap_mpi_) /= 0 +! swap_sync = iand(flag,psb_swap_sync_) /= 0 +! swap_send = iand(flag,psb_swap_send_) /= 0 +! swap_recv = iand(flag,psb_swap_recv_) /= 0 +! if (swap_mpi): use underlying MPI_ALLTOALLV. +! if (swap_sync): use PSB_SND and PSB_RCV in +! synchronized pairs +! if (swap_send .and. swap_recv): use mpi_irecv +! and mpi_send +! if (swap_send): use psb_snd (but need another +! call with swap_recv to complete) +! if (swap_recv): use psb_rcv (completing a +! previous call with swap_send) +! +! +! n - integer Number of columns in Y +! beta - integer Choose overwrite or sum. +! y(:) - integer The data area +! desc_a - type(psb_desc_type). The communication descriptor. +! work(:) - integer Buffer space. If not sufficient, will do +! our own internal allocation. +! info - integer. return code. +! data - integer which list is to be used to exchange data +! default psb_comm_halo_ +! psb_comm_halo_ use halo_index +! psb_comm_ext_ use ext_index +! psb_comm_ovrl_ use ovrl_index +! psb_comm_mov_ use ovr_mst_idx +! +! +subroutine psi_i2swapdatav(flag,beta,y,desc_a,work,info,data) + + use psi_mod, psb_protect_name => psi_i2swapdatav + use psb_error_mod + use psb_desc_mod + use psb_penv_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info + integer(psb_i2pk_) :: y(:), beta + integer(psb_i2pk_), target :: work(:) + type(psb_desc_type),target :: desc_a + integer(psb_ipk_), optional :: data + + ! locals + integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, data_, err_act + integer(psb_ipk_), pointer :: d_idx(:) + character(len=20) :: name + + info=psb_success_ + name='psi_swap_datav' + call psb_erractionsave(err_act) + + ictxt = desc_a%get_context() + icomm = desc_a%get_mpic() + 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_asb_desc(desc_a)) then + info=psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + endif + + if (present(data)) then + data_ = data + else + data_ = psb_comm_halo_ + end if + + call desc_a%get_list(data_,d_idx,totxch,idxr,idxs,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,a_err='psb_cd_get_list') + goto 9999 + end if + + call psi_swapdata(ictxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) + if (info /= psb_success_) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(ictxt,err_act) + + return +end subroutine psi_i2swapdatav + + +! +! +! Subroutine: psi_i2swapdataidxv +! Does the data exchange among processes. +! +! The real workhorse: the outer routines will only choose the index list +! this one takes the index list and does the actual exchange. +! +! +! +subroutine psi_i2swapidxv(iictxt,iicomm,flag,beta,y,idx, & + & totxch,totsnd,totrcv,work,info) + + use psi_mod, psb_protect_name => psi_i2swapidxv + use psb_error_mod + use psb_desc_mod + use psb_penv_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + + integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag + integer(psb_ipk_), intent(out) :: info + integer(psb_i2pk_) :: y(:), beta + integer(psb_i2pk_), target :: work(:) + integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv + + ! locals + integer(psb_mpk_) :: ictxt, icomm, np, me,& + & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret + integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& + & sdsz, rvsz, prcid, rvhd, sdhd + integer(psb_ipk_) :: nesd, nerv,& + & err_act, i, idx_pt, totsnd_, totrcv_,& + & snd_pt, rcv_pt, pnti, n + logical :: swap_mpi, swap_sync, swap_send, swap_recv,& + & albf,do_send,do_recv + logical, parameter :: usersend=.false. + + integer(psb_i2pk_), pointer, dimension(:) :: sndbuf, rcvbuf +#ifdef HAVE_VOLATILE + volatile :: sndbuf, rcvbuf +#endif + character(len=20) :: name + + info=psb_success_ + name='psi_swap_datav' + call psb_erractionsave(err_act) + ictxt = iictxt + icomm = iicomm + + call psb_info(ictxt,me,np) + if (np == -1) then + info=psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + n=1 + swap_mpi = iand(flag,psb_swap_mpi_) /= 0 + swap_sync = iand(flag,psb_swap_sync_) /= 0 + swap_send = iand(flag,psb_swap_send_) /= 0 + swap_recv = iand(flag,psb_swap_recv_) /= 0 + do_send = swap_mpi .or. swap_sync .or. swap_send + do_recv = swap_mpi .or. swap_sync .or. swap_recv + + totrcv_ = totrcv * n + totsnd_ = totsnd * n + + if (swap_mpi) then + allocate(sdsz(0:np-1), rvsz(0:np-1), bsdidx(0:np-1),& + & brvidx(0:np-1), rvhd(0:np-1), sdhd(0:np-1), prcid(0:np-1),& + & stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + + rvhd(:) = mpi_request_null + sdsz(:) = 0 + rvsz(:) = 0 + + ! prepare info for communications + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) + + brvidx(proc_to_comm) = rcv_pt + rvsz(proc_to_comm) = nerv + + bsdidx(proc_to_comm) = snd_pt + sdsz(proc_to_comm) = nesd + + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + + end do + + else + allocate(rvhd(totxch),prcid(totxch),stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + end if + + + totrcv_ = max(totrcv_,1) + totsnd_ = max(totsnd_,1) + if((totrcv_+totsnd_) < size(work)) then + sndbuf => work(1:totsnd_) + rcvbuf => work(totsnd_+1:totsnd_+totrcv_) + albf=.false. + else + allocate(sndbuf(totsnd_),rcvbuf(totrcv_), stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + albf=.true. + end if + + + if (do_send) then + + ! Pack send buffers + pnti = 1 + snd_pt = 1 + do i=1, totxch + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + idx_pt = 1+pnti+nerv+psb_n_elem_send_ + call psi_gth(nesd,idx(idx_pt:idx_pt+nesd-1),& + & y,sndbuf(snd_pt:snd_pt+nesd-1)) + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + end if + + ! Case SWAP_MPI + if (swap_mpi) then + + ! swap elements using mpi_alltoallv + call mpi_alltoallv(sndbuf,sdsz,bsdidx,& + & psb_mpi_i2pk_,rcvbuf,rvsz,& + & brvidx,psb_mpi_i2pk_,icomm,iret) + if(iret /= mpi_success) then + info=psb_err_mpi_error_ + call psb_errpush(info,name,m_err=(/iret/)) + goto 9999 + end if + + else if (swap_sync) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + + if (proc_to_comm < me) then + if (nesd>0) call psb_snd(ictxt,& + & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) + if (nerv>0) call psb_rcv(ictxt,& + & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) + else if (proc_to_comm > me) then + if (nerv>0) call psb_rcv(ictxt,& + & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) + if (nesd>0) call psb_snd(ictxt,& + & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) + else if (proc_to_comm == me) then + if (nesd /= nerv) then + write(psb_err_unit,*) & + & 'Fatal error in swapdata: mismatch on self send', & + & nerv,nesd + end if + rcvbuf(rcv_pt:rcv_pt+nerv-1) = sndbuf(snd_pt:snd_pt+nesd-1) + end if + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + + else if (swap_send .and. swap_recv) then + + ! First I post all the non blocking receives + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + + prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + if ((nerv>0).and.(proc_to_comm /= me)) then + p2ptag = psb_int2_swap_tag + call mpi_irecv(rcvbuf(rcv_pt),nerv,& + & psb_mpi_i2pk_,prcid(i),& + & p2ptag, icomm,rvhd(i),iret) + end if + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + + ! Then I post all the blocking sends + if (usersend) call mpi_barrier(icomm,iret) + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + + p2ptag = psb_int2_swap_tag + + if ((nesd>0).and.(proc_to_comm /= me)) then + if (usersend) then + call mpi_rsend(sndbuf(snd_pt),nesd,& + & psb_mpi_i2pk_,prcid(i),& + & p2ptag,icomm,iret) + else + call mpi_send(sndbuf(snd_pt),nesd,& + & psb_mpi_i2pk_,prcid(i),& + & p2ptag,icomm,iret) + end if + + if(iret /= mpi_success) then + info=psb_err_mpi_error_ + call psb_errpush(info,name,m_err=(/iret/)) + goto 9999 + end if + end if + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + + pnti = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + p2ptag = psb_int2_swap_tag + + if ((proc_to_comm /= me).and.(nerv>0)) then + call mpi_wait(rvhd(i),p2pstat,iret) + if(iret /= mpi_success) then + info=psb_err_mpi_error_ + call psb_errpush(info,name,m_err=(/iret/)) + goto 9999 + end if + else if (proc_to_comm == me) then + if (nesd /= nerv) then + write(psb_err_unit,*) & + & 'Fatal error in swapdata: mismatch on self send', & + & nerv,nesd + end if + rcvbuf(rcv_pt:rcv_pt+nerv-1) = sndbuf(snd_pt:snd_pt+nesd-1) + end if + pnti = pnti + nerv + nesd + 3 + end do + + + else if (swap_send) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + if (nesd>0) call psb_snd(ictxt,& + & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + else if (swap_recv) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + if (nerv>0) call psb_rcv(ictxt,& + & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + end if + + if (do_recv) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + idx_pt = 1+pnti+psb_n_elem_recv_ + call psi_sct(nerv,idx(idx_pt:idx_pt+nerv-1),& + & rcvbuf(rcv_pt:rcv_pt+nerv-1),beta,y) + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + end if + + if (swap_mpi) then + deallocate(sdsz,rvsz,bsdidx,brvidx,rvhd,prcid,sdhd,& + & stat=info) + else + deallocate(rvhd,prcid,stat=info) + end if + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + if(albf) deallocate(sndbuf,rcvbuf,stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(iictxt,err_act) + + return +end subroutine psi_i2swapidxv diff --git a/base/comm/internals/psi_i2swaptran_a.F90 b/base/comm/internals/psi_i2swaptran_a.F90 new file mode 100644 index 000000000..f69b8aec6 --- /dev/null +++ b/base/comm/internals/psi_i2swaptran_a.F90 @@ -0,0 +1,1006 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! 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_i2swaptran.F90 +! +! Subroutine: psi_i2swaptranm +! Implements the data exchange among processes. This is similar to Xswapdata, but +! the list is read "in reverse", i.e. indices that are normally SENT are used +! for the RECEIVE part and vice-versa. This is the basic data exchange operation +! for doing the product of a sparse matrix by a vector. +! Essentially this is doing a variable all-to-all data exchange +! (ALLTOALLV in MPI parlance), but +! it is capable of pruning empty exchanges, which are very likely in out +! application environment. All the variants have the same structure +! In all these subroutines X may be: I Integer +! S real(psb_spk_) +! D real(psb_dpk_) +! C complex(psb_spk_) +! Z complex(psb_dpk_) +! Basically the operation is as follows: on each process, we identify +! sections SND(Y) and RCV(Y); then we do a SEND(PACK(SND(Y))); +! then we receive, and we do an update with Y = UNPACK(RCV(Y)) + BETA * Y +! but only on the elements involved in the UNPACK operation. +! Thus: for halo data exchange, the receive section is confined in the +! halo indices, and BETA=0, whereas for overlap exchange the receive section +! is scattered in the owned indices, and BETA=1. +! The first routine picks the desired exchange index list and passes it to the second. +! +! Arguments: +! flag - integer Choose the algorithm for data exchange: +! this is chosen through bit fields. +! swap_mpi = iand(flag,psb_swap_mpi_) /= 0 +! swap_sync = iand(flag,psb_swap_sync_) /= 0 +! swap_send = iand(flag,psb_swap_send_) /= 0 +! swap_recv = iand(flag,psb_swap_recv_) /= 0 +! if (swap_mpi): use underlying MPI_ALLTOALLV. +! if (swap_sync): use PSB_SND and PSB_RCV in +! synchronized pairs +! if (swap_send .and. swap_recv): use mpi_irecv +! and mpi_send +! if (swap_send): use psb_snd (but need another +! call with swap_recv to complete) +! if (swap_recv): use psb_rcv (completing a +! previous call with swap_send) +! +! +! n - integer Number of columns in Y +! beta - integer Choose overwrite or sum. +! y(:,:) - integer The data area +! desc_a - type(psb_desc_type). The communication descriptor. +! work(:) - integer Buffer space. If not sufficient, will do +! our own internal allocation. +! info - integer. return code. +! data - integer which list is to be used to exchange data +! default psb_comm_halo_ +! psb_comm_halo_ use halo_index +! psb_comm_ext_ use ext_index +! psb_comm_ovrl_ use ovrl_index +! psb_comm_mov_ use ovr_mst_idx +! +! +subroutine psi_i2swaptranm(flag,n,beta,y,desc_a,work,info,data) + + use psi_mod, psb_protect_name => psi_i2swaptranm + use psb_error_mod + use psb_desc_mod + use psb_penv_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + + integer(psb_ipk_), intent(in) :: flag, n + integer(psb_ipk_), intent(out) :: info + integer(psb_i2pk_) :: y(:,:), beta + integer(psb_i2pk_), target :: work(:) + type(psb_desc_type),target :: desc_a + integer(psb_ipk_), optional :: data + + ! locals + integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, err_act, totxch, data_ + integer(psb_ipk_), pointer :: d_idx(:) + character(len=20) :: name + + info=psb_success_ + name='psi_swap_tran' + call psb_erractionsave(err_act) + + ictxt = desc_a%get_context() + icomm = desc_a%get_mpic() + + 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_asb_desc(desc_a)) then + info=psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + endif + + if(present(data)) then + data_ = data + else + data_ = psb_comm_halo_ + end if + + call desc_a%get_list(data_,d_idx,totxch,idxr,idxs,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,a_err='psb_cd_get_list') + goto 9999 + end if + + call psi_swaptran(ictxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info) + if (info /= psb_success_) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(ictxt,err_act) + + return +end subroutine psi_i2swaptranm + +subroutine psi_i2tranidxm(iictxt,iicomm,flag,n,beta,y,idx,& + & totxch,totsnd,totrcv,work,info) + + use psi_mod, psb_protect_name => psi_i2tranidxm + use psb_error_mod + use psb_desc_mod + use psb_penv_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + + integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag,n + integer(psb_ipk_), intent(out) :: info + integer(psb_i2pk_) :: y(:,:), beta + integer(psb_i2pk_), target :: work(:) + integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv + + ! locals + integer(psb_mpk_) :: ictxt, icomm, np, me,& + & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret + integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& + & sdsz, rvsz, prcid, rvhd, sdhd + integer(psb_ipk_) :: nesd, nerv,& + & err_act, i, idx_pt, totsnd_, totrcv_,& + & snd_pt, rcv_pt, pnti + logical :: swap_mpi, swap_sync, swap_send, swap_recv,& + & albf,do_send,do_recv + logical, parameter :: usersend=.false. + + integer(psb_i2pk_), pointer, dimension(:) :: sndbuf, rcvbuf +#ifdef HAVE_VOLATILE + volatile :: sndbuf, rcvbuf +#endif + character(len=20) :: name + + info=psb_success_ + name='psi_swap_tran' + call psb_erractionsave(err_act) + ictxt = iictxt + icomm = iicomm + + call psb_info(ictxt,me,np) + if (np == -1) then + info=psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + swap_mpi = iand(flag,psb_swap_mpi_) /= 0 + swap_sync = iand(flag,psb_swap_sync_) /= 0 + swap_send = iand(flag,psb_swap_send_) /= 0 + swap_recv = iand(flag,psb_swap_recv_) /= 0 + + do_send = swap_mpi .or. swap_sync .or. swap_send + do_recv = swap_mpi .or. swap_sync .or. swap_recv + + totrcv_ = totrcv * n + totsnd_ = totsnd * n + + if (swap_mpi) then + allocate(sdsz(0:np-1), rvsz(0:np-1), bsdidx(0:np-1),& + & brvidx(0:np-1), rvhd(0:np-1), sdhd(0:np-1), prcid(0:np-1),& + & stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + + rvhd(:) = mpi_request_null + sdsz(:) = 0 + rvsz(:) = 0 + + ! prepare info for communications + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) + + brvidx(proc_to_comm) = rcv_pt + rvsz(proc_to_comm) = n*nerv + + bsdidx(proc_to_comm) = snd_pt + sdsz(proc_to_comm) = n*nesd + + rcv_pt = rcv_pt + n*nerv + snd_pt = snd_pt + n*nesd + pnti = pnti + nerv + nesd + 3 + end do + + else + allocate(rvhd(totxch),prcid(totxch),stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + end if + + totrcv_ = max(totrcv_,1) + totsnd_ = max(totsnd_,1) + if((totrcv_+totsnd_) < size(work)) then + sndbuf => work(1:totsnd_) + rcvbuf => work(totsnd_+1:totsnd_+totrcv_) + albf=.false. + else + allocate(sndbuf(totsnd_),rcvbuf(totrcv_), stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + albf=.true. + end if + + if (do_send) then + + ! Pack send buffers + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + idx_pt = 1+pnti+psb_n_elem_recv_ + + call psi_gth(nerv,n,idx(idx_pt:idx_pt+nerv-1),& + & y,rcvbuf(rcv_pt:rcv_pt+n*nerv-1)) + + rcv_pt = rcv_pt + n*nerv + snd_pt = snd_pt + n*nesd + pnti = pnti + nerv + nesd + 3 + end do + + end if + + + + ! Case SWAP_MPI + if (swap_mpi) then + + ! swap elements using mpi_alltoallv + call mpi_alltoallv(rcvbuf,rvsz,brvidx,& + & psb_mpi_i2pk_,& + & sndbuf,sdsz,bsdidx,psb_mpi_i2pk_,icomm,iret) + if(iret /= mpi_success) then + info=psb_err_mpi_error_ + call psb_errpush(info,name,m_err=(/iret/)) + goto 9999 + end if + + else if (swap_sync) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + + if (proc_to_comm < me) then + if (nerv>0) call psb_snd(ictxt,& + & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) + if (nesd>0) call psb_rcv(ictxt,& + & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) + else if (proc_to_comm > me) then + if (nesd>0) call psb_rcv(ictxt,& + & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) + if (nerv>0) call psb_snd(ictxt,& + & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) + else if (proc_to_comm == me) then + if (nesd /= nerv) then + write(psb_err_unit,*) & + & 'Fatal error in swaptran: mismatch on self send', & + & nerv,nesd + end if + sndbuf(snd_pt:snd_pt+n*nesd-1) = rcvbuf(rcv_pt:rcv_pt+n*nerv-1) + end if + rcv_pt = rcv_pt + n*nerv + snd_pt = snd_pt + n*nesd + pnti = pnti + nerv + nesd + 3 + + end do + + + else if (swap_send .and. swap_recv) then + + ! First I post all the non blocking receives + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + if ((nesd>0).and.(proc_to_comm /= me)) then + p2ptag = psb_int2_swap_tag + call mpi_irecv(sndbuf(snd_pt),n*nesd,& + & psb_mpi_i2pk_,prcid(i),& + & p2ptag,icomm,rvhd(i),iret) + end if + rcv_pt = rcv_pt + n*nerv + snd_pt = snd_pt + n*nesd + pnti = pnti + nerv + nesd + 3 + end do + + + ! Then I post all the blocking sends + if (usersend) call mpi_barrier(icomm,iret) + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + + if ((nerv>0).and.(proc_to_comm /= me)) then + p2ptag = psb_int2_swap_tag + if (usersend) then + call mpi_rsend(rcvbuf(rcv_pt),n*nerv,& + & psb_mpi_i2pk_,prcid(i),& + & p2ptag,icomm,iret) + else + call mpi_send(rcvbuf(rcv_pt),n*nerv,& + & psb_mpi_i2pk_,prcid(i),& + & p2ptag,icomm,iret) + end if + + if(iret /= mpi_success) then + info=psb_err_mpi_error_ + call psb_errpush(info,name,m_err=(/iret/)) + goto 9999 + end if + end if + rcv_pt = rcv_pt + n*nerv + snd_pt = snd_pt + n*nesd + pnti = pnti + nerv + nesd + 3 + + end do + + + pnti = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + + p2ptag = psb_int2_swap_tag + + if ((proc_to_comm /= me).and.(nesd>0)) then + call mpi_wait(rvhd(i),p2pstat,iret) + if(iret /= mpi_success) then + info=psb_err_mpi_error_ + call psb_errpush(info,name,m_err=(/iret/)) + goto 9999 + end if + else if (proc_to_comm == me) then + if (nesd /= nerv) then + write(psb_err_unit,*) & + & 'Fatal error in swaptran: mismatch on self send',& + & nerv,nesd + end if + sndbuf(snd_pt:snd_pt+n*nesd-1) = rcvbuf(rcv_pt:rcv_pt+n*nerv-1) + end if + pnti = pnti + nerv + nesd + 3 + end do + + + else if (swap_send) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + if (nerv>0) call psb_snd(ictxt,& + & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) + rcv_pt = rcv_pt + n*nerv + snd_pt = snd_pt + n*nesd + pnti = pnti + nerv + nesd + 3 + + end do + + else if (swap_recv) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + if (nesd>0) call psb_rcv(ictxt,& + & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) + rcv_pt = rcv_pt + n*nerv + snd_pt = snd_pt + n*nesd + pnti = pnti + nerv + nesd + 3 + end do + + end if + + if (do_recv) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + idx_pt = 1+pnti+nerv+psb_n_elem_send_ + call psi_sct(nesd,n,idx(idx_pt:idx_pt+nesd-1),& + & sndbuf(snd_pt:snd_pt+n*nesd-1),beta,y) + rcv_pt = rcv_pt + n*nerv + snd_pt = snd_pt + n*nesd + pnti = pnti + nerv + nesd + 3 + end do + + end if + + + if (swap_mpi) then + deallocate(sdsz,rvsz,bsdidx,brvidx,rvhd,prcid,sdhd,& + & stat=info) + else + deallocate(rvhd,prcid,stat=info) + end if + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + if(albf) deallocate(sndbuf,rcvbuf,stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(iictxt,err_act) + + return +end subroutine psi_i2tranidxm +! +! +! Subroutine: psi_i2swaptranv +! Implements the data exchange among processes. This is similar to Xswapdata, but +! the list is read "in reverse", i.e. indices that are normally SENT are used +! for the RECEIVE part and vice-versa. This is the basic data exchange operation +! for doing the product of a sparse matrix by a vector. +! Essentially this is doing a variable all-to-all data exchange +! (ALLTOALLV in MPI parlance), but +! it is capable of pruning empty exchanges, which are very likely in out +! application environment. All the variants have the same structure +! In all these subroutines X may be: I Integer +! S real(psb_spk_) +! D real(psb_dpk_) +! C complex(psb_spk_) +! Z complex(psb_dpk_) +! Basically the operation is as follows: on each process, we identify +! sections SND(Y) and RCV(Y); then we do a SEND(PACK(SND(Y))); +! then we receive, and we do an update with Y = UNPACK(RCV(Y)) + BETA * Y +! but only on the elements involved in the UNPACK operation. +! Thus: for halo data exchange, the receive section is confined in the +! halo indices, and BETA=0, whereas for overlap exchange the receive section +! is scattered in the owned indices, and BETA=1. +! The first routine picks the desired exchange index list and passes it to the second. +! +! Arguments: +! flag - integer Choose the algorithm for data exchange: +! this is chosen through bit fields. +! swap_mpi = iand(flag,psb_swap_mpi_) /= 0 +! swap_sync = iand(flag,psb_swap_sync_) /= 0 +! swap_send = iand(flag,psb_swap_send_) /= 0 +! swap_recv = iand(flag,psb_swap_recv_) /= 0 +! if (swap_mpi): use underlying MPI_ALLTOALLV. +! if (swap_sync): use PSB_SND and PSB_RCV in +! synchronized pairs +! if (swap_send .and. swap_recv): use mpi_irecv +! and mpi_send +! if (swap_send): use psb_snd (but need another +! call with swap_recv to complete) +! if (swap_recv): use psb_rcv (completing a +! previous call with swap_send) +! +! +! n - integer Number of columns in Y +! beta - integer Choose overwrite or sum. +! y(:) - integer The data area +! desc_a - type(psb_desc_type). The communication descriptor. +! work(:) - integer Buffer space. If not sufficient, will do +! our own internal allocation. +! info - integer. return code. +! data - integer which list is to be used to exchange data +! default psb_comm_halo_ +! psb_comm_halo_ use halo_index +! psb_comm_ext_ use ext_index +! psb_comm_ovrl_ use ovrl_index +! psb_comm_mov_ use ovr_mst_idx +! +! +subroutine psi_i2swaptranv(flag,beta,y,desc_a,work,info,data) + + use psi_mod, psb_protect_name => psi_i2swaptranv + use psb_error_mod + use psb_desc_mod + use psb_penv_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info + integer(psb_i2pk_) :: y(:), beta + integer(psb_i2pk_), target :: work(:) + type(psb_desc_type),target :: desc_a + integer(psb_ipk_), optional :: data + + ! locals + integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ + integer(psb_ipk_), pointer :: d_idx(:) + character(len=20) :: name + + info=psb_success_ + name='psi_swap_tranv' + call psb_erractionsave(err_act) + + ictxt = desc_a%get_context() + icomm = desc_a%get_mpic() + 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_asb_desc(desc_a)) then + info=psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + endif + + if (present(data)) then + data_ = data + else + data_ = psb_comm_halo_ + end if + + call desc_a%get_list(data_,d_idx,totxch,idxr,idxs,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,a_err='psb_cd_get_list') + goto 9999 + end if + + call psi_swaptran(ictxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) + if (info /= psb_success_) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(ictxt,err_act) + + return +end subroutine psi_i2swaptranv + + +! +! +! Subroutine: psi_i2tranidxv +! Does the data exchange among processes. +! +! The real workhorse: the outer routines will only choose the index list +! this one takes the index list and does the actual exchange. +! +! +! +subroutine psi_i2tranidxv(iictxt,iicomm,flag,beta,y,idx,& + & totxch,totsnd,totrcv,work,info) + + use psi_mod, psb_protect_name => psi_i2tranidxv + use psb_error_mod + use psb_desc_mod + use psb_penv_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + + integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag + integer(psb_ipk_), intent(out) :: info + integer(psb_i2pk_) :: y(:), beta + integer(psb_i2pk_), target :: work(:) + integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv + + ! locals + integer(psb_mpk_) :: ictxt, icomm, np, me,& + & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret + integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& + & sdsz, rvsz, prcid, rvhd, sdhd + integer(psb_ipk_) :: nesd, nerv,& + & err_act, i, idx_pt, totsnd_, totrcv_,& + & snd_pt, rcv_pt, pnti, n + logical :: swap_mpi, swap_sync, swap_send, swap_recv,& + & albf,do_send,do_recv + logical, parameter :: usersend=.false. + + integer(psb_i2pk_), pointer, dimension(:) :: sndbuf, rcvbuf +#ifdef HAVE_VOLATILE + volatile :: sndbuf, rcvbuf +#endif + character(len=20) :: name + + info=psb_success_ + name='psi_swap_tran' + call psb_erractionsave(err_act) + ictxt = iictxt + icomm = iicomm + + call psb_info(ictxt,me,np) + if (np == -1) then + info=psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + n=1 + swap_mpi = iand(flag,psb_swap_mpi_) /= 0 + swap_sync = iand(flag,psb_swap_sync_) /= 0 + swap_send = iand(flag,psb_swap_send_) /= 0 + swap_recv = iand(flag,psb_swap_recv_) /= 0 + do_send = swap_mpi .or. swap_sync .or. swap_send + do_recv = swap_mpi .or. swap_sync .or. swap_recv + + totrcv_ = totrcv * n + totsnd_ = totsnd * n + + if (swap_mpi) then + allocate(sdsz(0:np-1), rvsz(0:np-1), bsdidx(0:np-1),& + & brvidx(0:np-1), rvhd(0:np-1), sdhd(0:np-1), prcid(0:np-1),& + & stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + + rvhd(:) = mpi_request_null + sdsz(:) = 0 + rvsz(:) = 0 + + ! prepare info for communications + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) + + brvidx(proc_to_comm) = rcv_pt + rvsz(proc_to_comm) = nerv + + bsdidx(proc_to_comm) = snd_pt + sdsz(proc_to_comm) = nesd + + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + + end do + + else + allocate(rvhd(totxch),prcid(totxch),stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + end if + + + totrcv_ = max(totrcv_,1) + totsnd_ = max(totsnd_,1) + if((totrcv_+totsnd_) < size(work)) then + sndbuf => work(1:totsnd_) + rcvbuf => work(totsnd_+1:totsnd_+totrcv_) + albf=.false. + else + allocate(sndbuf(totsnd_),rcvbuf(totrcv_), stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + albf=.true. + end if + + + if (do_send) then + + ! Pack send buffers + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + idx_pt = 1+pnti+psb_n_elem_recv_ + + call psi_gth(nerv,idx(idx_pt:idx_pt+nerv-1),& + & y,rcvbuf(rcv_pt:rcv_pt+nerv-1)) + + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + end if + + ! Case SWAP_MPI + if (swap_mpi) then + + ! swap elements using mpi_alltoallv + call mpi_alltoallv(rcvbuf,rvsz,brvidx,& + & psb_mpi_i2pk_,& + & sndbuf,sdsz,bsdidx,psb_mpi_i2pk_,icomm,iret) + if(iret /= mpi_success) then + info=psb_err_mpi_error_ + call psb_errpush(info,name,m_err=(/iret/)) + goto 9999 + end if + + else if (swap_sync) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + + if (proc_to_comm < me) then + if (nerv>0) call psb_snd(ictxt,& + & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) + if (nesd>0) call psb_rcv(ictxt,& + & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) + else if (proc_to_comm > me) then + if (nesd>0) call psb_rcv(ictxt,& + & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) + if (nerv>0) call psb_snd(ictxt,& + & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) + else if (proc_to_comm == me) then + if (nesd /= nerv) then + write(psb_err_unit,*) & + & 'Fatal error in swaptran: mismatch on self send', & + & nerv,nesd + end if + sndbuf(snd_pt:snd_pt+nesd-1) = rcvbuf(rcv_pt:rcv_pt+nerv-1) + end if + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + + else if (swap_send .and. swap_recv) then + + ! First I post all the non blocking receives + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + if ((nesd>0).and.(proc_to_comm /= me)) then + p2ptag = psb_int2_swap_tag + call mpi_irecv(sndbuf(snd_pt),nesd,& + & psb_mpi_i2pk_,prcid(i),& + & p2ptag,icomm,rvhd(i),iret) + end if + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + + ! Then I post all the blocking sends + if (usersend) call mpi_barrier(icomm,iret) + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + + if ((nerv>0).and.(proc_to_comm /= me)) then + p2ptag = psb_int2_swap_tag + if (usersend) then + call mpi_rsend(rcvbuf(rcv_pt),nerv,& + & psb_mpi_i2pk_,prcid(i),& + & p2ptag, icomm,iret) + else + call mpi_send(rcvbuf(rcv_pt),nerv,& + & psb_mpi_i2pk_,prcid(i),& + & p2ptag, icomm,iret) + end if + + if(iret /= mpi_success) then + info=psb_err_mpi_error_ + call psb_errpush(info,name,m_err=(/iret/)) + goto 9999 + end if + end if + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + + pnti = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + p2ptag = psb_int2_swap_tag + + if ((proc_to_comm /= me).and.(nesd>0)) then + call mpi_wait(rvhd(i),p2pstat,iret) + if(iret /= mpi_success) then + info=psb_err_mpi_error_ + call psb_errpush(info,name,m_err=(/iret/)) + goto 9999 + end if + else if (proc_to_comm == me) then + if (nesd /= nerv) then + write(psb_err_unit,*) & + & 'Fatal error in swaptran: mismatch on self send', & + & nerv,nesd + end if + sndbuf(snd_pt:snd_pt+nesd-1) = rcvbuf(rcv_pt:rcv_pt+nerv-1) + end if + pnti = pnti + nerv + nesd + 3 + end do + + + else if (swap_send) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + if (nerv>0) call psb_snd(ictxt,& + & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + else if (swap_recv) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + if (nesd>0) call psb_rcv(ictxt,& + & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + end if + + if (do_recv) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + idx_pt = 1+pnti+nerv+psb_n_elem_send_ + call psi_sct(nesd,idx(idx_pt:idx_pt+nesd-1),& + & sndbuf(snd_pt:snd_pt+nesd-1),beta,y) + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + end if + + if (swap_mpi) then + deallocate(sdsz,rvsz,bsdidx,brvidx,rvhd,prcid,sdhd,& + & stat=info) + else + deallocate(rvhd,prcid,stat=info) + end if + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + if(albf) deallocate(sndbuf,rcvbuf,stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(iictxt,err_act) + + return +end subroutine psi_i2tranidxv diff --git a/base/comm/psb_cspgather.F90 b/base/comm/psb_cspgather.F90 index 45dcc667a..23ab271fc 100644 --- a/base/comm/psb_cspgather.F90 +++ b/base/comm/psb_cspgather.F90 @@ -70,7 +70,7 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k logical :: keepnum_, keeploc_ integer(psb_mpk_) :: ictxt,np,me - integer(psb_mpk_) :: icomm, minfo, ndx + integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_lpk_), allocatable :: locia(:), locja(:), glbia(:), glbja(:) integer(psb_ipk_) :: ierr(5) @@ -98,7 +98,12 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep else keeploc_ = .true. end if - call globa%free() + if (present(root)) then + root_ = root + else + root_ = -1 + end if + if ((root_ == -1).or.(root_ == me)) call globa%free() if (keepnum_) then nrg = desc_a%get_global_rows() @@ -137,27 +142,48 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep call psb_errpush(info,name); goto 9999 end if #endif + if ((root_ == -1).or.(root_ == me)) then + if (info == psb_success_) call psb_realloc(nzg,glbia,info) + if (info == psb_success_) call psb_realloc(nzg,glbja,info) + if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) + else + if (info == psb_success_) call psb_realloc(ione,glbia,info) + if (info == psb_success_) call psb_realloc(ione,glbja,info) + if (info == psb_success_) call glob_coo%allocate(ione,ione,ione) + end if - if (info == psb_success_) call psb_realloc(nzg,glbia,info) - if (info == psb_success_) call psb_realloc(nzg,glbja,info) - if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) if (info /= psb_success_) goto 9999 do ip=1,np idisp(ip) = sum(nzbr(1:ip-1)) enddo - ndx = nzbr(me+1) - call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_c_spk_,& - & glob_coo%val,nzbr,idisp,& - & psb_mpi_c_spk_,icomm,minfo) - if (minfo == psb_success_) call & - & mpi_allgatherv(locia,ndx,psb_mpi_lpk_,& - & glbia,nzbr,idisp,& - & psb_mpi_lpk_,icomm,minfo) - if (minfo == psb_success_) call & - & mpi_allgatherv(locja,ndx,psb_mpi_lpk_,& - & glbja,nzbr,idisp,& - & psb_mpi_lpk_,icomm,minfo) + ndx = nzbr(me+1) + if (root_ == -1) then + call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_c_spk_,& + & glob_coo%val,nzbr,idisp,& + & psb_mpi_c_spk_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_allgatherv(locia,ndx,psb_mpi_lpk_,& + & glbia,nzbr,idisp,& + & psb_mpi_lpk_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_allgatherv(locja,ndx,psb_mpi_lpk_,& + & glbja,nzbr,idisp,& + & psb_mpi_lpk_,icomm,minfo) + else + call mpi_gatherv(loc_coo%val,ndx,psb_mpi_c_spk_,& + & glob_coo%val,nzbr,idisp,& + & psb_mpi_c_spk_,root_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_gatherv(locia,ndx,psb_mpi_lpk_,& + & glbia,nzbr,idisp,& + & psb_mpi_lpk_,root_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_gatherv(locja,ndx,psb_mpi_lpk_,& + & glbja,nzbr,idisp,& + & psb_mpi_lpk_,root_,icomm,minfo) + + end if if (minfo /= psb_success_) then info = minfo @@ -172,11 +198,13 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep ! for very large cases it does not make sense to ! gather the matrix on a single procecss anyway... ! - glob_coo%ia(1:nzg) = glbia(1:nzg) - glob_coo%ja(1:nzg) = glbja(1:nzg) - call glob_coo%set_nzeros(nzg) - if (present(dupl)) call glob_coo%set_dupl(dupl) - call globa%mv_from(glob_coo) + if ((root_ == -1).or.(root_ == me)) then + glob_coo%ia(1:nzg) = glbia(1:nzg) + glob_coo%ja(1:nzg) = glbja(1:nzg) + call glob_coo%set_nzeros(nzg) + if (present(dupl)) call glob_coo%set_dupl(dupl) + call globa%mv_from(glob_coo) + end if deallocate(glbia,glbja, stat=info) else @@ -228,7 +256,7 @@ subroutine psb_lcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ integer(psb_mpk_) :: ictxt,np,me - integer(psb_mpk_) :: icomm, minfo, ndx + integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_lpk_), allocatable :: lnzbr(:) integer(psb_ipk_) :: ierr(5) @@ -256,7 +284,13 @@ subroutine psb_lcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee else keeploc_ = .true. end if - call globa%free() + if (present(root)) then + root_ = root + else + root_ = -1 + end if + + if ((root_ == -1).or.(root_ == me)) call globa%free() if (keepnum_) then nrg = desc_a%get_global_rows() @@ -269,7 +303,7 @@ subroutine psb_lcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee goto 9999 end if - + if (keeploc_) then call loca%cp_to(loc_coo) else @@ -294,7 +328,11 @@ subroutine psb_lcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee call psb_errpush(info,name); goto 9999 end if #endif - if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) + if ((root_ == -1).or.(root_ == me)) then + if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) + else + if (info == psb_success_) call glob_coo%allocate(1_psb_lpk_,1_psb_lpk_,1_psb_lpk_) + end if if (info /= psb_success_) goto 9999 ! ! PLS REVIEW AND ADD OVERFLOW ERROR CHECKING @@ -303,24 +341,37 @@ subroutine psb_lcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee do ip=1,np idisp(ip) = sum(nzbr(1:ip-1)) enddo - ndx = nzbr(me+1) - call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_c_spk_,& - & glob_coo%val,nzbr,idisp,& - & psb_mpi_c_spk_,icomm,minfo) - if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& - & glob_coo%ia,nzbr,idisp,& - & psb_mpi_lpk_,icomm,minfo) - if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& - & glob_coo%ja,nzbr,idisp,& - & psb_mpi_lpk_,icomm,minfo) - + ndx = nzbr(me+1) + if (root_ == -1) then + call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_c_spk_,& + & glob_coo%val,nzbr,idisp,& + & psb_mpi_c_spk_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & glob_coo%ia,nzbr,idisp,& + & psb_mpi_lpk_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & glob_coo%ja,nzbr,idisp,& + & psb_mpi_lpk_,icomm,minfo) + else + call mpi_gatherv(loc_coo%val,ndx,psb_mpi_c_spk_,& + & glob_coo%val,nzbr,idisp,& + & psb_mpi_c_spk_,root_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_gatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & glob_coo%ia,nzbr,idisp,& + & psb_mpi_lpk_,root_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_gatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & glob_coo%ja,nzbr,idisp,& + & psb_mpi_lpk_,root_,icomm,minfo) + end if if (minfo /= psb_success_) then info = minfo call psb_errpush(psb_err_internal_error_,name,a_err=' from mpi_allgatherv') goto 9999 - end if + end if call loc_coo%free() ! ! Is the code below safe? For very large cases @@ -328,9 +379,11 @@ subroutine psb_lcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee ! for very large cases it does not make sense to ! gather the matrix on a single procecss anyway... ! - call glob_coo%set_nzeros(nzg) - if (present(dupl)) call glob_coo%set_dupl(dupl) - call globa%mv_from(glob_coo) + if ((root_ == -1).or.(root_ == me)) then + call glob_coo%set_nzeros(nzg) + if (present(dupl)) call glob_coo%set_dupl(dupl) + call globa%mv_from(glob_coo) + end if else write(psb_err_unit,*) 'SP_ALLGATHER: Not implemented yet with keepnum ',keepnum_ @@ -346,7 +399,7 @@ subroutine psb_lcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee call psb_error_handler(ione*ictxt,err_act) return - + end subroutine psb_lcsp_allgather subroutine psb_lclcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc) @@ -378,7 +431,7 @@ subroutine psb_lclcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k integer(psb_lpk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ integer(psb_mpk_) :: ictxt,np,me - integer(psb_mpk_) :: icomm, minfo, ndx + integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_lpk_), allocatable :: lnzbr(:) integer(psb_ipk_) :: ierr(5) @@ -406,7 +459,13 @@ subroutine psb_lclcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k else keeploc_ = .true. end if - call globa%free() + if (present(root)) then + root_ = root + else + root_ = -1 + end if + + if ((root_ == -1).or.(root_ == me)) call globa%free() if (keepnum_) then nrg = desc_a%get_global_rows() @@ -444,25 +503,43 @@ subroutine psb_lclcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k call psb_errpush(info,name); goto 9999 end if #endif - if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) + if ((root_ == -1).or.(root_ == me)) then + if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) + else + if (info == psb_success_) call glob_coo%allocate(1_psb_lpk_,1_psb_lpk_,1_psb_lpk_) + end if if (info /= psb_success_) goto 9999 do ip=1,np idisp(ip) = sum(nzbr(1:ip-1)) enddo - ndx = nzbr(me+1) - call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_c_spk_,& - & glob_coo%val,nzbr,idisp,& - & psb_mpi_c_spk_,icomm,minfo) - if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& - & glob_coo%ia,nzbr,idisp,& - & psb_mpi_lpk_,icomm,minfo) - if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& - & glob_coo%ja,nzbr,idisp,& - & psb_mpi_lpk_,icomm,minfo) - + ndx = nzbr(me+1) + + if (root_ == -1) then + call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_c_spk_,& + & glob_coo%val,nzbr,idisp,& + & psb_mpi_c_spk_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & glob_coo%ia,nzbr,idisp,& + & psb_mpi_lpk_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & glob_coo%ja,nzbr,idisp,& + & psb_mpi_lpk_,icomm,minfo) + else + call mpi_gatherv(loc_coo%val,ndx,psb_mpi_c_spk_,& + & glob_coo%val,nzbr,idisp,& + & psb_mpi_c_spk_,root_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_gatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & glob_coo%ia,nzbr,idisp,& + & psb_mpi_lpk_,root_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_gatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & glob_coo%ja,nzbr,idisp,& + & psb_mpi_lpk_,root_,icomm,minfo) + end if if (minfo /= psb_success_) then info = minfo call psb_errpush(psb_err_internal_error_,name,a_err=' from mpi_allgatherv') @@ -470,9 +547,11 @@ subroutine psb_lclcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k end if call loc_coo%free() ! - call glob_coo%set_nzeros(nzg) - if (present(dupl)) call glob_coo%set_dupl(dupl) - call globa%mv_from(glob_coo) + if ((root_ == -1).or.(root_ == me)) then + call glob_coo%set_nzeros(nzg) + if (present(dupl)) call glob_coo%set_dupl(dupl) + call globa%mv_from(glob_coo) + end if else write(psb_err_unit,*) 'SP_ALLGATHER: Not implemented yet with keepnum ',keepnum_ diff --git a/base/comm/psb_dspgather.F90 b/base/comm/psb_dspgather.F90 index 62084d481..11eedaf4a 100644 --- a/base/comm/psb_dspgather.F90 +++ b/base/comm/psb_dspgather.F90 @@ -70,7 +70,7 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k logical :: keepnum_, keeploc_ integer(psb_mpk_) :: ictxt,np,me - integer(psb_mpk_) :: icomm, minfo, ndx + integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_lpk_), allocatable :: locia(:), locja(:), glbia(:), glbja(:) integer(psb_ipk_) :: ierr(5) @@ -98,7 +98,12 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep else keeploc_ = .true. end if - call globa%free() + if (present(root)) then + root_ = root + else + root_ = -1 + end if + if ((root_ == -1).or.(root_ == me)) call globa%free() if (keepnum_) then nrg = desc_a%get_global_rows() @@ -137,27 +142,48 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep call psb_errpush(info,name); goto 9999 end if #endif + if ((root_ == -1).or.(root_ == me)) then + if (info == psb_success_) call psb_realloc(nzg,glbia,info) + if (info == psb_success_) call psb_realloc(nzg,glbja,info) + if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) + else + if (info == psb_success_) call psb_realloc(ione,glbia,info) + if (info == psb_success_) call psb_realloc(ione,glbja,info) + if (info == psb_success_) call glob_coo%allocate(ione,ione,ione) + end if - if (info == psb_success_) call psb_realloc(nzg,glbia,info) - if (info == psb_success_) call psb_realloc(nzg,glbja,info) - if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) if (info /= psb_success_) goto 9999 do ip=1,np idisp(ip) = sum(nzbr(1:ip-1)) enddo - ndx = nzbr(me+1) - call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_r_dpk_,& - & glob_coo%val,nzbr,idisp,& - & psb_mpi_r_dpk_,icomm,minfo) - if (minfo == psb_success_) call & - & mpi_allgatherv(locia,ndx,psb_mpi_lpk_,& - & glbia,nzbr,idisp,& - & psb_mpi_lpk_,icomm,minfo) - if (minfo == psb_success_) call & - & mpi_allgatherv(locja,ndx,psb_mpi_lpk_,& - & glbja,nzbr,idisp,& - & psb_mpi_lpk_,icomm,minfo) + ndx = nzbr(me+1) + if (root_ == -1) then + call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_r_dpk_,& + & glob_coo%val,nzbr,idisp,& + & psb_mpi_r_dpk_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_allgatherv(locia,ndx,psb_mpi_lpk_,& + & glbia,nzbr,idisp,& + & psb_mpi_lpk_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_allgatherv(locja,ndx,psb_mpi_lpk_,& + & glbja,nzbr,idisp,& + & psb_mpi_lpk_,icomm,minfo) + else + call mpi_gatherv(loc_coo%val,ndx,psb_mpi_r_dpk_,& + & glob_coo%val,nzbr,idisp,& + & psb_mpi_r_dpk_,root_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_gatherv(locia,ndx,psb_mpi_lpk_,& + & glbia,nzbr,idisp,& + & psb_mpi_lpk_,root_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_gatherv(locja,ndx,psb_mpi_lpk_,& + & glbja,nzbr,idisp,& + & psb_mpi_lpk_,root_,icomm,minfo) + + end if if (minfo /= psb_success_) then info = minfo @@ -172,11 +198,13 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep ! for very large cases it does not make sense to ! gather the matrix on a single procecss anyway... ! - glob_coo%ia(1:nzg) = glbia(1:nzg) - glob_coo%ja(1:nzg) = glbja(1:nzg) - call glob_coo%set_nzeros(nzg) - if (present(dupl)) call glob_coo%set_dupl(dupl) - call globa%mv_from(glob_coo) + if ((root_ == -1).or.(root_ == me)) then + glob_coo%ia(1:nzg) = glbia(1:nzg) + glob_coo%ja(1:nzg) = glbja(1:nzg) + call glob_coo%set_nzeros(nzg) + if (present(dupl)) call glob_coo%set_dupl(dupl) + call globa%mv_from(glob_coo) + end if deallocate(glbia,glbja, stat=info) else @@ -228,7 +256,7 @@ subroutine psb_ldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ integer(psb_mpk_) :: ictxt,np,me - integer(psb_mpk_) :: icomm, minfo, ndx + integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_lpk_), allocatable :: lnzbr(:) integer(psb_ipk_) :: ierr(5) @@ -256,7 +284,13 @@ subroutine psb_ldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee else keeploc_ = .true. end if - call globa%free() + if (present(root)) then + root_ = root + else + root_ = -1 + end if + + if ((root_ == -1).or.(root_ == me)) call globa%free() if (keepnum_) then nrg = desc_a%get_global_rows() @@ -269,7 +303,7 @@ subroutine psb_ldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee goto 9999 end if - + if (keeploc_) then call loca%cp_to(loc_coo) else @@ -294,7 +328,11 @@ subroutine psb_ldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee call psb_errpush(info,name); goto 9999 end if #endif - if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) + if ((root_ == -1).or.(root_ == me)) then + if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) + else + if (info == psb_success_) call glob_coo%allocate(1_psb_lpk_,1_psb_lpk_,1_psb_lpk_) + end if if (info /= psb_success_) goto 9999 ! ! PLS REVIEW AND ADD OVERFLOW ERROR CHECKING @@ -303,24 +341,37 @@ subroutine psb_ldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee do ip=1,np idisp(ip) = sum(nzbr(1:ip-1)) enddo - ndx = nzbr(me+1) - call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_r_dpk_,& - & glob_coo%val,nzbr,idisp,& - & psb_mpi_r_dpk_,icomm,minfo) - if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& - & glob_coo%ia,nzbr,idisp,& - & psb_mpi_lpk_,icomm,minfo) - if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& - & glob_coo%ja,nzbr,idisp,& - & psb_mpi_lpk_,icomm,minfo) - + ndx = nzbr(me+1) + if (root_ == -1) then + call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_r_dpk_,& + & glob_coo%val,nzbr,idisp,& + & psb_mpi_r_dpk_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & glob_coo%ia,nzbr,idisp,& + & psb_mpi_lpk_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & glob_coo%ja,nzbr,idisp,& + & psb_mpi_lpk_,icomm,minfo) + else + call mpi_gatherv(loc_coo%val,ndx,psb_mpi_r_dpk_,& + & glob_coo%val,nzbr,idisp,& + & psb_mpi_r_dpk_,root_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_gatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & glob_coo%ia,nzbr,idisp,& + & psb_mpi_lpk_,root_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_gatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & glob_coo%ja,nzbr,idisp,& + & psb_mpi_lpk_,root_,icomm,minfo) + end if if (minfo /= psb_success_) then info = minfo call psb_errpush(psb_err_internal_error_,name,a_err=' from mpi_allgatherv') goto 9999 - end if + end if call loc_coo%free() ! ! Is the code below safe? For very large cases @@ -328,9 +379,11 @@ subroutine psb_ldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee ! for very large cases it does not make sense to ! gather the matrix on a single procecss anyway... ! - call glob_coo%set_nzeros(nzg) - if (present(dupl)) call glob_coo%set_dupl(dupl) - call globa%mv_from(glob_coo) + if ((root_ == -1).or.(root_ == me)) then + call glob_coo%set_nzeros(nzg) + if (present(dupl)) call glob_coo%set_dupl(dupl) + call globa%mv_from(glob_coo) + end if else write(psb_err_unit,*) 'SP_ALLGATHER: Not implemented yet with keepnum ',keepnum_ @@ -346,7 +399,7 @@ subroutine psb_ldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee call psb_error_handler(ione*ictxt,err_act) return - + end subroutine psb_ldsp_allgather subroutine psb_ldldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc) @@ -378,7 +431,7 @@ subroutine psb_ldldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k integer(psb_lpk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ integer(psb_mpk_) :: ictxt,np,me - integer(psb_mpk_) :: icomm, minfo, ndx + integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_lpk_), allocatable :: lnzbr(:) integer(psb_ipk_) :: ierr(5) @@ -406,7 +459,13 @@ subroutine psb_ldldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k else keeploc_ = .true. end if - call globa%free() + if (present(root)) then + root_ = root + else + root_ = -1 + end if + + if ((root_ == -1).or.(root_ == me)) call globa%free() if (keepnum_) then nrg = desc_a%get_global_rows() @@ -444,25 +503,43 @@ subroutine psb_ldldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k call psb_errpush(info,name); goto 9999 end if #endif - if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) + if ((root_ == -1).or.(root_ == me)) then + if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) + else + if (info == psb_success_) call glob_coo%allocate(1_psb_lpk_,1_psb_lpk_,1_psb_lpk_) + end if if (info /= psb_success_) goto 9999 do ip=1,np idisp(ip) = sum(nzbr(1:ip-1)) enddo - ndx = nzbr(me+1) - call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_r_dpk_,& - & glob_coo%val,nzbr,idisp,& - & psb_mpi_r_dpk_,icomm,minfo) - if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& - & glob_coo%ia,nzbr,idisp,& - & psb_mpi_lpk_,icomm,minfo) - if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& - & glob_coo%ja,nzbr,idisp,& - & psb_mpi_lpk_,icomm,minfo) - + ndx = nzbr(me+1) + + if (root_ == -1) then + call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_r_dpk_,& + & glob_coo%val,nzbr,idisp,& + & psb_mpi_r_dpk_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & glob_coo%ia,nzbr,idisp,& + & psb_mpi_lpk_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & glob_coo%ja,nzbr,idisp,& + & psb_mpi_lpk_,icomm,minfo) + else + call mpi_gatherv(loc_coo%val,ndx,psb_mpi_r_dpk_,& + & glob_coo%val,nzbr,idisp,& + & psb_mpi_r_dpk_,root_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_gatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & glob_coo%ia,nzbr,idisp,& + & psb_mpi_lpk_,root_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_gatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & glob_coo%ja,nzbr,idisp,& + & psb_mpi_lpk_,root_,icomm,minfo) + end if if (minfo /= psb_success_) then info = minfo call psb_errpush(psb_err_internal_error_,name,a_err=' from mpi_allgatherv') @@ -470,9 +547,11 @@ subroutine psb_ldldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k end if call loc_coo%free() ! - call glob_coo%set_nzeros(nzg) - if (present(dupl)) call glob_coo%set_dupl(dupl) - call globa%mv_from(glob_coo) + if ((root_ == -1).or.(root_ == me)) then + call glob_coo%set_nzeros(nzg) + if (present(dupl)) call glob_coo%set_dupl(dupl) + call globa%mv_from(glob_coo) + end if else write(psb_err_unit,*) 'SP_ALLGATHER: Not implemented yet with keepnum ',keepnum_ diff --git a/base/comm/psb_i2gather_a.f90 b/base/comm/psb_i2gather_a.f90 new file mode 100644 index 000000000..9a671ef60 --- /dev/null +++ b/base/comm/psb_i2gather_a.f90 @@ -0,0 +1,335 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! 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: psb_i2gather.f90 +! +! Subroutine: psb_i2gather +! This subroutine gathers pieces of a distributed dense matrix into a local one. +! +! Arguments: +! globx - integer,dimension(:,:). The local matrix into which gather +! the distributed pieces. +! locx - integer,dimension(:,:). The local piece of the distributed +! matrix to be gathered. +! desc_a - type(psb_desc_type). The communication descriptor. +! info - integer. Error code. +! iroot - integer. The process that has to own the +! global matrix. If -1 all +! the processes will have a copy. +! +subroutine psb_i2gatherm(globx, locx, desc_a, info, iroot) + use psb_base_mod, psb_protect_name => psb_i2gatherm + implicit none + + integer(psb_i2pk_), intent(in) :: locx(:,:) + integer(psb_i2pk_), intent(out), allocatable :: globx(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iroot + + + ! locals + integer(psb_mpk_) :: ictxt, np, me, root, iiroot, icomm, myrank, rootrank + integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,& + & maxk, k, jlx, ilx, i, j + integer(psb_lpk_) :: m, n, ilocx, jlocx, idx, iglobx, jglobx + + character(len=20) :: name, ch_err + + name='psb_i2gatherm' + info=psb_success_ + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + + ictxt=desc_a%get_context() + ! 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 (present(iroot)) then + root = iroot + if((root < -1).or.(root > np)) then + info=psb_err_input_value_invalid_i_ + ierr(1) = 5; ierr(2)=root + call psb_errpush(info,name,i_err=ierr) + goto 9999 + end if + else + root = -1 + end if + if (root == -1) then + iiroot = psb_root_ + else + iiroot = root + endif + + iglobx = 1 + jglobx = 1 + ilocx = 1 + jlocx = 1 + + m = desc_a%get_global_rows() + n = desc_a%get_global_cols() + lda_globx = m + lda_locx = size(locx, 1) + lock = size(locx,2) + maxk = lock + k = maxk + + call psb_bcast(ictxt,k,root=iiroot) + + ! there should be a global check on k here!!! + + call psb_chkglobvect(m,n,lda_globx,iglobx,jglobx,desc_a,info) + if (info == psb_success_) & + & call psb_chkvect(m,n,lda_locx,ilocx,jlocx,desc_a,info,ilx,jlx) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chk(glob)vect' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if ((ilx /= 1).or.(iglobx /= 1)) then + info=psb_err_ix_n1_iy_n1_unsupported_ + call psb_errpush(info,name) + goto 9999 + end if + + call psb_realloc(m,k,globx,info) + if (info /= psb_success_) then + info=psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + end if + + globx(:,:)=i2zero + + do j=1,k + do i=1,desc_a%get_local_rows() + call psb_loc_to_glob(i,idx,desc_a,info) + globx(idx,j) = locx(i,jlx+j-1) + end do + end do + + do j=1,k + ! adjust overlapped elements + do i=1, size(desc_a%ovrlap_elem,1) + if (me /= desc_a%ovrlap_elem(i,3)) then + idx = desc_a%ovrlap_elem(i,1) + call psb_loc_to_glob(idx,desc_a,info) + globx(idx,j) = i2zero + end if + end do + end do + + call psb_sum(ictxt,globx(1:m,1:k),root=root) + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(ione*ictxt,err_act) + + return + +end subroutine psb_i2gatherm + + + + + + +!!$ +!!$ Parallel Sparse BLAS version 3.5 +!!$ (C) Copyright 2006-2018 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari +!!$ +!!$ 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: psb_i2gatherv +! This subroutine gathers pieces of a distributed dense vector into a local one. +! +! Arguments: +! globx - integer,dimension(:). The local vector into which gather +! the distributed pieces. +! locx - integer,dimension(:). The local piece of the distributed +! vector to be gathered. +! desc_a - type(psb_desc_type). The communication descriptor. +! info - integer. Error code. +! iroot - integer. The process that has to own the +! global matrix. If -1 all +! the processes will have a copy. +! default: -1 +! +subroutine psb_i2gatherv(globx, locx, desc_a, info, iroot) + use psb_base_mod, psb_protect_name => psb_i2gatherv + implicit none + + integer(psb_i2pk_), intent(in) :: locx(:) + integer(psb_i2pk_), intent(out), allocatable :: globx(:) + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iroot + + + ! locals + integer(psb_mpk_) :: ictxt, np, me, root, iiroot, icomm, myrank, rootrank + integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,& + & maxk, k, jlx, ilx, i, j + integer(psb_lpk_) :: m, n, ilocx, jlocx, idx, iglobx, jglobx + + character(len=20) :: name, ch_err + + name='psb_i2gatherv' + info=psb_success_ + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + + ictxt=desc_a%get_context() + + ! 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 (present(iroot)) then + root = iroot + if((root < -1).or.(root > np)) then + info=psb_err_input_value_invalid_i_ + ierr(1)=5; ierr(2)=root + call psb_errpush(info,name,i_err=ierr) + goto 9999 + end if + else + root = -1 + end if + + jglobx=1 + iglobx = 1 + jlocx=1 + ilocx = 1 + + m = desc_a%get_global_rows() + n = desc_a%get_global_cols() + + lda_globx = m + lda_locx = size(locx) + + k = 1 + + + ! there should be a global check on k here!!! + + call psb_chkglobvect(m,n,lda_globx,iglobx,jglobx,desc_a,info) + if (info == psb_success_) & + & call psb_chkvect(m,n,lda_locx,ilocx,jlocx,desc_a,info,ilx,jlx) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chk(glob)vect' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if ((ilx /= 1).or.(iglobx /= 1)) then + info=psb_err_ix_n1_iy_n1_unsupported_ + call psb_errpush(info,name) + goto 9999 + end if + + call psb_realloc(m,globx,info) + if (info /= psb_success_) then + info=psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + end if + + globx(:)=i2zero + + do i=1,desc_a%get_local_rows() + call psb_loc_to_glob(i,idx,desc_a,info) + globx(idx) = locx(i) + end do + + ! adjust overlapped elements + do i=1, size(desc_a%ovrlap_elem,1) + if (me /= desc_a%ovrlap_elem(i,3)) then + idx = desc_a%ovrlap_elem(i,1) + call psb_loc_to_glob(idx,desc_a,info) + globx(idx) = i2zero + end if + end do + + call psb_sum(ictxt,globx(1:m),root=root) + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(ione*ictxt,err_act) + + return + +end subroutine psb_i2gatherv + diff --git a/base/comm/psb_i2halo_a.f90 b/base/comm/psb_i2halo_a.f90 new file mode 100644 index 000000000..f9c17fa5e --- /dev/null +++ b/base/comm/psb_i2halo_a.f90 @@ -0,0 +1,380 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! 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: psb_i2halo.f90 +! +! Subroutine: psb_i2halom +! This subroutine performs the exchange of the halo elements in a +! distributed dense matrix between all the processes. +! +! Arguments: +! x - integer,dimension(:,:). The local part of the dense matrix. +! desc_a - type(psb_desc_type). The communication descriptor. +! info - integer. Return code +! jx - integer(optional). The starting column of the global matrix. +! ik - integer(optional). The number of columns to gather. +! work - integer(optional). Work area. +! tran - character(optional). Transpose exchange. +! mode - integer(optional). Communication mode (see Swapdata) +! data - integer Which index list in desc_a should be used +! to retrieve rows, default psb_comm_halo_ +! psb_comm_halo_ use halo_index +! psb_comm_ext_ use ext_index +! psb_comm_ovrl_ use ovrl_index +! psb_comm_mov_ use ovr_mst_idx +! +! +subroutine psb_i2halom(x,desc_a,info,jx,ik,work,tran,mode,data) + use psb_base_mod, psb_protect_name => psb_i2halom + use psi_mod + implicit none + + integer(psb_i2pk_), intent(inout), target :: x(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(out) :: info + integer(psb_i2pk_), optional, target, intent(inout) :: work(:) + integer(psb_ipk_), intent(in), optional :: mode,jx,ik,data + character, intent(in), optional :: tran + + ! locals + integer(psb_mpk_) :: ictxt, np, me + integer(psb_ipk_) :: err_act, iix, jjx, k, maxk, nrow, imode, i,& + & liwork,data_, ldx + integer(psb_lpk_) :: m, n, ix, ijx + integer(psb_i2pk_),pointer :: iwork(:), xp(:,:) + character :: tran_ + character(len=20) :: name, ch_err + logical :: aliw + + name='psb_i2halom' + info=psb_success_ + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + + ictxt=desc_a%get_context() + + ! 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 + + ix = 1 + if (present(jx)) then + ijx = jx + else + ijx = 1 + endif + + m = desc_a%get_global_rows() + n = desc_a%get_global_cols() + nrow = desc_a%get_local_rows() + + maxk=size(x,2)-ijx+1 + + if(present(ik)) then + if(ik > maxk) then + k=maxk + else + k=ik + end if + else + k = maxk + end if + + if (present(tran)) then + tran_ = psb_toupper(tran) + else + tran_ = 'N' + endif + if (present(mode)) then + imode = mode + else + imode = IOR(psb_swap_send_,psb_swap_recv_) + endif + + if (present(data)) then + data_ = data + else + data_ = psb_comm_halo_ + endif + ldx = size(x,1) + ! check vector correctness + call psb_chkvect(m,lone,ldx,ix,ijx,desc_a,info,iix,jjx,check_halo=.true.) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ ; ch_err='psb_chkvect' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + liwork=nrow + if (present(work)) then + if(size(work) >= liwork) then + aliw=.false. + iwork => work + else + aliw=.true. + allocate(iwork(liwork),stat=info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_realloc' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + end if + else + aliw=.true. + allocate(iwork(liwork),stat=info) + + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_realloc' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + end if + + ! exchange halo elements + xp => x(iix:size(x,1),jjx:jjx+k-1) + if(tran_ == 'N') then + call psi_swapdata(imode,k,i2zero,xp,& + & desc_a,iwork,info,data=data_) + else if((tran_ == 'T').or.(tran_ == 'C')) then + call psi_swaptran(imode,k,i2one,xp,& + &desc_a,iwork,info) + else + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='invalid tran') + goto 9999 + end if + + if(info /= psb_success_) then + ch_err='PSI_cswapdata' + call psb_errpush(psb_err_from_subroutine_,name,a_err=ch_err) + goto 9999 + end if + + if (aliw) deallocate(iwork) + nullify(iwork) + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(ione*ictxt,err_act) + + return +end subroutine psb_i2halom + + + + +!!$ +!!$ Parallel Sparse BLAS version 3.5 +!!$ (C) Copyright 2006-2018 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari +!!$ +!!$ 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: psb_i2halov +! This subroutine performs the exchange of the halo elements in a +! distributed dense vector between all the processes. +! +! Arguments: +! x - real,dimension(:). The local part of the dense vector. +! desc_a - type(psb_desc_type). The communication descriptor. +! info - integer. Return code +! jx - integer(optional). The starting column of the global matrix. +! ik - integer(optional). The number of columns to gather. +! work - integer(optional). Work area. +! tran - character(optional). Transpose exchange. +! mode - integer(optional). Communication mode (see Swapdata) +! data - integer Which index list in desc_a should be used +! to retrieve rows, default psb_comm_halo_ +! psb_comm_halo_ use halo_index +! psb_comm_ext_ use ext_index +! psb_comm_ovrl_ use ovrl_index +! psb_comm_mov_ use ovr_mst_idx +! +! +subroutine psb_i2halov(x,desc_a,info,work,tran,mode,data) + use psb_base_mod, psb_protect_name => psb_i2halov + use psi_mod + implicit none + + integer(psb_i2pk_), intent(inout) :: x(:) + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(out) :: info + integer(psb_i2pk_), target, optional, intent(inout) :: work(:) + integer(psb_ipk_), intent(in), optional :: mode,data + character, intent(in), optional :: tran + + ! locals + integer(psb_mpk_) :: ictxt, np, me + integer(psb_ipk_) :: err_act, ldx, iix, jjx, nrow, imode, liwork,data_ + integer(psb_lpk_) :: m, n, ix, ijx + integer(psb_i2pk_),pointer :: iwork(:) + character :: tran_ + character(len=20) :: name, ch_err + logical :: aliw + + name='psb_i2halov' + info=psb_success_ + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + + ictxt=desc_a%get_context() + + ! 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 + + ix = 1 + ijx = 1 + + m = desc_a%get_global_rows() + n = desc_a%get_global_cols() + nrow = desc_a%get_local_rows() + + if (present(tran)) then + tran_ = psb_toupper(tran) + else + tran_ = 'N' + endif + if (present(data)) then + data_ = data + else + data_ = psb_comm_halo_ + endif + if (present(mode)) then + imode = mode + else + imode = IOR(psb_swap_send_,psb_swap_recv_) + endif + ldx = size(x,1) + ! check vector correctness + call psb_chkvect(m,lone,ldx,ix,ijx,desc_a,info,iix,jjx,check_halo=.true.) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ ; ch_err='psb_chkvect' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + liwork=nrow + if (present(work)) then + if(size(work) >= liwork) then + aliw=.false. + iwork => work + else + aliw=.true. + allocate(iwork(liwork),stat=info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_realloc' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + end if + else + aliw=.true. + allocate(iwork(liwork),stat=info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_realloc' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + end if + + ! exchange halo elements + if(tran_ == 'N') then + call psi_swapdata(imode,i2zero,x(iix:size(x)),& + & desc_a,iwork,info,data=data_) + else if((tran_ == 'T').or.(tran_ == 'C')) then + call psi_swaptran(imode,i2one,x(iix:size(x)),& + & desc_a,iwork,info) + else + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='invalid tran') + goto 9999 + end if + + if(info /= psb_success_) then + ch_err='PSI_swapdata' + call psb_errpush(psb_err_from_subroutine_,name,a_err=ch_err) + goto 9999 + end if + + if (aliw) deallocate(iwork) + nullify(iwork) + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(ione*ictxt,err_act) + + return +end subroutine psb_i2halov + diff --git a/base/comm/psb_i2ovrl_a.f90 b/base/comm/psb_i2ovrl_a.f90 new file mode 100644 index 000000000..8d056e39f --- /dev/null +++ b/base/comm/psb_i2ovrl_a.f90 @@ -0,0 +1,374 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! 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: psb_i2ovrl.f90 +! +! Subroutine: psb_i2ovrlm +! This subroutine performs the exchange of the overlap elements in a +! distributed dense matrix between all the processes. +! +! Arguments: +! x(:,:) - integer The local part of the dense matrix. +! desc_a - type(psb_desc_type). The communication descriptor. +! info - integer. Return code. +! jx - integer(optional). The starting column of the global matrix +! ik - integer(optional). The number of columns to gather. +! work - integer(optional). A work area. +! update - integer(optional). Type of update: +! psb_none_ do nothing +! psb_sum_ sum of overlaps +! psb_avg_ average of overlaps +! mode - integer(optional). Choose the algorithm for data exchange: +! this is chosen through bit fields. +! - swap_mpi = iand(flag,psb_swap_mpi_) /= 0 +! - swap_sync = iand(flag,psb_swap_sync_) /= 0 +! - swap_send = iand(flag,psb_swap_send_) /= 0 +! - swap_recv = iand(flag,psb_swap_recv_) /= 0 +! - if (swap_mpi): use underlying MPI_ALLTOALLV. +! - if (swap_sync): use PSB_SND and PSB_RCV in +! synchronized pairs +! - if (swap_send .and. swap_recv): use mpi_irecv +! and mpi_send +! - if (swap_send): use psb_snd (but need another +! call with swap_recv to complete) +! - if (swap_recv): use psb_rcv (completing a +! previous call with swap_send) +! +! +subroutine psb_i2ovrlm(x,desc_a,info,jx,ik,work,update,mode) + use psb_base_mod, psb_protect_name => psb_i2ovrlm + use psi_mod + implicit none + + integer(psb_i2pk_), intent(inout), target :: x(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(out) :: info + integer(psb_i2pk_), optional, target, intent(inout) :: work(:) + integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode + + ! locals + integer(psb_mpk_) :: ictxt, np, me + integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, k, maxk, update_,& + & mode_, liwork, ldx + integer(psb_lpk_) :: m, n, ix, ijx + integer(psb_i2pk_),pointer :: iwork(:), xp(:,:) + logical :: do_swap + character(len=20) :: name, ch_err + logical :: aliw + + name='psb_i2ovrlm' + info=psb_success_ + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + + ictxt=desc_a%get_context() + + ! 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 + + ix = 1 + if (present(jx)) then + ijx = jx + else + ijx = 1 + endif + + m = desc_a%get_global_rows() + n = desc_a%get_global_cols() + nrow = desc_a%get_local_rows() + ncol = desc_a%get_local_cols() + + maxk=size(x,2)-ijx+1 + + if(present(ik)) then + if(ik > maxk) then + k=maxk + else + k=ik + end if + else + k = maxk + end if + + if (present(update)) then + update_ = update + else + update_ = psb_avg_ + endif + + if (present(mode)) then + mode_ = mode + else + mode_ = IOR(psb_swap_send_,psb_swap_recv_) + endif + do_swap = (mode_ /= 0) + ldx = size(x,1) + ! check vector correctness + call psb_chkvect(m,lone,ldx,ix,ijx,desc_a,info,iix,jjx) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ ; ch_err='psb_chkvect' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + ! check for presence/size of a work area + liwork=ncol + if (present(work)) then + if(size(work) >= liwork) then + aliw=.false. + else + aliw=.true. + end if + else + aliw=.true. + end if + + if (aliw) then + allocate(iwork(liwork),stat=info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='Allocate') + goto 9999 + end if + else + iwork => work + end if + ! exchange overlap elements + if(do_swap) then + xp => x(iix:ldx,jjx:jjx+k-1) + call psi_swapdata(mode_,k,i2one,xp,& + & desc_a,iwork,info,data=psb_comm_ovr_) + end if + if (info == psb_success_) call psi_ovrl_upd(xp,desc_a,update_,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='Inner updates') + goto 9999 + end if + + if (aliw) deallocate(iwork) + nullify(iwork) + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(ione*ictxt,err_act) + + return +end subroutine psb_i2ovrlm +!!$ +!!$ Parallel Sparse BLAS version 3.5 +!!$ (C) Copyright 2006-2018 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari +!!$ +!!$ 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: psb_i2ovrlv +! This subroutine performs the exchange of the overlap elements in a +! distributed dense vector between all the processes. +! +! Arguments: +! x(:) - integer The local part of the dense vector. +! desc_a - type(psb_desc_type). The communication descriptor. +! info - integer. Return code. +! work - integer(optional). A work area. +! update - integer(optional). Type of update: +! psb_none_ do nothing +! psb_sum_ sum of overlaps +! psb_avg_ average of overlaps +! mode - integer(optional). Choose the algorithm for data exchange: +! this is chosen through bit fields. +! - swap_mpi = iand(flag,psb_swap_mpi_) /= 0 +! - swap_sync = iand(flag,psb_swap_sync_) /= 0 +! - swap_send = iand(flag,psb_swap_send_) /= 0 +! - swap_recv = iand(flag,psb_swap_recv_) /= 0 +! - if (swap_mpi): use underlying MPI_ALLTOALLV. +! - if (swap_sync): use PSB_SND and PSB_RCV in +! synchronized pairs +! - if (swap_send .and. swap_recv): use mpi_irecv +! and mpi_send +! - if (swap_send): use psb_snd (but need another +! call with swap_recv to complete) +! - if (swap_recv): use psb_rcv (completing a +! previous call with swap_send) +! +! +subroutine psb_i2ovrlv(x,desc_a,info,work,update,mode) + use psb_base_mod, psb_protect_name => psb_i2ovrlv + use psi_mod + implicit none + + integer(psb_i2pk_), intent(inout), target :: x(:) + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(out) :: info + integer(psb_i2pk_), optional, target, intent(inout) :: work(:) + integer(psb_ipk_), intent(in), optional :: update,mode + + ! locals + integer(psb_ipk_) :: ictxt, np, me, err_act, iix, jjx, nrow, ncol, & + & k, update_, mode_, liwork, ldx + integer(psb_lpk_) :: m, n, ix, ijx + integer(psb_i2pk_),pointer :: iwork(:) + logical :: do_swap + character(len=20) :: name, ch_err + logical :: aliw + + name='psb_i2ovrlv' + info=psb_success_ + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + + ictxt=desc_a%get_context() + + ! 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 + + ix = 1 + ijx = 1 + + m = desc_a%get_global_rows() + n = desc_a%get_global_cols() + nrow = desc_a%get_local_rows() + ncol = desc_a%get_local_cols() + + k = 1 + + if (present(update)) then + update_ = update + else + update_ = psb_avg_ + endif + + if (present(mode)) then + mode_ = mode + else + mode_ = IOR(psb_swap_send_,psb_swap_recv_) + endif + do_swap = (mode_ /= 0) + ldx = size(x,1) + ! check vector correctness + call psb_chkvect(m,lone,ldx,ix,ijx,desc_a,info,iix,jjx) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect' + call psb_errpush(info,name,a_err=ch_err) + end if + + if (iix /= 1) then + info=psb_err_ix_n1_iy_n1_unsupported_ + call psb_errpush(info,name) + end if + + if(info /= 0) goto 9999 + + + ! check for presence/size of a work area + liwork=ncol + if (present(work)) then + if(size(work) >= liwork) then + aliw=.false. + else + aliw=.true. + end if + else + aliw=.true. + end if + if (aliw) then + allocate(iwork(liwork),stat=info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='Allocate') + goto 9999 + end if + else + iwork => work + end if + + ! exchange overlap elements + if (do_swap) then + call psi_swapdata(mode_,i2one,x,& + & desc_a,iwork,info,data=psb_comm_ovr_) + end if + if (info == psb_success_) call psi_ovrl_upd(x,desc_a,update_,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='Inner updates') + goto 9999 + end if + + if (aliw) deallocate(iwork) + nullify(iwork) + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(ione*ictxt,err_act) + + return +end subroutine psb_i2ovrlv diff --git a/base/comm/psb_i2scatter_a.F90 b/base/comm/psb_i2scatter_a.F90 new file mode 100644 index 000000000..4a72458ea --- /dev/null +++ b/base/comm/psb_i2scatter_a.F90 @@ -0,0 +1,480 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! 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: psb_i2scatter.f90 +! +! Subroutine: psb_i2scatterm +! This subroutine scatters a global matrix locally owned by one process +! into pieces that are local to all the processes. +! +! Arguments: +! globx - integer,dimension(:,:). The global matrix to scatter. +! locx - integer,dimension(:,:). The local piece of the distributed matrix. +! desc_a - type(psb_desc_type). The communication descriptor. +! info - integer. Error code. +! iroot - integer(optional). The process that owns the global matrix. +! If -1 all the processes have a copy. +! Default -1 +subroutine psb_i2scatterm(globx, locx, desc_a, info, root) + + use psb_base_mod, psb_protect_name => psb_i2scatterm +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + + integer(psb_i2pk_), intent(out), allocatable :: locx(:,:) + integer(psb_i2pk_), intent(in) :: globx(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: root + + + ! locals + integer(psb_mpk_) :: ictxt, np, me, iroot, icomm, myrank, rootrank, iam, nlr + integer(psb_ipk_) :: ierr(5), err_act, nrow,& + & ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, & + & col,pos + integer(psb_lpk_) :: m, n, i, j, idx, iglobx, jglobx + integer(psb_i2pk_),allocatable :: scatterv(:) + integer(psb_mpk_), allocatable :: displ(:), all_dim(:) + integer(psb_lpk_), allocatable :: l_t_g_all(:), ltg(:) + character(len=20) :: name, ch_err + + name='psb_scatterm' + info=psb_success_ + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + + ictxt=desc_a%get_context() + + ! check on blacs grid + call psb_info(ictxt, iam, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + if (present(root)) then + iroot = root + if((iroot < -1).or.(iroot >= np)) then + info=psb_err_input_value_invalid_i_ + ierr(1)=5; ierr(2)=iroot + call psb_errpush(info,name,i_err=ierr) + goto 9999 + end if + else + iroot = psb_root_ + end if + + iglobx = 1 + jglobx = 1 + lda_globx = size(globx,1) + + m = desc_a%get_global_rows() + n = desc_a%get_global_cols() + icomm = psb_get_mpi_comm(ictxt) + myrank = psb_get_mpi_rank(ictxt,me) + + if (iroot==-1) then + lda_globx = size(globx, 1) + k = size(globx,2) + else + if (iam==iroot) then + k = size(globx,2) + lda_globx = size(globx, 1) + end if + end if + + m = desc_a%get_global_rows() + n = desc_a%get_global_cols() + + + ! there should be a global check on k here!!! + if ((iroot==-1).or.(iam==iroot)) & + & call psb_chkglobvect(m,n,lda_globx,iglobx,jglobx,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chk(glob)vect' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + nrow=desc_a%get_local_rows() + ! root has to gather size information + allocate(displ(np),all_dim(np),ltg(nrow),stat=info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='Allocate' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + do i=1, nrow + ltg(i) = i + end do + call psb_loc_to_glob(ltg(1:nrow),desc_a,info) + + call psb_geall(locx,desc_a,info,n=k) + + if ((iroot == -1).or.(np == 1)) then + ! extract my chunk + do j=1,k + do i=1, nrow + locx(i,j)=globx(ltg(i),j) + end do + end do + else + + rootrank = psb_get_mpi_rank(ictxt,iroot) + ! + ! This is potentially unsafe when IPK=8 + ! But then, IPK=8 is highly experimental anyway. + ! + nlr = nrow + call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,& + & 1,psb_mpi_mpk_,rootrank,icomm,info) + + if (iam == iroot) then + displ(1)=0 + do i=2,np + displ(i)=displ(i-1)+all_dim(i-1) + end do + + ! root has to gather loc_glob from each process + allocate(l_t_g_all(sum(all_dim)),scatterv(sum(all_dim)),stat=info) + else + ! + ! This is to keep debugging compilers from being upset by + ! calling an external MPI function with an unallocated array; + ! the Fortran side would complain even if the MPI side does + ! not use the unallocated stuff. + ! + allocate(l_t_g_all(1),scatterv(1),stat=info) + end if + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='Allocate' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + call mpi_gatherv(ltg,nlr,& + & psb_mpi_lpk_,l_t_g_all,all_dim,& + & displ,psb_mpi_lpk_,rootrank,icomm,info) + + do col=1, k + ! prepare vector to scatter + if(iam == iroot) then + do i=1,np + pos=displ(i) + do j=1, all_dim(i) + idx=l_t_g_all(pos+j) + scatterv(pos+j)=globx(idx,col) + end do + end do + end if + + ! scatter + call mpi_scatterv(scatterv,all_dim,displ,& + & psb_mpi_i2pk_,locx(1,col),nrow,& + & psb_mpi_i2pk_,rootrank,icomm,info) + + end do + + deallocate(l_t_g_all, scatterv,stat=info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='deallocate' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + end if + deallocate(all_dim, displ, ltg,stat=info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='deallocate' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(ione*ictxt,err_act) + + return + +end subroutine psb_i2scatterm + + + + +!!$ +!!$ Parallel Sparse BLAS version 3.5 +!!$ (C) Copyright 2006-2018 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari +!!$ +!!$ 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: psb_i2scatterv +! This subroutine scatters a global vector locally owned by one process +! into pieces that are local to all the processes. +! +! Arguments: +! globx - integer,dimension(:). The global vector to scatter. +! locx - integer,dimension(:). The local piece of the ditributed vector. +! desc_a - type(psb_desc_type). The communication descriptor. +! info - integer. Return code +! iroot - integer(optional). The process that owns the global vector. If -1 all +! the processes have a copy. +! +subroutine psb_i2scatterv(globx, locx, desc_a, info, root) + use psb_base_mod, psb_protect_name => psb_i2scatterv +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + + integer(psb_i2pk_), intent(out), allocatable :: locx(:) + integer(psb_i2pk_), intent(in) :: globx(:) + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: root + + + ! locals + integer(psb_mpk_) :: ictxt, np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr + integer(psb_ipk_) :: ierr(5), err_act, nrow,& + & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx + integer(psb_lpk_) :: m, n, i, j, idx, iglobx, jglobx + integer(psb_i2pk_), allocatable :: scatterv(:) + integer(psb_mpk_), allocatable :: displ(:), all_dim(:) + integer(psb_lpk_), allocatable :: l_t_g_all(:), ltg(:) + character(len=20) :: name, ch_err + integer(psb_ipk_) :: debug_level, debug_unit + + name='psb_scatterv' + info=psb_success_ + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + ictxt=desc_a%get_context() + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + + ! check on blacs grid + call psb_info(ictxt, iam, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + if (present(root)) then + iroot = root + if((iroot < -1).or.(iroot > np)) then + info=psb_err_input_value_invalid_i_ + ierr(1) = 5; ierr(2)=iroot + call psb_errpush(info,name,i_err=ierr) + goto 9999 + end if + else + iroot = psb_root_ + end if + + icomm = psb_get_mpi_comm(ictxt) + myrank = psb_get_mpi_rank(ictxt,iam) + + iglobx = 1 + jglobx = 1 + ilocx = 1 + jlocx = 1 + if ((iroot==-1).or.(iam==iroot))& + & lda_globx = size(globx, 1) + + + m = desc_a%get_global_rows() + n = desc_a%get_global_cols() + + k = 1 + ! there should be a global check on k here!!! + if ((iroot==-1).or.(iam==iroot)) & + & call psb_chkglobvect(m,n,lda_globx,iglobx,jglobx,desc_a,info) + + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chk(glob)vect' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + nrow = desc_a%get_local_rows() + allocate(displ(np),all_dim(np),ltg(nrow),stat=info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='Allocate' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + do i=1, nrow + ltg(i) = i + end do + call psb_loc_to_glob(ltg(1:nrow),desc_a,info) + call psb_geall(locx,desc_a,info) + + if ((iroot == -1).or.(np == 1)) then + ! extract my chunk + do i=1, nrow + locx(i)=globx(ltg(i)) + end do + else + rootrank = psb_get_mpi_rank(ictxt,iroot) + ! + ! This is potentially unsafe when IPK=8 + ! But then, IPK=8 is highly experimental anyway. + ! + nlr = nrow + call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,& + & 1,psb_mpi_mpk_,rootrank,icomm,info) + + if(iam == iroot) then + displ(1)=0 + do i=2,np + displ(i)=displ(i-1) + all_dim(i-1) + end do + if (debug_level >= psb_debug_inner_) then + write(debug_unit,*) iam,' ',trim(name),' displ:',displ(1:np), & + &' dim',all_dim(1:np), sum(all_dim) + endif + + ! root has to gather loc_glob from each process + allocate(l_t_g_all(sum(all_dim)),scatterv(sum(all_dim)),stat=info) + + else + ! + ! This is to keep debugging compilers from being upset by + ! calling an external MPI function with an unallocated array; + ! the Fortran side would complain even if the MPI side does + ! not use the unallocated stuff. + ! + allocate(l_t_g_all(1),scatterv(1),stat=info) + end if + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='Allocate' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + call mpi_gatherv(ltg,nlr,& + & psb_mpi_lpk_,l_t_g_all,all_dim,& + & displ,psb_mpi_lpk_,rootrank,icomm,info) + + ! prepare vector to scatter + if (iam == iroot) then + do i=1,np + pos=displ(i) + do j=1, all_dim(i) + idx=l_t_g_all(pos+j) + scatterv(pos+j)=globx(idx) + + end do + end do + end if + + call mpi_scatterv(scatterv,all_dim,displ,& + & psb_mpi_i2pk_,locx,nrow,& + & psb_mpi_i2pk_,rootrank,icomm,info) + + deallocate(l_t_g_all, scatterv,stat=info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='deallocate' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + end if + + deallocate(all_dim, displ, ltg,stat=info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='deallocate' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(ione*ictxt,err_act) + + return + +end subroutine psb_i2scatterv + diff --git a/base/comm/psb_ispgather.F90 b/base/comm/psb_ispgather.F90 index d13c2e7cd..622641cbf 100644 --- a/base/comm/psb_ispgather.F90 +++ b/base/comm/psb_ispgather.F90 @@ -70,7 +70,7 @@ subroutine psb_isp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k logical :: keepnum_, keeploc_ integer(psb_mpk_) :: ictxt,np,me - integer(psb_mpk_) :: icomm, minfo, ndx + integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_lpk_), allocatable :: locia(:), locja(:), glbia(:), glbja(:) integer(psb_ipk_) :: ierr(5) @@ -98,7 +98,12 @@ subroutine psb_isp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep else keeploc_ = .true. end if - call globa%free() + if (present(root)) then + root_ = root + else + root_ = -1 + end if + if ((root_ == -1).or.(root_ == me)) call globa%free() if (keepnum_) then nrg = desc_a%get_global_rows() @@ -137,27 +142,48 @@ subroutine psb_isp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep call psb_errpush(info,name); goto 9999 end if #endif + if ((root_ == -1).or.(root_ == me)) then + if (info == psb_success_) call psb_realloc(nzg,glbia,info) + if (info == psb_success_) call psb_realloc(nzg,glbja,info) + if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) + else + if (info == psb_success_) call psb_realloc(ione,glbia,info) + if (info == psb_success_) call psb_realloc(ione,glbja,info) + if (info == psb_success_) call glob_coo%allocate(ione,ione,ione) + end if - if (info == psb_success_) call psb_realloc(nzg,glbia,info) - if (info == psb_success_) call psb_realloc(nzg,glbja,info) - if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) if (info /= psb_success_) goto 9999 do ip=1,np idisp(ip) = sum(nzbr(1:ip-1)) enddo - ndx = nzbr(me+1) - call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_ipk_,& - & glob_coo%val,nzbr,idisp,& - & psb_mpi_ipk_,icomm,minfo) - if (minfo == psb_success_) call & - & mpi_allgatherv(locia,ndx,psb_mpi_lpk_,& - & glbia,nzbr,idisp,& - & psb_mpi_lpk_,icomm,minfo) - if (minfo == psb_success_) call & - & mpi_allgatherv(locja,ndx,psb_mpi_lpk_,& - & glbja,nzbr,idisp,& - & psb_mpi_lpk_,icomm,minfo) + ndx = nzbr(me+1) + if (root_ == -1) then + call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_ipk_,& + & glob_coo%val,nzbr,idisp,& + & psb_mpi_ipk_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_allgatherv(locia,ndx,psb_mpi_lpk_,& + & glbia,nzbr,idisp,& + & psb_mpi_lpk_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_allgatherv(locja,ndx,psb_mpi_lpk_,& + & glbja,nzbr,idisp,& + & psb_mpi_lpk_,icomm,minfo) + else + call mpi_gatherv(loc_coo%val,ndx,psb_mpi_ipk_,& + & glob_coo%val,nzbr,idisp,& + & psb_mpi_ipk_,root_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_gatherv(locia,ndx,psb_mpi_lpk_,& + & glbia,nzbr,idisp,& + & psb_mpi_lpk_,root_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_gatherv(locja,ndx,psb_mpi_lpk_,& + & glbja,nzbr,idisp,& + & psb_mpi_lpk_,root_,icomm,minfo) + + end if if (minfo /= psb_success_) then info = minfo @@ -172,11 +198,13 @@ subroutine psb_isp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep ! for very large cases it does not make sense to ! gather the matrix on a single procecss anyway... ! - glob_coo%ia(1:nzg) = glbia(1:nzg) - glob_coo%ja(1:nzg) = glbja(1:nzg) - call glob_coo%set_nzeros(nzg) - if (present(dupl)) call glob_coo%set_dupl(dupl) - call globa%mv_from(glob_coo) + if ((root_ == -1).or.(root_ == me)) then + glob_coo%ia(1:nzg) = glbia(1:nzg) + glob_coo%ja(1:nzg) = glbja(1:nzg) + call glob_coo%set_nzeros(nzg) + if (present(dupl)) call glob_coo%set_dupl(dupl) + call globa%mv_from(glob_coo) + end if deallocate(glbia,glbja, stat=info) else @@ -228,7 +256,7 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ integer(psb_mpk_) :: ictxt,np,me - integer(psb_mpk_) :: icomm, minfo, ndx + integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_lpk_), allocatable :: lnzbr(:) integer(psb_ipk_) :: ierr(5) @@ -256,7 +284,13 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k else keeploc_ = .true. end if - call globa%free() + if (present(root)) then + root_ = root + else + root_ = -1 + end if + + if ((root_ == -1).or.(root_ == me)) call globa%free() if (keepnum_) then nrg = desc_a%get_global_rows() @@ -269,7 +303,7 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k goto 9999 end if - + if (keeploc_) then call loca%cp_to(loc_coo) else @@ -294,7 +328,11 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k call psb_errpush(info,name); goto 9999 end if #endif - if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) + if ((root_ == -1).or.(root_ == me)) then + if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) + else + if (info == psb_success_) call glob_coo%allocate(1_psb_lpk_,1_psb_lpk_,1_psb_lpk_) + end if if (info /= psb_success_) goto 9999 ! ! PLS REVIEW AND ADD OVERFLOW ERROR CHECKING @@ -303,24 +341,37 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k do ip=1,np idisp(ip) = sum(nzbr(1:ip-1)) enddo - ndx = nzbr(me+1) - call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_ipk_,& - & glob_coo%val,nzbr,idisp,& - & psb_mpi_ipk_,icomm,minfo) - if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& - & glob_coo%ia,nzbr,idisp,& - & psb_mpi_lpk_,icomm,minfo) - if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& - & glob_coo%ja,nzbr,idisp,& - & psb_mpi_lpk_,icomm,minfo) - + ndx = nzbr(me+1) + if (root_ == -1) then + call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_ipk_,& + & glob_coo%val,nzbr,idisp,& + & psb_mpi_ipk_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & glob_coo%ia,nzbr,idisp,& + & psb_mpi_lpk_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & glob_coo%ja,nzbr,idisp,& + & psb_mpi_lpk_,icomm,minfo) + else + call mpi_gatherv(loc_coo%val,ndx,psb_mpi_ipk_,& + & glob_coo%val,nzbr,idisp,& + & psb_mpi_ipk_,root_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_gatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & glob_coo%ia,nzbr,idisp,& + & psb_mpi_lpk_,root_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_gatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & glob_coo%ja,nzbr,idisp,& + & psb_mpi_lpk_,root_,icomm,minfo) + end if if (minfo /= psb_success_) then info = minfo call psb_errpush(psb_err_internal_error_,name,a_err=' from mpi_allgatherv') goto 9999 - end if + end if call loc_coo%free() ! ! Is the code below safe? For very large cases @@ -328,9 +379,11 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k ! for very large cases it does not make sense to ! gather the matrix on a single procecss anyway... ! - call glob_coo%set_nzeros(nzg) - if (present(dupl)) call glob_coo%set_dupl(dupl) - call globa%mv_from(glob_coo) + if ((root_ == -1).or.(root_ == me)) then + call glob_coo%set_nzeros(nzg) + if (present(dupl)) call glob_coo%set_dupl(dupl) + call globa%mv_from(glob_coo) + end if else write(psb_err_unit,*) 'SP_ALLGATHER: Not implemented yet with keepnum ',keepnum_ @@ -346,7 +399,7 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k call psb_error_handler(ione*ictxt,err_act) return - + end subroutine psb_@LX@sp_allgather subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc) @@ -378,7 +431,7 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn integer(psb_lpk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ integer(psb_mpk_) :: ictxt,np,me - integer(psb_mpk_) :: icomm, minfo, ndx + integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_lpk_), allocatable :: lnzbr(:) integer(psb_ipk_) :: ierr(5) @@ -406,7 +459,13 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn else keeploc_ = .true. end if - call globa%free() + if (present(root)) then + root_ = root + else + root_ = -1 + end if + + if ((root_ == -1).or.(root_ == me)) call globa%free() if (keepnum_) then nrg = desc_a%get_global_rows() @@ -444,25 +503,43 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn call psb_errpush(info,name); goto 9999 end if #endif - if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) + if ((root_ == -1).or.(root_ == me)) then + if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) + else + if (info == psb_success_) call glob_coo%allocate(1_psb_lpk_,1_psb_lpk_,1_psb_lpk_) + end if if (info /= psb_success_) goto 9999 do ip=1,np idisp(ip) = sum(nzbr(1:ip-1)) enddo - ndx = nzbr(me+1) - call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_ipk_,& - & glob_coo%val,nzbr,idisp,& - & psb_mpi_ipk_,icomm,minfo) - if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& - & glob_coo%ia,nzbr,idisp,& - & psb_mpi_lpk_,icomm,minfo) - if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& - & glob_coo%ja,nzbr,idisp,& - & psb_mpi_lpk_,icomm,minfo) - + ndx = nzbr(me+1) + + if (root_ == -1) then + call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_ipk_,& + & glob_coo%val,nzbr,idisp,& + & psb_mpi_ipk_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & glob_coo%ia,nzbr,idisp,& + & psb_mpi_lpk_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & glob_coo%ja,nzbr,idisp,& + & psb_mpi_lpk_,icomm,minfo) + else + call mpi_gatherv(loc_coo%val,ndx,psb_mpi_ipk_,& + & glob_coo%val,nzbr,idisp,& + & psb_mpi_ipk_,root_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_gatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & glob_coo%ia,nzbr,idisp,& + & psb_mpi_lpk_,root_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_gatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & glob_coo%ja,nzbr,idisp,& + & psb_mpi_lpk_,root_,icomm,minfo) + end if if (minfo /= psb_success_) then info = minfo call psb_errpush(psb_err_internal_error_,name,a_err=' from mpi_allgatherv') @@ -470,9 +547,11 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn end if call loc_coo%free() ! - call glob_coo%set_nzeros(nzg) - if (present(dupl)) call glob_coo%set_dupl(dupl) - call globa%mv_from(glob_coo) + if ((root_ == -1).or.(root_ == me)) then + call glob_coo%set_nzeros(nzg) + if (present(dupl)) call glob_coo%set_dupl(dupl) + call globa%mv_from(glob_coo) + end if else write(psb_err_unit,*) 'SP_ALLGATHER: Not implemented yet with keepnum ',keepnum_ diff --git a/base/comm/psb_lspgather.F90 b/base/comm/psb_lspgather.F90 index 2f5881168..bfba8a974 100644 --- a/base/comm/psb_lspgather.F90 +++ b/base/comm/psb_lspgather.F90 @@ -70,7 +70,7 @@ subroutine psb_lsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k logical :: keepnum_, keeploc_ integer(psb_mpk_) :: ictxt,np,me - integer(psb_mpk_) :: icomm, minfo, ndx + integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_lpk_), allocatable :: locia(:), locja(:), glbia(:), glbja(:) integer(psb_ipk_) :: ierr(5) @@ -98,7 +98,12 @@ subroutine psb_lsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep else keeploc_ = .true. end if - call globa%free() + if (present(root)) then + root_ = root + else + root_ = -1 + end if + if ((root_ == -1).or.(root_ == me)) call globa%free() if (keepnum_) then nrg = desc_a%get_global_rows() @@ -137,27 +142,48 @@ subroutine psb_lsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep call psb_errpush(info,name); goto 9999 end if #endif + if ((root_ == -1).or.(root_ == me)) then + if (info == psb_success_) call psb_realloc(nzg,glbia,info) + if (info == psb_success_) call psb_realloc(nzg,glbja,info) + if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) + else + if (info == psb_success_) call psb_realloc(ione,glbia,info) + if (info == psb_success_) call psb_realloc(ione,glbja,info) + if (info == psb_success_) call glob_coo%allocate(ione,ione,ione) + end if - if (info == psb_success_) call psb_realloc(nzg,glbia,info) - if (info == psb_success_) call psb_realloc(nzg,glbja,info) - if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) if (info /= psb_success_) goto 9999 do ip=1,np idisp(ip) = sum(nzbr(1:ip-1)) enddo - ndx = nzbr(me+1) - call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_lpk_,& - & glob_coo%val,nzbr,idisp,& - & psb_mpi_lpk_,icomm,minfo) - if (minfo == psb_success_) call & - & mpi_allgatherv(locia,ndx,psb_mpi_lpk_,& - & glbia,nzbr,idisp,& - & psb_mpi_lpk_,icomm,minfo) - if (minfo == psb_success_) call & - & mpi_allgatherv(locja,ndx,psb_mpi_lpk_,& - & glbja,nzbr,idisp,& - & psb_mpi_lpk_,icomm,minfo) + ndx = nzbr(me+1) + if (root_ == -1) then + call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_lpk_,& + & glob_coo%val,nzbr,idisp,& + & psb_mpi_lpk_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_allgatherv(locia,ndx,psb_mpi_lpk_,& + & glbia,nzbr,idisp,& + & psb_mpi_lpk_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_allgatherv(locja,ndx,psb_mpi_lpk_,& + & glbja,nzbr,idisp,& + & psb_mpi_lpk_,icomm,minfo) + else + call mpi_gatherv(loc_coo%val,ndx,psb_mpi_lpk_,& + & glob_coo%val,nzbr,idisp,& + & psb_mpi_lpk_,root_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_gatherv(locia,ndx,psb_mpi_lpk_,& + & glbia,nzbr,idisp,& + & psb_mpi_lpk_,root_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_gatherv(locja,ndx,psb_mpi_lpk_,& + & glbja,nzbr,idisp,& + & psb_mpi_lpk_,root_,icomm,minfo) + + end if if (minfo /= psb_success_) then info = minfo @@ -172,11 +198,13 @@ subroutine psb_lsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep ! for very large cases it does not make sense to ! gather the matrix on a single procecss anyway... ! - glob_coo%ia(1:nzg) = glbia(1:nzg) - glob_coo%ja(1:nzg) = glbja(1:nzg) - call glob_coo%set_nzeros(nzg) - if (present(dupl)) call glob_coo%set_dupl(dupl) - call globa%mv_from(glob_coo) + if ((root_ == -1).or.(root_ == me)) then + glob_coo%ia(1:nzg) = glbia(1:nzg) + glob_coo%ja(1:nzg) = glbja(1:nzg) + call glob_coo%set_nzeros(nzg) + if (present(dupl)) call glob_coo%set_dupl(dupl) + call globa%mv_from(glob_coo) + end if deallocate(glbia,glbja, stat=info) else @@ -228,7 +256,7 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ integer(psb_mpk_) :: ictxt,np,me - integer(psb_mpk_) :: icomm, minfo, ndx + integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_lpk_), allocatable :: lnzbr(:) integer(psb_ipk_) :: ierr(5) @@ -256,7 +284,13 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k else keeploc_ = .true. end if - call globa%free() + if (present(root)) then + root_ = root + else + root_ = -1 + end if + + if ((root_ == -1).or.(root_ == me)) call globa%free() if (keepnum_) then nrg = desc_a%get_global_rows() @@ -269,7 +303,7 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k goto 9999 end if - + if (keeploc_) then call loca%cp_to(loc_coo) else @@ -294,7 +328,11 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k call psb_errpush(info,name); goto 9999 end if #endif - if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) + if ((root_ == -1).or.(root_ == me)) then + if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) + else + if (info == psb_success_) call glob_coo%allocate(1_psb_lpk_,1_psb_lpk_,1_psb_lpk_) + end if if (info /= psb_success_) goto 9999 ! ! PLS REVIEW AND ADD OVERFLOW ERROR CHECKING @@ -303,24 +341,37 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k do ip=1,np idisp(ip) = sum(nzbr(1:ip-1)) enddo - ndx = nzbr(me+1) - call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_lpk_,& - & glob_coo%val,nzbr,idisp,& - & psb_mpi_lpk_,icomm,minfo) - if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& - & glob_coo%ia,nzbr,idisp,& - & psb_mpi_lpk_,icomm,minfo) - if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& - & glob_coo%ja,nzbr,idisp,& - & psb_mpi_lpk_,icomm,minfo) - + ndx = nzbr(me+1) + if (root_ == -1) then + call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_lpk_,& + & glob_coo%val,nzbr,idisp,& + & psb_mpi_lpk_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & glob_coo%ia,nzbr,idisp,& + & psb_mpi_lpk_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & glob_coo%ja,nzbr,idisp,& + & psb_mpi_lpk_,icomm,minfo) + else + call mpi_gatherv(loc_coo%val,ndx,psb_mpi_lpk_,& + & glob_coo%val,nzbr,idisp,& + & psb_mpi_lpk_,root_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_gatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & glob_coo%ia,nzbr,idisp,& + & psb_mpi_lpk_,root_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_gatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & glob_coo%ja,nzbr,idisp,& + & psb_mpi_lpk_,root_,icomm,minfo) + end if if (minfo /= psb_success_) then info = minfo call psb_errpush(psb_err_internal_error_,name,a_err=' from mpi_allgatherv') goto 9999 - end if + end if call loc_coo%free() ! ! Is the code below safe? For very large cases @@ -328,9 +379,11 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k ! for very large cases it does not make sense to ! gather the matrix on a single procecss anyway... ! - call glob_coo%set_nzeros(nzg) - if (present(dupl)) call glob_coo%set_dupl(dupl) - call globa%mv_from(glob_coo) + if ((root_ == -1).or.(root_ == me)) then + call glob_coo%set_nzeros(nzg) + if (present(dupl)) call glob_coo%set_dupl(dupl) + call globa%mv_from(glob_coo) + end if else write(psb_err_unit,*) 'SP_ALLGATHER: Not implemented yet with keepnum ',keepnum_ @@ -346,7 +399,7 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k call psb_error_handler(ione*ictxt,err_act) return - + end subroutine psb_@LX@sp_allgather subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc) @@ -378,7 +431,7 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn integer(psb_lpk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ integer(psb_mpk_) :: ictxt,np,me - integer(psb_mpk_) :: icomm, minfo, ndx + integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_lpk_), allocatable :: lnzbr(:) integer(psb_ipk_) :: ierr(5) @@ -406,7 +459,13 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn else keeploc_ = .true. end if - call globa%free() + if (present(root)) then + root_ = root + else + root_ = -1 + end if + + if ((root_ == -1).or.(root_ == me)) call globa%free() if (keepnum_) then nrg = desc_a%get_global_rows() @@ -444,25 +503,43 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn call psb_errpush(info,name); goto 9999 end if #endif - if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) + if ((root_ == -1).or.(root_ == me)) then + if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) + else + if (info == psb_success_) call glob_coo%allocate(1_psb_lpk_,1_psb_lpk_,1_psb_lpk_) + end if if (info /= psb_success_) goto 9999 do ip=1,np idisp(ip) = sum(nzbr(1:ip-1)) enddo - ndx = nzbr(me+1) - call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_lpk_,& - & glob_coo%val,nzbr,idisp,& - & psb_mpi_lpk_,icomm,minfo) - if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& - & glob_coo%ia,nzbr,idisp,& - & psb_mpi_lpk_,icomm,minfo) - if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& - & glob_coo%ja,nzbr,idisp,& - & psb_mpi_lpk_,icomm,minfo) - + ndx = nzbr(me+1) + + if (root_ == -1) then + call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_lpk_,& + & glob_coo%val,nzbr,idisp,& + & psb_mpi_lpk_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & glob_coo%ia,nzbr,idisp,& + & psb_mpi_lpk_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & glob_coo%ja,nzbr,idisp,& + & psb_mpi_lpk_,icomm,minfo) + else + call mpi_gatherv(loc_coo%val,ndx,psb_mpi_lpk_,& + & glob_coo%val,nzbr,idisp,& + & psb_mpi_lpk_,root_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_gatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & glob_coo%ia,nzbr,idisp,& + & psb_mpi_lpk_,root_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_gatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & glob_coo%ja,nzbr,idisp,& + & psb_mpi_lpk_,root_,icomm,minfo) + end if if (minfo /= psb_success_) then info = minfo call psb_errpush(psb_err_internal_error_,name,a_err=' from mpi_allgatherv') @@ -470,9 +547,11 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn end if call loc_coo%free() ! - call glob_coo%set_nzeros(nzg) - if (present(dupl)) call glob_coo%set_dupl(dupl) - call globa%mv_from(glob_coo) + if ((root_ == -1).or.(root_ == me)) then + call glob_coo%set_nzeros(nzg) + if (present(dupl)) call glob_coo%set_dupl(dupl) + call globa%mv_from(glob_coo) + end if else write(psb_err_unit,*) 'SP_ALLGATHER: Not implemented yet with keepnum ',keepnum_ diff --git a/base/comm/psb_sspgather.F90 b/base/comm/psb_sspgather.F90 index 7123a9887..e25c11451 100644 --- a/base/comm/psb_sspgather.F90 +++ b/base/comm/psb_sspgather.F90 @@ -70,7 +70,7 @@ subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k logical :: keepnum_, keeploc_ integer(psb_mpk_) :: ictxt,np,me - integer(psb_mpk_) :: icomm, minfo, ndx + integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_lpk_), allocatable :: locia(:), locja(:), glbia(:), glbja(:) integer(psb_ipk_) :: ierr(5) @@ -98,7 +98,12 @@ subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep else keeploc_ = .true. end if - call globa%free() + if (present(root)) then + root_ = root + else + root_ = -1 + end if + if ((root_ == -1).or.(root_ == me)) call globa%free() if (keepnum_) then nrg = desc_a%get_global_rows() @@ -137,27 +142,48 @@ subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep call psb_errpush(info,name); goto 9999 end if #endif + if ((root_ == -1).or.(root_ == me)) then + if (info == psb_success_) call psb_realloc(nzg,glbia,info) + if (info == psb_success_) call psb_realloc(nzg,glbja,info) + if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) + else + if (info == psb_success_) call psb_realloc(ione,glbia,info) + if (info == psb_success_) call psb_realloc(ione,glbja,info) + if (info == psb_success_) call glob_coo%allocate(ione,ione,ione) + end if - if (info == psb_success_) call psb_realloc(nzg,glbia,info) - if (info == psb_success_) call psb_realloc(nzg,glbja,info) - if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) if (info /= psb_success_) goto 9999 do ip=1,np idisp(ip) = sum(nzbr(1:ip-1)) enddo - ndx = nzbr(me+1) - call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_r_spk_,& - & glob_coo%val,nzbr,idisp,& - & psb_mpi_r_spk_,icomm,minfo) - if (minfo == psb_success_) call & - & mpi_allgatherv(locia,ndx,psb_mpi_lpk_,& - & glbia,nzbr,idisp,& - & psb_mpi_lpk_,icomm,minfo) - if (minfo == psb_success_) call & - & mpi_allgatherv(locja,ndx,psb_mpi_lpk_,& - & glbja,nzbr,idisp,& - & psb_mpi_lpk_,icomm,minfo) + ndx = nzbr(me+1) + if (root_ == -1) then + call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_r_spk_,& + & glob_coo%val,nzbr,idisp,& + & psb_mpi_r_spk_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_allgatherv(locia,ndx,psb_mpi_lpk_,& + & glbia,nzbr,idisp,& + & psb_mpi_lpk_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_allgatherv(locja,ndx,psb_mpi_lpk_,& + & glbja,nzbr,idisp,& + & psb_mpi_lpk_,icomm,minfo) + else + call mpi_gatherv(loc_coo%val,ndx,psb_mpi_r_spk_,& + & glob_coo%val,nzbr,idisp,& + & psb_mpi_r_spk_,root_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_gatherv(locia,ndx,psb_mpi_lpk_,& + & glbia,nzbr,idisp,& + & psb_mpi_lpk_,root_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_gatherv(locja,ndx,psb_mpi_lpk_,& + & glbja,nzbr,idisp,& + & psb_mpi_lpk_,root_,icomm,minfo) + + end if if (minfo /= psb_success_) then info = minfo @@ -172,11 +198,13 @@ subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep ! for very large cases it does not make sense to ! gather the matrix on a single procecss anyway... ! - glob_coo%ia(1:nzg) = glbia(1:nzg) - glob_coo%ja(1:nzg) = glbja(1:nzg) - call glob_coo%set_nzeros(nzg) - if (present(dupl)) call glob_coo%set_dupl(dupl) - call globa%mv_from(glob_coo) + if ((root_ == -1).or.(root_ == me)) then + glob_coo%ia(1:nzg) = glbia(1:nzg) + glob_coo%ja(1:nzg) = glbja(1:nzg) + call glob_coo%set_nzeros(nzg) + if (present(dupl)) call glob_coo%set_dupl(dupl) + call globa%mv_from(glob_coo) + end if deallocate(glbia,glbja, stat=info) else @@ -228,7 +256,7 @@ subroutine psb_lssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ integer(psb_mpk_) :: ictxt,np,me - integer(psb_mpk_) :: icomm, minfo, ndx + integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_lpk_), allocatable :: lnzbr(:) integer(psb_ipk_) :: ierr(5) @@ -256,7 +284,13 @@ subroutine psb_lssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee else keeploc_ = .true. end if - call globa%free() + if (present(root)) then + root_ = root + else + root_ = -1 + end if + + if ((root_ == -1).or.(root_ == me)) call globa%free() if (keepnum_) then nrg = desc_a%get_global_rows() @@ -269,7 +303,7 @@ subroutine psb_lssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee goto 9999 end if - + if (keeploc_) then call loca%cp_to(loc_coo) else @@ -294,7 +328,11 @@ subroutine psb_lssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee call psb_errpush(info,name); goto 9999 end if #endif - if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) + if ((root_ == -1).or.(root_ == me)) then + if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) + else + if (info == psb_success_) call glob_coo%allocate(1_psb_lpk_,1_psb_lpk_,1_psb_lpk_) + end if if (info /= psb_success_) goto 9999 ! ! PLS REVIEW AND ADD OVERFLOW ERROR CHECKING @@ -303,24 +341,37 @@ subroutine psb_lssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee do ip=1,np idisp(ip) = sum(nzbr(1:ip-1)) enddo - ndx = nzbr(me+1) - call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_r_spk_,& - & glob_coo%val,nzbr,idisp,& - & psb_mpi_r_spk_,icomm,minfo) - if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& - & glob_coo%ia,nzbr,idisp,& - & psb_mpi_lpk_,icomm,minfo) - if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& - & glob_coo%ja,nzbr,idisp,& - & psb_mpi_lpk_,icomm,minfo) - + ndx = nzbr(me+1) + if (root_ == -1) then + call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_r_spk_,& + & glob_coo%val,nzbr,idisp,& + & psb_mpi_r_spk_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & glob_coo%ia,nzbr,idisp,& + & psb_mpi_lpk_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & glob_coo%ja,nzbr,idisp,& + & psb_mpi_lpk_,icomm,minfo) + else + call mpi_gatherv(loc_coo%val,ndx,psb_mpi_r_spk_,& + & glob_coo%val,nzbr,idisp,& + & psb_mpi_r_spk_,root_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_gatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & glob_coo%ia,nzbr,idisp,& + & psb_mpi_lpk_,root_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_gatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & glob_coo%ja,nzbr,idisp,& + & psb_mpi_lpk_,root_,icomm,minfo) + end if if (minfo /= psb_success_) then info = minfo call psb_errpush(psb_err_internal_error_,name,a_err=' from mpi_allgatherv') goto 9999 - end if + end if call loc_coo%free() ! ! Is the code below safe? For very large cases @@ -328,9 +379,11 @@ subroutine psb_lssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee ! for very large cases it does not make sense to ! gather the matrix on a single procecss anyway... ! - call glob_coo%set_nzeros(nzg) - if (present(dupl)) call glob_coo%set_dupl(dupl) - call globa%mv_from(glob_coo) + if ((root_ == -1).or.(root_ == me)) then + call glob_coo%set_nzeros(nzg) + if (present(dupl)) call glob_coo%set_dupl(dupl) + call globa%mv_from(glob_coo) + end if else write(psb_err_unit,*) 'SP_ALLGATHER: Not implemented yet with keepnum ',keepnum_ @@ -346,7 +399,7 @@ subroutine psb_lssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee call psb_error_handler(ione*ictxt,err_act) return - + end subroutine psb_lssp_allgather subroutine psb_lslssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc) @@ -378,7 +431,7 @@ subroutine psb_lslssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k integer(psb_lpk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ integer(psb_mpk_) :: ictxt,np,me - integer(psb_mpk_) :: icomm, minfo, ndx + integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_lpk_), allocatable :: lnzbr(:) integer(psb_ipk_) :: ierr(5) @@ -406,7 +459,13 @@ subroutine psb_lslssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k else keeploc_ = .true. end if - call globa%free() + if (present(root)) then + root_ = root + else + root_ = -1 + end if + + if ((root_ == -1).or.(root_ == me)) call globa%free() if (keepnum_) then nrg = desc_a%get_global_rows() @@ -444,25 +503,43 @@ subroutine psb_lslssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k call psb_errpush(info,name); goto 9999 end if #endif - if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) + if ((root_ == -1).or.(root_ == me)) then + if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) + else + if (info == psb_success_) call glob_coo%allocate(1_psb_lpk_,1_psb_lpk_,1_psb_lpk_) + end if if (info /= psb_success_) goto 9999 do ip=1,np idisp(ip) = sum(nzbr(1:ip-1)) enddo - ndx = nzbr(me+1) - call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_r_spk_,& - & glob_coo%val,nzbr,idisp,& - & psb_mpi_r_spk_,icomm,minfo) - if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& - & glob_coo%ia,nzbr,idisp,& - & psb_mpi_lpk_,icomm,minfo) - if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& - & glob_coo%ja,nzbr,idisp,& - & psb_mpi_lpk_,icomm,minfo) - + ndx = nzbr(me+1) + + if (root_ == -1) then + call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_r_spk_,& + & glob_coo%val,nzbr,idisp,& + & psb_mpi_r_spk_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & glob_coo%ia,nzbr,idisp,& + & psb_mpi_lpk_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & glob_coo%ja,nzbr,idisp,& + & psb_mpi_lpk_,icomm,minfo) + else + call mpi_gatherv(loc_coo%val,ndx,psb_mpi_r_spk_,& + & glob_coo%val,nzbr,idisp,& + & psb_mpi_r_spk_,root_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_gatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & glob_coo%ia,nzbr,idisp,& + & psb_mpi_lpk_,root_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_gatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & glob_coo%ja,nzbr,idisp,& + & psb_mpi_lpk_,root_,icomm,minfo) + end if if (minfo /= psb_success_) then info = minfo call psb_errpush(psb_err_internal_error_,name,a_err=' from mpi_allgatherv') @@ -470,9 +547,11 @@ subroutine psb_lslssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k end if call loc_coo%free() ! - call glob_coo%set_nzeros(nzg) - if (present(dupl)) call glob_coo%set_dupl(dupl) - call globa%mv_from(glob_coo) + if ((root_ == -1).or.(root_ == me)) then + call glob_coo%set_nzeros(nzg) + if (present(dupl)) call glob_coo%set_dupl(dupl) + call globa%mv_from(glob_coo) + end if else write(psb_err_unit,*) 'SP_ALLGATHER: Not implemented yet with keepnum ',keepnum_ diff --git a/base/comm/psb_zspgather.F90 b/base/comm/psb_zspgather.F90 index f4a27681c..62a4c186e 100644 --- a/base/comm/psb_zspgather.F90 +++ b/base/comm/psb_zspgather.F90 @@ -70,7 +70,7 @@ subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k logical :: keepnum_, keeploc_ integer(psb_mpk_) :: ictxt,np,me - integer(psb_mpk_) :: icomm, minfo, ndx + integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_lpk_), allocatable :: locia(:), locja(:), glbia(:), glbja(:) integer(psb_ipk_) :: ierr(5) @@ -98,7 +98,12 @@ subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep else keeploc_ = .true. end if - call globa%free() + if (present(root)) then + root_ = root + else + root_ = -1 + end if + if ((root_ == -1).or.(root_ == me)) call globa%free() if (keepnum_) then nrg = desc_a%get_global_rows() @@ -137,27 +142,48 @@ subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep call psb_errpush(info,name); goto 9999 end if #endif + if ((root_ == -1).or.(root_ == me)) then + if (info == psb_success_) call psb_realloc(nzg,glbia,info) + if (info == psb_success_) call psb_realloc(nzg,glbja,info) + if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) + else + if (info == psb_success_) call psb_realloc(ione,glbia,info) + if (info == psb_success_) call psb_realloc(ione,glbja,info) + if (info == psb_success_) call glob_coo%allocate(ione,ione,ione) + end if - if (info == psb_success_) call psb_realloc(nzg,glbia,info) - if (info == psb_success_) call psb_realloc(nzg,glbja,info) - if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) if (info /= psb_success_) goto 9999 do ip=1,np idisp(ip) = sum(nzbr(1:ip-1)) enddo - ndx = nzbr(me+1) - call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_c_dpk_,& - & glob_coo%val,nzbr,idisp,& - & psb_mpi_c_dpk_,icomm,minfo) - if (minfo == psb_success_) call & - & mpi_allgatherv(locia,ndx,psb_mpi_lpk_,& - & glbia,nzbr,idisp,& - & psb_mpi_lpk_,icomm,minfo) - if (minfo == psb_success_) call & - & mpi_allgatherv(locja,ndx,psb_mpi_lpk_,& - & glbja,nzbr,idisp,& - & psb_mpi_lpk_,icomm,minfo) + ndx = nzbr(me+1) + if (root_ == -1) then + call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_c_dpk_,& + & glob_coo%val,nzbr,idisp,& + & psb_mpi_c_dpk_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_allgatherv(locia,ndx,psb_mpi_lpk_,& + & glbia,nzbr,idisp,& + & psb_mpi_lpk_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_allgatherv(locja,ndx,psb_mpi_lpk_,& + & glbja,nzbr,idisp,& + & psb_mpi_lpk_,icomm,minfo) + else + call mpi_gatherv(loc_coo%val,ndx,psb_mpi_c_dpk_,& + & glob_coo%val,nzbr,idisp,& + & psb_mpi_c_dpk_,root_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_gatherv(locia,ndx,psb_mpi_lpk_,& + & glbia,nzbr,idisp,& + & psb_mpi_lpk_,root_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_gatherv(locja,ndx,psb_mpi_lpk_,& + & glbja,nzbr,idisp,& + & psb_mpi_lpk_,root_,icomm,minfo) + + end if if (minfo /= psb_success_) then info = minfo @@ -172,11 +198,13 @@ subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep ! for very large cases it does not make sense to ! gather the matrix on a single procecss anyway... ! - glob_coo%ia(1:nzg) = glbia(1:nzg) - glob_coo%ja(1:nzg) = glbja(1:nzg) - call glob_coo%set_nzeros(nzg) - if (present(dupl)) call glob_coo%set_dupl(dupl) - call globa%mv_from(glob_coo) + if ((root_ == -1).or.(root_ == me)) then + glob_coo%ia(1:nzg) = glbia(1:nzg) + glob_coo%ja(1:nzg) = glbja(1:nzg) + call glob_coo%set_nzeros(nzg) + if (present(dupl)) call glob_coo%set_dupl(dupl) + call globa%mv_from(glob_coo) + end if deallocate(glbia,glbja, stat=info) else @@ -228,7 +256,7 @@ subroutine psb_lzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ integer(psb_mpk_) :: ictxt,np,me - integer(psb_mpk_) :: icomm, minfo, ndx + integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_lpk_), allocatable :: lnzbr(:) integer(psb_ipk_) :: ierr(5) @@ -256,7 +284,13 @@ subroutine psb_lzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee else keeploc_ = .true. end if - call globa%free() + if (present(root)) then + root_ = root + else + root_ = -1 + end if + + if ((root_ == -1).or.(root_ == me)) call globa%free() if (keepnum_) then nrg = desc_a%get_global_rows() @@ -269,7 +303,7 @@ subroutine psb_lzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee goto 9999 end if - + if (keeploc_) then call loca%cp_to(loc_coo) else @@ -294,7 +328,11 @@ subroutine psb_lzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee call psb_errpush(info,name); goto 9999 end if #endif - if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) + if ((root_ == -1).or.(root_ == me)) then + if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) + else + if (info == psb_success_) call glob_coo%allocate(1_psb_lpk_,1_psb_lpk_,1_psb_lpk_) + end if if (info /= psb_success_) goto 9999 ! ! PLS REVIEW AND ADD OVERFLOW ERROR CHECKING @@ -303,24 +341,37 @@ subroutine psb_lzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee do ip=1,np idisp(ip) = sum(nzbr(1:ip-1)) enddo - ndx = nzbr(me+1) - call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_c_dpk_,& - & glob_coo%val,nzbr,idisp,& - & psb_mpi_c_dpk_,icomm,minfo) - if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& - & glob_coo%ia,nzbr,idisp,& - & psb_mpi_lpk_,icomm,minfo) - if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& - & glob_coo%ja,nzbr,idisp,& - & psb_mpi_lpk_,icomm,minfo) - + ndx = nzbr(me+1) + if (root_ == -1) then + call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_c_dpk_,& + & glob_coo%val,nzbr,idisp,& + & psb_mpi_c_dpk_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & glob_coo%ia,nzbr,idisp,& + & psb_mpi_lpk_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & glob_coo%ja,nzbr,idisp,& + & psb_mpi_lpk_,icomm,minfo) + else + call mpi_gatherv(loc_coo%val,ndx,psb_mpi_c_dpk_,& + & glob_coo%val,nzbr,idisp,& + & psb_mpi_c_dpk_,root_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_gatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & glob_coo%ia,nzbr,idisp,& + & psb_mpi_lpk_,root_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_gatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & glob_coo%ja,nzbr,idisp,& + & psb_mpi_lpk_,root_,icomm,minfo) + end if if (minfo /= psb_success_) then info = minfo call psb_errpush(psb_err_internal_error_,name,a_err=' from mpi_allgatherv') goto 9999 - end if + end if call loc_coo%free() ! ! Is the code below safe? For very large cases @@ -328,9 +379,11 @@ subroutine psb_lzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee ! for very large cases it does not make sense to ! gather the matrix on a single procecss anyway... ! - call glob_coo%set_nzeros(nzg) - if (present(dupl)) call glob_coo%set_dupl(dupl) - call globa%mv_from(glob_coo) + if ((root_ == -1).or.(root_ == me)) then + call glob_coo%set_nzeros(nzg) + if (present(dupl)) call glob_coo%set_dupl(dupl) + call globa%mv_from(glob_coo) + end if else write(psb_err_unit,*) 'SP_ALLGATHER: Not implemented yet with keepnum ',keepnum_ @@ -346,7 +399,7 @@ subroutine psb_lzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee call psb_error_handler(ione*ictxt,err_act) return - + end subroutine psb_lzsp_allgather subroutine psb_lzlzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc) @@ -378,7 +431,7 @@ subroutine psb_lzlzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k integer(psb_lpk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ integer(psb_mpk_) :: ictxt,np,me - integer(psb_mpk_) :: icomm, minfo, ndx + integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_lpk_), allocatable :: lnzbr(:) integer(psb_ipk_) :: ierr(5) @@ -406,7 +459,13 @@ subroutine psb_lzlzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k else keeploc_ = .true. end if - call globa%free() + if (present(root)) then + root_ = root + else + root_ = -1 + end if + + if ((root_ == -1).or.(root_ == me)) call globa%free() if (keepnum_) then nrg = desc_a%get_global_rows() @@ -444,25 +503,43 @@ subroutine psb_lzlzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k call psb_errpush(info,name); goto 9999 end if #endif - if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) + if ((root_ == -1).or.(root_ == me)) then + if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) + else + if (info == psb_success_) call glob_coo%allocate(1_psb_lpk_,1_psb_lpk_,1_psb_lpk_) + end if if (info /= psb_success_) goto 9999 do ip=1,np idisp(ip) = sum(nzbr(1:ip-1)) enddo - ndx = nzbr(me+1) - call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_c_dpk_,& - & glob_coo%val,nzbr,idisp,& - & psb_mpi_c_dpk_,icomm,minfo) - if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& - & glob_coo%ia,nzbr,idisp,& - & psb_mpi_lpk_,icomm,minfo) - if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& - & glob_coo%ja,nzbr,idisp,& - & psb_mpi_lpk_,icomm,minfo) - + ndx = nzbr(me+1) + + if (root_ == -1) then + call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_c_dpk_,& + & glob_coo%val,nzbr,idisp,& + & psb_mpi_c_dpk_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & glob_coo%ia,nzbr,idisp,& + & psb_mpi_lpk_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & glob_coo%ja,nzbr,idisp,& + & psb_mpi_lpk_,icomm,minfo) + else + call mpi_gatherv(loc_coo%val,ndx,psb_mpi_c_dpk_,& + & glob_coo%val,nzbr,idisp,& + & psb_mpi_c_dpk_,root_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_gatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & glob_coo%ia,nzbr,idisp,& + & psb_mpi_lpk_,root_,icomm,minfo) + if (minfo == psb_success_) call & + & mpi_gatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & glob_coo%ja,nzbr,idisp,& + & psb_mpi_lpk_,root_,icomm,minfo) + end if if (minfo /= psb_success_) then info = minfo call psb_errpush(psb_err_internal_error_,name,a_err=' from mpi_allgatherv') @@ -470,9 +547,11 @@ subroutine psb_lzlzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k end if call loc_coo%free() ! - call glob_coo%set_nzeros(nzg) - if (present(dupl)) call glob_coo%set_dupl(dupl) - call globa%mv_from(glob_coo) + if ((root_ == -1).or.(root_ == me)) then + call glob_coo%set_nzeros(nzg) + if (present(dupl)) call glob_coo%set_dupl(dupl) + call globa%mv_from(glob_coo) + end if else write(psb_err_unit,*) 'SP_ALLGATHER: Not implemented yet with keepnum ',keepnum_ diff --git a/base/internals/psi_a2a_fnd_owner.F90 b/base/internals/psi_a2a_fnd_owner.F90 index 52e8b0ae9..b9cd9bb25 100644 --- a/base/internals/psi_a2a_fnd_owner.F90 +++ b/base/internals/psi_a2a_fnd_owner.F90 @@ -47,7 +47,7 @@ ! so it goes for an all-to-all by building an auxiliary neighbours list and ! reusing the neighbour version. ! -subroutine psi_a2a_fnd_owner(idx,iprc,idxmap,info) +subroutine psi_a2a_fnd_owner(idx,iprc,idxmap,info,samesize) use psb_serial_mod use psb_const_mod use psb_error_mod @@ -66,15 +66,22 @@ subroutine psi_a2a_fnd_owner(idx,iprc,idxmap,info) integer(psb_ipk_), allocatable, intent(out) :: iprc(:) class(psb_indx_map), intent(in) :: idxmap integer(psb_ipk_), intent(out) :: info + logical, intent(in), optional :: samesize integer(psb_ipk_), allocatable :: tmpadj(:) - integer(psb_mpk_) :: icomm, minfo, iictxt - integer(psb_ipk_) :: i,n_row,n_col,err_act,nv + integer(psb_lpk_), allocatable :: rmtidx(:) + integer(psb_ipk_), allocatable :: tproc(:), lclidx(:) + integer(psb_mpk_), allocatable :: hsz(:),hidx(:), sdidx(:), rvidx(:),& + & sdsz(:), rvsz(:), sdhd(:), rvhd(:), p2pstat(:,:) + integer(psb_mpk_) :: icomm, minfo, iictxt,nv + integer(psb_ipk_) :: i,n_row,n_col,err_act,gsz integer(psb_lpk_) :: mglob, ih integer(psb_ipk_) :: ictxt,np,me, nresp - real(psb_dpk_) :: t0, t1, t2, t3, t4, tamx, tidx - character(len=20) :: name + logical, parameter :: use_psi_adj=.true. + real(psb_dpk_) :: t0, t1, t2, t3, t4, tamx, tidx + character(len=20) :: name + logical :: samesize_ info = psb_success_ name = 'psi_a2a_fnd_owner' @@ -100,15 +107,95 @@ subroutine psi_a2a_fnd_owner(idx,iprc,idxmap,info) goto 9999 end if - ! - ! Reuse the adjcncy version by tricking it with an adjcncy list - ! that contains everybody but ME. - ! + if (present(samesize)) then + samesize_ = samesize + else + samesize_ = .false. + end if nv = size(idx) - call psb_realloc(np-1,tmpadj,info) - tmpadj(1:me) = [(i,i=0,me-1)] - tmpadj(me+1:np-1) = [(i,i=me+1,np-1)] - call psi_adjcncy_fnd_owner(idx,iprc,tmpadj,idxmap,info) + ! write(0,*) me,name,' :',use_psi_adj,samesize_,nv + if (use_psi_adj) then + ! + ! Reuse the adjcncy version by tricking it with an adjcncy list + ! that contains everybody but ME. + ! + call psb_realloc(np-1,tmpadj,info) + tmpadj(1:me) = [(i,i=0,me-1)] + tmpadj(me+1:np-1) = [(i,i=me+1,np-1)] + call psi_adjcncy_fnd_owner(idx,iprc,tmpadj,idxmap,info) + + else + if (samesize_) then + ! + ! Variant when IDX is guaranteed to have the same size on all + ! processes. To be tested for performance: is it worth it? + ! Probably yes. + ! + gsz = nv*np + Allocate(rmtidx(gsz),lclidx(gsz),iprc(nv),stat=info) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate') + goto 9999 + end if + call mpi_allgather(idx,nv,psb_mpi_lpk_,rmtidx,nv,psb_mpi_lpk_,icomm,minfo) + call idxmap%g2l(rmtidx(1:gsz),lclidx(1:gsz),info,owned=.true.) + ! + ! Reuse lclidx to encode owning process + ! + do i=1, gsz + if ((1<=lclidx(i)).and.(lclidx(i)<=n_row)) then + lclidx(i) = me + else + lclidx(i) = -1 + end if + end do + call mpi_reduce_scatter_block(lclidx,iprc,nv,psb_mpi_ipk_,mpi_max,icomm,minfo) + + else + ! + ! 1. allgetherv + ! 2. local conversion + ! 3. reduce_scatter + ! + ! + ! The basic idea is very simple. + ! First we collect (to all) all the requests. + Allocate(hidx(np+1),hsz(np),stat=info) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate') + goto 9999 + end if + + call mpi_allgather(nv,1,psb_mpi_mpk_,hsz,1,psb_mpi_mpk_,icomm,minfo) + hidx(1) = 0 + do i=1, np + hidx(i+1) = hidx(i) + hsz(i) + end do + gsz = hidx(np+1) + Allocate(rmtidx(gsz),lclidx(gsz),iprc(nv),stat=info) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate') + goto 9999 + end if + + call mpi_allgatherv(idx,hsz(me+1),psb_mpi_lpk_,& + & rmtidx,hsz,hidx,psb_mpi_lpk_,& + & icomm,minfo) + + call idxmap%g2l(rmtidx(1:gsz),lclidx(1:gsz),info,owned=.true.) + ! + ! Reuse lclidx to encode owning process + ! + do i=1, gsz + if ((1<=lclidx(i)).and.(lclidx(i)<=n_row)) then + lclidx(i) = me + else + lclidx(i) = -1 + end if + end do + call mpi_reduce_scatter(lclidx,iprc,hsz,psb_mpi_ipk_,mpi_max,icomm,minfo) + end if + end if call psb_erractionrestore(err_act) return diff --git a/base/internals/psi_adjcncy_fnd_owner.F90 b/base/internals/psi_adjcncy_fnd_owner.F90 index ed2445544..f26bb38fa 100644 --- a/base/internals/psi_adjcncy_fnd_owner.F90 +++ b/base/internals/psi_adjcncy_fnd_owner.F90 @@ -59,6 +59,7 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info) use psb_error_mod use psb_penv_mod use psb_realloc_mod + use psb_timers_mod use psb_indx_map_mod, psb_protect_name => psi_adjcncy_fnd_owner #ifdef MPI_MOD use mpi @@ -85,10 +86,11 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info) & last_ih, last_j, nidx, nrecv, nadj integer(psb_lpk_) :: mglob, ih integer(psb_ipk_) :: ictxt,np,me - logical, parameter :: gettime=.false., debug=.false. - logical, parameter :: a2av_impl=.true. - logical, parameter :: mpi_irecv_impl=.false. - logical, parameter :: psb_rcv_impl=.false. + logical, parameter :: gettime=.true., debug=.false. + integer(psb_mpk_) :: xchg_alg + logical, parameter :: do_timings=.false. + integer(psb_ipk_), save :: idx_phase1=-1, idx_phase2=-1, idx_phase3=-1 + integer(psb_ipk_), save :: idx_phase11=-1, idx_phase12=-1, idx_phase13=-1 real(psb_dpk_) :: t0, t1, t2, t3, t4, tamx, tidx character(len=20) :: name @@ -102,6 +104,19 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info) n_row = idxmap%get_lr() n_col = idxmap%get_lc() iictxt = ictxt + if ((do_timings).and.(idx_phase1==-1)) & + & idx_phase1 = psb_get_timer_idx("ADJ_FND_OWN: phase1 ") + if ((do_timings).and.(idx_phase2==-1)) & + & idx_phase2 = psb_get_timer_idx("ADJ_FND_OWN: phase2") + if ((do_timings).and.(idx_phase3==-1)) & + & idx_phase3 = psb_get_timer_idx("ADJ_FND_OWN: phase3") + if ((do_timings).and.(idx_phase11==-1)) & + & idx_phase11 = psb_get_timer_idx("ADJ_FND_OWN: phase11 ") + if ((do_timings).and.(idx_phase12==-1)) & + & idx_phase12 = psb_get_timer_idx("ADJ_FND_OWN: phase12") + if ((do_timings).and.(idx_phase13==-1)) & + & idx_phase13 = psb_get_timer_idx("ADJ_FND_OWN: phase13") + call psb_info(ictxt, me, np) @@ -129,8 +144,11 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info) end if iprc = -1 ! write(0,*) me,name,' Going through ',nidx,nadj + xchg_alg = psi_get_adj_alg() + select case(xchg_alg) + case(psi_adj_fnd_a2av_) + if (do_timings) call psb_tic(idx_phase1) - if (a2av_impl) then ! ! First simple minded version with auxiliary arrays ! dimensioned on NP. @@ -146,6 +164,7 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info) ! ! First, send sizes according to adjcncy list ! + if (do_timings) call psb_tic(idx_phase11) sdsz = 0 do j=1, nadj sdsz(adj(j)) = nidx @@ -154,15 +173,20 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info) call mpi_alltoall(sdsz,1,psb_mpi_mpk_,& & rvsz,1,psb_mpi_mpk_,icomm,minfo) + if (do_timings) call psb_toc(idx_phase11) + if (do_timings) call psb_tic(idx_phase12) rvidx(0) = 0 do i=0, np-1 rvidx(i+1) = rvidx(i) + rvsz(i) end do hsize = rvidx(np) + ! write(0,*)me,' Check on sizes from a2a:',hsize,rvsz(:) ! ! Second, allocate buffers and exchange data ! + if (do_timings) call psb_toc(idx_phase12) + if (do_timings) call psb_tic(idx_phase13) Allocate(rmtidx(hsize),lclidx(max(hsize,nidx*nadj)),& & tproc(max(hsize,nidx)),stat=info) @@ -173,7 +197,9 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info) call mpi_alltoallv(idx,sdsz,sdidx,psb_mpi_lpk_,& & rmtidx,rvsz,rvidx,psb_mpi_lpk_,icomm,iret) - + if (do_timings) call psb_toc(idx_phase13) + if (do_timings) call psb_toc(idx_phase1) + if (do_timings) call psb_tic(idx_phase2) ! ! Third, compute local answers ! @@ -182,6 +208,8 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info) tproc(i) = -1 if ((0 < lclidx(i)).and. (lclidx(i) <= n_row)) tproc(i) = me end do + if (do_timings) call psb_toc(idx_phase2) + if (do_timings) call psb_tic(idx_phase3) ! ! Fourth, exchange the answers @@ -203,10 +231,13 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info) iprc(1:nidx) = max(iprc(1:nidx), lclidx(sdidx(i)+1:sdidx(i)+sdsz(i))) end if end do + if (do_timings) call psb_toc(idx_phase3) if (debug) write(0,*) me,' End of adjcncy_fnd ',iprc(1:nidx) - else if (mpi_irecv_impl) then + case(psi_adj_fnd_irecv_) + + if (do_timings) call psb_tic(idx_phase1) ! ! First simple minded version with auxiliary arrays ! dimensioned on NP. @@ -216,6 +247,7 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info) Allocate(hidx(0:np),hsz(np),sdsz(0:np-1),rvsz(0:np-1),& & sdhd(0:np-1), rvhd(0:np-1), p2pstat(mpi_status_size,0:np-1),& & stat=info) + if (do_timings) call psb_tic(idx_phase11) sdhd(:) = mpi_request_null rvhd(:) = mpi_request_null ! @@ -255,6 +287,8 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info) & p2ptag, icomm,rvhd(i),iret) end if end do + if (do_timings) call psb_toc(idx_phase11) + if (do_timings) call psb_tic(idx_phase12) do j=1, nadj if (nidx > 0) then prc = psb_get_mpi_rank(ictxt,adj(j)) @@ -265,7 +299,12 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info) & p2ptag, icomm,iret) end if end do + if (do_timings) call psb_toc(idx_phase12) + if (do_timings) call psb_tic(idx_phase13) call mpi_waitall(np,rvhd,p2pstat,iret) + if (do_timings) call psb_toc(idx_phase13) + if (do_timings) call psb_toc(idx_phase1) + if (do_timings) call psb_tic(idx_phase2) ! ! Third, compute local answers @@ -275,6 +314,8 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info) tproc(i) = -1 if ((0 < lclidx(i)).and. (lclidx(i) <= n_row)) tproc(i) = me end do + if (do_timings) call psb_toc(idx_phase2) + if (do_timings) call psb_tic(idx_phase3) ! ! At this point we can reuse lclidx to receive messages ! @@ -312,9 +353,10 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info) do j = 1, nadj iprc(1:nidx) = max(iprc(1:nidx), lclidx((j-1)*nidx+1:(j-1)*nidx+nidx)) end do + if (do_timings) call psb_toc(idx_phase3) if (debug) write(0,*) me,' End of adjcncy_fnd ',iprc(1:nidx) - else if (psb_rcv_impl) then + case(psi_adj_fnd_pbrcv_) Allocate(hidx(0:np),hsz(np),& & sdsz(0:np-1),rvsz(0:np-1),stat=info) @@ -382,11 +424,11 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info) if (nidx > 0) call psb_rcv(ictxt,tproc(1:nidx),adj(j)) iprc(1:nidx) = max(iprc(1:nidx), tproc(1:nidx)) end do - else + case default info = psb_err_internal_error_ call psb_errpush(info,name,a_err='invalid exchange alg choice') goto 9999 - end if + end select call psb_erractionrestore(err_act) return diff --git a/base/internals/psi_crea_index.f90 b/base/internals/psi_crea_index.f90 index ec7838990..126d54e2e 100644 --- a/base/internals/psi_crea_index.f90 +++ b/base/internals/psi_crea_index.f90 @@ -54,6 +54,7 @@ subroutine psi_i_crea_index(desc_a,index_in,index_out,nxch,nsnd,nrcv,info) use psb_desc_mod use psb_error_mod use psb_penv_mod + use psb_timers_mod use psi_mod, psb_protect_name => psi_i_crea_index implicit none @@ -69,6 +70,9 @@ subroutine psi_i_crea_index(desc_a,index_in,index_out,nxch,nsnd,nrcv,info) integer(psb_ipk_),parameter :: root=psb_root_,no_comm=-1 integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name + logical, parameter :: do_timings=.false. + integer(psb_ipk_), save :: idx_phase1=-1, idx_phase2=-1, idx_phase3=-1 + integer(psb_ipk_), save :: idx_phase11=-1, idx_phase12=-1, idx_phase13=-1 info = psb_success_ name='psi_crea_index' @@ -84,12 +88,26 @@ subroutine psi_i_crea_index(desc_a,index_in,index_out,nxch,nsnd,nrcv,info) call psb_errpush(info,name) goto 9999 endif + if ((do_timings).and.(idx_phase1==-1)) & + & idx_phase1 = psb_get_timer_idx("PSI_CREA_INDEX: phase1 ") + if ((do_timings).and.(idx_phase2==-1)) & + & idx_phase2 = psb_get_timer_idx("PSI_CREA_INDEX: phase2") + if ((do_timings).and.(idx_phase3==-1)) & + & idx_phase3 = psb_get_timer_idx("PSI_CREA_INDEX: phase3") +!!$ if ((do_timings).and.(idx_phase11==-1)) & +!!$ & idx_phase11 = psb_get_timer_idx("PSI_CREA_INDEX: phase11 ") +!!$ if ((do_timings).and.(idx_phase12==-1)) & +!!$ & idx_phase12 = psb_get_timer_idx("PSI_CREA_INDEX: phase12") +!!$ if ((do_timings).and.(idx_phase13==-1)) & +!!$ & idx_phase13 = psb_get_timer_idx("PSI_CREA_INDEX: phase13") + ! ...extract dependence list (ordered list of identifer process ! which every process must communcate with... if (debug_level >= psb_debug_inner_) & & write(debug_unit,*) me,' ',trim(name),': calling extract_dep_list' mode = 1 + if (do_timings) call psb_tic(idx_phase1) call psi_extract_dep_list(ictxt,& & desc_a%is_bld(), desc_a%is_upd(),& @@ -105,6 +123,8 @@ subroutine psi_i_crea_index(desc_a,index_in,index_out,nxch,nsnd,nrcv,info) ! ...now process root contains dependence list of all processes... if (debug_level >= psb_debug_inner_) & & write(debug_unit,*) me,' ',trim(name),': root sorting dep list' + if (do_timings) call psb_toc(idx_phase1) + if (do_timings) call psb_tic(idx_phase2) call psi_dl_check(dep_list,dl_lda,np,length_dl) @@ -114,6 +134,8 @@ subroutine psi_i_crea_index(desc_a,index_in,index_out,nxch,nsnd,nrcv,info) call psb_errpush(psb_err_from_subroutine_,name,a_err='psi_sort_dl') goto 9999 end if + if (do_timings) call psb_toc(idx_phase2) + if (do_timings) call psb_tic(idx_phase3) if(debug_level >= psb_debug_inner_)& & write(debug_unit,*) me,' ',trim(name),': calling psi_desc_index' @@ -128,6 +150,7 @@ subroutine psi_i_crea_index(desc_a,index_in,index_out,nxch,nsnd,nrcv,info) call psb_errpush(psb_err_from_subroutine_,name,a_err='psi_desc_index') goto 9999 end if + if (do_timings) call psb_toc(idx_phase3) deallocate(dep_list,length_dl) if(debug_level >= psb_debug_inner_) & diff --git a/base/internals/psi_desc_impl.f90 b/base/internals/psi_desc_impl.f90 index b552a8ad4..43eae7bbb 100644 --- a/base/internals/psi_desc_impl.f90 +++ b/base/internals/psi_desc_impl.f90 @@ -63,6 +63,7 @@ end subroutine psi_renum_index subroutine psi_i_cnv_dsc(halo_in,ovrlap_in,ext_in,cdesc, info, mold) use psi_mod, psi_protect_name => psi_i_cnv_dsc + use psb_timers_mod use psb_realloc_mod implicit none @@ -82,6 +83,9 @@ subroutine psi_i_cnv_dsc(halo_in,ovrlap_in,ext_in,cdesc, info, mold) integer(psb_ipk_) :: debug_level, debug_unit logical, parameter :: debug=.false. character(len=20) :: name + logical, parameter :: do_timings=.false. + integer(psb_ipk_), save :: idx_phase1=-1, idx_phase2=-1, idx_phase3=-1 + integer(psb_ipk_), save :: idx_phase11=-1, idx_phase12=-1, idx_phase13=-1 name='psi_cnv_desc' call psb_get_erraction(err_act) @@ -97,8 +101,23 @@ subroutine psi_i_cnv_dsc(halo_in,ovrlap_in,ext_in,cdesc, info, mold) call psb_errpush(info,name) goto 9999 endif + if ((do_timings).and.(idx_phase1==-1)) & + & idx_phase1 = psb_get_timer_idx("PSI_CNV_DSC: phase1 ") + if ((do_timings).and.(idx_phase2==-1)) & + & idx_phase2 = psb_get_timer_idx("PSI_CNV_DSC: phase2") + if ((do_timings).and.(idx_phase3==-1)) & + & idx_phase3 = psb_get_timer_idx("PSI_CNV_DSC: phase3") + if ((do_timings).and.(idx_phase11==-1)) & + & idx_phase11 = psb_get_timer_idx("PSI_CNV_DSC: phase11 ") + if ((do_timings).and.(idx_phase12==-1)) & + & idx_phase12 = psb_get_timer_idx("PSI_CNV_DSC: phase12") + if ((do_timings).and.(idx_phase13==-1)) & + & idx_phase13 = psb_get_timer_idx("PSI_CNV_DSC: phase13") + if (do_timings) call psb_tic(idx_phase1) + if (do_timings) call psb_tic(idx_phase11) + ! first the halo index if (debug_level>0) write(debug_unit,*) me,'Calling crea_index on halo',& & size(halo_in) @@ -111,6 +130,8 @@ subroutine psi_i_cnv_dsc(halo_in,ovrlap_in,ext_in,cdesc, info, mold) 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' + if (do_timings) call psb_toc(idx_phase11) + if (do_timings) call psb_tic(idx_phase12) ! then ext index @@ -124,6 +145,8 @@ subroutine psi_i_cnv_dsc(halo_in,ovrlap_in,ext_in,cdesc, info, mold) 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' + if (do_timings) call psb_toc(idx_phase12) + if (do_timings) call psb_tic(idx_phase13) ! then the overlap index call psi_crea_index(cdesc,ovrlap_in, idx_out,nxch,nsnd,nrcv,info) @@ -136,6 +159,9 @@ subroutine psi_i_cnv_dsc(halo_in,ovrlap_in,ext_in,cdesc, info, mold) call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_move_alloc') goto 9999 end if + if (do_timings) call psb_toc(idx_phase13) + if (do_timings) call psb_toc(idx_phase1) + if (do_timings) call psb_tic(idx_phase2) ! next ovrlap_elem @@ -161,6 +187,8 @@ subroutine psi_i_cnv_dsc(halo_in,ovrlap_in,ext_in,cdesc, info, mold) call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_move_alloc') goto 9999 end if + if (do_timings) call psb_toc(idx_phase2) + if (do_timings) call psb_tic(idx_phase3) ! finally bnd_elem call psi_crea_bnd_elem(idx_out,cdesc,info) @@ -177,7 +205,8 @@ subroutine psi_i_cnv_dsc(halo_in,ovrlap_in,ext_in,cdesc, info, mold) goto 9999 end if if (debug_level>0) write(debug_unit,*) me,'Done crea_bnd_elem' - + if (do_timings) call psb_toc(idx_phase3) + call psb_erractionrestore(err_act) return diff --git a/base/internals/psi_desc_index.F90 b/base/internals/psi_desc_index.F90 index 7f36c6ea5..f23662f16 100644 --- a/base/internals/psi_desc_index.F90 +++ b/base/internals/psi_desc_index.F90 @@ -128,11 +128,15 @@ subroutine psi_i_desc_index(desc,index_in,dep_list,& integer(psb_mpk_),allocatable :: brvindx(:),rvsz(:),& & bsdindx(:),sdsz(:) + integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size),& + & iret, sz + integer(psb_mpk_), allocatable :: prcid(:), rvhd(:) + integer(psb_ipk_) :: ihinsz,ntot,k,err_act,nidx,& - & idxr, idxs, iszs, iszr, nesd, nerv + & idxr, idxs, iszs, iszr, nesd, nerv, ixp, idx integer(psb_mpk_) :: icomm, minfo - logical,parameter :: usempi=.true. + logical, parameter :: usempi=.false. integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -255,12 +259,12 @@ subroutine psi_i_desc_index(desc,index_in,dep_list,& call desc%indxmap%l2g(index_in(i+1:i+nerv),& & sndbuf(bsdindx(proc+1)+1:bsdindx(proc+1)+nerv),& & info) - + if (info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='l2g') goto 9999 end if - + bsdindx(proc+1) = bsdindx(proc+1) + nerv i = i + nerv + 1 end do @@ -282,11 +286,76 @@ subroutine psi_i_desc_index(desc,index_in,dep_list,& idxr = idxr + rvsz(proc+1) end do - call mpi_alltoallv(sndbuf,sdsz,bsdindx,psb_mpi_lpk_,& - & rcvbuf,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='mpi_alltoallv') - goto 9999 + if (usempi) then + call mpi_alltoallv(sndbuf,sdsz,bsdindx,psb_mpi_lpk_,& + & rcvbuf,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='mpi_alltoallv') + goto 9999 + end if + else + if (.true.) then + allocate(prcid(length_dl),rvhd(length_dl)) + prcid = -1 + ixp = 1 + do i=1, length_dl + proc = dep_list(i) + prcid(ixp) = psb_get_mpi_rank(ictxt,proc) + sz = rvsz(proc+1) + if (sz > 0) then + p2ptag = psb_long_tag + idx = brvindx(proc+1) + call mpi_irecv(rcvbuf(idx+1:idx+sz),sz,& + & psb_mpi_lpk_, prcid(ixp), p2ptag, icomm,& + & rvhd(ixp),iret) + end if + ixp = ixp + 1 + end do + ixp = 1 + do i=1, length_dl + proc = dep_list(i) + prcid(ixp) = psb_get_mpi_rank(ictxt,proc) + sz = sdsz(proc+1) + if (sz > 0) then + p2ptag = psb_long_tag + idx = bsdindx(proc+1) + call mpi_send(sndbuf(idx+1:idx+sz),sz,& + & psb_mpi_lpk_, prcid(ixp), p2ptag, & + & icomm,iret) + end if + ixp = ixp + 1 + end do + ixp = 1 + do i=1, length_dl + proc = dep_list(i) + prcid(ixp) = psb_get_mpi_rank(ictxt,proc) + sz = rvsz(proc+1) + if (sz > 0) then + call mpi_wait(rvhd(ixp),p2pstat,iret) + end if + ixp = ixp + 1 + end do + else + + do i=1, length_dl + proc = dep_list(i) + sz = sdsz(proc+1) + idx = bsdindx(proc+1) + if (sz > 0) then + call psb_snd(ictxt,sndbuf(idx+1:idx+sz), proc) + end if + end do + + do i=1, length_dl + proc = dep_list(i) + sz = rvsz(proc+1) + idx = brvindx(proc+1) + if (sz > 0) then + call psb_rcv(ictxt,rcvbuf(idx+1:idx+sz),proc) + end if + end do + + end if end if ! @@ -327,7 +396,7 @@ subroutine psi_i_desc_index(desc,index_in,dep_list,& return 9999 call psb_error_handler(ictxt,err_act) - + return end subroutine psi_i_desc_index diff --git a/base/internals/psi_dl_check.f90 b/base/internals/psi_dl_check.f90 index 8b12f0239..bf25976bc 100644 --- a/base/internals/psi_dl_check.f90 +++ b/base/internals/psi_dl_check.f90 @@ -79,7 +79,7 @@ subroutine psi_i_dl_check(dep_list,dl_lda,np,length_dl) ! ...add proc to proc2 s dep_list.....',proc,proc2 length_dl(proc2) = length_dl(proc2)+1 if (length_dl(proc2) > size(dep_list,1)) then - write(psb_err_unit,*)'error in crea_halo', proc2,proc,& + write(psb_err_unit,*)'error in dl_check', proc2,proc,& & length_dl(proc2),'>',size(dep_list,1) endif dep_list(length_dl(proc2),proc2) = proc diff --git a/base/internals/psi_graph_fnd_owner.F90 b/base/internals/psi_graph_fnd_owner.F90 index 7e69c1ef9..b951945e5 100644 --- a/base/internals/psi_graph_fnd_owner.F90 +++ b/base/internals/psi_graph_fnd_owner.F90 @@ -101,13 +101,13 @@ subroutine psi_graph_fnd_owner(idx,iprc,idxmap,info) integer(psb_ipk_), allocatable :: tprc(:), tsmpl(:), ladj(:) integer(psb_mpk_) :: icomm, minfo, iictxt integer(psb_ipk_) :: i,n_row,n_col,err_act,ip,j,ipnt, nsampl_out,& - & nv, n_answers, n_rest, nsampl_in, locr_max, & - & nrest_max, nadj, maxspace, mxnsin + & nv, n_answers, nreqst, nsampl_in, locr_max, & + & nreqst_max, nadj, maxspace, mxnsin integer(psb_lpk_) :: mglob, ih integer(psb_ipk_) :: ictxt,np,me, nresp integer(psb_ipk_), parameter :: nt=4 integer(psb_ipk_) :: tmpv(4) - logical, parameter :: do_timings=.false., trace=.false. + logical, parameter :: do_timings=.false., trace=.false., debugsz=.false. integer(psb_ipk_), save :: idx_sweep0=-1, idx_loop_a2a=-1, idx_loop_neigh=-1 real(psb_dpk_) :: t0, t1, t2, t3, t4 character(len=20) :: name @@ -162,20 +162,25 @@ subroutine psi_graph_fnd_owner(idx,iprc,idxmap,info) ! call psb_safe_ab_cpy(idxmap%p_adjcncy,ladj,info) nadj = psb_size(ladj) - ! This makes ladj allocated with size 0 just in case + ! This makes ladj allocated with size 0 if needed, as opposed to unallocated call psb_realloc(nadj,ladj,info) - n_rest = nv - n_answers - nrest_max = n_rest + ! + ! Throughout the subroutine, nreqst is the number of local inquiries + ! that have not been answered yet + ! + nreqst = nv - n_answers + nreqst_max = nreqst ! ! Choice of maxspace should be adjusted to account for a default ! "sensible" size and/or a user-specified value ! tmpv(1) = nadj - tmpv(2) = nrest_max + tmpv(2) = nreqst_max tmpv(3) = n_row tmpv(4) = psb_cd_get_maxspace() call psb_max(ictxt,tmpv) + nreqst_max = tmpv(2) locr_max = tmpv(3) maxspace = nt*locr_max if (tmpv(4) > 0) maxspace = min(maxspace,tmpv(4)) @@ -187,18 +192,21 @@ subroutine psi_graph_fnd_owner(idx,iprc,idxmap,info) ! Do a preliminary run on the user-defined adjacency lists ! if (trace.and.(me == 0)) write(0,*) ' Initial sweep on user-defined topology' - nsampl_in = min(n_rest,max(1,(maxspace+max(1,nadj)-1))/(max(1,nadj))) + if (debugsz) write(0,*) me,' Initial sweep on user-defined topology',nreqst + nsampl_in = min(nreqst,max(1,(maxspace+max(1,nadj)-1))/(max(1,nadj))) call psi_adj_fnd_sweep(idx,iprc,ladj,idxmap,nsampl_in,n_answers) call idxmap%xtnd_p_adjcncy(ladj) - n_rest = nv - n_answers - nrest_max = n_rest - call psb_max(ictxt,nrest_max) - if (trace.and.(me == 0)) write(0,*) ' After initial sweep:',nrest_max + nreqst = nv - n_answers + nreqst_max = nreqst + call psb_max(ictxt,nreqst_max) + if (trace.and.(me == 0)) write(0,*) ' After initial sweep:',nreqst_max + if (debugsz) write(0,*) me,' After sweep on user-defined topology',nreqst_max end if if (do_timings) call psb_toc(idx_sweep0) - fnd_owner_loop: do while (nrest_max>0) - if (do_timings) call psb_tic(idx_loop_a2a) + fnd_owner_loop: do while (nreqst_max>0) + if (do_timings) call psb_tic(idx_loop_a2a) + if (debugsz) write(0,*) me,' fnd_owner_loop',nreqst_max ! ! The basic idea of this loop is to alternate between ! searching through all processes and searching @@ -207,28 +215,34 @@ subroutine psi_graph_fnd_owner(idx,iprc,idxmap,info) ! 1. Select a sample such that the total size is <= maxspace ! sample query is then sent to all processes ! - ! if (trace.and.(me == 0)) write(0,*) 'Looping in graph_fnd_owner: ', nrest_max - nsampl_in = min(n_rest,max(1,(maxspace+np-1)/np)) + ! if (trace.and.(me == 0)) write(0,*) 'Looping in graph_fnd_owner: ', nreqst_max + nsampl_in = psb_cd_get_samplesize() + nsampl_in = min(max(1,(maxspace+np-1)/np),nsampl_in) ! ! Choose a sample, should it be done in this simplistic way? ! Note: nsampl_in is a hint, not an absolute, hence nsampl_out ! ipnt = 1 -!!$ write(0,*) me,' Into first sampling ',nsampl_in - call psi_get_sample(ipnt, idx,iprc,tidx,tsmpl,nsampl_in,nsampl_out) + call psi_get_sample(ipnt, idx,iprc,tidx,tsmpl,nsampl_in,nsampl_out, pad=.true.) nsampl_in = min(nsampl_out,nsampl_in) -!!$ write(0,*) me,' From first sampling ',nsampl_in + if (debugsz) write(0,*) me,' From first sampling ',nsampl_in ! ! 2. Do a search on all processes; this is supposed to find ! the owning process for all inputs; ! - call psi_a2a_fnd_owner(tidx(1:nsampl_in),tprc,idxmap,info) + call psi_a2a_fnd_owner(tidx(1:nsampl_in),tprc,idxmap,info, samesize=.true.) + if (debugsz) write(0,*) me,' From a2a_fnd_owner ',info + ! + ! We might have padded when looking for owners, so the actual samples + ! could be less than they appear. Should be explained better. + ! + nsampl_in = min(nreqst,nsampl_in) call psi_cpy_out(iprc,tprc,tsmpl,nsampl_in,nsampl_out) if (nsampl_out /= nsampl_in) then write(0,*) me,'Warning: indices not found by a2a_fnd_owner ',nsampl_out,nsampl_in end if n_answers = n_answers + nsampl_out - n_rest = nv - n_answers + nreqst = nv - n_answers ! ! 3. Extract the resulting adjacency list and add it to the ! indxmap; @@ -245,18 +259,18 @@ subroutine psi_graph_fnd_owner(idx,iprc,idxmap,info) ! Need to set up a proper loop here to have a complete ! sweep over the input vector. Done inside adj_fnd_sweep. ! -!!$ write(0,*) me,' After a2a ',n_rest - nsampl_in = min(n_rest,max(1,(maxspace+max(1,nadj)-1))/(max(1,nadj))) +!!$ write(0,*) me,' After a2a ',nreqst + nsampl_in = min(nreqst,max(1,(maxspace+max(1,nadj)-1))/(max(1,nadj))) mxnsin = nsampl_in call psb_max(ictxt,mxnsin) !!$ write(0,*) me, ' mxnsin ',mxnsin if (mxnsin>0) call psi_adj_fnd_sweep(idx,iprc,ladj,idxmap,nsampl_in,n_answers) call idxmap%xtnd_p_adjcncy(ladj) - n_rest = nv - n_answers - nrest_max = n_rest - call psb_max(ictxt,nrest_max) - if (trace.and.(me == 0)) write(0,*) ' fnd_owner_loop remaining:',nrest_max + nreqst = nv - n_answers + nreqst_max = nreqst + call psb_max(ictxt,nreqst_max) + if (trace.and.(me == 0)) write(0,*) ' fnd_owner_loop remaining:',nreqst_max if (do_timings) call psb_toc(idx_loop_neigh) end do fnd_owner_loop @@ -269,16 +283,23 @@ subroutine psi_graph_fnd_owner(idx,iprc,idxmap,info) contains - subroutine psi_get_sample(ipntidx,idx,iprc,tidx,tsmpl,ns_in,ns_out) + subroutine psi_get_sample(ipntidx,idx,iprc,tidx,tsmpl,ns_in,ns_out,pad) implicit none integer(psb_ipk_), intent(inout) :: ipntidx integer(psb_lpk_), intent(in) :: idx(:) integer(psb_ipk_), intent(in) :: ns_in, iprc(:) integer(psb_lpk_), intent(out) :: tidx(:) integer(psb_ipk_), intent(out) :: tsmpl(:), ns_out + logical, intent(in), optional :: pad ! - integer(psb_ipk_) :: nv, ns + integer(psb_ipk_) :: nv, ns, k + logical :: pad_ + if (present(pad)) then + pad_ = pad + else + pad_ = .false. + end if nv = size(idx) ! ! Choose a sample, should it be done in this simplistic way? @@ -287,9 +308,11 @@ contains ! ! ns_in == 0 means that on the outside we figure there's ! nothing left, but we are here because we have to synchronize. - ! Make sure we sweep through the entire vector immediately + ! Make sure we sweep through the entire vector immediately. + ! But also make sure we do not overrun tsmpl ! if (ns == 0) ns = nv + ns = min(ns,size(tsmpl)) ns_out = 0 do while (ipntidx<= nv) @@ -301,6 +324,13 @@ contains ipntidx = ipntidx + 1 if (ns_out >= ns) exit end do + if (pad_) then + do k = ns_out+1, ns + tsmpl(k) = -1 + tidx(k) = -1 + end do + ns_out = ns + end if end subroutine psi_get_sample diff --git a/base/internals/psi_indx_map_fnd_owner.F90 b/base/internals/psi_indx_map_fnd_owner.F90 index 0aee08065..e11ad0b28 100644 --- a/base/internals/psi_indx_map_fnd_owner.F90 +++ b/base/internals/psi_indx_map_fnd_owner.F90 @@ -74,7 +74,8 @@ subroutine psi_indx_map_fnd_owner(idx,iprc,idxmap,info) integer(psb_ipk_), allocatable :: hhidx(:) integer(psb_mpk_) :: icomm, minfo, iictxt - integer(psb_ipk_) :: i, err_act, hsize, nv + integer(psb_ipk_) :: i, err_act, hsize + integer(psb_lpk_) :: nv integer(psb_lpk_) :: mglob integer(psb_ipk_) :: ictxt,np,me, nresp logical, parameter :: gettime=.false. @@ -140,7 +141,66 @@ subroutine psi_indx_map_fnd_owner(idx,iprc,idxmap,info) else - call psi_graph_fnd_owner(idx,iprc,idxmap,info) + if (allocated(idxmap%halo_owner)) then + ! + ! Maybe we are coming here after a REINIT event. + ! In this case, reuse the existing information as much as possible. + ! + block + integer(psb_ipk_), allocatable :: tprc(:), lidx(:) + integer(psb_lpk_), allocatable :: tidx(:) + integer(psb_lpk_) :: k1, k2, nh + allocate(lidx(nv),stat=info) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate') + goto 9999 + end if + ! + ! Get local answers, if any + ! + call idxmap%g2l(idx,lidx,info,owned=.false.) + call idxmap%fnd_halo_owner(lidx,iprc,info) + + nh = count(iprc<0) + !write(0,*) me,'Going through new impl from ',nv,' to ',nh + allocate(tidx(nh),tprc(nh),stat=info) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate') + goto 9999 + end if + ! + ! Prepare remote queries + ! + k2 = 0 + do k1 = 1, nv + if (iprc(k1) < 0) then + k2 = k2 + 1 + if (k2 > nh) then + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='Wrong auxiliary count') + goto 9999 + end if + tidx(k2) = idx(k1) + end if + end do + call psi_graph_fnd_owner(tidx,tprc,idxmap,info) + k2 = 0 + do k1 = 1, nv + if (iprc(k1) < 0) then + k2 = k2 + 1 + if (k2 > nh) then + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='Wrong auxiliary count') + goto 9999 + end if + iprc(k1) = tprc(k2) + end if + end do + end block + else + call psi_graph_fnd_owner(idx,iprc,idxmap,info) + end if + end if diff --git a/base/modules/Makefile b/base/modules/Makefile index 21525a3c9..6c19b2479 100644 --- a/base/modules/Makefile +++ b/base/modules/Makefile @@ -153,9 +153,13 @@ penv/psi_collective_mod.o: penv/psi_e_collective_mod.o \ penv/psi_z_collective_mod.o penv/psi_m_p2p_mod.o penv/psi_e_p2p_mod.o penv/psi_s_p2p_mod.o \ -penv/psi_d_p2p_mod.o penv/psi_c_p2p_mod.o penv/psi_z_p2p_mod.o\ +penv/psi_d_p2p_mod.o penv/psi_c_p2p_mod.o penv/psi_z_p2p_mod.o: penv/psi_penv_mod.o + penv/psi_e_collective_mod.o penv/psi_m_collective_mod.o penv/psi_s_collective_mod.o \ -penv/psi_d_collective_mod.o penv/psi_c_collective_mod.o penv/psi_z_collective_mod.o: penv/psi_penv_mod.o +penv/psi_d_collective_mod.o penv/psi_c_collective_mod.o penv/psi_z_collective_mod.o: penv/psi_penv_mod.o \ + penv/psi_m_p2p_mod.o penv/psi_e_p2p_mod.o penv/psi_s_p2p_mod.o \ + penv/psi_d_p2p_mod.o penv/psi_c_p2p_mod.o penv/psi_z_p2p_mod.o + auxil/psb_string_mod.o desc/psb_desc_const_mod.o psi_comm_buffers_mod.o: psb_const_mod.o desc/psb_hash_mod.o: psb_realloc_mod.o psb_const_mod.o desc/psb_desc_const_mod.o diff --git a/base/modules/auxil/psb_i2_hsort_mod.f90 b/base/modules/auxil/psb_i2_hsort_mod.f90 new file mode 100644 index 000000000..0878f86e6 --- /dev/null +++ b/base/modules/auxil/psb_i2_hsort_mod.f90 @@ -0,0 +1,125 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! 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. +! +! +! +! Sorting routines +! References: +! D. Knuth +! The Art of Computer Programming, vol. 3 +! Addison-Wesley +! +! Aho, Hopcroft, Ullman +! Data Structures and Algorithms +! Addison-Wesley +! +module psb_i2_hsort_mod + use psb_const_mod + + interface psb_hsort + subroutine psb_i2hsort(x,ix,dir,flag) + import + integer(psb_i2pk_), intent(inout) :: x(:) + integer(psb_ipk_), optional, intent(in) :: dir, flag + integer(psb_ipk_), optional, intent(inout) :: ix(:) + end subroutine psb_i2hsort + end interface psb_hsort + + + interface psi_insert_heap + subroutine psi_i2_insert_heap(key,last,heap,dir,info) + import + implicit none + + ! + ! Input: + ! key: the new value + ! last: pointer to the last occupied element in heap + ! heap: the heap + ! dir: sorting direction + + integer(psb_i2pk_), intent(in) :: key + integer(psb_i2pk_), intent(inout) :: heap(:) + integer(psb_ipk_), intent(in) :: dir + integer(psb_ipk_), intent(inout) :: last + integer(psb_ipk_), intent(out) :: info + end subroutine psi_i2_insert_heap + end interface psi_insert_heap + + interface psi_idx_insert_heap + subroutine psi_i2_idx_insert_heap(key,index,last,heap,idxs,dir,info) + import + implicit none + + ! + ! Input: + ! key: the new value + ! last: pointer to the last occupied element in heap + ! heap: the heap + ! dir: sorting direction + + integer(psb_i2pk_), intent(in) :: key + integer(psb_i2pk_), intent(inout) :: heap(:) + integer(psb_ipk_), intent(in) :: index + integer(psb_ipk_), intent(in) :: dir + integer(psb_ipk_), intent(inout) :: idxs(:) + integer(psb_ipk_), intent(inout) :: last + integer(psb_ipk_), intent(out) :: info + end subroutine psi_i2_idx_insert_heap + end interface psi_idx_insert_heap + + + interface psi_heap_get_first + subroutine psi_i2_heap_get_first(key,last,heap,dir,info) + import + implicit none + integer(psb_i2pk_), intent(inout) :: key + integer(psb_ipk_), intent(inout) :: last + integer(psb_ipk_), intent(in) :: dir + integer(psb_i2pk_), intent(inout) :: heap(:) + integer(psb_ipk_), intent(out) :: info + end subroutine psi_i2_heap_get_first + end interface psi_heap_get_first + + interface psi_idx_heap_get_first + subroutine psi_i2_idx_heap_get_first(key,index,last,heap,idxs,dir,info) + import + integer(psb_i2pk_), intent(inout) :: key + integer(psb_ipk_), intent(out) :: index + integer(psb_i2pk_), intent(inout) :: heap(:) + integer(psb_ipk_), intent(in) :: dir + integer(psb_ipk_), intent(inout) :: last + integer(psb_ipk_), intent(inout) :: idxs(:) + integer(psb_ipk_), intent(out) :: info + end subroutine psi_i2_idx_heap_get_first + end interface psi_idx_heap_get_first + + +end module psb_i2_hsort_mod diff --git a/base/modules/auxil/psb_i2_ip_reord_mod.F90 b/base/modules/auxil/psb_i2_ip_reord_mod.F90 new file mode 100644 index 000000000..985b3cd42 --- /dev/null +++ b/base/modules/auxil/psb_i2_ip_reord_mod.F90 @@ -0,0 +1,320 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! 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. +! +! +! +! Reorder (an) input vector(s) based on a list sort output. +! Based on: D. E. Knuth: The Art of Computer Programming +! vol. 3: Sorting and Searching, Addison Wesley, 1973 +! ex. 5.2.12 +! +! +module psb_i2_ip_reord_mod + use psb_const_mod + + interface psb_ip_reord + module procedure psb_ip_reord_i21m,& + & psb_ip_reord_i21m1, psb_ip_reord_i21m2,& + & psb_ip_reord_i21m3 + module procedure psb_ip_reord_i21e,& + & psb_ip_reord_i21e1, psb_ip_reord_i21e2,& + & psb_ip_reord_i21e3 + + + end interface + +contains + + subroutine psb_ip_reord_i21m(n,x,iaux) + integer(psb_ipk_), intent(in) :: n + integer(psb_mpk_) :: iaux(0:*) + integer(psb_i2pk_) :: x(*) + integer(psb_mpk_) :: lswap, lp, k + integer(psb_i2pk_) :: swap + + lp = iaux(0) + k = 1 + do + if ((lp == 0).or.(k>n)) exit + do + if (lp >= k) exit + lp = iaux(lp) + end do + swap = x(lp) + x(lp) = x(k) + x(k) = swap + lswap = iaux(lp) + iaux(lp) = iaux(k) + iaux(k) = lp + lp = lswap + k = k + 1 + enddo + return + end subroutine psb_ip_reord_i21m + + subroutine psb_ip_reord_i21m1(n,x,indx,iaux) + integer(psb_ipk_), intent(in) :: n + integer(psb_mpk_) :: iaux(0:*) + integer(psb_i2pk_) :: x(*) + integer(psb_mpk_) :: indx(*) + integer(psb_mpk_) :: lswap, lp, k, ixswap + integer(psb_i2pk_) :: swap + + lp = iaux(0) + k = 1 + do + if ((lp == 0).or.(k>n)) exit + do + if (lp >= k) exit + lp = iaux(lp) + end do + swap = x(lp) + x(lp) = x(k) + x(k) = swap + ixswap = indx(lp) + indx(lp) = indx(k) + indx(k) = ixswap + lswap = iaux(lp) + iaux(lp) = iaux(k) + iaux(k) = lp + lp = lswap + k = k + 1 + enddo + return + end subroutine psb_ip_reord_i21m1 + + subroutine psb_ip_reord_i21m2(n,x,i1,i2,iaux) + integer(psb_ipk_), intent(in) :: n + integer(psb_mpk_) :: iaux(0:*) + integer(psb_i2pk_) :: x(*) + integer(psb_mpk_) :: i1(*), i2(*) + + + integer(psb_mpk_) :: lswap, lp, k, isw1, isw2 + integer(psb_i2pk_) :: swap + + lp = iaux(0) + k = 1 + do + if ((lp == 0).or.(k>n)) exit + do + if (lp >= k) exit + lp = iaux(lp) + end do + swap = x(lp) + x(lp) = x(k) + x(k) = swap + isw1 = i1(lp) + i1(lp) = i1(k) + i1(k) = isw1 + isw2 = i2(lp) + i2(lp) = i2(k) + i2(k) = isw2 + lswap = iaux(lp) + iaux(lp) = iaux(k) + iaux(k) = lp + lp = lswap + k = k + 1 + enddo + return + end subroutine psb_ip_reord_i21m2 + + subroutine psb_ip_reord_i21m3(n,x,i1,i2,i3,iaux) + integer(psb_ipk_), intent(in) :: n + integer(psb_mpk_) :: iaux(0:*) + integer(psb_i2pk_) :: x(*) + integer(psb_mpk_) :: i1(*), i2(*), i3(*) + + integer(psb_mpk_) :: lswap, lp, k, isw1, isw2, isw3 + integer(psb_i2pk_) :: swap + + lp = iaux(0) + k = 1 + do + if ((lp == 0).or.(k>n)) exit + do + if (lp >= k) exit + lp = iaux(lp) + end do + swap = x(lp) + x(lp) = x(k) + x(k) = swap + isw1 = i1(lp) + i1(lp) = i1(k) + i1(k) = isw1 + isw2 = i2(lp) + i2(lp) = i2(k) + i2(k) = isw2 + isw3 = i3(lp) + i3(lp) = i3(k) + i3(k) = isw3 + lswap = iaux(lp) + iaux(lp) = iaux(k) + iaux(k) = lp + lp = lswap + k = k + 1 + enddo + return + end subroutine psb_ip_reord_i21m3 + + + subroutine psb_ip_reord_i21e(n,x,iaux) + integer(psb_ipk_), intent(in) :: n + integer(psb_epk_) :: iaux(0:*) + integer(psb_i2pk_) :: x(*) + integer(psb_epk_) :: lswap, lp, k + integer(psb_i2pk_) :: swap + + lp = iaux(0) + k = 1 + do + if ((lp == 0).or.(k>n)) exit + do + if (lp >= k) exit + lp = iaux(lp) + end do + swap = x(lp) + x(lp) = x(k) + x(k) = swap + lswap = iaux(lp) + iaux(lp) = iaux(k) + iaux(k) = lp + lp = lswap + k = k + 1 + enddo + return + end subroutine psb_ip_reord_i21e + + subroutine psb_ip_reord_i21e1(n,x,indx,iaux) + integer(psb_ipk_), intent(in) :: n + integer(psb_epk_) :: iaux(0:*) + integer(psb_i2pk_) :: x(*) + integer(psb_epk_) :: indx(*) + integer(psb_epk_) :: lswap, lp, k, ixswap + integer(psb_i2pk_) :: swap + + lp = iaux(0) + k = 1 + do + if ((lp == 0).or.(k>n)) exit + do + if (lp >= k) exit + lp = iaux(lp) + end do + swap = x(lp) + x(lp) = x(k) + x(k) = swap + ixswap = indx(lp) + indx(lp) = indx(k) + indx(k) = ixswap + lswap = iaux(lp) + iaux(lp) = iaux(k) + iaux(k) = lp + lp = lswap + k = k + 1 + enddo + return + end subroutine psb_ip_reord_i21e1 + + subroutine psb_ip_reord_i21e2(n,x,i1,i2,iaux) + integer(psb_ipk_), intent(in) :: n + integer(psb_epk_) :: iaux(0:*) + integer(psb_i2pk_) :: x(*) + integer(psb_epk_) :: i1(*), i2(*) + + + integer(psb_epk_) :: lswap, lp, k, isw1, isw2 + integer(psb_i2pk_) :: swap + + lp = iaux(0) + k = 1 + do + if ((lp == 0).or.(k>n)) exit + do + if (lp >= k) exit + lp = iaux(lp) + end do + swap = x(lp) + x(lp) = x(k) + x(k) = swap + isw1 = i1(lp) + i1(lp) = i1(k) + i1(k) = isw1 + isw2 = i2(lp) + i2(lp) = i2(k) + i2(k) = isw2 + lswap = iaux(lp) + iaux(lp) = iaux(k) + iaux(k) = lp + lp = lswap + k = k + 1 + enddo + return + end subroutine psb_ip_reord_i21e2 + + subroutine psb_ip_reord_i21e3(n,x,i1,i2,i3,iaux) + integer(psb_ipk_), intent(in) :: n + integer(psb_epk_) :: iaux(0:*) + integer(psb_i2pk_) :: x(*) + integer(psb_epk_) :: i1(*), i2(*), i3(*) + + integer(psb_epk_) :: lswap, lp, k, isw1, isw2, isw3 + integer(psb_i2pk_) :: swap + + lp = iaux(0) + k = 1 + do + if ((lp == 0).or.(k>n)) exit + do + if (lp >= k) exit + lp = iaux(lp) + end do + swap = x(lp) + x(lp) = x(k) + x(k) = swap + isw1 = i1(lp) + i1(lp) = i1(k) + i1(k) = isw1 + isw2 = i2(lp) + i2(lp) = i2(k) + i2(k) = isw2 + isw3 = i3(lp) + i3(lp) = i3(k) + i3(k) = isw3 + lswap = iaux(lp) + iaux(lp) = iaux(k) + iaux(k) = lp + lp = lswap + k = k + 1 + enddo + return + end subroutine psb_ip_reord_i21e3 + +end module psb_i2_ip_reord_mod diff --git a/base/modules/auxil/psb_i2_isort_mod.f90 b/base/modules/auxil/psb_i2_isort_mod.f90 new file mode 100644 index 000000000..115da75cb --- /dev/null +++ b/base/modules/auxil/psb_i2_isort_mod.f90 @@ -0,0 +1,105 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! 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. +! +! +! +! Sorting routines +! References: +! D. Knuth +! The Art of Computer Programming, vol. 3 +! Addison-Wesley +! +! Aho, Hopcroft, Ullman +! Data Structures and Algorithms +! Addison-Wesley +! +module psb_i2_isort_mod + use psb_const_mod + + interface psb_isort + subroutine psb_i2isort(x,ix,dir,flag) + import + integer(psb_i2pk_), intent(inout) :: x(:) + integer(psb_ipk_), optional, intent(in) :: dir, flag + integer(psb_ipk_), optional, intent(inout) :: ix(:) + end subroutine psb_i2isort + end interface psb_isort + + + + interface + subroutine psi_i2isrx_up(n,x,ix) + import + integer(psb_i2pk_), intent(inout) :: x(:) + integer(psb_ipk_), intent(inout) :: ix(:) + integer(psb_ipk_), intent(in) :: n + end subroutine psi_i2isrx_up + subroutine psi_i2isrx_dw(n,x,ix) + import + integer(psb_i2pk_), intent(inout) :: x(:) + integer(psb_ipk_), intent(inout) :: ix(:) + integer(psb_ipk_), intent(in) :: n + end subroutine psi_i2isrx_dw + subroutine psi_i2isr_up(n,x) + import + integer(psb_i2pk_), intent(inout) :: x(:) + integer(psb_ipk_), intent(in) :: n + end subroutine psi_i2isr_up + subroutine psi_i2isr_dw(n,x) + import + integer(psb_i2pk_), intent(inout) :: x(:) + integer(psb_ipk_), intent(in) :: n + end subroutine psi_i2isr_dw + subroutine psi_i2aisrx_up(n,x,ix) + import + integer(psb_i2pk_), intent(inout) :: x(:) + integer(psb_ipk_), intent(inout) :: ix(:) + integer(psb_ipk_), intent(in) :: n + end subroutine psi_i2aisrx_up + subroutine psi_i2aisrx_dw(n,x,ix) + import + integer(psb_i2pk_), intent(inout) :: x(:) + integer(psb_ipk_), intent(inout) :: ix(:) + integer(psb_ipk_), intent(in) :: n + end subroutine psi_i2aisrx_dw + subroutine psi_i2aisr_up(n,x) + import + integer(psb_i2pk_), intent(inout) :: x(:) + integer(psb_ipk_), intent(in) :: n + end subroutine psi_i2aisr_up + subroutine psi_i2aisr_dw(n,x) + import + integer(psb_i2pk_), intent(inout) :: x(:) + integer(psb_ipk_), intent(in) :: n + end subroutine psi_i2aisr_dw + end interface + + +end module psb_i2_isort_mod diff --git a/base/modules/auxil/psb_i2_msort_mod.f90 b/base/modules/auxil/psb_i2_msort_mod.f90 new file mode 100644 index 000000000..caad09713 --- /dev/null +++ b/base/modules/auxil/psb_i2_msort_mod.f90 @@ -0,0 +1,111 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! 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. +! +! +! +! Sorting routines +! References: +! D. Knuth +! The Art of Computer Programming, vol. 3 +! Addison-Wesley +! +! Aho, Hopcroft, Ullman +! Data Structures and Algorithms +! Addison-Wesley +! +module psb_i2_msort_mod + use psb_const_mod + + interface psb_isaperm + logical function psb_i2isaperm(n,eip) + import + integer(psb_i2pk_), intent(in) :: n + integer(psb_i2pk_), intent(in) :: eip(n) + end function psb_i2isaperm + end interface psb_isaperm + + interface psb_msort_unique + subroutine psb_i2msort_u(x,nout,dir) + import + integer(psb_i2pk_), intent(inout) :: x(:) + integer(psb_ipk_), intent(out) :: nout + integer(psb_ipk_), optional, intent(in) :: dir + end subroutine psb_i2msort_u + end interface psb_msort_unique + + + interface psb_msort + subroutine psb_i2msort(x,ix,dir,flag) + import + integer(psb_i2pk_), intent(inout) :: x(:) + integer(psb_ipk_), optional, intent(in) :: dir, flag + integer(psb_ipk_), optional, intent(inout) :: ix(:) + end subroutine psb_i2msort + end interface psb_msort + + + interface psi_msort_up + subroutine psi_i2_msort_up(n,k,l,iret) + import + implicit none + integer(psb_ipk_) :: n, iret + integer(psb_i2pk_) :: k(n) + integer(psb_ipk_) :: l(0:n+1) + end subroutine psi_i2_msort_up + end interface psi_msort_up + interface psi_msort_dw + subroutine psi_i2_msort_dw(n,k,l,iret) + import + implicit none + integer(psb_ipk_) :: n, iret + integer(psb_i2pk_) :: k(n) + integer(psb_ipk_) :: l(0:n+1) + end subroutine psi_i2_msort_dw + end interface psi_msort_dw + interface psi_amsort_up + subroutine psi_i2_amsort_up(n,k,l,iret) + import + implicit none + integer(psb_ipk_) :: n, iret + integer(psb_i2pk_) :: k(n) + integer(psb_ipk_) :: l(0:n+1) + end subroutine psi_i2_amsort_up + end interface psi_amsort_up + interface psi_amsort_dw + subroutine psi_i2_amsort_dw(n,k,l,iret) + import + implicit none + integer(psb_ipk_) :: n, iret + integer(psb_i2pk_) :: k(n) + integer(psb_ipk_) :: l(0:n+1) + end subroutine psi_i2_amsort_dw + end interface psi_amsort_dw + +end module psb_i2_msort_mod diff --git a/base/modules/auxil/psb_i2_qsort_mod.f90 b/base/modules/auxil/psb_i2_qsort_mod.f90 new file mode 100644 index 000000000..944a436ec --- /dev/null +++ b/base/modules/auxil/psb_i2_qsort_mod.f90 @@ -0,0 +1,123 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! 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. +! +! +! +! Sorting routines +! References: +! D. Knuth +! The Art of Computer Programming, vol. 3 +! Addison-Wesley +! +! Aho, Hopcroft, Ullman +! Data Structures and Algorithms +! Addison-Wesley +! +module psb_i2_qsort_mod + use psb_const_mod + + + + interface psb_bsrch + function psb_i2bsrch(key,n,v) result(ipos) + import + integer(psb_ipk_) :: ipos, n + integer(psb_i2pk_) :: key + integer(psb_i2pk_) :: v(:) + end function psb_i2bsrch + end interface psb_bsrch + + interface psb_ssrch + function psb_i2ssrch(key,n,v) result(ipos) + import + implicit none + integer(psb_ipk_) :: ipos, n + integer(psb_i2pk_) :: key + integer(psb_i2pk_) :: v(:) + end function psb_i2ssrch + end interface psb_ssrch + + interface psb_qsort + subroutine psb_i2qsort(x,ix,dir,flag) + import + integer(psb_i2pk_), intent(inout) :: x(:) + integer(psb_ipk_), optional, intent(in) :: dir, flag + integer(psb_ipk_), optional, intent(inout) :: ix(:) + end subroutine psb_i2qsort + end interface psb_qsort + + interface + subroutine psi_i2qsrx_up(n,x,ix) + import + integer(psb_i2pk_), intent(inout) :: x(:) + integer(psb_ipk_), intent(inout) :: ix(:) + integer(psb_ipk_), intent(in) :: n + end subroutine psi_i2qsrx_up + subroutine psi_i2qsrx_dw(n,x,ix) + import + integer(psb_i2pk_), intent(inout) :: x(:) + integer(psb_ipk_), intent(inout) :: ix(:) + integer(psb_ipk_), intent(in) :: n + end subroutine psi_i2qsrx_dw + subroutine psi_i2qsr_up(n,x) + import + integer(psb_i2pk_), intent(inout) :: x(:) + integer(psb_ipk_), intent(in) :: n + end subroutine psi_i2qsr_up + subroutine psi_i2qsr_dw(n,x) + import + integer(psb_i2pk_), intent(inout) :: x(:) + integer(psb_ipk_), intent(in) :: n + end subroutine psi_i2qsr_dw + subroutine psi_i2aqsrx_up(n,x,ix) + import + integer(psb_i2pk_), intent(inout) :: x(:) + integer(psb_ipk_), intent(inout) :: ix(:) + integer(psb_ipk_), intent(in) :: n + end subroutine psi_i2aqsrx_up + subroutine psi_i2aqsrx_dw(n,x,ix) + import + integer(psb_i2pk_), intent(inout) :: x(:) + integer(psb_ipk_), intent(inout) :: ix(:) + integer(psb_ipk_), intent(in) :: n + end subroutine psi_i2aqsrx_dw + subroutine psi_i2aqsr_up(n,x) + import + integer(psb_i2pk_), intent(inout) :: x(:) + integer(psb_ipk_), intent(in) :: n + end subroutine psi_i2aqsr_up + subroutine psi_i2aqsr_dw(n,x) + import + integer(psb_i2pk_), intent(inout) :: x(:) + integer(psb_ipk_), intent(in) :: n + end subroutine psi_i2aqsr_dw + end interface + +end module psb_i2_qsort_mod diff --git a/base/modules/auxil/psb_i2_realloc_mod.F90 b/base/modules/auxil/psb_i2_realloc_mod.F90 new file mode 100644 index 000000000..4bc4da320 --- /dev/null +++ b/base/modules/auxil/psb_i2_realloc_mod.F90 @@ -0,0 +1,1027 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! 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. +! +! +module psb_i2_realloc_mod + use psb_const_mod + + implicit none + + ! + ! psb_realloc will reallocate the input array to have exactly + ! the size specified, possibly shortening it. + ! + Interface psb_realloc + module procedure psb_r_m_i2_rk1 + module procedure psb_r_m_i2_rk2 + module procedure psb_r_e_i2_rk1 + module procedure psb_r_e_i2_rk2 + module procedure psb_r_me_i2_rk2 + module procedure psb_r_em_i2_rk2 + + module procedure psb_r_m_2_i2_rk1 + module procedure psb_r_e_2_i2_rk1 + + end Interface psb_realloc + + interface psb_move_alloc + module procedure psb_move_alloc_i2_rk1, psb_move_alloc_i2_rk2 + end interface psb_move_alloc + + Interface psb_safe_ab_cpy + module procedure psb_ab_cpy_i2_rk1, psb_ab_cpy_i2_rk2 + end Interface psb_safe_ab_cpy + + Interface psb_safe_cpy + module procedure psb_cpy_i2_rk1, psb_cpy_i2_rk2 + end Interface psb_safe_cpy + + ! + ! psb_ensure_size will reallocate the input array if necessary + ! to guarantee that its size is at least as large as the + ! value required, usually with some room to spare. + ! + interface psb_ensure_size + module procedure psb_ensure_m_sz_i2_rk1, psb_ensure_e_sz_i2_rk1 + end Interface psb_ensure_size + + ! + ! psb_size returns 0 if argument is not allocated. + ! + interface psb_size + module procedure psb_size_i2_rk1, psb_size_i2_rk2 + end interface psb_size + + +Contains + + Subroutine psb_r_m_i2_rk1(len,rrax,info,pad,lb) + use psb_error_mod + + ! ...Subroutine Arguments + integer(psb_mpk_),Intent(in) :: len + integer(psb_i2pk_), allocatable, intent(inout) :: rrax(:) + integer(psb_ipk_) :: info + integer(psb_i2pk_), optional, intent(in) :: pad + integer(psb_mpk_), optional, intent(in) :: lb + + ! ...Local Variables + integer(psb_i2pk_),allocatable :: tmp(:) + integer(psb_mpk_) :: dim, lb_, lbi,ub_ + integer(psb_ipk_) :: err_act,err + character(len=20) :: name + logical, parameter :: debug=.false. + + name='psb_r_m_i2_rk1' + call psb_erractionsave(err_act) + info=psb_success_ + if (debug) write(psb_err_unit,*) 'reallocate D',len + + if (present(lb)) then + lb_ = lb + else + lb_ = 1 + endif + if ((len<0)) then + err=4025 + call psb_errpush(err,name, l_err=(/len*1_psb_lpk_/), & + & a_err='integer(psb_i2pk_)') + goto 9999 + end if + ub_ = lb_ + len-1 + + if (allocated(rrax)) then + dim = size(rrax) + lbi = lbound(rrax,1) + If ((dim /= len).or.(lbi /= lb_)) Then + Allocate(tmp(lb_:ub_),stat=info) + if (info /= psb_success_) then + err=4025 + call psb_errpush(err,name, l_err=(/len*1_psb_lpk_/), & + & a_err='integer(psb_i2pk_)') + goto 9999 + end if + tmp(lb_:lb_-1+min(len,dim))=rrax(lbi:lbi-1+min(len,dim)) + call psb_move_alloc(tmp,rrax,info) + End If + else + dim = 0 + Allocate(rrax(lb_:ub_),stat=info) + if (info /= psb_success_) then + err=4025 + call psb_errpush(err,name, l_err=(/len*1_psb_lpk_/), & + & a_err='integer(psb_i2pk_)') + goto 9999 + end if + endif + if (present(pad)) then + rrax(lb_-1+dim+1:lb_-1+len) = pad + endif + call psb_erractionrestore(err_act) + return + +9999 continue + info = err + call psb_error_handler(err_act) + return + + End Subroutine psb_r_m_i2_rk1 + + Subroutine psb_r_m_i2_rk2(len1,len2,rrax,info,pad,lb1,lb2) + use psb_error_mod + ! ...Subroutine Arguments + integer(psb_mpk_),Intent(in) :: len1,len2 + integer(psb_i2pk_),allocatable :: rrax(:,:) + integer(psb_ipk_) :: info + integer(psb_i2pk_), optional, intent(in) :: pad + integer(psb_mpk_),Intent(in), optional :: lb1,lb2 + + ! ...Local Variables + + integer(psb_i2pk_),allocatable :: tmp(:,:) + integer(psb_ipk_) :: err_act,err + integer(psb_mpk_) :: dim,dim2,lb1_, lb2_, ub1_, ub2_,lbi1, lbi2 + character(len=20) :: name + + name='psb_r_m_i2_rk2' + call psb_erractionsave(err_act) + info=psb_success_ + if (present(lb1)) then + lb1_ = lb1 + else + lb1_ = 1 + endif + if (present(lb2)) then + lb2_ = lb2 + else + lb2_ = 1 + endif + ub1_ = lb1_ + len1 -1 + ub2_ = lb2_ + len2 -1 + + if (len1 < 0) then + err=4025 + call psb_errpush(err,name, l_err=(/len1*1_psb_lpk_/), & + & a_err='integer(psb_i2pk_)') + goto 9999 + end if + if (len2 < 0) then + err=4025 + call psb_errpush(err,name, l_err=(/len2*1_psb_lpk_/), & + & a_err='integer(psb_i2pk_)') + goto 9999 + end if + + + if (allocated(rrax)) then + dim = size(rrax,1) + lbi1 = lbound(rrax,1) + dim2 = size(rrax,2) + lbi2 = lbound(rrax,2) + If ((dim /= len1).or.(dim2 /= len2).or.(lbi1 /= lb1_)& + & .or.(lbi2 /= lb2_)) Then + Allocate(tmp(lb1_:ub1_,lb2_:ub2_),stat=info) + if (info /= psb_success_) then + err=4025 + call psb_errpush(err,name, l_err=(/len1*1_psb_lpk_*len2/), & + & a_err='integer(psb_i2pk_)') + goto 9999 + end if + tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = & + & rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2)) + call psb_move_alloc(tmp,rrax,info) + End If + else + dim = 0 + dim2 = 0 + Allocate(rrax(lb1_:ub1_,lb2_:ub2_),stat=info) + if (info /= psb_success_) then + err=4025 + call psb_errpush(err,name, l_err=(/len1*1_psb_lpk_*len2/), & + & a_err='integer(psb_i2pk_)') + goto 9999 + end if + endif + if (present(pad)) then + rrax(lb1_-1+dim+1:lb1_-1+len1,:) = pad + rrax(lb1_:lb1_-1+dim,lb2_-1+dim2+1:lb2_-1+len2) = pad + endif + call psb_erractionrestore(err_act) + return + +9999 continue + info = err + call psb_error_handler(err_act) + return + + End Subroutine psb_r_m_i2_rk2 + + + Subroutine psb_r_e_i2_rk1(len,rrax,info,pad,lb) + use psb_error_mod + + ! ...Subroutine Arguments + integer(psb_epk_),Intent(in) :: len + integer(psb_i2pk_), allocatable, intent(inout) :: rrax(:) + integer(psb_ipk_) :: info + integer(psb_i2pk_), optional, intent(in) :: pad + integer(psb_epk_), optional, intent(in) :: lb + + ! ...Local Variables + integer(psb_i2pk_),allocatable :: tmp(:) + integer(psb_epk_) :: dim, lb_, lbi,ub_ + integer(psb_ipk_) :: iplen + integer(psb_ipk_) :: err_act,err + character(len=20) :: name + logical, parameter :: debug=.false. + + name='psb_r_m_i2_rk1' + call psb_erractionsave(err_act) + info=psb_success_ + if (debug) write(psb_err_unit,*) 'reallocate D',len + + if (present(lb)) then + lb_ = lb + else + lb_ = 1 + endif + if ((len<0)) then + err=4025 + iplen = len + call psb_errpush(err,name, i_err=(/iplen/), & + & a_err='integer(psb_i2pk_)') + goto 9999 + end if + ub_ = lb_ + len-1 + + if (allocated(rrax)) then + dim = size(rrax) + lbi = lbound(rrax,1) + If ((dim /= len).or.(lbi /= lb_)) Then + Allocate(tmp(lb_:ub_),stat=info) + if (info /= psb_success_) then + err=4025 + iplen = len + call psb_errpush(err,name, i_err=(/iplen/), & + & a_err='integer(psb_i2pk_)') + goto 9999 + end if + tmp(lb_:lb_-1+min(len,dim))=rrax(lbi:lbi-1+min(len,dim)) + call psb_move_alloc(tmp,rrax,info) + End If + else + dim = 0 + Allocate(rrax(lb_:ub_),stat=info) + if (info /= psb_success_) then + err=4025 + iplen = len + call psb_errpush(err,name, i_err=(/iplen/), & + & a_err='integer(psb_i2pk_)') + goto 9999 + end if + endif + if (present(pad)) then + rrax(lb_-1+dim+1:lb_-1+len) = pad + endif + call psb_erractionrestore(err_act) + return + +9999 continue + info = err + call psb_error_handler(err_act) + return + + End Subroutine psb_r_e_i2_rk1 + + Subroutine psb_r_e_i2_rk2(len1,len2,rrax,info,pad,lb1,lb2) + use psb_error_mod + ! ...Subroutine Arguments + integer(psb_epk_),Intent(in) :: len1,len2 + integer(psb_i2pk_),allocatable :: rrax(:,:) + integer(psb_ipk_) :: info + integer(psb_i2pk_), optional, intent(in) :: pad + integer(psb_epk_),Intent(in), optional :: lb1,lb2 + + ! ...Local Variables + + integer(psb_i2pk_),allocatable :: tmp(:,:) + integer(psb_ipk_) :: err_act,err, iplen + integer(psb_epk_) :: dim,dim2,lb1_, lb2_, ub1_, ub2_,lbi1, lbi2 + character(len=20) :: name + + name='psb_r_e_i2_rk2' + call psb_erractionsave(err_act) + info=psb_success_ + if (present(lb1)) then + lb1_ = lb1 + else + lb1_ = 1 + endif + if (present(lb2)) then + lb2_ = lb2 + else + lb2_ = 1 + endif + ub1_ = lb1_ + len1 -1 + ub2_ = lb2_ + len2 -1 + + if (len1 < 0) then + err=4025 + iplen = len1 + call psb_errpush(err,name, i_err=(/iplen/), & + & a_err='integer(psb_i2pk_)') + goto 9999 + end if + if (len2 < 0) then + err=4025 + iplen = len2 + call psb_errpush(err,name, i_err=(/iplen/), & + & a_err='integer(psb_i2pk_)') + goto 9999 + end if + + + if (allocated(rrax)) then + dim = size(rrax,1) + lbi1 = lbound(rrax,1) + dim2 = size(rrax,2) + lbi2 = lbound(rrax,2) + If ((dim /= len1).or.(dim2 /= len2).or.(lbi1 /= lb1_)& + & .or.(lbi2 /= lb2_)) Then + Allocate(tmp(lb1_:ub1_,lb2_:ub2_),stat=info) + if (info /= psb_success_) then + err=4025 + iplen = len1*len2 + call psb_errpush(err,name, i_err=(/iplen/), & + & a_err='integer(psb_i2pk_)') + goto 9999 + end if + tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = & + & rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2)) + call psb_move_alloc(tmp,rrax,info) + End If + else + dim = 0 + dim2 = 0 + Allocate(rrax(lb1_:ub1_,lb2_:ub2_),stat=info) + if (info /= psb_success_) then + err=4025 + iplen = len1*len2 + call psb_errpush(err,name, i_err=(/iplen/), & + & a_err='integer(psb_i2pk_)') + goto 9999 + end if + endif + if (present(pad)) then + rrax(lb1_-1+dim+1:lb1_-1+len1,:) = pad + rrax(lb1_:lb1_-1+dim,lb2_-1+dim2+1:lb2_-1+len2) = pad + endif + call psb_erractionrestore(err_act) + return + +9999 continue + info = err + call psb_error_handler(err_act) + return + + End Subroutine psb_r_e_i2_rk2 + + Subroutine psb_r_me_i2_rk2(len1,len2,rrax,info,pad,lb1,lb2) + use psb_error_mod + ! ...Subroutine Arguments + integer(psb_mpk_),Intent(in) :: len1 + integer(psb_epk_),Intent(in) :: len2 + integer(psb_i2pk_),allocatable :: rrax(:,:) + integer(psb_ipk_) :: info + integer(psb_i2pk_), optional, intent(in) :: pad + integer(psb_mpk_),Intent(in), optional :: lb1,lb2 + + ! ...Local Variables + + integer(psb_i2pk_),allocatable :: tmp(:,:) + integer(psb_ipk_) :: err_act,err, iplen + integer(psb_mpk_) :: dim,lb1_, lb2_, ub1_, ub2_,lbi1, lbi2 + integer(psb_epk_) :: dim2 + character(len=20) :: name + + name='psb_r_me_i2_rk2' + call psb_erractionsave(err_act) + info=psb_success_ + if (present(lb1)) then + lb1_ = lb1 + else + lb1_ = 1 + endif + if (present(lb2)) then + lb2_ = lb2 + else + lb2_ = 1 + endif + ub1_ = lb1_ + len1 -1 + ub2_ = lb2_ + len2 -1 + + if (len1 < 0) then + err=4025 + iplen = len1 + call psb_errpush(err,name, i_err=(/iplen/), & + & a_err='integer(psb_i2pk_)') + goto 9999 + end if + if (len2 < 0) then + err=4025 + iplen = len2 + call psb_errpush(err,name, i_err=(/iplen/), & + & a_err='integer(psb_i2pk_)') + goto 9999 + end if + + + if (allocated(rrax)) then + dim = size(rrax,1) + lbi1 = lbound(rrax,1) + dim2 = size(rrax,2) + lbi2 = lbound(rrax,2) + If ((dim /= len1).or.(dim2 /= len2).or.(lbi1 /= lb1_)& + & .or.(lbi2 /= lb2_)) Then + Allocate(tmp(lb1_:ub1_,lb2_:ub2_),stat=info) + if (info /= psb_success_) then + err=4025 + iplen = len1*len2 + call psb_errpush(err,name, i_err=(/iplen/), & + & a_err='integer(psb_i2pk_)') + goto 9999 + end if + tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = & + & rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2)) + call psb_move_alloc(tmp,rrax,info) + End If + else + dim = 0 + dim2 = 0 + Allocate(rrax(lb1_:ub1_,lb2_:ub2_),stat=info) + if (info /= psb_success_) then + err=4025 + iplen = len1*len2 + call psb_errpush(err,name,i_err=(/iplen/),& + & a_err='integer(psb_i2pk_)') + goto 9999 + end if + endif + if (present(pad)) then + rrax(lb1_-1+dim+1:lb1_-1+len1,:) = pad + rrax(lb1_:lb1_-1+dim,lb2_-1+dim2+1:lb2_-1+len2) = pad + endif + call psb_erractionrestore(err_act) + return + +9999 continue + info = err + call psb_error_handler(err_act) + return + + End Subroutine psb_r_me_i2_rk2 + + Subroutine psb_r_em_i2_rk2(len1,len2,rrax,info,pad,lb1,lb2) + use psb_error_mod + ! ...Subroutine Arguments + integer(psb_epk_),Intent(in) :: len1 + integer(psb_mpk_),Intent(in) :: len2 + integer(psb_i2pk_),allocatable :: rrax(:,:) + integer(psb_ipk_) :: info + integer(psb_i2pk_), optional, intent(in) :: pad + integer(psb_mpk_),Intent(in), optional :: lb1,lb2 + + ! ...Local Variables + + integer(psb_i2pk_),allocatable :: tmp(:,:) + integer(psb_ipk_) :: err_act,err, iplen + integer(psb_mpk_) :: dim2,lb1_, lb2_, ub1_, ub2_,lbi1, lbi2 + integer(psb_epk_) :: dim + character(len=20) :: name + + name='psb_r_me_i2_rk2' + call psb_erractionsave(err_act) + info=psb_success_ + if (present(lb1)) then + lb1_ = lb1 + else + lb1_ = 1 + endif + if (present(lb2)) then + lb2_ = lb2 + else + lb2_ = 1 + endif + ub1_ = lb1_ + len1 -1 + ub2_ = lb2_ + len2 -1 + + if (len1 < 0) then + err=4025 + iplen = len1 + call psb_errpush(err,name, i_err=(/iplen/), & + & a_err='integer(psb_i2pk_)') + goto 9999 + end if + if (len2 < 0) then + err=4025 + iplen = len2 + call psb_errpush(err,name, i_err=(/iplen/), & + & a_err='integer(psb_i2pk_)') + goto 9999 + end if + + + if (allocated(rrax)) then + dim = size(rrax,1) + lbi1 = lbound(rrax,1) + dim2 = size(rrax,2) + lbi2 = lbound(rrax,2) + If ((dim /= len1).or.(dim2 /= len2).or.(lbi1 /= lb1_)& + & .or.(lbi2 /= lb2_)) Then + Allocate(tmp(lb1_:ub1_,lb2_:ub2_),stat=info) + if (info /= psb_success_) then + err=4025 + iplen = len1*len2 + call psb_errpush(err,name, i_err=(/iplen/), & + & a_err='integer(psb_i2pk_)') + goto 9999 + end if + tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = & + & rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2)) + call psb_move_alloc(tmp,rrax,info) + End If + else + dim = 0 + dim2 = 0 + Allocate(rrax(lb1_:ub1_,lb2_:ub2_),stat=info) + if (info /= psb_success_) then + err=4025 + iplen = len1*len2 + call psb_errpush(err,name, i_err=(/iplen/), & + & a_err='integer(psb_i2pk_)') + goto 9999 + end if + endif + if (present(pad)) then + rrax(lb1_-1+dim+1:lb1_-1+len1,:) = pad + rrax(lb1_:lb1_-1+dim,lb2_-1+dim2+1:lb2_-1+len2) = pad + endif + call psb_erractionrestore(err_act) + return + +9999 continue + info = err + call psb_error_handler(err_act) + return + + End Subroutine psb_r_em_i2_rk2 + + Subroutine psb_r_m_2_i2_rk1(len,rrax,y,info,pad) + use psb_error_mod + ! ...Subroutine Arguments + + integer(psb_mpk_),Intent(in) :: len + integer(psb_i2pk_),allocatable, intent(inout) :: rrax(:),y(:) + integer(psb_ipk_) :: info + integer(psb_i2pk_), optional, intent(in) :: pad + character(len=20) :: name + integer(psb_ipk_) :: err_act, err + + name='psb_r_m_2_i2_rk1' + call psb_erractionsave(err_act) + info=psb_success_ + + if(psb_errstatus_fatal()) then + info=psb_err_from_subroutine_ + goto 9999 + end if + + call psb_realloc(len,rrax,info,pad=pad) + if (info /= psb_success_) then + err=4000 + call psb_errpush(err,name) + goto 9999 + end if + call psb_realloc(len,y,info,pad=pad) + if (info /= psb_success_) then + err=4000 + call psb_errpush(err,name) + goto 9999 + end if + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + + End Subroutine psb_r_m_2_i2_rk1 + + Subroutine psb_r_e_2_i2_rk1(len,rrax,y,info,pad) + use psb_error_mod + ! ...Subroutine Arguments + + integer(psb_epk_),Intent(in) :: len + integer(psb_i2pk_),allocatable, intent(inout) :: rrax(:),y(:) + integer(psb_ipk_) :: info + integer(psb_i2pk_), optional, intent(in) :: pad + character(len=20) :: name + integer(psb_ipk_) :: err_act, err + + name='psb_r_m_2_i2_rk1' + call psb_erractionsave(err_act) + info=psb_success_ + + if(psb_errstatus_fatal()) then + info=psb_err_from_subroutine_ + goto 9999 + end if + + call psb_realloc(len,rrax,info,pad=pad) + if (info /= psb_success_) then + err=4000 + call psb_errpush(err,name) + goto 9999 + end if + call psb_realloc(len,y,info,pad=pad) + if (info /= psb_success_) then + err=4000 + call psb_errpush(err,name) + goto 9999 + end if + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + + End Subroutine psb_r_e_2_i2_rk1 + + + + subroutine psb_ab_cpy_i2_rk1(vin,vout,info) + use psb_error_mod + + ! ...Subroutine Arguments + integer(psb_i2pk_), allocatable, intent(in) :: vin(:) + integer(psb_i2pk_), allocatable, intent(out) :: vout(:) + integer(psb_ipk_) :: info + ! ...Local Variables + + integer(psb_ipk_) :: isz,err_act,lb + character(len=20) :: name, char_err + logical, parameter :: debug=.false. + + name='psb_ab_cpy_i2_rk1' + call psb_erractionsave(err_act) + info=psb_success_ + if(psb_errstatus_fatal()) then + info=psb_err_from_subroutine_ + goto 9999 + end if + + if (allocated(vin)) then + isz = size(vin) + lb = lbound(vin,1) + call psb_realloc(isz,vout,info,lb=lb) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + char_err='psb_realloc' + call psb_errpush(info,name,a_err=char_err) + goto 9999 + else + vout(:) = vin(:) + endif + endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + + end subroutine psb_ab_cpy_i2_rk1 + + subroutine psb_ab_cpy_i2_rk2(vin,vout,info) + use psb_error_mod + + ! ...Subroutine Arguments + integer(psb_i2pk_), allocatable, intent(in) :: vin(:,:) + integer(psb_i2pk_), allocatable, intent(out) :: vout(:,:) + integer(psb_ipk_) :: info + ! ...Local Variables + + integer(psb_ipk_) :: isz1, isz2,err_act, lb1, lb2 + character(len=20) :: name, char_err + logical, parameter :: debug=.false. + + name='psb_ab_cpy_i2_rk2' + call psb_erractionsave(err_act) + info=psb_success_ + if(psb_errstatus_fatal()) then + info=psb_err_from_subroutine_ + goto 9999 + end if + + if (allocated(vin)) then + isz1 = size(vin,1) + isz2 = size(vin,2) + lb1 = lbound(vin,1) + lb2 = lbound(vin,2) + call psb_realloc(isz1,isz2,vout,info,lb1=lb1,lb2=lb2) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + char_err='psb_realloc' + call psb_errpush(info,name,a_err=char_err) + goto 9999 + else + vout(:,:) = vin(:,:) + endif + endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + + end subroutine psb_ab_cpy_i2_rk2 + + + subroutine psb_cpy_i2_rk1(vin,vout,info) + use psb_error_mod + + ! ...Subroutine Arguments + integer(psb_i2pk_), intent(in) :: vin(:) + integer(psb_i2pk_), allocatable, intent(out) :: vout(:) + integer(psb_ipk_) :: info + ! ...Local Variables + + integer(psb_ipk_) :: isz,err_act,lb + character(len=20) :: name, char_err + logical, parameter :: debug=.false. + + name='psb_cpy_i2_rk1' + call psb_erractionsave(err_act) + info=psb_success_ + if(psb_errstatus_fatal()) then + info=psb_err_from_subroutine_ + goto 9999 + end if + isz = size(vin) + lb = lbound(vin,1) + call psb_realloc(isz,vout,info,lb=lb) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + char_err='psb_realloc' + call psb_errpush(info,name,a_err=char_err) + goto 9999 + else + vout(:) = vin(:) + endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + + end subroutine psb_cpy_i2_rk1 + + subroutine psb_cpy_i2_rk2(vin,vout,info) + use psb_error_mod + + ! ...Subroutine Arguments + integer(psb_i2pk_), intent(in) :: vin(:,:) + integer(psb_i2pk_), allocatable, intent(out) :: vout(:,:) + integer(psb_ipk_) :: info + ! ...Local Variables + + integer(psb_ipk_) :: isz1, isz2,err_act, lb1, lb2 + character(len=20) :: name, char_err + logical, parameter :: debug=.false. + + name='psb_safe_cpy' + call psb_erractionsave(err_act) + info=psb_success_ + if(psb_errstatus_fatal()) then + info=psb_err_from_subroutine_ + goto 9999 + end if + + isz1 = size(vin,1) + isz2 = size(vin,2) + lb1 = lbound(vin,1) + lb2 = lbound(vin,2) + call psb_realloc(isz1,isz2,vout,info,lb1=lb1,lb2=lb2) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + char_err='psb_realloc' + call psb_errpush(info,name,a_err=char_err) + goto 9999 + else + vout(:,:) = vin(:,:) + endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + + end subroutine psb_cpy_i2_rk2 + + + function psb_size_i2_rk1(vin) result(val) + integer(psb_epk_) :: val + integer(psb_i2pk_), allocatable, intent(in) :: vin(:) + + if (.not.allocated(vin)) then + val = 0 + else + val = size(vin) + end if + end function psb_size_i2_rk1 + + + function psb_size_i2_rk2(vin,dim) result(val) + integer(psb_epk_) :: val + integer(psb_i2pk_), allocatable, intent(in) :: vin(:,:) + integer(psb_ipk_), optional :: dim + integer(psb_ipk_) :: dim_ + + + if (.not.allocated(vin)) then + val = 0 + else + if (present(dim)) then + dim_= dim + val = size(vin,dim=dim_) + else + val = size(vin) + end if + end if + end function psb_size_i2_rk2 + + Subroutine psb_ensure_m_sz_i2_rk1(len,v,info,pad,addsz,newsz) + use psb_error_mod + + ! ...Subroutine Arguments + integer(psb_mpk_),Intent(in) :: len + integer(psb_i2pk_),allocatable, intent(inout) :: v(:) + integer(psb_ipk_) :: info + integer(psb_mpk_), optional, intent(in) :: addsz,newsz + integer(psb_i2pk_), optional, intent(in) :: pad + ! ...Local Variables + character(len=20) :: name + logical, parameter :: debug=.false. + integer(psb_ipk_) :: err_act + integer(psb_mpk_) :: isz + + name='psb_ensure_m_sz_i2_rk1' + call psb_erractionsave(err_act) + info = psb_success_ + + if (psb_errstatus_fatal()) then + info=psb_err_from_subroutine_ + goto 9999 + end if + + If (len > psb_size(v)) Then + if (present(newsz)) then + isz = (max(len+1,newsz)) + else + if (present(addsz)) then + isz = len+max(1,addsz) + else + isz = max(len+10, int(1.25*len)) + endif + endif + + call psb_realloc(isz,v,info,pad=pad) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_realloc') + goto 9999 + End If + end If + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + + + End Subroutine psb_ensure_m_sz_i2_rk1 + + Subroutine psb_ensure_e_sz_i2_rk1(len,v,info,pad,addsz,newsz) + use psb_error_mod + + ! ...Subroutine Arguments + integer(psb_epk_),Intent(in) :: len + integer(psb_i2pk_),allocatable, intent(inout) :: v(:) + integer(psb_ipk_) :: info + integer(psb_epk_), optional, intent(in) :: addsz,newsz + integer(psb_i2pk_), optional, intent(in) :: pad + ! ...Local Variables + character(len=20) :: name + logical, parameter :: debug=.false. + integer(psb_ipk_) :: err_act + integer(psb_epk_) :: isz + + name='psb_ensure_m_sz_i2_rk1' + call psb_erractionsave(err_act) + info = psb_success_ + + if (psb_errstatus_fatal()) then + info=psb_err_from_subroutine_ + goto 9999 + end if + + If (len > psb_size(v)) Then + if (present(newsz)) then + isz = (max(len+1,newsz)) + else + if (present(addsz)) then + isz = len+max(1,addsz) + else + isz = max(len+10, int(1.25*len)) + endif + endif + + call psb_realloc(isz,v,info,pad=pad) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_realloc') + goto 9999 + End If + end If + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + + + End Subroutine psb_ensure_e_sz_i2_rk1 + + Subroutine psb_move_alloc_i2_rk1(vin,vout,info) + use psb_error_mod + integer(psb_i2pk_), allocatable, intent(inout) :: vin(:),vout(:) + integer(psb_ipk_), intent(out) :: info + ! + ! + info=psb_success_ + call move_alloc(vin,vout) + + end Subroutine psb_move_alloc_i2_rk1 + + Subroutine psb_move_alloc_i2_rk2(vin,vout,info) + use psb_error_mod + integer(psb_i2pk_), allocatable, intent(inout) :: vin(:,:),vout(:,:) + integer(psb_ipk_), intent(out) :: info + ! + ! + info=psb_success_ + + call move_alloc(vin,vout) + + end Subroutine psb_move_alloc_i2_rk2 + +end module psb_i2_realloc_mod diff --git a/base/modules/auxil/psi_i2_serial_mod.f90 b/base/modules/auxil/psi_i2_serial_mod.f90 new file mode 100644 index 000000000..bc0df7c55 --- /dev/null +++ b/base/modules/auxil/psi_i2_serial_mod.f90 @@ -0,0 +1,143 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! 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. +! +! +module psi_i2_serial_mod + use psb_const_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_ + + interface psb_gelp + ! 2-D version + subroutine psb_i2gelp(trans,iperm,x,info) + import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_ + implicit none + integer(psb_i2pk_), intent(inout) :: x(:,:) + integer(psb_ipk_), intent(in) :: iperm(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in) :: trans + end subroutine psb_i2gelp + subroutine psb_i2gelpv(trans,iperm,x,info) + import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_ + implicit none + integer(psb_i2pk_), intent(inout) :: x(:) + integer(psb_ipk_), intent(in) :: iperm(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in) :: trans + end subroutine psb_i2gelpv + end interface psb_gelp + + interface psb_geaxpby + subroutine psi_i2axpby(m,n,alpha, x, beta, y, info) + import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_ + implicit none + integer(psb_ipk_), intent(in) :: m, n + integer(psb_i2pk_), intent (in) :: x(:,:) + integer(psb_i2pk_), intent (inout) :: y(:,:) + integer(psb_i2pk_), intent (in) :: alpha, beta + integer(psb_ipk_), intent(out) :: info + end subroutine psi_i2axpby + subroutine psi_i2axpbyv(m,alpha, x, beta, y, info) + import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_ + implicit none + integer(psb_ipk_), intent(in) :: m + integer(psb_i2pk_), intent (in) :: x(:) + integer(psb_i2pk_), intent (inout) :: y(:) + integer(psb_i2pk_), intent (in) :: alpha, beta + integer(psb_ipk_), intent(out) :: info + end subroutine psi_i2axpbyv + subroutine psi_i2axpbyv2(m,alpha, x, beta, y, z, info) + import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_ + implicit none + integer(psb_ipk_), intent(in) :: m + integer(psb_i2pk_), intent (in) :: x(:) + integer(psb_i2pk_), intent (in) :: y(:) + integer(psb_i2pk_), intent (in) :: z(:) + integer(psb_i2pk_), intent (in) :: alpha, beta + integer(psb_ipk_), intent(out) :: info + end subroutine psi_i2axpbyv2 + end interface psb_geaxpby + + interface psi_gth + subroutine psi_i2gthmv(n,k,idx,alpha,x,beta,y) + import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_ + implicit none + integer(psb_ipk_) :: n, k, idx(:) + integer(psb_i2pk_) :: x(:,:), y(:),alpha,beta + end subroutine psi_i2gthmv + subroutine psi_i2gthv(n,idx,alpha,x,beta,y) + import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_ + implicit none + integer(psb_ipk_) :: n, idx(:) + integer(psb_i2pk_) :: x(:), y(:),alpha,beta + end subroutine psi_i2gthv + subroutine psi_i2gthzmv(n,k,idx,x,y) + import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_ + implicit none + integer(psb_ipk_) :: n, k, idx(:) + integer(psb_i2pk_) :: x(:,:), y(:) + + end subroutine psi_i2gthzmv + subroutine psi_i2gthzmm(n,k,idx,x,y) + import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_ + implicit none + integer(psb_ipk_) :: n, k, idx(:) + integer(psb_i2pk_) :: x(:,:), y(:,:) + + end subroutine psi_i2gthzmm + subroutine psi_i2gthzv(n,idx,x,y) + import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_ + implicit none + integer(psb_ipk_) :: n, idx(:) + integer(psb_i2pk_) :: x(:), y(:) + end subroutine psi_i2gthzv + end interface psi_gth + + interface psi_sct + subroutine psi_i2sctmm(n,k,idx,x,beta,y) + import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_ + implicit none + integer(psb_ipk_) :: n, k, idx(:) + integer(psb_i2pk_) :: beta, x(:,:), y(:,:) + end subroutine psi_i2sctmm + subroutine psi_i2sctmv(n,k,idx,x,beta,y) + import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_ + implicit none + integer(psb_ipk_) :: n, k, idx(:) + integer(psb_i2pk_) :: beta, x(:), y(:,:) + end subroutine psi_i2sctmv + subroutine psi_i2sctv(n,idx,x,beta,y) + import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_ + implicit none + + integer(psb_ipk_) :: n, idx(:) + integer(psb_i2pk_) :: beta, x(:), y(:) + end subroutine psi_i2sctv + end interface psi_sct + +end module psi_i2_serial_mod diff --git a/base/modules/comm/psb_e_comm_a_mod.f90 b/base/modules/comm/psb_e_comm_a_mod.f90 index 19f1cb012..46057d94c 100644 --- a/base/modules/comm/psb_e_comm_a_mod.f90 +++ b/base/modules/comm/psb_e_comm_a_mod.f90 @@ -30,7 +30,8 @@ ! ! module psb_e_comm_a_mod - use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_lpk_, psb_epk_, psb_mpk_ + use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_lpk_, & + & psb_epk_, psb_mpk_, psb_i2pk_ interface psb_ovrl subroutine psb_eovrlm(x,desc_a,info,jx,ik,work,update,mode) diff --git a/base/modules/comm/psb_i2_comm_a_mod.f90 b/base/modules/comm/psb_i2_comm_a_mod.f90 new file mode 100644 index 000000000..09398722d --- /dev/null +++ b/base/modules/comm/psb_i2_comm_a_mod.f90 @@ -0,0 +1,123 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! 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. +! +! +module psb_i2_comm_a_mod + use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_lpk_, & + & psb_epk_, psb_mpk_, psb_i2pk_ + + interface psb_ovrl + subroutine psb_i2ovrlm(x,desc_a,info,jx,ik,work,update,mode) + import + implicit none + integer(psb_i2pk_), intent(inout), target :: x(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(out) :: info + integer(psb_i2pk_), intent(inout), optional, target :: work(:) + integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode + end subroutine psb_i2ovrlm + subroutine psb_i2ovrlv(x,desc_a,info,work,update,mode) + import + implicit none + integer(psb_i2pk_), intent(inout), target :: x(:) + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(out) :: info + integer(psb_i2pk_), intent(inout), optional, target :: work(:) + integer(psb_ipk_), intent(in), optional :: update,mode + end subroutine psb_i2ovrlv + end interface psb_ovrl + + interface psb_halo + subroutine psb_i2halom(x,desc_a,info,jx,ik,work,tran,mode,data) + import + implicit none + integer(psb_i2pk_), intent(inout), target :: x(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(out) :: info + integer(psb_i2pk_), target, optional, intent(inout) :: work(:) + integer(psb_ipk_), intent(in), optional :: mode,jx,ik,data + character, intent(in), optional :: tran + end subroutine psb_i2halom + subroutine psb_i2halov(x,desc_a,info,work,tran,mode,data) + import + implicit none + integer(psb_i2pk_), intent(inout) :: x(:) + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(out) :: info + integer(psb_i2pk_), target, optional, intent(inout) :: work(:) + integer(psb_ipk_), intent(in), optional :: mode,data + character, intent(in), optional :: tran + end subroutine psb_i2halov + end interface psb_halo + + + interface psb_scatter + subroutine psb_i2scatterm(globx, locx, desc_a, info, root) + import + implicit none + integer(psb_i2pk_), intent(out), allocatable :: locx(:,:) + integer(psb_i2pk_), intent(in) :: globx(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: root + end subroutine psb_i2scatterm + subroutine psb_i2scatterv(globx, locx, desc_a, info, root) + import + implicit none + integer(psb_i2pk_), intent(out), allocatable :: locx(:) + integer(psb_i2pk_), intent(in) :: globx(:) + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: root + end subroutine psb_i2scatterv + end interface psb_scatter + + interface psb_gather + subroutine psb_i2gatherm(globx, locx, desc_a, info, root) + import + implicit none + integer(psb_i2pk_), intent(in) :: locx(:,:) + integer(psb_i2pk_), intent(out), allocatable :: globx(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: root + end subroutine psb_i2gatherm + subroutine psb_i2gatherv(globx, locx, desc_a, info, root) + import + implicit none + integer(psb_i2pk_), intent(in) :: locx(:) + integer(psb_i2pk_), intent(out), allocatable :: globx(:) + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: root + end subroutine psb_i2gatherv + end interface psb_gather + +end module psb_i2_comm_a_mod diff --git a/base/modules/comm/psb_m_comm_a_mod.f90 b/base/modules/comm/psb_m_comm_a_mod.f90 index 91124a534..dbec118a8 100644 --- a/base/modules/comm/psb_m_comm_a_mod.f90 +++ b/base/modules/comm/psb_m_comm_a_mod.f90 @@ -30,7 +30,8 @@ ! ! module psb_m_comm_a_mod - use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_lpk_, psb_epk_, psb_mpk_ + use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_lpk_, & + & psb_epk_, psb_mpk_, psb_i2pk_ interface psb_ovrl subroutine psb_movrlm(x,desc_a,info,jx,ik,work,update,mode) diff --git a/base/modules/comm/psi_i2_comm_a_mod.f90 b/base/modules/comm/psi_i2_comm_a_mod.f90 new file mode 100644 index 000000000..f67b56541 --- /dev/null +++ b/base/modules/comm/psi_i2_comm_a_mod.f90 @@ -0,0 +1,166 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! 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. +! +! +module psi_i2_comm_a_mod + use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_mpk_, psb_epk_ + + interface psi_swapdata + subroutine psi_i2swapdatam(flag,n,beta,y,desc_a,work,info,data) + import + integer(psb_ipk_), intent(in) :: flag, n + integer(psb_ipk_), intent(out) :: info + integer(psb_i2pk_) :: y(:,:), beta + integer(psb_i2pk_),target :: work(:) + type(psb_desc_type), target :: desc_a + integer(psb_ipk_), optional :: data + end subroutine psi_i2swapdatam + subroutine psi_i2swapdatav(flag,beta,y,desc_a,work,info,data) + import + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info + integer(psb_i2pk_) :: y(:), beta + integer(psb_i2pk_),target :: work(:) + type(psb_desc_type), target :: desc_a + integer(psb_ipk_), optional :: data + end subroutine psi_i2swapdatav + subroutine psi_i2swapidxm(ictxt,icomm,flag,n,beta,y,idx,& + & totxch,totsnd,totrcv,work,info) + import + integer(psb_ipk_), intent(in) :: ictxt,icomm,flag, n + integer(psb_ipk_), intent(out) :: info + integer(psb_i2pk_) :: y(:,:), beta + integer(psb_i2pk_),target :: work(:) + integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv + end subroutine psi_i2swapidxm + subroutine psi_i2swapidxv(ictxt,icomm,flag,beta,y,idx,& + & totxch,totsnd,totrcv,work,info) + import + integer(psb_ipk_), intent(in) :: ictxt,icomm,flag + integer(psb_ipk_), intent(out) :: info + integer(psb_i2pk_) :: y(:), beta + integer(psb_i2pk_),target :: work(:) + integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv + end subroutine psi_i2swapidxv + end interface psi_swapdata + + + interface psi_swaptran + subroutine psi_i2swaptranm(flag,n,beta,y,desc_a,work,info,data) + import + integer(psb_ipk_), intent(in) :: flag, n + integer(psb_ipk_), intent(out) :: info + integer(psb_i2pk_) :: y(:,:), beta + integer(psb_i2pk_),target :: work(:) + type(psb_desc_type), target :: desc_a + integer(psb_ipk_), optional :: data + end subroutine psi_i2swaptranm + subroutine psi_i2swaptranv(flag,beta,y,desc_a,work,info,data) + import + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info + integer(psb_i2pk_) :: y(:), beta + integer(psb_i2pk_),target :: work(:) + type(psb_desc_type), target :: desc_a + integer(psb_ipk_), optional :: data + end subroutine psi_i2swaptranv + subroutine psi_i2tranidxm(ictxt,icomm,flag,n,beta,y,idx,& + & totxch,totsnd,totrcv,work,info) + import + integer(psb_ipk_), intent(in) :: ictxt,icomm,flag, n + integer(psb_ipk_), intent(out) :: info + integer(psb_i2pk_) :: y(:,:), beta + integer(psb_i2pk_),target :: work(:) + integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv + end subroutine psi_i2tranidxm + subroutine psi_i2tranidxv(ictxt,icomm,flag,beta,y,idx,& + & totxch,totsnd,totrcv,work,info) + import + integer(psb_ipk_), intent(in) :: ictxt,icomm,flag + integer(psb_ipk_), intent(out) :: info + integer(psb_i2pk_) :: y(:), beta + integer(psb_i2pk_),target :: work(:) + integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv + end subroutine psi_i2tranidxv + end interface psi_swaptran + + interface psi_ovrl_upd + subroutine psi_i2ovrl_updr1(x,desc_a,update,info) + import + integer(psb_i2pk_), intent(inout), target :: x(:) + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(in) :: update + integer(psb_ipk_), intent(out) :: info + end subroutine psi_i2ovrl_updr1 + subroutine psi_i2ovrl_updr2(x,desc_a,update,info) + import + integer(psb_i2pk_), intent(inout), target :: x(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(in) :: update + integer(psb_ipk_), intent(out) :: info + end subroutine psi_i2ovrl_updr2 + end interface psi_ovrl_upd + + interface psi_ovrl_save + subroutine psi_i2ovrl_saver1(x,xs,desc_a,info) + import + integer(psb_i2pk_), intent(inout) :: x(:) + integer(psb_i2pk_), allocatable :: xs(:) + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(out) :: info + end subroutine psi_i2ovrl_saver1 + subroutine psi_i2ovrl_saver2(x,xs,desc_a,info) + import + integer(psb_i2pk_), intent(inout) :: x(:,:) + integer(psb_i2pk_), allocatable :: xs(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(out) :: info + end subroutine psi_i2ovrl_saver2 + end interface psi_ovrl_save + + interface psi_ovrl_restore + subroutine psi_i2ovrl_restrr1(x,xs,desc_a,info) + import + integer(psb_i2pk_), intent(inout) :: x(:) + integer(psb_i2pk_) :: xs(:) + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(out) :: info + end subroutine psi_i2ovrl_restrr1 + subroutine psi_i2ovrl_restrr2(x,xs,desc_a,info) + import + integer(psb_i2pk_), intent(inout) :: x(:,:) + integer(psb_i2pk_) :: xs(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(out) :: info + end subroutine psi_i2ovrl_restrr2 + end interface psi_ovrl_restore + +end module psi_i2_comm_a_mod + diff --git a/base/modules/comm/psi_i_comm_v_mod.f90 b/base/modules/comm/psi_i_comm_v_mod.f90 index 91b2f85a6..bc4ea2a85 100644 --- a/base/modules/comm/psi_i_comm_v_mod.f90 +++ b/base/modules/comm/psi_i_comm_v_mod.f90 @@ -30,7 +30,8 @@ ! ! module psi_i_comm_v_mod - use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_mpk_, psb_lpk_, psb_epk_ + use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_mpk_, & + & psb_lpk_, psb_epk_, psb_i2pk_ use psb_i_base_vect_mod, only : psb_i_base_vect_type use psb_i_base_multivect_mod, only : psb_i_base_multivect_type diff --git a/base/modules/comm/psi_l_comm_v_mod.f90 b/base/modules/comm/psi_l_comm_v_mod.f90 index 150c5bd45..4c80b0907 100644 --- a/base/modules/comm/psi_l_comm_v_mod.f90 +++ b/base/modules/comm/psi_l_comm_v_mod.f90 @@ -30,7 +30,8 @@ ! ! module psi_l_comm_v_mod - use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_mpk_, psb_lpk_, psb_epk_ + use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_mpk_, & + & psb_lpk_, psb_epk_, psb_i2pk_ use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_mpk_, psb_lpk_, psb_epk_, psb_i_base_vect_type use psb_l_base_vect_mod, only : psb_l_base_vect_type use psb_l_base_multivect_mod, only : psb_l_base_multivect_type diff --git a/base/modules/desc/psb_desc_const_mod.f90 b/base/modules/desc/psb_desc_const_mod.f90 index 8c3937e01..aa2ea2fe0 100644 --- a/base/modules/desc/psb_desc_const_mod.f90 +++ b/base/modules/desc/psb_desc_const_mod.f90 @@ -104,9 +104,17 @@ module psb_desc_const_mod integer(psb_ipk_), parameter :: psb_hash_bits = 16 integer(psb_ipk_), parameter :: psb_max_hash_bits = 22 integer(psb_ipk_), parameter :: psb_hash_size = 2**psb_hash_bits, psb_hash_mask=psb_hash_size-1 - integer(psb_ipk_), parameter :: psb_default_large_threshold=1*1024*1024 integer(psb_ipk_), parameter :: psb_hpnt_nentries_ = 7 - + integer(psb_ipk_), parameter :: psb_default_large_threshold=1*1024*1024 + ! + ! Choice of algorithm for sparse matrix A2AV + ! + integer(psb_ipk_), parameter :: psb_sp_a2av_smpl_triad_ = 1 + integer(psb_ipk_), parameter :: psb_sp_a2av_smpl_v_ = 2 + integer(psb_ipk_), parameter :: psb_sp_a2av_mpi_ = 3 + integer(psb_ipk_), parameter :: psb_sp_a2av_alg_min_ = psb_sp_a2av_smpl_triad_ + integer(psb_ipk_), parameter :: psb_sp_a2av_alg_max_ = psb_sp_a2av_mpi_ + ! ! Constants for desc_a handling ! diff --git a/base/modules/desc/psb_desc_mod.F90 b/base/modules/desc/psb_desc_mod.F90 index fbc64c8cb..43ae58525 100644 --- a/base/modules/desc/psb_desc_mod.F90 +++ b/base/modules/desc/psb_desc_mod.F90 @@ -285,14 +285,6 @@ module psb_desc_mod module procedure psb_cdfree end interface psb_free - interface psb_cd_set_maxspace - module procedure psb_cd_set_maxspace - end interface psb_cd_set_maxspace - - interface psb_cd_get_maxspace - module procedure psb_cd_get_maxspace - end interface psb_cd_get_maxspace - interface psb_cd_set_large_threshold module procedure psb_i_cd_set_large_threshold end interface psb_cd_set_large_threshold @@ -302,7 +294,15 @@ module psb_desc_mod module procedure psb_l_cd_set_large_threshold end interface psb_cd_set_large_threshold #endif - + + interface psb_set_sp_a2av_alg + module procedure psb_m_set_sp_a2av_alg, psb_e_set_sp_a2av_alg + end interface psb_set_sp_a2av_alg + + interface psb_get_sp_a2av_alg + module procedure psb_m_get_sp_a2av_alg + end interface psb_get_sp_a2av_alg + private :: nullify_desc, cd_get_fmt,& & cd_l2gs1, cd_l2gs2, cd_l2gv1, cd_l2gv2, cd_g2ls1,& & cd_g2ls2, cd_g2lv1, cd_g2lv2, cd_g2ls1_ins,& @@ -310,11 +310,33 @@ module psb_desc_mod integer(psb_lpk_), private, save :: cd_large_threshold = psb_default_large_threshold - integer(psb_ipk_), private, save :: cd_maxspace = -1 - + integer(psb_ipk_), private, save :: sp_a2av_alg = psb_sp_a2av_smpl_triad_ contains + function psb_m_get_sp_a2av_alg() result(val) + implicit none + integer(psb_mpk_) :: val + val = sp_a2av_alg + end function psb_m_get_sp_a2av_alg + + subroutine psb_m_set_sp_a2av_alg(val) + implicit none + integer(psb_mpk_), intent(in) :: val + + if ((psb_sp_a2av_alg_min_ <= val).and.(val<=psb_sp_a2av_alg_max_)) & + & sp_a2av_alg = val + end subroutine psb_m_set_sp_a2av_alg + + subroutine psb_e_set_sp_a2av_alg(val) + implicit none + integer(psb_epk_), intent(in) :: val + + if ((psb_sp_a2av_alg_min_ <= val).and.(val<=psb_sp_a2av_alg_max_)) & + & sp_a2av_alg = val + end subroutine psb_e_set_sp_a2av_alg + + function psb_cd_sizeof(desc) result(val) implicit none !....Parameters... @@ -362,21 +384,6 @@ contains integer(psb_lpk_) :: val val = cd_large_threshold end function psb_cd_get_large_threshold - - - subroutine psb_cd_set_maxspace(ith) - implicit none - integer(psb_ipk_), intent(in) :: ith - if (ith > 0) then - cd_maxspace = ith - end if - end subroutine psb_cd_set_maxspace - - function psb_cd_get_maxspace() result(val) - implicit none - integer(psb_ipk_) :: val - val = cd_maxspace - end function psb_cd_get_maxspace function psb_cd_is_large_size(m) result(val) use psb_penv_mod diff --git a/base/modules/desc/psb_gen_block_map_mod.F90 b/base/modules/desc/psb_gen_block_map_mod.F90 index 255b05d11..b53713a5e 100644 --- a/base/modules/desc/psb_gen_block_map_mod.F90 +++ b/base/modules/desc/psb_gen_block_map_mod.F90 @@ -127,7 +127,7 @@ module psb_gen_block_map_mod #if defined(IPK4) && defined(LPK8) private :: l_gen_block_search #endif - + interface gen_block_search module procedure i_gen_block_search #if defined(IPK4) && defined(LPK8) @@ -373,7 +373,7 @@ contains integer(psb_ipk_), intent(out) :: info logical, intent(in), optional :: mask(:) logical, intent(in), optional :: owned - integer(psb_ipk_) :: i + integer(psb_lpk_) :: i logical :: owned_ info = 0 @@ -431,7 +431,7 @@ contains integer(psb_ipk_), intent(out) :: info logical, intent(in), optional :: mask(:) logical, intent(in), optional :: owned - integer(psb_ipk_) :: is, im, i + integer(psb_lpk_) :: is, im, i logical :: owned_ info = 0 @@ -806,7 +806,7 @@ contains logical, intent(in), optional :: owned integer(psb_ipk_) :: i, nv, is integer(psb_lpk_) :: tidx, ip, lip - integer(psb_mpk_) :: ictxt, iam, np + integer(psb_ipk_) :: ictxt, iam, np logical :: owned_ info = 0 @@ -922,7 +922,7 @@ contains integer(psb_ipk_) :: i, nv, is, im integer(psb_lpk_) :: tidx, ip, lip - integer(psb_mpk_) :: ictxt, iam, np + integer(psb_ipk_) :: ictxt, iam, np logical :: owned_ info = 0 @@ -1527,7 +1527,7 @@ contains logical, intent(in), optional :: mask(:) integer(psb_ipk_), intent(in), optional :: lidx(:) - integer(psb_ipk_) :: i, nv, is, ix + integer(psb_lpk_) :: i, nv, is, ix integer(psb_lpk_) :: ip, lip, lnxt integer(psb_ipk_) :: nxt @@ -1732,7 +1732,7 @@ contains logical, intent(in), optional :: mask(:) integer(psb_ipk_), intent(in), optional :: lidx(:) - integer(psb_ipk_) :: i, nv, is, ix, im + integer(psb_lpk_) :: i, nv, is, ix, im integer(psb_lpk_) :: ip, lip, lnxt integer(psb_ipk_) :: nxt @@ -1964,11 +1964,11 @@ contains use psb_error_mod implicit none class(psb_gen_block_map), intent(inout) :: idxmap - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_ipk_), intent(in) :: nl integer(psb_ipk_), intent(out) :: info ! To be implemented - integer(psb_mpk_) :: iam, np + integer(psb_ipk_) :: iam, np integer(psb_ipk_) :: i integer(psb_lpk_) :: ntot integer(psb_lpk_), allocatable :: vnl(:) @@ -2030,7 +2030,7 @@ contains integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: nhal, i - integer(psb_mpk_) :: ictxt, iam, np + integer(psb_ipk_) :: ictxt, iam, np logical :: debug=.false. info = 0 ictxt = idxmap%get_ctxt() diff --git a/base/modules/desc/psb_glist_map_mod.f90 b/base/modules/desc/psb_glist_map_mod.f90 index 3298291a9..69169b173 100644 --- a/base/modules/desc/psb_glist_map_mod.f90 +++ b/base/modules/desc/psb_glist_map_mod.f90 @@ -96,11 +96,11 @@ contains use psb_error_mod implicit none class(psb_glist_map), intent(inout) :: idxmap - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_ipk_), intent(in) :: vg(:) integer(psb_ipk_), intent(out) :: info ! To be implemented - integer(psb_mpk_) :: iam, np + integer(psb_ipk_) :: iam, np integer(psb_ipk_) :: nl integer(psb_lpk_) :: i, n diff --git a/base/modules/desc/psb_hash_map_mod.f90 b/base/modules/desc/psb_hash_map_mod.f90 index 02eff7a4a..ae109d5a5 100644 --- a/base/modules/desc/psb_hash_map_mod.f90 +++ b/base/modules/desc/psb_hash_map_mod.f90 @@ -94,8 +94,8 @@ module psb_hash_map_mod procedure, pass(idxmap) :: lg2lv1_ins => hash_g2lv1_ins procedure, pass(idxmap) :: lg2lv2_ins => hash_g2lv2_ins - procedure, pass(idxmap) :: hash_cpy - generic, public :: assignment(=) => hash_cpy +!!$ procedure, pass(idxmap) :: hash_cpy +!!$ generic, public :: assignment(=) => hash_cpy procedure, pass(idxmap) :: bld_g2l_map => hash_bld_g2l_map end type psb_hash_map @@ -805,11 +805,11 @@ contains use psb_realloc_mod implicit none class(psb_hash_map), intent(inout) :: idxmap - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_lpk_), intent(in) :: vl(:) integer(psb_ipk_), intent(out) :: info ! To be implemented - integer(psb_mpk_) :: iam, np + integer(psb_ipk_) :: iam, np integer(psb_ipk_) :: i, nlu, nl, int_err(5) integer(psb_lpk_) :: m, nrt integer(psb_lpk_), allocatable :: vlu(:) @@ -878,11 +878,11 @@ contains use psb_error_mod implicit none class(psb_hash_map), intent(inout) :: idxmap - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_ipk_), intent(in) :: vg(:) integer(psb_ipk_), intent(out) :: info ! To be implemented - integer(psb_mpk_) :: iam, np + integer(psb_ipk_) :: iam, np integer(psb_ipk_) :: i, j, nl, int_err(5) integer(psb_lpk_) :: n integer(psb_lpk_), allocatable :: vlu(:) @@ -938,12 +938,12 @@ contains use psb_realloc_mod implicit none class(psb_hash_map), intent(inout) :: idxmap - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_lpk_), intent(in) :: vlu(:), ntot integer(psb_ipk_), intent(in) :: nl integer(psb_ipk_), intent(out) :: info ! To be implemented - integer(psb_mpk_) :: iam, np + integer(psb_ipk_) :: iam, np integer(psb_ipk_) :: i, j, lc2, nlu, m, nrt,int_err(5) character(len=20), parameter :: name='hash_map_init_vlu' @@ -1464,7 +1464,7 @@ contains end if select type (outmap) - type is (psb_hash_map) + type is (psb_hash_map) call idxmap%psb_indx_map%cpy(outmap%psb_indx_map,info) if (info == psb_success_) then outmap%hashvsize = idxmap%hashvsize @@ -1478,7 +1478,7 @@ contains & call psb_safe_ab_cpy(idxmap%glb_lc,outmap%glb_lc,info) if (info == psb_success_)& & call psb_hash_copy(idxmap%hash,outmap%hash,info) -!!$ outmap = idxmap + class default ! This should be impossible info = -1 @@ -1499,30 +1499,30 @@ contains end subroutine hash_clone - subroutine hash_cpy(outmap,idxmap) - use psb_penv_mod - use psb_error_mod - use psb_realloc_mod - implicit none - class(psb_hash_map), intent(in) :: idxmap - type(psb_hash_map), intent(out) :: outmap - integer(psb_ipk_) :: info - - info = psb_success_ - outmap%psb_indx_map = idxmap%psb_indx_map - outmap%hashvsize = idxmap%hashvsize - outmap%hashvmask = idxmap%hashvmask - if (info == psb_success_)& - & call psb_safe_ab_cpy(idxmap%loc_to_glob,outmap%loc_to_glob,info) - if (info == psb_success_)& - & call psb_safe_ab_cpy(idxmap%hashv,outmap%hashv,info) - if (info == psb_success_)& - & call psb_safe_ab_cpy(idxmap%glb_lc,outmap%glb_lc,info) - if (info == psb_success_)& - & call psb_hash_copy(idxmap%hash,outmap%hash,info) - end subroutine hash_cpy - - +!!$ subroutine hash_cpy(outmap,idxmap) +!!$ use psb_penv_mod +!!$ use psb_error_mod +!!$ use psb_realloc_mod +!!$ implicit none +!!$ class(psb_hash_map), intent(in) :: idxmap +!!$ type(psb_hash_map), intent(out) :: outmap +!!$ integer(psb_ipk_) :: info +!!$ +!!$ info = psb_success_ +!!$ call idxmap%psb_indx_map%cpy(outmap%psb_indx_map,info) +!!$ if (info == psb_success_) then +!!$ outmap%hashvsize = idxmap%hashvsize +!!$ outmap%hashvmask = idxmap%hashvmask +!!$ end if +!!$ if (info == psb_success_)& +!!$ & call psb_safe_ab_cpy(idxmap%loc_to_glob,outmap%loc_to_glob,info) +!!$ if (info == psb_success_)& +!!$ & call psb_safe_ab_cpy(idxmap%hashv,outmap%hashv,info) +!!$ if (info == psb_success_)& +!!$ & call psb_safe_ab_cpy(idxmap%glb_lc,outmap%glb_lc,info) +!!$ if (info == psb_success_)& +!!$ & call psb_hash_copy(idxmap%hash,outmap%hash,info) +!!$ end subroutine hash_cpy subroutine hash_reinit(idxmap,info) use psb_penv_mod @@ -1534,8 +1534,8 @@ contains integer(psb_ipk_) :: err_act, nr,nc,k, nl integer(psb_lpk_) :: lk integer(psb_lpk_) :: ntot - integer(psb_mpk_) :: ictxt, me, np - integer(psb_ipk_), allocatable :: lidx(:) + integer(psb_ipk_) :: ictxt, me, np + integer(psb_ipk_), allocatable :: lidx(:), tadj(:), th_own(:) integer(psb_lpk_), allocatable :: gidx(:) character(len=20) :: name='hash_reinit' logical, parameter :: debug=.false. @@ -1551,13 +1551,16 @@ contains lidx = (/(k,k=1,nc)/) gidx = (/(lk,lk=1,nc)/) call idxmap%l2gip(gidx,info) - + tadj = idxmap%get_p_adjcncy() + call idxmap%get_halo_owner(th_own,info) + call idxmap%free() call hash_init_vlu(idxmap,ictxt,ntot,nr,gidx(1:nr),info) if (nc>nr) then call idxmap%g2lip_ins(gidx(nr+1:nc),info,lidx=lidx(nr+1:nc)) end if - + call idxmap%set_p_adjcncy(tadj) + call idxmap%set_halo_owner(th_own,info) if (info /= psb_success_) then info = psb_err_from_subroutine_ diff --git a/base/modules/desc/psb_hash_mod.F90 b/base/modules/desc/psb_hash_mod.F90 index 76c02fc5b..42911e3ff 100644 --- a/base/modules/desc/psb_hash_mod.F90 +++ b/base/modules/desc/psb_hash_mod.F90 @@ -64,8 +64,11 @@ module psb_hash_mod end type psb_hash_type - integer(psb_ipk_), parameter :: HashDuplicate = 123, HashOK=0, HashOutOfMemory=-512,& - & HashFreeEntry = -1, HashNotFound = -256 + integer(psb_ipk_), parameter :: HashOK=0 + integer(psb_ipk_), parameter :: HashDuplicate = 123 + integer(psb_ipk_), parameter :: HashOutOfMemory=-512 + integer(psb_ipk_), parameter :: HashFreeEntry = -1 + integer(psb_ipk_), parameter :: HashNotFound = -256 interface psb_hashval #if defined(IPK4) @@ -391,7 +394,7 @@ contains hd = 1 else hd = hsize - hk - hd = ior(hd,1) + hd = ior(hd,1_psb_ipk_) end if if (.not.allocated(hash%table)) then info = HashOutOfMemory @@ -451,7 +454,7 @@ contains hd = 1 else hd = hsize - hk - hd = ior(hd,1) + hd = ior(hd,1_psb_ipk_) end if if (.not.allocated(hash%table)) then info = HashOutOfMemory @@ -515,7 +518,7 @@ contains hd = 1 else hd = hsize - hk - hd = ior(hd,1) + hd = ior(hd,1_psb_ipk_) end if hash%nsrch = hash%nsrch + 1 @@ -555,7 +558,7 @@ contains hd = 1 else hd = hsize - hk - hd = ior(hd,1) + hd = ior(hd,1_psb_ipk_) end if hash%nsrch = hash%nsrch + 1 diff --git a/base/modules/desc/psb_indx_map_mod.f90 b/base/modules/desc/psb_indx_map_mod.f90 index 378b38afe..710e2ea9f 100644 --- a/base/modules/desc/psb_indx_map_mod.f90 +++ b/base/modules/desc/psb_indx_map_mod.f90 @@ -29,7 +29,7 @@ ! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE ! POSSIBILITY OF SUCH DAMAGE. ! -!!$ +! ! ! ! package: psb_indx_map_mod @@ -108,7 +108,7 @@ module psb_indx_map_mod !> State of the map integer(psb_ipk_) :: state = psb_desc_null_ !> Communication context - integer(psb_mpk_) :: ictxt = -1 + integer(psb_ipk_) :: ictxt = -1 !> MPI communicator integer(psb_mpk_) :: mpic = -1 !> Number of global rows @@ -278,13 +278,14 @@ module psb_indx_map_mod end interface interface - subroutine psi_a2a_fnd_owner(idx,iprc,idxmap,info) + subroutine psi_a2a_fnd_owner(idx,iprc,idxmap,info,samesize) import :: psb_indx_map, psb_ipk_, psb_lpk_ implicit none integer(psb_lpk_), intent(in) :: idx(:) integer(psb_ipk_), allocatable, intent(out) :: iprc(:) class(psb_indx_map), intent(in) :: idxmap integer(psb_ipk_), intent(out) :: info + logical, intent(in), optional :: samesize end subroutine psi_a2a_fnd_owner end interface @@ -311,6 +312,25 @@ module psb_indx_map_mod end subroutine psi_graph_fnd_owner end interface + interface psb_cd_set_maxspace + module procedure psb_cd_set_maxspace + end interface psb_cd_set_maxspace + + interface psb_cd_get_maxspace + module procedure psb_cd_get_maxspace + end interface psb_cd_get_maxspace + + interface psb_cd_set_samplesize + module procedure psb_cd_set_samplesize + end interface psb_cd_set_samplesize + + interface psb_cd_get_samplesize + module procedure psb_cd_get_samplesize + end interface psb_cd_get_samplesize + + integer(psb_ipk_), private, save :: cd_maxspace = -1 + integer(psb_ipk_), private, save :: samplesize = 32 + integer, parameter :: psi_symm_flag_norv_ = 0 integer, parameter :: psi_symm_flag_inrv_ = 1 interface psi_symm_dep_list @@ -331,9 +351,69 @@ module psb_indx_map_mod end subroutine psi_symm_dep_list_norv end interface psi_symm_dep_list + integer(psb_mpk_), parameter :: psi_adj_fnd_irecv_ = 0 + integer(psb_mpk_), parameter :: psi_adj_fnd_a2av_ = 1 + integer(psb_mpk_), parameter :: psi_adj_fnd_pbrcv_ = 2 + integer(psb_mpk_), parameter :: psi_adj_alg_max_ = psi_adj_fnd_pbrcv_ + integer(psb_mpk_), save :: psi_adj_alg = psi_adj_fnd_irecv_ + contains + subroutine psi_set_adj_alg(ialg) + integer(psb_mpk_), intent(in) :: ialg + if ((ialg >=0) .and. (ialg <= psi_adj_alg_max_))& + & psi_adj_alg = ialg + end subroutine psi_set_adj_alg + function psi_get_adj_alg() result(val) + integer(psb_mpk_) :: val + val = psi_adj_alg + end function psi_get_adj_alg + + function psi_get_adj_alg_fmt() result(val) + character(len=20) :: val + select case(psi_adj_alg) + case(psi_adj_fnd_a2av_) + val = 'MPI_A2AV' + case(psi_adj_fnd_irecv_) + val = 'MPI_ISEND/IRECV' + case(psi_adj_fnd_pbrcv_) + val = 'PSB_SND/RCV' + case default + val = 'Unknown ?' + end select + end function psi_get_adj_alg_fmt + + subroutine psb_cd_set_maxspace(ith) + implicit none + integer(psb_ipk_), intent(in) :: ith + if (ith > 0) then + cd_maxspace = ith + end if + end subroutine psb_cd_set_maxspace + + function psb_cd_get_maxspace() result(val) + implicit none + integer(psb_ipk_) :: val + val = cd_maxspace + end function psb_cd_get_maxspace + + + subroutine psb_cd_set_samplesize(ith) + implicit none + integer(psb_ipk_), intent(in) :: ith + if (ith > 0) then + samplesize = ith + end if + end subroutine psb_cd_set_samplesize + + function psb_cd_get_samplesize() result(val) + implicit none + integer(psb_ipk_) :: val + val = samplesize + end function psb_cd_get_samplesize + + !> !! \memberof psb_indx_map !! \brief Print a descriptive name @@ -407,7 +487,7 @@ contains function base_get_ctxt(idxmap) result(val) implicit none class(psb_indx_map), intent(in) :: idxmap - integer(psb_mpk_) :: val + integer(psb_ipk_) :: val val = idxmap%ictxt @@ -435,7 +515,7 @@ contains subroutine base_set_ctxt(idxmap,val) implicit none class(psb_indx_map), intent(inout) :: idxmap - integer(psb_mpk_), intent(in) :: val + integer(psb_ipk_), intent(in) :: val idxmap%ictxt = val end subroutine base_set_ctxt @@ -1268,7 +1348,7 @@ contains use psb_error_mod implicit none class(psb_indx_map), intent(inout) :: idxmap - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_lpk_), intent(in) :: vl(:) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act @@ -1390,7 +1470,7 @@ contains integer(psb_ipk_), intent(in) :: v(:) integer(psb_ipk_), intent(out) :: info ! - integer(psb_mpk_) :: me, np + integer(psb_ipk_) :: me, np integer(psb_ipk_) :: i, j, nr, nc, nh call psb_info(idxmap%ictxt,me,np) @@ -1406,6 +1486,7 @@ contains end subroutine base_set_halo_owner subroutine base_get_halo_owner(idxmap,v,info) + use psb_realloc_mod use psb_penv_mod use psb_error_mod implicit none @@ -1414,13 +1495,15 @@ contains integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: nh - nh = min(size(v),size(idxmap%halo_owner)) - v(1:nh) = idxmap%halo_owner(1:nh) + nh = size(idxmap%halo_owner) + !v = idxmap%halo_owner(1:nh) + call psb_safe_ab_cpy(idxmap%halo_owner,v,info) end subroutine base_get_halo_owner subroutine base_fnd_halo_owner_s(idxmap,xin,xout,info) use psb_penv_mod use psb_error_mod + use psb_realloc_mod implicit none class(psb_indx_map), intent(inout) :: idxmap integer(psb_ipk_), intent(in) :: xin @@ -1430,16 +1513,17 @@ contains integer(psb_ipk_) :: i, j, nr, nc, nh nr = idxmap%local_rows nc = idxmap%local_cols + nc = min(idxmap%local_cols, (nr+psb_size(idxmap%halo_owner))) xout = -1 if (.not.allocated(idxmap%halo_owner)) then !write(0,*) 'Halo_owner not allocated!', nr, nc, xin return end if if ((nr 0) then + idx = bsdindx(ip+1) + call psb_snd(ictxt,valsnd(idx+1:idx+sz),ip) + end if + end do + + do ip = 0, np-1 + sz = rvsz(ip+1) + if (sz > 0) then + idx = brvindx(ip+1) + call psb_rcv(ictxt,valrcv(idx+1:idx+sz),ip) + end if + end do + + end subroutine psb_c_simple_a2av + + subroutine psb_c_m_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & valrcv,iarcv,jarcv,rvsz,brvindx,ictxt,info) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + complex(psb_spk_), intent(in) :: valsnd(:) + integer(psb_mpk_), intent(in) :: iasnd(:), jasnd(:) + complex(psb_spk_), intent(out) :: valrcv(:) + integer(psb_mpk_), intent(out) :: iarcv(:), jarcv(:) + integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) + integer(psb_ipk_), intent(in) :: ictxt + integer(psb_ipk_), intent(out) :: info + + !Local variables + integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz, counter + integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm + integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) + + call psb_info(ictxt,iam,np) + + icomm = psb_get_mpi_comm(ictxt) + + if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then + prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + idx = brvindx(ip+1) + p2ptag = psb_complex_tag + call mpi_irecv(valrcv(idx+1:idx+sz),sz,& + & psb_mpi_c_spk_,prcid(ip+1),& + & p2ptag, icomm,rvhd(ip+1,1),iret) + p2ptag = psb_int_swap_tag + call mpi_irecv(iarcv(idx+1:idx+sz),sz,& + & psb_mpi_mpk_,prcid(ip+1),& + & p2ptag, icomm,rvhd(ip+1,2),iret) + call mpi_irecv(jarcv(idx+1:idx+sz),sz,& + & psb_mpi_mpk_,prcid(ip+1),& + & p2ptag, icomm,rvhd(ip+1,3),iret) + end if + Enddo + + + do ip = 0, np-1 + sz = sdsz(ip+1) + if (sz > 0) then + if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + idx = bsdindx(ip+1) + p2ptag = psb_complex_tag + call mpi_send(valsnd(idx+1:idx+sz),sz,& + & psb_mpi_c_spk_,prcid(ip+1),& + & p2ptag, icomm,iret) + p2ptag = psb_int_swap_tag + call mpi_send(iasnd(idx+1:idx+sz),sz,& + & psb_mpi_mpk_,prcid(ip+1),& + & p2ptag, icomm,iret) + call mpi_send(jasnd(idx+1:idx+sz),sz,& + & psb_mpi_mpk_,prcid(ip+1),& + & p2ptag, icomm,iret) + end if + Enddo + + do ip = 0, np-1 + sz = rvsz(ip+1) + if (sz > 0) then + call mpi_wait(rvhd(ip+1,1),p2pstat,iret) + call mpi_wait(rvhd(ip+1,2),p2pstat,iret) + call mpi_wait(rvhd(ip+1,3),p2pstat,iret) + end if + Enddo + + end subroutine psb_c_m_simple_triad_a2av + + subroutine psb_c_e_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & valrcv,iarcv,jarcv,rvsz,brvindx,ictxt,info) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + complex(psb_spk_), intent(in) :: valsnd(:) + integer(psb_epk_), intent(in) :: iasnd(:), jasnd(:) + complex(psb_spk_), intent(out) :: valrcv(:) + integer(psb_epk_), intent(out) :: iarcv(:), jarcv(:) + integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) + integer(psb_ipk_), intent(in) :: ictxt + integer(psb_ipk_), intent(out) :: info + + !Local variables + integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz, counter + integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm + integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) + + call psb_info(ictxt,iam,np) + + icomm = psb_get_mpi_comm(ictxt) + + if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then + prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + idx = brvindx(ip+1) + p2ptag = psb_complex_tag + call mpi_irecv(valrcv(idx+1:idx+sz),sz,& + & psb_mpi_c_spk_,prcid(ip+1),& + & p2ptag, icomm,rvhd(ip+1,1),iret) + p2ptag = psb_int_swap_tag + call mpi_irecv(iarcv(idx+1:idx+sz),sz,& + & psb_mpi_epk_,prcid(ip+1),& + & p2ptag, icomm,rvhd(ip+1,2),iret) + call mpi_irecv(jarcv(idx+1:idx+sz),sz,& + & psb_mpi_epk_,prcid(ip+1),& + & p2ptag, icomm,rvhd(ip+1,3),iret) + end if + Enddo + + + do ip = 0, np-1 + sz = sdsz(ip+1) + if (sz > 0) then + if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + idx = bsdindx(ip+1) + p2ptag = psb_complex_tag + call mpi_send(valsnd(idx+1:idx+sz),sz,& + & psb_mpi_r_dpk_,prcid(ip+1),& + & p2ptag, icomm,iret) + p2ptag = psb_int_swap_tag + call mpi_send(iasnd(idx+1:idx+sz),sz,& + & psb_mpi_epk_,prcid(ip+1),& + & p2ptag, icomm,iret) + call mpi_send(jasnd(idx+1:idx+sz),sz,& + & psb_mpi_epk_,prcid(ip+1),& + & p2ptag, icomm,iret) + end if + Enddo + + do ip = 0, np-1 + sz = rvsz(ip+1) + if (sz > 0) then + call mpi_wait(rvhd(ip+1,1),p2pstat,iret) + call mpi_wait(rvhd(ip+1,2),p2pstat,iret) + call mpi_wait(rvhd(ip+1,3),p2pstat,iret) + end if + Enddo + + end subroutine psb_c_e_simple_triad_a2av + end module psi_c_collective_mod diff --git a/base/modules/penv/psi_d_collective_mod.F90 b/base/modules/penv/psi_d_collective_mod.F90 index fa022233d..eb848a9fe 100644 --- a/base/modules/penv/psi_d_collective_mod.F90 +++ b/base/modules/penv/psi_d_collective_mod.F90 @@ -31,6 +31,7 @@ ! module psi_d_collective_mod use psi_penv_mod + use psi_comm_buffers_mod interface psb_max module procedure psb_dmaxs, psb_dmaxv, psb_dmaxm, & @@ -76,7 +77,13 @@ module psi_d_collective_mod module procedure psb_dexscan_sums, psb_dexscan_sumv end interface psb_exscan_sum + interface psb_simple_a2av + module procedure psb_d_simple_a2av + end interface psb_simple_a2av + interface psb_simple_triad_a2av + module procedure psb_d_e_simple_triad_a2av, psb_d_m_simple_triad_a2av + end interface psb_simple_triad_a2av contains @@ -1255,16 +1262,17 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt real(psb_dpk_), intent(inout) :: dat real(psb_dpk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) - call mpi_scan(dat,dat_,1,psb_mpi_r_dpk_,mpi_sum,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_scan(dat,dat_,1,psb_mpi_r_dpk_,mpi_sum,icomm,minfo) dat = dat_ #endif end subroutine psb_dscan_sums @@ -1278,16 +1286,17 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt real(psb_dpk_), intent(inout) :: dat real(psb_dpk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: icomm, minfo #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) - call mpi_exscan(dat,dat_,1,psb_mpi_r_dpk_,mpi_sum,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_exscan(dat,dat_,1,psb_mpi_r_dpk_,mpi_sum,icomm,minfo) dat = dat_ #else dat = dzero @@ -1303,20 +1312,21 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt real(psb_dpk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root + integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ real(psb_dpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) - call psb_realloc(size(dat),dat_,iinfo) + icomm = psb_get_mpi_comm(ictxt) + call psb_realloc(size(dat),dat_,info) dat_ = dat - if (iinfo == psb_success_) & - & call mpi_scan(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_sum,ictxt,info) + if (info == psb_success_) & + & call mpi_scan(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_sum,icomm,minfo) #endif end subroutine psb_dscan_sumv @@ -1329,23 +1339,228 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt real(psb_dpk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root + integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ real(psb_dpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) - call psb_realloc(size(dat),dat_,iinfo) + icomm = psb_get_mpi_comm(ictxt) + call psb_realloc(size(dat),dat_,info) dat_ = dat - if (iinfo == psb_success_) & - & call mpi_exscan(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_sum,ictxt,info) + if (info == psb_success_) & + & call mpi_exscan(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_sum,icomm,minfo) #else dat = dzero #endif end subroutine psb_dexscan_sumv + + subroutine psb_d_simple_a2av(valsnd,sdsz,bsdindx,& + & valrcv,rvsz,brvindx,ictxt,info) + use psi_d_p2p_mod + implicit none + real(psb_dpk_), intent(in) :: valsnd(:) + real(psb_dpk_), intent(out) :: valrcv(:) + integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) + integer(psb_ipk_), intent(in) :: ictxt + integer(psb_ipk_), intent(out) :: info + + integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz + + call psb_info(ictxt,iam,np) + + if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then + idx = bsdindx(ip+1) + call psb_snd(ictxt,valsnd(idx+1:idx+sz),ip) + end if + end do + + do ip = 0, np-1 + sz = rvsz(ip+1) + if (sz > 0) then + idx = brvindx(ip+1) + call psb_rcv(ictxt,valrcv(idx+1:idx+sz),ip) + end if + end do + + end subroutine psb_d_simple_a2av + + subroutine psb_d_m_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & valrcv,iarcv,jarcv,rvsz,brvindx,ictxt,info) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + real(psb_dpk_), intent(in) :: valsnd(:) + integer(psb_mpk_), intent(in) :: iasnd(:), jasnd(:) + real(psb_dpk_), intent(out) :: valrcv(:) + integer(psb_mpk_), intent(out) :: iarcv(:), jarcv(:) + integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) + integer(psb_ipk_), intent(in) :: ictxt + integer(psb_ipk_), intent(out) :: info + + !Local variables + integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz, counter + integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm + integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) + + call psb_info(ictxt,iam,np) + + icomm = psb_get_mpi_comm(ictxt) + + if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then + prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + idx = brvindx(ip+1) + p2ptag = psb_double_tag + call mpi_irecv(valrcv(idx+1:idx+sz),sz,& + & psb_mpi_r_dpk_,prcid(ip+1),& + & p2ptag, icomm,rvhd(ip+1,1),iret) + p2ptag = psb_int_swap_tag + call mpi_irecv(iarcv(idx+1:idx+sz),sz,& + & psb_mpi_mpk_,prcid(ip+1),& + & p2ptag, icomm,rvhd(ip+1,2),iret) + call mpi_irecv(jarcv(idx+1:idx+sz),sz,& + & psb_mpi_mpk_,prcid(ip+1),& + & p2ptag, icomm,rvhd(ip+1,3),iret) + end if + Enddo + + + do ip = 0, np-1 + sz = sdsz(ip+1) + if (sz > 0) then + if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + idx = bsdindx(ip+1) + p2ptag = psb_double_tag + call mpi_send(valsnd(idx+1:idx+sz),sz,& + & psb_mpi_r_dpk_,prcid(ip+1),& + & p2ptag, icomm,iret) + p2ptag = psb_int_swap_tag + call mpi_send(iasnd(idx+1:idx+sz),sz,& + & psb_mpi_mpk_,prcid(ip+1),& + & p2ptag, icomm,iret) + call mpi_send(jasnd(idx+1:idx+sz),sz,& + & psb_mpi_mpk_,prcid(ip+1),& + & p2ptag, icomm,iret) + end if + Enddo + + do ip = 0, np-1 + sz = rvsz(ip+1) + if (sz > 0) then + call mpi_wait(rvhd(ip+1,1),p2pstat,iret) + call mpi_wait(rvhd(ip+1,2),p2pstat,iret) + call mpi_wait(rvhd(ip+1,3),p2pstat,iret) + end if + Enddo + + end subroutine psb_d_m_simple_triad_a2av + + subroutine psb_d_e_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & valrcv,iarcv,jarcv,rvsz,brvindx,ictxt,info) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + real(psb_dpk_), intent(in) :: valsnd(:) + integer(psb_epk_), intent(in) :: iasnd(:), jasnd(:) + real(psb_dpk_), intent(out) :: valrcv(:) + integer(psb_epk_), intent(out) :: iarcv(:), jarcv(:) + integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) + integer(psb_ipk_), intent(in) :: ictxt + integer(psb_ipk_), intent(out) :: info + + !Local variables + integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz, counter + integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm + integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) + + call psb_info(ictxt,iam,np) + + icomm = psb_get_mpi_comm(ictxt) + + if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then + prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + idx = brvindx(ip+1) + p2ptag = psb_double_tag + call mpi_irecv(valrcv(idx+1:idx+sz),sz,& + & psb_mpi_r_dpk_,prcid(ip+1),& + & p2ptag, icomm,rvhd(ip+1,1),iret) + p2ptag = psb_int_swap_tag + call mpi_irecv(iarcv(idx+1:idx+sz),sz,& + & psb_mpi_epk_,prcid(ip+1),& + & p2ptag, icomm,rvhd(ip+1,2),iret) + call mpi_irecv(jarcv(idx+1:idx+sz),sz,& + & psb_mpi_epk_,prcid(ip+1),& + & p2ptag, icomm,rvhd(ip+1,3),iret) + end if + Enddo + + + do ip = 0, np-1 + sz = sdsz(ip+1) + if (sz > 0) then + if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + idx = bsdindx(ip+1) + p2ptag = psb_double_tag + call mpi_send(valsnd(idx+1:idx+sz),sz,& + & psb_mpi_r_dpk_,prcid(ip+1),& + & p2ptag, icomm,iret) + p2ptag = psb_int_swap_tag + call mpi_send(iasnd(idx+1:idx+sz),sz,& + & psb_mpi_epk_,prcid(ip+1),& + & p2ptag, icomm,iret) + call mpi_send(jasnd(idx+1:idx+sz),sz,& + & psb_mpi_epk_,prcid(ip+1),& + & p2ptag, icomm,iret) + end if + Enddo + + do ip = 0, np-1 + sz = rvsz(ip+1) + if (sz > 0) then + call mpi_wait(rvhd(ip+1,1),p2pstat,iret) + call mpi_wait(rvhd(ip+1,2),p2pstat,iret) + call mpi_wait(rvhd(ip+1,3),p2pstat,iret) + end if + Enddo + + end subroutine psb_d_e_simple_triad_a2av + end module psi_d_collective_mod diff --git a/base/modules/penv/psi_e_collective_mod.F90 b/base/modules/penv/psi_e_collective_mod.F90 index 59e74280a..4c3a006ed 100644 --- a/base/modules/penv/psi_e_collective_mod.F90 +++ b/base/modules/penv/psi_e_collective_mod.F90 @@ -31,6 +31,7 @@ ! module psi_e_collective_mod use psi_penv_mod + use psi_comm_buffers_mod interface psb_max module procedure psb_emaxs, psb_emaxv, psb_emaxm, & @@ -72,7 +73,13 @@ module psi_e_collective_mod module procedure psb_eexscan_sums, psb_eexscan_sumv end interface psb_exscan_sum + interface psb_simple_a2av + module procedure psb_e_simple_a2av + end interface psb_simple_a2av + interface psb_simple_triad_a2av + module procedure psb_e_e_simple_triad_a2av, psb_e_m_simple_triad_a2av + end interface psb_simple_triad_a2av contains @@ -1132,16 +1139,17 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_epk_), intent(inout) :: dat integer(psb_epk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) - call mpi_scan(dat,dat_,1,psb_mpi_epk_,mpi_sum,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_scan(dat,dat_,1,psb_mpi_epk_,mpi_sum,icomm,minfo) dat = dat_ #endif end subroutine psb_escan_sums @@ -1155,16 +1163,17 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_epk_), intent(inout) :: dat integer(psb_epk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: icomm, minfo #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) - call mpi_exscan(dat,dat_,1,psb_mpi_epk_,mpi_sum,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_exscan(dat,dat_,1,psb_mpi_epk_,mpi_sum,icomm,minfo) dat = dat_ #else dat = ezero @@ -1180,20 +1189,21 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_epk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root + integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_epk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) - call psb_realloc(size(dat),dat_,iinfo) + icomm = psb_get_mpi_comm(ictxt) + call psb_realloc(size(dat),dat_,info) dat_ = dat - if (iinfo == psb_success_) & - & call mpi_scan(dat,dat_,size(dat),psb_mpi_epk_,mpi_sum,ictxt,info) + if (info == psb_success_) & + & call mpi_scan(dat,dat_,size(dat),psb_mpi_epk_,mpi_sum,icomm,minfo) #endif end subroutine psb_escan_sumv @@ -1206,23 +1216,228 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_epk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root + integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_epk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) - call psb_realloc(size(dat),dat_,iinfo) + icomm = psb_get_mpi_comm(ictxt) + call psb_realloc(size(dat),dat_,info) dat_ = dat - if (iinfo == psb_success_) & - & call mpi_exscan(dat,dat_,size(dat),psb_mpi_epk_,mpi_sum,ictxt,info) + if (info == psb_success_) & + & call mpi_exscan(dat,dat_,size(dat),psb_mpi_epk_,mpi_sum,icomm,minfo) #else dat = ezero #endif end subroutine psb_eexscan_sumv + + subroutine psb_e_simple_a2av(valsnd,sdsz,bsdindx,& + & valrcv,rvsz,brvindx,ictxt,info) + use psi_e_p2p_mod + implicit none + integer(psb_epk_), intent(in) :: valsnd(:) + integer(psb_epk_), intent(out) :: valrcv(:) + integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) + integer(psb_ipk_), intent(in) :: ictxt + integer(psb_ipk_), intent(out) :: info + + integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz + + call psb_info(ictxt,iam,np) + + if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then + idx = bsdindx(ip+1) + call psb_snd(ictxt,valsnd(idx+1:idx+sz),ip) + end if + end do + + do ip = 0, np-1 + sz = rvsz(ip+1) + if (sz > 0) then + idx = brvindx(ip+1) + call psb_rcv(ictxt,valrcv(idx+1:idx+sz),ip) + end if + end do + + end subroutine psb_e_simple_a2av + + subroutine psb_e_m_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & valrcv,iarcv,jarcv,rvsz,brvindx,ictxt,info) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_epk_), intent(in) :: valsnd(:) + integer(psb_mpk_), intent(in) :: iasnd(:), jasnd(:) + integer(psb_epk_), intent(out) :: valrcv(:) + integer(psb_mpk_), intent(out) :: iarcv(:), jarcv(:) + integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) + integer(psb_ipk_), intent(in) :: ictxt + integer(psb_ipk_), intent(out) :: info + + !Local variables + integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz, counter + integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm + integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) + + call psb_info(ictxt,iam,np) + + icomm = psb_get_mpi_comm(ictxt) + + if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then + prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + idx = brvindx(ip+1) + p2ptag = psb_int8_tag + call mpi_irecv(valrcv(idx+1:idx+sz),sz,& + & psb_mpi_epk_,prcid(ip+1),& + & p2ptag, icomm,rvhd(ip+1,1),iret) + p2ptag = psb_int_swap_tag + call mpi_irecv(iarcv(idx+1:idx+sz),sz,& + & psb_mpi_mpk_,prcid(ip+1),& + & p2ptag, icomm,rvhd(ip+1,2),iret) + call mpi_irecv(jarcv(idx+1:idx+sz),sz,& + & psb_mpi_mpk_,prcid(ip+1),& + & p2ptag, icomm,rvhd(ip+1,3),iret) + end if + Enddo + + + do ip = 0, np-1 + sz = sdsz(ip+1) + if (sz > 0) then + if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + idx = bsdindx(ip+1) + p2ptag = psb_int8_tag + call mpi_send(valsnd(idx+1:idx+sz),sz,& + & psb_mpi_epk_,prcid(ip+1),& + & p2ptag, icomm,iret) + p2ptag = psb_int_swap_tag + call mpi_send(iasnd(idx+1:idx+sz),sz,& + & psb_mpi_mpk_,prcid(ip+1),& + & p2ptag, icomm,iret) + call mpi_send(jasnd(idx+1:idx+sz),sz,& + & psb_mpi_mpk_,prcid(ip+1),& + & p2ptag, icomm,iret) + end if + Enddo + + do ip = 0, np-1 + sz = rvsz(ip+1) + if (sz > 0) then + call mpi_wait(rvhd(ip+1,1),p2pstat,iret) + call mpi_wait(rvhd(ip+1,2),p2pstat,iret) + call mpi_wait(rvhd(ip+1,3),p2pstat,iret) + end if + Enddo + + end subroutine psb_e_m_simple_triad_a2av + + subroutine psb_e_e_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & valrcv,iarcv,jarcv,rvsz,brvindx,ictxt,info) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_epk_), intent(in) :: valsnd(:) + integer(psb_epk_), intent(in) :: iasnd(:), jasnd(:) + integer(psb_epk_), intent(out) :: valrcv(:) + integer(psb_epk_), intent(out) :: iarcv(:), jarcv(:) + integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) + integer(psb_ipk_), intent(in) :: ictxt + integer(psb_ipk_), intent(out) :: info + + !Local variables + integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz, counter + integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm + integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) + + call psb_info(ictxt,iam,np) + + icomm = psb_get_mpi_comm(ictxt) + + if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then + prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + idx = brvindx(ip+1) + p2ptag = psb_int8_tag + call mpi_irecv(valrcv(idx+1:idx+sz),sz,& + & psb_mpi_epk_,prcid(ip+1),& + & p2ptag, icomm,rvhd(ip+1,1),iret) + p2ptag = psb_int_swap_tag + call mpi_irecv(iarcv(idx+1:idx+sz),sz,& + & psb_mpi_epk_,prcid(ip+1),& + & p2ptag, icomm,rvhd(ip+1,2),iret) + call mpi_irecv(jarcv(idx+1:idx+sz),sz,& + & psb_mpi_epk_,prcid(ip+1),& + & p2ptag, icomm,rvhd(ip+1,3),iret) + end if + Enddo + + + do ip = 0, np-1 + sz = sdsz(ip+1) + if (sz > 0) then + if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + idx = bsdindx(ip+1) + p2ptag = psb_int8_tag + call mpi_send(valsnd(idx+1:idx+sz),sz,& + & psb_mpi_r_dpk_,prcid(ip+1),& + & p2ptag, icomm,iret) + p2ptag = psb_int_swap_tag + call mpi_send(iasnd(idx+1:idx+sz),sz,& + & psb_mpi_epk_,prcid(ip+1),& + & p2ptag, icomm,iret) + call mpi_send(jasnd(idx+1:idx+sz),sz,& + & psb_mpi_epk_,prcid(ip+1),& + & p2ptag, icomm,iret) + end if + Enddo + + do ip = 0, np-1 + sz = rvsz(ip+1) + if (sz > 0) then + call mpi_wait(rvhd(ip+1,1),p2pstat,iret) + call mpi_wait(rvhd(ip+1,2),p2pstat,iret) + call mpi_wait(rvhd(ip+1,3),p2pstat,iret) + end if + Enddo + + end subroutine psb_e_e_simple_triad_a2av + end module psi_e_collective_mod diff --git a/base/modules/penv/psi_i2_collective_mod.F90 b/base/modules/penv/psi_i2_collective_mod.F90 new file mode 100644 index 000000000..911ed9386 --- /dev/null +++ b/base/modules/penv/psi_i2_collective_mod.F90 @@ -0,0 +1,1443 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! 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. +! +! +module psi_i2_collective_mod + use psi_penv_mod + use psi_comm_buffers_mod + + interface psb_max + module procedure psb_i2maxs, psb_i2maxv, psb_i2maxm, & + & psb_i2maxs_ec, psb_i2maxv_ec, psb_i2maxm_ec + end interface + + interface psb_min + module procedure psb_i2mins, psb_i2minv, psb_i2minm, & + & psb_i2mins_ec, psb_i2minv_ec, psb_i2minm_ec + end interface psb_min + + + interface psb_sum + module procedure psb_i2sums, psb_i2sumv, psb_i2summ, & + & psb_i2sums_ec, psb_i2sumv_ec, psb_i2summ_ec + end interface + + interface psb_amx + module procedure psb_i2amxs, psb_i2amxv, psb_i2amxm, & + & psb_i2amxs_ec, psb_i2amxv_ec, psb_i2amxm_ec + end interface + + interface psb_amn + module procedure psb_i2amns, psb_i2amnv, psb_i2amnm, & + & psb_i2amns_ec, psb_i2amnv_ec, psb_i2amnm_ec + end interface + + + interface psb_bcast + module procedure psb_i2bcasts, psb_i2bcastv, psb_i2bcastm, & + & psb_i2bcasts_ec, psb_i2bcastv_ec, psb_i2bcastm_ec + end interface psb_bcast + + interface psb_scan_sum + module procedure psb_i2scan_sums, psb_i2scan_sumv + end interface psb_scan_sum + + interface psb_exscan_sum + module procedure psb_i2exscan_sums, psb_i2exscan_sumv + end interface psb_exscan_sum + + interface psb_simple_a2av + module procedure psb_i2_simple_a2av + end interface psb_simple_a2av + + interface psb_simple_triad_a2av + module procedure psb_i2_e_simple_triad_a2av, psb_i2_m_simple_triad_a2av + end interface psb_simple_triad_a2av + + +contains + + ! !!!!!!!!!!!!!!!!!!!!!! + ! + ! Reduction operations + ! + ! !!!!!!!!!!!!!!!!!!!!!! + + + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! + ! MAX + ! + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine psb_i2maxs(ictxt,dat,root) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(inout) :: dat + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_i2pk_) :: dat_ + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call mpi_allreduce(dat,dat_,1,psb_mpi_i2pk_,mpi_max,ictxt,info) + dat = dat_ + else + call mpi_reduce(dat,dat_,1,psb_mpi_i2pk_,mpi_max,root_,ictxt,info) + if (iam == root_) dat = dat_ + endif +#endif + end subroutine psb_i2maxs + + subroutine psb_i2maxv(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(inout) :: dat(:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_i2pk_), allocatable :: dat_(:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_) & + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_max,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_max,root_,ictxt,info) + else + call psb_realloc(1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_i2pk_,mpi_max,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_i2maxv + + subroutine psb_i2maxm(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(inout) :: dat(:,:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_i2pk_), allocatable :: dat_(:,:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + +#if !defined(SERIAL_MPI) + + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_)& + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_max,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_max,root_,ictxt,info) + else + call psb_realloc(1,1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_i2pk_,mpi_max,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_i2maxm + + + subroutine psb_i2maxs_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(inout) :: dat + integer(psb_epk_), intent(in), optional :: root + integer(psb_mpk_) :: ictxt_, root_ + + ictxt_ = ictxt + if (present(root)) then + root_ = root + call psb_max(ictxt_,dat,root_) + else + call psb_max(ictxt_,dat) + end if + end subroutine psb_i2maxs_ec + + subroutine psb_i2maxv_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(inout) :: dat(:) + integer(psb_epk_), intent(in), optional :: root + integer(psb_mpk_) :: ictxt_, root_ + + ictxt_ = ictxt + if (present(root)) then + root_ = root + call psb_max(ictxt_,dat,root_) + else + call psb_max(ictxt_,dat) + end if + end subroutine psb_i2maxv_ec + + subroutine psb_i2maxm_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(inout) :: dat(:,:) + integer(psb_epk_), intent(in), optional :: root + integer(psb_mpk_) :: ictxt_, root_ + + ictxt_ = ictxt + if (present(root)) then + root_ = root + call psb_max(ictxt_,dat,root_) + else + call psb_max(ictxt_,dat) + end if + end subroutine psb_i2maxm_ec + + + ! + ! MIN: Minimum Value + ! + + + subroutine psb_i2mins(ictxt,dat,root) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(inout) :: dat + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_i2pk_) :: dat_ + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call mpi_allreduce(dat,dat_,1,psb_mpi_i2pk_,mpi_min,ictxt,info) + dat = dat_ + else + call mpi_reduce(dat,dat_,1,psb_mpi_i2pk_,mpi_min,root_,ictxt,info) + if (iam == root_) dat = dat_ + endif +#endif + end subroutine psb_i2mins + + subroutine psb_i2minv(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(inout) :: dat(:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_i2pk_), allocatable :: dat_(:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_) & + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_min,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_min,root_,ictxt,info) + else + call psb_realloc(1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_i2pk_,mpi_min,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_i2minv + + subroutine psb_i2minm(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(inout) :: dat(:,:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_i2pk_), allocatable :: dat_(:,:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + +#if !defined(SERIAL_MPI) + + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_)& + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_min,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_min,root_,ictxt,info) + else + call psb_realloc(1,1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_i2pk_,mpi_min,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_i2minm + + + subroutine psb_i2mins_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(inout) :: dat + integer(psb_epk_), intent(in), optional :: root + integer(psb_mpk_) :: ictxt_, root_ + + ictxt_ = ictxt + if (present(root)) then + root_ = root + call psb_min(ictxt_,dat,root_) + else + call psb_min(ictxt_,dat) + end if + end subroutine psb_i2mins_ec + + subroutine psb_i2minv_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(inout) :: dat(:) + integer(psb_epk_), intent(in), optional :: root + integer(psb_mpk_) :: ictxt_, root_ + + ictxt_ = ictxt + if (present(root)) then + root_ = root + call psb_min(ictxt_,dat,root_) + else + call psb_min(ictxt_,dat) + end if + end subroutine psb_i2minv_ec + + subroutine psb_i2minm_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(inout) :: dat(:,:) + integer(psb_epk_), intent(in), optional :: root + integer(psb_mpk_) :: ictxt_, root_ + + ictxt_ = ictxt + if (present(root)) then + root_ = root + call psb_min(ictxt_,dat,root_) + else + call psb_min(ictxt_,dat) + end if + end subroutine psb_i2minm_ec + + + + + ! + ! SUM + ! + + subroutine psb_i2sums(ictxt,dat,root) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(inout) :: dat + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_i2pk_) :: dat_ + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call mpi_allreduce(dat,dat_,1,psb_mpi_i2pk_,mpi_sum,ictxt,info) + dat = dat_ + else + call mpi_reduce(dat,dat_,1,psb_mpi_i2pk_,mpi_sum,root_,ictxt,info) + if (iam == root_) dat = dat_ + endif +#endif + end subroutine psb_i2sums + + subroutine psb_i2sumv(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(inout) :: dat(:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_i2pk_), allocatable :: dat_(:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_) & + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_sum,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_sum,root_,ictxt,info) + else + call psb_realloc(1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_i2pk_,mpi_sum,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_i2sumv + + subroutine psb_i2summ(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(inout) :: dat(:,:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_i2pk_), allocatable :: dat_(:,:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + +#if !defined(SERIAL_MPI) + + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_)& + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_sum,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_sum,root_,ictxt,info) + else + call psb_realloc(1,1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_i2pk_,mpi_sum,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_i2summ + + subroutine psb_i2sums_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(inout) :: dat + integer(psb_epk_), intent(in), optional :: root + integer(psb_mpk_) :: ictxt_, root_ + + ictxt_ = ictxt + if (present(root)) then + root_ = root + call psb_sum(ictxt_,dat,root_) + else + call psb_sum(ictxt_,dat) + end if + end subroutine psb_i2sums_ec + + subroutine psb_i2sumv_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(inout) :: dat(:) + integer(psb_epk_), intent(in), optional :: root + integer(psb_mpk_) :: ictxt_, root_ + + ictxt_ = ictxt + if (present(root)) then + root_ = root + call psb_sum(ictxt_,dat,root_) + else + call psb_sum(ictxt_,dat) + end if + end subroutine psb_i2sumv_ec + + subroutine psb_i2summ_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(inout) :: dat(:,:) + integer(psb_epk_), intent(in), optional :: root + integer(psb_mpk_) :: ictxt_, root_ + + ictxt_ = ictxt + if (present(root)) then + root_ = root + call psb_sum(ictxt_,dat,root_) + else + call psb_sum(ictxt_,dat) + end if + end subroutine psb_i2summ_ec + + + ! + ! AMX: Maximum Absolute Value + ! + + subroutine psb_i2amxs(ictxt,dat,root) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(inout) :: dat + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_i2pk_) :: dat_ + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call mpi_allreduce(dat,dat_,1,psb_mpi_i2pk_,mpi_i2amx_op,ictxt,info) + dat = dat_ + else + call mpi_reduce(dat,dat_,1,psb_mpi_i2pk_,mpi_i2amx_op,root_,ictxt,info) + if (iam == root_) dat = dat_ + endif +#endif + end subroutine psb_i2amxs + + subroutine psb_i2amxv(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(inout) :: dat(:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_i2pk_), allocatable :: dat_(:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_) & + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_i2amx_op,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_i2amx_op,root_,ictxt,info) + else + call psb_realloc(1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_i2pk_,mpi_i2amx_op,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_i2amxv + + subroutine psb_i2amxm(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(inout) :: dat(:,:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_i2pk_), allocatable :: dat_(:,:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + +#if !defined(SERIAL_MPI) + + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_)& + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_i2amx_op,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_i2amx_op,root_,ictxt,info) + else + call psb_realloc(1,1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_i2pk_,mpi_i2amx_op,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_i2amxm + + + subroutine psb_i2amxs_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(inout) :: dat + integer(psb_epk_), intent(in), optional :: root + integer(psb_mpk_) :: ictxt_, root_ + + ictxt_ = ictxt + if (present(root)) then + root_ = root + call psb_amx(ictxt_,dat,root_) + else + call psb_amx(ictxt_,dat) + end if + end subroutine psb_i2amxs_ec + + subroutine psb_i2amxv_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(inout) :: dat(:) + integer(psb_epk_), intent(in), optional :: root + integer(psb_mpk_) :: ictxt_, root_ + + ictxt_ = ictxt + if (present(root)) then + root_ = root + call psb_amx(ictxt_,dat,root_) + else + call psb_amx(ictxt_,dat) + end if + end subroutine psb_i2amxv_ec + + subroutine psb_i2amxm_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(inout) :: dat(:,:) + integer(psb_epk_), intent(in), optional :: root + integer(psb_mpk_) :: ictxt_, root_ + + ictxt_ = ictxt + if (present(root)) then + root_ = root + call psb_amx(ictxt_,dat,root_) + else + call psb_amx(ictxt_,dat) + end if + end subroutine psb_i2amxm_ec + + + ! + ! AMN: Minimum Absolute Value + ! + + subroutine psb_i2amns(ictxt,dat,root) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(inout) :: dat + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_i2pk_) :: dat_ + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call mpi_allreduce(dat,dat_,1,psb_mpi_i2pk_,mpi_i2amn_op,ictxt,info) + dat = dat_ + else + call mpi_reduce(dat,dat_,1,psb_mpi_i2pk_,mpi_i2amn_op,root_,ictxt,info) + if (iam == root_) dat = dat_ + endif +#endif + end subroutine psb_i2amns + + subroutine psb_i2amnv(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(inout) :: dat(:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_i2pk_), allocatable :: dat_(:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_) & + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_i2amn_op,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_i2amn_op,root_,ictxt,info) + else + call psb_realloc(1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_i2pk_,mpi_i2amn_op,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_i2amnv + + subroutine psb_i2amnm(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(inout) :: dat(:,:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_i2pk_), allocatable :: dat_(:,:) + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + +#if !defined(SERIAL_MPI) + + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + if (iinfo == psb_success_)& + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_i2amn_op,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_ = dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_i2amn_op,root_,ictxt,info) + else + call psb_realloc(1,1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_i2pk_,mpi_i2amn_op,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_i2amnm + + + subroutine psb_i2amns_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(inout) :: dat + integer(psb_epk_), intent(in), optional :: root + integer(psb_mpk_) :: ictxt_, root_ + + ictxt_ = ictxt + if (present(root)) then + root_ = root + call psb_amn(ictxt_,dat,root_) + else + call psb_amn(ictxt_,dat) + end if + end subroutine psb_i2amns_ec + + subroutine psb_i2amnv_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(inout) :: dat(:) + integer(psb_epk_), intent(in), optional :: root + integer(psb_mpk_) :: ictxt_, root_ + + ictxt_ = ictxt + if (present(root)) then + root_ = root + call psb_amn(ictxt_,dat,root_) + else + call psb_amn(ictxt_,dat) + end if + end subroutine psb_i2amnv_ec + + subroutine psb_i2amnm_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(inout) :: dat(:,:) + integer(psb_epk_), intent(in), optional :: root + integer(psb_mpk_) :: ictxt_, root_ + + ictxt_ = ictxt + if (present(root)) then + root_ = root + call psb_amn(ictxt_,dat,root_) + else + call psb_amn(ictxt_,dat) + end if + end subroutine psb_i2amnm_ec + + + ! + ! BCAST Broadcast + ! + + subroutine psb_i2bcasts(ictxt,dat,root) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(inout) :: dat + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = psb_root_ + endif + call mpi_bcast(dat,1,psb_mpi_i2pk_,root_,ictxt,info) + +#endif + end subroutine psb_i2bcasts + + subroutine psb_i2bcastv(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(inout) :: dat(:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = psb_root_ + endif + + call mpi_bcast(dat,size(dat),psb_mpi_i2pk_,root_,ictxt,info) +#endif + end subroutine psb_i2bcastv + + subroutine psb_i2bcastm(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(inout) :: dat(:,:) + integer(psb_mpk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + + integer(psb_mpk_) :: iam, np, info + integer(psb_ipk_) :: iinfo + +#if !defined(SERIAL_MPI) + + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = psb_root_ + endif + + call mpi_bcast(dat,size(dat),psb_mpi_i2pk_,root_,ictxt,info) +#endif + end subroutine psb_i2bcastm + + + subroutine psb_i2bcasts_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(inout) :: dat + integer(psb_epk_), intent(in), optional :: root + integer(psb_mpk_) :: ictxt_, root_ + + ictxt_ = ictxt + if (present(root)) then + root_ = root + call psb_bcast(ictxt_,dat,root_) + else + call psb_bcast(ictxt_,dat) + end if + end subroutine psb_i2bcasts_ec + + subroutine psb_i2bcastv_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(inout) :: dat(:) + integer(psb_epk_), intent(in), optional :: root + integer(psb_mpk_) :: ictxt_, root_ + + ictxt_ = ictxt + if (present(root)) then + root_ = root + call psb_bcast(ictxt_,dat,root_) + else + call psb_bcast(ictxt_,dat) + end if + end subroutine psb_i2bcastv_ec + + subroutine psb_i2bcastm_ec(ictxt,dat,root) + implicit none + integer(psb_epk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(inout) :: dat(:,:) + integer(psb_epk_), intent(in), optional :: root + integer(psb_mpk_) :: ictxt_, root_ + + ictxt_ = ictxt + if (present(root)) then + root_ = root + call psb_bcast(ictxt_,dat,root_) + else + call psb_bcast(ictxt_,dat) + end if + end subroutine psb_i2bcastm_ec + + + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! + ! SCAN + ! + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine psb_i2scan_sums(ictxt,dat) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_ipk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(inout) :: dat + integer(psb_i2pk_) :: dat_ + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: minfo, icomm + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + icomm = psb_get_mpi_comm(ictxt) + call mpi_scan(dat,dat_,1,psb_mpi_i2pk_,mpi_sum,icomm,minfo) + dat = dat_ +#endif + end subroutine psb_i2scan_sums + + + subroutine psb_i2exscan_sums(ictxt,dat) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_ipk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(inout) :: dat + integer(psb_i2pk_) :: dat_ + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: icomm, minfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + icomm = psb_get_mpi_comm(ictxt) + call mpi_exscan(dat,dat_,1,psb_mpi_i2pk_,mpi_sum,icomm,minfo) + dat = dat_ +#else + dat = i2zero +#endif + end subroutine psb_i2exscan_sums + + subroutine psb_i2scan_sumv(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_ipk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(inout) :: dat(:) + integer(psb_ipk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_i2pk_), allocatable :: dat_(:) + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: minfo, icomm + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + icomm = psb_get_mpi_comm(ictxt) + call psb_realloc(size(dat),dat_,info) + dat_ = dat + if (info == psb_success_) & + & call mpi_scan(dat,dat_,size(dat),psb_mpi_i2pk_,mpi_sum,icomm,minfo) +#endif + end subroutine psb_i2scan_sumv + + subroutine psb_i2exscan_sumv(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_ipk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(inout) :: dat(:) + integer(psb_ipk_), intent(in), optional :: root + integer(psb_mpk_) :: root_ + integer(psb_i2pk_), allocatable :: dat_(:) + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: minfo, icomm + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + icomm = psb_get_mpi_comm(ictxt) + call psb_realloc(size(dat),dat_,info) + dat_ = dat + if (info == psb_success_) & + & call mpi_exscan(dat,dat_,size(dat),psb_mpi_i2pk_,mpi_sum,icomm,minfo) +#else + dat = i2zero +#endif + end subroutine psb_i2exscan_sumv + + subroutine psb_i2_simple_a2av(valsnd,sdsz,bsdindx,& + & valrcv,rvsz,brvindx,ictxt,info) + use psi_i2_p2p_mod + implicit none + integer(psb_i2pk_), intent(in) :: valsnd(:) + integer(psb_i2pk_), intent(out) :: valrcv(:) + integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) + integer(psb_ipk_), intent(in) :: ictxt + integer(psb_ipk_), intent(out) :: info + + integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz + + call psb_info(ictxt,iam,np) + + if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then + idx = bsdindx(ip+1) + call psb_snd(ictxt,valsnd(idx+1:idx+sz),ip) + end if + end do + + do ip = 0, np-1 + sz = rvsz(ip+1) + if (sz > 0) then + idx = brvindx(ip+1) + call psb_rcv(ictxt,valrcv(idx+1:idx+sz),ip) + end if + end do + + end subroutine psb_i2_simple_a2av + + subroutine psb_i2_m_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & valrcv,iarcv,jarcv,rvsz,brvindx,ictxt,info) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_i2pk_), intent(in) :: valsnd(:) + integer(psb_mpk_), intent(in) :: iasnd(:), jasnd(:) + integer(psb_i2pk_), intent(out) :: valrcv(:) + integer(psb_mpk_), intent(out) :: iarcv(:), jarcv(:) + integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) + integer(psb_ipk_), intent(in) :: ictxt + integer(psb_ipk_), intent(out) :: info + + !Local variables + integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz, counter + integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm + integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) + + call psb_info(ictxt,iam,np) + + icomm = psb_get_mpi_comm(ictxt) + + if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then + prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + idx = brvindx(ip+1) + p2ptag = psb_int2_tag + call mpi_irecv(valrcv(idx+1:idx+sz),sz,& + & psb_mpi_i2pk_,prcid(ip+1),& + & p2ptag, icomm,rvhd(ip+1,1),iret) + p2ptag = psb_int_swap_tag + call mpi_irecv(iarcv(idx+1:idx+sz),sz,& + & psb_mpi_mpk_,prcid(ip+1),& + & p2ptag, icomm,rvhd(ip+1,2),iret) + call mpi_irecv(jarcv(idx+1:idx+sz),sz,& + & psb_mpi_mpk_,prcid(ip+1),& + & p2ptag, icomm,rvhd(ip+1,3),iret) + end if + Enddo + + + do ip = 0, np-1 + sz = sdsz(ip+1) + if (sz > 0) then + if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + idx = bsdindx(ip+1) + p2ptag = psb_int2_tag + call mpi_send(valsnd(idx+1:idx+sz),sz,& + & psb_mpi_i2pk_,prcid(ip+1),& + & p2ptag, icomm,iret) + p2ptag = psb_int_swap_tag + call mpi_send(iasnd(idx+1:idx+sz),sz,& + & psb_mpi_mpk_,prcid(ip+1),& + & p2ptag, icomm,iret) + call mpi_send(jasnd(idx+1:idx+sz),sz,& + & psb_mpi_mpk_,prcid(ip+1),& + & p2ptag, icomm,iret) + end if + Enddo + + do ip = 0, np-1 + sz = rvsz(ip+1) + if (sz > 0) then + call mpi_wait(rvhd(ip+1,1),p2pstat,iret) + call mpi_wait(rvhd(ip+1,2),p2pstat,iret) + call mpi_wait(rvhd(ip+1,3),p2pstat,iret) + end if + Enddo + + end subroutine psb_i2_m_simple_triad_a2av + + subroutine psb_i2_e_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & valrcv,iarcv,jarcv,rvsz,brvindx,ictxt,info) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_i2pk_), intent(in) :: valsnd(:) + integer(psb_epk_), intent(in) :: iasnd(:), jasnd(:) + integer(psb_i2pk_), intent(out) :: valrcv(:) + integer(psb_epk_), intent(out) :: iarcv(:), jarcv(:) + integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) + integer(psb_ipk_), intent(in) :: ictxt + integer(psb_ipk_), intent(out) :: info + + !Local variables + integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz, counter + integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm + integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) + + call psb_info(ictxt,iam,np) + + icomm = psb_get_mpi_comm(ictxt) + + if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then + prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + idx = brvindx(ip+1) + p2ptag = psb_int2_tag + call mpi_irecv(valrcv(idx+1:idx+sz),sz,& + & psb_mpi_i2pk_,prcid(ip+1),& + & p2ptag, icomm,rvhd(ip+1,1),iret) + p2ptag = psb_int_swap_tag + call mpi_irecv(iarcv(idx+1:idx+sz),sz,& + & psb_mpi_epk_,prcid(ip+1),& + & p2ptag, icomm,rvhd(ip+1,2),iret) + call mpi_irecv(jarcv(idx+1:idx+sz),sz,& + & psb_mpi_epk_,prcid(ip+1),& + & p2ptag, icomm,rvhd(ip+1,3),iret) + end if + Enddo + + + do ip = 0, np-1 + sz = sdsz(ip+1) + if (sz > 0) then + if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + idx = bsdindx(ip+1) + p2ptag = psb_int2_tag + call mpi_send(valsnd(idx+1:idx+sz),sz,& + & psb_mpi_r_dpk_,prcid(ip+1),& + & p2ptag, icomm,iret) + p2ptag = psb_int_swap_tag + call mpi_send(iasnd(idx+1:idx+sz),sz,& + & psb_mpi_epk_,prcid(ip+1),& + & p2ptag, icomm,iret) + call mpi_send(jasnd(idx+1:idx+sz),sz,& + & psb_mpi_epk_,prcid(ip+1),& + & p2ptag, icomm,iret) + end if + Enddo + + do ip = 0, np-1 + sz = rvsz(ip+1) + if (sz > 0) then + call mpi_wait(rvhd(ip+1,1),p2pstat,iret) + call mpi_wait(rvhd(ip+1,2),p2pstat,iret) + call mpi_wait(rvhd(ip+1,3),p2pstat,iret) + end if + Enddo + + end subroutine psb_i2_e_simple_triad_a2av + + +end module psi_i2_collective_mod diff --git a/base/modules/penv/psi_i2_p2p_mod.F90 b/base/modules/penv/psi_i2_p2p_mod.F90 new file mode 100644 index 000000000..84bf7712d --- /dev/null +++ b/base/modules/penv/psi_i2_p2p_mod.F90 @@ -0,0 +1,307 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! 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. +! +! + +module psi_i2_p2p_mod + use psi_penv_mod + use psi_comm_buffers_mod + + interface psb_snd + module procedure psb_i2snds, psb_i2sndv, psb_i2sndm, & + & psb_i2snds_ec, psb_i2sndv_ec, psb_i2sndm_ec + end interface + + interface psb_rcv + module procedure psb_i2rcvs, psb_i2rcvv, psb_i2rcvm, & + & psb_i2rcvs_ec, psb_i2rcvv_ec, psb_i2rcvm_ec + end interface + +contains + + subroutine psb_i2snds(ictxt,dat,dst) + use psi_comm_buffers_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(in) :: dat + integer(psb_mpk_), intent(in) :: dst + integer(psb_i2pk_), allocatable :: dat_(:) + integer(psb_mpk_) :: info +#if defined(SERIAL_MPI) + ! do nothing +#else + allocate(dat_(1), stat=info) + dat_(1) = dat + call psi_snd(ictxt,psb_int2_tag,dst,dat_,psb_mesg_queue) +#endif + end subroutine psb_i2snds + + subroutine psb_i2sndv(ictxt,dat,dst) + use psi_comm_buffers_mod + +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(in) :: dat(:) + integer(psb_mpk_), intent(in) :: dst + integer(psb_i2pk_), allocatable :: dat_(:) + integer(psb_mpk_) :: info + +#if defined(SERIAL_MPI) +#else + allocate(dat_(size(dat)), stat=info) + dat_(:) = dat(:) + call psi_snd(ictxt,psb_int2_tag,dst,dat_,psb_mesg_queue) +#endif + + end subroutine psb_i2sndv + + subroutine psb_i2sndm(ictxt,dat,dst,m) + use psi_comm_buffers_mod + +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(in) :: dat(:,:) + integer(psb_mpk_), intent(in) :: dst + integer(psb_ipk_), intent(in), optional :: m + integer(psb_i2pk_), allocatable :: dat_(:) + integer(psb_ipk_) :: i,j,k,m_,n_ + integer(psb_mpk_) :: info + +#if defined(SERIAL_MPI) +#else + if (present(m)) then + m_ = m + else + m_ = size(dat,1) + end if + n_ = size(dat,2) + allocate(dat_(m_*n_), stat=info) + k=1 + do j=1,n_ + do i=1, m_ + dat_(k) = dat(i,j) + k = k + 1 + end do + end do + call psi_snd(ictxt,psb_int2_tag,dst,dat_,psb_mesg_queue) +#endif + end subroutine psb_i2sndm + + subroutine psb_i2rcvs(ictxt,dat,src) + use psi_comm_buffers_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(out) :: dat + integer(psb_mpk_), intent(in) :: src + integer(psb_mpk_) :: info + integer(psb_mpk_) :: status(mpi_status_size) +#if defined(SERIAL_MPI) + ! do nothing +#else + call mpi_recv(dat,1,psb_mpi_i2pk_,src,psb_int2_tag,ictxt,status,info) + call psb_test_nodes(psb_mesg_queue) +#endif + end subroutine psb_i2rcvs + + subroutine psb_i2rcvv(ictxt,dat,src) + use psi_comm_buffers_mod + +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(out) :: dat(:) + integer(psb_mpk_), intent(in) :: src + integer(psb_i2pk_), allocatable :: dat_(:) + integer(psb_mpk_) :: info + integer(psb_mpk_) :: status(mpi_status_size) +#if defined(SERIAL_MPI) +#else + call mpi_recv(dat,size(dat),psb_mpi_i2pk_,src,psb_int2_tag,ictxt,status,info) + call psb_test_nodes(psb_mesg_queue) +#endif + + end subroutine psb_i2rcvv + + subroutine psb_i2rcvm(ictxt,dat,src,m) + use psi_comm_buffers_mod + +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(out) :: dat(:,:) + integer(psb_mpk_), intent(in) :: src + integer(psb_ipk_), intent(in), optional :: m + integer(psb_i2pk_), allocatable :: dat_(:) + integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type + integer(psb_mpk_) :: i,j,k + integer(psb_mpk_) :: status(mpi_status_size) +#if defined(SERIAL_MPI) + ! What should we do here?? +#else + if (present(m)) then + m_ = m + ld = size(dat,1) + n_ = size(dat,2) + call mpi_type_vector(n_,m_,ld,psb_mpi_i2pk_,mp_rcv_type,info) + if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info) + if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,& + & psb_int2_tag,ictxt,status,info) + if (info == mpi_success) call mpi_type_free(mp_rcv_type,info) + else + call mpi_recv(dat,size(dat),psb_mpi_i2pk_,src,psb_int2_tag,ictxt,status,info) + end if + if (info /= mpi_success) then + write(psb_err_unit,*) 'Error in psb_recv', info + end if + call psb_test_nodes(psb_mesg_queue) +#endif + end subroutine psb_i2rcvm + + + subroutine psb_i2snds_ec(ictxt,dat,dst) + + integer(psb_epk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(in) :: dat + integer(psb_epk_), intent(in) :: dst + + integer(psb_mpk_) :: iictxt, idst + + iictxt = ictxt + idst = dst + call psb_snd(iictxt, dat, idst) + + end subroutine psb_i2snds_ec + + subroutine psb_i2sndv_ec(ictxt,dat,dst) + + integer(psb_epk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(in) :: dat(:) + integer(psb_epk_), intent(in) :: dst + + integer(psb_mpk_) :: iictxt, idst + + iictxt = ictxt + idst = dst + call psb_snd(iictxt, dat, idst) + + end subroutine psb_i2sndv_ec + + subroutine psb_i2sndm_ec(ictxt,dat,dst,m) + + integer(psb_epk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(in) :: dat(:,:) + integer(psb_epk_), intent(in) :: dst + + integer(psb_mpk_) :: iictxt, idst + + iictxt = ictxt + idst = dst + call psb_snd(iictxt, dat, idst) + + end subroutine psb_i2sndm_ec + + subroutine psb_i2rcvs_ec(ictxt,dat,src) + + integer(psb_epk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(out) :: dat + integer(psb_epk_), intent(in) :: src + + integer(psb_mpk_) :: iictxt, isrc + + iictxt = ictxt + isrc = src + call psb_rcv(iictxt, dat, isrc) + + end subroutine psb_i2rcvs_ec + + subroutine psb_i2rcvv_ec(ictxt,dat,src) + + integer(psb_epk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(out) :: dat(:) + integer(psb_epk_), intent(in) :: src + + integer(psb_mpk_) :: iictxt, isrc + + iictxt = ictxt + isrc = src + call psb_rcv(iictxt, dat, isrc) + + end subroutine psb_i2rcvv_ec + + subroutine psb_i2rcvm_ec(ictxt,dat,src,m) + + integer(psb_epk_), intent(in) :: ictxt + integer(psb_i2pk_), intent(out) :: dat(:,:) + integer(psb_epk_), intent(in) :: src + + integer(psb_mpk_) :: iictxt, isrc + + iictxt = ictxt + isrc = src + call psb_rcv(iictxt, dat, isrc) + + end subroutine psb_i2rcvm_ec + + +end module psi_i2_p2p_mod diff --git a/base/modules/penv/psi_m_collective_mod.F90 b/base/modules/penv/psi_m_collective_mod.F90 index 5959e468e..206b15fa4 100644 --- a/base/modules/penv/psi_m_collective_mod.F90 +++ b/base/modules/penv/psi_m_collective_mod.F90 @@ -31,6 +31,7 @@ ! module psi_m_collective_mod use psi_penv_mod + use psi_comm_buffers_mod interface psb_max module procedure psb_mmaxs, psb_mmaxv, psb_mmaxm, & @@ -72,7 +73,13 @@ module psi_m_collective_mod module procedure psb_mexscan_sums, psb_mexscan_sumv end interface psb_exscan_sum + interface psb_simple_a2av + module procedure psb_m_simple_a2av + end interface psb_simple_a2av + interface psb_simple_triad_a2av + module procedure psb_m_e_simple_triad_a2av, psb_m_m_simple_triad_a2av + end interface psb_simple_triad_a2av contains @@ -1132,16 +1139,17 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_mpk_), intent(inout) :: dat integer(psb_mpk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) - call mpi_scan(dat,dat_,1,psb_mpi_mpk_,mpi_sum,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_scan(dat,dat_,1,psb_mpi_mpk_,mpi_sum,icomm,minfo) dat = dat_ #endif end subroutine psb_mscan_sums @@ -1155,16 +1163,17 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_mpk_), intent(inout) :: dat integer(psb_mpk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: icomm, minfo #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) - call mpi_exscan(dat,dat_,1,psb_mpi_mpk_,mpi_sum,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_exscan(dat,dat_,1,psb_mpi_mpk_,mpi_sum,icomm,minfo) dat = dat_ #else dat = mzero @@ -1180,20 +1189,21 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_mpk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root + integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_mpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) - call psb_realloc(size(dat),dat_,iinfo) + icomm = psb_get_mpi_comm(ictxt) + call psb_realloc(size(dat),dat_,info) dat_ = dat - if (iinfo == psb_success_) & - & call mpi_scan(dat,dat_,size(dat),psb_mpi_mpk_,mpi_sum,ictxt,info) + if (info == psb_success_) & + & call mpi_scan(dat,dat_,size(dat),psb_mpi_mpk_,mpi_sum,icomm,minfo) #endif end subroutine psb_mscan_sumv @@ -1206,23 +1216,228 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_mpk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root + integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_mpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) - call psb_realloc(size(dat),dat_,iinfo) + icomm = psb_get_mpi_comm(ictxt) + call psb_realloc(size(dat),dat_,info) dat_ = dat - if (iinfo == psb_success_) & - & call mpi_exscan(dat,dat_,size(dat),psb_mpi_mpk_,mpi_sum,ictxt,info) + if (info == psb_success_) & + & call mpi_exscan(dat,dat_,size(dat),psb_mpi_mpk_,mpi_sum,icomm,minfo) #else dat = mzero #endif end subroutine psb_mexscan_sumv + + subroutine psb_m_simple_a2av(valsnd,sdsz,bsdindx,& + & valrcv,rvsz,brvindx,ictxt,info) + use psi_m_p2p_mod + implicit none + integer(psb_mpk_), intent(in) :: valsnd(:) + integer(psb_mpk_), intent(out) :: valrcv(:) + integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) + integer(psb_ipk_), intent(in) :: ictxt + integer(psb_ipk_), intent(out) :: info + + integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz + + call psb_info(ictxt,iam,np) + + if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then + idx = bsdindx(ip+1) + call psb_snd(ictxt,valsnd(idx+1:idx+sz),ip) + end if + end do + + do ip = 0, np-1 + sz = rvsz(ip+1) + if (sz > 0) then + idx = brvindx(ip+1) + call psb_rcv(ictxt,valrcv(idx+1:idx+sz),ip) + end if + end do + + end subroutine psb_m_simple_a2av + + subroutine psb_m_m_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & valrcv,iarcv,jarcv,rvsz,brvindx,ictxt,info) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: valsnd(:) + integer(psb_mpk_), intent(in) :: iasnd(:), jasnd(:) + integer(psb_mpk_), intent(out) :: valrcv(:) + integer(psb_mpk_), intent(out) :: iarcv(:), jarcv(:) + integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) + integer(psb_ipk_), intent(in) :: ictxt + integer(psb_ipk_), intent(out) :: info + + !Local variables + integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz, counter + integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm + integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) + + call psb_info(ictxt,iam,np) + + icomm = psb_get_mpi_comm(ictxt) + + if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then + prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + idx = brvindx(ip+1) + p2ptag = psb_int4_tag + call mpi_irecv(valrcv(idx+1:idx+sz),sz,& + & psb_mpi_mpk_,prcid(ip+1),& + & p2ptag, icomm,rvhd(ip+1,1),iret) + p2ptag = psb_int_swap_tag + call mpi_irecv(iarcv(idx+1:idx+sz),sz,& + & psb_mpi_mpk_,prcid(ip+1),& + & p2ptag, icomm,rvhd(ip+1,2),iret) + call mpi_irecv(jarcv(idx+1:idx+sz),sz,& + & psb_mpi_mpk_,prcid(ip+1),& + & p2ptag, icomm,rvhd(ip+1,3),iret) + end if + Enddo + + + do ip = 0, np-1 + sz = sdsz(ip+1) + if (sz > 0) then + if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + idx = bsdindx(ip+1) + p2ptag = psb_int4_tag + call mpi_send(valsnd(idx+1:idx+sz),sz,& + & psb_mpi_mpk_,prcid(ip+1),& + & p2ptag, icomm,iret) + p2ptag = psb_int_swap_tag + call mpi_send(iasnd(idx+1:idx+sz),sz,& + & psb_mpi_mpk_,prcid(ip+1),& + & p2ptag, icomm,iret) + call mpi_send(jasnd(idx+1:idx+sz),sz,& + & psb_mpi_mpk_,prcid(ip+1),& + & p2ptag, icomm,iret) + end if + Enddo + + do ip = 0, np-1 + sz = rvsz(ip+1) + if (sz > 0) then + call mpi_wait(rvhd(ip+1,1),p2pstat,iret) + call mpi_wait(rvhd(ip+1,2),p2pstat,iret) + call mpi_wait(rvhd(ip+1,3),p2pstat,iret) + end if + Enddo + + end subroutine psb_m_m_simple_triad_a2av + + subroutine psb_m_e_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & valrcv,iarcv,jarcv,rvsz,brvindx,ictxt,info) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: valsnd(:) + integer(psb_epk_), intent(in) :: iasnd(:), jasnd(:) + integer(psb_mpk_), intent(out) :: valrcv(:) + integer(psb_epk_), intent(out) :: iarcv(:), jarcv(:) + integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) + integer(psb_ipk_), intent(in) :: ictxt + integer(psb_ipk_), intent(out) :: info + + !Local variables + integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz, counter + integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm + integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) + + call psb_info(ictxt,iam,np) + + icomm = psb_get_mpi_comm(ictxt) + + if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then + prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + idx = brvindx(ip+1) + p2ptag = psb_int4_tag + call mpi_irecv(valrcv(idx+1:idx+sz),sz,& + & psb_mpi_mpk_,prcid(ip+1),& + & p2ptag, icomm,rvhd(ip+1,1),iret) + p2ptag = psb_int_swap_tag + call mpi_irecv(iarcv(idx+1:idx+sz),sz,& + & psb_mpi_epk_,prcid(ip+1),& + & p2ptag, icomm,rvhd(ip+1,2),iret) + call mpi_irecv(jarcv(idx+1:idx+sz),sz,& + & psb_mpi_epk_,prcid(ip+1),& + & p2ptag, icomm,rvhd(ip+1,3),iret) + end if + Enddo + + + do ip = 0, np-1 + sz = sdsz(ip+1) + if (sz > 0) then + if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + idx = bsdindx(ip+1) + p2ptag = psb_int4_tag + call mpi_send(valsnd(idx+1:idx+sz),sz,& + & psb_mpi_r_dpk_,prcid(ip+1),& + & p2ptag, icomm,iret) + p2ptag = psb_int_swap_tag + call mpi_send(iasnd(idx+1:idx+sz),sz,& + & psb_mpi_epk_,prcid(ip+1),& + & p2ptag, icomm,iret) + call mpi_send(jasnd(idx+1:idx+sz),sz,& + & psb_mpi_epk_,prcid(ip+1),& + & p2ptag, icomm,iret) + end if + Enddo + + do ip = 0, np-1 + sz = rvsz(ip+1) + if (sz > 0) then + call mpi_wait(rvhd(ip+1,1),p2pstat,iret) + call mpi_wait(rvhd(ip+1,2),p2pstat,iret) + call mpi_wait(rvhd(ip+1,3),p2pstat,iret) + end if + Enddo + + end subroutine psb_m_e_simple_triad_a2av + end module psi_m_collective_mod diff --git a/base/modules/penv/psi_penv_mod.F90 b/base/modules/penv/psi_penv_mod.F90 index 4d7be8086..a082ea0e2 100644 --- a/base/modules/penv/psi_penv_mod.F90 +++ b/base/modules/penv/psi_penv_mod.F90 @@ -75,8 +75,15 @@ module psi_penv_mod interface psb_wtime module procedure psb_wtime - end interface + end interface psb_wtime + interface psb_get_mpi_comm + module procedure psb_m_get_mpi_comm, psb_e_get_mpi_comm + end interface psb_get_mpi_comm + + interface psb_get_mpi_rank + module procedure psb_m_get_mpi_rank, psb_e_get_mpi_rank + end interface psb_get_mpi_rank #if defined(SERIAL_MPI) integer(psb_mpk_), private, save :: nctxt=0 @@ -563,17 +570,33 @@ contains end subroutine psb_info_mpik - function psb_get_mpi_comm(ictxt) result(comm) + function psb_m_get_mpi_comm(ictxt) result(comm) integer(psb_mpk_) :: ictxt, comm comm = ictxt - end function psb_get_mpi_comm + end function psb_m_get_mpi_comm - function psb_get_mpi_rank(ictxt,id) result(rank) - integer(psb_mpk_) :: rank,ictxt,id + function psb_e_get_mpi_comm(ictxt) result(comm) + integer(psb_epk_) :: ictxt + integer(psb_mpk_) :: comm + + comm = ictxt + end function psb_e_get_mpi_comm + + function psb_m_get_mpi_rank(ictxt,id) result(rank) + integer(psb_mpk_) :: rank + integer(psb_mpk_) :: ictxt,id rank = id - end function psb_get_mpi_rank + end function psb_m_get_mpi_rank + + + function psb_e_get_mpi_rank(ictxt,id) result(rank) + integer(psb_mpk_) :: rank + integer(psb_epk_) :: ictxt,id + + rank = id + end function psb_e_get_mpi_rank subroutine psb_get_mpicomm(ictxt,comm) diff --git a/base/modules/penv/psi_s_collective_mod.F90 b/base/modules/penv/psi_s_collective_mod.F90 index 5de46599d..eda869614 100644 --- a/base/modules/penv/psi_s_collective_mod.F90 +++ b/base/modules/penv/psi_s_collective_mod.F90 @@ -31,6 +31,7 @@ ! module psi_s_collective_mod use psi_penv_mod + use psi_comm_buffers_mod interface psb_max module procedure psb_smaxs, psb_smaxv, psb_smaxm, & @@ -76,7 +77,13 @@ module psi_s_collective_mod module procedure psb_sexscan_sums, psb_sexscan_sumv end interface psb_exscan_sum + interface psb_simple_a2av + module procedure psb_s_simple_a2av + end interface psb_simple_a2av + interface psb_simple_triad_a2av + module procedure psb_s_e_simple_triad_a2av, psb_s_m_simple_triad_a2av + end interface psb_simple_triad_a2av contains @@ -1255,16 +1262,17 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt real(psb_spk_), intent(inout) :: dat real(psb_spk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) - call mpi_scan(dat,dat_,1,psb_mpi_r_spk_,mpi_sum,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_scan(dat,dat_,1,psb_mpi_r_spk_,mpi_sum,icomm,minfo) dat = dat_ #endif end subroutine psb_sscan_sums @@ -1278,16 +1286,17 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt real(psb_spk_), intent(inout) :: dat real(psb_spk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: icomm, minfo #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) - call mpi_exscan(dat,dat_,1,psb_mpi_r_spk_,mpi_sum,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_exscan(dat,dat_,1,psb_mpi_r_spk_,mpi_sum,icomm,minfo) dat = dat_ #else dat = szero @@ -1303,20 +1312,21 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt real(psb_spk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root + integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ real(psb_spk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) - call psb_realloc(size(dat),dat_,iinfo) + icomm = psb_get_mpi_comm(ictxt) + call psb_realloc(size(dat),dat_,info) dat_ = dat - if (iinfo == psb_success_) & - & call mpi_scan(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_sum,ictxt,info) + if (info == psb_success_) & + & call mpi_scan(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_sum,icomm,minfo) #endif end subroutine psb_sscan_sumv @@ -1329,23 +1339,228 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt real(psb_spk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root + integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ real(psb_spk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) - call psb_realloc(size(dat),dat_,iinfo) + icomm = psb_get_mpi_comm(ictxt) + call psb_realloc(size(dat),dat_,info) dat_ = dat - if (iinfo == psb_success_) & - & call mpi_exscan(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_sum,ictxt,info) + if (info == psb_success_) & + & call mpi_exscan(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_sum,icomm,minfo) #else dat = szero #endif end subroutine psb_sexscan_sumv + + subroutine psb_s_simple_a2av(valsnd,sdsz,bsdindx,& + & valrcv,rvsz,brvindx,ictxt,info) + use psi_s_p2p_mod + implicit none + real(psb_spk_), intent(in) :: valsnd(:) + real(psb_spk_), intent(out) :: valrcv(:) + integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) + integer(psb_ipk_), intent(in) :: ictxt + integer(psb_ipk_), intent(out) :: info + + integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz + + call psb_info(ictxt,iam,np) + + if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then + idx = bsdindx(ip+1) + call psb_snd(ictxt,valsnd(idx+1:idx+sz),ip) + end if + end do + + do ip = 0, np-1 + sz = rvsz(ip+1) + if (sz > 0) then + idx = brvindx(ip+1) + call psb_rcv(ictxt,valrcv(idx+1:idx+sz),ip) + end if + end do + + end subroutine psb_s_simple_a2av + + subroutine psb_s_m_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & valrcv,iarcv,jarcv,rvsz,brvindx,ictxt,info) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + real(psb_spk_), intent(in) :: valsnd(:) + integer(psb_mpk_), intent(in) :: iasnd(:), jasnd(:) + real(psb_spk_), intent(out) :: valrcv(:) + integer(psb_mpk_), intent(out) :: iarcv(:), jarcv(:) + integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) + integer(psb_ipk_), intent(in) :: ictxt + integer(psb_ipk_), intent(out) :: info + + !Local variables + integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz, counter + integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm + integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) + + call psb_info(ictxt,iam,np) + + icomm = psb_get_mpi_comm(ictxt) + + if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then + prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + idx = brvindx(ip+1) + p2ptag = psb_real_tag + call mpi_irecv(valrcv(idx+1:idx+sz),sz,& + & psb_mpi_r_spk_,prcid(ip+1),& + & p2ptag, icomm,rvhd(ip+1,1),iret) + p2ptag = psb_int_swap_tag + call mpi_irecv(iarcv(idx+1:idx+sz),sz,& + & psb_mpi_mpk_,prcid(ip+1),& + & p2ptag, icomm,rvhd(ip+1,2),iret) + call mpi_irecv(jarcv(idx+1:idx+sz),sz,& + & psb_mpi_mpk_,prcid(ip+1),& + & p2ptag, icomm,rvhd(ip+1,3),iret) + end if + Enddo + + + do ip = 0, np-1 + sz = sdsz(ip+1) + if (sz > 0) then + if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + idx = bsdindx(ip+1) + p2ptag = psb_real_tag + call mpi_send(valsnd(idx+1:idx+sz),sz,& + & psb_mpi_r_spk_,prcid(ip+1),& + & p2ptag, icomm,iret) + p2ptag = psb_int_swap_tag + call mpi_send(iasnd(idx+1:idx+sz),sz,& + & psb_mpi_mpk_,prcid(ip+1),& + & p2ptag, icomm,iret) + call mpi_send(jasnd(idx+1:idx+sz),sz,& + & psb_mpi_mpk_,prcid(ip+1),& + & p2ptag, icomm,iret) + end if + Enddo + + do ip = 0, np-1 + sz = rvsz(ip+1) + if (sz > 0) then + call mpi_wait(rvhd(ip+1,1),p2pstat,iret) + call mpi_wait(rvhd(ip+1,2),p2pstat,iret) + call mpi_wait(rvhd(ip+1,3),p2pstat,iret) + end if + Enddo + + end subroutine psb_s_m_simple_triad_a2av + + subroutine psb_s_e_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & valrcv,iarcv,jarcv,rvsz,brvindx,ictxt,info) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + real(psb_spk_), intent(in) :: valsnd(:) + integer(psb_epk_), intent(in) :: iasnd(:), jasnd(:) + real(psb_spk_), intent(out) :: valrcv(:) + integer(psb_epk_), intent(out) :: iarcv(:), jarcv(:) + integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) + integer(psb_ipk_), intent(in) :: ictxt + integer(psb_ipk_), intent(out) :: info + + !Local variables + integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz, counter + integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm + integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) + + call psb_info(ictxt,iam,np) + + icomm = psb_get_mpi_comm(ictxt) + + if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then + prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + idx = brvindx(ip+1) + p2ptag = psb_real_tag + call mpi_irecv(valrcv(idx+1:idx+sz),sz,& + & psb_mpi_r_spk_,prcid(ip+1),& + & p2ptag, icomm,rvhd(ip+1,1),iret) + p2ptag = psb_int_swap_tag + call mpi_irecv(iarcv(idx+1:idx+sz),sz,& + & psb_mpi_epk_,prcid(ip+1),& + & p2ptag, icomm,rvhd(ip+1,2),iret) + call mpi_irecv(jarcv(idx+1:idx+sz),sz,& + & psb_mpi_epk_,prcid(ip+1),& + & p2ptag, icomm,rvhd(ip+1,3),iret) + end if + Enddo + + + do ip = 0, np-1 + sz = sdsz(ip+1) + if (sz > 0) then + if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + idx = bsdindx(ip+1) + p2ptag = psb_real_tag + call mpi_send(valsnd(idx+1:idx+sz),sz,& + & psb_mpi_r_dpk_,prcid(ip+1),& + & p2ptag, icomm,iret) + p2ptag = psb_int_swap_tag + call mpi_send(iasnd(idx+1:idx+sz),sz,& + & psb_mpi_epk_,prcid(ip+1),& + & p2ptag, icomm,iret) + call mpi_send(jasnd(idx+1:idx+sz),sz,& + & psb_mpi_epk_,prcid(ip+1),& + & p2ptag, icomm,iret) + end if + Enddo + + do ip = 0, np-1 + sz = rvsz(ip+1) + if (sz > 0) then + call mpi_wait(rvhd(ip+1,1),p2pstat,iret) + call mpi_wait(rvhd(ip+1,2),p2pstat,iret) + call mpi_wait(rvhd(ip+1,3),p2pstat,iret) + end if + Enddo + + end subroutine psb_s_e_simple_triad_a2av + end module psi_s_collective_mod diff --git a/base/modules/penv/psi_z_collective_mod.F90 b/base/modules/penv/psi_z_collective_mod.F90 index 33fe77642..a517cb031 100644 --- a/base/modules/penv/psi_z_collective_mod.F90 +++ b/base/modules/penv/psi_z_collective_mod.F90 @@ -31,6 +31,7 @@ ! module psi_z_collective_mod use psi_penv_mod + use psi_comm_buffers_mod interface psb_sum @@ -62,7 +63,13 @@ module psi_z_collective_mod module procedure psb_zexscan_sums, psb_zexscan_sumv end interface psb_exscan_sum + interface psb_simple_a2av + module procedure psb_z_simple_a2av + end interface psb_simple_a2av + interface psb_simple_triad_a2av + module procedure psb_z_e_simple_triad_a2av, psb_z_m_simple_triad_a2av + end interface psb_simple_triad_a2av contains @@ -764,16 +771,17 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt complex(psb_dpk_), intent(inout) :: dat complex(psb_dpk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) - call mpi_scan(dat,dat_,1,psb_mpi_c_dpk_,mpi_sum,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_scan(dat,dat_,1,psb_mpi_c_dpk_,mpi_sum,icomm,minfo) dat = dat_ #endif end subroutine psb_zscan_sums @@ -787,16 +795,17 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt complex(psb_dpk_), intent(inout) :: dat complex(psb_dpk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: icomm, minfo #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) - call mpi_exscan(dat,dat_,1,psb_mpi_c_dpk_,mpi_sum,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_exscan(dat,dat_,1,psb_mpi_c_dpk_,mpi_sum,icomm,minfo) dat = dat_ #else dat = zzero @@ -812,20 +821,21 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt complex(psb_dpk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root + integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ complex(psb_dpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) - call psb_realloc(size(dat),dat_,iinfo) + icomm = psb_get_mpi_comm(ictxt) + call psb_realloc(size(dat),dat_,info) dat_ = dat - if (iinfo == psb_success_) & - & call mpi_scan(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_sum,ictxt,info) + if (info == psb_success_) & + & call mpi_scan(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_sum,icomm,minfo) #endif end subroutine psb_zscan_sumv @@ -838,23 +848,228 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt complex(psb_dpk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root + integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ complex(psb_dpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) - call psb_realloc(size(dat),dat_,iinfo) + icomm = psb_get_mpi_comm(ictxt) + call psb_realloc(size(dat),dat_,info) dat_ = dat - if (iinfo == psb_success_) & - & call mpi_exscan(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_sum,ictxt,info) + if (info == psb_success_) & + & call mpi_exscan(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_sum,icomm,minfo) #else dat = zzero #endif end subroutine psb_zexscan_sumv + + subroutine psb_z_simple_a2av(valsnd,sdsz,bsdindx,& + & valrcv,rvsz,brvindx,ictxt,info) + use psi_z_p2p_mod + implicit none + complex(psb_dpk_), intent(in) :: valsnd(:) + complex(psb_dpk_), intent(out) :: valrcv(:) + integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) + integer(psb_ipk_), intent(in) :: ictxt + integer(psb_ipk_), intent(out) :: info + + integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz + + call psb_info(ictxt,iam,np) + + if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then + idx = bsdindx(ip+1) + call psb_snd(ictxt,valsnd(idx+1:idx+sz),ip) + end if + end do + + do ip = 0, np-1 + sz = rvsz(ip+1) + if (sz > 0) then + idx = brvindx(ip+1) + call psb_rcv(ictxt,valrcv(idx+1:idx+sz),ip) + end if + end do + + end subroutine psb_z_simple_a2av + + subroutine psb_z_m_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & valrcv,iarcv,jarcv,rvsz,brvindx,ictxt,info) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + complex(psb_dpk_), intent(in) :: valsnd(:) + integer(psb_mpk_), intent(in) :: iasnd(:), jasnd(:) + complex(psb_dpk_), intent(out) :: valrcv(:) + integer(psb_mpk_), intent(out) :: iarcv(:), jarcv(:) + integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) + integer(psb_ipk_), intent(in) :: ictxt + integer(psb_ipk_), intent(out) :: info + + !Local variables + integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz, counter + integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm + integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) + + call psb_info(ictxt,iam,np) + + icomm = psb_get_mpi_comm(ictxt) + + if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then + prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + idx = brvindx(ip+1) + p2ptag = psb_dcomplex_tag + call mpi_irecv(valrcv(idx+1:idx+sz),sz,& + & psb_mpi_c_dpk_,prcid(ip+1),& + & p2ptag, icomm,rvhd(ip+1,1),iret) + p2ptag = psb_int_swap_tag + call mpi_irecv(iarcv(idx+1:idx+sz),sz,& + & psb_mpi_mpk_,prcid(ip+1),& + & p2ptag, icomm,rvhd(ip+1,2),iret) + call mpi_irecv(jarcv(idx+1:idx+sz),sz,& + & psb_mpi_mpk_,prcid(ip+1),& + & p2ptag, icomm,rvhd(ip+1,3),iret) + end if + Enddo + + + do ip = 0, np-1 + sz = sdsz(ip+1) + if (sz > 0) then + if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + idx = bsdindx(ip+1) + p2ptag = psb_dcomplex_tag + call mpi_send(valsnd(idx+1:idx+sz),sz,& + & psb_mpi_c_dpk_,prcid(ip+1),& + & p2ptag, icomm,iret) + p2ptag = psb_int_swap_tag + call mpi_send(iasnd(idx+1:idx+sz),sz,& + & psb_mpi_mpk_,prcid(ip+1),& + & p2ptag, icomm,iret) + call mpi_send(jasnd(idx+1:idx+sz),sz,& + & psb_mpi_mpk_,prcid(ip+1),& + & p2ptag, icomm,iret) + end if + Enddo + + do ip = 0, np-1 + sz = rvsz(ip+1) + if (sz > 0) then + call mpi_wait(rvhd(ip+1,1),p2pstat,iret) + call mpi_wait(rvhd(ip+1,2),p2pstat,iret) + call mpi_wait(rvhd(ip+1,3),p2pstat,iret) + end if + Enddo + + end subroutine psb_z_m_simple_triad_a2av + + subroutine psb_z_e_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & valrcv,iarcv,jarcv,rvsz,brvindx,ictxt,info) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + complex(psb_dpk_), intent(in) :: valsnd(:) + integer(psb_epk_), intent(in) :: iasnd(:), jasnd(:) + complex(psb_dpk_), intent(out) :: valrcv(:) + integer(psb_epk_), intent(out) :: iarcv(:), jarcv(:) + integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) + integer(psb_ipk_), intent(in) :: ictxt + integer(psb_ipk_), intent(out) :: info + + !Local variables + integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz, counter + integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm + integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) + + call psb_info(ictxt,iam,np) + + icomm = psb_get_mpi_comm(ictxt) + + if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then + prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + idx = brvindx(ip+1) + p2ptag = psb_dcomplex_tag + call mpi_irecv(valrcv(idx+1:idx+sz),sz,& + & psb_mpi_c_dpk_,prcid(ip+1),& + & p2ptag, icomm,rvhd(ip+1,1),iret) + p2ptag = psb_int_swap_tag + call mpi_irecv(iarcv(idx+1:idx+sz),sz,& + & psb_mpi_epk_,prcid(ip+1),& + & p2ptag, icomm,rvhd(ip+1,2),iret) + call mpi_irecv(jarcv(idx+1:idx+sz),sz,& + & psb_mpi_epk_,prcid(ip+1),& + & p2ptag, icomm,rvhd(ip+1,3),iret) + end if + Enddo + + + do ip = 0, np-1 + sz = sdsz(ip+1) + if (sz > 0) then + if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + idx = bsdindx(ip+1) + p2ptag = psb_dcomplex_tag + call mpi_send(valsnd(idx+1:idx+sz),sz,& + & psb_mpi_r_dpk_,prcid(ip+1),& + & p2ptag, icomm,iret) + p2ptag = psb_int_swap_tag + call mpi_send(iasnd(idx+1:idx+sz),sz,& + & psb_mpi_epk_,prcid(ip+1),& + & p2ptag, icomm,iret) + call mpi_send(jasnd(idx+1:idx+sz),sz,& + & psb_mpi_epk_,prcid(ip+1),& + & p2ptag, icomm,iret) + end if + Enddo + + do ip = 0, np-1 + sz = rvsz(ip+1) + if (sz > 0) then + call mpi_wait(rvhd(ip+1,1),p2pstat,iret) + call mpi_wait(rvhd(ip+1,2),p2pstat,iret) + call mpi_wait(rvhd(ip+1,3),p2pstat,iret) + end if + Enddo + + end subroutine psb_z_e_simple_triad_a2av + end module psi_z_collective_mod diff --git a/base/modules/psb_const_mod.F90 b/base/modules/psb_const_mod.F90 index 92def010a..648a1669f 100644 --- a/base/modules/psb_const_mod.F90 +++ b/base/modules/psb_const_mod.F90 @@ -103,9 +103,9 @@ module psb_const_mod integer(psb_ipk_), save :: psb_sizeof_sp integer(psb_ipk_), save :: psb_sizeof_dp - integer(psb_ipk_), save :: psb_sizeof_i2p - integer(psb_ipk_), save :: psb_sizeof_mp = 4 - integer(psb_ipk_), save :: psb_sizeof_ep = 8 + integer(psb_ipk_), save :: psb_sizeof_i2p = 2 + integer(psb_ipk_), save :: psb_sizeof_mp = 4 + integer(psb_ipk_), save :: psb_sizeof_ep = 8 #if defined(IPK4) && defined(LPK4) integer(psb_ipk_), save :: psb_sizeof_ip = 4 @@ -145,13 +145,15 @@ module psb_const_mod ! Handy & miscellaneous constants ! integer(psb_epk_), parameter :: ezero=0, eone=1 - integer(psb_epk_), parameter :: etwo=2, ethree=3,emone=-1 + integer(psb_epk_), parameter :: etwo=2, ethree=3, emone=-1 integer(psb_mpk_), parameter :: mzero=0, mone=1 - integer(psb_mpk_), parameter :: mtwo=2, mthree=3,mmone=-1 + integer(psb_mpk_), parameter :: mtwo=2, mthree=3, mmone=-1 integer(psb_lpk_), parameter :: lzero=0, lone=1 - integer(psb_lpk_), parameter :: ltwo=2, lthree=3,lmone=-1 + integer(psb_lpk_), parameter :: ltwo=2, lthree=3, lmone=-1 integer(psb_ipk_), parameter :: izero=0, ione=1 - integer(psb_ipk_), parameter :: itwo=2, ithree=3,imone=-1 + integer(psb_ipk_), parameter :: itwo=2, ithree=3, imone=-1 + integer(psb_i2pk_), parameter :: i2zero=0, i2one=1 + integer(psb_i2pk_), parameter :: i2two=2, i2three=3, i2mone=-1 integer(psb_ipk_), parameter :: psb_root_=0 real(psb_spk_), parameter :: szero=0.0_psb_spk_, sone=1.0_psb_spk_ diff --git a/base/modules/psb_timers_mod.f90 b/base/modules/psb_timers_mod.f90 index 5b2a8054d..755afd24d 100644 --- a/base/modules/psb_timers_mod.f90 +++ b/base/modules/psb_timers_mod.f90 @@ -56,7 +56,7 @@ module psb_timers_mod ! The data itself type psb_string_item - character(len=:), allocatable :: data + character(len=40) :: data end type psb_string_item integer(psb_ipk_), allocatable :: nsamples(:) real(psb_dpk_), allocatable :: timers(:,:) diff --git a/base/modules/serial/psb_base_mat_mod.F90 b/base/modules/serial/psb_base_mat_mod.F90 index 8ebc7dc2f..9180142ac 100644 --- a/base/modules/serial/psb_base_mat_mod.F90 +++ b/base/modules/serial/psb_base_mat_mod.F90 @@ -1,9 +1,9 @@ -! +! ! Parallel Sparse BLAS version 3.5 ! (C) Copyright 2006-2018 -! Salvatore Filippone -! Alfredo Buttari -! +! Salvatore Filippone +! Alfredo Buttari +! ! Redistribution and use in source and binary forms, with or without ! modification, are permitted provided that the following conditions ! are met: @@ -15,7 +15,7 @@ ! 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 @@ -27,8 +27,8 @@ ! 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. -! -! +! +! ! ! package: psb_base_mat_mod ! @@ -64,15 +64,15 @@ ! of the indices, which are PSB_LPK_ so that the entries ! are guaranteed to be able to contain global indices. ! This type only supports data handling and preprocessing, it is -! not supposed to be used for computations. +! not supposed to be used for computations. ! ! module psb_base_mat_mod - - use psb_const_mod + + use psb_const_mod use psi_serial_mod - + ! !> \namespace psb_base_mod \class psb_base_sparse_mat !! The basic data about your matrix. @@ -81,7 +81,7 @@ module psb_base_mat_mod !! storage formats. The grandchild classes are then !! encapsulated to implement the STATE design pattern. !! We have an ambiguity in that the inner class has a - !! "state" variable; we hope the context will make it clear. + !! "state" variable; we hope the context will make it clear. !! !! !! The methods associated to this class can be grouped into three sets: @@ -106,7 +106,7 @@ module psb_base_mat_mod !> Row size integer(psb_ipk_), private :: m !> Col size - integer(psb_ipk_), private :: n + integer(psb_ipk_), private :: n !> Matrix state: !! null: pristine; !! build: it's being filled with entries; @@ -114,17 +114,17 @@ module psb_base_mat_mod !! update: accepts coefficients but only !! in already existing entries. !! The transitions among the states are detailed in - !! psb_T_mat_mod. + !! psb_T_mat_mod. integer(psb_ipk_), private :: state !> How to treat duplicate elements when - !! transitioning from the BUILD to the ASSEMBLED state. + !! transitioning from the BUILD to the ASSEMBLED state. !! While many formats would allow for duplicate !! entries, it is much better to constrain the matrices !! NOT to have duplicate entries, except while in the !! BUILD state; in our overall design, only COO matrices !! can ever be in the BUILD state, hence all other formats !! cannot have duplicate entries. - integer(psb_ipk_), private :: duplicate + integer(psb_ipk_), private :: duplicate !> Is the matrix symmetric? (must also be square) logical, private :: symmetric !> Is the matrix triangular? (must also be square) @@ -137,11 +137,11 @@ module psb_base_mat_mod logical, private :: sorted logical, private :: repeatable_updates=.false. - contains + contains ! == = ================================= ! - ! Getters + ! Getters ! ! ! == = ================================= @@ -168,10 +168,10 @@ module psb_base_mat_mod procedure, pass(a) :: is_by_rows => psb_base_is_by_rows procedure, pass(a) :: is_by_cols => psb_base_is_by_cols procedure, pass(a) :: is_repeatable_updates => psb_base_is_repeatable_updates - + ! == = ================================= ! - ! Setters + ! Setters ! ! == = ================================= procedure, pass(a) :: set_nrows => psb_base_set_nrows @@ -196,7 +196,7 @@ module psb_base_mat_mod ! ! Data management ! - ! == = ================================= + ! == = ================================= procedure, pass(a) :: get_neigh => psb_base_get_neigh procedure, pass(a) :: free => psb_base_free procedure, pass(a) :: asb => psb_base_mat_asb @@ -224,7 +224,7 @@ module psb_base_mat_mod ! Any derived class having extra storage upon sync ! will guarantee that both fortran/host side and ! external side contain the same data. The base - ! version is only a placeholder. + ! version is only a placeholder. ! procedure, pass(a) :: sync => psb_base_mat_sync procedure, pass(a) :: is_host => psb_base_mat_is_host @@ -233,7 +233,7 @@ module psb_base_mat_mod procedure, pass(a) :: set_host => psb_base_mat_set_host procedure, pass(a) :: set_dev => psb_base_mat_set_dev procedure, pass(a) :: set_sync => psb_base_mat_set_sync - + end type psb_base_sparse_mat !> Function: psb_base_get_nz_row @@ -242,7 +242,7 @@ module psb_base_mat_mod !! count(A(idx,:)/=0) !! \param idx The line we are interested in. ! - interface + interface function psb_base_get_nz_row(idx,a) result(res) import :: psb_ipk_, psb_epk_, psb_base_sparse_mat integer(psb_ipk_), intent(in) :: idx @@ -250,14 +250,14 @@ module psb_base_mat_mod integer(psb_ipk_) :: res end function psb_base_get_nz_row end interface - + ! !> Function: psb_base_get_nzeros !! \memberof psb_base_sparse_mat - !! Interface for the get_nzeros method. Equivalent to: - !! count(A(:,:)/=0) + !! Interface for the get_nzeros method. Equivalent to: + !! count(A(:,:)/=0) ! - interface + interface function psb_base_get_nzeros(a) result(res) import :: psb_ipk_, psb_epk_, psb_base_sparse_mat class(psb_base_sparse_mat), intent(in) :: a @@ -270,9 +270,9 @@ module psb_base_mat_mod !! how many items can A hold with !! its current space allocation? !! (as opposed to how many are - !! currently occupied) - ! - interface + !! currently occupied) + ! + interface function psb_base_get_size(a) result(res) import :: psb_ipk_, psb_epk_, psb_base_sparse_mat class(psb_base_sparse_mat), intent(in) :: a @@ -284,34 +284,34 @@ module psb_base_mat_mod !> Function reinit: transition state from ASB to UPDATE !! \memberof psb_base_sparse_mat !! \param clear [true] explicitly zero out coefficients. - ! - interface + ! + interface subroutine psb_base_reinit(a,clear) import :: psb_ipk_, psb_epk_, psb_base_sparse_mat - class(psb_base_sparse_mat), intent(inout) :: a + class(psb_base_sparse_mat), intent(inout) :: a logical, intent(in), optional :: clear end subroutine psb_base_reinit end interface - + ! !> Function !! \memberof psb_base_sparse_mat - !! print on file in Matrix Market format. + !! print on file in Matrix Market format. !! \param iout the output unit !! \param iv(:) [none] renumber both row and column indices !! \param head [none] a descriptive header for the matrix data !! \param ivr(:) [none] renumbering for the rows !! \param ivc(:) [none] renumbering for the cols - ! - interface + ! + interface subroutine psb_base_sparse_print(iout,a,iv,head,ivr,ivc) - import :: psb_ipk_, psb_epk_, psb_base_sparse_mat + import :: psb_ipk_, psb_epk_, psb_base_sparse_mat, psb_lpk_ integer(psb_ipk_), intent(in) :: iout - class(psb_base_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + class(psb_base_sparse_mat), intent(in) :: a + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) end subroutine psb_base_sparse_print end interface @@ -325,25 +325,25 @@ module psb_base_mat_mod !! Return a list of NZ pairs !! (IA(i),JA(i)) !! each identifying the position of a nonzero in A - !! between row indices IMIN:IMAX; + !! between row indices IMIN:IMAX; !! IA,JA are reallocated as necessary. - !! \param imin the minimum row index we are interested in - !! \param imax the minimum row index we are interested in + !! \param imin the minimum row index we are interested in + !! \param imax the minimum row index we are interested in !! \param nz the number of output coefficients !! \param ia(:) the output row indices !! \param ja(:) the output col indices !! \param info return code - !! \param jmin [1] minimum col index - !! \param jmax [a\%get_ncols()] maximum col index + !! \param jmin [1] minimum col index + !! \param jmax [a\%get_ncols()] maximum col index !! \param iren(:) [none] an array to return renumbered indices (iren(ia(:)),iren(ja(:)) !! \param rscale [false] map [min(ia(:)):max(ia(:))] onto [1:max(ia(:))-min(ia(:))+1] !! \param cscale [false] map [min(ja(:)):max(ja(:))] onto [1:max(ja(:))-min(ja(:))+1] !! ( iren cannot be specified with rscale/cscale) - !! \param append [false] append to ia,ja + !! \param append [false] append to ia,ja !! \param nzin [none] if append, then first new entry should go in entry nzin+1 - ! + ! - interface + interface subroutine psb_base_csgetptn(imin,imax,a,nz,ia,ja,info,& & jmin,jmax,iren,append,nzin,rscale,cscale) import :: psb_ipk_, psb_epk_, psb_base_sparse_mat @@ -358,7 +358,7 @@ module psb_base_mat_mod logical, intent(in), optional :: rscale,cscale end subroutine psb_base_csgetptn end interface - + ! !> Function get_neigh: !! \memberof psb_base_sparse_mat @@ -372,21 +372,21 @@ module psb_base_mat_mod !! \param n the number of indices returned !! \param info return code !! \param lev [1] find neighbours recursively for LEV levels, - !! i.e. when lev=2 find neighours of neighbours, etc. - ! - interface + !! i.e. when lev=2 find neighours of neighbours, etc. + ! + interface subroutine psb_base_get_neigh(a,idx,neigh,n,info,lev) import :: psb_ipk_, psb_epk_, psb_base_sparse_mat - class(psb_base_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in) :: idx - integer(psb_ipk_), intent(out) :: n + class(psb_base_sparse_mat), intent(in) :: a + integer(psb_ipk_), intent(in) :: idx + integer(psb_ipk_), intent(out) :: n integer(psb_ipk_), allocatable, intent(out) :: neigh(:) integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: lev + integer(psb_ipk_), optional, intent(in) :: lev end subroutine psb_base_get_neigh end interface - - ! + + ! ! !> Function allocate_mnnz !! \memberof psb_base_sparse_mat @@ -396,8 +396,8 @@ module psb_base_mat_mod !! \param n number of cols !! \param nz [estimated internally] number of nonzeros to allocate for ! - interface - subroutine psb_base_allocate_mnnz(m,n,a,nz) + interface + subroutine psb_base_allocate_mnnz(m,n,a,nz) import :: psb_ipk_, psb_epk_, psb_base_sparse_mat integer(psb_ipk_), intent(in) :: m,n class(psb_base_sparse_mat), intent(inout) :: a @@ -405,8 +405,8 @@ module psb_base_mat_mod end subroutine psb_base_allocate_mnnz end interface - - ! + + ! ! !> Function reallocate_nz !! \memberof psb_base_sparse_mat @@ -414,40 +414,40 @@ module psb_base_mat_mod !! !! \param nz number of nonzeros to allocate for ! - interface - subroutine psb_base_reallocate_nz(nz,a) + interface + subroutine psb_base_reallocate_nz(nz,a) import :: psb_ipk_, psb_epk_, psb_base_sparse_mat integer(psb_ipk_), intent(in) :: nz class(psb_base_sparse_mat), intent(inout) :: a end subroutine psb_base_reallocate_nz end interface - ! + ! !> Function free !! \memberof psb_base_sparse_mat !! \brief destructor ! - interface - subroutine psb_base_free(a) + interface + subroutine psb_base_free(a) import :: psb_ipk_, psb_epk_, psb_base_sparse_mat class(psb_base_sparse_mat), intent(inout) :: a end subroutine psb_base_free end interface - - ! - !> Function trim + + ! + !> Function trim !! \memberof psb_base_sparse_mat !! \brief Memory trim !! Make sure the memory allocation of the sparse matrix is as tight as - !! possible given the actual number of nonzeros it contains. + !! possible given the actual number of nonzeros it contains. ! - interface - subroutine psb_base_trim(a) + interface + subroutine psb_base_trim(a) import :: psb_ipk_, psb_epk_, psb_base_sparse_mat class(psb_base_sparse_mat), intent(inout) :: a end subroutine psb_base_trim end interface - + ! !> \namespace psb_lbase_mod \class psb_lbase_sparse_mat !! The basic data about your matrix. @@ -456,7 +456,7 @@ module psb_base_mat_mod !! storage formats. The grandchild classes are then !! encapsulated to implement the STATE design pattern. !! We have an ambiguity in that the inner class has a - !! "state" variable; we hope the context will make it clear. + !! "state" variable; we hope the context will make it clear. !! !! !! The methods associated to this class can be grouped into three sets: @@ -481,7 +481,7 @@ module psb_base_mat_mod !> Row size integer(psb_lpk_), private :: m !> Col size - integer(psb_lpk_), private :: n + integer(psb_lpk_), private :: n !> Matrix state: !! null: pristine; !! build: it's being filled with entries; @@ -489,17 +489,17 @@ module psb_base_mat_mod !! update: accepts coefficients but only !! in already existing entries. !! The transitions among the states are detailed in - !! psb_T_mat_mod. + !! psb_T_mat_mod. integer(psb_ipk_), private :: state !> How to treat duplicate elements when - !! transitioning from the BUILD to the ASSEMBLED state. + !! transitioning from the BUILD to the ASSEMBLED state. !! While many formats would allow for duplicate !! entries, it is much better to constrain the matrices !! NOT to have duplicate entries, except while in the !! BUILD state; in our overall design, only COO matrices !! can ever be in the BUILD state, hence all other formats !! cannot have duplicate entries. - integer(psb_ipk_), private :: duplicate + integer(psb_ipk_), private :: duplicate !> Is the matrix symmetric? (must also be square) logical, private :: symmetric !> Is the matrix triangular? (must also be square) @@ -512,11 +512,11 @@ module psb_base_mat_mod logical, private :: sorted logical, private :: repeatable_updates=.false. - contains + contains ! == = ================================= ! - ! Getters + ! Getters ! ! ! == = ================================= @@ -543,15 +543,15 @@ module psb_base_mat_mod procedure, pass(a) :: is_by_rows => psb_lbase_is_by_rows procedure, pass(a) :: is_by_cols => psb_lbase_is_by_cols procedure, pass(a) :: is_repeatable_updates => psb_lbase_is_repeatable_updates - + ! == = ================================= ! - ! Setters + ! Setters ! ! == = ================================= procedure, pass(a) :: set_lnrows => psb_lbase_set_lnrows procedure, pass(a) :: set_lncols => psb_lbase_set_lncols -#if defined(IPK4) && defined(LPK8) +#if defined(IPK4) && defined(LPK8) procedure, pass(a) :: set_inrows => psb_lbase_set_inrows procedure, pass(a) :: set_incols => psb_lbase_set_incols generic, public :: set_nrows => set_lnrows, set_inrows @@ -559,7 +559,7 @@ module psb_base_mat_mod #else generic, public :: set_nrows => set_lnrows generic, public :: set_ncols => set_lncols -#endif +#endif procedure, pass(a) :: set_dupl => psb_lbase_set_dupl procedure, pass(a) :: set_state => psb_lbase_set_state procedure, pass(a) :: set_null => psb_lbase_set_null @@ -580,7 +580,7 @@ module psb_base_mat_mod ! ! Data management ! - ! == = ================================= + ! == = ================================= procedure, pass(a) :: get_neigh => psb_lbase_get_neigh procedure, pass(a) :: free => psb_lbase_free procedure, pass(a) :: asb => psb_lbase_mat_asb @@ -608,7 +608,7 @@ module psb_base_mat_mod ! Any derived class having extra storage upon sync ! will guarantee that both fortran/host side and ! external side contain the same data. The base - ! version is only a placeholder. + ! version is only a placeholder. ! procedure, pass(a) :: sync => psb_lbase_mat_sync procedure, pass(a) :: is_host => psb_lbase_mat_is_host @@ -617,7 +617,7 @@ module psb_base_mat_mod procedure, pass(a) :: set_host => psb_lbase_mat_set_host procedure, pass(a) :: set_dev => psb_lbase_mat_set_dev procedure, pass(a) :: set_sync => psb_lbase_mat_set_sync - + end type psb_lbase_sparse_mat !> Function: psb_lbase_get_nz_row @@ -626,7 +626,7 @@ module psb_base_mat_mod !! count(A(idx,:)/=0) !! \param idx The line we are interested in. ! - interface + interface function psb_lbase_get_nz_row(idx,a) result(res) import :: psb_lpk_, psb_epk_, psb_lbase_sparse_mat integer(psb_lpk_), intent(in) :: idx @@ -634,14 +634,14 @@ module psb_base_mat_mod integer(psb_lpk_) :: res end function psb_lbase_get_nz_row end interface - + ! !> Function: psb_lbase_get_nzeros !! \memberof psb_lbase_sparse_mat - !! Interface for the get_nzeros method. Equivalent to: - !! count(A(:,:)/=0) + !! Interface for the get_nzeros method. Equivalent to: + !! count(A(:,:)/=0) ! - interface + interface function psb_lbase_get_nzeros(a) result(res) import :: psb_lpk_, psb_epk_, psb_lbase_sparse_mat class(psb_lbase_sparse_mat), intent(in) :: a @@ -654,9 +654,9 @@ module psb_base_mat_mod !! how many items can A hold with !! its current space allocation? !! (as opposed to how many are - !! currently occupied) - ! - interface + !! currently occupied) + ! + interface function psb_lbase_get_size(a) result(res) import :: psb_lpk_, psb_epk_, psb_lbase_sparse_mat class(psb_lbase_sparse_mat), intent(in) :: a @@ -668,31 +668,31 @@ module psb_base_mat_mod !> Function reinit: transition state from ASB to UPDATE !! \memberof psb_lbase_sparse_mat !! \param clear [true] explicitly zero out coefficients. - ! - interface + ! + interface subroutine psb_lbase_reinit(a,clear) import :: psb_ipk_, psb_epk_, psb_lbase_sparse_mat - class(psb_lbase_sparse_mat), intent(inout) :: a + class(psb_lbase_sparse_mat), intent(inout) :: a logical, intent(in), optional :: clear end subroutine psb_lbase_reinit end interface - + ! !> Function !! \memberof psb_lbase_sparse_mat - !! print on file in Matrix Market format. + !! print on file in Matrix Market format. !! \param iout the output unit !! \param iv(:) [none] renumber both row and column indices !! \param head [none] a descriptive header for the matrix data !! \param ivr(:) [none] renumbering for the rows !! \param ivc(:) [none] renumbering for the cols - ! - interface + ! + interface subroutine psb_lbase_sparse_print(iout,a,iv,head,ivr,ivc) import :: psb_ipk_, psb_lpk_, psb_epk_, psb_lbase_sparse_mat integer(psb_ipk_), intent(in) :: iout - class(psb_lbase_sparse_mat), intent(in) :: a + class(psb_lbase_sparse_mat), intent(in) :: a integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) @@ -709,25 +709,25 @@ module psb_base_mat_mod !! Return a list of NZ pairs !! (IA(i),JA(i)) !! each identifying the position of a nonzero in A - !! between row indices IMIN:IMAX; + !! between row indices IMIN:IMAX; !! IA,JA are reallocated as necessary. - !! \param imin the minimum row index we are interested in - !! \param imax the minimum row index we are interested in + !! \param imin the minimum row index we are interested in + !! \param imax the minimum row index we are interested in !! \param nz the number of output coefficients !! \param ia(:) the output row indices !! \param ja(:) the output col indices !! \param info return code - !! \param jmin [1] minimum col index - !! \param jmax [a\%get_ncols()] maximum col index + !! \param jmin [1] minimum col index + !! \param jmax [a\%get_ncols()] maximum col index !! \param iren(:) [none] an array to return renumbered indices (iren(ia(:)),iren(ja(:)) !! \param rscale [false] map [min(ia(:)):max(ia(:))] onto [1:max(ia(:))-min(ia(:))+1] !! \param cscale [false] map [min(ja(:)):max(ja(:))] onto [1:max(ja(:))-min(ja(:))+1] !! ( iren cannot be specified with rscale/cscale) - !! \param append [false] append to ia,ja + !! \param append [false] append to ia,ja !! \param nzin [none] if append, then first new entry should go in entry nzin+1 - ! + ! - interface + interface subroutine psb_lbase_csgetptn(imin,imax,a,nz,ia,ja,info,& & jmin,jmax,iren,append,nzin,rscale,cscale) import :: psb_ipk_, psb_lpk_, psb_epk_, psb_lbase_sparse_mat @@ -742,7 +742,7 @@ module psb_base_mat_mod logical, intent(in), optional :: rscale,cscale end subroutine psb_lbase_csgetptn end interface - + ! !> Function get_neigh: !! \memberof psb_lbase_sparse_mat @@ -756,21 +756,21 @@ module psb_base_mat_mod !! \param n the number of indices returned !! \param info return code !! \param lev [1] find neighbours recursively for LEV levels, - !! i.e. when lev=2 find neighours of neighbours, etc. - ! - interface + !! i.e. when lev=2 find neighours of neighbours, etc. + ! + interface subroutine psb_lbase_get_neigh(a,idx,neigh,n,info,lev) import :: psb_ipk_, psb_lpk_, psb_epk_, psb_lbase_sparse_mat - class(psb_lbase_sparse_mat), intent(in) :: a - integer(psb_lpk_), intent(in) :: idx - integer(psb_lpk_), intent(out) :: n + class(psb_lbase_sparse_mat), intent(in) :: a + integer(psb_lpk_), intent(in) :: idx + integer(psb_lpk_), intent(out) :: n integer(psb_lpk_), allocatable, intent(out) :: neigh(:) integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), optional, intent(in) :: lev + integer(psb_lpk_), optional, intent(in) :: lev end subroutine psb_lbase_get_neigh end interface - - ! + + ! ! !> Function allocate_mnnz !! \memberof psb_lbase_sparse_mat @@ -780,8 +780,8 @@ module psb_base_mat_mod !! \param n number of cols !! \param nz [estimated internally] number of nonzeros to allocate for ! - interface - subroutine psb_lbase_allocate_mnnz(m,n,a,nz) + interface + subroutine psb_lbase_allocate_mnnz(m,n,a,nz) import :: psb_ipk_, psb_lpk_, psb_epk_, psb_lbase_sparse_mat integer(psb_lpk_), intent(in) :: m,n class(psb_lbase_sparse_mat), intent(inout) :: a @@ -789,8 +789,8 @@ module psb_base_mat_mod end subroutine psb_lbase_allocate_mnnz end interface - - ! + + ! ! !> Function reallocate_nz !! \memberof psb_lbase_sparse_mat @@ -798,249 +798,249 @@ module psb_base_mat_mod !! !! \param nz number of nonzeros to allocate for ! - interface - subroutine psb_lbase_reallocate_nz(nz,a) + interface + subroutine psb_lbase_reallocate_nz(nz,a) import :: psb_ipk_, psb_lpk_, psb_epk_, psb_lbase_sparse_mat integer(psb_lpk_), intent(in) :: nz class(psb_lbase_sparse_mat), intent(inout) :: a end subroutine psb_lbase_reallocate_nz end interface - ! + ! !> Function free !! \memberof psb_lbase_sparse_mat !! \brief destructor ! - interface - subroutine psb_lbase_free(a) + interface + subroutine psb_lbase_free(a) import :: psb_ipk_, psb_lpk_, psb_epk_, psb_lbase_sparse_mat class(psb_lbase_sparse_mat), intent(inout) :: a end subroutine psb_lbase_free end interface - - ! - !> Function trim + + ! + !> Function trim !! \memberof psb_lbase_sparse_mat !! \brief Memory trim !! Make sure the memory allocation of the sparse matrix is as tight as - !! possible given the actual number of nonzeros it contains. + !! possible given the actual number of nonzeros it contains. ! - interface - subroutine psb_lbase_trim(a) + interface + subroutine psb_lbase_trim(a) import :: psb_ipk_, psb_lpk_, psb_epk_, psb_lbase_sparse_mat class(psb_lbase_sparse_mat), intent(inout) :: a end subroutine psb_lbase_trim end interface - + interface assignment(=) module procedure psb_base_from_lbase, psb_lbase_from_base end interface assignment(=) - + contains - - ! + + ! !> Function sizeof !! \memberof psb_base_sparse_mat !! \brief Memory occupation in byes ! function psb_base_sizeof(a) result(res) - implicit none + implicit none class(psb_base_sparse_mat), intent(in) :: a integer(psb_epk_) :: res res = 8 end function psb_base_sizeof - - ! + + ! !> Function get_fmt !! \memberof psb_base_sparse_mat !! \brief return a short descriptive name (e.g. COO CSR etc.) ! function psb_base_get_fmt() result(res) - implicit none + implicit none character(len=5) :: res res = 'NULL' end function psb_base_get_fmt - ! + ! !> Function has_update !! \memberof psb_base_sparse_mat - !! \brief Does the forma have the UPDATE functionality? + !! \brief Does the forma have the UPDATE functionality? ! function psb_base_has_update() result(res) - implicit none + implicit none logical :: res res = .true. end function psb_base_has_update - + ! - ! Standard getter functions: self-explaining. + ! Standard getter functions: self-explaining. ! function psb_base_get_dupl(a) result(res) - implicit none + implicit none class(psb_base_sparse_mat), intent(in) :: a integer(psb_ipk_) :: res res = a%duplicate end function psb_base_get_dupl - - + + function psb_base_get_state(a) result(res) - implicit none + implicit none class(psb_base_sparse_mat), intent(in) :: a integer(psb_ipk_) :: res res = a%state end function psb_base_get_state - + function psb_base_get_nrows(a) result(res) - implicit none + implicit none class(psb_base_sparse_mat), intent(in) :: a integer(psb_ipk_) :: res res = a%m end function psb_base_get_nrows function psb_base_get_ncols(a) result(res) - implicit none + implicit none class(psb_base_sparse_mat), intent(in) :: a integer(psb_ipk_) :: res res = a%n end function psb_base_get_ncols - subroutine psb_base_set_nrows(m,a) - implicit none + subroutine psb_base_set_nrows(m,a) + implicit none class(psb_base_sparse_mat), intent(inout) :: a integer(psb_ipk_), intent(in) :: m a%m = m end subroutine psb_base_set_nrows - subroutine psb_base_set_ncols(n,a) - implicit none + subroutine psb_base_set_ncols(n,a) + implicit none class(psb_base_sparse_mat), intent(inout) :: a integer(psb_ipk_), intent(in) :: n a%n = n end subroutine psb_base_set_ncols - - subroutine psb_base_set_state(n,a) - implicit none + + subroutine psb_base_set_state(n,a) + implicit none class(psb_base_sparse_mat), intent(inout) :: a integer(psb_ipk_), intent(in) :: n a%state = n end subroutine psb_base_set_state - subroutine psb_base_set_dupl(n,a) - implicit none + subroutine psb_base_set_dupl(n,a) + implicit none class(psb_base_sparse_mat), intent(inout) :: a integer(psb_ipk_), intent(in) :: n a%duplicate = n end subroutine psb_base_set_dupl - subroutine psb_base_set_null(a) - implicit none + subroutine psb_base_set_null(a) + implicit none class(psb_base_sparse_mat), intent(inout) :: a a%state = psb_spmat_null_ end subroutine psb_base_set_null - subroutine psb_base_set_bld(a) - implicit none + subroutine psb_base_set_bld(a) + implicit none class(psb_base_sparse_mat), intent(inout) :: a a%state = psb_spmat_bld_ end subroutine psb_base_set_bld - subroutine psb_base_set_upd(a) - implicit none + subroutine psb_base_set_upd(a) + implicit none class(psb_base_sparse_mat), intent(inout) :: a a%state = psb_spmat_upd_ end subroutine psb_base_set_upd - subroutine psb_base_set_asb(a) - implicit none + subroutine psb_base_set_asb(a) + implicit none class(psb_base_sparse_mat), intent(inout) :: a a%state = psb_spmat_asb_ end subroutine psb_base_set_asb - subroutine psb_base_set_sorted(a,val) - implicit none + subroutine psb_base_set_sorted(a,val) + implicit none class(psb_base_sparse_mat), intent(inout) :: a logical, intent(in), optional :: val - - if (present(val)) then + + if (present(val)) then a%sorted = val else a%sorted = .true. end if end subroutine psb_base_set_sorted - subroutine psb_base_set_triangle(a,val) - implicit none + subroutine psb_base_set_triangle(a,val) + implicit none class(psb_base_sparse_mat), intent(inout) :: a logical, intent(in), optional :: val - - if (present(val)) then + + if (present(val)) then a%triangle = val else a%triangle = .true. end if end subroutine psb_base_set_triangle - subroutine psb_base_set_symmetric(a,val) - implicit none + subroutine psb_base_set_symmetric(a,val) + implicit none class(psb_base_sparse_mat), intent(inout) :: a logical, intent(in), optional :: val - - if (present(val)) then + + if (present(val)) then a%symmetric = val else a%symmetric = .true. end if end subroutine psb_base_set_symmetric - subroutine psb_base_set_unit(a,val) - implicit none + subroutine psb_base_set_unit(a,val) + implicit none class(psb_base_sparse_mat), intent(inout) :: a logical, intent(in), optional :: val - - if (present(val)) then + + if (present(val)) then a%unitd = val else a%unitd = .true. end if end subroutine psb_base_set_unit - subroutine psb_base_set_lower(a,val) - implicit none + subroutine psb_base_set_lower(a,val) + implicit none class(psb_base_sparse_mat), intent(inout) :: a logical, intent(in), optional :: val - - if (present(val)) then + + if (present(val)) then a%upper = .not.val else a%upper = .false. end if end subroutine psb_base_set_lower - subroutine psb_base_set_upper(a,val) - implicit none + subroutine psb_base_set_upper(a,val) + implicit none class(psb_base_sparse_mat), intent(inout) :: a logical, intent(in), optional :: val - - if (present(val)) then + + if (present(val)) then a%upper = val else a%upper = .true. end if end subroutine psb_base_set_upper - subroutine psb_base_set_repeatable_updates(a,val) - implicit none + subroutine psb_base_set_repeatable_updates(a,val) + implicit none class(psb_base_sparse_mat), intent(inout) :: a logical, intent(in), optional :: val - - if (present(val)) then + + if (present(val)) then a%repeatable_updates = val else a%repeatable_updates = .true. @@ -1048,70 +1048,70 @@ contains end subroutine psb_base_set_repeatable_updates function psb_base_is_triangle(a) result(res) - implicit none + implicit none class(psb_base_sparse_mat), intent(in) :: a logical :: res res = a%triangle end function psb_base_is_triangle function psb_base_is_symmetric(a) result(res) - implicit none + implicit none class(psb_base_sparse_mat), intent(in) :: a logical :: res res = a%symmetric end function psb_base_is_symmetric function psb_base_is_unit(a) result(res) - implicit none + implicit none class(psb_base_sparse_mat), intent(in) :: a logical :: res res = a%unitd end function psb_base_is_unit function psb_base_is_upper(a) result(res) - implicit none + implicit none class(psb_base_sparse_mat), intent(in) :: a logical :: res res = a%upper .and. a%triangle end function psb_base_is_upper function psb_base_is_lower(a) result(res) - implicit none + implicit none class(psb_base_sparse_mat), intent(in) :: a logical :: res res = (.not.a%upper) .and. a%triangle end function psb_base_is_lower function psb_base_is_null(a) result(res) - implicit none + implicit none class(psb_base_sparse_mat), intent(in) :: a logical :: res res = (a%state == psb_spmat_null_) end function psb_base_is_null function psb_base_is_bld(a) result(res) - implicit none + implicit none class(psb_base_sparse_mat), intent(in) :: a logical :: res res = (a%state == psb_spmat_bld_) end function psb_base_is_bld function psb_base_is_upd(a) result(res) - implicit none + implicit none class(psb_base_sparse_mat), intent(in) :: a logical :: res res = (a%state == psb_spmat_upd_) end function psb_base_is_upd function psb_base_is_asb(a) result(res) - implicit none + implicit none class(psb_base_sparse_mat), intent(in) :: a logical :: res res = (a%state == psb_spmat_asb_) end function psb_base_is_asb function psb_base_is_sorted(a) result(res) - implicit none + implicit none class(psb_base_sparse_mat), intent(in) :: a logical :: res res = a%sorted @@ -1119,21 +1119,21 @@ contains function psb_base_is_by_rows(a) result(res) - implicit none + implicit none class(psb_base_sparse_mat), intent(in) :: a logical :: res res = .false. end function psb_base_is_by_rows function psb_base_is_by_cols(a) result(res) - implicit none + implicit none class(psb_base_sparse_mat), intent(in) :: a logical :: res res = .false. end function psb_base_is_by_cols function psb_base_is_repeatable_updates(a) result(res) - implicit none + implicit none class(psb_base_sparse_mat), intent(in) :: a logical :: res res = a%repeatable_updates @@ -1141,27 +1141,27 @@ contains ! ! has_xt_tri: does the current type support - ! extended triangle operations? - ! + ! extended triangle operations? + ! function psb_base_has_xt_tri() result(res) - implicit none + implicit none logical :: res - - res = .false. + + res = .false. end function psb_base_has_xt_tri - + ! ! TRANSP: note sorted=.false. ! better invoke a fix() too many than ! regret it later... ! subroutine psb_base_transp_2mat(a,b) - implicit none - + implicit none + class(psb_base_sparse_mat), intent(in) :: a class(psb_base_sparse_mat), intent(out) :: b - + b%m = a%n b%n = a%m b%state = a%state @@ -1172,16 +1172,16 @@ contains b%upper = .not.a%upper b%sorted = .false. b%repeatable_updates = .false. - + end subroutine psb_base_transp_2mat subroutine psb_base_transc_2mat(a,b) - implicit none - + implicit none + class(psb_base_sparse_mat), intent(in) :: a class(psb_base_sparse_mat), intent(out) :: b - + b%m = a%n b%n = a%m b%state = a%state @@ -1196,8 +1196,8 @@ contains end subroutine psb_base_transc_2mat subroutine psb_base_transp_1mat(a) - implicit none - + implicit none + class(psb_base_sparse_mat), intent(inout) :: a integer(psb_ipk_) :: itmp @@ -1211,15 +1211,15 @@ contains a%upper = .not.a%upper a%sorted = .false. a%repeatable_updates = .false. - + end subroutine psb_base_transp_1mat subroutine psb_base_transc_1mat(a) - implicit none - + implicit none + class(psb_base_sparse_mat), intent(inout) :: a - - call a%transp() + + call a%transp() end subroutine psb_base_transc_1mat @@ -1228,89 +1228,89 @@ contains !> Function base_asb: !! \memberof psb_base_sparse_mat !! \brief Sync: base version calls sync and the set_asb. - !! + !! ! subroutine psb_base_mat_asb(a) - implicit none + implicit none class(psb_base_sparse_mat), intent(inout) :: a - + call a%sync() call a%set_asb() end subroutine psb_base_mat_asb ! ! The base version of SYNC & friends does nothing, it's just ! a placeholder. - ! + ! ! !> Function base_sync: !! \memberof psb_base_sparse_mat !! \brief Sync: base version is a no-op. - !! + !! ! subroutine psb_base_mat_sync(a) - implicit none + implicit none class(psb_base_sparse_mat), target, intent(in) :: a - + end subroutine psb_base_mat_sync ! !> Function base_set_host: !! \memberof psb_base_sparse_mat !! \brief Set_host: base version is a no-op. - !! + !! ! subroutine psb_base_mat_set_host(a) - implicit none + implicit none class(psb_base_sparse_mat), intent(inout) :: a - + end subroutine psb_base_mat_set_host ! !> Function base_set_dev: !! \memberof psb_base_sparse_mat !! \brief Set_dev: base version is a no-op. - !! + !! ! subroutine psb_base_mat_set_dev(a) - implicit none + implicit none class(psb_base_sparse_mat), intent(inout) :: a - + end subroutine psb_base_mat_set_dev ! !> Function base_set_sync: !! \memberof psb_base_sparse_mat !! \brief Set_sync: base version is a no-op. - !! + !! ! subroutine psb_base_mat_set_sync(a) - implicit none + implicit none class(psb_base_sparse_mat), intent(inout) :: a - + end subroutine psb_base_mat_set_sync ! !> Function base_is_dev: !! \memberof psb_base_sparse_mat !! \brief Is matrix on eaternal device . - !! + !! ! function psb_base_mat_is_dev(a) result(res) - implicit none + implicit none class(psb_base_sparse_mat), intent(in) :: a logical :: res - + res = .false. end function psb_base_mat_is_dev - + ! !> Function base_is_host !! \memberof psb_base_sparse_mat !! \brief Is matrix on standard memory . - !! + !! ! function psb_base_mat_is_host(a) result(res) - implicit none + implicit none class(psb_base_sparse_mat), intent(in) :: a logical :: res @@ -1321,10 +1321,10 @@ contains !> Function base_is_sync !! \memberof psb_base_sparse_mat !! \brief Is matrix on sync . - !! + !! ! function psb_base_mat_is_sync(a) result(res) - implicit none + implicit none class(psb_base_sparse_mat), intent(in) :: a logical :: res @@ -1332,225 +1332,225 @@ contains end function psb_base_mat_is_sync - - ! + + ! !> Function sizeof !! \memberof psb_lbase_sparse_mat !! \brief Memory occupation in byes ! function psb_lbase_sizeof(a) result(res) - implicit none + implicit none class(psb_lbase_sparse_mat), intent(in) :: a integer(psb_epk_) :: res res = 8 end function psb_lbase_sizeof - - ! + + ! !> Function get_fmt !! \memberof psb_lbase_sparse_mat !! \brief return a short descriptive name (e.g. COO CSR etc.) ! function psb_lbase_get_fmt() result(res) - implicit none + implicit none character(len=5) :: res res = 'NULL' end function psb_lbase_get_fmt - ! + ! !> Function has_update !! \memberof psb_lbase_sparse_mat - !! \brief Does the forma have the UPDATE functionality? + !! \brief Does the forma have the UPDATE functionality? ! function psb_lbase_has_update() result(res) - implicit none + implicit none logical :: res res = .true. end function psb_lbase_has_update - + ! - ! Standard getter functions: self-explaining. + ! Standard getter functions: self-explaining. ! function psb_lbase_get_dupl(a) result(res) - implicit none + implicit none class(psb_lbase_sparse_mat), intent(in) :: a integer(psb_ipk_) :: res res = a%duplicate end function psb_lbase_get_dupl - - + + function psb_lbase_get_state(a) result(res) - implicit none + implicit none class(psb_lbase_sparse_mat), intent(in) :: a integer(psb_ipk_) :: res res = a%state end function psb_lbase_get_state - + function psb_lbase_get_nrows(a) result(res) - implicit none + implicit none class(psb_lbase_sparse_mat), intent(in) :: a integer(psb_lpk_) :: res res = a%m end function psb_lbase_get_nrows function psb_lbase_get_ncols(a) result(res) - implicit none + implicit none class(psb_lbase_sparse_mat), intent(in) :: a integer(psb_lpk_) :: res res = a%n end function psb_lbase_get_ncols - subroutine psb_lbase_set_lnrows(m,a) - implicit none + subroutine psb_lbase_set_lnrows(m,a) + implicit none class(psb_lbase_sparse_mat), intent(inout) :: a integer(psb_lpk_), intent(in) :: m a%m = m end subroutine psb_lbase_set_lnrows - subroutine psb_lbase_set_lncols(n,a) - implicit none + subroutine psb_lbase_set_lncols(n,a) + implicit none class(psb_lbase_sparse_mat), intent(inout) :: a integer(psb_lpk_), intent(in) :: n a%n = n end subroutine psb_lbase_set_lncols -#if defined(IPK4) && defined(LPK8) - subroutine psb_lbase_set_inrows(m,a) - implicit none +#if defined(IPK4) && defined(LPK8) + subroutine psb_lbase_set_inrows(m,a) + implicit none class(psb_lbase_sparse_mat), intent(inout) :: a integer(psb_ipk_), intent(in) :: m ! This cannot overflow, since ipk_ <= lpk_ a%m = m end subroutine psb_lbase_set_inrows - subroutine psb_lbase_set_incols(n,a) - implicit none + subroutine psb_lbase_set_incols(n,a) + implicit none class(psb_lbase_sparse_mat), intent(inout) :: a integer(psb_ipk_), intent(in) :: n ! This cannot overflow, since ipk_ <= lpk_ a%n = n end subroutine psb_lbase_set_incols -#endif +#endif - subroutine psb_lbase_set_state(n,a) - implicit none + subroutine psb_lbase_set_state(n,a) + implicit none class(psb_lbase_sparse_mat), intent(inout) :: a integer(psb_lpk_), intent(in) :: n a%state = n end subroutine psb_lbase_set_state - subroutine psb_lbase_set_dupl(n,a) - implicit none + subroutine psb_lbase_set_dupl(n,a) + implicit none class(psb_lbase_sparse_mat), intent(inout) :: a integer(psb_ipk_), intent(in) :: n a%duplicate = n end subroutine psb_lbase_set_dupl - subroutine psb_lbase_set_null(a) - implicit none + subroutine psb_lbase_set_null(a) + implicit none class(psb_lbase_sparse_mat), intent(inout) :: a a%state = psb_spmat_null_ end subroutine psb_lbase_set_null - subroutine psb_lbase_set_bld(a) - implicit none + subroutine psb_lbase_set_bld(a) + implicit none class(psb_lbase_sparse_mat), intent(inout) :: a a%state = psb_spmat_bld_ end subroutine psb_lbase_set_bld - subroutine psb_lbase_set_upd(a) - implicit none + subroutine psb_lbase_set_upd(a) + implicit none class(psb_lbase_sparse_mat), intent(inout) :: a a%state = psb_spmat_upd_ end subroutine psb_lbase_set_upd - subroutine psb_lbase_set_asb(a) - implicit none + subroutine psb_lbase_set_asb(a) + implicit none class(psb_lbase_sparse_mat), intent(inout) :: a a%state = psb_spmat_asb_ end subroutine psb_lbase_set_asb - subroutine psb_lbase_set_sorted(a,val) - implicit none + subroutine psb_lbase_set_sorted(a,val) + implicit none class(psb_lbase_sparse_mat), intent(inout) :: a logical, intent(in), optional :: val - - if (present(val)) then + + if (present(val)) then a%sorted = val else a%sorted = .true. end if end subroutine psb_lbase_set_sorted - subroutine psb_lbase_set_triangle(a,val) - implicit none + subroutine psb_lbase_set_triangle(a,val) + implicit none class(psb_lbase_sparse_mat), intent(inout) :: a logical, intent(in), optional :: val - - if (present(val)) then + + if (present(val)) then a%triangle = val else a%triangle = .true. end if end subroutine psb_lbase_set_triangle - subroutine psb_lbase_set_symmetric(a,val) - implicit none + subroutine psb_lbase_set_symmetric(a,val) + implicit none class(psb_lbase_sparse_mat), intent(inout) :: a logical, intent(in), optional :: val - - if (present(val)) then + + if (present(val)) then a%symmetric = val else a%symmetric = .true. end if end subroutine psb_lbase_set_symmetric - subroutine psb_lbase_set_unit(a,val) - implicit none + subroutine psb_lbase_set_unit(a,val) + implicit none class(psb_lbase_sparse_mat), intent(inout) :: a logical, intent(in), optional :: val - - if (present(val)) then + + if (present(val)) then a%unitd = val else a%unitd = .true. end if end subroutine psb_lbase_set_unit - subroutine psb_lbase_set_lower(a,val) - implicit none + subroutine psb_lbase_set_lower(a,val) + implicit none class(psb_lbase_sparse_mat), intent(inout) :: a logical, intent(in), optional :: val - - if (present(val)) then + + if (present(val)) then a%upper = .not.val else a%upper = .false. end if end subroutine psb_lbase_set_lower - subroutine psb_lbase_set_upper(a,val) - implicit none + subroutine psb_lbase_set_upper(a,val) + implicit none class(psb_lbase_sparse_mat), intent(inout) :: a logical, intent(in), optional :: val - - if (present(val)) then + + if (present(val)) then a%upper = val else a%upper = .true. end if end subroutine psb_lbase_set_upper - subroutine psb_lbase_set_repeatable_updates(a,val) - implicit none + subroutine psb_lbase_set_repeatable_updates(a,val) + implicit none class(psb_lbase_sparse_mat), intent(inout) :: a logical, intent(in), optional :: val - - if (present(val)) then + + if (present(val)) then a%repeatable_updates = val else a%repeatable_updates = .true. @@ -1559,80 +1559,80 @@ contains ! ! has_xt_tri: does the current type support - ! extended triangle operations? - ! + ! extended triangle operations? + ! function psb_lbase_has_xt_tri() result(res) - implicit none + implicit none logical :: res - - res = .false. + + res = .false. end function psb_lbase_has_xt_tri function psb_lbase_is_triangle(a) result(res) - implicit none + implicit none class(psb_lbase_sparse_mat), intent(in) :: a logical :: res res = a%triangle end function psb_lbase_is_triangle function psb_lbase_is_symmetric(a) result(res) - implicit none + implicit none class(psb_lbase_sparse_mat), intent(in) :: a logical :: res res = a%symmetric end function psb_lbase_is_symmetric function psb_lbase_is_unit(a) result(res) - implicit none + implicit none class(psb_lbase_sparse_mat), intent(in) :: a logical :: res res = a%unitd end function psb_lbase_is_unit function psb_lbase_is_upper(a) result(res) - implicit none + implicit none class(psb_lbase_sparse_mat), intent(in) :: a logical :: res res = a%upper .and. a%triangle end function psb_lbase_is_upper function psb_lbase_is_lower(a) result(res) - implicit none + implicit none class(psb_lbase_sparse_mat), intent(in) :: a logical :: res res = (.not.a%upper) .and. a%triangle end function psb_lbase_is_lower function psb_lbase_is_null(a) result(res) - implicit none + implicit none class(psb_lbase_sparse_mat), intent(in) :: a logical :: res res = (a%state == psb_spmat_null_) end function psb_lbase_is_null function psb_lbase_is_bld(a) result(res) - implicit none + implicit none class(psb_lbase_sparse_mat), intent(in) :: a logical :: res res = (a%state == psb_spmat_bld_) end function psb_lbase_is_bld function psb_lbase_is_upd(a) result(res) - implicit none + implicit none class(psb_lbase_sparse_mat), intent(in) :: a logical :: res res = (a%state == psb_spmat_upd_) end function psb_lbase_is_upd function psb_lbase_is_asb(a) result(res) - implicit none + implicit none class(psb_lbase_sparse_mat), intent(in) :: a logical :: res res = (a%state == psb_spmat_asb_) end function psb_lbase_is_asb function psb_lbase_is_sorted(a) result(res) - implicit none + implicit none class(psb_lbase_sparse_mat), intent(in) :: a logical :: res res = a%sorted @@ -1640,38 +1640,38 @@ contains function psb_lbase_is_by_rows(a) result(res) - implicit none + implicit none class(psb_lbase_sparse_mat), intent(in) :: a logical :: res res = .false. end function psb_lbase_is_by_rows function psb_lbase_is_by_cols(a) result(res) - implicit none + implicit none class(psb_lbase_sparse_mat), intent(in) :: a logical :: res res = .false. end function psb_lbase_is_by_cols function psb_lbase_is_repeatable_updates(a) result(res) - implicit none + implicit none class(psb_lbase_sparse_mat), intent(in) :: a logical :: res res = a%repeatable_updates end function psb_lbase_is_repeatable_updates - + ! ! TRANSP: note sorted=.false. ! better invoke a fix() too many than ! regret it later... ! subroutine psb_lbase_transp_2mat(a,b) - implicit none - + implicit none + class(psb_lbase_sparse_mat), intent(in) :: a class(psb_lbase_sparse_mat), intent(out) :: b - + b%m = a%n b%n = a%m b%state = a%state @@ -1681,16 +1681,16 @@ contains b%upper = .not.a%upper b%sorted = .false. b%repeatable_updates = .false. - + end subroutine psb_lbase_transp_2mat subroutine psb_lbase_transc_2mat(a,b) - implicit none - + implicit none + class(psb_lbase_sparse_mat), intent(in) :: a class(psb_lbase_sparse_mat), intent(out) :: b - + b%m = a%n b%n = a%m b%state = a%state @@ -1704,8 +1704,8 @@ contains end subroutine psb_lbase_transc_2mat subroutine psb_lbase_transp_1mat(a) - implicit none - + implicit none + class(psb_lbase_sparse_mat), intent(inout) :: a integer(psb_lpk_) :: itmp @@ -1719,15 +1719,15 @@ contains a%upper = .not.a%upper a%sorted = .false. a%repeatable_updates = .false. - + end subroutine psb_lbase_transp_1mat subroutine psb_lbase_transc_1mat(a) - implicit none - + implicit none + class(psb_lbase_sparse_mat), intent(inout) :: a - - call a%transp() + + call a%transp() end subroutine psb_lbase_transc_1mat @@ -1736,89 +1736,89 @@ contains !> Function base_asb: !! \memberof psb_lbase_sparse_mat !! \brief Sync: base version calls sync and the set_asb. - !! + !! ! subroutine psb_lbase_mat_asb(a) - implicit none + implicit none class(psb_lbase_sparse_mat), intent(inout) :: a - + call a%sync() call a%set_asb() end subroutine psb_lbase_mat_asb ! ! The base version of SYNC & friends does nothing, it's just ! a placeholder. - ! + ! ! !> Function base_sync: !! \memberof psb_lbase_sparse_mat !! \brief Sync: base version is a no-op. - !! + !! ! subroutine psb_lbase_mat_sync(a) - implicit none + implicit none class(psb_lbase_sparse_mat), target, intent(in) :: a - + end subroutine psb_lbase_mat_sync ! !> Function base_set_host: !! \memberof psb_lbase_sparse_mat !! \brief Set_host: base version is a no-op. - !! + !! ! subroutine psb_lbase_mat_set_host(a) - implicit none + implicit none class(psb_lbase_sparse_mat), intent(inout) :: a - + end subroutine psb_lbase_mat_set_host ! !> Function base_set_dev: !! \memberof psb_lbase_sparse_mat !! \brief Set_dev: base version is a no-op. - !! + !! ! subroutine psb_lbase_mat_set_dev(a) - implicit none + implicit none class(psb_lbase_sparse_mat), intent(inout) :: a - + end subroutine psb_lbase_mat_set_dev ! !> Function base_set_sync: !! \memberof psb_lbase_sparse_mat !! \brief Set_sync: base version is a no-op. - !! + !! ! subroutine psb_lbase_mat_set_sync(a) - implicit none + implicit none class(psb_lbase_sparse_mat), intent(inout) :: a - + end subroutine psb_lbase_mat_set_sync ! !> Function base_is_dev: !! \memberof psb_lbase_sparse_mat !! \brief Is matrix on eaternal device . - !! + !! ! function psb_lbase_mat_is_dev(a) result(res) - implicit none + implicit none class(psb_lbase_sparse_mat), intent(in) :: a logical :: res - + res = .false. end function psb_lbase_mat_is_dev - + ! !> Function base_is_host !! \memberof psb_lbase_sparse_mat !! \brief Is matrix on standard memory . - !! + !! ! function psb_lbase_mat_is_host(a) result(res) - implicit none + implicit none class(psb_lbase_sparse_mat), intent(in) :: a logical :: res @@ -1829,10 +1829,10 @@ contains !> Function base_is_sync !! \memberof psb_lbase_sparse_mat !! \brief Is matrix on sync . - !! + !! ! function psb_lbase_mat_is_sync(a) result(res) - implicit none + implicit none class(psb_lbase_sparse_mat), intent(in) :: a logical :: res @@ -1844,33 +1844,32 @@ contains type(psb_lbase_sparse_mat), intent(inout) :: lb type(psb_base_sparse_mat), intent(in) :: ib - lb%m = ib%m - lb%n = ib%n - lb%state = ib%state - lb%duplicate = ib%duplicate - lb%triangle = ib%triangle - lb%unitd = ib%unitd - lb%upper = ib%upper - lb%sorted = ib%sorted - lb%repeatable_updates = ib%repeatable_updates - + lb%m = ib%m + lb%n = ib%n + lb%state = ib%state + lb%duplicate = ib%duplicate + lb%triangle = ib%triangle + lb%unitd = ib%unitd + lb%upper = ib%upper + lb%sorted = ib%sorted + lb%repeatable_updates = ib%repeatable_updates + end subroutine psb_lbase_from_base subroutine psb_base_from_lbase(ib,lb) type(psb_base_sparse_mat), intent(inout) :: ib type(psb_lbase_sparse_mat), intent(in) :: lb - - ib%m = lb%m - ib%n = lb%n - ib%state = lb%state - ib%duplicate = lb%duplicate - ib%triangle = lb%triangle - ib%unitd = lb%unitd - ib%upper = lb%upper - ib%sorted = lb%sorted - ib%repeatable_updates = lb%repeatable_updates - + + ib%m = lb%m + ib%n = lb%n + ib%state = lb%state + ib%duplicate = lb%duplicate + ib%triangle = lb%triangle + ib%unitd = lb%unitd + ib%upper = lb%upper + ib%sorted = lb%sorted + ib%repeatable_updates = lb%repeatable_updates + end subroutine psb_base_from_lbase end module psb_base_mat_mod - diff --git a/base/modules/serial/psb_c_base_mat_mod.F90 b/base/modules/serial/psb_c_base_mat_mod.F90 index a52f7a7ce..6924d8198 100644 --- a/base/modules/serial/psb_c_base_mat_mod.F90 +++ b/base/modules/serial/psb_c_base_mat_mod.F90 @@ -167,6 +167,7 @@ module psb_c_base_mat_mod procedure, pass(a) :: sizeof => c_coo_sizeof procedure, pass(a) :: reallocate_nz => psb_c_coo_reallocate_nz procedure, pass(a) :: allocate_mnnz => psb_c_coo_allocate_mnnz + procedure, pass(a) :: ensure_size => psb_c_coo_ensure_size procedure, pass(a) :: cp_to_coo => psb_c_cp_coo_to_coo procedure, pass(a) :: cp_from_coo => psb_c_cp_coo_from_coo procedure, pass(a) :: cp_to_fmt => psb_c_cp_coo_to_fmt @@ -191,6 +192,7 @@ module psb_c_base_mat_mod procedure, pass(a) :: fix => psb_c_fix_coo procedure, pass(a) :: trim => psb_c_coo_trim procedure, pass(a) :: clean_zeros => psb_c_coo_clean_zeros + procedure, pass(a) :: clean_negidx => psb_c_coo_clean_negidx procedure, pass(a) :: print => psb_c_coo_print procedure, pass(a) :: free => c_coo_free procedure, pass(a) :: mold => psb_c_coo_mold @@ -360,6 +362,7 @@ module psb_c_base_mat_mod procedure, pass(a) :: sizeof => lc_coo_sizeof procedure, pass(a) :: reallocate_nz => psb_lc_coo_reallocate_nz procedure, pass(a) :: allocate_mnnz => psb_lc_coo_allocate_mnnz + procedure, pass(a) :: ensure_size => psb_lc_coo_ensure_size procedure, pass(a) :: cp_to_coo => psb_lc_cp_coo_to_coo procedure, pass(a) :: cp_from_coo => psb_lc_cp_coo_from_coo procedure, pass(a) :: cp_to_fmt => psb_lc_cp_coo_to_fmt @@ -380,6 +383,7 @@ module psb_c_base_mat_mod procedure, pass(a) :: fix => psb_lc_fix_coo procedure, pass(a) :: trim => psb_lc_coo_trim procedure, pass(a) :: clean_zeros => psb_lc_coo_clean_zeros + procedure, pass(a) :: clean_negidx => psb_lc_coo_clean_negidx procedure, pass(a) :: print => psb_lc_coo_print procedure, pass(a) :: free => lc_coo_free procedure, pass(a) :: mold => psb_lc_coo_mold @@ -1678,6 +1682,17 @@ module psb_c_base_mat_mod class(psb_c_coo_sparse_mat), intent(inout) :: a end subroutine psb_c_coo_reallocate_nz end interface + ! + !> + !! \memberof psb_c_coo_sparse_mat + ! + interface + subroutine psb_c_coo_ensure_size(nz,a) + import + integer(psb_ipk_), intent(in) :: nz + class(psb_c_coo_sparse_mat), intent(inout) :: a + end subroutine psb_c_coo_ensure_size + end interface ! !> @@ -1715,6 +1730,46 @@ module psb_c_base_mat_mod end subroutine psb_c_coo_clean_zeros end interface + ! + !> + !! \memberof psb_c_coo_sparse_mat + !! \brief Take out any entries with negative row or column index + !! May happen when converting local/global numbering + !! \param info return code + !! + ! + interface + subroutine psb_c_coo_clean_negidx(a,info) + import + class(psb_c_coo_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_coo_clean_negidx + end interface + + ! + !> Funtion: coo_clean_negidx_inner + !! \brief Take out any entries with negative row or column index + !! Used internally by coo_clean_negidx + !! \param nzin Number of entries on input to be handled + !! \param ia(:) Row indices + !! \param ja(:) Col indices + !! \param val(:) Coefficients + !! \param nzout Number of entries after sorting/duplicate handling + !! \param info return code + !! + ! + interface psb_coo_clean_negidx_inner + subroutine psb_c_coo_clean_negidx_inner(nzin,ia,ja,val,nzout,info) + import + integer(psb_ipk_), intent(in) :: nzin + integer(psb_ipk_), intent(inout) :: ia(:), ja(:) + complex(psb_spk_), intent(inout) :: val(:) + integer(psb_ipk_), intent(out) :: nzout + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_coo_clean_negidx_inner + end interface psb_coo_clean_negidx_inner + + ! !> !! \memberof psb_c_coo_sparse_mat @@ -1759,9 +1814,9 @@ module psb_c_base_mat_mod import integer(psb_ipk_), intent(in) :: iout class(psb_c_coo_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) end subroutine psb_c_coo_print end interface @@ -3279,6 +3334,17 @@ module psb_c_base_mat_mod class(psb_lc_coo_sparse_mat), intent(inout) :: a end subroutine psb_lc_coo_reallocate_nz end interface + ! + !> + !! \memberof psb_lc_coo_sparse_mat + ! + interface + subroutine psb_lc_coo_ensure_size(nz,a) + import + integer(psb_lpk_), intent(in) :: nz + class(psb_lc_coo_sparse_mat), intent(inout) :: a + end subroutine psb_lc_coo_ensure_size + end interface ! !> @@ -3316,6 +3382,46 @@ module psb_c_base_mat_mod end subroutine psb_lc_coo_clean_zeros end interface + ! + !> + !! \memberof psb_lc_coo_sparse_mat + !! \brief Take out any entries with negative row or column index + !! May happen when converting local/global numbering + !! \param info return code + !! + ! + interface + subroutine psb_lc_coo_clean_negidx(a,info) + import + class(psb_lc_coo_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_lc_coo_clean_negidx + end interface + +#if defined(IPK4) && defined(LPK8) + ! + !> Funtion: coo_clean_negidx_inner + !! \brief Take out any entries with negative row or column index + !! Used internally by coo_clean_negidx + !! \param nzin Number of entries on input to be handled + !! \param ia(:) Row indices + !! \param ja(:) Col indices + !! \param val(:) Coefficients + !! \param nzout Number of entries after sorting/duplicate handling + !! \param info return code + !! + ! + interface psb_coo_clean_negidx_inner + subroutine psb_lc_coo_clean_negidx_inner(nzin,ia,ja,val,nzout,info) + import + integer(psb_lpk_), intent(in) :: nzin + integer(psb_lpk_), intent(inout) :: ia(:), ja(:) + complex(psb_spk_), intent(inout) :: val(:) + integer(psb_lpk_), intent(out) :: nzout + integer(psb_ipk_), intent(out) :: info + end subroutine psb_lc_coo_clean_negidx_inner + end interface psb_coo_clean_negidx_inner +#endif ! !> !! \memberof psb_lc_coo_sparse_mat @@ -3674,6 +3780,8 @@ module psb_c_base_mat_mod end subroutine psb_lc_coo_scals end interface + public :: psb_c_get_print_frmt, psb_lc_get_print_frmt + !> !! \memberof psb_lc_coo_sparse_mat !! \see psb_lc_base_mat_mod::psb_lc_base_scalplusidentity @@ -3729,6 +3837,56 @@ module psb_c_base_mat_mod contains + function psb_c_get_print_frmt(nr,nc,nz,iv,ivr,ivc) result(frmt) + + implicit none + character(len=80) :: frmt + integer(psb_ipk_), intent(in) :: nr, nc, nz + integer(psb_lpk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) + ! + character(len=*), parameter :: datatype='complex' + integer(psb_lpk_) :: nmx + integer(psb_ipk_) :: ni + nmx = max(nr,nc,ione) + if (present(iv)) nmx = max(nmx,maxval(abs(iv(1:nc)))) + if (present(ivr)) nmx = max(nmx,maxval(abs(ivr(1:nr)))) + if (present(ivc)) nmx = max(nmx,maxval(abs(ivc(1:nc)))) + ni = floor(log10(1.0*nmx)) + 2 + + if (datatype=='complex') then + write(frmt,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' + else + write(frmt,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' + end if + + end function psb_c_get_print_frmt + + function psb_lc_get_print_frmt(nr,nc,nz,iv,ivr,ivc) result(frmt) + + implicit none + character(len=80) :: frmt + integer(psb_lpk_), intent(in) :: nr, nc, nz + integer(psb_lpk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) + ! + character(len=*), parameter :: datatype='complex' + integer(psb_lpk_) :: nmx + integer(psb_lpk_) :: ni + nmx = max(nr,nc,lone) + if (present(iv)) nmx = max(nmx,maxval(abs(iv(1:nc)))) + if (present(ivr)) nmx = max(nmx,maxval(abs(ivr(1:nr)))) + if (present(ivc)) nmx = max(nmx,maxval(abs(ivc(1:nc)))) + ni = floor(log10(1.0*nmx)) + 2 + + if (datatype=='complex') then + write(frmt,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' + else + write(frmt,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' + end if + + end function psb_lc_get_print_frmt + ! == ================================== ! diff --git a/base/modules/serial/psb_c_csc_mat_mod.f90 b/base/modules/serial/psb_c_csc_mat_mod.f90 index ad59f0f19..bb06977b8 100644 --- a/base/modules/serial/psb_c_csc_mat_mod.f90 +++ b/base/modules/serial/psb_c_csc_mat_mod.f90 @@ -219,9 +219,9 @@ module psb_c_csc_mat_mod import integer(psb_ipk_), intent(in) :: iout class(psb_c_csc_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) end subroutine psb_c_csc_print end interface diff --git a/base/modules/serial/psb_c_csr_mat_mod.f90 b/base/modules/serial/psb_c_csr_mat_mod.f90 index e9004b3c0..8b076cc22 100644 --- a/base/modules/serial/psb_c_csr_mat_mod.f90 +++ b/base/modules/serial/psb_c_csr_mat_mod.f90 @@ -169,9 +169,9 @@ module psb_c_csr_mat_mod import integer(psb_ipk_), intent(in) :: iout class(psb_c_csr_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) end subroutine psb_c_csr_print end interface ! diff --git a/base/modules/serial/psb_c_mat_mod.F90 b/base/modules/serial/psb_c_mat_mod.F90 index 82d565ec8..a7c7e3583 100644 --- a/base/modules/serial/psb_c_mat_mod.F90 +++ b/base/modules/serial/psb_c_mat_mod.F90 @@ -145,8 +145,9 @@ module psb_c_mat_mod procedure, pass(a) :: tril => psb_c_tril procedure, pass(a) :: triu => psb_c_triu procedure, pass(a) :: m_csclip => psb_c_csclip + procedure, pass(a) :: m_csclip_ip => psb_c_csclip_ip procedure, pass(a) :: b_csclip => psb_c_b_csclip - generic, public :: csclip => b_csclip, m_csclip + generic, public :: csclip => b_csclip, m_csclip, m_csclip_ip procedure, pass(a) :: clean_zeros => psb_c_clean_zeros procedure, pass(a) :: reall => psb_c_reallocate_nz procedure, pass(a) :: get_neigh => psb_c_get_neigh @@ -342,8 +343,9 @@ module psb_c_mat_mod procedure, pass(a) :: tril => psb_lc_tril procedure, pass(a) :: triu => psb_lc_triu procedure, pass(a) :: m_csclip => psb_lc_csclip + procedure, pass(a) :: m_csclip_ip => psb_lc_csclip_ip procedure, pass(a) :: b_csclip => psb_lc_b_csclip - generic, public :: csclip => b_csclip, m_csclip + generic, public :: csclip => b_csclip, m_csclip, m_csclip_ip procedure, pass(a) :: clean_zeros => psb_lc_clean_zeros procedure, pass(a) :: reall => psb_lc_reallocate_nz procedure, pass(a) :: get_neigh => psb_lc_get_neigh @@ -573,9 +575,9 @@ module psb_c_mat_mod import :: psb_ipk_, psb_lpk_, psb_cspmat_type integer(psb_ipk_), intent(in) :: iout class(psb_cspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) end subroutine psb_c_sparse_print end interface @@ -584,9 +586,9 @@ module psb_c_mat_mod import :: psb_ipk_, psb_lpk_, psb_cspmat_type character(len=*), intent(in) :: fname class(psb_cspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) end subroutine psb_c_n_sparse_print end interface @@ -745,6 +747,17 @@ module psb_c_mat_mod end subroutine psb_c_csclip end interface + interface + subroutine psb_c_csclip_ip(a,info,& + & imin,imax,jmin,jmax,rscale,cscale) + import :: psb_ipk_, psb_lpk_, psb_cspmat_type, psb_spk_ + class(psb_cspmat_type), intent(inout) :: a + integer(psb_ipk_),intent(out) :: info + integer(psb_ipk_), intent(in), optional :: imin,imax,jmin,jmax + logical, intent(in), optional :: rscale,cscale + end subroutine psb_c_csclip_ip + end interface + interface subroutine psb_c_b_csclip(a,b,info,& & imin,imax,jmin,jmax,rscale,cscale) @@ -1514,6 +1527,17 @@ module psb_c_mat_mod end subroutine psb_lc_csclip end interface + interface + subroutine psb_lc_csclip_ip(a,info,& + & imin,imax,jmin,jmax,rscale,cscale) + import :: psb_ipk_, psb_lpk_, psb_lcspmat_type, psb_spk_ + class(psb_lcspmat_type), intent(inout) :: a + integer(psb_ipk_),intent(out) :: info + integer(psb_lpk_), intent(in), optional :: imin,imax,jmin,jmax + logical, intent(in), optional :: rscale,cscale + end subroutine psb_lc_csclip_ip + end interface + interface subroutine psb_lc_b_csclip(a,b,info,& & imin,imax,jmin,jmax,rscale,cscale) diff --git a/base/modules/serial/psb_c_serial_mod.f90 b/base/modules/serial/psb_c_serial_mod.f90 index b3e3abd09..9c43f3e76 100644 --- a/base/modules/serial/psb_c_serial_mod.f90 +++ b/base/modules/serial/psb_c_serial_mod.f90 @@ -292,9 +292,9 @@ contains use psb_c_mat_mod, only : psb_cspmat_type integer(psb_ipk_), intent(in) :: iout type(psb_cspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:),ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:),ivc(:) call a%print(iout,iv,head,ivr,ivc) @@ -304,9 +304,9 @@ contains use psb_c_mat_mod, only : psb_cspmat_type character(len=*), intent(in) :: fname type(psb_cspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:),ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:),ivc(:) call a%print(fname,iv,head,ivr,ivc) diff --git a/base/modules/serial/psb_d_base_mat_mod.F90 b/base/modules/serial/psb_d_base_mat_mod.F90 index a4b78e82f..a6ff7c5ec 100644 --- a/base/modules/serial/psb_d_base_mat_mod.F90 +++ b/base/modules/serial/psb_d_base_mat_mod.F90 @@ -167,6 +167,7 @@ module psb_d_base_mat_mod procedure, pass(a) :: sizeof => d_coo_sizeof procedure, pass(a) :: reallocate_nz => psb_d_coo_reallocate_nz procedure, pass(a) :: allocate_mnnz => psb_d_coo_allocate_mnnz + procedure, pass(a) :: ensure_size => psb_d_coo_ensure_size procedure, pass(a) :: cp_to_coo => psb_d_cp_coo_to_coo procedure, pass(a) :: cp_from_coo => psb_d_cp_coo_from_coo procedure, pass(a) :: cp_to_fmt => psb_d_cp_coo_to_fmt @@ -191,6 +192,7 @@ module psb_d_base_mat_mod procedure, pass(a) :: fix => psb_d_fix_coo procedure, pass(a) :: trim => psb_d_coo_trim procedure, pass(a) :: clean_zeros => psb_d_coo_clean_zeros + procedure, pass(a) :: clean_negidx => psb_d_coo_clean_negidx procedure, pass(a) :: print => psb_d_coo_print procedure, pass(a) :: free => d_coo_free procedure, pass(a) :: mold => psb_d_coo_mold @@ -360,6 +362,7 @@ module psb_d_base_mat_mod procedure, pass(a) :: sizeof => ld_coo_sizeof procedure, pass(a) :: reallocate_nz => psb_ld_coo_reallocate_nz procedure, pass(a) :: allocate_mnnz => psb_ld_coo_allocate_mnnz + procedure, pass(a) :: ensure_size => psb_ld_coo_ensure_size procedure, pass(a) :: cp_to_coo => psb_ld_cp_coo_to_coo procedure, pass(a) :: cp_from_coo => psb_ld_cp_coo_from_coo procedure, pass(a) :: cp_to_fmt => psb_ld_cp_coo_to_fmt @@ -380,6 +383,7 @@ module psb_d_base_mat_mod procedure, pass(a) :: fix => psb_ld_fix_coo procedure, pass(a) :: trim => psb_ld_coo_trim procedure, pass(a) :: clean_zeros => psb_ld_coo_clean_zeros + procedure, pass(a) :: clean_negidx => psb_ld_coo_clean_negidx procedure, pass(a) :: print => psb_ld_coo_print procedure, pass(a) :: free => ld_coo_free procedure, pass(a) :: mold => psb_ld_coo_mold @@ -1678,6 +1682,17 @@ module psb_d_base_mat_mod class(psb_d_coo_sparse_mat), intent(inout) :: a end subroutine psb_d_coo_reallocate_nz end interface + ! + !> + !! \memberof psb_d_coo_sparse_mat + ! + interface + subroutine psb_d_coo_ensure_size(nz,a) + import + integer(psb_ipk_), intent(in) :: nz + class(psb_d_coo_sparse_mat), intent(inout) :: a + end subroutine psb_d_coo_ensure_size + end interface ! !> @@ -1715,6 +1730,46 @@ module psb_d_base_mat_mod end subroutine psb_d_coo_clean_zeros end interface + ! + !> + !! \memberof psb_d_coo_sparse_mat + !! \brief Take out any entries with negative row or column index + !! May happen when converting local/global numbering + !! \param info return code + !! + ! + interface + subroutine psb_d_coo_clean_negidx(a,info) + import + class(psb_d_coo_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_coo_clean_negidx + end interface + + ! + !> Funtion: coo_clean_negidx_inner + !! \brief Take out any entries with negative row or column index + !! Used internally by coo_clean_negidx + !! \param nzin Number of entries on input to be handled + !! \param ia(:) Row indices + !! \param ja(:) Col indices + !! \param val(:) Coefficients + !! \param nzout Number of entries after sorting/duplicate handling + !! \param info return code + !! + ! + interface psb_coo_clean_negidx_inner + subroutine psb_d_coo_clean_negidx_inner(nzin,ia,ja,val,nzout,info) + import + integer(psb_ipk_), intent(in) :: nzin + integer(psb_ipk_), intent(inout) :: ia(:), ja(:) + real(psb_dpk_), intent(inout) :: val(:) + integer(psb_ipk_), intent(out) :: nzout + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_coo_clean_negidx_inner + end interface psb_coo_clean_negidx_inner + + ! !> !! \memberof psb_d_coo_sparse_mat @@ -1759,9 +1814,9 @@ module psb_d_base_mat_mod import integer(psb_ipk_), intent(in) :: iout class(psb_d_coo_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) end subroutine psb_d_coo_print end interface @@ -3279,6 +3334,17 @@ module psb_d_base_mat_mod class(psb_ld_coo_sparse_mat), intent(inout) :: a end subroutine psb_ld_coo_reallocate_nz end interface + ! + !> + !! \memberof psb_ld_coo_sparse_mat + ! + interface + subroutine psb_ld_coo_ensure_size(nz,a) + import + integer(psb_lpk_), intent(in) :: nz + class(psb_ld_coo_sparse_mat), intent(inout) :: a + end subroutine psb_ld_coo_ensure_size + end interface ! !> @@ -3316,6 +3382,46 @@ module psb_d_base_mat_mod end subroutine psb_ld_coo_clean_zeros end interface + ! + !> + !! \memberof psb_ld_coo_sparse_mat + !! \brief Take out any entries with negative row or column index + !! May happen when converting local/global numbering + !! \param info return code + !! + ! + interface + subroutine psb_ld_coo_clean_negidx(a,info) + import + class(psb_ld_coo_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_ld_coo_clean_negidx + end interface + +#if defined(IPK4) && defined(LPK8) + ! + !> Funtion: coo_clean_negidx_inner + !! \brief Take out any entries with negative row or column index + !! Used internally by coo_clean_negidx + !! \param nzin Number of entries on input to be handled + !! \param ia(:) Row indices + !! \param ja(:) Col indices + !! \param val(:) Coefficients + !! \param nzout Number of entries after sorting/duplicate handling + !! \param info return code + !! + ! + interface psb_coo_clean_negidx_inner + subroutine psb_ld_coo_clean_negidx_inner(nzin,ia,ja,val,nzout,info) + import + integer(psb_lpk_), intent(in) :: nzin + integer(psb_lpk_), intent(inout) :: ia(:), ja(:) + real(psb_dpk_), intent(inout) :: val(:) + integer(psb_lpk_), intent(out) :: nzout + integer(psb_ipk_), intent(out) :: info + end subroutine psb_ld_coo_clean_negidx_inner + end interface psb_coo_clean_negidx_inner +#endif ! !> !! \memberof psb_ld_coo_sparse_mat @@ -3674,6 +3780,8 @@ module psb_d_base_mat_mod end subroutine psb_ld_coo_scals end interface + public :: psb_d_get_print_frmt, psb_ld_get_print_frmt + !> !! \memberof psb_ld_coo_sparse_mat !! \see psb_ld_base_mat_mod::psb_ld_base_scalplusidentity @@ -3729,6 +3837,56 @@ module psb_d_base_mat_mod contains + function psb_d_get_print_frmt(nr,nc,nz,iv,ivr,ivc) result(frmt) + + implicit none + character(len=80) :: frmt + integer(psb_ipk_), intent(in) :: nr, nc, nz + integer(psb_lpk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) + ! + character(len=*), parameter :: datatype='real' + integer(psb_lpk_) :: nmx + integer(psb_ipk_) :: ni + nmx = max(nr,nc,ione) + if (present(iv)) nmx = max(nmx,maxval(abs(iv(1:nc)))) + if (present(ivr)) nmx = max(nmx,maxval(abs(ivr(1:nr)))) + if (present(ivc)) nmx = max(nmx,maxval(abs(ivc(1:nc)))) + ni = floor(log10(1.0*nmx)) + 2 + + if (datatype=='complex') then + write(frmt,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' + else + write(frmt,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' + end if + + end function psb_d_get_print_frmt + + function psb_ld_get_print_frmt(nr,nc,nz,iv,ivr,ivc) result(frmt) + + implicit none + character(len=80) :: frmt + integer(psb_lpk_), intent(in) :: nr, nc, nz + integer(psb_lpk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) + ! + character(len=*), parameter :: datatype='real' + integer(psb_lpk_) :: nmx + integer(psb_lpk_) :: ni + nmx = max(nr,nc,lone) + if (present(iv)) nmx = max(nmx,maxval(abs(iv(1:nc)))) + if (present(ivr)) nmx = max(nmx,maxval(abs(ivr(1:nr)))) + if (present(ivc)) nmx = max(nmx,maxval(abs(ivc(1:nc)))) + ni = floor(log10(1.0*nmx)) + 2 + + if (datatype=='complex') then + write(frmt,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' + else + write(frmt,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' + end if + + end function psb_ld_get_print_frmt + ! == ================================== ! diff --git a/base/modules/serial/psb_d_csc_mat_mod.f90 b/base/modules/serial/psb_d_csc_mat_mod.f90 index 42cefb723..60d91bf29 100644 --- a/base/modules/serial/psb_d_csc_mat_mod.f90 +++ b/base/modules/serial/psb_d_csc_mat_mod.f90 @@ -219,9 +219,9 @@ module psb_d_csc_mat_mod import integer(psb_ipk_), intent(in) :: iout class(psb_d_csc_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) end subroutine psb_d_csc_print end interface diff --git a/base/modules/serial/psb_d_csr_mat_mod.f90 b/base/modules/serial/psb_d_csr_mat_mod.f90 index e6f926e83..d0aa622bb 100644 --- a/base/modules/serial/psb_d_csr_mat_mod.f90 +++ b/base/modules/serial/psb_d_csr_mat_mod.f90 @@ -169,9 +169,9 @@ module psb_d_csr_mat_mod import integer(psb_ipk_), intent(in) :: iout class(psb_d_csr_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) end subroutine psb_d_csr_print end interface ! diff --git a/base/modules/serial/psb_d_mat_mod.F90 b/base/modules/serial/psb_d_mat_mod.F90 index 263192399..354c4199e 100644 --- a/base/modules/serial/psb_d_mat_mod.F90 +++ b/base/modules/serial/psb_d_mat_mod.F90 @@ -145,8 +145,9 @@ module psb_d_mat_mod procedure, pass(a) :: tril => psb_d_tril procedure, pass(a) :: triu => psb_d_triu procedure, pass(a) :: m_csclip => psb_d_csclip + procedure, pass(a) :: m_csclip_ip => psb_d_csclip_ip procedure, pass(a) :: b_csclip => psb_d_b_csclip - generic, public :: csclip => b_csclip, m_csclip + generic, public :: csclip => b_csclip, m_csclip, m_csclip_ip procedure, pass(a) :: clean_zeros => psb_d_clean_zeros procedure, pass(a) :: reall => psb_d_reallocate_nz procedure, pass(a) :: get_neigh => psb_d_get_neigh @@ -342,8 +343,9 @@ module psb_d_mat_mod procedure, pass(a) :: tril => psb_ld_tril procedure, pass(a) :: triu => psb_ld_triu procedure, pass(a) :: m_csclip => psb_ld_csclip + procedure, pass(a) :: m_csclip_ip => psb_ld_csclip_ip procedure, pass(a) :: b_csclip => psb_ld_b_csclip - generic, public :: csclip => b_csclip, m_csclip + generic, public :: csclip => b_csclip, m_csclip, m_csclip_ip procedure, pass(a) :: clean_zeros => psb_ld_clean_zeros procedure, pass(a) :: reall => psb_ld_reallocate_nz procedure, pass(a) :: get_neigh => psb_ld_get_neigh @@ -573,9 +575,9 @@ module psb_d_mat_mod import :: psb_ipk_, psb_lpk_, psb_dspmat_type integer(psb_ipk_), intent(in) :: iout class(psb_dspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) end subroutine psb_d_sparse_print end interface @@ -584,9 +586,9 @@ module psb_d_mat_mod import :: psb_ipk_, psb_lpk_, psb_dspmat_type character(len=*), intent(in) :: fname class(psb_dspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) end subroutine psb_d_n_sparse_print end interface @@ -745,6 +747,17 @@ module psb_d_mat_mod end subroutine psb_d_csclip end interface + interface + subroutine psb_d_csclip_ip(a,info,& + & imin,imax,jmin,jmax,rscale,cscale) + import :: psb_ipk_, psb_lpk_, psb_dspmat_type, psb_dpk_ + class(psb_dspmat_type), intent(inout) :: a + integer(psb_ipk_),intent(out) :: info + integer(psb_ipk_), intent(in), optional :: imin,imax,jmin,jmax + logical, intent(in), optional :: rscale,cscale + end subroutine psb_d_csclip_ip + end interface + interface subroutine psb_d_b_csclip(a,b,info,& & imin,imax,jmin,jmax,rscale,cscale) @@ -1514,6 +1527,17 @@ module psb_d_mat_mod end subroutine psb_ld_csclip end interface + interface + subroutine psb_ld_csclip_ip(a,info,& + & imin,imax,jmin,jmax,rscale,cscale) + import :: psb_ipk_, psb_lpk_, psb_ldspmat_type, psb_dpk_ + class(psb_ldspmat_type), intent(inout) :: a + integer(psb_ipk_),intent(out) :: info + integer(psb_lpk_), intent(in), optional :: imin,imax,jmin,jmax + logical, intent(in), optional :: rscale,cscale + end subroutine psb_ld_csclip_ip + end interface + interface subroutine psb_ld_b_csclip(a,b,info,& & imin,imax,jmin,jmax,rscale,cscale) diff --git a/base/modules/serial/psb_d_serial_mod.f90 b/base/modules/serial/psb_d_serial_mod.f90 index e43be2acd..523282f5c 100644 --- a/base/modules/serial/psb_d_serial_mod.f90 +++ b/base/modules/serial/psb_d_serial_mod.f90 @@ -292,9 +292,9 @@ contains use psb_d_mat_mod, only : psb_dspmat_type integer(psb_ipk_), intent(in) :: iout type(psb_dspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:),ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:),ivc(:) call a%print(iout,iv,head,ivr,ivc) @@ -304,9 +304,9 @@ contains use psb_d_mat_mod, only : psb_dspmat_type character(len=*), intent(in) :: fname type(psb_dspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:),ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:),ivc(:) call a%print(fname,iv,head,ivr,ivc) diff --git a/base/modules/serial/psb_s_base_mat_mod.F90 b/base/modules/serial/psb_s_base_mat_mod.F90 index 9069d48e0..95bab09ee 100644 --- a/base/modules/serial/psb_s_base_mat_mod.F90 +++ b/base/modules/serial/psb_s_base_mat_mod.F90 @@ -167,6 +167,7 @@ module psb_s_base_mat_mod procedure, pass(a) :: sizeof => s_coo_sizeof procedure, pass(a) :: reallocate_nz => psb_s_coo_reallocate_nz procedure, pass(a) :: allocate_mnnz => psb_s_coo_allocate_mnnz + procedure, pass(a) :: ensure_size => psb_s_coo_ensure_size procedure, pass(a) :: cp_to_coo => psb_s_cp_coo_to_coo procedure, pass(a) :: cp_from_coo => psb_s_cp_coo_from_coo procedure, pass(a) :: cp_to_fmt => psb_s_cp_coo_to_fmt @@ -191,6 +192,7 @@ module psb_s_base_mat_mod procedure, pass(a) :: fix => psb_s_fix_coo procedure, pass(a) :: trim => psb_s_coo_trim procedure, pass(a) :: clean_zeros => psb_s_coo_clean_zeros + procedure, pass(a) :: clean_negidx => psb_s_coo_clean_negidx procedure, pass(a) :: print => psb_s_coo_print procedure, pass(a) :: free => s_coo_free procedure, pass(a) :: mold => psb_s_coo_mold @@ -360,6 +362,7 @@ module psb_s_base_mat_mod procedure, pass(a) :: sizeof => ls_coo_sizeof procedure, pass(a) :: reallocate_nz => psb_ls_coo_reallocate_nz procedure, pass(a) :: allocate_mnnz => psb_ls_coo_allocate_mnnz + procedure, pass(a) :: ensure_size => psb_ls_coo_ensure_size procedure, pass(a) :: cp_to_coo => psb_ls_cp_coo_to_coo procedure, pass(a) :: cp_from_coo => psb_ls_cp_coo_from_coo procedure, pass(a) :: cp_to_fmt => psb_ls_cp_coo_to_fmt @@ -380,6 +383,7 @@ module psb_s_base_mat_mod procedure, pass(a) :: fix => psb_ls_fix_coo procedure, pass(a) :: trim => psb_ls_coo_trim procedure, pass(a) :: clean_zeros => psb_ls_coo_clean_zeros + procedure, pass(a) :: clean_negidx => psb_ls_coo_clean_negidx procedure, pass(a) :: print => psb_ls_coo_print procedure, pass(a) :: free => ls_coo_free procedure, pass(a) :: mold => psb_ls_coo_mold @@ -1678,6 +1682,17 @@ module psb_s_base_mat_mod class(psb_s_coo_sparse_mat), intent(inout) :: a end subroutine psb_s_coo_reallocate_nz end interface + ! + !> + !! \memberof psb_s_coo_sparse_mat + ! + interface + subroutine psb_s_coo_ensure_size(nz,a) + import + integer(psb_ipk_), intent(in) :: nz + class(psb_s_coo_sparse_mat), intent(inout) :: a + end subroutine psb_s_coo_ensure_size + end interface ! !> @@ -1715,6 +1730,46 @@ module psb_s_base_mat_mod end subroutine psb_s_coo_clean_zeros end interface + ! + !> + !! \memberof psb_s_coo_sparse_mat + !! \brief Take out any entries with negative row or column index + !! May happen when converting local/global numbering + !! \param info return code + !! + ! + interface + subroutine psb_s_coo_clean_negidx(a,info) + import + class(psb_s_coo_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_coo_clean_negidx + end interface + + ! + !> Funtion: coo_clean_negidx_inner + !! \brief Take out any entries with negative row or column index + !! Used internally by coo_clean_negidx + !! \param nzin Number of entries on input to be handled + !! \param ia(:) Row indices + !! \param ja(:) Col indices + !! \param val(:) Coefficients + !! \param nzout Number of entries after sorting/duplicate handling + !! \param info return code + !! + ! + interface psb_coo_clean_negidx_inner + subroutine psb_s_coo_clean_negidx_inner(nzin,ia,ja,val,nzout,info) + import + integer(psb_ipk_), intent(in) :: nzin + integer(psb_ipk_), intent(inout) :: ia(:), ja(:) + real(psb_spk_), intent(inout) :: val(:) + integer(psb_ipk_), intent(out) :: nzout + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_coo_clean_negidx_inner + end interface psb_coo_clean_negidx_inner + + ! !> !! \memberof psb_s_coo_sparse_mat @@ -1759,9 +1814,9 @@ module psb_s_base_mat_mod import integer(psb_ipk_), intent(in) :: iout class(psb_s_coo_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) end subroutine psb_s_coo_print end interface @@ -3279,6 +3334,17 @@ module psb_s_base_mat_mod class(psb_ls_coo_sparse_mat), intent(inout) :: a end subroutine psb_ls_coo_reallocate_nz end interface + ! + !> + !! \memberof psb_ls_coo_sparse_mat + ! + interface + subroutine psb_ls_coo_ensure_size(nz,a) + import + integer(psb_lpk_), intent(in) :: nz + class(psb_ls_coo_sparse_mat), intent(inout) :: a + end subroutine psb_ls_coo_ensure_size + end interface ! !> @@ -3316,6 +3382,46 @@ module psb_s_base_mat_mod end subroutine psb_ls_coo_clean_zeros end interface + ! + !> + !! \memberof psb_ls_coo_sparse_mat + !! \brief Take out any entries with negative row or column index + !! May happen when converting local/global numbering + !! \param info return code + !! + ! + interface + subroutine psb_ls_coo_clean_negidx(a,info) + import + class(psb_ls_coo_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_ls_coo_clean_negidx + end interface + +#if defined(IPK4) && defined(LPK8) + ! + !> Funtion: coo_clean_negidx_inner + !! \brief Take out any entries with negative row or column index + !! Used internally by coo_clean_negidx + !! \param nzin Number of entries on input to be handled + !! \param ia(:) Row indices + !! \param ja(:) Col indices + !! \param val(:) Coefficients + !! \param nzout Number of entries after sorting/duplicate handling + !! \param info return code + !! + ! + interface psb_coo_clean_negidx_inner + subroutine psb_ls_coo_clean_negidx_inner(nzin,ia,ja,val,nzout,info) + import + integer(psb_lpk_), intent(in) :: nzin + integer(psb_lpk_), intent(inout) :: ia(:), ja(:) + real(psb_spk_), intent(inout) :: val(:) + integer(psb_lpk_), intent(out) :: nzout + integer(psb_ipk_), intent(out) :: info + end subroutine psb_ls_coo_clean_negidx_inner + end interface psb_coo_clean_negidx_inner +#endif ! !> !! \memberof psb_ls_coo_sparse_mat @@ -3674,6 +3780,8 @@ module psb_s_base_mat_mod end subroutine psb_ls_coo_scals end interface + public :: psb_s_get_print_frmt, psb_ls_get_print_frmt + !> !! \memberof psb_ls_coo_sparse_mat !! \see psb_ls_base_mat_mod::psb_ls_base_scalplusidentity @@ -3729,6 +3837,56 @@ module psb_s_base_mat_mod contains + function psb_s_get_print_frmt(nr,nc,nz,iv,ivr,ivc) result(frmt) + + implicit none + character(len=80) :: frmt + integer(psb_ipk_), intent(in) :: nr, nc, nz + integer(psb_lpk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) + ! + character(len=*), parameter :: datatype='real' + integer(psb_lpk_) :: nmx + integer(psb_ipk_) :: ni + nmx = max(nr,nc,ione) + if (present(iv)) nmx = max(nmx,maxval(abs(iv(1:nc)))) + if (present(ivr)) nmx = max(nmx,maxval(abs(ivr(1:nr)))) + if (present(ivc)) nmx = max(nmx,maxval(abs(ivc(1:nc)))) + ni = floor(log10(1.0*nmx)) + 2 + + if (datatype=='complex') then + write(frmt,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' + else + write(frmt,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' + end if + + end function psb_s_get_print_frmt + + function psb_ls_get_print_frmt(nr,nc,nz,iv,ivr,ivc) result(frmt) + + implicit none + character(len=80) :: frmt + integer(psb_lpk_), intent(in) :: nr, nc, nz + integer(psb_lpk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) + ! + character(len=*), parameter :: datatype='real' + integer(psb_lpk_) :: nmx + integer(psb_lpk_) :: ni + nmx = max(nr,nc,lone) + if (present(iv)) nmx = max(nmx,maxval(abs(iv(1:nc)))) + if (present(ivr)) nmx = max(nmx,maxval(abs(ivr(1:nr)))) + if (present(ivc)) nmx = max(nmx,maxval(abs(ivc(1:nc)))) + ni = floor(log10(1.0*nmx)) + 2 + + if (datatype=='complex') then + write(frmt,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' + else + write(frmt,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' + end if + + end function psb_ls_get_print_frmt + ! == ================================== ! diff --git a/base/modules/serial/psb_s_csc_mat_mod.f90 b/base/modules/serial/psb_s_csc_mat_mod.f90 index 822659d94..ccd4f4457 100644 --- a/base/modules/serial/psb_s_csc_mat_mod.f90 +++ b/base/modules/serial/psb_s_csc_mat_mod.f90 @@ -219,9 +219,9 @@ module psb_s_csc_mat_mod import integer(psb_ipk_), intent(in) :: iout class(psb_s_csc_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) end subroutine psb_s_csc_print end interface diff --git a/base/modules/serial/psb_s_csr_mat_mod.f90 b/base/modules/serial/psb_s_csr_mat_mod.f90 index 01d36829a..6b4c51c79 100644 --- a/base/modules/serial/psb_s_csr_mat_mod.f90 +++ b/base/modules/serial/psb_s_csr_mat_mod.f90 @@ -169,9 +169,9 @@ module psb_s_csr_mat_mod import integer(psb_ipk_), intent(in) :: iout class(psb_s_csr_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) end subroutine psb_s_csr_print end interface ! diff --git a/base/modules/serial/psb_s_mat_mod.F90 b/base/modules/serial/psb_s_mat_mod.F90 index 32a2f378e..ee6671d38 100644 --- a/base/modules/serial/psb_s_mat_mod.F90 +++ b/base/modules/serial/psb_s_mat_mod.F90 @@ -145,8 +145,9 @@ module psb_s_mat_mod procedure, pass(a) :: tril => psb_s_tril procedure, pass(a) :: triu => psb_s_triu procedure, pass(a) :: m_csclip => psb_s_csclip + procedure, pass(a) :: m_csclip_ip => psb_s_csclip_ip procedure, pass(a) :: b_csclip => psb_s_b_csclip - generic, public :: csclip => b_csclip, m_csclip + generic, public :: csclip => b_csclip, m_csclip, m_csclip_ip procedure, pass(a) :: clean_zeros => psb_s_clean_zeros procedure, pass(a) :: reall => psb_s_reallocate_nz procedure, pass(a) :: get_neigh => psb_s_get_neigh @@ -342,8 +343,9 @@ module psb_s_mat_mod procedure, pass(a) :: tril => psb_ls_tril procedure, pass(a) :: triu => psb_ls_triu procedure, pass(a) :: m_csclip => psb_ls_csclip + procedure, pass(a) :: m_csclip_ip => psb_ls_csclip_ip procedure, pass(a) :: b_csclip => psb_ls_b_csclip - generic, public :: csclip => b_csclip, m_csclip + generic, public :: csclip => b_csclip, m_csclip, m_csclip_ip procedure, pass(a) :: clean_zeros => psb_ls_clean_zeros procedure, pass(a) :: reall => psb_ls_reallocate_nz procedure, pass(a) :: get_neigh => psb_ls_get_neigh @@ -573,9 +575,9 @@ module psb_s_mat_mod import :: psb_ipk_, psb_lpk_, psb_sspmat_type integer(psb_ipk_), intent(in) :: iout class(psb_sspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) end subroutine psb_s_sparse_print end interface @@ -584,9 +586,9 @@ module psb_s_mat_mod import :: psb_ipk_, psb_lpk_, psb_sspmat_type character(len=*), intent(in) :: fname class(psb_sspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) end subroutine psb_s_n_sparse_print end interface @@ -745,6 +747,17 @@ module psb_s_mat_mod end subroutine psb_s_csclip end interface + interface + subroutine psb_s_csclip_ip(a,info,& + & imin,imax,jmin,jmax,rscale,cscale) + import :: psb_ipk_, psb_lpk_, psb_sspmat_type, psb_spk_ + class(psb_sspmat_type), intent(inout) :: a + integer(psb_ipk_),intent(out) :: info + integer(psb_ipk_), intent(in), optional :: imin,imax,jmin,jmax + logical, intent(in), optional :: rscale,cscale + end subroutine psb_s_csclip_ip + end interface + interface subroutine psb_s_b_csclip(a,b,info,& & imin,imax,jmin,jmax,rscale,cscale) @@ -1514,6 +1527,17 @@ module psb_s_mat_mod end subroutine psb_ls_csclip end interface + interface + subroutine psb_ls_csclip_ip(a,info,& + & imin,imax,jmin,jmax,rscale,cscale) + import :: psb_ipk_, psb_lpk_, psb_lsspmat_type, psb_spk_ + class(psb_lsspmat_type), intent(inout) :: a + integer(psb_ipk_),intent(out) :: info + integer(psb_lpk_), intent(in), optional :: imin,imax,jmin,jmax + logical, intent(in), optional :: rscale,cscale + end subroutine psb_ls_csclip_ip + end interface + interface subroutine psb_ls_b_csclip(a,b,info,& & imin,imax,jmin,jmax,rscale,cscale) diff --git a/base/modules/serial/psb_s_serial_mod.f90 b/base/modules/serial/psb_s_serial_mod.f90 index 45ed7dbbe..81583f64e 100644 --- a/base/modules/serial/psb_s_serial_mod.f90 +++ b/base/modules/serial/psb_s_serial_mod.f90 @@ -292,9 +292,9 @@ contains use psb_s_mat_mod, only : psb_sspmat_type integer(psb_ipk_), intent(in) :: iout type(psb_sspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:),ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:),ivc(:) call a%print(iout,iv,head,ivr,ivc) @@ -304,9 +304,9 @@ contains use psb_s_mat_mod, only : psb_sspmat_type character(len=*), intent(in) :: fname type(psb_sspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:),ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:),ivc(:) call a%print(fname,iv,head,ivr,ivc) diff --git a/base/modules/serial/psb_z_base_mat_mod.F90 b/base/modules/serial/psb_z_base_mat_mod.F90 index cc7b2e22c..88ba36ec3 100644 --- a/base/modules/serial/psb_z_base_mat_mod.F90 +++ b/base/modules/serial/psb_z_base_mat_mod.F90 @@ -167,6 +167,7 @@ module psb_z_base_mat_mod procedure, pass(a) :: sizeof => z_coo_sizeof procedure, pass(a) :: reallocate_nz => psb_z_coo_reallocate_nz procedure, pass(a) :: allocate_mnnz => psb_z_coo_allocate_mnnz + procedure, pass(a) :: ensure_size => psb_z_coo_ensure_size procedure, pass(a) :: cp_to_coo => psb_z_cp_coo_to_coo procedure, pass(a) :: cp_from_coo => psb_z_cp_coo_from_coo procedure, pass(a) :: cp_to_fmt => psb_z_cp_coo_to_fmt @@ -191,6 +192,7 @@ module psb_z_base_mat_mod procedure, pass(a) :: fix => psb_z_fix_coo procedure, pass(a) :: trim => psb_z_coo_trim procedure, pass(a) :: clean_zeros => psb_z_coo_clean_zeros + procedure, pass(a) :: clean_negidx => psb_z_coo_clean_negidx procedure, pass(a) :: print => psb_z_coo_print procedure, pass(a) :: free => z_coo_free procedure, pass(a) :: mold => psb_z_coo_mold @@ -360,6 +362,7 @@ module psb_z_base_mat_mod procedure, pass(a) :: sizeof => lz_coo_sizeof procedure, pass(a) :: reallocate_nz => psb_lz_coo_reallocate_nz procedure, pass(a) :: allocate_mnnz => psb_lz_coo_allocate_mnnz + procedure, pass(a) :: ensure_size => psb_lz_coo_ensure_size procedure, pass(a) :: cp_to_coo => psb_lz_cp_coo_to_coo procedure, pass(a) :: cp_from_coo => psb_lz_cp_coo_from_coo procedure, pass(a) :: cp_to_fmt => psb_lz_cp_coo_to_fmt @@ -380,6 +383,7 @@ module psb_z_base_mat_mod procedure, pass(a) :: fix => psb_lz_fix_coo procedure, pass(a) :: trim => psb_lz_coo_trim procedure, pass(a) :: clean_zeros => psb_lz_coo_clean_zeros + procedure, pass(a) :: clean_negidx => psb_lz_coo_clean_negidx procedure, pass(a) :: print => psb_lz_coo_print procedure, pass(a) :: free => lz_coo_free procedure, pass(a) :: mold => psb_lz_coo_mold @@ -1678,6 +1682,17 @@ module psb_z_base_mat_mod class(psb_z_coo_sparse_mat), intent(inout) :: a end subroutine psb_z_coo_reallocate_nz end interface + ! + !> + !! \memberof psb_z_coo_sparse_mat + ! + interface + subroutine psb_z_coo_ensure_size(nz,a) + import + integer(psb_ipk_), intent(in) :: nz + class(psb_z_coo_sparse_mat), intent(inout) :: a + end subroutine psb_z_coo_ensure_size + end interface ! !> @@ -1715,6 +1730,46 @@ module psb_z_base_mat_mod end subroutine psb_z_coo_clean_zeros end interface + ! + !> + !! \memberof psb_z_coo_sparse_mat + !! \brief Take out any entries with negative row or column index + !! May happen when converting local/global numbering + !! \param info return code + !! + ! + interface + subroutine psb_z_coo_clean_negidx(a,info) + import + class(psb_z_coo_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_coo_clean_negidx + end interface + + ! + !> Funtion: coo_clean_negidx_inner + !! \brief Take out any entries with negative row or column index + !! Used internally by coo_clean_negidx + !! \param nzin Number of entries on input to be handled + !! \param ia(:) Row indices + !! \param ja(:) Col indices + !! \param val(:) Coefficients + !! \param nzout Number of entries after sorting/duplicate handling + !! \param info return code + !! + ! + interface psb_coo_clean_negidx_inner + subroutine psb_z_coo_clean_negidx_inner(nzin,ia,ja,val,nzout,info) + import + integer(psb_ipk_), intent(in) :: nzin + integer(psb_ipk_), intent(inout) :: ia(:), ja(:) + complex(psb_dpk_), intent(inout) :: val(:) + integer(psb_ipk_), intent(out) :: nzout + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_coo_clean_negidx_inner + end interface psb_coo_clean_negidx_inner + + ! !> !! \memberof psb_z_coo_sparse_mat @@ -1759,9 +1814,9 @@ module psb_z_base_mat_mod import integer(psb_ipk_), intent(in) :: iout class(psb_z_coo_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) end subroutine psb_z_coo_print end interface @@ -3279,6 +3334,17 @@ module psb_z_base_mat_mod class(psb_lz_coo_sparse_mat), intent(inout) :: a end subroutine psb_lz_coo_reallocate_nz end interface + ! + !> + !! \memberof psb_lz_coo_sparse_mat + ! + interface + subroutine psb_lz_coo_ensure_size(nz,a) + import + integer(psb_lpk_), intent(in) :: nz + class(psb_lz_coo_sparse_mat), intent(inout) :: a + end subroutine psb_lz_coo_ensure_size + end interface ! !> @@ -3316,6 +3382,46 @@ module psb_z_base_mat_mod end subroutine psb_lz_coo_clean_zeros end interface + ! + !> + !! \memberof psb_lz_coo_sparse_mat + !! \brief Take out any entries with negative row or column index + !! May happen when converting local/global numbering + !! \param info return code + !! + ! + interface + subroutine psb_lz_coo_clean_negidx(a,info) + import + class(psb_lz_coo_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_lz_coo_clean_negidx + end interface + +#if defined(IPK4) && defined(LPK8) + ! + !> Funtion: coo_clean_negidx_inner + !! \brief Take out any entries with negative row or column index + !! Used internally by coo_clean_negidx + !! \param nzin Number of entries on input to be handled + !! \param ia(:) Row indices + !! \param ja(:) Col indices + !! \param val(:) Coefficients + !! \param nzout Number of entries after sorting/duplicate handling + !! \param info return code + !! + ! + interface psb_coo_clean_negidx_inner + subroutine psb_lz_coo_clean_negidx_inner(nzin,ia,ja,val,nzout,info) + import + integer(psb_lpk_), intent(in) :: nzin + integer(psb_lpk_), intent(inout) :: ia(:), ja(:) + complex(psb_dpk_), intent(inout) :: val(:) + integer(psb_lpk_), intent(out) :: nzout + integer(psb_ipk_), intent(out) :: info + end subroutine psb_lz_coo_clean_negidx_inner + end interface psb_coo_clean_negidx_inner +#endif ! !> !! \memberof psb_lz_coo_sparse_mat @@ -3674,6 +3780,8 @@ module psb_z_base_mat_mod end subroutine psb_lz_coo_scals end interface + public :: psb_z_get_print_frmt, psb_lz_get_print_frmt + !> !! \memberof psb_lz_coo_sparse_mat !! \see psb_lz_base_mat_mod::psb_lz_base_scalplusidentity @@ -3729,6 +3837,56 @@ module psb_z_base_mat_mod contains + function psb_z_get_print_frmt(nr,nc,nz,iv,ivr,ivc) result(frmt) + + implicit none + character(len=80) :: frmt + integer(psb_ipk_), intent(in) :: nr, nc, nz + integer(psb_lpk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) + ! + character(len=*), parameter :: datatype='complex' + integer(psb_lpk_) :: nmx + integer(psb_ipk_) :: ni + nmx = max(nr,nc,ione) + if (present(iv)) nmx = max(nmx,maxval(abs(iv(1:nc)))) + if (present(ivr)) nmx = max(nmx,maxval(abs(ivr(1:nr)))) + if (present(ivc)) nmx = max(nmx,maxval(abs(ivc(1:nc)))) + ni = floor(log10(1.0*nmx)) + 2 + + if (datatype=='complex') then + write(frmt,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' + else + write(frmt,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' + end if + + end function psb_z_get_print_frmt + + function psb_lz_get_print_frmt(nr,nc,nz,iv,ivr,ivc) result(frmt) + + implicit none + character(len=80) :: frmt + integer(psb_lpk_), intent(in) :: nr, nc, nz + integer(psb_lpk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) + ! + character(len=*), parameter :: datatype='complex' + integer(psb_lpk_) :: nmx + integer(psb_lpk_) :: ni + nmx = max(nr,nc,lone) + if (present(iv)) nmx = max(nmx,maxval(abs(iv(1:nc)))) + if (present(ivr)) nmx = max(nmx,maxval(abs(ivr(1:nr)))) + if (present(ivc)) nmx = max(nmx,maxval(abs(ivc(1:nc)))) + ni = floor(log10(1.0*nmx)) + 2 + + if (datatype=='complex') then + write(frmt,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' + else + write(frmt,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' + end if + + end function psb_lz_get_print_frmt + ! == ================================== ! diff --git a/base/modules/serial/psb_z_csc_mat_mod.f90 b/base/modules/serial/psb_z_csc_mat_mod.f90 index b3b3e8fe1..222742ebe 100644 --- a/base/modules/serial/psb_z_csc_mat_mod.f90 +++ b/base/modules/serial/psb_z_csc_mat_mod.f90 @@ -219,9 +219,9 @@ module psb_z_csc_mat_mod import integer(psb_ipk_), intent(in) :: iout class(psb_z_csc_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) end subroutine psb_z_csc_print end interface diff --git a/base/modules/serial/psb_z_csr_mat_mod.f90 b/base/modules/serial/psb_z_csr_mat_mod.f90 index 406ef6b4f..4ec8dd004 100644 --- a/base/modules/serial/psb_z_csr_mat_mod.f90 +++ b/base/modules/serial/psb_z_csr_mat_mod.f90 @@ -169,9 +169,9 @@ module psb_z_csr_mat_mod import integer(psb_ipk_), intent(in) :: iout class(psb_z_csr_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) end subroutine psb_z_csr_print end interface ! diff --git a/base/modules/serial/psb_z_mat_mod.F90 b/base/modules/serial/psb_z_mat_mod.F90 index 7a32cde86..d03f3bef4 100644 --- a/base/modules/serial/psb_z_mat_mod.F90 +++ b/base/modules/serial/psb_z_mat_mod.F90 @@ -145,8 +145,9 @@ module psb_z_mat_mod procedure, pass(a) :: tril => psb_z_tril procedure, pass(a) :: triu => psb_z_triu procedure, pass(a) :: m_csclip => psb_z_csclip + procedure, pass(a) :: m_csclip_ip => psb_z_csclip_ip procedure, pass(a) :: b_csclip => psb_z_b_csclip - generic, public :: csclip => b_csclip, m_csclip + generic, public :: csclip => b_csclip, m_csclip, m_csclip_ip procedure, pass(a) :: clean_zeros => psb_z_clean_zeros procedure, pass(a) :: reall => psb_z_reallocate_nz procedure, pass(a) :: get_neigh => psb_z_get_neigh @@ -342,8 +343,9 @@ module psb_z_mat_mod procedure, pass(a) :: tril => psb_lz_tril procedure, pass(a) :: triu => psb_lz_triu procedure, pass(a) :: m_csclip => psb_lz_csclip + procedure, pass(a) :: m_csclip_ip => psb_lz_csclip_ip procedure, pass(a) :: b_csclip => psb_lz_b_csclip - generic, public :: csclip => b_csclip, m_csclip + generic, public :: csclip => b_csclip, m_csclip, m_csclip_ip procedure, pass(a) :: clean_zeros => psb_lz_clean_zeros procedure, pass(a) :: reall => psb_lz_reallocate_nz procedure, pass(a) :: get_neigh => psb_lz_get_neigh @@ -573,9 +575,9 @@ module psb_z_mat_mod import :: psb_ipk_, psb_lpk_, psb_zspmat_type integer(psb_ipk_), intent(in) :: iout class(psb_zspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) end subroutine psb_z_sparse_print end interface @@ -584,9 +586,9 @@ module psb_z_mat_mod import :: psb_ipk_, psb_lpk_, psb_zspmat_type character(len=*), intent(in) :: fname class(psb_zspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) end subroutine psb_z_n_sparse_print end interface @@ -745,6 +747,17 @@ module psb_z_mat_mod end subroutine psb_z_csclip end interface + interface + subroutine psb_z_csclip_ip(a,info,& + & imin,imax,jmin,jmax,rscale,cscale) + import :: psb_ipk_, psb_lpk_, psb_zspmat_type, psb_dpk_ + class(psb_zspmat_type), intent(inout) :: a + integer(psb_ipk_),intent(out) :: info + integer(psb_ipk_), intent(in), optional :: imin,imax,jmin,jmax + logical, intent(in), optional :: rscale,cscale + end subroutine psb_z_csclip_ip + end interface + interface subroutine psb_z_b_csclip(a,b,info,& & imin,imax,jmin,jmax,rscale,cscale) @@ -1514,6 +1527,17 @@ module psb_z_mat_mod end subroutine psb_lz_csclip end interface + interface + subroutine psb_lz_csclip_ip(a,info,& + & imin,imax,jmin,jmax,rscale,cscale) + import :: psb_ipk_, psb_lpk_, psb_lzspmat_type, psb_dpk_ + class(psb_lzspmat_type), intent(inout) :: a + integer(psb_ipk_),intent(out) :: info + integer(psb_lpk_), intent(in), optional :: imin,imax,jmin,jmax + logical, intent(in), optional :: rscale,cscale + end subroutine psb_lz_csclip_ip + end interface + interface subroutine psb_lz_b_csclip(a,b,info,& & imin,imax,jmin,jmax,rscale,cscale) diff --git a/base/modules/serial/psb_z_serial_mod.f90 b/base/modules/serial/psb_z_serial_mod.f90 index 5afbcf961..dbfce00bd 100644 --- a/base/modules/serial/psb_z_serial_mod.f90 +++ b/base/modules/serial/psb_z_serial_mod.f90 @@ -292,9 +292,9 @@ contains use psb_z_mat_mod, only : psb_zspmat_type integer(psb_ipk_), intent(in) :: iout type(psb_zspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:),ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:),ivc(:) call a%print(iout,iv,head,ivr,ivc) @@ -304,9 +304,9 @@ contains use psb_z_mat_mod, only : psb_zspmat_type character(len=*), intent(in) :: fname type(psb_zspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:),ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:),ivc(:) call a%print(fname,iv,head,ivr,ivc) diff --git a/base/modules/tools/psb_c_tools_mod.f90 b/base/modules/tools/psb_c_tools_mod.F90 similarity index 80% rename from base/modules/tools/psb_c_tools_mod.f90 rename to base/modules/tools/psb_c_tools_mod.F90 index bf02bdc51..fdcc5e56e 100644 --- a/base/modules/tools/psb_c_tools_mod.f90 +++ b/base/modules/tools/psb_c_tools_mod.F90 @@ -32,7 +32,9 @@ Module psb_c_tools_mod use psb_desc_mod, only : psb_desc_type, psb_spk_, psb_ipk_, psb_lpk_ use psb_c_vect_mod, only : psb_c_base_vect_type, psb_c_vect_type - use psb_c_mat_mod, only : psb_cspmat_type, psb_lcspmat_type, psb_c_base_sparse_mat, psb_lc_csr_sparse_mat + use psb_c_mat_mod, only : psb_cspmat_type, psb_lcspmat_type, psb_c_base_sparse_mat, & + & psb_lc_csr_sparse_mat, psb_lc_coo_sparse_mat, & + & psb_c_csr_sparse_mat, psb_c_coo_sparse_mat use psb_l_vect_mod, only : psb_l_vect_type use psb_c_multivect_mod, only : psb_c_base_multivect_type, psb_c_multivect_type @@ -220,6 +222,18 @@ Module psb_c_tools_mod integer(psb_ipk_), intent(in), optional :: data type(psb_desc_type),Intent(in), optional, target :: col_desc end Subroutine psb_lc_csr_halo + Subroutine psb_c_lc_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& + & rowscale,colscale,data,outcol_glob,col_desc) + import + implicit none + type(psb_c_csr_sparse_mat),Intent(in) :: a + type(psb_lc_csr_sparse_mat),Intent(inout) :: blk + type(psb_desc_type),intent(in), target :: desc_a + integer(psb_ipk_), intent(out) :: info + logical, optional, intent(in) :: rowcnv,colcnv,rowscale,colscale,outcol_glob + integer(psb_ipk_), intent(in), optional :: data + type(psb_desc_type),Intent(in), optional, target :: col_desc + end Subroutine psb_c_lc_csr_halo end interface @@ -282,6 +296,7 @@ Module psb_c_tools_mod integer(psb_ipk_), intent(out) :: info logical, intent(in), optional :: rebuild, local end subroutine psb_cspins_csr_lirp +#if defined(IPK4) && defined(LPK8) subroutine psb_cspins_csr_iirp(nr,irw,irp,ja,val,a,desc_a,info,rebuild,local) import implicit none @@ -293,6 +308,7 @@ Module psb_c_tools_mod integer(psb_ipk_), intent(out) :: info logical, intent(in), optional :: rebuild, local end subroutine psb_cspins_csr_iirp +#endif subroutine psb_cspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local) use psb_i_vect_mod, only : psb_i_vect_type import @@ -332,6 +348,17 @@ Module psb_c_tools_mod end interface interface psb_par_spspmm + subroutine psb_c_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) + import :: psb_c_csr_sparse_mat, psb_desc_type, psb_ipk_ + Implicit None + type(psb_c_csr_sparse_mat),intent(in) :: acsr + type(psb_c_csr_sparse_mat),intent(inout) :: bcsr + type(psb_c_csr_sparse_mat),intent(out) :: ccsr + type(psb_desc_type),intent(in) :: desc_a + type(psb_desc_type),intent(inout) :: desc_c + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: data + End Subroutine psb_c_par_csr_spspmm subroutine psb_lc_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) import :: psb_lc_csr_sparse_mat, psb_desc_type, psb_ipk_ Implicit None @@ -344,5 +371,54 @@ Module psb_c_tools_mod integer(psb_ipk_), intent(in), optional :: data End Subroutine psb_lc_par_csr_spspmm end interface psb_par_spspmm + + interface psb_glob_transpose + subroutine psb_c_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) + import + type(psb_c_coo_sparse_mat), intent(inout) :: ain + type(psb_desc_type), intent(inout), target :: desc_r + type(psb_c_coo_sparse_mat), intent(out), optional :: atrans + type(psb_desc_type), intent(inout), target, optional :: desc_c + type(psb_desc_type), intent(out), optional :: desc_rx + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_coo_glob_transpose + subroutine psb_lc_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) + import + type(psb_lc_coo_sparse_mat), intent(inout) :: ain + type(psb_desc_type), intent(inout), target :: desc_r + type(psb_lc_coo_sparse_mat), intent(out), optional :: atrans + type(psb_desc_type), intent(inout), target, optional :: desc_c + type(psb_desc_type), intent(out), optional :: desc_rx + integer(psb_ipk_), intent(out) :: info + end subroutine psb_lc_coo_glob_transpose + subroutine psb_lc_simple_glob_transpose(ain,aout,desc_a,info) + import + type(psb_lcspmat_type), intent(in) :: ain + type(psb_lcspmat_type), intent(out) :: aout + type(psb_desc_type) :: desc_a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_lc_simple_glob_transpose + subroutine psb_lc_simple_glob_transpose_ip(ain,desc_a,info) + import + type(psb_lcspmat_type), intent(inout) :: ain + type(psb_desc_type) :: desc_a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_lc_simple_glob_transpose_ip + subroutine psb_c_simple_glob_transpose(ain,aout,desc_a,info) + import + type(psb_cspmat_type), intent(in) :: ain + type(psb_cspmat_type), intent(out) :: aout + type(psb_desc_type) :: desc_a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_simple_glob_transpose + subroutine psb_c_simple_glob_transpose_ip(ain,desc_a,info) + import + type(psb_cspmat_type), intent(inout) :: ain + type(psb_desc_type) :: desc_a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_simple_glob_transpose_ip + end interface psb_glob_transpose + + end module psb_c_tools_mod diff --git a/base/modules/tools/psb_cd_tools_mod.f90 b/base/modules/tools/psb_cd_tools_mod.F90 similarity index 99% rename from base/modules/tools/psb_cd_tools_mod.f90 rename to base/modules/tools/psb_cd_tools_mod.F90 index 62d22ed34..3a67d829e 100644 --- a/base/modules/tools/psb_cd_tools_mod.f90 +++ b/base/modules/tools/psb_cd_tools_mod.F90 @@ -104,6 +104,7 @@ module psb_cd_tools_mod end interface interface psb_cdins +#if defined(IPK4) && defined(LPK8) subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla) import :: psb_ipk_, psb_lpk_, psb_desc_type type(psb_desc_type), intent(inout) :: desc_a @@ -122,6 +123,7 @@ module psb_cd_tools_mod logical, optional, target, intent(in) :: mask(:) integer(psb_ipk_), intent(in), optional :: lidx(:) end subroutine psb_cdinsc +#endif subroutine psb_lcdinsrc(nz,ia,ja,desc_a,info,ila,jla) import :: psb_ipk_, psb_lpk_, psb_desc_type type(psb_desc_type), intent(inout) :: desc_a diff --git a/base/modules/tools/psb_d_tools_mod.f90 b/base/modules/tools/psb_d_tools_mod.F90 similarity index 80% rename from base/modules/tools/psb_d_tools_mod.f90 rename to base/modules/tools/psb_d_tools_mod.F90 index faf910451..aa127872a 100644 --- a/base/modules/tools/psb_d_tools_mod.f90 +++ b/base/modules/tools/psb_d_tools_mod.F90 @@ -32,7 +32,9 @@ Module psb_d_tools_mod use psb_desc_mod, only : psb_desc_type, psb_dpk_, psb_ipk_, psb_lpk_ use psb_d_vect_mod, only : psb_d_base_vect_type, psb_d_vect_type - use psb_d_mat_mod, only : psb_dspmat_type, psb_ldspmat_type, psb_d_base_sparse_mat, psb_ld_csr_sparse_mat + use psb_d_mat_mod, only : psb_dspmat_type, psb_ldspmat_type, psb_d_base_sparse_mat, & + & psb_ld_csr_sparse_mat, psb_ld_coo_sparse_mat, & + & psb_d_csr_sparse_mat, psb_d_coo_sparse_mat use psb_l_vect_mod, only : psb_l_vect_type use psb_d_multivect_mod, only : psb_d_base_multivect_type, psb_d_multivect_type @@ -220,6 +222,18 @@ Module psb_d_tools_mod integer(psb_ipk_), intent(in), optional :: data type(psb_desc_type),Intent(in), optional, target :: col_desc end Subroutine psb_ld_csr_halo + Subroutine psb_d_ld_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& + & rowscale,colscale,data,outcol_glob,col_desc) + import + implicit none + type(psb_d_csr_sparse_mat),Intent(in) :: a + type(psb_ld_csr_sparse_mat),Intent(inout) :: blk + type(psb_desc_type),intent(in), target :: desc_a + integer(psb_ipk_), intent(out) :: info + logical, optional, intent(in) :: rowcnv,colcnv,rowscale,colscale,outcol_glob + integer(psb_ipk_), intent(in), optional :: data + type(psb_desc_type),Intent(in), optional, target :: col_desc + end Subroutine psb_d_ld_csr_halo end interface @@ -282,6 +296,7 @@ Module psb_d_tools_mod integer(psb_ipk_), intent(out) :: info logical, intent(in), optional :: rebuild, local end subroutine psb_dspins_csr_lirp +#if defined(IPK4) && defined(LPK8) subroutine psb_dspins_csr_iirp(nr,irw,irp,ja,val,a,desc_a,info,rebuild,local) import implicit none @@ -293,6 +308,7 @@ Module psb_d_tools_mod integer(psb_ipk_), intent(out) :: info logical, intent(in), optional :: rebuild, local end subroutine psb_dspins_csr_iirp +#endif subroutine psb_dspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local) use psb_i_vect_mod, only : psb_i_vect_type import @@ -332,6 +348,17 @@ Module psb_d_tools_mod end interface interface psb_par_spspmm + subroutine psb_d_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) + import :: psb_d_csr_sparse_mat, psb_desc_type, psb_ipk_ + Implicit None + type(psb_d_csr_sparse_mat),intent(in) :: acsr + type(psb_d_csr_sparse_mat),intent(inout) :: bcsr + type(psb_d_csr_sparse_mat),intent(out) :: ccsr + type(psb_desc_type),intent(in) :: desc_a + type(psb_desc_type),intent(inout) :: desc_c + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: data + End Subroutine psb_d_par_csr_spspmm subroutine psb_ld_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) import :: psb_ld_csr_sparse_mat, psb_desc_type, psb_ipk_ Implicit None @@ -344,5 +371,54 @@ Module psb_d_tools_mod integer(psb_ipk_), intent(in), optional :: data End Subroutine psb_ld_par_csr_spspmm end interface psb_par_spspmm + + interface psb_glob_transpose + subroutine psb_d_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) + import + type(psb_d_coo_sparse_mat), intent(inout) :: ain + type(psb_desc_type), intent(inout), target :: desc_r + type(psb_d_coo_sparse_mat), intent(out), optional :: atrans + type(psb_desc_type), intent(inout), target, optional :: desc_c + type(psb_desc_type), intent(out), optional :: desc_rx + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_coo_glob_transpose + subroutine psb_ld_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) + import + type(psb_ld_coo_sparse_mat), intent(inout) :: ain + type(psb_desc_type), intent(inout), target :: desc_r + type(psb_ld_coo_sparse_mat), intent(out), optional :: atrans + type(psb_desc_type), intent(inout), target, optional :: desc_c + type(psb_desc_type), intent(out), optional :: desc_rx + integer(psb_ipk_), intent(out) :: info + end subroutine psb_ld_coo_glob_transpose + subroutine psb_ld_simple_glob_transpose(ain,aout,desc_a,info) + import + type(psb_ldspmat_type), intent(in) :: ain + type(psb_ldspmat_type), intent(out) :: aout + type(psb_desc_type) :: desc_a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_ld_simple_glob_transpose + subroutine psb_ld_simple_glob_transpose_ip(ain,desc_a,info) + import + type(psb_ldspmat_type), intent(inout) :: ain + type(psb_desc_type) :: desc_a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_ld_simple_glob_transpose_ip + subroutine psb_d_simple_glob_transpose(ain,aout,desc_a,info) + import + type(psb_dspmat_type), intent(in) :: ain + type(psb_dspmat_type), intent(out) :: aout + type(psb_desc_type) :: desc_a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_simple_glob_transpose + subroutine psb_d_simple_glob_transpose_ip(ain,desc_a,info) + import + type(psb_dspmat_type), intent(inout) :: ain + type(psb_desc_type) :: desc_a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_simple_glob_transpose_ip + end interface psb_glob_transpose + + end module psb_d_tools_mod diff --git a/base/modules/tools/psb_i2_tools_a_mod.f90 b/base/modules/tools/psb_i2_tools_a_mod.f90 new file mode 100644 index 000000000..860a55b16 --- /dev/null +++ b/base/modules/tools/psb_i2_tools_a_mod.f90 @@ -0,0 +1,119 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! 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. +! +! +Module psb_i2_tools_a_mod + use psb_desc_mod, only : psb_desc_type, psb_i2pk_, psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_ + + interface psb_geall + subroutine psb_i2alloc(x, desc_a, info, n, lb) + import + implicit none + integer(psb_i2pk_), allocatable, intent(out) :: x(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), optional, intent(in) :: n, lb + end subroutine psb_i2alloc + subroutine psb_i2allocv(x, desc_a,info,n) + import + implicit none + integer(psb_i2pk_), allocatable, intent(out) :: x(:) + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), optional, intent(in) :: n + end subroutine psb_i2allocv + end interface + + + interface psb_geasb + subroutine psb_i2asb(x, desc_a, info, scratch) + import + implicit none + type(psb_desc_type), intent(in) :: desc_a + integer(psb_i2pk_), allocatable, intent(inout) :: x(:,:) + integer(psb_ipk_), intent(out) :: info + logical, intent(in), optional :: scratch + end subroutine psb_i2asb + subroutine psb_i2asbv(x, desc_a, info, scratch) + import + implicit none + type(psb_desc_type), intent(in) :: desc_a + integer(psb_i2pk_), allocatable, intent(inout) :: x(:) + integer(psb_ipk_), intent(out) :: info + logical, intent(in), optional :: scratch + end subroutine psb_i2asbv + end interface + + interface psb_gefree + subroutine psb_i2free(x, desc_a, info) + import + implicit none + integer(psb_i2pk_),allocatable, intent(inout) :: x(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i2free + subroutine psb_i2freev(x, desc_a, info) + import + implicit none + integer(psb_i2pk_),allocatable, intent(inout) :: x(:) + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i2freev + end interface + + + interface psb_geins + subroutine psb_i2insi(m,irw,val, x, desc_a,info,dupl,local) + import + implicit none + integer(psb_ipk_), intent(in) :: m + type(psb_desc_type), intent(in) :: desc_a + integer(psb_i2pk_),intent(inout) :: x(:,:) + integer(psb_lpk_), intent(in) :: irw(:) + integer(psb_i2pk_), intent(in) :: val(:,:) + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), optional, intent(in) :: dupl + logical, intent(in), optional :: local + end subroutine psb_i2insi + subroutine psb_i2insvi(m, irw,val, x,desc_a,info,dupl,local) + import + implicit none + integer(psb_ipk_), intent(in) :: m + type(psb_desc_type), intent(in) :: desc_a + integer(psb_i2pk_),intent(inout) :: x(:) + integer(psb_lpk_), intent(in) :: irw(:) + integer(psb_i2pk_), intent(in) :: val(:) + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), optional, intent(in) :: dupl + logical, intent(in), optional :: local + end subroutine psb_i2insvi + end interface + +end module psb_i2_tools_a_mod diff --git a/base/modules/tools/psb_i_tools_mod.f90 b/base/modules/tools/psb_i_tools_mod.F90 similarity index 100% rename from base/modules/tools/psb_i_tools_mod.f90 rename to base/modules/tools/psb_i_tools_mod.F90 diff --git a/base/modules/tools/psb_l_tools_mod.f90 b/base/modules/tools/psb_l_tools_mod.F90 similarity index 100% rename from base/modules/tools/psb_l_tools_mod.f90 rename to base/modules/tools/psb_l_tools_mod.F90 diff --git a/base/modules/tools/psb_s_tools_mod.f90 b/base/modules/tools/psb_s_tools_mod.F90 similarity index 80% rename from base/modules/tools/psb_s_tools_mod.f90 rename to base/modules/tools/psb_s_tools_mod.F90 index 59c576a01..24453728e 100644 --- a/base/modules/tools/psb_s_tools_mod.f90 +++ b/base/modules/tools/psb_s_tools_mod.F90 @@ -32,7 +32,9 @@ Module psb_s_tools_mod use psb_desc_mod, only : psb_desc_type, psb_spk_, psb_ipk_, psb_lpk_ use psb_s_vect_mod, only : psb_s_base_vect_type, psb_s_vect_type - use psb_s_mat_mod, only : psb_sspmat_type, psb_lsspmat_type, psb_s_base_sparse_mat, psb_ls_csr_sparse_mat + use psb_s_mat_mod, only : psb_sspmat_type, psb_lsspmat_type, psb_s_base_sparse_mat, & + & psb_ls_csr_sparse_mat, psb_ls_coo_sparse_mat, & + & psb_s_csr_sparse_mat, psb_s_coo_sparse_mat use psb_l_vect_mod, only : psb_l_vect_type use psb_s_multivect_mod, only : psb_s_base_multivect_type, psb_s_multivect_type @@ -220,6 +222,18 @@ Module psb_s_tools_mod integer(psb_ipk_), intent(in), optional :: data type(psb_desc_type),Intent(in), optional, target :: col_desc end Subroutine psb_ls_csr_halo + Subroutine psb_s_ls_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& + & rowscale,colscale,data,outcol_glob,col_desc) + import + implicit none + type(psb_s_csr_sparse_mat),Intent(in) :: a + type(psb_ls_csr_sparse_mat),Intent(inout) :: blk + type(psb_desc_type),intent(in), target :: desc_a + integer(psb_ipk_), intent(out) :: info + logical, optional, intent(in) :: rowcnv,colcnv,rowscale,colscale,outcol_glob + integer(psb_ipk_), intent(in), optional :: data + type(psb_desc_type),Intent(in), optional, target :: col_desc + end Subroutine psb_s_ls_csr_halo end interface @@ -282,6 +296,7 @@ Module psb_s_tools_mod integer(psb_ipk_), intent(out) :: info logical, intent(in), optional :: rebuild, local end subroutine psb_sspins_csr_lirp +#if defined(IPK4) && defined(LPK8) subroutine psb_sspins_csr_iirp(nr,irw,irp,ja,val,a,desc_a,info,rebuild,local) import implicit none @@ -293,6 +308,7 @@ Module psb_s_tools_mod integer(psb_ipk_), intent(out) :: info logical, intent(in), optional :: rebuild, local end subroutine psb_sspins_csr_iirp +#endif subroutine psb_sspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local) use psb_i_vect_mod, only : psb_i_vect_type import @@ -332,6 +348,17 @@ Module psb_s_tools_mod end interface interface psb_par_spspmm + subroutine psb_s_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) + import :: psb_s_csr_sparse_mat, psb_desc_type, psb_ipk_ + Implicit None + type(psb_s_csr_sparse_mat),intent(in) :: acsr + type(psb_s_csr_sparse_mat),intent(inout) :: bcsr + type(psb_s_csr_sparse_mat),intent(out) :: ccsr + type(psb_desc_type),intent(in) :: desc_a + type(psb_desc_type),intent(inout) :: desc_c + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: data + End Subroutine psb_s_par_csr_spspmm subroutine psb_ls_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) import :: psb_ls_csr_sparse_mat, psb_desc_type, psb_ipk_ Implicit None @@ -344,5 +371,54 @@ Module psb_s_tools_mod integer(psb_ipk_), intent(in), optional :: data End Subroutine psb_ls_par_csr_spspmm end interface psb_par_spspmm + + interface psb_glob_transpose + subroutine psb_s_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) + import + type(psb_s_coo_sparse_mat), intent(inout) :: ain + type(psb_desc_type), intent(inout), target :: desc_r + type(psb_s_coo_sparse_mat), intent(out), optional :: atrans + type(psb_desc_type), intent(inout), target, optional :: desc_c + type(psb_desc_type), intent(out), optional :: desc_rx + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_coo_glob_transpose + subroutine psb_ls_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) + import + type(psb_ls_coo_sparse_mat), intent(inout) :: ain + type(psb_desc_type), intent(inout), target :: desc_r + type(psb_ls_coo_sparse_mat), intent(out), optional :: atrans + type(psb_desc_type), intent(inout), target, optional :: desc_c + type(psb_desc_type), intent(out), optional :: desc_rx + integer(psb_ipk_), intent(out) :: info + end subroutine psb_ls_coo_glob_transpose + subroutine psb_ls_simple_glob_transpose(ain,aout,desc_a,info) + import + type(psb_lsspmat_type), intent(in) :: ain + type(psb_lsspmat_type), intent(out) :: aout + type(psb_desc_type) :: desc_a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_ls_simple_glob_transpose + subroutine psb_ls_simple_glob_transpose_ip(ain,desc_a,info) + import + type(psb_lsspmat_type), intent(inout) :: ain + type(psb_desc_type) :: desc_a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_ls_simple_glob_transpose_ip + subroutine psb_s_simple_glob_transpose(ain,aout,desc_a,info) + import + type(psb_sspmat_type), intent(in) :: ain + type(psb_sspmat_type), intent(out) :: aout + type(psb_desc_type) :: desc_a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_simple_glob_transpose + subroutine psb_s_simple_glob_transpose_ip(ain,desc_a,info) + import + type(psb_sspmat_type), intent(inout) :: ain + type(psb_desc_type) :: desc_a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_simple_glob_transpose_ip + end interface psb_glob_transpose + + end module psb_s_tools_mod diff --git a/base/modules/tools/psb_z_tools_mod.f90 b/base/modules/tools/psb_z_tools_mod.F90 similarity index 80% rename from base/modules/tools/psb_z_tools_mod.f90 rename to base/modules/tools/psb_z_tools_mod.F90 index 185aba049..2b639fdc9 100644 --- a/base/modules/tools/psb_z_tools_mod.f90 +++ b/base/modules/tools/psb_z_tools_mod.F90 @@ -32,7 +32,9 @@ Module psb_z_tools_mod use psb_desc_mod, only : psb_desc_type, psb_dpk_, psb_ipk_, psb_lpk_ use psb_z_vect_mod, only : psb_z_base_vect_type, psb_z_vect_type - use psb_z_mat_mod, only : psb_zspmat_type, psb_lzspmat_type, psb_z_base_sparse_mat, psb_lz_csr_sparse_mat + use psb_z_mat_mod, only : psb_zspmat_type, psb_lzspmat_type, psb_z_base_sparse_mat, & + & psb_lz_csr_sparse_mat, psb_lz_coo_sparse_mat, & + & psb_z_csr_sparse_mat, psb_z_coo_sparse_mat use psb_l_vect_mod, only : psb_l_vect_type use psb_z_multivect_mod, only : psb_z_base_multivect_type, psb_z_multivect_type @@ -220,6 +222,18 @@ Module psb_z_tools_mod integer(psb_ipk_), intent(in), optional :: data type(psb_desc_type),Intent(in), optional, target :: col_desc end Subroutine psb_lz_csr_halo + Subroutine psb_z_lz_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& + & rowscale,colscale,data,outcol_glob,col_desc) + import + implicit none + type(psb_z_csr_sparse_mat),Intent(in) :: a + type(psb_lz_csr_sparse_mat),Intent(inout) :: blk + type(psb_desc_type),intent(in), target :: desc_a + integer(psb_ipk_), intent(out) :: info + logical, optional, intent(in) :: rowcnv,colcnv,rowscale,colscale,outcol_glob + integer(psb_ipk_), intent(in), optional :: data + type(psb_desc_type),Intent(in), optional, target :: col_desc + end Subroutine psb_z_lz_csr_halo end interface @@ -282,6 +296,7 @@ Module psb_z_tools_mod integer(psb_ipk_), intent(out) :: info logical, intent(in), optional :: rebuild, local end subroutine psb_zspins_csr_lirp +#if defined(IPK4) && defined(LPK8) subroutine psb_zspins_csr_iirp(nr,irw,irp,ja,val,a,desc_a,info,rebuild,local) import implicit none @@ -293,6 +308,7 @@ Module psb_z_tools_mod integer(psb_ipk_), intent(out) :: info logical, intent(in), optional :: rebuild, local end subroutine psb_zspins_csr_iirp +#endif subroutine psb_zspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local) use psb_i_vect_mod, only : psb_i_vect_type import @@ -332,6 +348,17 @@ Module psb_z_tools_mod end interface interface psb_par_spspmm + subroutine psb_z_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) + import :: psb_z_csr_sparse_mat, psb_desc_type, psb_ipk_ + Implicit None + type(psb_z_csr_sparse_mat),intent(in) :: acsr + type(psb_z_csr_sparse_mat),intent(inout) :: bcsr + type(psb_z_csr_sparse_mat),intent(out) :: ccsr + type(psb_desc_type),intent(in) :: desc_a + type(psb_desc_type),intent(inout) :: desc_c + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: data + End Subroutine psb_z_par_csr_spspmm subroutine psb_lz_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) import :: psb_lz_csr_sparse_mat, psb_desc_type, psb_ipk_ Implicit None @@ -344,5 +371,54 @@ Module psb_z_tools_mod integer(psb_ipk_), intent(in), optional :: data End Subroutine psb_lz_par_csr_spspmm end interface psb_par_spspmm + + interface psb_glob_transpose + subroutine psb_z_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) + import + type(psb_z_coo_sparse_mat), intent(inout) :: ain + type(psb_desc_type), intent(inout), target :: desc_r + type(psb_z_coo_sparse_mat), intent(out), optional :: atrans + type(psb_desc_type), intent(inout), target, optional :: desc_c + type(psb_desc_type), intent(out), optional :: desc_rx + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_coo_glob_transpose + subroutine psb_lz_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) + import + type(psb_lz_coo_sparse_mat), intent(inout) :: ain + type(psb_desc_type), intent(inout), target :: desc_r + type(psb_lz_coo_sparse_mat), intent(out), optional :: atrans + type(psb_desc_type), intent(inout), target, optional :: desc_c + type(psb_desc_type), intent(out), optional :: desc_rx + integer(psb_ipk_), intent(out) :: info + end subroutine psb_lz_coo_glob_transpose + subroutine psb_lz_simple_glob_transpose(ain,aout,desc_a,info) + import + type(psb_lzspmat_type), intent(in) :: ain + type(psb_lzspmat_type), intent(out) :: aout + type(psb_desc_type) :: desc_a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_lz_simple_glob_transpose + subroutine psb_lz_simple_glob_transpose_ip(ain,desc_a,info) + import + type(psb_lzspmat_type), intent(inout) :: ain + type(psb_desc_type) :: desc_a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_lz_simple_glob_transpose_ip + subroutine psb_z_simple_glob_transpose(ain,aout,desc_a,info) + import + type(psb_zspmat_type), intent(in) :: ain + type(psb_zspmat_type), intent(out) :: aout + type(psb_desc_type) :: desc_a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_simple_glob_transpose + subroutine psb_z_simple_glob_transpose_ip(ain,desc_a,info) + import + type(psb_zspmat_type), intent(inout) :: ain + type(psb_desc_type) :: desc_a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_simple_glob_transpose_ip + end interface psb_glob_transpose + + end module psb_z_tools_mod diff --git a/base/serial/Makefile b/base/serial/Makefile index 1ce9156bb..5bff0b64a 100644 --- a/base/serial/Makefile +++ b/base/serial/Makefile @@ -29,12 +29,12 @@ lib: impld sortd lib1 $(FOBJS) lib1: $(FOBJS) impld: - cd impl && $(MAKE) lib + $(MAKE) -C impl lib sortd: - cd sort && $(MAKE) lib + $(MAKE) -C sort lib clean: /bin/rm -f $(FOBJS) *$(.mod) - (cd impl; $(MAKE) clean) - (cd sort; $(MAKE) clean) + ($(MAKE) -C impl clean) + ($(MAKE) -C sort clean) veryclean: clean diff --git a/base/serial/impl/psb_c_coo_impl.f90 b/base/serial/impl/psb_c_coo_impl.F90 similarity index 97% rename from base/serial/impl/psb_c_coo_impl.f90 rename to base/serial/impl/psb_c_coo_impl.F90 index f4240d3d2..88bdb66fe 100644 --- a/base/serial/impl/psb_c_coo_impl.f90 +++ b/base/serial/impl/psb_c_coo_impl.F90 @@ -407,6 +407,38 @@ subroutine psb_c_coo_reallocate_nz(nz,a) end subroutine psb_c_coo_reallocate_nz +subroutine psb_c_coo_ensure_size(nz,a) + use psb_c_base_mat_mod, psb_protect_name => psb_c_coo_ensure_size + use psb_error_mod + use psb_realloc_mod + implicit none + integer(psb_ipk_), intent(in) :: nz + class(psb_c_coo_sparse_mat), intent(inout) :: a + integer(psb_ipk_) :: err_act, info, nz_ + character(len=20) :: name='c_coo_ensure_size' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + nz_ = max(nz,ione) + call psb_ensure_size(nz_,a%ia,info) + if (info == psb_success_) call psb_ensure_size(nz_,a%ja,info) + if (info == psb_success_) call psb_ensure_size(nz_,a%val,info) + + if (info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_c_coo_ensure_size + subroutine psb_c_coo_mold(a,b,info) use psb_c_base_mat_mod, psb_protect_name => psb_c_coo_mold use psb_error_mod @@ -540,7 +572,44 @@ subroutine psb_c_coo_clean_zeros(a, info) call a%trim() end subroutine psb_c_coo_clean_zeros +subroutine psb_c_coo_clean_negidx(a,info) + use psb_error_mod + use psb_c_base_mat_mod, psb_protect_name => psb_c_coo_clean_negidx + implicit none + class(psb_c_coo_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + ! + ! + integer(psb_ipk_) :: nz + call psb_coo_clean_negidx_inner(a%get_nzeros(),a%ia,a%ja,a%val,nz,info) + if (info == 0) call a%set_nzeros(nz) +end subroutine psb_c_coo_clean_negidx + +subroutine psb_c_coo_clean_negidx_inner(nzin,ia,ja,val,nzout,info) + use psb_error_mod + use psb_c_base_mat_mod, psb_protect_name => psb_c_coo_clean_negidx_inner + implicit none + integer(psb_ipk_), intent(in) :: nzin + integer(psb_ipk_), intent(inout) :: ia(:), ja(:) + complex(psb_spk_), intent(inout) :: val(:) + integer(psb_ipk_), intent(out) :: nzout + integer(psb_ipk_), intent(out) :: info + ! + ! + integer(psb_ipk_) :: i + info = 0 + nzout = 0 + do i=1, nzin + if ((ia(i)>0).and.(ja(i)>0)) then + nzout = nzout + 1 + val(nzout) = val(i) + ia(nzout) = ia(i) + ja(nzout) = ja(i) + end if + end do + +end subroutine psb_c_coo_clean_negidx_inner subroutine psb_c_coo_allocate_mnnz(m,n,a,nz) use psb_c_base_mat_mod, psb_protect_name => psb_c_coo_allocate_mnnz @@ -610,17 +679,15 @@ subroutine psb_c_coo_print(iout,a,iv,head,ivr,ivc) integer(psb_ipk_), intent(in) :: iout class(psb_c_coo_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act character(len=20) :: name='c_coo_print' logical, parameter :: debug=.false. - - character(len=*), parameter :: datatype='complex' - character(len=80) :: frmtv - integer(psb_ipk_) :: i,j, nmx, ni, nr, nc, nz + character(len=80) :: frmt + integer(psb_ipk_) :: i,j, ni, nr, nc, nz write(iout,'(a)') '%%MatrixMarket matrix coordinate complex general' if (present(head)) write(iout,'(a,a)') '% ',head @@ -632,38 +699,29 @@ subroutine psb_c_coo_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 + frmt = psb_c_get_print_frmt(nr,nc,nz,iv,ivr,ivc) - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if write(iout,*) nr, nc, nz if(present(iv)) then do j=1,a%get_nzeros() - write(iout,frmtv) iv(a%ia(j)),iv(a%ja(j)),a%val(j) + write(iout,frmt) iv(a%ia(j)),iv(a%ja(j)),a%val(j) enddo else if (present(ivr).and..not.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) ivr(a%ia(j)),a%ja(j),a%val(j) + write(iout,frmt) ivr(a%ia(j)),a%ja(j),a%val(j) enddo else if (present(ivr).and.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) ivr(a%ia(j)),ivc(a%ja(j)),a%val(j) + write(iout,frmt) ivr(a%ia(j)),ivc(a%ja(j)),a%val(j) enddo else if (.not.present(ivr).and.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) a%ia(j),ivc(a%ja(j)),a%val(j) + write(iout,frmt) a%ia(j),ivc(a%ja(j)),a%val(j) enddo else if (.not.present(ivr).and..not.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) a%ia(j),a%ja(j),a%val(j) + write(iout,frmt) a%ia(j),a%ja(j),a%val(j) enddo endif endif @@ -1777,7 +1835,7 @@ subroutine psb_c_coo_csmm(alpha,a,x,beta,y,info,trans) end if !.....end testing on alpha - else if (ctra) then + else if (ctra) then ! if (alpha == cone) then i = 1 @@ -4910,6 +4968,38 @@ subroutine psb_lc_coo_reallocate_nz(nz,a) end subroutine psb_lc_coo_reallocate_nz +subroutine psb_lc_coo_ensure_size(nz,a) + use psb_c_base_mat_mod, psb_protect_name => psb_lc_coo_ensure_size + use psb_error_mod + use psb_realloc_mod + implicit none + integer(psb_lpk_), intent(in) :: nz + class(psb_lc_coo_sparse_mat), intent(inout) :: a + integer(psb_ipk_) :: err_act, info, nz_ + character(len=20) :: name='lc_coo_ensure_size' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + nz_ = max(nz,ione) + call psb_ensure_size(nz_,a%ia,info) + if (info == psb_success_) call psb_ensure_size(nz_,a%ja,info) + if (info == psb_success_) call psb_ensure_size(nz_,a%val,info) + + if (info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_lc_coo_ensure_size + subroutine psb_lc_coo_mold(a,b,info) use psb_c_base_mat_mod, psb_protect_name => psb_lc_coo_mold use psb_error_mod @@ -5044,7 +5134,46 @@ subroutine psb_lc_coo_clean_zeros(a, info) call a%trim() end subroutine psb_lc_coo_clean_zeros +subroutine psb_lc_coo_clean_negidx(a,info) + use psb_error_mod + use psb_c_base_mat_mod, psb_protect_name => psb_lc_coo_clean_negidx + implicit none + class(psb_lc_coo_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + ! + ! + integer(psb_lpk_) :: nz + call psb_coo_clean_negidx_inner(a%get_nzeros(),a%ia,a%ja,a%val,nz,info) + if (info == 0) call a%set_nzeros(nz) +end subroutine psb_lc_coo_clean_negidx + +#if defined(IPK4) && defined(LPK8) +subroutine psb_lc_coo_clean_negidx_inner(nzin,ia,ja,val,nzout,info) + use psb_error_mod + use psb_c_base_mat_mod, psb_protect_name => psb_lc_coo_clean_negidx_inner + implicit none + integer(psb_lpk_), intent(in) :: nzin + integer(psb_lpk_), intent(inout) :: ia(:), ja(:) + complex(psb_spk_), intent(inout) :: val(:) + integer(psb_lpk_), intent(out) :: nzout + integer(psb_ipk_), intent(out) :: info + ! + ! + integer(psb_lpk_) :: i + info = 0 + nzout = 0 + do i=1, nzin + if ((ia(i)>0).and.(ja(i)>0)) then + nzout = nzout + 1 + val(nzout) = val(i) + ia(nzout) = ia(i) + ja(nzout) = ja(i) + end if + end do + +end subroutine psb_lc_coo_clean_negidx_inner +#endif subroutine psb_lc_coo_allocate_mnnz(m,n,a,nz) use psb_c_base_mat_mod, psb_protect_name => psb_lc_coo_allocate_mnnz @@ -5123,9 +5252,8 @@ subroutine psb_lc_coo_print(iout,a,iv,head,ivr,ivc) character(len=20) :: name='lc_coo_print' logical, parameter :: debug=.false. - character(len=*), parameter :: datatype='complex' - character(len=80) :: frmtv - integer(psb_lpk_) :: i,j, nmx, ni, nr, nc, nz + character(len=80) :: frmt + integer(psb_lpk_) :: i,j, ni, nr, nc, nz write(iout,'(a)') '%%MatrixMarket matrix coordinate complex general' if (present(head)) write(iout,'(a,a)') '% ',head @@ -5137,38 +5265,29 @@ subroutine psb_lc_coo_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 + frmt = psb_lc_get_print_frmt(nr,nc,nz,iv,ivr,ivc) - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if write(iout,*) nr, nc, nz if(present(iv)) then do j=1,a%get_nzeros() - write(iout,frmtv) iv(a%ia(j)),iv(a%ja(j)),a%val(j) + write(iout,frmt) iv(a%ia(j)),iv(a%ja(j)),a%val(j) enddo else if (present(ivr).and..not.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) ivr(a%ia(j)),a%ja(j),a%val(j) + write(iout,frmt) ivr(a%ia(j)),a%ja(j),a%val(j) enddo else if (present(ivr).and.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) ivr(a%ia(j)),ivc(a%ja(j)),a%val(j) + write(iout,frmt) ivr(a%ia(j)),ivc(a%ja(j)),a%val(j) enddo else if (.not.present(ivr).and.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) a%ia(j),ivc(a%ja(j)),a%val(j) + write(iout,frmt) a%ia(j),ivc(a%ja(j)),a%val(j) enddo else if (.not.present(ivr).and..not.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) a%ia(j),a%ja(j),a%val(j) + write(iout,frmt) a%ia(j),a%ja(j),a%val(j) enddo endif endif diff --git a/base/serial/impl/psb_c_csc_impl.f90 b/base/serial/impl/psb_c_csc_impl.f90 index 62f0b738e..4769f5ff4 100644 --- a/base/serial/impl/psb_c_csc_impl.f90 +++ b/base/serial/impl/psb_c_csc_impl.f90 @@ -2706,9 +2706,9 @@ subroutine psb_c_csc_print(iout,a,iv,head,ivr,ivc) integer(psb_ipk_), intent(in) :: iout class(psb_c_csc_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act integer(psb_ipk_) :: ierr(5) @@ -2716,7 +2716,7 @@ subroutine psb_c_csc_print(iout,a,iv,head,ivr,ivc) logical, parameter :: debug=.false. character(len=*), parameter :: datatype='complex' - character(len=80) :: frmtv + character(len=80) :: frmt integer(psb_ipk_) :: i,j, nmx, ni, nr, nc, nz @@ -2730,47 +2730,37 @@ subroutine psb_c_csc_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 - - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if + frmt = psb_c_get_print_frmt(nr,nc,nz,iv,ivr,ivc) write(iout,*) nr, nc, nz if(present(iv)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) iv(a%ia(j)),iv(i),a%val(j) + write(iout,frmt) iv(a%ia(j)),iv(i),a%val(j) end do enddo else if (present(ivr).and..not.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) ivr(a%ia(j)),i,a%val(j) + write(iout,frmt) ivr(a%ia(j)),i,a%val(j) end do enddo else if (present(ivr).and.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) ivr(a%ia(j)),ivc(i),a%val(j) + write(iout,frmt) ivr(a%ia(j)),ivc(i),a%val(j) end do enddo else if (.not.present(ivr).and.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) (a%ia(j)),ivc(i),a%val(j) + write(iout,frmt) (a%ia(j)),ivc(i),a%val(j) end do enddo else if (.not.present(ivr).and..not.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) (a%ia(j)),(i),a%val(j) + write(iout,frmt) (a%ia(j)),(i),a%val(j) end do enddo endif @@ -3064,6 +3054,7 @@ subroutine psb_lc_csc_scals(d,a,info) end subroutine psb_lc_csc_scals + function psb_lc_csc_maxval(a) result(res) use psb_error_mod use psb_c_csc_mat_mod, psb_protect_name => psb_lc_csc_maxval @@ -4563,10 +4554,8 @@ subroutine psb_lc_csc_print(iout,a,iv,head,ivr,ivc) integer(psb_ipk_) :: ierr(5) character(len=20) :: name='lc_csc_print' logical, parameter :: debug=.false. - - character(len=*), parameter :: datatype='complex' - character(len=80) :: frmtv - integer(psb_ipk_) :: i,j, nmx, ni, nr, nc, nz + character(len=80) :: frmt + integer(psb_lpk_) :: i,j, ni, nr, nc, nz write(iout,'(a)') '%%MatrixMarket matrix coordinate complex general' @@ -4579,47 +4568,38 @@ subroutine psb_lc_csc_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 + frmt = psb_lc_get_print_frmt(nr,nc,nz,iv,ivr,ivc) - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if write(iout,*) nr, nc, nz if(present(iv)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) iv(a%ia(j)),iv(i),a%val(j) + write(iout,frmt) iv(a%ia(j)),iv(i),a%val(j) end do enddo else if (present(ivr).and..not.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) ivr(a%ia(j)),i,a%val(j) + write(iout,frmt) ivr(a%ia(j)),i,a%val(j) end do enddo else if (present(ivr).and.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) ivr(a%ia(j)),ivc(i),a%val(j) + write(iout,frmt) ivr(a%ia(j)),ivc(i),a%val(j) end do enddo else if (.not.present(ivr).and.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) (a%ia(j)),ivc(i),a%val(j) + write(iout,frmt) (a%ia(j)),ivc(i),a%val(j) end do enddo else if (.not.present(ivr).and..not.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) (a%ia(j)),(i),a%val(j) + write(iout,frmt) (a%ia(j)),(i),a%val(j) end do enddo endif diff --git a/base/serial/impl/psb_c_csr_impl.f90 b/base/serial/impl/psb_c_csr_impl.f90 index 2c333b38f..7b2f61a2a 100644 --- a/base/serial/impl/psb_c_csr_impl.f90 +++ b/base/serial/impl/psb_c_csr_impl.f90 @@ -1677,6 +1677,9 @@ subroutine psb_c_csr_scals(d,a,info) end subroutine psb_c_csr_scals + + + ! == =================================== ! ! @@ -2747,21 +2750,21 @@ end subroutine psb_c_csr_trim subroutine psb_c_csr_print(iout,a,iv,head,ivr,ivc) use psb_string_mod + use psb_c_base_mat_mod use psb_c_csr_mat_mod, psb_protect_name => psb_c_csr_print implicit none integer(psb_ipk_), intent(in) :: iout class(psb_c_csr_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act character(len=20) :: name='c_csr_print' logical, parameter :: debug=.false. - character(len=*), parameter :: datatype='complex' - character(len=80) :: frmtv - integer(psb_ipk_) :: irs,ics,i,j, nmx, ni, nr, nc, nz + character(len=80) :: frmt + integer(psb_ipk_) :: irs,ics,i,j, ni, nr, nc, nz write(iout,'(a)') '%%MatrixMarket matrix coordinate complex general' @@ -2774,47 +2777,38 @@ subroutine psb_c_csr_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 + frmt = psb_c_get_print_frmt(nr,nc,nz,iv,ivr,ivc) - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if write(iout,*) nr, nc, nz if(present(iv)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) iv(i),iv(a%ja(j)),a%val(j) + write(iout,frmt) iv(i),iv(a%ja(j)),a%val(j) end do enddo else if (present(ivr).and..not.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) ivr(i),(a%ja(j)),a%val(j) + write(iout,frmt) ivr(i),(a%ja(j)),a%val(j) end do enddo else if (present(ivr).and.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) ivr(i),ivc(a%ja(j)),a%val(j) + write(iout,frmt) ivr(i),ivc(a%ja(j)),a%val(j) end do enddo else if (.not.present(ivr).and.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) (i),ivc(a%ja(j)),a%val(j) + write(iout,frmt) (i),ivc(a%ja(j)),a%val(j) end do enddo else if (.not.present(ivr).and..not.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) (i),(a%ja(j)),a%val(j) + write(iout,frmt) (i),(a%ja(j)),a%val(j) end do enddo endif @@ -4883,9 +4877,8 @@ subroutine psb_lc_csr_print(iout,a,iv,head,ivr,ivc) integer(psb_ipk_) :: err_act character(len=20) :: name='lc_csr_print' logical, parameter :: debug=.false. - character(len=*), parameter :: datatype='complex' - character(len=80) :: frmtv - integer(psb_lpk_) :: irs,ics,i,j, nmx, ni, nr, nc, nz + character(len=80) :: frmt + integer(psb_lpk_) :: irs,ics,i,j, ni, nr, nc, nz write(iout,'(a)') '%%MatrixMarket matrix coordinate complex general' @@ -4898,47 +4891,38 @@ subroutine psb_lc_csr_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 + frmt = psb_lc_get_print_frmt(nr,nc,nz,iv,ivr,ivc) - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if write(iout,*) nr, nc, nz if(present(iv)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) iv(i),iv(a%ja(j)),a%val(j) + write(iout,frmt) iv(i),iv(a%ja(j)),a%val(j) end do enddo else if (present(ivr).and..not.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) ivr(i),(a%ja(j)),a%val(j) + write(iout,frmt) ivr(i),(a%ja(j)),a%val(j) end do enddo else if (present(ivr).and.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) ivr(i),ivc(a%ja(j)),a%val(j) + write(iout,frmt) ivr(i),ivc(a%ja(j)),a%val(j) end do enddo else if (.not.present(ivr).and.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) (i),ivc(a%ja(j)),a%val(j) + write(iout,frmt) (i),ivc(a%ja(j)),a%val(j) end do enddo else if (.not.present(ivr).and..not.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) (i),(a%ja(j)),a%val(j) + write(iout,frmt) (i),(a%ja(j)),a%val(j) end do enddo endif diff --git a/base/serial/impl/psb_c_mat_impl.F90 b/base/serial/impl/psb_c_mat_impl.F90 index 5663bc29b..69c67d028 100644 --- a/base/serial/impl/psb_c_mat_impl.F90 +++ b/base/serial/impl/psb_c_mat_impl.F90 @@ -466,9 +466,9 @@ subroutine psb_c_sparse_print(iout,a,iv,head,ivr,ivc) integer(psb_ipk_), intent(in) :: iout class(psb_cspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act, info character(len=20) :: name='sparse_print' @@ -500,9 +500,9 @@ subroutine psb_c_n_sparse_print(fname,a,iv,head,ivr,ivc) character(len=*), intent(in) :: fname class(psb_cspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act, info, iout logical :: isopen @@ -1098,6 +1098,53 @@ subroutine psb_c_csclip(a,b,info,& end subroutine psb_c_csclip +subroutine psb_c_csclip_ip(a,info,& + & imin,imax,jmin,jmax,rscale,cscale) + ! Output is always in COO format + use psb_error_mod + use psb_const_mod + use psb_c_base_mat_mod + use psb_c_mat_mod, psb_protect_name => psb_c_csclip_ip + implicit none + + class(psb_cspmat_type), intent(inout) :: a + integer(psb_ipk_),intent(out) :: info + integer(psb_ipk_), intent(in), optional :: imin,imax,jmin,jmax + logical, intent(in), optional :: rscale,cscale + + integer(psb_ipk_) :: err_act + character(len=20) :: name='csclip' + logical, parameter :: debug=.false. + type(psb_c_coo_sparse_mat), allocatable :: acoo + + info = psb_success_ + call psb_erractionsave(err_act) + if (a%is_null()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + allocate(acoo,stat=info) + if (info == psb_success_) then + call a%a%csclip(acoo,info,& + & imin,imax,jmin,jmax,rscale,cscale) + else + info = psb_err_alloc_dealloc_ + end if + if (info == psb_success_) call a%free() + if (info == psb_success_) call move_alloc(acoo,a%a) + if (info /= psb_success_) goto 9999 + + call psb_erractionrestore(err_act) + return + + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_c_csclip_ip subroutine psb_c_b_csclip(a,b,info,& & imin,imax,jmin,jmax,rscale,cscale) @@ -2602,6 +2649,8 @@ subroutine psb_c_mv_from_lb(a,b) class(psb_cspmat_type), intent(inout) :: a class(psb_lc_base_sparse_mat), intent(inout) :: b integer(psb_ipk_) :: info + + info = psb_success_ if (.not.allocated(a%a)) allocate(psb_c_csr_sparse_mat :: a%a, stat=info) if (info == psb_success_) call a%a%mv_from_lfmt(b,info) @@ -2618,6 +2667,7 @@ subroutine psb_c_cp_from_lb(a,b) class(psb_lc_base_sparse_mat), intent(inout) :: b integer(psb_ipk_) :: info + info = psb_success_ if (.not.allocated(a%a)) allocate(psb_c_csr_sparse_mat :: a%a, stat=info) if (info == psb_success_) call a%a%cp_from_lfmt(b,info) @@ -2668,6 +2718,7 @@ subroutine psb_c_mv_from_l(a,b) class(psb_lcspmat_type), intent(inout) :: b integer(psb_ipk_) :: info + info = psb_success_ if (allocated(b%a)) then if (.not.allocated(a%a)) allocate(psb_c_csr_sparse_mat :: a%a, stat=info) call a%a%mv_from_lfmt(b%a,info) @@ -2689,6 +2740,7 @@ subroutine psb_c_cp_from_l(a,b) class(psb_lcspmat_type), intent(in) :: b integer(psb_ipk_) :: info + info = psb_success_ if (allocated(b%a)) then if (.not.allocated(a%a)) allocate(psb_c_csr_sparse_mat :: a%a, stat=info) call a%a%cp_from_lfmt(b%a,info) @@ -3845,6 +3897,53 @@ subroutine psb_lc_csclip(a,b,info,& end subroutine psb_lc_csclip +subroutine psb_lc_csclip_ip(a,info,& + & imin,imax,jmin,jmax,rscale,cscale) + ! Output is always in COO format + use psb_error_mod + use psb_const_mod + use psb_c_base_mat_mod + use psb_c_mat_mod, psb_protect_name => psb_lc_csclip_ip + implicit none + + class(psb_lcspmat_type), intent(inout) :: a + integer(psb_ipk_),intent(out) :: info + integer(psb_lpk_), intent(in), optional :: imin,imax,jmin,jmax + logical, intent(in), optional :: rscale,cscale + + integer(psb_ipk_) :: err_act + character(len=20) :: name='csclip' + logical, parameter :: debug=.false. + type(psb_lc_coo_sparse_mat), allocatable :: acoo + + info = psb_success_ + call psb_erractionsave(err_act) + if (a%is_null()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + allocate(acoo,stat=info) + if (info == psb_success_) then + call a%a%csclip(acoo,info,& + & imin,imax,jmin,jmax,rscale,cscale) + else + info = psb_err_alloc_dealloc_ + end if + if (info == psb_success_) call a%free() + if (info == psb_success_) call move_alloc(acoo,a%a) + if (info /= psb_success_) goto 9999 + + call psb_erractionrestore(err_act) + return + + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_lc_csclip_ip subroutine psb_lc_b_csclip(a,b,info,& & imin,imax,jmin,jmax,rscale,cscale) @@ -5100,6 +5199,8 @@ subroutine psb_lc_mv_from_ib(a,b) class(psb_lcspmat_type), intent(inout) :: a class(psb_c_base_sparse_mat), intent(inout) :: b integer(psb_ipk_) :: info + + info = psb_success_ if (.not.allocated(a%a)) allocate(psb_lc_csr_sparse_mat :: a%a, stat=info) if (info == psb_success_) call a%a%mv_from_ifmt(b,info) @@ -5115,6 +5216,7 @@ subroutine psb_lc_cp_from_ib(a,b) class(psb_c_base_sparse_mat), intent(inout) :: b integer(psb_ipk_) :: info + info = psb_success_ if (.not.allocated(a%a)) allocate(psb_lc_csr_sparse_mat :: a%a, stat=info) if (info == psb_success_) call a%a%cp_from_ifmt(b,info) diff --git a/base/serial/impl/psb_d_coo_impl.f90 b/base/serial/impl/psb_d_coo_impl.F90 similarity index 97% rename from base/serial/impl/psb_d_coo_impl.f90 rename to base/serial/impl/psb_d_coo_impl.F90 index aeddc6f3c..cd5ea5a80 100644 --- a/base/serial/impl/psb_d_coo_impl.f90 +++ b/base/serial/impl/psb_d_coo_impl.F90 @@ -407,6 +407,38 @@ subroutine psb_d_coo_reallocate_nz(nz,a) end subroutine psb_d_coo_reallocate_nz +subroutine psb_d_coo_ensure_size(nz,a) + use psb_d_base_mat_mod, psb_protect_name => psb_d_coo_ensure_size + use psb_error_mod + use psb_realloc_mod + implicit none + integer(psb_ipk_), intent(in) :: nz + class(psb_d_coo_sparse_mat), intent(inout) :: a + integer(psb_ipk_) :: err_act, info, nz_ + character(len=20) :: name='d_coo_ensure_size' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + nz_ = max(nz,ione) + call psb_ensure_size(nz_,a%ia,info) + if (info == psb_success_) call psb_ensure_size(nz_,a%ja,info) + if (info == psb_success_) call psb_ensure_size(nz_,a%val,info) + + if (info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_d_coo_ensure_size + subroutine psb_d_coo_mold(a,b,info) use psb_d_base_mat_mod, psb_protect_name => psb_d_coo_mold use psb_error_mod @@ -540,7 +572,44 @@ subroutine psb_d_coo_clean_zeros(a, info) call a%trim() end subroutine psb_d_coo_clean_zeros +subroutine psb_d_coo_clean_negidx(a,info) + use psb_error_mod + use psb_d_base_mat_mod, psb_protect_name => psb_d_coo_clean_negidx + implicit none + class(psb_d_coo_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + ! + ! + integer(psb_ipk_) :: nz + call psb_coo_clean_negidx_inner(a%get_nzeros(),a%ia,a%ja,a%val,nz,info) + if (info == 0) call a%set_nzeros(nz) +end subroutine psb_d_coo_clean_negidx + +subroutine psb_d_coo_clean_negidx_inner(nzin,ia,ja,val,nzout,info) + use psb_error_mod + use psb_d_base_mat_mod, psb_protect_name => psb_d_coo_clean_negidx_inner + implicit none + integer(psb_ipk_), intent(in) :: nzin + integer(psb_ipk_), intent(inout) :: ia(:), ja(:) + real(psb_dpk_), intent(inout) :: val(:) + integer(psb_ipk_), intent(out) :: nzout + integer(psb_ipk_), intent(out) :: info + ! + ! + integer(psb_ipk_) :: i + info = 0 + nzout = 0 + do i=1, nzin + if ((ia(i)>0).and.(ja(i)>0)) then + nzout = nzout + 1 + val(nzout) = val(i) + ia(nzout) = ia(i) + ja(nzout) = ja(i) + end if + end do + +end subroutine psb_d_coo_clean_negidx_inner subroutine psb_d_coo_allocate_mnnz(m,n,a,nz) use psb_d_base_mat_mod, psb_protect_name => psb_d_coo_allocate_mnnz @@ -610,17 +679,15 @@ subroutine psb_d_coo_print(iout,a,iv,head,ivr,ivc) integer(psb_ipk_), intent(in) :: iout class(psb_d_coo_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act character(len=20) :: name='d_coo_print' logical, parameter :: debug=.false. - - character(len=*), parameter :: datatype='real' - character(len=80) :: frmtv - integer(psb_ipk_) :: i,j, nmx, ni, nr, nc, nz + character(len=80) :: frmt + integer(psb_ipk_) :: i,j, ni, nr, nc, nz write(iout,'(a)') '%%MatrixMarket matrix coordinate real general' if (present(head)) write(iout,'(a,a)') '% ',head @@ -632,38 +699,29 @@ subroutine psb_d_coo_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 + frmt = psb_d_get_print_frmt(nr,nc,nz,iv,ivr,ivc) - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if write(iout,*) nr, nc, nz if(present(iv)) then do j=1,a%get_nzeros() - write(iout,frmtv) iv(a%ia(j)),iv(a%ja(j)),a%val(j) + write(iout,frmt) iv(a%ia(j)),iv(a%ja(j)),a%val(j) enddo else if (present(ivr).and..not.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) ivr(a%ia(j)),a%ja(j),a%val(j) + write(iout,frmt) ivr(a%ia(j)),a%ja(j),a%val(j) enddo else if (present(ivr).and.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) ivr(a%ia(j)),ivc(a%ja(j)),a%val(j) + write(iout,frmt) ivr(a%ia(j)),ivc(a%ja(j)),a%val(j) enddo else if (.not.present(ivr).and.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) a%ia(j),ivc(a%ja(j)),a%val(j) + write(iout,frmt) a%ia(j),ivc(a%ja(j)),a%val(j) enddo else if (.not.present(ivr).and..not.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) a%ia(j),a%ja(j),a%val(j) + write(iout,frmt) a%ia(j),a%ja(j),a%val(j) enddo endif endif @@ -1777,7 +1835,7 @@ subroutine psb_d_coo_csmm(alpha,a,x,beta,y,info,trans) end if !.....end testing on alpha - else if (ctra) then + else if (ctra) then ! if (alpha == done) then i = 1 @@ -4910,6 +4968,38 @@ subroutine psb_ld_coo_reallocate_nz(nz,a) end subroutine psb_ld_coo_reallocate_nz +subroutine psb_ld_coo_ensure_size(nz,a) + use psb_d_base_mat_mod, psb_protect_name => psb_ld_coo_ensure_size + use psb_error_mod + use psb_realloc_mod + implicit none + integer(psb_lpk_), intent(in) :: nz + class(psb_ld_coo_sparse_mat), intent(inout) :: a + integer(psb_ipk_) :: err_act, info, nz_ + character(len=20) :: name='ld_coo_ensure_size' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + nz_ = max(nz,ione) + call psb_ensure_size(nz_,a%ia,info) + if (info == psb_success_) call psb_ensure_size(nz_,a%ja,info) + if (info == psb_success_) call psb_ensure_size(nz_,a%val,info) + + if (info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_ld_coo_ensure_size + subroutine psb_ld_coo_mold(a,b,info) use psb_d_base_mat_mod, psb_protect_name => psb_ld_coo_mold use psb_error_mod @@ -5044,7 +5134,46 @@ subroutine psb_ld_coo_clean_zeros(a, info) call a%trim() end subroutine psb_ld_coo_clean_zeros +subroutine psb_ld_coo_clean_negidx(a,info) + use psb_error_mod + use psb_d_base_mat_mod, psb_protect_name => psb_ld_coo_clean_negidx + implicit none + class(psb_ld_coo_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + ! + ! + integer(psb_lpk_) :: nz + call psb_coo_clean_negidx_inner(a%get_nzeros(),a%ia,a%ja,a%val,nz,info) + if (info == 0) call a%set_nzeros(nz) +end subroutine psb_ld_coo_clean_negidx + +#if defined(IPK4) && defined(LPK8) +subroutine psb_ld_coo_clean_negidx_inner(nzin,ia,ja,val,nzout,info) + use psb_error_mod + use psb_d_base_mat_mod, psb_protect_name => psb_ld_coo_clean_negidx_inner + implicit none + integer(psb_lpk_), intent(in) :: nzin + integer(psb_lpk_), intent(inout) :: ia(:), ja(:) + real(psb_dpk_), intent(inout) :: val(:) + integer(psb_lpk_), intent(out) :: nzout + integer(psb_ipk_), intent(out) :: info + ! + ! + integer(psb_lpk_) :: i + info = 0 + nzout = 0 + do i=1, nzin + if ((ia(i)>0).and.(ja(i)>0)) then + nzout = nzout + 1 + val(nzout) = val(i) + ia(nzout) = ia(i) + ja(nzout) = ja(i) + end if + end do + +end subroutine psb_ld_coo_clean_negidx_inner +#endif subroutine psb_ld_coo_allocate_mnnz(m,n,a,nz) use psb_d_base_mat_mod, psb_protect_name => psb_ld_coo_allocate_mnnz @@ -5123,9 +5252,8 @@ subroutine psb_ld_coo_print(iout,a,iv,head,ivr,ivc) character(len=20) :: name='ld_coo_print' logical, parameter :: debug=.false. - character(len=*), parameter :: datatype='real' - character(len=80) :: frmtv - integer(psb_lpk_) :: i,j, nmx, ni, nr, nc, nz + character(len=80) :: frmt + integer(psb_lpk_) :: i,j, ni, nr, nc, nz write(iout,'(a)') '%%MatrixMarket matrix coordinate real general' if (present(head)) write(iout,'(a,a)') '% ',head @@ -5137,38 +5265,29 @@ subroutine psb_ld_coo_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 + frmt = psb_ld_get_print_frmt(nr,nc,nz,iv,ivr,ivc) - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if write(iout,*) nr, nc, nz if(present(iv)) then do j=1,a%get_nzeros() - write(iout,frmtv) iv(a%ia(j)),iv(a%ja(j)),a%val(j) + write(iout,frmt) iv(a%ia(j)),iv(a%ja(j)),a%val(j) enddo else if (present(ivr).and..not.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) ivr(a%ia(j)),a%ja(j),a%val(j) + write(iout,frmt) ivr(a%ia(j)),a%ja(j),a%val(j) enddo else if (present(ivr).and.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) ivr(a%ia(j)),ivc(a%ja(j)),a%val(j) + write(iout,frmt) ivr(a%ia(j)),ivc(a%ja(j)),a%val(j) enddo else if (.not.present(ivr).and.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) a%ia(j),ivc(a%ja(j)),a%val(j) + write(iout,frmt) a%ia(j),ivc(a%ja(j)),a%val(j) enddo else if (.not.present(ivr).and..not.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) a%ia(j),a%ja(j),a%val(j) + write(iout,frmt) a%ia(j),a%ja(j),a%val(j) enddo endif endif diff --git a/base/serial/impl/psb_d_csc_impl.f90 b/base/serial/impl/psb_d_csc_impl.f90 index 624332e54..eb1f2021b 100644 --- a/base/serial/impl/psb_d_csc_impl.f90 +++ b/base/serial/impl/psb_d_csc_impl.f90 @@ -2706,9 +2706,9 @@ subroutine psb_d_csc_print(iout,a,iv,head,ivr,ivc) integer(psb_ipk_), intent(in) :: iout class(psb_d_csc_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act integer(psb_ipk_) :: ierr(5) @@ -2716,7 +2716,7 @@ subroutine psb_d_csc_print(iout,a,iv,head,ivr,ivc) logical, parameter :: debug=.false. character(len=*), parameter :: datatype='real' - character(len=80) :: frmtv + character(len=80) :: frmt integer(psb_ipk_) :: i,j, nmx, ni, nr, nc, nz @@ -2730,47 +2730,37 @@ subroutine psb_d_csc_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 - - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if + frmt = psb_d_get_print_frmt(nr,nc,nz,iv,ivr,ivc) write(iout,*) nr, nc, nz if(present(iv)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) iv(a%ia(j)),iv(i),a%val(j) + write(iout,frmt) iv(a%ia(j)),iv(i),a%val(j) end do enddo else if (present(ivr).and..not.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) ivr(a%ia(j)),i,a%val(j) + write(iout,frmt) ivr(a%ia(j)),i,a%val(j) end do enddo else if (present(ivr).and.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) ivr(a%ia(j)),ivc(i),a%val(j) + write(iout,frmt) ivr(a%ia(j)),ivc(i),a%val(j) end do enddo else if (.not.present(ivr).and.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) (a%ia(j)),ivc(i),a%val(j) + write(iout,frmt) (a%ia(j)),ivc(i),a%val(j) end do enddo else if (.not.present(ivr).and..not.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) (a%ia(j)),(i),a%val(j) + write(iout,frmt) (a%ia(j)),(i),a%val(j) end do enddo endif @@ -3064,6 +3054,7 @@ subroutine psb_ld_csc_scals(d,a,info) end subroutine psb_ld_csc_scals + function psb_ld_csc_maxval(a) result(res) use psb_error_mod use psb_d_csc_mat_mod, psb_protect_name => psb_ld_csc_maxval @@ -4563,10 +4554,8 @@ subroutine psb_ld_csc_print(iout,a,iv,head,ivr,ivc) integer(psb_ipk_) :: ierr(5) character(len=20) :: name='ld_csc_print' logical, parameter :: debug=.false. - - character(len=*), parameter :: datatype='real' - character(len=80) :: frmtv - integer(psb_ipk_) :: i,j, nmx, ni, nr, nc, nz + character(len=80) :: frmt + integer(psb_lpk_) :: i,j, ni, nr, nc, nz write(iout,'(a)') '%%MatrixMarket matrix coordinate real general' @@ -4579,47 +4568,38 @@ subroutine psb_ld_csc_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 + frmt = psb_ld_get_print_frmt(nr,nc,nz,iv,ivr,ivc) - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if write(iout,*) nr, nc, nz if(present(iv)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) iv(a%ia(j)),iv(i),a%val(j) + write(iout,frmt) iv(a%ia(j)),iv(i),a%val(j) end do enddo else if (present(ivr).and..not.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) ivr(a%ia(j)),i,a%val(j) + write(iout,frmt) ivr(a%ia(j)),i,a%val(j) end do enddo else if (present(ivr).and.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) ivr(a%ia(j)),ivc(i),a%val(j) + write(iout,frmt) ivr(a%ia(j)),ivc(i),a%val(j) end do enddo else if (.not.present(ivr).and.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) (a%ia(j)),ivc(i),a%val(j) + write(iout,frmt) (a%ia(j)),ivc(i),a%val(j) end do enddo else if (.not.present(ivr).and..not.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) (a%ia(j)),(i),a%val(j) + write(iout,frmt) (a%ia(j)),(i),a%val(j) end do enddo endif diff --git a/base/serial/impl/psb_d_csr_impl.f90 b/base/serial/impl/psb_d_csr_impl.f90 index 1a99ae9ab..01f36eaab 100644 --- a/base/serial/impl/psb_d_csr_impl.f90 +++ b/base/serial/impl/psb_d_csr_impl.f90 @@ -1677,6 +1677,9 @@ subroutine psb_d_csr_scals(d,a,info) end subroutine psb_d_csr_scals + + + ! == =================================== ! ! @@ -2747,21 +2750,21 @@ end subroutine psb_d_csr_trim subroutine psb_d_csr_print(iout,a,iv,head,ivr,ivc) use psb_string_mod + use psb_d_base_mat_mod use psb_d_csr_mat_mod, psb_protect_name => psb_d_csr_print implicit none integer(psb_ipk_), intent(in) :: iout class(psb_d_csr_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act character(len=20) :: name='d_csr_print' logical, parameter :: debug=.false. - character(len=*), parameter :: datatype='real' - character(len=80) :: frmtv - integer(psb_ipk_) :: irs,ics,i,j, nmx, ni, nr, nc, nz + character(len=80) :: frmt + integer(psb_ipk_) :: irs,ics,i,j, ni, nr, nc, nz write(iout,'(a)') '%%MatrixMarket matrix coordinate real general' @@ -2774,47 +2777,38 @@ subroutine psb_d_csr_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 + frmt = psb_d_get_print_frmt(nr,nc,nz,iv,ivr,ivc) - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if write(iout,*) nr, nc, nz if(present(iv)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) iv(i),iv(a%ja(j)),a%val(j) + write(iout,frmt) iv(i),iv(a%ja(j)),a%val(j) end do enddo else if (present(ivr).and..not.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) ivr(i),(a%ja(j)),a%val(j) + write(iout,frmt) ivr(i),(a%ja(j)),a%val(j) end do enddo else if (present(ivr).and.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) ivr(i),ivc(a%ja(j)),a%val(j) + write(iout,frmt) ivr(i),ivc(a%ja(j)),a%val(j) end do enddo else if (.not.present(ivr).and.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) (i),ivc(a%ja(j)),a%val(j) + write(iout,frmt) (i),ivc(a%ja(j)),a%val(j) end do enddo else if (.not.present(ivr).and..not.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) (i),(a%ja(j)),a%val(j) + write(iout,frmt) (i),(a%ja(j)),a%val(j) end do enddo endif @@ -4883,9 +4877,8 @@ subroutine psb_ld_csr_print(iout,a,iv,head,ivr,ivc) integer(psb_ipk_) :: err_act character(len=20) :: name='ld_csr_print' logical, parameter :: debug=.false. - character(len=*), parameter :: datatype='real' - character(len=80) :: frmtv - integer(psb_lpk_) :: irs,ics,i,j, nmx, ni, nr, nc, nz + character(len=80) :: frmt + integer(psb_lpk_) :: irs,ics,i,j, ni, nr, nc, nz write(iout,'(a)') '%%MatrixMarket matrix coordinate real general' @@ -4898,47 +4891,38 @@ subroutine psb_ld_csr_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 + frmt = psb_ld_get_print_frmt(nr,nc,nz,iv,ivr,ivc) - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if write(iout,*) nr, nc, nz if(present(iv)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) iv(i),iv(a%ja(j)),a%val(j) + write(iout,frmt) iv(i),iv(a%ja(j)),a%val(j) end do enddo else if (present(ivr).and..not.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) ivr(i),(a%ja(j)),a%val(j) + write(iout,frmt) ivr(i),(a%ja(j)),a%val(j) end do enddo else if (present(ivr).and.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) ivr(i),ivc(a%ja(j)),a%val(j) + write(iout,frmt) ivr(i),ivc(a%ja(j)),a%val(j) end do enddo else if (.not.present(ivr).and.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) (i),ivc(a%ja(j)),a%val(j) + write(iout,frmt) (i),ivc(a%ja(j)),a%val(j) end do enddo else if (.not.present(ivr).and..not.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) (i),(a%ja(j)),a%val(j) + write(iout,frmt) (i),(a%ja(j)),a%val(j) end do enddo endif diff --git a/base/serial/impl/psb_d_mat_impl.F90 b/base/serial/impl/psb_d_mat_impl.F90 index c8288a719..86de55367 100644 --- a/base/serial/impl/psb_d_mat_impl.F90 +++ b/base/serial/impl/psb_d_mat_impl.F90 @@ -466,9 +466,9 @@ subroutine psb_d_sparse_print(iout,a,iv,head,ivr,ivc) integer(psb_ipk_), intent(in) :: iout class(psb_dspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act, info character(len=20) :: name='sparse_print' @@ -500,9 +500,9 @@ subroutine psb_d_n_sparse_print(fname,a,iv,head,ivr,ivc) character(len=*), intent(in) :: fname class(psb_dspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act, info, iout logical :: isopen @@ -1098,6 +1098,53 @@ subroutine psb_d_csclip(a,b,info,& end subroutine psb_d_csclip +subroutine psb_d_csclip_ip(a,info,& + & imin,imax,jmin,jmax,rscale,cscale) + ! Output is always in COO format + use psb_error_mod + use psb_const_mod + use psb_d_base_mat_mod + use psb_d_mat_mod, psb_protect_name => psb_d_csclip_ip + implicit none + + class(psb_dspmat_type), intent(inout) :: a + integer(psb_ipk_),intent(out) :: info + integer(psb_ipk_), intent(in), optional :: imin,imax,jmin,jmax + logical, intent(in), optional :: rscale,cscale + + integer(psb_ipk_) :: err_act + character(len=20) :: name='csclip' + logical, parameter :: debug=.false. + type(psb_d_coo_sparse_mat), allocatable :: acoo + + info = psb_success_ + call psb_erractionsave(err_act) + if (a%is_null()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + allocate(acoo,stat=info) + if (info == psb_success_) then + call a%a%csclip(acoo,info,& + & imin,imax,jmin,jmax,rscale,cscale) + else + info = psb_err_alloc_dealloc_ + end if + if (info == psb_success_) call a%free() + if (info == psb_success_) call move_alloc(acoo,a%a) + if (info /= psb_success_) goto 9999 + + call psb_erractionrestore(err_act) + return + + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_d_csclip_ip subroutine psb_d_b_csclip(a,b,info,& & imin,imax,jmin,jmax,rscale,cscale) @@ -2602,6 +2649,8 @@ subroutine psb_d_mv_from_lb(a,b) class(psb_dspmat_type), intent(inout) :: a class(psb_ld_base_sparse_mat), intent(inout) :: b integer(psb_ipk_) :: info + + info = psb_success_ if (.not.allocated(a%a)) allocate(psb_d_csr_sparse_mat :: a%a, stat=info) if (info == psb_success_) call a%a%mv_from_lfmt(b,info) @@ -2618,6 +2667,7 @@ subroutine psb_d_cp_from_lb(a,b) class(psb_ld_base_sparse_mat), intent(inout) :: b integer(psb_ipk_) :: info + info = psb_success_ if (.not.allocated(a%a)) allocate(psb_d_csr_sparse_mat :: a%a, stat=info) if (info == psb_success_) call a%a%cp_from_lfmt(b,info) @@ -2668,6 +2718,7 @@ subroutine psb_d_mv_from_l(a,b) class(psb_ldspmat_type), intent(inout) :: b integer(psb_ipk_) :: info + info = psb_success_ if (allocated(b%a)) then if (.not.allocated(a%a)) allocate(psb_d_csr_sparse_mat :: a%a, stat=info) call a%a%mv_from_lfmt(b%a,info) @@ -2689,6 +2740,7 @@ subroutine psb_d_cp_from_l(a,b) class(psb_ldspmat_type), intent(in) :: b integer(psb_ipk_) :: info + info = psb_success_ if (allocated(b%a)) then if (.not.allocated(a%a)) allocate(psb_d_csr_sparse_mat :: a%a, stat=info) call a%a%cp_from_lfmt(b%a,info) @@ -3845,6 +3897,53 @@ subroutine psb_ld_csclip(a,b,info,& end subroutine psb_ld_csclip +subroutine psb_ld_csclip_ip(a,info,& + & imin,imax,jmin,jmax,rscale,cscale) + ! Output is always in COO format + use psb_error_mod + use psb_const_mod + use psb_d_base_mat_mod + use psb_d_mat_mod, psb_protect_name => psb_ld_csclip_ip + implicit none + + class(psb_ldspmat_type), intent(inout) :: a + integer(psb_ipk_),intent(out) :: info + integer(psb_lpk_), intent(in), optional :: imin,imax,jmin,jmax + logical, intent(in), optional :: rscale,cscale + + integer(psb_ipk_) :: err_act + character(len=20) :: name='csclip' + logical, parameter :: debug=.false. + type(psb_ld_coo_sparse_mat), allocatable :: acoo + + info = psb_success_ + call psb_erractionsave(err_act) + if (a%is_null()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + allocate(acoo,stat=info) + if (info == psb_success_) then + call a%a%csclip(acoo,info,& + & imin,imax,jmin,jmax,rscale,cscale) + else + info = psb_err_alloc_dealloc_ + end if + if (info == psb_success_) call a%free() + if (info == psb_success_) call move_alloc(acoo,a%a) + if (info /= psb_success_) goto 9999 + + call psb_erractionrestore(err_act) + return + + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_ld_csclip_ip subroutine psb_ld_b_csclip(a,b,info,& & imin,imax,jmin,jmax,rscale,cscale) @@ -5100,6 +5199,8 @@ subroutine psb_ld_mv_from_ib(a,b) class(psb_ldspmat_type), intent(inout) :: a class(psb_d_base_sparse_mat), intent(inout) :: b integer(psb_ipk_) :: info + + info = psb_success_ if (.not.allocated(a%a)) allocate(psb_ld_csr_sparse_mat :: a%a, stat=info) if (info == psb_success_) call a%a%mv_from_ifmt(b,info) @@ -5115,6 +5216,7 @@ subroutine psb_ld_cp_from_ib(a,b) class(psb_d_base_sparse_mat), intent(inout) :: b integer(psb_ipk_) :: info + info = psb_success_ if (.not.allocated(a%a)) allocate(psb_ld_csr_sparse_mat :: a%a, stat=info) if (info == psb_success_) call a%a%cp_from_ifmt(b,info) diff --git a/base/serial/impl/psb_s_coo_impl.f90 b/base/serial/impl/psb_s_coo_impl.F90 similarity index 97% rename from base/serial/impl/psb_s_coo_impl.f90 rename to base/serial/impl/psb_s_coo_impl.F90 index 31d7995e2..061fb9045 100644 --- a/base/serial/impl/psb_s_coo_impl.f90 +++ b/base/serial/impl/psb_s_coo_impl.F90 @@ -407,6 +407,38 @@ subroutine psb_s_coo_reallocate_nz(nz,a) end subroutine psb_s_coo_reallocate_nz +subroutine psb_s_coo_ensure_size(nz,a) + use psb_s_base_mat_mod, psb_protect_name => psb_s_coo_ensure_size + use psb_error_mod + use psb_realloc_mod + implicit none + integer(psb_ipk_), intent(in) :: nz + class(psb_s_coo_sparse_mat), intent(inout) :: a + integer(psb_ipk_) :: err_act, info, nz_ + character(len=20) :: name='s_coo_ensure_size' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + nz_ = max(nz,ione) + call psb_ensure_size(nz_,a%ia,info) + if (info == psb_success_) call psb_ensure_size(nz_,a%ja,info) + if (info == psb_success_) call psb_ensure_size(nz_,a%val,info) + + if (info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_s_coo_ensure_size + subroutine psb_s_coo_mold(a,b,info) use psb_s_base_mat_mod, psb_protect_name => psb_s_coo_mold use psb_error_mod @@ -540,7 +572,44 @@ subroutine psb_s_coo_clean_zeros(a, info) call a%trim() end subroutine psb_s_coo_clean_zeros +subroutine psb_s_coo_clean_negidx(a,info) + use psb_error_mod + use psb_s_base_mat_mod, psb_protect_name => psb_s_coo_clean_negidx + implicit none + class(psb_s_coo_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + ! + ! + integer(psb_ipk_) :: nz + call psb_coo_clean_negidx_inner(a%get_nzeros(),a%ia,a%ja,a%val,nz,info) + if (info == 0) call a%set_nzeros(nz) +end subroutine psb_s_coo_clean_negidx + +subroutine psb_s_coo_clean_negidx_inner(nzin,ia,ja,val,nzout,info) + use psb_error_mod + use psb_s_base_mat_mod, psb_protect_name => psb_s_coo_clean_negidx_inner + implicit none + integer(psb_ipk_), intent(in) :: nzin + integer(psb_ipk_), intent(inout) :: ia(:), ja(:) + real(psb_spk_), intent(inout) :: val(:) + integer(psb_ipk_), intent(out) :: nzout + integer(psb_ipk_), intent(out) :: info + ! + ! + integer(psb_ipk_) :: i + info = 0 + nzout = 0 + do i=1, nzin + if ((ia(i)>0).and.(ja(i)>0)) then + nzout = nzout + 1 + val(nzout) = val(i) + ia(nzout) = ia(i) + ja(nzout) = ja(i) + end if + end do + +end subroutine psb_s_coo_clean_negidx_inner subroutine psb_s_coo_allocate_mnnz(m,n,a,nz) use psb_s_base_mat_mod, psb_protect_name => psb_s_coo_allocate_mnnz @@ -610,17 +679,15 @@ subroutine psb_s_coo_print(iout,a,iv,head,ivr,ivc) integer(psb_ipk_), intent(in) :: iout class(psb_s_coo_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act character(len=20) :: name='s_coo_print' logical, parameter :: debug=.false. - - character(len=*), parameter :: datatype='real' - character(len=80) :: frmtv - integer(psb_ipk_) :: i,j, nmx, ni, nr, nc, nz + character(len=80) :: frmt + integer(psb_ipk_) :: i,j, ni, nr, nc, nz write(iout,'(a)') '%%MatrixMarket matrix coordinate real general' if (present(head)) write(iout,'(a,a)') '% ',head @@ -632,38 +699,29 @@ subroutine psb_s_coo_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 + frmt = psb_s_get_print_frmt(nr,nc,nz,iv,ivr,ivc) - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if write(iout,*) nr, nc, nz if(present(iv)) then do j=1,a%get_nzeros() - write(iout,frmtv) iv(a%ia(j)),iv(a%ja(j)),a%val(j) + write(iout,frmt) iv(a%ia(j)),iv(a%ja(j)),a%val(j) enddo else if (present(ivr).and..not.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) ivr(a%ia(j)),a%ja(j),a%val(j) + write(iout,frmt) ivr(a%ia(j)),a%ja(j),a%val(j) enddo else if (present(ivr).and.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) ivr(a%ia(j)),ivc(a%ja(j)),a%val(j) + write(iout,frmt) ivr(a%ia(j)),ivc(a%ja(j)),a%val(j) enddo else if (.not.present(ivr).and.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) a%ia(j),ivc(a%ja(j)),a%val(j) + write(iout,frmt) a%ia(j),ivc(a%ja(j)),a%val(j) enddo else if (.not.present(ivr).and..not.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) a%ia(j),a%ja(j),a%val(j) + write(iout,frmt) a%ia(j),a%ja(j),a%val(j) enddo endif endif @@ -1777,7 +1835,7 @@ subroutine psb_s_coo_csmm(alpha,a,x,beta,y,info,trans) end if !.....end testing on alpha - else if (ctra) then + else if (ctra) then ! if (alpha == sone) then i = 1 @@ -4910,6 +4968,38 @@ subroutine psb_ls_coo_reallocate_nz(nz,a) end subroutine psb_ls_coo_reallocate_nz +subroutine psb_ls_coo_ensure_size(nz,a) + use psb_s_base_mat_mod, psb_protect_name => psb_ls_coo_ensure_size + use psb_error_mod + use psb_realloc_mod + implicit none + integer(psb_lpk_), intent(in) :: nz + class(psb_ls_coo_sparse_mat), intent(inout) :: a + integer(psb_ipk_) :: err_act, info, nz_ + character(len=20) :: name='ls_coo_ensure_size' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + nz_ = max(nz,ione) + call psb_ensure_size(nz_,a%ia,info) + if (info == psb_success_) call psb_ensure_size(nz_,a%ja,info) + if (info == psb_success_) call psb_ensure_size(nz_,a%val,info) + + if (info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_ls_coo_ensure_size + subroutine psb_ls_coo_mold(a,b,info) use psb_s_base_mat_mod, psb_protect_name => psb_ls_coo_mold use psb_error_mod @@ -5044,7 +5134,46 @@ subroutine psb_ls_coo_clean_zeros(a, info) call a%trim() end subroutine psb_ls_coo_clean_zeros +subroutine psb_ls_coo_clean_negidx(a,info) + use psb_error_mod + use psb_s_base_mat_mod, psb_protect_name => psb_ls_coo_clean_negidx + implicit none + class(psb_ls_coo_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + ! + ! + integer(psb_lpk_) :: nz + call psb_coo_clean_negidx_inner(a%get_nzeros(),a%ia,a%ja,a%val,nz,info) + if (info == 0) call a%set_nzeros(nz) +end subroutine psb_ls_coo_clean_negidx + +#if defined(IPK4) && defined(LPK8) +subroutine psb_ls_coo_clean_negidx_inner(nzin,ia,ja,val,nzout,info) + use psb_error_mod + use psb_s_base_mat_mod, psb_protect_name => psb_ls_coo_clean_negidx_inner + implicit none + integer(psb_lpk_), intent(in) :: nzin + integer(psb_lpk_), intent(inout) :: ia(:), ja(:) + real(psb_spk_), intent(inout) :: val(:) + integer(psb_lpk_), intent(out) :: nzout + integer(psb_ipk_), intent(out) :: info + ! + ! + integer(psb_lpk_) :: i + info = 0 + nzout = 0 + do i=1, nzin + if ((ia(i)>0).and.(ja(i)>0)) then + nzout = nzout + 1 + val(nzout) = val(i) + ia(nzout) = ia(i) + ja(nzout) = ja(i) + end if + end do + +end subroutine psb_ls_coo_clean_negidx_inner +#endif subroutine psb_ls_coo_allocate_mnnz(m,n,a,nz) use psb_s_base_mat_mod, psb_protect_name => psb_ls_coo_allocate_mnnz @@ -5123,9 +5252,8 @@ subroutine psb_ls_coo_print(iout,a,iv,head,ivr,ivc) character(len=20) :: name='ls_coo_print' logical, parameter :: debug=.false. - character(len=*), parameter :: datatype='real' - character(len=80) :: frmtv - integer(psb_lpk_) :: i,j, nmx, ni, nr, nc, nz + character(len=80) :: frmt + integer(psb_lpk_) :: i,j, ni, nr, nc, nz write(iout,'(a)') '%%MatrixMarket matrix coordinate real general' if (present(head)) write(iout,'(a,a)') '% ',head @@ -5137,38 +5265,29 @@ subroutine psb_ls_coo_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 + frmt = psb_ls_get_print_frmt(nr,nc,nz,iv,ivr,ivc) - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if write(iout,*) nr, nc, nz if(present(iv)) then do j=1,a%get_nzeros() - write(iout,frmtv) iv(a%ia(j)),iv(a%ja(j)),a%val(j) + write(iout,frmt) iv(a%ia(j)),iv(a%ja(j)),a%val(j) enddo else if (present(ivr).and..not.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) ivr(a%ia(j)),a%ja(j),a%val(j) + write(iout,frmt) ivr(a%ia(j)),a%ja(j),a%val(j) enddo else if (present(ivr).and.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) ivr(a%ia(j)),ivc(a%ja(j)),a%val(j) + write(iout,frmt) ivr(a%ia(j)),ivc(a%ja(j)),a%val(j) enddo else if (.not.present(ivr).and.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) a%ia(j),ivc(a%ja(j)),a%val(j) + write(iout,frmt) a%ia(j),ivc(a%ja(j)),a%val(j) enddo else if (.not.present(ivr).and..not.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) a%ia(j),a%ja(j),a%val(j) + write(iout,frmt) a%ia(j),a%ja(j),a%val(j) enddo endif endif diff --git a/base/serial/impl/psb_s_csc_impl.f90 b/base/serial/impl/psb_s_csc_impl.f90 index 40eeb40ef..71e240513 100644 --- a/base/serial/impl/psb_s_csc_impl.f90 +++ b/base/serial/impl/psb_s_csc_impl.f90 @@ -2706,9 +2706,9 @@ subroutine psb_s_csc_print(iout,a,iv,head,ivr,ivc) integer(psb_ipk_), intent(in) :: iout class(psb_s_csc_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act integer(psb_ipk_) :: ierr(5) @@ -2716,7 +2716,7 @@ subroutine psb_s_csc_print(iout,a,iv,head,ivr,ivc) logical, parameter :: debug=.false. character(len=*), parameter :: datatype='real' - character(len=80) :: frmtv + character(len=80) :: frmt integer(psb_ipk_) :: i,j, nmx, ni, nr, nc, nz @@ -2730,47 +2730,37 @@ subroutine psb_s_csc_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 - - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if + frmt = psb_s_get_print_frmt(nr,nc,nz,iv,ivr,ivc) write(iout,*) nr, nc, nz if(present(iv)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) iv(a%ia(j)),iv(i),a%val(j) + write(iout,frmt) iv(a%ia(j)),iv(i),a%val(j) end do enddo else if (present(ivr).and..not.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) ivr(a%ia(j)),i,a%val(j) + write(iout,frmt) ivr(a%ia(j)),i,a%val(j) end do enddo else if (present(ivr).and.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) ivr(a%ia(j)),ivc(i),a%val(j) + write(iout,frmt) ivr(a%ia(j)),ivc(i),a%val(j) end do enddo else if (.not.present(ivr).and.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) (a%ia(j)),ivc(i),a%val(j) + write(iout,frmt) (a%ia(j)),ivc(i),a%val(j) end do enddo else if (.not.present(ivr).and..not.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) (a%ia(j)),(i),a%val(j) + write(iout,frmt) (a%ia(j)),(i),a%val(j) end do enddo endif @@ -3064,6 +3054,7 @@ subroutine psb_ls_csc_scals(d,a,info) end subroutine psb_ls_csc_scals + function psb_ls_csc_maxval(a) result(res) use psb_error_mod use psb_s_csc_mat_mod, psb_protect_name => psb_ls_csc_maxval @@ -4563,10 +4554,8 @@ subroutine psb_ls_csc_print(iout,a,iv,head,ivr,ivc) integer(psb_ipk_) :: ierr(5) character(len=20) :: name='ls_csc_print' logical, parameter :: debug=.false. - - character(len=*), parameter :: datatype='real' - character(len=80) :: frmtv - integer(psb_ipk_) :: i,j, nmx, ni, nr, nc, nz + character(len=80) :: frmt + integer(psb_lpk_) :: i,j, ni, nr, nc, nz write(iout,'(a)') '%%MatrixMarket matrix coordinate real general' @@ -4579,47 +4568,38 @@ subroutine psb_ls_csc_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 + frmt = psb_ls_get_print_frmt(nr,nc,nz,iv,ivr,ivc) - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if write(iout,*) nr, nc, nz if(present(iv)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) iv(a%ia(j)),iv(i),a%val(j) + write(iout,frmt) iv(a%ia(j)),iv(i),a%val(j) end do enddo else if (present(ivr).and..not.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) ivr(a%ia(j)),i,a%val(j) + write(iout,frmt) ivr(a%ia(j)),i,a%val(j) end do enddo else if (present(ivr).and.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) ivr(a%ia(j)),ivc(i),a%val(j) + write(iout,frmt) ivr(a%ia(j)),ivc(i),a%val(j) end do enddo else if (.not.present(ivr).and.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) (a%ia(j)),ivc(i),a%val(j) + write(iout,frmt) (a%ia(j)),ivc(i),a%val(j) end do enddo else if (.not.present(ivr).and..not.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) (a%ia(j)),(i),a%val(j) + write(iout,frmt) (a%ia(j)),(i),a%val(j) end do enddo endif diff --git a/base/serial/impl/psb_s_csr_impl.f90 b/base/serial/impl/psb_s_csr_impl.f90 index d60af4f49..2fa87adf6 100644 --- a/base/serial/impl/psb_s_csr_impl.f90 +++ b/base/serial/impl/psb_s_csr_impl.f90 @@ -1677,6 +1677,9 @@ subroutine psb_s_csr_scals(d,a,info) end subroutine psb_s_csr_scals + + + ! == =================================== ! ! @@ -2747,21 +2750,21 @@ end subroutine psb_s_csr_trim subroutine psb_s_csr_print(iout,a,iv,head,ivr,ivc) use psb_string_mod + use psb_s_base_mat_mod use psb_s_csr_mat_mod, psb_protect_name => psb_s_csr_print implicit none integer(psb_ipk_), intent(in) :: iout class(psb_s_csr_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act character(len=20) :: name='s_csr_print' logical, parameter :: debug=.false. - character(len=*), parameter :: datatype='real' - character(len=80) :: frmtv - integer(psb_ipk_) :: irs,ics,i,j, nmx, ni, nr, nc, nz + character(len=80) :: frmt + integer(psb_ipk_) :: irs,ics,i,j, ni, nr, nc, nz write(iout,'(a)') '%%MatrixMarket matrix coordinate real general' @@ -2774,47 +2777,38 @@ subroutine psb_s_csr_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 + frmt = psb_s_get_print_frmt(nr,nc,nz,iv,ivr,ivc) - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if write(iout,*) nr, nc, nz if(present(iv)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) iv(i),iv(a%ja(j)),a%val(j) + write(iout,frmt) iv(i),iv(a%ja(j)),a%val(j) end do enddo else if (present(ivr).and..not.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) ivr(i),(a%ja(j)),a%val(j) + write(iout,frmt) ivr(i),(a%ja(j)),a%val(j) end do enddo else if (present(ivr).and.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) ivr(i),ivc(a%ja(j)),a%val(j) + write(iout,frmt) ivr(i),ivc(a%ja(j)),a%val(j) end do enddo else if (.not.present(ivr).and.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) (i),ivc(a%ja(j)),a%val(j) + write(iout,frmt) (i),ivc(a%ja(j)),a%val(j) end do enddo else if (.not.present(ivr).and..not.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) (i),(a%ja(j)),a%val(j) + write(iout,frmt) (i),(a%ja(j)),a%val(j) end do enddo endif @@ -4883,9 +4877,8 @@ subroutine psb_ls_csr_print(iout,a,iv,head,ivr,ivc) integer(psb_ipk_) :: err_act character(len=20) :: name='ls_csr_print' logical, parameter :: debug=.false. - character(len=*), parameter :: datatype='real' - character(len=80) :: frmtv - integer(psb_lpk_) :: irs,ics,i,j, nmx, ni, nr, nc, nz + character(len=80) :: frmt + integer(psb_lpk_) :: irs,ics,i,j, ni, nr, nc, nz write(iout,'(a)') '%%MatrixMarket matrix coordinate real general' @@ -4898,47 +4891,38 @@ subroutine psb_ls_csr_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 + frmt = psb_ls_get_print_frmt(nr,nc,nz,iv,ivr,ivc) - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if write(iout,*) nr, nc, nz if(present(iv)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) iv(i),iv(a%ja(j)),a%val(j) + write(iout,frmt) iv(i),iv(a%ja(j)),a%val(j) end do enddo else if (present(ivr).and..not.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) ivr(i),(a%ja(j)),a%val(j) + write(iout,frmt) ivr(i),(a%ja(j)),a%val(j) end do enddo else if (present(ivr).and.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) ivr(i),ivc(a%ja(j)),a%val(j) + write(iout,frmt) ivr(i),ivc(a%ja(j)),a%val(j) end do enddo else if (.not.present(ivr).and.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) (i),ivc(a%ja(j)),a%val(j) + write(iout,frmt) (i),ivc(a%ja(j)),a%val(j) end do enddo else if (.not.present(ivr).and..not.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) (i),(a%ja(j)),a%val(j) + write(iout,frmt) (i),(a%ja(j)),a%val(j) end do enddo endif diff --git a/base/serial/impl/psb_s_mat_impl.F90 b/base/serial/impl/psb_s_mat_impl.F90 index 65deb5a72..867f9fa4c 100644 --- a/base/serial/impl/psb_s_mat_impl.F90 +++ b/base/serial/impl/psb_s_mat_impl.F90 @@ -466,9 +466,9 @@ subroutine psb_s_sparse_print(iout,a,iv,head,ivr,ivc) integer(psb_ipk_), intent(in) :: iout class(psb_sspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act, info character(len=20) :: name='sparse_print' @@ -500,9 +500,9 @@ subroutine psb_s_n_sparse_print(fname,a,iv,head,ivr,ivc) character(len=*), intent(in) :: fname class(psb_sspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act, info, iout logical :: isopen @@ -1098,6 +1098,53 @@ subroutine psb_s_csclip(a,b,info,& end subroutine psb_s_csclip +subroutine psb_s_csclip_ip(a,info,& + & imin,imax,jmin,jmax,rscale,cscale) + ! Output is always in COO format + use psb_error_mod + use psb_const_mod + use psb_s_base_mat_mod + use psb_s_mat_mod, psb_protect_name => psb_s_csclip_ip + implicit none + + class(psb_sspmat_type), intent(inout) :: a + integer(psb_ipk_),intent(out) :: info + integer(psb_ipk_), intent(in), optional :: imin,imax,jmin,jmax + logical, intent(in), optional :: rscale,cscale + + integer(psb_ipk_) :: err_act + character(len=20) :: name='csclip' + logical, parameter :: debug=.false. + type(psb_s_coo_sparse_mat), allocatable :: acoo + + info = psb_success_ + call psb_erractionsave(err_act) + if (a%is_null()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + allocate(acoo,stat=info) + if (info == psb_success_) then + call a%a%csclip(acoo,info,& + & imin,imax,jmin,jmax,rscale,cscale) + else + info = psb_err_alloc_dealloc_ + end if + if (info == psb_success_) call a%free() + if (info == psb_success_) call move_alloc(acoo,a%a) + if (info /= psb_success_) goto 9999 + + call psb_erractionrestore(err_act) + return + + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_s_csclip_ip subroutine psb_s_b_csclip(a,b,info,& & imin,imax,jmin,jmax,rscale,cscale) @@ -2602,6 +2649,8 @@ subroutine psb_s_mv_from_lb(a,b) class(psb_sspmat_type), intent(inout) :: a class(psb_ls_base_sparse_mat), intent(inout) :: b integer(psb_ipk_) :: info + + info = psb_success_ if (.not.allocated(a%a)) allocate(psb_s_csr_sparse_mat :: a%a, stat=info) if (info == psb_success_) call a%a%mv_from_lfmt(b,info) @@ -2618,6 +2667,7 @@ subroutine psb_s_cp_from_lb(a,b) class(psb_ls_base_sparse_mat), intent(inout) :: b integer(psb_ipk_) :: info + info = psb_success_ if (.not.allocated(a%a)) allocate(psb_s_csr_sparse_mat :: a%a, stat=info) if (info == psb_success_) call a%a%cp_from_lfmt(b,info) @@ -2668,6 +2718,7 @@ subroutine psb_s_mv_from_l(a,b) class(psb_lsspmat_type), intent(inout) :: b integer(psb_ipk_) :: info + info = psb_success_ if (allocated(b%a)) then if (.not.allocated(a%a)) allocate(psb_s_csr_sparse_mat :: a%a, stat=info) call a%a%mv_from_lfmt(b%a,info) @@ -2689,6 +2740,7 @@ subroutine psb_s_cp_from_l(a,b) class(psb_lsspmat_type), intent(in) :: b integer(psb_ipk_) :: info + info = psb_success_ if (allocated(b%a)) then if (.not.allocated(a%a)) allocate(psb_s_csr_sparse_mat :: a%a, stat=info) call a%a%cp_from_lfmt(b%a,info) @@ -3845,6 +3897,53 @@ subroutine psb_ls_csclip(a,b,info,& end subroutine psb_ls_csclip +subroutine psb_ls_csclip_ip(a,info,& + & imin,imax,jmin,jmax,rscale,cscale) + ! Output is always in COO format + use psb_error_mod + use psb_const_mod + use psb_s_base_mat_mod + use psb_s_mat_mod, psb_protect_name => psb_ls_csclip_ip + implicit none + + class(psb_lsspmat_type), intent(inout) :: a + integer(psb_ipk_),intent(out) :: info + integer(psb_lpk_), intent(in), optional :: imin,imax,jmin,jmax + logical, intent(in), optional :: rscale,cscale + + integer(psb_ipk_) :: err_act + character(len=20) :: name='csclip' + logical, parameter :: debug=.false. + type(psb_ls_coo_sparse_mat), allocatable :: acoo + + info = psb_success_ + call psb_erractionsave(err_act) + if (a%is_null()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + allocate(acoo,stat=info) + if (info == psb_success_) then + call a%a%csclip(acoo,info,& + & imin,imax,jmin,jmax,rscale,cscale) + else + info = psb_err_alloc_dealloc_ + end if + if (info == psb_success_) call a%free() + if (info == psb_success_) call move_alloc(acoo,a%a) + if (info /= psb_success_) goto 9999 + + call psb_erractionrestore(err_act) + return + + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_ls_csclip_ip subroutine psb_ls_b_csclip(a,b,info,& & imin,imax,jmin,jmax,rscale,cscale) @@ -5100,6 +5199,8 @@ subroutine psb_ls_mv_from_ib(a,b) class(psb_lsspmat_type), intent(inout) :: a class(psb_s_base_sparse_mat), intent(inout) :: b integer(psb_ipk_) :: info + + info = psb_success_ if (.not.allocated(a%a)) allocate(psb_ls_csr_sparse_mat :: a%a, stat=info) if (info == psb_success_) call a%a%mv_from_ifmt(b,info) @@ -5115,6 +5216,7 @@ subroutine psb_ls_cp_from_ib(a,b) class(psb_s_base_sparse_mat), intent(inout) :: b integer(psb_ipk_) :: info + info = psb_success_ if (.not.allocated(a%a)) allocate(psb_ls_csr_sparse_mat :: a%a, stat=info) if (info == psb_success_) call a%a%cp_from_ifmt(b,info) diff --git a/base/serial/impl/psb_z_coo_impl.f90 b/base/serial/impl/psb_z_coo_impl.F90 similarity index 97% rename from base/serial/impl/psb_z_coo_impl.f90 rename to base/serial/impl/psb_z_coo_impl.F90 index b950ed195..2da382963 100644 --- a/base/serial/impl/psb_z_coo_impl.f90 +++ b/base/serial/impl/psb_z_coo_impl.F90 @@ -407,6 +407,38 @@ subroutine psb_z_coo_reallocate_nz(nz,a) end subroutine psb_z_coo_reallocate_nz +subroutine psb_z_coo_ensure_size(nz,a) + use psb_z_base_mat_mod, psb_protect_name => psb_z_coo_ensure_size + use psb_error_mod + use psb_realloc_mod + implicit none + integer(psb_ipk_), intent(in) :: nz + class(psb_z_coo_sparse_mat), intent(inout) :: a + integer(psb_ipk_) :: err_act, info, nz_ + character(len=20) :: name='z_coo_ensure_size' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + nz_ = max(nz,ione) + call psb_ensure_size(nz_,a%ia,info) + if (info == psb_success_) call psb_ensure_size(nz_,a%ja,info) + if (info == psb_success_) call psb_ensure_size(nz_,a%val,info) + + if (info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_z_coo_ensure_size + subroutine psb_z_coo_mold(a,b,info) use psb_z_base_mat_mod, psb_protect_name => psb_z_coo_mold use psb_error_mod @@ -540,7 +572,44 @@ subroutine psb_z_coo_clean_zeros(a, info) call a%trim() end subroutine psb_z_coo_clean_zeros +subroutine psb_z_coo_clean_negidx(a,info) + use psb_error_mod + use psb_z_base_mat_mod, psb_protect_name => psb_z_coo_clean_negidx + implicit none + class(psb_z_coo_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + ! + ! + integer(psb_ipk_) :: nz + call psb_coo_clean_negidx_inner(a%get_nzeros(),a%ia,a%ja,a%val,nz,info) + if (info == 0) call a%set_nzeros(nz) +end subroutine psb_z_coo_clean_negidx + +subroutine psb_z_coo_clean_negidx_inner(nzin,ia,ja,val,nzout,info) + use psb_error_mod + use psb_z_base_mat_mod, psb_protect_name => psb_z_coo_clean_negidx_inner + implicit none + integer(psb_ipk_), intent(in) :: nzin + integer(psb_ipk_), intent(inout) :: ia(:), ja(:) + complex(psb_dpk_), intent(inout) :: val(:) + integer(psb_ipk_), intent(out) :: nzout + integer(psb_ipk_), intent(out) :: info + ! + ! + integer(psb_ipk_) :: i + info = 0 + nzout = 0 + do i=1, nzin + if ((ia(i)>0).and.(ja(i)>0)) then + nzout = nzout + 1 + val(nzout) = val(i) + ia(nzout) = ia(i) + ja(nzout) = ja(i) + end if + end do + +end subroutine psb_z_coo_clean_negidx_inner subroutine psb_z_coo_allocate_mnnz(m,n,a,nz) use psb_z_base_mat_mod, psb_protect_name => psb_z_coo_allocate_mnnz @@ -610,17 +679,15 @@ subroutine psb_z_coo_print(iout,a,iv,head,ivr,ivc) integer(psb_ipk_), intent(in) :: iout class(psb_z_coo_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act character(len=20) :: name='z_coo_print' logical, parameter :: debug=.false. - - character(len=*), parameter :: datatype='complex' - character(len=80) :: frmtv - integer(psb_ipk_) :: i,j, nmx, ni, nr, nc, nz + character(len=80) :: frmt + integer(psb_ipk_) :: i,j, ni, nr, nc, nz write(iout,'(a)') '%%MatrixMarket matrix coordinate complex general' if (present(head)) write(iout,'(a,a)') '% ',head @@ -632,38 +699,29 @@ subroutine psb_z_coo_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 + frmt = psb_z_get_print_frmt(nr,nc,nz,iv,ivr,ivc) - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if write(iout,*) nr, nc, nz if(present(iv)) then do j=1,a%get_nzeros() - write(iout,frmtv) iv(a%ia(j)),iv(a%ja(j)),a%val(j) + write(iout,frmt) iv(a%ia(j)),iv(a%ja(j)),a%val(j) enddo else if (present(ivr).and..not.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) ivr(a%ia(j)),a%ja(j),a%val(j) + write(iout,frmt) ivr(a%ia(j)),a%ja(j),a%val(j) enddo else if (present(ivr).and.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) ivr(a%ia(j)),ivc(a%ja(j)),a%val(j) + write(iout,frmt) ivr(a%ia(j)),ivc(a%ja(j)),a%val(j) enddo else if (.not.present(ivr).and.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) a%ia(j),ivc(a%ja(j)),a%val(j) + write(iout,frmt) a%ia(j),ivc(a%ja(j)),a%val(j) enddo else if (.not.present(ivr).and..not.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) a%ia(j),a%ja(j),a%val(j) + write(iout,frmt) a%ia(j),a%ja(j),a%val(j) enddo endif endif @@ -1777,7 +1835,7 @@ subroutine psb_z_coo_csmm(alpha,a,x,beta,y,info,trans) end if !.....end testing on alpha - else if (ctra) then + else if (ctra) then ! if (alpha == zone) then i = 1 @@ -4910,6 +4968,38 @@ subroutine psb_lz_coo_reallocate_nz(nz,a) end subroutine psb_lz_coo_reallocate_nz +subroutine psb_lz_coo_ensure_size(nz,a) + use psb_z_base_mat_mod, psb_protect_name => psb_lz_coo_ensure_size + use psb_error_mod + use psb_realloc_mod + implicit none + integer(psb_lpk_), intent(in) :: nz + class(psb_lz_coo_sparse_mat), intent(inout) :: a + integer(psb_ipk_) :: err_act, info, nz_ + character(len=20) :: name='lz_coo_ensure_size' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + nz_ = max(nz,ione) + call psb_ensure_size(nz_,a%ia,info) + if (info == psb_success_) call psb_ensure_size(nz_,a%ja,info) + if (info == psb_success_) call psb_ensure_size(nz_,a%val,info) + + if (info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_lz_coo_ensure_size + subroutine psb_lz_coo_mold(a,b,info) use psb_z_base_mat_mod, psb_protect_name => psb_lz_coo_mold use psb_error_mod @@ -5044,7 +5134,46 @@ subroutine psb_lz_coo_clean_zeros(a, info) call a%trim() end subroutine psb_lz_coo_clean_zeros +subroutine psb_lz_coo_clean_negidx(a,info) + use psb_error_mod + use psb_z_base_mat_mod, psb_protect_name => psb_lz_coo_clean_negidx + implicit none + class(psb_lz_coo_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + ! + ! + integer(psb_lpk_) :: nz + call psb_coo_clean_negidx_inner(a%get_nzeros(),a%ia,a%ja,a%val,nz,info) + if (info == 0) call a%set_nzeros(nz) +end subroutine psb_lz_coo_clean_negidx + +#if defined(IPK4) && defined(LPK8) +subroutine psb_lz_coo_clean_negidx_inner(nzin,ia,ja,val,nzout,info) + use psb_error_mod + use psb_z_base_mat_mod, psb_protect_name => psb_lz_coo_clean_negidx_inner + implicit none + integer(psb_lpk_), intent(in) :: nzin + integer(psb_lpk_), intent(inout) :: ia(:), ja(:) + complex(psb_dpk_), intent(inout) :: val(:) + integer(psb_lpk_), intent(out) :: nzout + integer(psb_ipk_), intent(out) :: info + ! + ! + integer(psb_lpk_) :: i + info = 0 + nzout = 0 + do i=1, nzin + if ((ia(i)>0).and.(ja(i)>0)) then + nzout = nzout + 1 + val(nzout) = val(i) + ia(nzout) = ia(i) + ja(nzout) = ja(i) + end if + end do + +end subroutine psb_lz_coo_clean_negidx_inner +#endif subroutine psb_lz_coo_allocate_mnnz(m,n,a,nz) use psb_z_base_mat_mod, psb_protect_name => psb_lz_coo_allocate_mnnz @@ -5123,9 +5252,8 @@ subroutine psb_lz_coo_print(iout,a,iv,head,ivr,ivc) character(len=20) :: name='lz_coo_print' logical, parameter :: debug=.false. - character(len=*), parameter :: datatype='complex' - character(len=80) :: frmtv - integer(psb_lpk_) :: i,j, nmx, ni, nr, nc, nz + character(len=80) :: frmt + integer(psb_lpk_) :: i,j, ni, nr, nc, nz write(iout,'(a)') '%%MatrixMarket matrix coordinate complex general' if (present(head)) write(iout,'(a,a)') '% ',head @@ -5137,38 +5265,29 @@ subroutine psb_lz_coo_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 + frmt = psb_lz_get_print_frmt(nr,nc,nz,iv,ivr,ivc) - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if write(iout,*) nr, nc, nz if(present(iv)) then do j=1,a%get_nzeros() - write(iout,frmtv) iv(a%ia(j)),iv(a%ja(j)),a%val(j) + write(iout,frmt) iv(a%ia(j)),iv(a%ja(j)),a%val(j) enddo else if (present(ivr).and..not.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) ivr(a%ia(j)),a%ja(j),a%val(j) + write(iout,frmt) ivr(a%ia(j)),a%ja(j),a%val(j) enddo else if (present(ivr).and.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) ivr(a%ia(j)),ivc(a%ja(j)),a%val(j) + write(iout,frmt) ivr(a%ia(j)),ivc(a%ja(j)),a%val(j) enddo else if (.not.present(ivr).and.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) a%ia(j),ivc(a%ja(j)),a%val(j) + write(iout,frmt) a%ia(j),ivc(a%ja(j)),a%val(j) enddo else if (.not.present(ivr).and..not.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) a%ia(j),a%ja(j),a%val(j) + write(iout,frmt) a%ia(j),a%ja(j),a%val(j) enddo endif endif diff --git a/base/serial/impl/psb_z_csc_impl.f90 b/base/serial/impl/psb_z_csc_impl.f90 index 3cde422fb..e1c003d0f 100644 --- a/base/serial/impl/psb_z_csc_impl.f90 +++ b/base/serial/impl/psb_z_csc_impl.f90 @@ -2706,9 +2706,9 @@ subroutine psb_z_csc_print(iout,a,iv,head,ivr,ivc) integer(psb_ipk_), intent(in) :: iout class(psb_z_csc_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act integer(psb_ipk_) :: ierr(5) @@ -2716,7 +2716,7 @@ subroutine psb_z_csc_print(iout,a,iv,head,ivr,ivc) logical, parameter :: debug=.false. character(len=*), parameter :: datatype='complex' - character(len=80) :: frmtv + character(len=80) :: frmt integer(psb_ipk_) :: i,j, nmx, ni, nr, nc, nz @@ -2730,47 +2730,37 @@ subroutine psb_z_csc_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 - - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if + frmt = psb_z_get_print_frmt(nr,nc,nz,iv,ivr,ivc) write(iout,*) nr, nc, nz if(present(iv)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) iv(a%ia(j)),iv(i),a%val(j) + write(iout,frmt) iv(a%ia(j)),iv(i),a%val(j) end do enddo else if (present(ivr).and..not.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) ivr(a%ia(j)),i,a%val(j) + write(iout,frmt) ivr(a%ia(j)),i,a%val(j) end do enddo else if (present(ivr).and.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) ivr(a%ia(j)),ivc(i),a%val(j) + write(iout,frmt) ivr(a%ia(j)),ivc(i),a%val(j) end do enddo else if (.not.present(ivr).and.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) (a%ia(j)),ivc(i),a%val(j) + write(iout,frmt) (a%ia(j)),ivc(i),a%val(j) end do enddo else if (.not.present(ivr).and..not.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) (a%ia(j)),(i),a%val(j) + write(iout,frmt) (a%ia(j)),(i),a%val(j) end do enddo endif @@ -3064,6 +3054,7 @@ subroutine psb_lz_csc_scals(d,a,info) end subroutine psb_lz_csc_scals + function psb_lz_csc_maxval(a) result(res) use psb_error_mod use psb_z_csc_mat_mod, psb_protect_name => psb_lz_csc_maxval @@ -4563,10 +4554,8 @@ subroutine psb_lz_csc_print(iout,a,iv,head,ivr,ivc) integer(psb_ipk_) :: ierr(5) character(len=20) :: name='lz_csc_print' logical, parameter :: debug=.false. - - character(len=*), parameter :: datatype='complex' - character(len=80) :: frmtv - integer(psb_ipk_) :: i,j, nmx, ni, nr, nc, nz + character(len=80) :: frmt + integer(psb_lpk_) :: i,j, ni, nr, nc, nz write(iout,'(a)') '%%MatrixMarket matrix coordinate complex general' @@ -4579,47 +4568,38 @@ subroutine psb_lz_csc_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 + frmt = psb_lz_get_print_frmt(nr,nc,nz,iv,ivr,ivc) - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if write(iout,*) nr, nc, nz if(present(iv)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) iv(a%ia(j)),iv(i),a%val(j) + write(iout,frmt) iv(a%ia(j)),iv(i),a%val(j) end do enddo else if (present(ivr).and..not.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) ivr(a%ia(j)),i,a%val(j) + write(iout,frmt) ivr(a%ia(j)),i,a%val(j) end do enddo else if (present(ivr).and.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) ivr(a%ia(j)),ivc(i),a%val(j) + write(iout,frmt) ivr(a%ia(j)),ivc(i),a%val(j) end do enddo else if (.not.present(ivr).and.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) (a%ia(j)),ivc(i),a%val(j) + write(iout,frmt) (a%ia(j)),ivc(i),a%val(j) end do enddo else if (.not.present(ivr).and..not.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) (a%ia(j)),(i),a%val(j) + write(iout,frmt) (a%ia(j)),(i),a%val(j) end do enddo endif diff --git a/base/serial/impl/psb_z_csr_impl.f90 b/base/serial/impl/psb_z_csr_impl.f90 index 43b40b3a8..f3b7b45f9 100644 --- a/base/serial/impl/psb_z_csr_impl.f90 +++ b/base/serial/impl/psb_z_csr_impl.f90 @@ -1677,6 +1677,9 @@ subroutine psb_z_csr_scals(d,a,info) end subroutine psb_z_csr_scals + + + ! == =================================== ! ! @@ -2747,21 +2750,21 @@ end subroutine psb_z_csr_trim subroutine psb_z_csr_print(iout,a,iv,head,ivr,ivc) use psb_string_mod + use psb_z_base_mat_mod use psb_z_csr_mat_mod, psb_protect_name => psb_z_csr_print implicit none integer(psb_ipk_), intent(in) :: iout class(psb_z_csr_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act character(len=20) :: name='z_csr_print' logical, parameter :: debug=.false. - character(len=*), parameter :: datatype='complex' - character(len=80) :: frmtv - integer(psb_ipk_) :: irs,ics,i,j, nmx, ni, nr, nc, nz + character(len=80) :: frmt + integer(psb_ipk_) :: irs,ics,i,j, ni, nr, nc, nz write(iout,'(a)') '%%MatrixMarket matrix coordinate complex general' @@ -2774,47 +2777,38 @@ subroutine psb_z_csr_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 + frmt = psb_z_get_print_frmt(nr,nc,nz,iv,ivr,ivc) - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if write(iout,*) nr, nc, nz if(present(iv)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) iv(i),iv(a%ja(j)),a%val(j) + write(iout,frmt) iv(i),iv(a%ja(j)),a%val(j) end do enddo else if (present(ivr).and..not.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) ivr(i),(a%ja(j)),a%val(j) + write(iout,frmt) ivr(i),(a%ja(j)),a%val(j) end do enddo else if (present(ivr).and.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) ivr(i),ivc(a%ja(j)),a%val(j) + write(iout,frmt) ivr(i),ivc(a%ja(j)),a%val(j) end do enddo else if (.not.present(ivr).and.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) (i),ivc(a%ja(j)),a%val(j) + write(iout,frmt) (i),ivc(a%ja(j)),a%val(j) end do enddo else if (.not.present(ivr).and..not.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) (i),(a%ja(j)),a%val(j) + write(iout,frmt) (i),(a%ja(j)),a%val(j) end do enddo endif @@ -4883,9 +4877,8 @@ subroutine psb_lz_csr_print(iout,a,iv,head,ivr,ivc) integer(psb_ipk_) :: err_act character(len=20) :: name='lz_csr_print' logical, parameter :: debug=.false. - character(len=*), parameter :: datatype='complex' - character(len=80) :: frmtv - integer(psb_lpk_) :: irs,ics,i,j, nmx, ni, nr, nc, nz + character(len=80) :: frmt + integer(psb_lpk_) :: irs,ics,i,j, ni, nr, nc, nz write(iout,'(a)') '%%MatrixMarket matrix coordinate complex general' @@ -4898,47 +4891,38 @@ subroutine psb_lz_csr_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 + frmt = psb_lz_get_print_frmt(nr,nc,nz,iv,ivr,ivc) - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if write(iout,*) nr, nc, nz if(present(iv)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) iv(i),iv(a%ja(j)),a%val(j) + write(iout,frmt) iv(i),iv(a%ja(j)),a%val(j) end do enddo else if (present(ivr).and..not.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) ivr(i),(a%ja(j)),a%val(j) + write(iout,frmt) ivr(i),(a%ja(j)),a%val(j) end do enddo else if (present(ivr).and.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) ivr(i),ivc(a%ja(j)),a%val(j) + write(iout,frmt) ivr(i),ivc(a%ja(j)),a%val(j) end do enddo else if (.not.present(ivr).and.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) (i),ivc(a%ja(j)),a%val(j) + write(iout,frmt) (i),ivc(a%ja(j)),a%val(j) end do enddo else if (.not.present(ivr).and..not.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) (i),(a%ja(j)),a%val(j) + write(iout,frmt) (i),(a%ja(j)),a%val(j) end do enddo endif diff --git a/base/serial/impl/psb_z_mat_impl.F90 b/base/serial/impl/psb_z_mat_impl.F90 index ed16fdeca..07616c05d 100644 --- a/base/serial/impl/psb_z_mat_impl.F90 +++ b/base/serial/impl/psb_z_mat_impl.F90 @@ -466,9 +466,9 @@ subroutine psb_z_sparse_print(iout,a,iv,head,ivr,ivc) integer(psb_ipk_), intent(in) :: iout class(psb_zspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act, info character(len=20) :: name='sparse_print' @@ -500,9 +500,9 @@ subroutine psb_z_n_sparse_print(fname,a,iv,head,ivr,ivc) character(len=*), intent(in) :: fname class(psb_zspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act, info, iout logical :: isopen @@ -1098,6 +1098,53 @@ subroutine psb_z_csclip(a,b,info,& end subroutine psb_z_csclip +subroutine psb_z_csclip_ip(a,info,& + & imin,imax,jmin,jmax,rscale,cscale) + ! Output is always in COO format + use psb_error_mod + use psb_const_mod + use psb_z_base_mat_mod + use psb_z_mat_mod, psb_protect_name => psb_z_csclip_ip + implicit none + + class(psb_zspmat_type), intent(inout) :: a + integer(psb_ipk_),intent(out) :: info + integer(psb_ipk_), intent(in), optional :: imin,imax,jmin,jmax + logical, intent(in), optional :: rscale,cscale + + integer(psb_ipk_) :: err_act + character(len=20) :: name='csclip' + logical, parameter :: debug=.false. + type(psb_z_coo_sparse_mat), allocatable :: acoo + + info = psb_success_ + call psb_erractionsave(err_act) + if (a%is_null()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + allocate(acoo,stat=info) + if (info == psb_success_) then + call a%a%csclip(acoo,info,& + & imin,imax,jmin,jmax,rscale,cscale) + else + info = psb_err_alloc_dealloc_ + end if + if (info == psb_success_) call a%free() + if (info == psb_success_) call move_alloc(acoo,a%a) + if (info /= psb_success_) goto 9999 + + call psb_erractionrestore(err_act) + return + + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_z_csclip_ip subroutine psb_z_b_csclip(a,b,info,& & imin,imax,jmin,jmax,rscale,cscale) @@ -2602,6 +2649,8 @@ subroutine psb_z_mv_from_lb(a,b) class(psb_zspmat_type), intent(inout) :: a class(psb_lz_base_sparse_mat), intent(inout) :: b integer(psb_ipk_) :: info + + info = psb_success_ if (.not.allocated(a%a)) allocate(psb_z_csr_sparse_mat :: a%a, stat=info) if (info == psb_success_) call a%a%mv_from_lfmt(b,info) @@ -2618,6 +2667,7 @@ subroutine psb_z_cp_from_lb(a,b) class(psb_lz_base_sparse_mat), intent(inout) :: b integer(psb_ipk_) :: info + info = psb_success_ if (.not.allocated(a%a)) allocate(psb_z_csr_sparse_mat :: a%a, stat=info) if (info == psb_success_) call a%a%cp_from_lfmt(b,info) @@ -2668,6 +2718,7 @@ subroutine psb_z_mv_from_l(a,b) class(psb_lzspmat_type), intent(inout) :: b integer(psb_ipk_) :: info + info = psb_success_ if (allocated(b%a)) then if (.not.allocated(a%a)) allocate(psb_z_csr_sparse_mat :: a%a, stat=info) call a%a%mv_from_lfmt(b%a,info) @@ -2689,6 +2740,7 @@ subroutine psb_z_cp_from_l(a,b) class(psb_lzspmat_type), intent(in) :: b integer(psb_ipk_) :: info + info = psb_success_ if (allocated(b%a)) then if (.not.allocated(a%a)) allocate(psb_z_csr_sparse_mat :: a%a, stat=info) call a%a%cp_from_lfmt(b%a,info) @@ -3845,6 +3897,53 @@ subroutine psb_lz_csclip(a,b,info,& end subroutine psb_lz_csclip +subroutine psb_lz_csclip_ip(a,info,& + & imin,imax,jmin,jmax,rscale,cscale) + ! Output is always in COO format + use psb_error_mod + use psb_const_mod + use psb_z_base_mat_mod + use psb_z_mat_mod, psb_protect_name => psb_lz_csclip_ip + implicit none + + class(psb_lzspmat_type), intent(inout) :: a + integer(psb_ipk_),intent(out) :: info + integer(psb_lpk_), intent(in), optional :: imin,imax,jmin,jmax + logical, intent(in), optional :: rscale,cscale + + integer(psb_ipk_) :: err_act + character(len=20) :: name='csclip' + logical, parameter :: debug=.false. + type(psb_lz_coo_sparse_mat), allocatable :: acoo + + info = psb_success_ + call psb_erractionsave(err_act) + if (a%is_null()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + allocate(acoo,stat=info) + if (info == psb_success_) then + call a%a%csclip(acoo,info,& + & imin,imax,jmin,jmax,rscale,cscale) + else + info = psb_err_alloc_dealloc_ + end if + if (info == psb_success_) call a%free() + if (info == psb_success_) call move_alloc(acoo,a%a) + if (info /= psb_success_) goto 9999 + + call psb_erractionrestore(err_act) + return + + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_lz_csclip_ip subroutine psb_lz_b_csclip(a,b,info,& & imin,imax,jmin,jmax,rscale,cscale) @@ -5100,6 +5199,8 @@ subroutine psb_lz_mv_from_ib(a,b) class(psb_lzspmat_type), intent(inout) :: a class(psb_z_base_sparse_mat), intent(inout) :: b integer(psb_ipk_) :: info + + info = psb_success_ if (.not.allocated(a%a)) allocate(psb_lz_csr_sparse_mat :: a%a, stat=info) if (info == psb_success_) call a%a%mv_from_ifmt(b,info) @@ -5115,6 +5216,7 @@ subroutine psb_lz_cp_from_ib(a,b) class(psb_z_base_sparse_mat), intent(inout) :: b integer(psb_ipk_) :: info + info = psb_success_ if (.not.allocated(a%a)) allocate(psb_lz_csr_sparse_mat :: a%a, stat=info) if (info == psb_success_) call a%a%cp_from_ifmt(b,info) diff --git a/base/serial/psb_crwextd.f90 b/base/serial/psb_crwextd.f90 index 7673a9353..1b55e4dbc 100644 --- a/base/serial/psb_crwextd.f90 +++ b/base/serial/psb_crwextd.f90 @@ -121,8 +121,9 @@ subroutine psb_cbase_rwextd(nr,a,info,b,rowscale) rowscale_ = .true. end if - ma = a%get_nrows() - na = a%get_ncols() + ma = a%get_nrows() + na = a%get_ncols() + nza = a%get_nzeros() select type(a) @@ -137,16 +138,12 @@ subroutine psb_cbase_rwextd(nr,a,info,b,rowscale) select type (b) type is (psb_c_csr_sparse_mat) - call psb_ensure_size(size(a%ja)+nzb,a%ja,info) - call psb_ensure_size(size(a%val)+nzb,a%val,info) + call psb_ensure_size(nza+nzb,a%ja,info) + call psb_ensure_size(nza+nzb,a%val,info) + a%ja(nza+1:nza+nzb) = b%ja(1:nzb) + a%val(nza+1:nza+nzb) = b%val(1:nzb) do i=1, min(nr-ma,mb) a%irp(ma+i+1) = a%irp(ma+i) + b%irp(i+1) - b%irp(i) - ja = a%irp(ma+i) - do jb = b%irp(i), b%irp(i+1)-1 - a%val(ja) = b%val(jb) - a%ja(ja) = b%ja(jb) - ja = ja + 1 - end do end do do j=i,nr-ma a%irp(ma+j+1) = a%irp(ma+j) @@ -175,7 +172,7 @@ subroutine psb_cbase_rwextd(nr,a,info,b,rowscale) mb = b%get_nrows() nb = b%get_ncols() nzb = b%get_nzeros() - call a%reallocate(nza+nzb) + call a%ensure_size(nza+nzb) select type(b) type is (psb_c_coo_sparse_mat) @@ -326,8 +323,9 @@ subroutine psb_lcbase_rwextd(nr,a,info,b,rowscale) rowscale_ = .true. end if - ma = a%get_nrows() - na = a%get_ncols() + ma = a%get_nrows() + na = a%get_ncols() + nza = a%get_nzeros() select type(a) @@ -342,16 +340,12 @@ subroutine psb_lcbase_rwextd(nr,a,info,b,rowscale) select type (b) type is (psb_lc_csr_sparse_mat) - call psb_ensure_size(size(a%ja)+nzb,a%ja,info) - call psb_ensure_size(size(a%val)+nzb,a%val,info) + call psb_ensure_size(nza+nzb,a%ja,info) + call psb_ensure_size(nza+nzb,a%val,info) + a%ja(nza+1:nza+nzb) = b%ja(1:nzb) + a%val(nza+1:nza+nzb) = b%val(1:nzb) do i=1, min(nr-ma,mb) a%irp(ma+i+1) = a%irp(ma+i) + b%irp(i+1) - b%irp(i) - ja = a%irp(ma+i) - do jb = b%irp(i), b%irp(i+1)-1 - a%val(ja) = b%val(jb) - a%ja(ja) = b%ja(jb) - ja = ja + 1 - end do end do do j=i,nr-ma a%irp(ma+j+1) = a%irp(ma+j) @@ -380,7 +374,7 @@ subroutine psb_lcbase_rwextd(nr,a,info,b,rowscale) mb = b%get_nrows() nb = b%get_ncols() nzb = b%get_nzeros() - call a%reallocate(nza+nzb) + call a%ensure_size(nza+nzb) select type(b) type is (psb_lc_coo_sparse_mat) diff --git a/base/serial/psb_drwextd.f90 b/base/serial/psb_drwextd.f90 index 5a5efae34..9abc42d2e 100644 --- a/base/serial/psb_drwextd.f90 +++ b/base/serial/psb_drwextd.f90 @@ -121,8 +121,9 @@ subroutine psb_dbase_rwextd(nr,a,info,b,rowscale) rowscale_ = .true. end if - ma = a%get_nrows() - na = a%get_ncols() + ma = a%get_nrows() + na = a%get_ncols() + nza = a%get_nzeros() select type(a) @@ -137,16 +138,12 @@ subroutine psb_dbase_rwextd(nr,a,info,b,rowscale) select type (b) type is (psb_d_csr_sparse_mat) - call psb_ensure_size(size(a%ja)+nzb,a%ja,info) - call psb_ensure_size(size(a%val)+nzb,a%val,info) + call psb_ensure_size(nza+nzb,a%ja,info) + call psb_ensure_size(nza+nzb,a%val,info) + a%ja(nza+1:nza+nzb) = b%ja(1:nzb) + a%val(nza+1:nza+nzb) = b%val(1:nzb) do i=1, min(nr-ma,mb) a%irp(ma+i+1) = a%irp(ma+i) + b%irp(i+1) - b%irp(i) - ja = a%irp(ma+i) - do jb = b%irp(i), b%irp(i+1)-1 - a%val(ja) = b%val(jb) - a%ja(ja) = b%ja(jb) - ja = ja + 1 - end do end do do j=i,nr-ma a%irp(ma+j+1) = a%irp(ma+j) @@ -175,7 +172,7 @@ subroutine psb_dbase_rwextd(nr,a,info,b,rowscale) mb = b%get_nrows() nb = b%get_ncols() nzb = b%get_nzeros() - call a%reallocate(nza+nzb) + call a%ensure_size(nza+nzb) select type(b) type is (psb_d_coo_sparse_mat) @@ -326,8 +323,9 @@ subroutine psb_ldbase_rwextd(nr,a,info,b,rowscale) rowscale_ = .true. end if - ma = a%get_nrows() - na = a%get_ncols() + ma = a%get_nrows() + na = a%get_ncols() + nza = a%get_nzeros() select type(a) @@ -342,16 +340,12 @@ subroutine psb_ldbase_rwextd(nr,a,info,b,rowscale) select type (b) type is (psb_ld_csr_sparse_mat) - call psb_ensure_size(size(a%ja)+nzb,a%ja,info) - call psb_ensure_size(size(a%val)+nzb,a%val,info) + call psb_ensure_size(nza+nzb,a%ja,info) + call psb_ensure_size(nza+nzb,a%val,info) + a%ja(nza+1:nza+nzb) = b%ja(1:nzb) + a%val(nza+1:nza+nzb) = b%val(1:nzb) do i=1, min(nr-ma,mb) a%irp(ma+i+1) = a%irp(ma+i) + b%irp(i+1) - b%irp(i) - ja = a%irp(ma+i) - do jb = b%irp(i), b%irp(i+1)-1 - a%val(ja) = b%val(jb) - a%ja(ja) = b%ja(jb) - ja = ja + 1 - end do end do do j=i,nr-ma a%irp(ma+j+1) = a%irp(ma+j) @@ -380,7 +374,7 @@ subroutine psb_ldbase_rwextd(nr,a,info,b,rowscale) mb = b%get_nrows() nb = b%get_ncols() nzb = b%get_nzeros() - call a%reallocate(nza+nzb) + call a%ensure_size(nza+nzb) select type(b) type is (psb_ld_coo_sparse_mat) diff --git a/base/serial/psb_srwextd.f90 b/base/serial/psb_srwextd.f90 index f92f39700..eb7ecf003 100644 --- a/base/serial/psb_srwextd.f90 +++ b/base/serial/psb_srwextd.f90 @@ -121,8 +121,9 @@ subroutine psb_sbase_rwextd(nr,a,info,b,rowscale) rowscale_ = .true. end if - ma = a%get_nrows() - na = a%get_ncols() + ma = a%get_nrows() + na = a%get_ncols() + nza = a%get_nzeros() select type(a) @@ -137,16 +138,12 @@ subroutine psb_sbase_rwextd(nr,a,info,b,rowscale) select type (b) type is (psb_s_csr_sparse_mat) - call psb_ensure_size(size(a%ja)+nzb,a%ja,info) - call psb_ensure_size(size(a%val)+nzb,a%val,info) + call psb_ensure_size(nza+nzb,a%ja,info) + call psb_ensure_size(nza+nzb,a%val,info) + a%ja(nza+1:nza+nzb) = b%ja(1:nzb) + a%val(nza+1:nza+nzb) = b%val(1:nzb) do i=1, min(nr-ma,mb) a%irp(ma+i+1) = a%irp(ma+i) + b%irp(i+1) - b%irp(i) - ja = a%irp(ma+i) - do jb = b%irp(i), b%irp(i+1)-1 - a%val(ja) = b%val(jb) - a%ja(ja) = b%ja(jb) - ja = ja + 1 - end do end do do j=i,nr-ma a%irp(ma+j+1) = a%irp(ma+j) @@ -175,7 +172,7 @@ subroutine psb_sbase_rwextd(nr,a,info,b,rowscale) mb = b%get_nrows() nb = b%get_ncols() nzb = b%get_nzeros() - call a%reallocate(nza+nzb) + call a%ensure_size(nza+nzb) select type(b) type is (psb_s_coo_sparse_mat) @@ -326,8 +323,9 @@ subroutine psb_lsbase_rwextd(nr,a,info,b,rowscale) rowscale_ = .true. end if - ma = a%get_nrows() - na = a%get_ncols() + ma = a%get_nrows() + na = a%get_ncols() + nza = a%get_nzeros() select type(a) @@ -342,16 +340,12 @@ subroutine psb_lsbase_rwextd(nr,a,info,b,rowscale) select type (b) type is (psb_ls_csr_sparse_mat) - call psb_ensure_size(size(a%ja)+nzb,a%ja,info) - call psb_ensure_size(size(a%val)+nzb,a%val,info) + call psb_ensure_size(nza+nzb,a%ja,info) + call psb_ensure_size(nza+nzb,a%val,info) + a%ja(nza+1:nza+nzb) = b%ja(1:nzb) + a%val(nza+1:nza+nzb) = b%val(1:nzb) do i=1, min(nr-ma,mb) a%irp(ma+i+1) = a%irp(ma+i) + b%irp(i+1) - b%irp(i) - ja = a%irp(ma+i) - do jb = b%irp(i), b%irp(i+1)-1 - a%val(ja) = b%val(jb) - a%ja(ja) = b%ja(jb) - ja = ja + 1 - end do end do do j=i,nr-ma a%irp(ma+j+1) = a%irp(ma+j) @@ -380,7 +374,7 @@ subroutine psb_lsbase_rwextd(nr,a,info,b,rowscale) mb = b%get_nrows() nb = b%get_ncols() nzb = b%get_nzeros() - call a%reallocate(nza+nzb) + call a%ensure_size(nza+nzb) select type(b) type is (psb_ls_coo_sparse_mat) diff --git a/base/serial/psb_zrwextd.f90 b/base/serial/psb_zrwextd.f90 index 0ea0bf3d4..f3e07f26e 100644 --- a/base/serial/psb_zrwextd.f90 +++ b/base/serial/psb_zrwextd.f90 @@ -121,8 +121,9 @@ subroutine psb_zbase_rwextd(nr,a,info,b,rowscale) rowscale_ = .true. end if - ma = a%get_nrows() - na = a%get_ncols() + ma = a%get_nrows() + na = a%get_ncols() + nza = a%get_nzeros() select type(a) @@ -137,16 +138,12 @@ subroutine psb_zbase_rwextd(nr,a,info,b,rowscale) select type (b) type is (psb_z_csr_sparse_mat) - call psb_ensure_size(size(a%ja)+nzb,a%ja,info) - call psb_ensure_size(size(a%val)+nzb,a%val,info) + call psb_ensure_size(nza+nzb,a%ja,info) + call psb_ensure_size(nza+nzb,a%val,info) + a%ja(nza+1:nza+nzb) = b%ja(1:nzb) + a%val(nza+1:nza+nzb) = b%val(1:nzb) do i=1, min(nr-ma,mb) a%irp(ma+i+1) = a%irp(ma+i) + b%irp(i+1) - b%irp(i) - ja = a%irp(ma+i) - do jb = b%irp(i), b%irp(i+1)-1 - a%val(ja) = b%val(jb) - a%ja(ja) = b%ja(jb) - ja = ja + 1 - end do end do do j=i,nr-ma a%irp(ma+j+1) = a%irp(ma+j) @@ -175,7 +172,7 @@ subroutine psb_zbase_rwextd(nr,a,info,b,rowscale) mb = b%get_nrows() nb = b%get_ncols() nzb = b%get_nzeros() - call a%reallocate(nza+nzb) + call a%ensure_size(nza+nzb) select type(b) type is (psb_z_coo_sparse_mat) @@ -326,8 +323,9 @@ subroutine psb_lzbase_rwextd(nr,a,info,b,rowscale) rowscale_ = .true. end if - ma = a%get_nrows() - na = a%get_ncols() + ma = a%get_nrows() + na = a%get_ncols() + nza = a%get_nzeros() select type(a) @@ -342,16 +340,12 @@ subroutine psb_lzbase_rwextd(nr,a,info,b,rowscale) select type (b) type is (psb_lz_csr_sparse_mat) - call psb_ensure_size(size(a%ja)+nzb,a%ja,info) - call psb_ensure_size(size(a%val)+nzb,a%val,info) + call psb_ensure_size(nza+nzb,a%ja,info) + call psb_ensure_size(nza+nzb,a%val,info) + a%ja(nza+1:nza+nzb) = b%ja(1:nzb) + a%val(nza+1:nza+nzb) = b%val(1:nzb) do i=1, min(nr-ma,mb) a%irp(ma+i+1) = a%irp(ma+i) + b%irp(i+1) - b%irp(i) - ja = a%irp(ma+i) - do jb = b%irp(i), b%irp(i+1)-1 - a%val(ja) = b%val(jb) - a%ja(ja) = b%ja(jb) - ja = ja + 1 - end do end do do j=i,nr-ma a%irp(ma+j+1) = a%irp(ma+j) @@ -380,7 +374,7 @@ subroutine psb_lzbase_rwextd(nr,a,info,b,rowscale) mb = b%get_nrows() nb = b%get_ncols() nzb = b%get_nzeros() - call a%reallocate(nza+nzb) + call a%ensure_size(nza+nzb) select type(b) type is (psb_lz_coo_sparse_mat) diff --git a/base/serial/psi_i2_serial_impl.f90 b/base/serial/psi_i2_serial_impl.f90 new file mode 100644 index 000000000..59d579f2e --- /dev/null +++ b/base/serial/psi_i2_serial_impl.f90 @@ -0,0 +1,840 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! 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_i2axpby(m,n,alpha, x, beta, y, info) + + use psb_const_mod + use psb_error_mod + implicit none + integer(psb_ipk_), intent(in) :: m, n + integer(psb_i2pk_), intent (in) :: x(:,:) + integer(psb_i2pk_), intent (inout) :: y(:,:) + integer(psb_i2pk_), intent (in) :: alpha, beta + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: lx, ly + integer(psb_ipk_) :: ierr(5) + character(len=20) :: name, ch_err + + name='psb_geaxpby' + info=psb_success_ + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + + if (m < 0) then + info = psb_err_iarg_neg_ + ierr(1) = 1; ierr(2) = m + call psb_errpush(info,name,i_err=ierr) + goto 9999 + end if + if (n < 0) then + info = psb_err_iarg_neg_ + ierr(1) = 2; ierr(2) = n + call psb_errpush(info,name,i_err=ierr) + goto 9999 + end if + lx = size(x,1) + ly = size(y,1) + if (lx < m) then + info = psb_err_input_asize_small_i_ + ierr(1) = 4; ierr(2) = m + call psb_errpush(info,name,i_err=ierr) + goto 9999 + end if + if (ly < m) then + info = psb_err_input_asize_small_i_ + ierr(1) = 6; ierr(2) = m + call psb_errpush(info,name,i_err=ierr) + goto 9999 + end if + + if ((m>0).and.(n>0)) call i2axpby(m,n,alpha,x,lx,beta,y,ly,info) + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return +end subroutine psi_i2axpby + +subroutine psi_i2axpbyv(m,alpha, x, beta, y, info) + + use psb_const_mod + use psb_error_mod + implicit none + integer(psb_ipk_), intent(in) :: m + integer(psb_i2pk_), intent (in) :: x(:) + integer(psb_i2pk_), intent (inout) :: y(:) + integer(psb_i2pk_), intent (in) :: alpha, beta + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: lx, ly + integer(psb_ipk_) :: ierr(5) + character(len=20) :: name, ch_err + + name='psb_geaxpby' + info=psb_success_ + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + + if (m < 0) then + info = psb_err_iarg_neg_ + ierr(1) = 1; ierr(2) = m + call psb_errpush(info,name,i_err=ierr) + goto 9999 + end if + lx = size(x,1) + ly = size(y,1) + if (lx < m) then + info = psb_err_input_asize_small_i_ + ierr(1) = 3; ierr(2) = m + call psb_errpush(info,name,i_err=ierr) + goto 9999 + end if + if (ly < m) then + info = psb_err_input_asize_small_i_ + ierr(1) = 5; ierr(2) = m + call psb_errpush(info,name,i_err=ierr) + goto 9999 + end if + + if (m>0) call i2axpby(m,ione,alpha,x,lx,beta,y,ly,info) + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psi_i2axpbyv + +subroutine psi_i2axpbyv2(m,alpha, x, beta, y, z, info) + + use psb_const_mod + use psb_error_mod + implicit none + integer(psb_ipk_), intent(in) :: m + integer(psb_i2pk_), intent (in) :: x(:) + integer(psb_i2pk_), intent (in) :: y(:) + integer(psb_i2pk_), intent (inout) :: z(:) + integer(psb_i2pk_), intent (in) :: alpha, beta + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: lx, ly, lz + integer(psb_ipk_) :: ierr(5) + character(len=20) :: name, ch_err + + name='psb_geaxpby' + info=psb_success_ + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + + if (m < 0) then + info = psb_err_iarg_neg_ + ierr(1) = 1; ierr(2) = m + call psb_errpush(info,name,i_err=ierr) + goto 9999 + end if + lx = size(x,1) + ly = size(y,1) + lz = size(z,1) + if (lx < m) then + info = psb_err_input_asize_small_i_ + ierr(1) = 3; ierr(2) = m + call psb_errpush(info,name,i_err=ierr) + goto 9999 + end if + if (ly < m) then + info = psb_err_input_asize_small_i_ + ierr(1) = 5; ierr(2) = m + call psb_errpush(info,name,i_err=ierr) + goto 9999 + end if + if (lz < m) then + info = psb_err_input_asize_small_i_ + ierr(1) = 5; ierr(2) = m + call psb_errpush(info,name,i_err=ierr) + goto 9999 + end if + + if (m>0) call i2axpbyv2(m,ione,alpha,x,lx,beta,y,ly,z,lz,info) + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psi_i2axpbyv2 + +subroutine psi_i2gthmv(n,k,idx,alpha,x,beta,y) + + use psb_const_mod + implicit none + + integer(psb_ipk_) :: n, k, idx(:) + integer(psb_i2pk_) :: x(:,:), y(:),alpha,beta + + ! Locals + integer(psb_ipk_) :: i, j, pt + + if (beta == i2zero) then + if (alpha == i2zero) then + pt=0 + do j=1,k + do i=1,n + pt=pt+1 + y(pt) = i2zero + end do + end do + else if (alpha == i2one) then + pt=0 + do j=1,k + do i=1,n + pt=pt+1 + y(pt) = x(idx(i),j) + end do + end do + else if (alpha == -i2one) then + pt=0 + do j=1,k + do i=1,n + pt=pt+1 + y(pt) = -x(idx(i),j) + end do + end do + else + pt=0 + do j=1,k + do i=1,n + pt=pt+1 + y(pt) = alpha*x(idx(i),j) + end do + end do + end if + else + if (beta == i2one) then + ! Do nothing + else if (beta == -i2one) then + y(1:n*k) = -y(1:n*k) + else + y(1:n*k) = beta*y(1:n*k) + end if + + if (alpha == i2zero) then + ! do nothing + else if (alpha == i2one) then + pt=0 + do j=1,k + do i=1,n + pt=pt+1 + y(pt) = y(pt) + x(idx(i),j) + end do + end do + else if (alpha == -i2one) then + pt=0 + do j=1,k + do i=1,n + pt=pt+1 + y(pt) = y(pt) - x(idx(i),j) + end do + end do + else + pt=0 + do j=1,k + do i=1,n + pt=pt+1 + y(pt) = y(pt) + alpha*x(idx(i),j) + end do + end do + end if + end if + +end subroutine psi_i2gthmv + +subroutine psi_i2gthv(n,idx,alpha,x,beta,y) + + use psb_const_mod + implicit none + + integer(psb_ipk_) :: n, idx(:) + integer(psb_i2pk_) :: x(:), y(:),alpha,beta + + ! Locals + integer(psb_ipk_) :: i + if (beta == i2zero) then + if (alpha == i2zero) then + do i=1,n + y(i) = i2zero + end do + else if (alpha == i2one) then + do i=1,n + y(i) = x(idx(i)) + end do + else if (alpha == -i2one) then + do i=1,n + y(i) = -x(idx(i)) + end do + else + do i=1,n + y(i) = alpha*x(idx(i)) + end do + end if + else + if (beta == i2one) then + ! Do nothing + else if (beta == -i2one) then + y(1:n) = -y(1:n) + else + y(1:n) = beta*y(1:n) + end if + + if (alpha == i2zero) then + ! do nothing + else if (alpha == i2one) then + do i=1,n + y(i) = y(i) + x(idx(i)) + end do + else if (alpha == -i2one) then + do i=1,n + y(i) = y(i) - x(idx(i)) + end do + else + do i=1,n + y(i) = y(i) + alpha*x(idx(i)) + end do + end if + end if + +end subroutine psi_i2gthv + +subroutine psi_i2gthzmm(n,k,idx,x,y) + + use psb_const_mod + implicit none + + integer(psb_ipk_) :: n, k, idx(:) + integer(psb_i2pk_) :: x(:,:), y(:,:) + + ! Locals + integer(psb_ipk_) :: i + + + do i=1,n + y(i,1:k)=x(idx(i),1:k) + end do + +end subroutine psi_i2gthzmm + +subroutine psi_i2gthzmv(n,k,idx,x,y) + + use psb_const_mod + implicit none + + integer(psb_ipk_) :: n, k, idx(:) + integer(psb_i2pk_) :: x(:,:), y(:) + + ! Locals + integer(psb_ipk_) :: i, j, pt + + pt=0 + do j=1,k + do i=1,n + pt=pt+1 + y(pt)=x(idx(i),j) + end do + end do + +end subroutine psi_i2gthzmv + +subroutine psi_i2gthzv(n,idx,x,y) + + use psb_const_mod + implicit none + + integer(psb_ipk_) :: n, idx(:) + integer(psb_i2pk_) :: x(:), y(:) + + ! Locals + integer(psb_ipk_) :: i + + do i=1,n + y(i)=x(idx(i)) + end do + +end subroutine psi_i2gthzv + +subroutine psi_i2sctmm(n,k,idx,x,beta,y) + + use psb_const_mod + implicit none + + integer(psb_ipk_) :: n, k, idx(:) + integer(psb_i2pk_) :: beta, x(:,:), y(:,:) + + ! Locals + integer(psb_ipk_) :: i, j + + if (beta == i2zero) then + do i=1,n + y(idx(i),1:k) = x(i,1:k) + end do + else if (beta == i2one) then + do i=1,n + y(idx(i),1:k) = y(idx(i),1:k)+x(i,1:k) + end do + else + do i=1,n + y(idx(i),1:k) = beta*y(idx(i),1:k)+x(i,1:k) + end do + end if +end subroutine psi_i2sctmm + +subroutine psi_i2sctmv(n,k,idx,x,beta,y) + + use psb_const_mod + implicit none + + integer(psb_ipk_) :: n, k, idx(:) + integer(psb_i2pk_) :: beta, x(:), y(:,:) + + ! Locals + integer(psb_ipk_) :: i, j, pt + + if (beta == i2zero) then + pt=0 + do j=1,k + do i=1,n + pt=pt+1 + y(idx(i),j) = x(pt) + end do + end do + else if (beta == i2one) then + pt=0 + do j=1,k + do i=1,n + pt=pt+1 + y(idx(i),j) = y(idx(i),j)+x(pt) + end do + end do + else + pt=0 + do j=1,k + do i=1,n + pt=pt+1 + y(idx(i),j) = beta*y(idx(i),j)+x(pt) + end do + end do + end if +end subroutine psi_i2sctmv + +subroutine psi_i2sctv(n,idx,x,beta,y) + + use psb_const_mod + implicit none + + integer(psb_ipk_) :: n, idx(:) + integer(psb_i2pk_) :: beta, x(:), y(:) + + ! Locals + integer(psb_ipk_) :: i + + if (beta == i2zero) then + do i=1,n + y(idx(i)) = x(i) + end do + else if (beta == i2one) then + do i=1,n + y(idx(i)) = y(idx(i))+x(i) + end do + else + do i=1,n + y(idx(i)) = beta*y(idx(i))+x(i) + end do + end if +end subroutine psi_i2sctv + +subroutine i2axpby(m, n, alpha, X, lldx, beta, Y, lldy, info) + use psb_const_mod + use psb_error_mod + implicit none + integer(psb_ipk_) :: n, m, lldx, lldy, info + integer(psb_i2pk_) X(lldx,*), Y(lldy,*) + integer(psb_i2pk_) alpha, beta + integer(psb_ipk_) :: i, j + integer(psb_ipk_) :: int_err(5) + character name*20 + name='i2axpby' + + + ! + ! Error handling + ! + info = psb_success_ + if (m.lt.0) then + info=psb_err_iarg_neg_ + int_err(1)=1 + int_err(2)=m + call fcpsb_errpush(info,name,int_err) + goto 9999 + else if (n.lt.0) then + info=psb_err_iarg_neg_ + int_err(1)=1 + int_err(2)=n + call fcpsb_errpush(info,name,int_err) + goto 9999 + else if (lldx.lt.max(1,m)) then + info=psb_err_iarg_not_gtia_ii_ + int_err(1)=5 + int_err(2)=1 + int_err(3)=lldx + int_err(4)=m + call fcpsb_errpush(info,name,int_err) + goto 9999 + else if (lldy.lt.max(1,m)) then + info=psb_err_iarg_not_gtia_ii_ + int_err(1)=8 + int_err(2)=1 + int_err(3)=lldy + int_err(4)=m + call fcpsb_errpush(info,name,int_err) + goto 9999 + endif + + if (alpha.eq.i2zero) then + if (beta.eq.i2zero) then + do j=1, n + do i=1,m + y(i,j) = i2zero + enddo + enddo + else if (beta.eq.i2one) then + ! + ! Do nothing! + ! + + else if (beta.eq.-i2one) then + do j=1,n + do i=1,m + y(i,j) = - y(i,j) + enddo + enddo + else + do j=1,n + do i=1,m + y(i,j) = beta*y(i,j) + enddo + enddo + endif + + else if (alpha.eq.i2one) then + + if (beta.eq.i2zero) then + do j=1,n + do i=1,m + y(i,j) = x(i,j) + enddo + enddo + else if (beta.eq.i2one) then + do j=1,n + do i=1,m + y(i,j) = x(i,j) + y(i,j) + enddo + enddo + + else if (beta.eq.-i2one) then + do j=1,n + do i=1,m + y(i,j) = x(i,j) - y(i,j) + enddo + enddo + else + do j=1,n + do i=1,m + y(i,j) = x(i,j) + beta*y(i,j) + enddo + enddo + endif + + else if (alpha.eq.-i2one) then + + if (beta.eq.i2zero) then + do j=1,n + do i=1,m + y(i,j) = -x(i,j) + enddo + enddo + else if (beta.eq.i2one) then + do j=1,n + do i=1,m + y(i,j) = -x(i,j) + y(i,j) + enddo + enddo + + else if (beta.eq.-i2one) then + do j=1,n + do i=1,m + y(i,j) = -x(i,j) - y(i,j) + enddo + enddo + else + do j=1,n + do i=1,m + y(i,j) = -x(i,j) + beta*y(i,j) + enddo + enddo + endif + + else + + if (beta.eq.i2zero) then + do j=1,n + do i=1,m + y(i,j) = alpha*x(i,j) + enddo + enddo + else if (beta.eq.i2one) then + do j=1,n + do i=1,m + y(i,j) = alpha*x(i,j) + y(i,j) + enddo + enddo + + else if (beta.eq.-i2one) then + do j=1,n + do i=1,m + y(i,j) = alpha*x(i,j) - y(i,j) + enddo + enddo + else + do j=1,n + do i=1,m + y(i,j) = alpha*x(i,j) + beta*y(i,j) + enddo + enddo + endif + + endif + + return + +9999 continue + call fcpsb_serror() + return + +end subroutine i2axpby + +subroutine i2axpbyv2(m, n, alpha, X, lldx, beta, Y, lldy, Z, lldz, info) + use psb_const_mod + use psb_error_mod + implicit none + integer(psb_ipk_) :: n, m, lldx, lldy, lldz, info + integer(psb_i2pk_) X(lldx,*), Y(lldy,*), Z(lldy,*) + integer(psb_i2pk_) alpha, beta + integer(psb_ipk_) :: i, j + integer(psb_ipk_) :: int_err(5) + character name*20 + name='i2axpby' + + + ! + ! Error handling + ! + info = psb_success_ + if (m.lt.0) then + info=psb_err_iarg_neg_ + int_err(1)=1 + int_err(2)=m + call fcpsb_errpush(info,name,int_err) + goto 9999 + else if (n.lt.0) then + info=psb_err_iarg_neg_ + int_err(1)=1 + int_err(2)=n + call fcpsb_errpush(info,name,int_err) + goto 9999 + else if (lldx.lt.max(1,m)) then + info=psb_err_iarg_not_gtia_ii_ + int_err(1)=5 + int_err(2)=1 + int_err(3)=lldx + int_err(4)=m + call fcpsb_errpush(info,name,int_err) + goto 9999 + else if (lldy.lt.max(1,m)) then + info=psb_err_iarg_not_gtia_ii_ + int_err(1)=8 + int_err(2)=1 + int_err(3)=lldy + int_err(4)=m + call fcpsb_errpush(info,name,int_err) + goto 9999 + else if (lldz.lt.max(1,m)) then + info=psb_err_iarg_not_gtia_ii_ + int_err(1)=8 + int_err(2)=1 + int_err(3)=lldz + int_err(4)=m + call fcpsb_errpush(info,name,int_err) + goto 9999 + endif + + if (alpha.eq.i2zero) then + if (beta.eq.i2zero) then + do j=1, n + do i=1,m + Z(i,j) = i2zero + enddo + enddo + else if (beta.eq.i2one) then + ! + ! Do nothing! + ! + + else if (beta.eq.-i2one) then + do j=1,n + do i=1,m + Z(i,j) = - y(i,j) + enddo + enddo + else + do j=1,n + do i=1,m + Z(i,j) = beta*y(i,j) + enddo + enddo + endif + + else if (alpha.eq.i2one) then + + if (beta.eq.i2zero) then + do j=1,n + do i=1,m + Z(i,j) = x(i,j) + enddo + enddo + else if (beta.eq.i2one) then + do j=1,n + do i=1,m + Z(i,j) = x(i,j) + y(i,j) + enddo + enddo + + else if (beta.eq.-i2one) then + do j=1,n + do i=1,m + Z(i,j) = x(i,j) - y(i,j) + enddo + enddo + else + do j=1,n + do i=1,m + Z(i,j) = x(i,j) + beta*y(i,j) + enddo + enddo + endif + + else if (alpha.eq.-i2one) then + + if (beta.eq.i2zero) then + do j=1,n + do i=1,m + Z(i,j) = -x(i,j) + enddo + enddo + else if (beta.eq.i2one) then + do j=1,n + do i=1,m + Z(i,j) = -x(i,j) + y(i,j) + enddo + enddo + + else if (beta.eq.-i2one) then + do j=1,n + do i=1,m + Z(i,j) = -x(i,j) - y(i,j) + enddo + enddo + else + do j=1,n + do i=1,m + Z(i,j) = -x(i,j) + beta*y(i,j) + enddo + enddo + endif + + else + + if (beta.eq.i2zero) then + do j=1,n + do i=1,m + Z(i,j) = alpha*x(i,j) + enddo + enddo + else if (beta.eq.i2one) then + do j=1,n + do i=1,m + Z(i,j) = alpha*x(i,j) + y(i,j) + enddo + enddo + + else if (beta.eq.-i2one) then + do j=1,n + do i=1,m + Z(i,j) = alpha*x(i,j) - y(i,j) + enddo + enddo + else + do j=1,n + do i=1,m + Z(i,j) = alpha*x(i,j) + beta*y(i,j) + enddo + enddo + endif + + endif + + return + +9999 continue + call fcpsb_serror() + return + +end subroutine i2axpbyv2 diff --git a/base/tools/Makefile b/base/tools/Makefile index c29bee88f..6b103d410 100644 --- a/base/tools/Makefile +++ b/base/tools/Makefile @@ -25,7 +25,8 @@ FOBJS = psb_cdall.o psb_cdals.o psb_cdalv.o psb_cd_inloc.o psb_cdins.o psb_cdprt psb_cspalloc.o psb_cspasb.o psb_cspfree.o\ psb_cspins.o psb_csprn.o psb_cd_set_bld.o \ psb_s_map.o psb_d_map.o psb_c_map.o psb_z_map.o \ - psb_s_par_csr_spspmm.o psb_d_par_csr_spspmm.o psb_c_par_csr_spspmm.o psb_z_par_csr_spspmm.o + psb_s_par_csr_spspmm.o psb_d_par_csr_spspmm.o psb_c_par_csr_spspmm.o psb_z_par_csr_spspmm.o \ + psb_s_glob_transpose.o psb_d_glob_transpose.o psb_c_glob_transpose.o psb_z_glob_transpose.o # psb_lallc.o psb_lasb.o psb_lfree.o psb_lins.o \ MPFOBJS = psb_icdasb.o psb_ssphalo.o psb_dsphalo.o psb_csphalo.o psb_zsphalo.o \ diff --git a/base/tools/psb_c_glob_transpose.F90 b/base/tools/psb_c_glob_transpose.F90 new file mode 100644 index 000000000..a13da65a2 --- /dev/null +++ b/base/tools/psb_c_glob_transpose.F90 @@ -0,0 +1,902 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! 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: psb_c_glob_transpose.f90 +! +! Subroutine: psb_c_glob_transpose +! Version: complex +! +! This file provides multiple related versions of a parallel +! global transpose +! +! B = A^T +! +! There are some variations of this routine, that are accounted for +! in the workhorse psb_lc_coo_glob_transpose +! 1. The row and column spaces can share the same descriptor +! This essentially means that the descriptor relates to a +! matrix with a symmetric pattern. Examples are: symmetric +! matrices, matrices with symmetric pattern, lower or +! upper halves of such matrices +! 2. The row and column index spaces are different +! In this case you need to have two descriptor on input, +! plus if you want the output to be distributed according +! to the row descriptor, you will still need a new descriptor +! because even if the row distribution is the same, the pattern +! will be different. +! +! This is handled in the workhorse by having one mandatory and +! two optional descriptors: +! 1. If only the mandatory descriptor is present, then it is assumed that it +! is both row and column descriptor, and that it is sufficient. +! 2. If two descriptors are available, then use the second +! 3. If the third output descriptor is available, then rebuild it +! after the data exchange. +! +! The main transpose algorithm works like this: +! 1. Compute sizes: any entry A(I,J) with J in the halo will have +! to be sent to the process owning J, so walk through the +! matrix and compute all the send sizes, then do an alltoall to figure +! the receive sizes; +! 2. Adjust send bufffers; +! 3. Perform a local transpose; +! 4. Split the matrix: all local entries stay, all halo entries go into +! the send buffers, and are converted to global numbering; +! 5. Do the all-to-all (see below for a discussion of the alternative +! communication strategies) +! 6. The receive is in the extra section of the ACOO buffer; convert +! the row indices to local numbering, and discard extra ones (there will +! be some) +! 7. If desc_rx was requested, make sure to insert the (new) column indices +! 8. Cleanup and sort the output matrix +! 9. Copy back into AIN or ATRANS if requested. +! +! There are three possible exchange algorithms: +! 1. Use MPI_Alltoallv +! 2. Use psb_simple_a2av +! 3. Use psb_simple_triad_a2av +! Default choice is 3. The MPI variant has proved to be inefficient; +! that is because it is not persistent, therefore you pay the initialization price +! every time, and it is not optimized for a sparse communication pattern, +! most MPI implementations assume that all communications are non-empty. +! The PSB_SIMPLE variants reuse the same communicator, and go for a simplistic +! sequence of sends/receive that is quite efficient for a sparse communication +! pattern. To be refined/reviewed in the future to compare with neighbour +! persistent collectives. +! +! +subroutine psb_lc_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) +#ifdef MPI_MOD + use mpi +#endif + use psb_base_mod, psb_protect_name => psb_lc_coo_glob_transpose + Implicit None +#ifdef MPI_H + include 'mpif.h' +#endif + type(psb_lc_coo_sparse_mat), intent(inout) :: ain + type(psb_desc_type), intent(inout), target :: desc_r + type(psb_lc_coo_sparse_mat), intent(out), optional :: atrans + type(psb_desc_type), intent(inout), target, optional :: desc_c + type(psb_desc_type), intent(out), optional :: desc_rx + integer(psb_ipk_), intent(out) :: info + + ! ...local scalars.... + integer(psb_ipk_) :: ictxt, np,me + integer(psb_ipk_) :: counter,proc, err_act, j + integer(psb_lpk_) :: i, k, idx, r, ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& + & l1, nsnds, nrcvs, nr,nc,nzl, hlstart, nzt, nzd + integer(psb_mpk_) :: icomm, minfo + integer(psb_mpk_), allocatable :: brvindx(:), & + & rvsz(:), bsdindx(:), sdsz(:), tsdx(:), trvx(:) + integer(psb_ipk_), allocatable :: halo_owner(:) + integer(psb_lpk_), allocatable :: iasnd(:), jasnd(:) + complex(psb_spk_), allocatable :: valsnd(:) + type(psb_lc_coo_sparse_mat), allocatable :: acoo + logical :: rowcnv_,colcnv_,rowscale_,colscale_,outcol_glob_ + type(psb_desc_type), pointer :: p_desc_c + character(len=5) :: outfmt_ + integer(psb_ipk_) :: debug_level, debug_unit + character(len=20) :: name, ch_err + + if(psb_get_errstatus() /= 0) return + info=psb_success_ + name='mld_glob_transpose' + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt = desc_r%get_context() + icomm = desc_r%get_mpic() + + Call psb_info(ictxt, me, np) + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),': Start' + + if (present(desc_c)) then + p_desc_c => desc_c + else + p_desc_c => desc_r + end if + + Allocate(brvindx(np+1),& + & rvsz(np),sdsz(np),bsdindx(np+1), acoo,stat=info) + + if (info /= psb_success_) then + info=psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + end if + + + sdsz(:)=0 + rvsz(:)=0 + l1 = 0 + brvindx(1) = 0 + bsdindx(1) = 0 + counter=1 + idx = 0 + idxs = 0 + idxr = 0 + + if (present(atrans)) then + call ain%cp_to_coo(acoo,info) + else + call ain%mv_to_coo(acoo,info) + end if + + + ! + ! Compute number of entries in the + ! halo part, sorted by destination process + ! + nr = desc_r%get_local_rows() + nc = p_desc_c%get_local_cols() + nzl = acoo%get_nzeros() + hlstart = p_desc_c%get_local_rows() + do k=1, nzl + j = acoo%ja(k) + if (j > hlstart) then + call p_desc_c%indxmap%fnd_halo_owner(j,proc,info) + sdsz(proc+1) = sdsz(proc+1) +1 + end if + end do + + ! + ! Exchange sizes, so as to know sends/receives. + ! This is different from the halo exchange because the + ! number of entries was not precomputed in the descriptor, + ! which was vector-oriented and not matrix-entry-oriented + ! + call mpi_alltoall(sdsz,1,psb_mpi_mpk_,& + & rvsz,1,psb_mpi_mpk_,icomm,minfo) + + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='mpi_alltoall') + goto 9999 + end if + nsnds = count(sdsz /= 0) + nrcvs = count(rvsz /= 0) + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Done initial alltoall',nsnds,nrcvs + + idxs = 0 + idxr = 0 + counter = 1 + Do proc = 0, np-1 + bsdindx(proc+1) = idxs + idxs = idxs + sdsz(proc+1) + brvindx(proc+1) = idxr + idxr = idxr + rvsz(proc+1) + Enddo + + tsdx = bsdindx + trvx = brvindx + + iszr = sum(rvsz) + iszs = sum(sdsz) + + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Sizes:',& + & ' Send:',sdsz(:),' Receive:',rvsz(:) + + call psb_ensure_size(max(iszs,1),iasnd,info) + if (info == psb_success_) call psb_ensure_size(max(iszs,1),jasnd,info) + if (info == psb_success_) call psb_ensure_size(max(iszs,1),valsnd,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='ensure_size') + goto 9999 + end if + + ! + ! Now, transpose the matrix, then split between itself + ! and the send buffers + ! + call acoo%transp() + if (acoo%get_nzeros()/= nzl) then + write(0,*) me,'Something strange upon transpose: ',nzl,acoo%get_nzeros() + end if + nzl = acoo%get_nzeros() + hlstart = p_desc_c%get_local_rows() + + + nzd = 0 + do k = 1, nzl + j = acoo%ia(k) + if (j<=hlstart) then + nzd = nzd + 1 + acoo%ia(nzd) = acoo%ia(k) + acoo%ja(nzd) = acoo%ja(k) + acoo%val(nzd) = acoo%val(k) + else + call p_desc_c%indxmap%fnd_halo_owner(j,proc,info) + tsdx(proc+1) = tsdx(proc+1) +1 + iasnd(tsdx(proc+1)) = acoo%ia(k) + jasnd(tsdx(proc+1)) = acoo%ja(k) + valsnd(tsdx(proc+1)) = acoo%val(k) + end if + end do + call acoo%set_nzeros(nzd) + ! + ! Put halo entries in global numbering + ! + call desc_r%indxmap%l2gip(jasnd(1:iszs),info) + call p_desc_c%indxmap%l2gip(iasnd(1:iszs),info) + ! And exchange data. + ! Normally we'll use our SIMPLE A2AV and not MPI, because + ! the communication pattern is sparse, so ours is more + ! efficient. Using ACOO for the receive buffers. + nzl = acoo%get_nzeros() + call acoo%ensure_size(nzl+iszr) + + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & acoo%val(nzl+1:nzl+iszr),acoo%ia(nzl+1:nzl+iszr),& + & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& + & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& + & acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& + & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_mpi_) + + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_spk_,& + & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_c_spk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select + + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='alltoallv') + goto 9999 + end if + + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Done alltoallv' + + if (present(desc_rx)) then + ! + ! Extend the appropriate descriptor; started as R but on + ! transpose it now describes C + ! + call desc_r%clone(desc_rx,info) + call psb_cd_reinit(desc_rx,info) + ! + ! Take out non-local rows + ! + call psb_glob_to_loc(acoo%ia(nzl+1:nzl+iszr),p_desc_c,info,iact='I',owned=.true.) + call psb_coo_clean_negidx_inner(iszr,acoo%ia(nzl+1:nzl+iszr),acoo%ja(nzl+1:nzl+iszr),& + & acoo%val(nzl+1:nzl+iszr),nzt,info) + call desc_rx%g2lip_ins(acoo%ja(nzl+1:nzl+nzt),info) + call psb_cdasb(desc_rx,info) + nzl = nzl + nzt + call acoo%set_nzeros(nzl) + nzl = acoo%get_nzeros() + call acoo%set_sorted(.false.) + ! + ! Insert to extend descriptor + ! + call acoo%set_nrows(p_desc_c%get_local_rows()) + call acoo%set_ncols(desc_rx%get_local_cols()) + !write(0,*) me,' Trans RX ',acoo%get_nrows(),acoo%get_ncols(),acoo%get_nzeros() + else + ! + ! + ! Take out non-local rows + ! + call psb_glob_to_loc(acoo%ia(nzl+1:nzl+iszr),p_desc_c,info,iact='I',owned=.true.) + call psb_glob_to_loc(acoo%ja(nzl+1:nzl+iszr),desc_r,info,iact='I') + call psb_coo_clean_negidx_inner(iszr,acoo%ia(nzl+1:nzl+iszr),acoo%ja(nzl+1:nzl+iszr),& + & acoo%val(nzl+1:nzl+iszr),nzt,info) + + nzl = nzl + nzt + call acoo%set_nzeros(nzl) + nzl = acoo%get_nzeros() + call acoo%set_sorted(.false.) + + call acoo%set_nrows(p_desc_c%get_local_rows()) + call acoo%set_ncols(desc_r%get_local_cols()) + !write(0,*) me,' Trans R- ',acoo%get_nrows(),acoo%get_ncols(),acoo%get_nzeros() + end if + +!!$ write(0,*) me,' Sanity check after rx%g2l :',count(acoo%ja(1:nzl)<0) + + + call acoo%fix(info) + nzl = acoo%get_nzeros() + + if (present(atrans)) then + call atrans%mv_from_coo(acoo,info) + else + call ain%mv_from_coo(acoo,info) + end if + Deallocate(brvindx,bsdindx,rvsz,sdsz,& + & iasnd,jasnd,valsnd,stat=info) + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Done' + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(ictxt,err_act) + + return +end subroutine psb_lc_coo_glob_transpose + +subroutine psb_c_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) +#ifdef MPI_MOD + use mpi +#endif + use psb_base_mod, psb_protect_name => psb_c_coo_glob_transpose + Implicit None +#ifdef MPI_H + include 'mpif.h' +#endif + type(psb_c_coo_sparse_mat), intent(inout) :: ain + type(psb_desc_type), intent(inout), target :: desc_r + type(psb_c_coo_sparse_mat), intent(out), optional :: atrans + type(psb_desc_type), intent(inout), target, optional :: desc_c + type(psb_desc_type), intent(out), optional :: desc_rx + integer(psb_ipk_), intent(out) :: info + + integer(psb_ipk_) :: ictxt, np,me + integer(psb_ipk_) :: counter,proc, err_act, j + integer(psb_ipk_) :: i, k, idx, r, ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& + & l1, nsnds, nrcvs, nr,nc,nzl, hlstart, nzd + integer(psb_lpk_) :: nzt, lszr + integer(psb_mpk_) :: icomm, minfo + integer(psb_mpk_), allocatable :: brvindx(:), & + & rvsz(:), bsdindx(:), sdsz(:), tsdx(:), trvx(:) + integer(psb_ipk_), allocatable :: halo_owner(:) + integer(psb_lpk_), allocatable :: iasnd(:), jasnd(:),iarcv(:),jarcv(:) + complex(psb_spk_), allocatable :: valsnd(:) + type(psb_c_coo_sparse_mat), allocatable :: acoo + logical :: rowcnv_,colcnv_,rowscale_,colscale_,outcol_glob_ + type(psb_desc_type), pointer :: p_desc_c + character(len=5) :: outfmt_ + integer(psb_ipk_) :: debug_level, debug_unit + character(len=20) :: name, ch_err + + if(psb_get_errstatus() /= 0) return + info=psb_success_ + name='mld_glob_transpose' + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt = desc_r%get_context() + icomm = desc_r%get_mpic() + + Call psb_info(ictxt, me, np) + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),': Start' + + if (present(desc_c)) then + p_desc_c => desc_c + else + p_desc_c => desc_r + end if + + Allocate(brvindx(np+1),& + & rvsz(np),sdsz(np),bsdindx(np+1), acoo,stat=info) + + if (info /= psb_success_) then + info=psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + end if + + + sdsz(:)=0 + rvsz(:)=0 + l1 = 0 + brvindx(1) = 0 + bsdindx(1) = 0 + counter=1 + idx = 0 + idxs = 0 + idxr = 0 + + if (present(atrans)) then + call ain%cp_to_coo(acoo,info) + else + call ain%mv_to_coo(acoo,info) + end if + + + ! + ! Compute number of entries in the + ! halo part, sorted by destination process + ! + nr = desc_r%get_local_rows() + nc = p_desc_c%get_local_cols() + nzl = acoo%get_nzeros() + hlstart = p_desc_c%get_local_rows() + do k=1, nzl + j = acoo%ja(k) + if (j > hlstart) then + call p_desc_c%indxmap%fnd_halo_owner(j,proc,info) + sdsz(proc+1) = sdsz(proc+1) +1 + end if + end do + + ! + ! Exchange sizes, so as to know sends/receives. + ! This is different from the halo exchange because the + ! number of entries was not precomputed in the descriptor, + ! which was vector-oriented and not matrix-entry-oriented + ! + call mpi_alltoall(sdsz,1,psb_mpi_mpk_,& + & rvsz,1,psb_mpi_mpk_,icomm,minfo) + + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='mpi_alltoall') + goto 9999 + end if + nsnds = count(sdsz /= 0) + nrcvs = count(rvsz /= 0) + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Done initial alltoall',nsnds,nrcvs + + idxs = 0 + idxr = 0 + counter = 1 + Do proc = 0, np-1 + bsdindx(proc+1) = idxs + idxs = idxs + sdsz(proc+1) + brvindx(proc+1) = idxr + idxr = idxr + rvsz(proc+1) + Enddo + + tsdx = bsdindx + trvx = brvindx + + iszr = sum(rvsz) + iszs = sum(sdsz) + + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Sizes:',& + & ' Send:',sdsz(:),' Receive:',rvsz(:) + + call psb_ensure_size(max(iszs,1),iasnd,info) + if (info == psb_success_) call psb_ensure_size(max(iszs,1),jasnd,info) + if (info == psb_success_) call psb_ensure_size(max(iszs,1),valsnd,info) + if (info == psb_success_) call psb_ensure_size(max(iszr,1),iarcv,info) + if (info == psb_success_) call psb_ensure_size(max(iszr,1),jarcv,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='ensure_size') + goto 9999 + end if + + ! + ! Now, transpose the matrix, then split between itself + ! and the send buffers + ! + call acoo%transp() + if (acoo%get_nzeros()/= nzl) then + write(0,*) me,'Something strange upon transpose: ',nzl,acoo%get_nzeros() + end if + nzl = acoo%get_nzeros() + hlstart = p_desc_c%get_local_rows() + + + nzd = 0 + do k = 1, nzl + j = acoo%ia(k) + if (j<=hlstart) then + nzd = nzd + 1 + acoo%ia(nzd) = acoo%ia(k) + acoo%ja(nzd) = acoo%ja(k) + acoo%val(nzd) = acoo%val(k) + else + call p_desc_c%indxmap%fnd_halo_owner(j,proc,info) + tsdx(proc+1) = tsdx(proc+1) +1 + iasnd(tsdx(proc+1)) = acoo%ia(k) + jasnd(tsdx(proc+1)) = acoo%ja(k) + valsnd(tsdx(proc+1)) = acoo%val(k) + end if + end do + call acoo%set_nzeros(nzd) + ! + ! Put halo entries in global numbering + ! + call desc_r%indxmap%l2gip(jasnd(1:iszs),info) + call p_desc_c%indxmap%l2gip(iasnd(1:iszs),info) + ! And exchange data. + ! Normally we'll use our SIMPLE A2AV and not MPI, because + ! the communication pattern is sparse, so ours is more + ! efficient. Using ACOO for the receive buffers. + nzl = acoo%get_nzeros() + call acoo%ensure_size(nzl+iszr) + + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & acoo%val(nzl+1:nzl+iszr),iarcv(1:iszr),& + & jarcv(1:iszr),rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& + & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& + & iarcv(1:iszr),rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& + & jarcv(1:iszr),rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_mpi_) + + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_spk_,& + & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_c_spk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & iarcv(1:iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & jarcv(1:iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select + + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='alltoallv') + goto 9999 + end if + + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Done alltoallv' + + if (present(desc_rx)) then + ! + ! Extend the appropriate descriptor; started as R but on + ! transpose it now describes C + ! + call desc_r%clone(desc_rx,info) + call psb_cd_reinit(desc_rx,info) + ! + ! Take out non-local rows + ! + call psb_glob_to_loc(iarcv(1:iszr),p_desc_c,info,iact='I',owned=.true.) + lszr = iszr + call psb_coo_clean_negidx_inner(lszr,iarcv(1:iszr),jarcv(1:iszr),& + & acoo%val(nzl+1:nzl+iszr),nzt,info) + call desc_rx%g2lip_ins(jarcv(1:nzt),info) + call psb_cdasb(desc_rx,info) + acoo%ia(nzl+1:nzl+nzt) = iarcv(1:nzt) + acoo%ja(nzl+1:nzl+nzt) = jarcv(1:nzt) + nzl = nzl + nzt + call acoo%set_nzeros(nzl) + nzl = acoo%get_nzeros() + call acoo%set_sorted(.false.) + ! + ! Insert to extend descriptor + ! + call acoo%set_nrows(p_desc_c%get_local_rows()) + call acoo%set_ncols(desc_rx%get_local_cols()) + !write(0,*) me,' Trans RX ',acoo%get_nrows(),acoo%get_ncols(),acoo%get_nzeros() + else + ! + ! + ! Take out non-local rows + ! + call psb_glob_to_loc(iarcv(1:iszr),p_desc_c,info,iact='I',owned=.true.) + call psb_glob_to_loc(jarcv(1:iszr),desc_r,info,iact='I') + lszr = iszr + call psb_coo_clean_negidx_inner(lszr,iarcv(1:iszr),jarcv(1:iszr),& + & acoo%val(nzl+1:nzl+iszr),nzt,info) + acoo%ia(nzl+1:nzl+nzt) = iarcv(1:nzt) + acoo%ja(nzl+1:nzl+nzt) = jarcv(1:nzt) + nzl = nzl + nzt + call acoo%set_nzeros(nzl) + nzl = acoo%get_nzeros() + call acoo%set_sorted(.false.) + + call acoo%set_nrows(p_desc_c%get_local_rows()) + call acoo%set_ncols(desc_r%get_local_cols()) + !write(0,*) me,' Trans R- ',acoo%get_nrows(),acoo%get_ncols(),acoo%get_nzeros() + end if + +!!$ write(0,*) me,' Sanity check after rx%g2l :',count(acoo%ja(1:nzl)<0) + + + call acoo%fix(info) + nzl = acoo%get_nzeros() + + if (present(atrans)) then + call atrans%mv_from_coo(acoo,info) + else + call ain%mv_from_coo(acoo,info) + end if + Deallocate(brvindx,bsdindx,rvsz,sdsz,& + & iasnd,jasnd,valsnd,& + & iarcv,jarcv,stat=info) + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Done' + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(ictxt,err_act) + + return +end subroutine psb_c_coo_glob_transpose + +subroutine psb_c_simple_glob_transpose_ip(ain,desc_a,info) + use psb_base_mod, psb_protect_name => psb_c_simple_glob_transpose_ip + implicit none + type(psb_cspmat_type), intent(inout) :: ain + type(psb_desc_type) :: desc_a + integer(psb_ipk_), intent(out) :: info + + ! + ! BEWARE: This routine works under the assumption + ! that the same DESC_A works for both A and A^T, which + ! essentially means that A has a symmetric pattern. + ! + type(psb_c_coo_sparse_mat) :: tmpc1, tmpc2 + integer(psb_ipk_) :: nz1, nz2, nzh, nz + integer(psb_ipk_) :: ictxt, me, np + integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz + integer(psb_lpk_), allocatable :: ilv(:) + character(len=80) :: aname + logical, parameter :: debug=.false., dump=.false., debug_sync=.false. + + ictxt = desc_a%get_context() + call psb_info(ictxt,me,np) + + nrow = desc_a%get_local_rows() + ncol = desc_a%get_local_cols() + if (debug_sync) then + call psb_barrier(ictxt) + if (me == 0) write(0,*) 'Start htranspose ' + end if + + + call ain%mv_to(tmpc1) + call psb_glob_transpose(tmpc1, desc_a,info,atrans=tmpc2) + call ain%mv_from(tmpc2) + + if (dump) then + block + type(psb_lcspmat_type) :: aglb + write(aname,'(a,i3.3,a)') 'atran-',me,'.mtx' + call ain%print(fname=aname,head='atrans ') + call psb_gather(aglb,ain,desc_a,info) + if (me==psb_root_) then + write(aname,'(a,i3.3,a)') 'atran.mtx' + call aglb%print(fname=aname,head='Test ') + end if + end block + end if + +end subroutine psb_c_simple_glob_transpose_ip + +subroutine psb_c_simple_glob_transpose(ain,aout,desc_a,info) + use psb_base_mod, psb_protect_name => psb_c_simple_glob_transpose + implicit none + type(psb_cspmat_type), intent(in) :: ain + type(psb_cspmat_type), intent(out) :: aout + type(psb_desc_type) :: desc_a + integer(psb_ipk_), intent(out) :: info + + ! + ! BEWARE: This routine works under the assumption + ! that the same DESC_A works for both A and A^T, which + ! essentially means that A has a symmetric pattern. + ! + type(psb_c_coo_sparse_mat) :: tmpc1, tmpc2 + integer(psb_ipk_) :: nz1, nz2, nzh, nz + integer(psb_ipk_) :: ictxt, me, np + integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz + integer(psb_lpk_), allocatable :: ilv(:) + character(len=80) :: aname + logical, parameter :: debug=.false., dump=.false., debug_sync=.false. + + ictxt = desc_a%get_context() + call psb_info(ictxt,me,np) + + nrow = desc_a%get_local_rows() + ncol = desc_a%get_local_cols() + if (debug_sync) then + call psb_barrier(ictxt) + if (me == 0) write(0,*) 'Start htranspose ' + end if + + + call ain%cp_to(tmpc1) + call psb_glob_transpose(tmpc1, desc_a,info,atrans=tmpc2) + call aout%mv_from(tmpc2) + + if (dump) then + block + type(psb_lcspmat_type) :: aglb + + write(aname,'(a,i3.3,a)') 'atran-',me,'.mtx' + call aout%print(fname=aname,head='atrans ') + call psb_gather(aglb,aout,desc_a,info) + if (me==psb_root_) then + write(aname,'(a,i3.3,a)') 'atran.mtx' + call aglb%print(fname=aname,head='Test ') + end if + end block + end if + +end subroutine psb_c_simple_glob_transpose + +subroutine psb_lc_simple_glob_transpose_ip(ain,desc_a,info) + use psb_base_mod, psb_protect_name => psb_lc_simple_glob_transpose_ip + implicit none + type(psb_lcspmat_type), intent(inout) :: ain + type(psb_desc_type) :: desc_a + integer(psb_ipk_), intent(out) :: info + + ! + ! BEWARE: This routine works under the assumption + ! that the same DESC_A works for both A and A^T, which + ! essentially means that A has a symmetric pattern. + ! + type(psb_lc_coo_sparse_mat) :: tmpc1, tmpc2 + integer(psb_ipk_) :: nz1, nz2, nzh, nz + integer(psb_ipk_) :: ictxt, me, np + integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz + integer(psb_lpk_), allocatable :: ilv(:) + character(len=80) :: aname + logical, parameter :: debug=.false., dump=.false., debug_sync=.false. + + ictxt = desc_a%get_context() + call psb_info(ictxt,me,np) + + nrow = desc_a%get_local_rows() + ncol = desc_a%get_local_cols() + if (debug_sync) then + call psb_barrier(ictxt) + if (me == 0) write(0,*) 'Start htranspose ' + end if + + + call ain%mv_to(tmpc1) + call psb_glob_transpose(tmpc1, desc_a,info,atrans=tmpc2) + call ain%mv_from(tmpc2) + + if (dump) then + block + type(psb_lcspmat_type) :: aglb + write(aname,'(a,i3.3,a)') 'atran-',me,'.mtx' + call ain%print(fname=aname,head='atrans ',iv=ilv) + call psb_gather(aglb,ain,desc_a,info) + if (me==psb_root_) then + write(aname,'(a,i3.3,a)') 'atran.mtx' + call aglb%print(fname=aname,head='Test ') + end if + end block + end if + +end subroutine psb_lc_simple_glob_transpose_ip + +subroutine psb_lc_simple_glob_transpose(ain,aout,desc_a,info) + use psb_base_mod, psb_protect_name => psb_lc_simple_glob_transpose + implicit none + type(psb_lcspmat_type), intent(in) :: ain + type(psb_lcspmat_type), intent(out) :: aout + type(psb_desc_type) :: desc_a + integer(psb_ipk_), intent(out) :: info + + ! + ! BEWARE: This routine works under the assumption + ! that the same DESC_A works for both A and A^T, which + ! essentially means that A has a symmetric pattern. + ! + type(psb_lc_coo_sparse_mat) :: tmpc1, tmpc2 + integer(psb_ipk_) :: nz1, nz2, nzh, nz + integer(psb_ipk_) :: ictxt, me, np + integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz + integer(psb_lpk_), allocatable :: ilv(:) + character(len=80) :: aname + logical, parameter :: debug=.false., dump=.false., debug_sync=.false. + + ictxt = desc_a%get_context() + call psb_info(ictxt,me,np) + + nrow = desc_a%get_local_rows() + ncol = desc_a%get_local_cols() + if (debug_sync) then + call psb_barrier(ictxt) + if (me == 0) write(0,*) 'Start htranspose ' + end if + + + call ain%cp_to(tmpc1) + call psb_glob_transpose(tmpc1, desc_a,info,atrans=tmpc2) + call aout%mv_from(tmpc2) + + if (dump) then + block + type(psb_lcspmat_type) :: aglb + + write(aname,'(a,i3.3,a)') 'atran-',me,'.mtx' + call aout%print(fname=aname,head='atrans ',iv=ilv) + call psb_gather(aglb,aout,desc_a,info) + if (me==psb_root_) then + write(aname,'(a,i3.3,a)') 'atran.mtx' + call aglb%print(fname=aname,head='Test ') + end if + end block + end if + +end subroutine psb_lc_simple_glob_transpose + + diff --git a/base/tools/psb_c_par_csr_spspmm.f90 b/base/tools/psb_c_par_csr_spspmm.f90 index d835e27d2..058d1a627 100644 --- a/base/tools/psb_c_par_csr_spspmm.f90 +++ b/base/tools/psb_c_par_csr_spspmm.f90 @@ -39,7 +39,7 @@ ! C = A * B ! ! where all the matrices are stored in CSR. On input and output the matrices -! are stored with column indices in local numbering, but inermediate quantities +! are stored with column indices in local numbering, but intermediate quantities ! are in global numbering because gathering the halo of B to multiply it ! by A implies a potential enlargement of the support. ! Also, B may have a column index space different from its row index space, @@ -61,98 +61,100 @@ ! info - integer, output. ! Error code. ! -!!$Subroutine psb_c_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) -!!$ use psb_base_mod, psb_protect_name => psb_c_par_csr_spspmm -!!$ Implicit None -!!$ -!!$ type(psb_c_csr_sparse_mat),intent(in) :: acsr -!!$ type(psb_c_csr_sparse_mat),intent(inout) :: bcsr -!!$ type(psb_c_csr_sparse_mat),intent(out) :: ccsr -!!$ type(psb_desc_type),intent(in) :: desc_a -!!$ type(psb_desc_type),intent(inout) :: desc_c -!!$ integer(psb_ipk_), intent(out) :: info -!!$ integer(psb_ipk_), intent(in), optional :: data -!!$ ! ...local scalars.... -!!$ integer(psb_ipk_) :: ictxt, np,me -!!$ integer(psb_ipk_) :: ncol, nnz -!!$ type(psb_c_csr_sparse_mat) :: tcsr1 -!!$ logical :: update_desc_c -!!$ integer(psb_ipk_) :: debug_level, debug_unit, err_act -!!$ character(len=20) :: name, ch_err -!!$ -!!$ if(psb_get_errstatus() /= 0) return -!!$ info=psb_success_ -!!$ name='psb_c_p_csr_spspmm' -!!$ call psb_erractionsave(err_act) -!!$ if (psb_errstatus_fatal()) then -!!$ info = psb_err_internal_error_ ; goto 9999 -!!$ end if -!!$ debug_unit = psb_get_debug_unit() -!!$ debug_level = psb_get_debug_level() -!!$ -!!$ ictxt = desc_a%get_context() -!!$ -!!$ call psb_info(ictxt, me, np) -!!$ -!!$ if (debug_level >= psb_debug_outer_) & -!!$ & write(debug_unit,*) me,' ',trim(name),': Start' -!!$ -!!$ update_desc_c = desc_c%is_bld() -!!$ -!!$ ! -!!$ ! This is a bit tricky. -!!$ ! DESC_A is the descriptor of (the columns of) A, and therefore -!!$ ! of the rows of B; the columns of B, in the intended usage, span -!!$ ! a different space for which we have DESC_C. -!!$ ! We are gathering the halo rows of B to multiply by A; -!!$ ! now, the columns of B would ideally be kept in -!!$ ! global numbering, so that we can call this repeatedly to accumulate -!!$ ! the product of multiple operators, and convert to local numbering -!!$ ! at the last possible moment. However, this would imply calling -!!$ ! the serial SPSPMM with a matrix B with the GLOBAL number of columns -!!$ ! and this could be very expensive in memory. The solution is to keep B -!!$ ! in local numbering, so that only columns really appearing count, but to -!!$ ! expand the descriptor when gathering the halo, because by performing -!!$ ! the products we are extending the support of the operator; hence -!!$ ! this routine is intended to be called with a temporary descriptor -!!$ ! DESC_C which is in the BUILD state, to allow for such expansion -!!$ ! across multiple products. -!!$ ! The caller will at some later point finalize the descriptor DESC_C. -!!$ ! -!!$ -!!$ ncol = desc_a%get_local_cols() -!!$ call psb_sphalo(bcsr,desc_a,tcsr1,info,& -!!$ & colcnv=.true.,rowscale=.true.,outcol_glob=.true.,col_desc=desc_c,data=data) -!!$ nnz = tcsr1%get_nzeros() -!!$ if (update_desc_c) then -!!$ call desc_c%indxmap%g2lip_ins(tcsr1%ja(1:nnz),info) -!!$ else -!!$ call desc_c%indxmap%g2lip(tcsr1%ja(1:nnz),info) -!!$ end if -!!$ if (info == psb_success_) call psb_rwextd(ncol,bcsr,info,b=tcsr1) -!!$ if (info == psb_success_) call tcsr1%free() -!!$ if(info /= psb_success_) then -!!$ call psb_errpush(psb_err_internal_error_,name,a_err='Extend am3') -!!$ goto 9999 -!!$ end if -!!$ call bcsr%set_ncols(desc_c%get_local_cols()) -!!$ -!!$ -!!$ if (debug_level >= psb_debug_outer_) & -!!$ & write(debug_unit,*) me,' ',trim(name),& -!!$ & 'starting spspmm 3' -!!$ if (debug_level >= psb_debug_outer_) write(debug_unit,*) me,' ',trim(name),& -!!$ & 'starting spspmm ',acsr%get_nrows(),acsr%get_ncols(),bcsr%get_nrows(),bcsr%get_ncols() -!!$ call psb_spspmm(acsr,bcsr,ccsr,info) -!!$ -!!$ call psb_erractionrestore(err_act) -!!$ return -!!$ -!!$9999 call psb_error_handler(ictxt,err_act) -!!$ -!!$ return -!!$ -!!$End Subroutine psb_c_par_csr_spspmm +Subroutine psb_c_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) + use psb_base_mod, psb_protect_name => psb_c_par_csr_spspmm + Implicit None + + type(psb_c_csr_sparse_mat),intent(in) :: acsr + type(psb_c_csr_sparse_mat),intent(inout) :: bcsr + type(psb_c_csr_sparse_mat),intent(out) :: ccsr + type(psb_desc_type),intent(in) :: desc_a + type(psb_desc_type),intent(inout) :: desc_c + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: data + ! ...local scalars.... + integer(psb_ipk_) :: ictxt, np,me + integer(psb_ipk_) :: ncol, nnz + type(psb_lc_csr_sparse_mat) :: ltcsr + type(psb_c_csr_sparse_mat) :: tcsr + logical :: update_desc_c + integer(psb_ipk_) :: debug_level, debug_unit, err_act + character(len=20) :: name, ch_err + + if(psb_get_errstatus() /= 0) return + info=psb_success_ + name='psb_c_p_csr_spspmm' + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt = desc_a%get_context() + + call psb_info(ictxt, me, np) + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),': Start' + + update_desc_c = desc_c%is_bld() + + ! + ! This is a bit tricky. + ! DESC_A is the descriptor of (the columns of) A, and therefore + ! of the rows of B; the columns of B, in the intended usage, span + ! a different space for which we have DESC_C. + ! We are gathering the halo rows of B to multiply by A; + ! now, the columns of B would ideally be kept in + ! global numbering, so that we can call this repeatedly to accumulate + ! the product of multiple operators, and convert to local numbering + ! at the last possible moment. However, this would imply calling + ! the serial SPSPMM with a matrix B with the GLOBAL number of columns + ! and this could be very expensive in memory. The solution is to keep B + ! in local numbering, so that only columns really appearing count, but to + ! expand the descriptor when gathering the halo, because by performing + ! the products we are extending the support of the operator; hence + ! this routine is intended to be called with a temporary descriptor + ! DESC_C which is in the BUILD state, to allow for such expansion + ! across multiple products. + ! The caller will at some later point finalize the descriptor DESC_C. + ! + + ncol = desc_a%get_local_cols() + call psb_sphalo(bcsr,desc_a,ltcsr,info,& + & colcnv=.true.,rowscale=.true.,outcol_glob=.true.,col_desc=desc_c,data=data) + nnz = ltcsr%get_nzeros() + if (update_desc_c) then + call desc_c%indxmap%g2lip_ins(ltcsr%ja(1:nnz),info) + else + call desc_c%indxmap%g2lip(ltcsr%ja(1:nnz),info) + end if + call ltcsr%mv_to_ifmt(tcsr,info) + if (info == psb_success_) call psb_rwextd(ncol,bcsr,info,b=tcsr) + if (info == psb_success_) call tcsr%free() + if(info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,a_err='Extend am3') + goto 9999 + end if + call bcsr%set_ncols(desc_c%get_local_cols()) + + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),& + & 'starting spspmm 3' + if (debug_level >= psb_debug_outer_) write(debug_unit,*) me,' ',trim(name),& + & 'starting spspmm ',acsr%get_nrows(),acsr%get_ncols(),bcsr%get_nrows(),bcsr%get_ncols() + call psb_spspmm(acsr,bcsr,ccsr,info) + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(ictxt,err_act) + + return + +End Subroutine psb_c_par_csr_spspmm Subroutine psb_lc_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) use psb_base_mod, psb_protect_name => psb_lc_par_csr_spspmm diff --git a/base/tools/psb_cd_inloc.f90 b/base/tools/psb_cd_inloc.f90 index 1cb2c9137..010901b59 100644 --- a/base/tools/psb_cd_inloc.f90 +++ b/base/tools/psb_cd_inloc.f90 @@ -67,8 +67,8 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx,usehash) & nov(:), ov_idx(:,:), temp_ovrlap(:) integer(psb_lpk_), allocatable :: vl(:), ix(:), l_temp_ovrlap(:) integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_mpk_) :: iictxt - real(psb_dpk_) :: t0, t1, t2, t3, t4, t5 + real(psb_dpk_) :: t0, t1, t2, t3, t4, t5 + logical, parameter :: debug_size=.false. logical :: do_timings=.false. logical :: check_, islarge, usehash_ character(len=20) :: name @@ -84,14 +84,13 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx,usehash) call psb_info(ictxt, me, np) if (debug_level >= psb_debug_ext_) & & write(debug_unit,*) me,' ',trim(name),': start',np - iictxt = ictxt if (do_timings) then call psb_barrier(ictxt) t0 = psb_wtime() end if loc_row = size(v) - m = maxval(v) - nrt = loc_row + m = maxval(v) + nrt = loc_row call psb_sum(ictxt,nrt) call psb_max(ictxt,m) @@ -148,12 +147,14 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx,usehash) islarge = psb_cd_is_large_size(m) - allocate(vl(loc_row),ix(loc_row),stat=info) + allocate(vl(max(loc_row,ione)),ix(max(loc_row,ione)),stat=info) if (info /= psb_success_) then info=psb_err_alloc_dealloc_ call psb_errpush(info,name,l_err=l_err) goto 9999 end if + if (debug_size) & + & write(debug_unit,*) me,' ',trim(name),': sizes',loc_row,m,nrt,check_ ! ! Checks for valid input: @@ -164,6 +165,9 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx,usehash) ! if (check_.or.(.not.islarge)) then + if (debug_size) & + & write(debug_unit,*) me,' ',trim(name),': Going for global checks' + allocate(tmpgidx(m,2),stat=info) if (info /= psb_success_) then info=psb_err_alloc_dealloc_ @@ -228,6 +232,9 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx,usehash) write(psb_err_unit,*) trim(name),' : in the global sizes!',m,nrt end if end if + if (debug_size) & + & write(debug_unit,*) me,' ',trim(name),': After global checks ' + if (do_timings) then call psb_barrier(ictxt) t1 = psb_wtime() @@ -254,7 +261,7 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx,usehash) end do end if call psb_msort(vl,ix,flag=psb_sort_keep_idx_) - nlu = 1 + nlu = min(1,loc_row) do i=2,loc_row if (vl(i) /= vl(nlu)) then nlu = nlu + 1 @@ -264,6 +271,9 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx,usehash) end do call psb_msort(ix(1:nlu),vl(1:nlu),flag=psb_sort_keep_idx_) + if (debug_size) & + & write(debug_unit,*) me,' ',trim(name),': After sort ',nlu + call psb_nullify_desc(desc) if (do_timings) then call psb_barrier(ictxt) @@ -276,7 +286,10 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx,usehash) ! then novrl = 0, hence all accesses to tmpgidx ! are safe. ! - if (novrl > 0) then + if (novrl > 0) then + if (debug_size) & + & write(debug_unit,*) me,' ',trim(name),': Check overlap ' + if (debug_level >= psb_debug_ext_) & & write(debug_unit,*) me,' ',trim(name),': code for NOVRL>0',novrl,npr_ov @@ -320,6 +333,9 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx,usehash) call psb_msort(ov_idx(:,1),ix=ov_idx(:,2),flag=psb_sort_keep_idx_) end if + if (debug_size) & + & write(debug_unit,*) me,' ',trim(name),': Done overlap ' + ! allocate work vector allocate(l_temp_ovrlap(max(1,2*loc_row)),desc%lprm(1),& @@ -375,7 +391,9 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx,usehash) call psb_barrier(ictxt) t3 = psb_wtime() end if - + if (debug_size) & + & write(debug_unit,*) me,' ',trim(name),': Allocate indxmap' + if (np == 1) then allocate(psb_repl_map :: desc%indxmap, stat=info) else @@ -388,11 +406,15 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx,usehash) select type(aa => desc%indxmap) type is (psb_repl_map) - call aa%repl_map_init(iictxt,m,info) + call aa%repl_map_init(ictxt,m,info) class default - call aa%init(iictxt,vl(1:nlu),info) + call aa%init(ictxt,vl(1:nlu),info) end select + if (debug_size) & + & write(debug_unit,*) me,' ',trim(name),': Done init indxmap' + + if (do_timings) then call psb_barrier(ictxt) t4 = psb_wtime() @@ -420,6 +442,8 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx,usehash) end if end block if (info == psb_success_) call psi_bld_tmpovrl(temp_ovrlap,desc,info) + if (debug_size) & + & write(debug_unit,*) me,' ',trim(name),': Done bld_tmpovrl' if (info == psb_success_) deallocate(temp_ovrlap,vl,ix,stat=info) if ((info == psb_success_).and.(allocated(tmpgidx)))& @@ -455,6 +479,8 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx,usehash) write(0,*) ' Phase 5 : ', t5 end if end if + if (debug_size) & + & write(debug_unit,*) me,' ',trim(name),': Done cd_inloc' call psb_erractionrestore(err_act) return diff --git a/base/tools/psb_cd_reinit.f90 b/base/tools/psb_cd_reinit.f90 index d579ba95e..15dbbc590 100644 --- a/base/tools/psb_cd_reinit.f90 +++ b/base/tools/psb_cd_reinit.f90 @@ -69,6 +69,9 @@ Subroutine psb_cd_reinit(desc,info) call psb_move_alloc(tmp_halo,desc%halo_index,info) call psb_move_alloc(tmp_ext,desc%ext_index,info) call desc%indxmap%reinit(info) +!!$ if (me == 0) write(0,*) 'On cdreinit status :',& +!!$ & allocated(desc%indxmap%p_adjcncy),allocated(desc%indxmap%halo_owner), & +!!$ & desc%get_fmt() ! call psb_cd_set_bld(desc,info) end if diff --git a/base/tools/psb_cd_renum_block.F90 b/base/tools/psb_cd_renum_block.F90 index 531d14dfb..1d64a09e0 100644 --- a/base/tools/psb_cd_renum_block.F90 +++ b/base/tools/psb_cd_renum_block.F90 @@ -53,9 +53,9 @@ subroutine psb_cd_renum_block(desc_in, desc_out, info) type(psb_gen_block_map), allocatable :: blck_map integer(psb_ipk_), allocatable :: lidx(:),reflidx(:) integer(psb_lpk_), allocatable :: gidx(:),vnl(:) - integer(psb_ipk_) :: i,n_row, n_col - integer(psb_lpk_) :: li,n_glob_row, n_glob_col - integer(psb_ipk_) :: np,me,ictxt, err_act + integer(psb_ipk_) :: i, n_row, n_col + integer(psb_lpk_) :: li, n_glob_row, n_glob_col + integer(psb_ipk_) :: np, me, ictxt, err_act integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name diff --git a/base/tools/psb_cd_switch_ovl_indxmap.f90 b/base/tools/psb_cd_switch_ovl_indxmap.f90 index ea8aabcfc..b2bdd9e42 100644 --- a/base/tools/psb_cd_switch_ovl_indxmap.f90 +++ b/base/tools/psb_cd_switch_ovl_indxmap.f90 @@ -51,7 +51,6 @@ Subroutine psb_cd_switch_ovl_indxmap(desc,info) integer(psb_lpk_), allocatable :: vl(:) integer(psb_ipk_) :: debug_level, debug_unit, ierr(5) - integer(psb_mpk_) :: iictxt character(len=20) :: name, ch_err name='cd_switch_ovl_indxmap' @@ -66,7 +65,6 @@ Subroutine psb_cd_switch_ovl_indxmap(desc,info) If (debug_level >= psb_debug_outer_) & & Write(debug_unit,*) me,' ',trim(name),& & ': start' - iictxt = ictxt mglob = desc%get_global_rows() n_row = desc%get_local_rows() n_col = desc%get_local_cols() @@ -99,7 +97,7 @@ Subroutine psb_cd_switch_ovl_indxmap(desc,info) end if if (info == psb_success_)& - & call desc%indxmap%init(iictxt,vl(1:n_row),info) + & call desc%indxmap%init(ictxt,vl(1:n_row),info) if (info == psb_success_) call psb_cd_set_bld(desc,info) if (info == psb_success_) & & call desc%indxmap%g2lip_ins(vl(n_row+1:n_col),info) diff --git a/base/tools/psb_cdall.f90 b/base/tools/psb_cdall.f90 index 0f0ec813a..15ce572fd 100644 --- a/base/tools/psb_cdall.f90 +++ b/base/tools/psb_cdall.f90 @@ -57,7 +57,6 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl,globalchec logical :: usehash_ integer(psb_ipk_), allocatable :: itmpv(:) integer(psb_lpk_), allocatable :: lvl(:) - integer(psb_mpk_) :: iictxt @@ -67,7 +66,6 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl,globalchec call psb_erractionsave(err_act) call psb_info(ictxt, me, np) - iictxt = ictxt if (count((/ present(vg),present(vl),& & present(parts),present(nl), present(repl) /)) /= 1) then info=psb_err_no_optional_arg_ @@ -159,9 +157,9 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl,globalchec select type(aa => desc%indxmap) type is (psb_repl_map) n_ = nl - call aa%repl_map_init(iictxt,n_,info) + call aa%repl_map_init(ictxt,n_,info) type is (psb_gen_block_map) - call aa%gen_block_map_init(iictxt,nl,info) + call aa%gen_block_map_init(ictxt,nl,info) class default ! This cannot happen info = psb_err_internal_error_ diff --git a/base/tools/psb_cdals.f90 b/base/tools/psb_cdals.f90 index dc8a28738..dfee41135 100644 --- a/base/tools/psb_cdals.f90 +++ b/base/tools/psb_cdals.f90 @@ -67,7 +67,6 @@ subroutine psb_cdals(m, n, parts, ictxt, desc, info) integer(psb_ipk_), allocatable :: prc_v(:) integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: me, np, nprocs - integer(psb_mpk_) :: iictxt character(len=20) :: name if(psb_get_errstatus() /= 0) return @@ -239,12 +238,11 @@ subroutine psb_cdals(m, n, parts, ictxt, desc, info) if (debug_level >= psb_debug_ext_) & & write(debug_unit,*) me,' ',trim(name),': End main loop:' ,loc_row,itmpov,info - iictxt = ictxt select type(aa => desc%indxmap) type is (psb_repl_map) - call aa%repl_map_init(iictxt,m,info) + call aa%repl_map_init(ictxt,m,info) class default - call aa%init(iictxt,loc_idx(1:k),info) + call aa%init(ictxt,loc_idx(1:k),info) end select diff --git a/base/tools/psb_cdalv.f90 b/base/tools/psb_cdalv.f90 index 1e433eaae..8b850f6be 100644 --- a/base/tools/psb_cdalv.f90 +++ b/base/tools/psb_cdalv.f90 @@ -64,7 +64,6 @@ subroutine psb_cdalv(v, ictxt, desc, info, flag) integer(psb_lpk_) :: l_err(5) integer(psb_ipk_), allocatable :: temp_ovrlap(:) integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_mpk_) :: iictxt character(len=20) :: name if(psb_get_errstatus() /= 0) return @@ -77,7 +76,6 @@ subroutine psb_cdalv(v, ictxt, desc, info, flag) call psb_info(ictxt, me, np) if (debug_level >= psb_debug_ext_) & & write(debug_unit,*) me,' ',trim(name),': ',np,me - iictxt = ictxt m = size(v) n = m !... check m and n parameters.... @@ -192,11 +190,11 @@ subroutine psb_cdalv(v, ictxt, desc, info, flag) select type(aa => desc%indxmap) type is (psb_repl_map) - call aa%repl_map_init(iictxt,m,info) + call aa%repl_map_init(ictxt,m,info) type is (psb_hash_map) - call aa%hash_map_init(iictxt,v,info) + call aa%hash_map_init(ictxt,v,info) type is (psb_glist_map) - call aa%glist_map_init(iictxt,v,info) + call aa%glist_map_init(ictxt,v,info) class default ! This cannot happen info = psb_err_internal_error_ diff --git a/base/tools/psb_cdins.f90 b/base/tools/psb_cdins.F90 similarity index 99% rename from base/tools/psb_cdins.f90 rename to base/tools/psb_cdins.F90 index 5e2192966..d1b186f94 100644 --- a/base/tools/psb_cdins.f90 +++ b/base/tools/psb_cdins.F90 @@ -45,6 +45,7 @@ ! ila(:) - integer(psb_ipk_), optional The row indices in local numbering ! jla(:) - integer(psb_ipk_), optional The col indices in local numbering ! +#if defined(IPK4) && defined(LPK8) subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla) use psb_base_mod, psb_protect_name => psb_cdinsrc use psi_mod @@ -61,7 +62,7 @@ subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla) lnz = nz call psb_cdins(lnz,ia,ja,desc_a,info,ila,jla) end subroutine psb_cdinsrc - +#endif subroutine psb_lcdinsrc(nz,ia,ja,desc_a,info,ila,jla) use psb_base_mod, psb_protect_name => psb_lcdinsrc use psi_mod @@ -180,6 +181,7 @@ end subroutine psb_lcdinsrc ! mask(:) - logical, optional, target ! lidx(:) - integer(psb_ipk_), optional User-defined local col indices ! +#if defined(IPK4) && defined(LPK8) subroutine psb_cdinsc(nz,ja,desc,info,jla,mask,lidx) use psb_base_mod, psb_protect_name => psb_cdinsc use psi_mod @@ -199,7 +201,7 @@ subroutine psb_cdinsc(nz,ja,desc,info,jla,mask,lidx) lnz = nz call psb_cdins(lnz,ja,desc,info,jla,mask,lidx) end subroutine psb_cdinsc - +#endif subroutine psb_lcdinsc(nz,ja,desc,info,jla,mask,lidx) use psb_base_mod, psb_protect_name => psb_lcdinsc use psi_mod diff --git a/base/tools/psb_cdrep.f90 b/base/tools/psb_cdrep.f90 index 61f0ac2ad..2ba47c2c9 100644 --- a/base/tools/psb_cdrep.f90 +++ b/base/tools/psb_cdrep.f90 @@ -118,7 +118,6 @@ subroutine psb_cdrep(m, ictxt, desc, info) integer(psb_lpk_) :: l_err(5),exch(2) integer(psb_ipk_) :: thalo(1), tovr(1), text(1) integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_mpk_) :: iictxt character(len=20) :: name if(psb_get_errstatus() /= 0) return @@ -131,7 +130,6 @@ subroutine psb_cdrep(m, ictxt, desc, info) call psb_info(ictxt, me, np) if (debug_level >= psb_debug_ext_) & & write(debug_unit,*) me,' ',trim(name),': ',np - iictxt = ictxt n = m !... check m and n parameters.... if (m < 1) then @@ -182,7 +180,7 @@ subroutine psb_cdrep(m, ictxt, desc, info) allocate(psb_repl_map :: desc%indxmap, stat=info) select type(aa => desc%indxmap) type is (psb_repl_map) - call aa%repl_map_init(iictxt,m,info) + call aa%repl_map_init(ictxt,m,info) class default ! This cannot happen info = psb_err_internal_error_ diff --git a/base/tools/psb_cspasb.f90 b/base/tools/psb_cspasb.f90 index ae5c0af2c..073fcbbd8 100644 --- a/base/tools/psb_cspasb.f90 +++ b/base/tools/psb_cspasb.f90 @@ -122,11 +122,11 @@ subroutine psb_cspasb(a,desc_a, info, afmt, upd, dupl, mold) end if - IF (debug_level >= psb_debug_ext_) then + if (debug_level >= psb_debug_ext_) then ch_err=a%get_fmt() write(debug_unit, *) me,' ',trim(name),': From SPCNV',& & info,' ',ch_err - end IF + end if if (psb_errstatus_fatal()) then info=psb_err_from_subroutine_ diff --git a/base/tools/psb_csphalo.F90 b/base/tools/psb_csphalo.F90 index f0432cc64..668f7d522 100644 --- a/base/tools/psb_csphalo.F90 +++ b/base/tools/psb_csphalo.F90 @@ -31,11 +31,26 @@ ! ! File: psb_csphalo.f90 ! -! Subroutine: psb_csphalo +! Subroutine: psb_csphalo psb_lcsphalo ! This routine does the retrieval of remote matrix rows. -! Note that retrieval is done through GTBLK, therefore it should work -! for any matrix format in A; as for the output, default is CSR. -! +! Retrieval is done through GETROW, therefore it should work +! for any matrix format in A; as for the output, default is CSR. +! +! There is also a specialized version lc_CSR whose interface +! is adapted for the needs of c_par_csr_spspmm. +! +! There are three possible exchange algorithms: +! 1. Use MPI_Alltoallv +! 2. Use psb_simple_a2av +! 3. Use psb_simple_triad_a2av +! Default choice is 3. The MPI variant has proved to be inefficient; +! that is because it is not persistent, therefore you pay the initialization price +! every time, and it is not optimized for a sparse communication pattern, +! most MPI implementations assume that all communications are non-empty. +! The PSB_SIMPLE variants reuse the same communicator, and go for a simplistic +! sequence of sends/receive that is quite efficient for a sparse communication +! pattern. To be refined/reviewed in the future to compare with neighbour +! persistent collectives. ! ! Arguments: ! a - type(psb_cspmat_type) The local part of input matrix A @@ -55,9 +70,6 @@ ! psb_comm_ext_ use ext_index ! psb_comm_ovrl_ DISABLED for this routine. ! -#undef SP_A2AV_MPI -#undef SP_A2AV_XI -#define SP_A2AV_MAT Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,& & rowscale,colscale,outfmt,data) use psb_base_mod, psb_protect_name => psb_csphalo @@ -314,16 +326,36 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,& call psb_errpush(info,name,a_err=ch_err); goto 9999 end if - - call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_spk_,& - & acoo%val,rvsz,brvindx,psb_mpi_c_spk_,icomm,minfo) - call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & acoo%val,iarcv,jarcv,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& + & acoo%val,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& + & iarcv,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& + & jarcv,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_mpi_) + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_spk_,& + & acoo%val,rvsz,brvindx,psb_mpi_c_spk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& & iarcv,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & jarcv,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & jarcv,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select + if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='mpi_alltoallv' + ch_err='alltoallv' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if @@ -390,16 +422,36 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,& goto 9999 end if + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& + & acoo%val,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& + & acoo%ia,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& + & acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_mpi_) + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_spk_,& + & acoo%val,rvsz,brvindx,psb_mpi_c_spk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select - call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_spk_,& - & acoo%val,rvsz,brvindx,psb_mpi_c_spk_,icomm,minfo) - call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_ipk_,& - & acoo%ia,rvsz,brvindx,psb_mpi_ipk_,icomm,minfo) - call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_ipk_,& - & acoo%ja,rvsz,brvindx,psb_mpi_ipk_,icomm,minfo) if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='mpi_alltoallv' + ch_err='alltoallv' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if @@ -506,8 +558,7 @@ Subroutine psb_lcsphalo(a,desc_a,blk,info,rowcnv,colcnv,& integer(psb_ipk_), intent(in), optional :: data ! ...local scalars.... integer(psb_ipk_) :: ictxt, np,me - integer(psb_ipk_) :: counter, proc, i, & - & n_el_send,n_el_recv,& + integer(psb_ipk_) :: counter, proc, i, n_el_send,n_el_recv, & & n_elem, j, ipx,mat_recv, idxs,idxr,nz,& & data_,totxch,nxs, nxr, ncg integer(psb_lpk_) :: r, k, irmin, irmax, icmin, icmax, iszs, iszr, & @@ -718,16 +769,37 @@ Subroutine psb_lcsphalo(a,desc_a,blk,info,rowcnv,colcnv,& goto 9999 end if + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& + & acoo%val,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& + & acoo%ia,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& + & acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_mpi_) + + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_spk_,& + & acoo%val,rvsz,brvindx,psb_mpi_c_spk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select - call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_spk_,& - & acoo%val,rvsz,brvindx,psb_mpi_c_spk_,icomm,minfo) - call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) if (info /= psb_success_) then info=psb_err_from_subroutine_ - call psb_errpush(info,name,a_err='mpi_alltoallv') + call psb_errpush(info,name,a_err='alltoallv') goto 9999 end if @@ -829,12 +901,11 @@ Subroutine psb_lc_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& type(psb_desc_type),Intent(in), optional, target :: col_desc ! ...local scalars.... integer(psb_ipk_) :: ictxt, np,me - integer(psb_ipk_) :: counter,proc,i, & - & n_el_send,k,n_el_recv,r,& - & n_elem, j, ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& - & irmin,icmin,data_,totxch,nxs, nxr,& - & err_act, nsnds, nrcvs - integer(psb_lpk_) :: ngtz,irmax,icmax,l1, lnr, lnc, lnnz, ncg, jpx, idx, tot_elem + integer(psb_ipk_) :: counter,proc,i, n_el_send,n_el_recv,& + & n_elem, j,ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& + & data_,totxch,nxs, nxr, err_act, nsnds, nrcvs + integer(psb_lpk_) :: ngtz,irmax,icmax,irmin,icmin,l1, lnr, lnc, lnnz, & + & r, k, ncg, jpx, idx, tot_elem integer(psb_mpk_) :: icomm, minfo integer(psb_mpk_), allocatable :: brvindx(:), & & rvsz(:), bsdindx(:),sdsz(:) @@ -1054,32 +1125,36 @@ Subroutine psb_lc_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& goto 9999 end if -#if defined(SP_A2AV_MPI) - call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_spk_,& - & acoo%val,rvsz,brvindx,psb_mpi_c_spk_,icomm,minfo) - if (minfo == mpi_success) & - & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo == mpi_success) & - & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo /= mpi_success) info = minfo -#elif defined(SP_A2AV_XI) - call lc_my_a2av(valsnd,sdsz,bsdindx,& + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& & acoo%val,rvsz,brvindx,ictxt,info) - if (info == psb_success_) call i_my_a2av(iasnd,sdsz,bsdindx,& + if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& & acoo%ia,rvsz,brvindx,ictxt,info) - if (info == psb_success_) call i_my_a2av(jasnd,sdsz,bsdindx,& + if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& & acoo%ja,rvsz,brvindx,ictxt,info) -#elif defined(SP_A2AV_MAT) - call lc_coo_my_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ipdxv,ictxt,icomm,info) -#else - choke on me @! -#endif + case(psb_sp_a2av_mpi_) + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_spk_,& + & acoo%val,rvsz,brvindx,psb_mpi_c_spk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select + if (info /= psb_success_) then info=psb_err_from_subroutine_ - call psb_errpush(info,name,a_err='mpi_alltoallv') + call psb_errpush(info,name,a_err='alltoallv') goto 9999 end if @@ -1163,185 +1238,376 @@ Subroutine psb_lc_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& return -#if defined(SP_A2AV_XI) || defined(SP_A2AV_MAT) -contains +End Subroutine psb_lc_csr_halo -#if defined(SP_A2AV_MAT) - subroutine lc_coo_my_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & valrcv,iarcv,jarcv,rvsz,brvindx,ipdxv,ictxt,icomm,info) +Subroutine psb_c_lc_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& + & rowscale,colscale,data,outcol_glob,col_desc) + use psb_base_mod, psb_protect_name => psb_c_lc_csr_halo #ifdef MPI_MOD - use mpi + use mpi #endif - Implicit None + Implicit None #ifdef MPI_H - include 'mpif.h' + include 'mpif.h' #endif - complex(psb_spk_), intent(in) :: valsnd(:) - integer(psb_ipk_), intent(in) :: ipdxv(:) - integer(psb_lpk_), intent(in) :: iasnd(:), jasnd(:) - complex(psb_spk_), intent(out) :: valrcv(:) - integer(psb_lpk_), intent(out) :: iarcv(:), jarcv(:) - integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_mpk_), intent(in) :: icomm - integer(psb_ipk_), intent(out) :: info - !Local variables - integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz, counter - integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret - integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) - call psb_info(ictxt,iam,np) - if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz))= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),': Start' + + if (present(rowcnv)) then + rowcnv_ = rowcnv + else + rowcnv_ = .true. + endif + if (present(colcnv)) then + colcnv_ = colcnv + else + colcnv_ = .true. + endif + if (present(rowscale)) then + rowscale_ = rowscale + else + rowscale_ = .false. + endif + if (present(colscale)) then + colscale_ = colscale + else + colscale_ = .false. + endif + if (present(data)) then + data_ = data + else + data_ = psb_comm_halo_ + endif + if (present(outcol_glob)) then + outcol_glob_ = outcol_glob + else + outcol_glob_ = .false. + endif + if (present(col_desc)) then + col_desc_ => col_desc + else + col_desc_ => desc_a + end if + + Allocate(brvindx(np+1),& + & rvsz(np),sdsz(np),bsdindx(np+1), acoo,stat=info) + + if (info /= psb_success_) then + info=psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + end if + + If (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Data selector',data_ + select case(data_) + case(psb_comm_halo_,psb_comm_ext_ ) + ! Do not accept OVRLAP_INDEX any longer. + case default + call psb_errpush(psb_err_from_subroutine_,name,a_err='wrong Data selector') + goto 9999 + end select - counter=1 - Do - ip=ipdxv(counter) - if (ip == -1) exit - n_el_recv = ipdxv(counter+psb_n_elem_recv_) - counter = counter+n_el_recv - n_el_send = ipdxv(counter+psb_n_elem_send_) - prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) - sz = rvsz(ip+1) - if (sz > 0) then - idx = brvindx(ip+1) - p2ptag = psb_complex_swap_tag - call mpi_irecv(valrcv(idx+1:idx+sz),sz,& - & psb_mpi_c_spk_,prcid(ip+1),& - & p2ptag, icomm,rvhd(ip+1,1),iret) - p2ptag = psb_int_swap_tag - call mpi_irecv(iarcv(idx+1:idx+sz),sz,& - & psb_mpi_lpk_,prcid(ip+1),& - & p2ptag, icomm,rvhd(ip+1,2),iret) - call mpi_irecv(jarcv(idx+1:idx+sz),sz,& - & psb_mpi_lpk_,prcid(ip+1),& - & p2ptag, icomm,rvhd(ip+1,3),iret) - end if - counter = counter+n_el_send+3 + sdsz(:)=0 + rvsz(:)=0 + l1 = 0 + brvindx(1) = 0 + bsdindx(1) = 0 + counter=1 + idx = 0 + idxs = 0 + idxr = 0 + + call desc_a%get_list(data_,pdxv,totxch,nxr,nxs,info) + ipdxv = pdxv%get_vect() + ! For all rows in the halo descriptor, extract the row size + lnr = 0 + Do + proc=ipdxv(counter) + if (proc == -1) exit + n_el_recv = ipdxv(counter+psb_n_elem_recv_) + counter = counter+n_el_recv + n_el_send = ipdxv(counter+psb_n_elem_send_) + tot_elem = 0 + Do j=0,n_el_send-1 + idx = ipdxv(counter+psb_elem_send_+j) + n_elem = a%get_nz_row(idx) + tot_elem = tot_elem+n_elem Enddo + sdsz(proc+1) = tot_elem + lnr = lnr + n_el_recv + counter = counter+n_el_send+3 + Enddo + ! + ! Exchange row sizes, so as to know sends/receives. + ! This is different from the halo exchange because the + ! size of the rows may vary, as opposed to fixed + ! (multi) vector row size. + ! + call mpi_alltoall(sdsz,1,psb_mpi_mpk_,& + & rvsz,1,psb_mpi_mpk_,icomm,minfo) + + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='mpi_alltoall') + goto 9999 + end if + nsnds = count(sdsz /= 0) + nrcvs = count(rvsz /= 0) + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Done initial alltoall',nsnds,nrcvs - counter=1 - Do - ip=ipdxv(counter) - if (ip == -1) exit - n_el_recv = ipdxv(counter+psb_n_elem_recv_) - counter = counter+n_el_recv - n_el_send = ipdxv(counter+psb_n_elem_send_) - if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) - sz = sdsz(ip+1) - if (sz > 0) then - idx = bsdindx(ip+1) - p2ptag = psb_complex_swap_tag - call mpi_send(valsnd(idx+1:idx+sz),sz,& - & psb_mpi_c_spk_,prcid(ip+1),& - & p2ptag, icomm,iret) - p2ptag = psb_int_swap_tag - call mpi_send(iasnd(idx+1:idx+sz),sz,& - & psb_mpi_lpk_,prcid(ip+1),& - & p2ptag, icomm,iret) - call mpi_send(jasnd(idx+1:idx+sz),sz,& - & psb_mpi_lpk_,prcid(ip+1),& - & p2ptag, icomm,iret) + idxs = 0 + idxr = 0 + counter = 1 + Do + proc=ipdxv(counter) + if (proc == -1) exit + n_el_recv = ipdxv(counter+psb_n_elem_recv_) + counter = counter+n_el_recv + n_el_send = ipdxv(counter+psb_n_elem_send_) + + bsdindx(proc+1) = idxs + idxs = idxs + sdsz(proc+1) + brvindx(proc+1) = idxr + idxr = idxr + rvsz(proc+1) + counter = counter+n_el_send+3 + Enddo + + iszr = sum(rvsz) + mat_recv = iszr + iszs = sum(sdsz) + + lnnz = max(iszr,iszs,ione) + lnc = a%get_ncols() + call acoo%allocate(lnr,lnc,lnnz) + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Sizes:',acoo%get_size(),& + & ' Send:',sdsz(:),' Receive:',rvsz(:) + + call psb_ensure_size(max(iszs,1),iasnd,info) + if (info == psb_success_) call psb_ensure_size(max(iszs,1),jasnd,info) + if (info == psb_success_) call psb_ensure_size(max(iszs,1),liasnd,info) + if (info == psb_success_) call psb_ensure_size(max(iszs,1),ljasnd,info) + if (info == psb_success_) call psb_ensure_size(max(iszs,1),valsnd,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='ensure_size') + goto 9999 + end if + + l1 = 0 + ipx = 1 + counter=1 + idx = 0 + ! + ! Make sure to get all columns in csget. + ! This is necessary when sphalo is used to compute a transpose, + ! as opposed to just gathering halo for spspmm purposes. + ! + ncg = huge(ncg) + tot_elem = 0 + Do + proc = ipdxv(counter) + if (proc == -1) exit + n_el_recv = ipdxv(counter+psb_n_elem_recv_) + counter = counter+n_el_recv + n_el_send = ipdxv(counter+psb_n_elem_send_) + + Do j=0,n_el_send-1 + idx = ipdxv(counter+psb_elem_send_+j) + n_elem = a%get_nz_row(idx) + call a%csget(idx,idx,ngtz,iasnd,jasnd,valsnd,info,& + & append=.true.,nzin=tot_elem,jmax=ncg) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_sp_getrow') + goto 9999 end if - counter = counter+n_el_send+3 + tot_elem = tot_elem+ngtz Enddo + counter = counter+n_el_send+3 + Enddo + nz = tot_elem - counter=1 - Do - ip=ipdxv(counter) - if (ip == -1) exit - n_el_recv = ipdxv(counter+psb_n_elem_recv_) - counter = counter+n_el_recv - n_el_send = ipdxv(counter+psb_n_elem_send_) - sz = rvsz(ip+1) - if (sz > 0) then - call mpi_wait(rvhd(ip+1,1),p2pstat,iret) - call mpi_wait(rvhd(ip+1,2),p2pstat,iret) - call mpi_wait(rvhd(ip+1,3),p2pstat,iret) - end if - counter = counter+n_el_send+3 - Enddo + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Going for alltoallv',iszs,iszr + if (rowcnv_) then + call psb_loc_to_glob(iasnd(1:nz),liasnd(1:nz),desc_a,info,iact='I') + else + liasnd(1:nz) = iasnd(1:nz) + end if + if (colcnv_) then + call psb_loc_to_glob(jasnd(1:nz),ljasnd(1:nz),col_desc_,info,iact='I') + else + ljasnd(1:nz) = jasnd(1:nz) + end if + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_loc_to_glob') + goto 9999 + end if + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,liasnd,ljasnd,sdsz,bsdindx,& + & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& + & acoo%val,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(liasnd,sdsz,bsdindx,& + & acoo%ia,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(ljasnd,sdsz,bsdindx,& + & acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_mpi_) + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_spk_,& + & acoo%val,rvsz,brvindx,psb_mpi_c_spk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(liasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(ljasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select - end subroutine lc_coo_my_a2av -#endif -#if defined(SP_A2AV_XI) - subroutine lc_my_a2av(valsnd,sdsz,bsdindx,& - & valrcv,rvsz,brvindx,ictxt,info) - complex(psb_spk_), intent(in) :: valsnd(:) - complex(psb_spk_), intent(out) :: valrcv(:) - integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_ipk_), intent(out) :: info + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='alltoallv') + goto 9999 + end if + + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Done alltoallv' + ! + ! Convert into local numbering + ! + if (rowcnv_) call psb_glob_to_loc(acoo%ia(1:iszr),desc_a,info,iact='I') + ! + ! This seems to be the correct output condition + ! + if (colcnv_.and.(.not.outcol_glob_)) & + & call psb_glob_to_loc(acoo%ja(1:iszr),col_desc_,info,iact='I') - integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psbglob_to_loc') + goto 9999 + end if - call psb_info(ictxt,iam,np) - if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz))0).and.(k>0)) Then + l1=l1+1 + acoo%val(l1) = acoo%val(i) + acoo%ia(l1) = r + acoo%ja(l1) = k + irmin = min(irmin,r) + irmax = max(irmax,r) + icmin = min(icmin,k) + icmax = max(icmax,k) + End If + Enddo + if (rowscale_) then + call acoo%set_nrows(max(irmax-irmin+1,0)) + acoo%ia(1:l1) = acoo%ia(1:l1) - irmin + 1 + else + call acoo%set_nrows(irmax) + end if + if (colscale_) then + call acoo%set_ncols(max(icmax-icmin+1,0)) + acoo%ja(1:l1) = acoo%ja(1:l1) - icmin + 1 + else + call acoo%set_ncols(icmax) + end if - do ip = 0, np-1 - sz = sdsz(ip+1) - if (sz > 0) then - idx = bsdindx(ip+1) - call psb_snd(ictxt,valsnd(idx+1:idx+sz),ip) - end if - end do + call acoo%set_nzeros(l1) + call acoo%set_sorted(.false.) - do ip = 0, np-1 - sz = rvsz(ip+1) - if (sz > 0) then - idx = brvindx(ip+1) - call psb_rcv(ictxt,valrcv(idx+1:idx+sz),ip) - end if - end do - - end subroutine lc_my_a2av + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),& + & ': End data exchange',counter,l1 - subroutine i_my_a2av(valsnd,sdsz,bsdindx,& - & valrcv,rvsz,brvindx,ictxt,info) - integer(psb_ipk_), intent(in) :: valsnd(:) - integer(psb_ipk_), intent(out) :: valrcv(:) - integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_ipk_), intent(out) :: info - + call acoo%fix(info) + if (info == psb_success_) call acoo%mv_to_fmt(blk,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_spcnv') + goto 9999 + end if - integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz + Deallocate(brvindx,bsdindx,rvsz,sdsz,& + & iasnd,jasnd,valsnd,stat=info) + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Done' - call psb_info(ictxt,iam,np) - if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then - idx = bsdindx(ip+1) - call psb_snd(ictxt,valsnd(idx+1:idx+sz),ip) - end if - end do +9999 call psb_error_handler(ictxt,err_act) - do ip = 0, np-1 - sz = rvsz(ip+1) - if (sz > 0) then - idx = brvindx(ip+1) - call psb_rcv(ictxt,valrcv(idx+1:idx+sz),ip) - end if - end do - - end subroutine i_my_a2av -#endif -#endif -End Subroutine psb_lc_csr_halo + return + +End Subroutine psb_c_lc_csr_halo diff --git a/base/tools/psb_cspins.f90 b/base/tools/psb_cspins.F90 similarity index 99% rename from base/tools/psb_cspins.f90 rename to base/tools/psb_cspins.F90 index c17c14093..c2a52eb3c 100644 --- a/base/tools/psb_cspins.f90 +++ b/base/tools/psb_cspins.F90 @@ -288,6 +288,7 @@ subroutine psb_cspins_csr_lirp(nr,irp,ja,val,irw,a,desc_a,info,rebuild,local) end subroutine psb_cspins_csr_lirp +#if defined(IPK4) && defined(LPK8) subroutine psb_cspins_csr_iirp(nr,irw,irp,ja,val,a,desc_a,info,rebuild,local) use psb_base_mod, psb_protect_name => psb_cspins_csr_iirp use psi_mod @@ -384,6 +385,7 @@ subroutine psb_cspins_csr_iirp(nr,irw,irp,ja,val,a,desc_a,info,rebuild,local) return end subroutine psb_cspins_csr_iirp +#endif subroutine psb_cspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) use psb_base_mod, psb_protect_name => psb_cspins_2desc diff --git a/base/tools/psb_d_glob_transpose.F90 b/base/tools/psb_d_glob_transpose.F90 new file mode 100644 index 000000000..9f7692d6f --- /dev/null +++ b/base/tools/psb_d_glob_transpose.F90 @@ -0,0 +1,902 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! 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: psb_d_glob_transpose.f90 +! +! Subroutine: psb_d_glob_transpose +! Version: real +! +! This file provides multiple related versions of a parallel +! global transpose +! +! B = A^T +! +! There are some variations of this routine, that are accounted for +! in the workhorse psb_ld_coo_glob_transpose +! 1. The row and column spaces can share the same descriptor +! This essentially means that the descriptor relates to a +! matrix with a symmetric pattern. Examples are: symmetric +! matrices, matrices with symmetric pattern, lower or +! upper halves of such matrices +! 2. The row and column index spaces are different +! In this case you need to have two descriptor on input, +! plus if you want the output to be distributed according +! to the row descriptor, you will still need a new descriptor +! because even if the row distribution is the same, the pattern +! will be different. +! +! This is handled in the workhorse by having one mandatory and +! two optional descriptors: +! 1. If only the mandatory descriptor is present, then it is assumed that it +! is both row and column descriptor, and that it is sufficient. +! 2. If two descriptors are available, then use the second +! 3. If the third output descriptor is available, then rebuild it +! after the data exchange. +! +! The main transpose algorithm works like this: +! 1. Compute sizes: any entry A(I,J) with J in the halo will have +! to be sent to the process owning J, so walk through the +! matrix and compute all the send sizes, then do an alltoall to figure +! the receive sizes; +! 2. Adjust send bufffers; +! 3. Perform a local transpose; +! 4. Split the matrix: all local entries stay, all halo entries go into +! the send buffers, and are converted to global numbering; +! 5. Do the all-to-all (see below for a discussion of the alternative +! communication strategies) +! 6. The receive is in the extra section of the ACOO buffer; convert +! the row indices to local numbering, and discard extra ones (there will +! be some) +! 7. If desc_rx was requested, make sure to insert the (new) column indices +! 8. Cleanup and sort the output matrix +! 9. Copy back into AIN or ATRANS if requested. +! +! There are three possible exchange algorithms: +! 1. Use MPI_Alltoallv +! 2. Use psb_simple_a2av +! 3. Use psb_simple_triad_a2av +! Default choice is 3. The MPI variant has proved to be inefficient; +! that is because it is not persistent, therefore you pay the initialization price +! every time, and it is not optimized for a sparse communication pattern, +! most MPI implementations assume that all communications are non-empty. +! The PSB_SIMPLE variants reuse the same communicator, and go for a simplistic +! sequence of sends/receive that is quite efficient for a sparse communication +! pattern. To be refined/reviewed in the future to compare with neighbour +! persistent collectives. +! +! +subroutine psb_ld_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) +#ifdef MPI_MOD + use mpi +#endif + use psb_base_mod, psb_protect_name => psb_ld_coo_glob_transpose + Implicit None +#ifdef MPI_H + include 'mpif.h' +#endif + type(psb_ld_coo_sparse_mat), intent(inout) :: ain + type(psb_desc_type), intent(inout), target :: desc_r + type(psb_ld_coo_sparse_mat), intent(out), optional :: atrans + type(psb_desc_type), intent(inout), target, optional :: desc_c + type(psb_desc_type), intent(out), optional :: desc_rx + integer(psb_ipk_), intent(out) :: info + + ! ...local scalars.... + integer(psb_ipk_) :: ictxt, np,me + integer(psb_ipk_) :: counter,proc, err_act, j + integer(psb_lpk_) :: i, k, idx, r, ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& + & l1, nsnds, nrcvs, nr,nc,nzl, hlstart, nzt, nzd + integer(psb_mpk_) :: icomm, minfo + integer(psb_mpk_), allocatable :: brvindx(:), & + & rvsz(:), bsdindx(:), sdsz(:), tsdx(:), trvx(:) + integer(psb_ipk_), allocatable :: halo_owner(:) + integer(psb_lpk_), allocatable :: iasnd(:), jasnd(:) + real(psb_dpk_), allocatable :: valsnd(:) + type(psb_ld_coo_sparse_mat), allocatable :: acoo + logical :: rowcnv_,colcnv_,rowscale_,colscale_,outcol_glob_ + type(psb_desc_type), pointer :: p_desc_c + character(len=5) :: outfmt_ + integer(psb_ipk_) :: debug_level, debug_unit + character(len=20) :: name, ch_err + + if(psb_get_errstatus() /= 0) return + info=psb_success_ + name='mld_glob_transpose' + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt = desc_r%get_context() + icomm = desc_r%get_mpic() + + Call psb_info(ictxt, me, np) + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),': Start' + + if (present(desc_c)) then + p_desc_c => desc_c + else + p_desc_c => desc_r + end if + + Allocate(brvindx(np+1),& + & rvsz(np),sdsz(np),bsdindx(np+1), acoo,stat=info) + + if (info /= psb_success_) then + info=psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + end if + + + sdsz(:)=0 + rvsz(:)=0 + l1 = 0 + brvindx(1) = 0 + bsdindx(1) = 0 + counter=1 + idx = 0 + idxs = 0 + idxr = 0 + + if (present(atrans)) then + call ain%cp_to_coo(acoo,info) + else + call ain%mv_to_coo(acoo,info) + end if + + + ! + ! Compute number of entries in the + ! halo part, sorted by destination process + ! + nr = desc_r%get_local_rows() + nc = p_desc_c%get_local_cols() + nzl = acoo%get_nzeros() + hlstart = p_desc_c%get_local_rows() + do k=1, nzl + j = acoo%ja(k) + if (j > hlstart) then + call p_desc_c%indxmap%fnd_halo_owner(j,proc,info) + sdsz(proc+1) = sdsz(proc+1) +1 + end if + end do + + ! + ! Exchange sizes, so as to know sends/receives. + ! This is different from the halo exchange because the + ! number of entries was not precomputed in the descriptor, + ! which was vector-oriented and not matrix-entry-oriented + ! + call mpi_alltoall(sdsz,1,psb_mpi_mpk_,& + & rvsz,1,psb_mpi_mpk_,icomm,minfo) + + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='mpi_alltoall') + goto 9999 + end if + nsnds = count(sdsz /= 0) + nrcvs = count(rvsz /= 0) + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Done initial alltoall',nsnds,nrcvs + + idxs = 0 + idxr = 0 + counter = 1 + Do proc = 0, np-1 + bsdindx(proc+1) = idxs + idxs = idxs + sdsz(proc+1) + brvindx(proc+1) = idxr + idxr = idxr + rvsz(proc+1) + Enddo + + tsdx = bsdindx + trvx = brvindx + + iszr = sum(rvsz) + iszs = sum(sdsz) + + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Sizes:',& + & ' Send:',sdsz(:),' Receive:',rvsz(:) + + call psb_ensure_size(max(iszs,1),iasnd,info) + if (info == psb_success_) call psb_ensure_size(max(iszs,1),jasnd,info) + if (info == psb_success_) call psb_ensure_size(max(iszs,1),valsnd,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='ensure_size') + goto 9999 + end if + + ! + ! Now, transpose the matrix, then split between itself + ! and the send buffers + ! + call acoo%transp() + if (acoo%get_nzeros()/= nzl) then + write(0,*) me,'Something strange upon transpose: ',nzl,acoo%get_nzeros() + end if + nzl = acoo%get_nzeros() + hlstart = p_desc_c%get_local_rows() + + + nzd = 0 + do k = 1, nzl + j = acoo%ia(k) + if (j<=hlstart) then + nzd = nzd + 1 + acoo%ia(nzd) = acoo%ia(k) + acoo%ja(nzd) = acoo%ja(k) + acoo%val(nzd) = acoo%val(k) + else + call p_desc_c%indxmap%fnd_halo_owner(j,proc,info) + tsdx(proc+1) = tsdx(proc+1) +1 + iasnd(tsdx(proc+1)) = acoo%ia(k) + jasnd(tsdx(proc+1)) = acoo%ja(k) + valsnd(tsdx(proc+1)) = acoo%val(k) + end if + end do + call acoo%set_nzeros(nzd) + ! + ! Put halo entries in global numbering + ! + call desc_r%indxmap%l2gip(jasnd(1:iszs),info) + call p_desc_c%indxmap%l2gip(iasnd(1:iszs),info) + ! And exchange data. + ! Normally we'll use our SIMPLE A2AV and not MPI, because + ! the communication pattern is sparse, so ours is more + ! efficient. Using ACOO for the receive buffers. + nzl = acoo%get_nzeros() + call acoo%ensure_size(nzl+iszr) + + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & acoo%val(nzl+1:nzl+iszr),acoo%ia(nzl+1:nzl+iszr),& + & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& + & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& + & acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& + & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_mpi_) + + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_dpk_,& + & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_r_dpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select + + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='alltoallv') + goto 9999 + end if + + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Done alltoallv' + + if (present(desc_rx)) then + ! + ! Extend the appropriate descriptor; started as R but on + ! transpose it now describes C + ! + call desc_r%clone(desc_rx,info) + call psb_cd_reinit(desc_rx,info) + ! + ! Take out non-local rows + ! + call psb_glob_to_loc(acoo%ia(nzl+1:nzl+iszr),p_desc_c,info,iact='I',owned=.true.) + call psb_coo_clean_negidx_inner(iszr,acoo%ia(nzl+1:nzl+iszr),acoo%ja(nzl+1:nzl+iszr),& + & acoo%val(nzl+1:nzl+iszr),nzt,info) + call desc_rx%g2lip_ins(acoo%ja(nzl+1:nzl+nzt),info) + call psb_cdasb(desc_rx,info) + nzl = nzl + nzt + call acoo%set_nzeros(nzl) + nzl = acoo%get_nzeros() + call acoo%set_sorted(.false.) + ! + ! Insert to extend descriptor + ! + call acoo%set_nrows(p_desc_c%get_local_rows()) + call acoo%set_ncols(desc_rx%get_local_cols()) + !write(0,*) me,' Trans RX ',acoo%get_nrows(),acoo%get_ncols(),acoo%get_nzeros() + else + ! + ! + ! Take out non-local rows + ! + call psb_glob_to_loc(acoo%ia(nzl+1:nzl+iszr),p_desc_c,info,iact='I',owned=.true.) + call psb_glob_to_loc(acoo%ja(nzl+1:nzl+iszr),desc_r,info,iact='I') + call psb_coo_clean_negidx_inner(iszr,acoo%ia(nzl+1:nzl+iszr),acoo%ja(nzl+1:nzl+iszr),& + & acoo%val(nzl+1:nzl+iszr),nzt,info) + + nzl = nzl + nzt + call acoo%set_nzeros(nzl) + nzl = acoo%get_nzeros() + call acoo%set_sorted(.false.) + + call acoo%set_nrows(p_desc_c%get_local_rows()) + call acoo%set_ncols(desc_r%get_local_cols()) + !write(0,*) me,' Trans R- ',acoo%get_nrows(),acoo%get_ncols(),acoo%get_nzeros() + end if + +!!$ write(0,*) me,' Sanity check after rx%g2l :',count(acoo%ja(1:nzl)<0) + + + call acoo%fix(info) + nzl = acoo%get_nzeros() + + if (present(atrans)) then + call atrans%mv_from_coo(acoo,info) + else + call ain%mv_from_coo(acoo,info) + end if + Deallocate(brvindx,bsdindx,rvsz,sdsz,& + & iasnd,jasnd,valsnd,stat=info) + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Done' + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(ictxt,err_act) + + return +end subroutine psb_ld_coo_glob_transpose + +subroutine psb_d_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) +#ifdef MPI_MOD + use mpi +#endif + use psb_base_mod, psb_protect_name => psb_d_coo_glob_transpose + Implicit None +#ifdef MPI_H + include 'mpif.h' +#endif + type(psb_d_coo_sparse_mat), intent(inout) :: ain + type(psb_desc_type), intent(inout), target :: desc_r + type(psb_d_coo_sparse_mat), intent(out), optional :: atrans + type(psb_desc_type), intent(inout), target, optional :: desc_c + type(psb_desc_type), intent(out), optional :: desc_rx + integer(psb_ipk_), intent(out) :: info + + integer(psb_ipk_) :: ictxt, np,me + integer(psb_ipk_) :: counter,proc, err_act, j + integer(psb_ipk_) :: i, k, idx, r, ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& + & l1, nsnds, nrcvs, nr,nc,nzl, hlstart, nzd + integer(psb_lpk_) :: nzt, lszr + integer(psb_mpk_) :: icomm, minfo + integer(psb_mpk_), allocatable :: brvindx(:), & + & rvsz(:), bsdindx(:), sdsz(:), tsdx(:), trvx(:) + integer(psb_ipk_), allocatable :: halo_owner(:) + integer(psb_lpk_), allocatable :: iasnd(:), jasnd(:),iarcv(:),jarcv(:) + real(psb_dpk_), allocatable :: valsnd(:) + type(psb_d_coo_sparse_mat), allocatable :: acoo + logical :: rowcnv_,colcnv_,rowscale_,colscale_,outcol_glob_ + type(psb_desc_type), pointer :: p_desc_c + character(len=5) :: outfmt_ + integer(psb_ipk_) :: debug_level, debug_unit + character(len=20) :: name, ch_err + + if(psb_get_errstatus() /= 0) return + info=psb_success_ + name='mld_glob_transpose' + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt = desc_r%get_context() + icomm = desc_r%get_mpic() + + Call psb_info(ictxt, me, np) + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),': Start' + + if (present(desc_c)) then + p_desc_c => desc_c + else + p_desc_c => desc_r + end if + + Allocate(brvindx(np+1),& + & rvsz(np),sdsz(np),bsdindx(np+1), acoo,stat=info) + + if (info /= psb_success_) then + info=psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + end if + + + sdsz(:)=0 + rvsz(:)=0 + l1 = 0 + brvindx(1) = 0 + bsdindx(1) = 0 + counter=1 + idx = 0 + idxs = 0 + idxr = 0 + + if (present(atrans)) then + call ain%cp_to_coo(acoo,info) + else + call ain%mv_to_coo(acoo,info) + end if + + + ! + ! Compute number of entries in the + ! halo part, sorted by destination process + ! + nr = desc_r%get_local_rows() + nc = p_desc_c%get_local_cols() + nzl = acoo%get_nzeros() + hlstart = p_desc_c%get_local_rows() + do k=1, nzl + j = acoo%ja(k) + if (j > hlstart) then + call p_desc_c%indxmap%fnd_halo_owner(j,proc,info) + sdsz(proc+1) = sdsz(proc+1) +1 + end if + end do + + ! + ! Exchange sizes, so as to know sends/receives. + ! This is different from the halo exchange because the + ! number of entries was not precomputed in the descriptor, + ! which was vector-oriented and not matrix-entry-oriented + ! + call mpi_alltoall(sdsz,1,psb_mpi_mpk_,& + & rvsz,1,psb_mpi_mpk_,icomm,minfo) + + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='mpi_alltoall') + goto 9999 + end if + nsnds = count(sdsz /= 0) + nrcvs = count(rvsz /= 0) + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Done initial alltoall',nsnds,nrcvs + + idxs = 0 + idxr = 0 + counter = 1 + Do proc = 0, np-1 + bsdindx(proc+1) = idxs + idxs = idxs + sdsz(proc+1) + brvindx(proc+1) = idxr + idxr = idxr + rvsz(proc+1) + Enddo + + tsdx = bsdindx + trvx = brvindx + + iszr = sum(rvsz) + iszs = sum(sdsz) + + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Sizes:',& + & ' Send:',sdsz(:),' Receive:',rvsz(:) + + call psb_ensure_size(max(iszs,1),iasnd,info) + if (info == psb_success_) call psb_ensure_size(max(iszs,1),jasnd,info) + if (info == psb_success_) call psb_ensure_size(max(iszs,1),valsnd,info) + if (info == psb_success_) call psb_ensure_size(max(iszr,1),iarcv,info) + if (info == psb_success_) call psb_ensure_size(max(iszr,1),jarcv,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='ensure_size') + goto 9999 + end if + + ! + ! Now, transpose the matrix, then split between itself + ! and the send buffers + ! + call acoo%transp() + if (acoo%get_nzeros()/= nzl) then + write(0,*) me,'Something strange upon transpose: ',nzl,acoo%get_nzeros() + end if + nzl = acoo%get_nzeros() + hlstart = p_desc_c%get_local_rows() + + + nzd = 0 + do k = 1, nzl + j = acoo%ia(k) + if (j<=hlstart) then + nzd = nzd + 1 + acoo%ia(nzd) = acoo%ia(k) + acoo%ja(nzd) = acoo%ja(k) + acoo%val(nzd) = acoo%val(k) + else + call p_desc_c%indxmap%fnd_halo_owner(j,proc,info) + tsdx(proc+1) = tsdx(proc+1) +1 + iasnd(tsdx(proc+1)) = acoo%ia(k) + jasnd(tsdx(proc+1)) = acoo%ja(k) + valsnd(tsdx(proc+1)) = acoo%val(k) + end if + end do + call acoo%set_nzeros(nzd) + ! + ! Put halo entries in global numbering + ! + call desc_r%indxmap%l2gip(jasnd(1:iszs),info) + call p_desc_c%indxmap%l2gip(iasnd(1:iszs),info) + ! And exchange data. + ! Normally we'll use our SIMPLE A2AV and not MPI, because + ! the communication pattern is sparse, so ours is more + ! efficient. Using ACOO for the receive buffers. + nzl = acoo%get_nzeros() + call acoo%ensure_size(nzl+iszr) + + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & acoo%val(nzl+1:nzl+iszr),iarcv(1:iszr),& + & jarcv(1:iszr),rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& + & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& + & iarcv(1:iszr),rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& + & jarcv(1:iszr),rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_mpi_) + + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_dpk_,& + & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_r_dpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & iarcv(1:iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & jarcv(1:iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select + + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='alltoallv') + goto 9999 + end if + + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Done alltoallv' + + if (present(desc_rx)) then + ! + ! Extend the appropriate descriptor; started as R but on + ! transpose it now describes C + ! + call desc_r%clone(desc_rx,info) + call psb_cd_reinit(desc_rx,info) + ! + ! Take out non-local rows + ! + call psb_glob_to_loc(iarcv(1:iszr),p_desc_c,info,iact='I',owned=.true.) + lszr = iszr + call psb_coo_clean_negidx_inner(lszr,iarcv(1:iszr),jarcv(1:iszr),& + & acoo%val(nzl+1:nzl+iszr),nzt,info) + call desc_rx%g2lip_ins(jarcv(1:nzt),info) + call psb_cdasb(desc_rx,info) + acoo%ia(nzl+1:nzl+nzt) = iarcv(1:nzt) + acoo%ja(nzl+1:nzl+nzt) = jarcv(1:nzt) + nzl = nzl + nzt + call acoo%set_nzeros(nzl) + nzl = acoo%get_nzeros() + call acoo%set_sorted(.false.) + ! + ! Insert to extend descriptor + ! + call acoo%set_nrows(p_desc_c%get_local_rows()) + call acoo%set_ncols(desc_rx%get_local_cols()) + !write(0,*) me,' Trans RX ',acoo%get_nrows(),acoo%get_ncols(),acoo%get_nzeros() + else + ! + ! + ! Take out non-local rows + ! + call psb_glob_to_loc(iarcv(1:iszr),p_desc_c,info,iact='I',owned=.true.) + call psb_glob_to_loc(jarcv(1:iszr),desc_r,info,iact='I') + lszr = iszr + call psb_coo_clean_negidx_inner(lszr,iarcv(1:iszr),jarcv(1:iszr),& + & acoo%val(nzl+1:nzl+iszr),nzt,info) + acoo%ia(nzl+1:nzl+nzt) = iarcv(1:nzt) + acoo%ja(nzl+1:nzl+nzt) = jarcv(1:nzt) + nzl = nzl + nzt + call acoo%set_nzeros(nzl) + nzl = acoo%get_nzeros() + call acoo%set_sorted(.false.) + + call acoo%set_nrows(p_desc_c%get_local_rows()) + call acoo%set_ncols(desc_r%get_local_cols()) + !write(0,*) me,' Trans R- ',acoo%get_nrows(),acoo%get_ncols(),acoo%get_nzeros() + end if + +!!$ write(0,*) me,' Sanity check after rx%g2l :',count(acoo%ja(1:nzl)<0) + + + call acoo%fix(info) + nzl = acoo%get_nzeros() + + if (present(atrans)) then + call atrans%mv_from_coo(acoo,info) + else + call ain%mv_from_coo(acoo,info) + end if + Deallocate(brvindx,bsdindx,rvsz,sdsz,& + & iasnd,jasnd,valsnd,& + & iarcv,jarcv,stat=info) + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Done' + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(ictxt,err_act) + + return +end subroutine psb_d_coo_glob_transpose + +subroutine psb_d_simple_glob_transpose_ip(ain,desc_a,info) + use psb_base_mod, psb_protect_name => psb_d_simple_glob_transpose_ip + implicit none + type(psb_dspmat_type), intent(inout) :: ain + type(psb_desc_type) :: desc_a + integer(psb_ipk_), intent(out) :: info + + ! + ! BEWARE: This routine works under the assumption + ! that the same DESC_A works for both A and A^T, which + ! essentially means that A has a symmetric pattern. + ! + type(psb_d_coo_sparse_mat) :: tmpc1, tmpc2 + integer(psb_ipk_) :: nz1, nz2, nzh, nz + integer(psb_ipk_) :: ictxt, me, np + integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz + integer(psb_lpk_), allocatable :: ilv(:) + character(len=80) :: aname + logical, parameter :: debug=.false., dump=.false., debug_sync=.false. + + ictxt = desc_a%get_context() + call psb_info(ictxt,me,np) + + nrow = desc_a%get_local_rows() + ncol = desc_a%get_local_cols() + if (debug_sync) then + call psb_barrier(ictxt) + if (me == 0) write(0,*) 'Start htranspose ' + end if + + + call ain%mv_to(tmpc1) + call psb_glob_transpose(tmpc1, desc_a,info,atrans=tmpc2) + call ain%mv_from(tmpc2) + + if (dump) then + block + type(psb_ldspmat_type) :: aglb + write(aname,'(a,i3.3,a)') 'atran-',me,'.mtx' + call ain%print(fname=aname,head='atrans ') + call psb_gather(aglb,ain,desc_a,info) + if (me==psb_root_) then + write(aname,'(a,i3.3,a)') 'atran.mtx' + call aglb%print(fname=aname,head='Test ') + end if + end block + end if + +end subroutine psb_d_simple_glob_transpose_ip + +subroutine psb_d_simple_glob_transpose(ain,aout,desc_a,info) + use psb_base_mod, psb_protect_name => psb_d_simple_glob_transpose + implicit none + type(psb_dspmat_type), intent(in) :: ain + type(psb_dspmat_type), intent(out) :: aout + type(psb_desc_type) :: desc_a + integer(psb_ipk_), intent(out) :: info + + ! + ! BEWARE: This routine works under the assumption + ! that the same DESC_A works for both A and A^T, which + ! essentially means that A has a symmetric pattern. + ! + type(psb_d_coo_sparse_mat) :: tmpc1, tmpc2 + integer(psb_ipk_) :: nz1, nz2, nzh, nz + integer(psb_ipk_) :: ictxt, me, np + integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz + integer(psb_lpk_), allocatable :: ilv(:) + character(len=80) :: aname + logical, parameter :: debug=.false., dump=.false., debug_sync=.false. + + ictxt = desc_a%get_context() + call psb_info(ictxt,me,np) + + nrow = desc_a%get_local_rows() + ncol = desc_a%get_local_cols() + if (debug_sync) then + call psb_barrier(ictxt) + if (me == 0) write(0,*) 'Start htranspose ' + end if + + + call ain%cp_to(tmpc1) + call psb_glob_transpose(tmpc1, desc_a,info,atrans=tmpc2) + call aout%mv_from(tmpc2) + + if (dump) then + block + type(psb_ldspmat_type) :: aglb + + write(aname,'(a,i3.3,a)') 'atran-',me,'.mtx' + call aout%print(fname=aname,head='atrans ') + call psb_gather(aglb,aout,desc_a,info) + if (me==psb_root_) then + write(aname,'(a,i3.3,a)') 'atran.mtx' + call aglb%print(fname=aname,head='Test ') + end if + end block + end if + +end subroutine psb_d_simple_glob_transpose + +subroutine psb_ld_simple_glob_transpose_ip(ain,desc_a,info) + use psb_base_mod, psb_protect_name => psb_ld_simple_glob_transpose_ip + implicit none + type(psb_ldspmat_type), intent(inout) :: ain + type(psb_desc_type) :: desc_a + integer(psb_ipk_), intent(out) :: info + + ! + ! BEWARE: This routine works under the assumption + ! that the same DESC_A works for both A and A^T, which + ! essentially means that A has a symmetric pattern. + ! + type(psb_ld_coo_sparse_mat) :: tmpc1, tmpc2 + integer(psb_ipk_) :: nz1, nz2, nzh, nz + integer(psb_ipk_) :: ictxt, me, np + integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz + integer(psb_lpk_), allocatable :: ilv(:) + character(len=80) :: aname + logical, parameter :: debug=.false., dump=.false., debug_sync=.false. + + ictxt = desc_a%get_context() + call psb_info(ictxt,me,np) + + nrow = desc_a%get_local_rows() + ncol = desc_a%get_local_cols() + if (debug_sync) then + call psb_barrier(ictxt) + if (me == 0) write(0,*) 'Start htranspose ' + end if + + + call ain%mv_to(tmpc1) + call psb_glob_transpose(tmpc1, desc_a,info,atrans=tmpc2) + call ain%mv_from(tmpc2) + + if (dump) then + block + type(psb_ldspmat_type) :: aglb + write(aname,'(a,i3.3,a)') 'atran-',me,'.mtx' + call ain%print(fname=aname,head='atrans ',iv=ilv) + call psb_gather(aglb,ain,desc_a,info) + if (me==psb_root_) then + write(aname,'(a,i3.3,a)') 'atran.mtx' + call aglb%print(fname=aname,head='Test ') + end if + end block + end if + +end subroutine psb_ld_simple_glob_transpose_ip + +subroutine psb_ld_simple_glob_transpose(ain,aout,desc_a,info) + use psb_base_mod, psb_protect_name => psb_ld_simple_glob_transpose + implicit none + type(psb_ldspmat_type), intent(in) :: ain + type(psb_ldspmat_type), intent(out) :: aout + type(psb_desc_type) :: desc_a + integer(psb_ipk_), intent(out) :: info + + ! + ! BEWARE: This routine works under the assumption + ! that the same DESC_A works for both A and A^T, which + ! essentially means that A has a symmetric pattern. + ! + type(psb_ld_coo_sparse_mat) :: tmpc1, tmpc2 + integer(psb_ipk_) :: nz1, nz2, nzh, nz + integer(psb_ipk_) :: ictxt, me, np + integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz + integer(psb_lpk_), allocatable :: ilv(:) + character(len=80) :: aname + logical, parameter :: debug=.false., dump=.false., debug_sync=.false. + + ictxt = desc_a%get_context() + call psb_info(ictxt,me,np) + + nrow = desc_a%get_local_rows() + ncol = desc_a%get_local_cols() + if (debug_sync) then + call psb_barrier(ictxt) + if (me == 0) write(0,*) 'Start htranspose ' + end if + + + call ain%cp_to(tmpc1) + call psb_glob_transpose(tmpc1, desc_a,info,atrans=tmpc2) + call aout%mv_from(tmpc2) + + if (dump) then + block + type(psb_ldspmat_type) :: aglb + + write(aname,'(a,i3.3,a)') 'atran-',me,'.mtx' + call aout%print(fname=aname,head='atrans ',iv=ilv) + call psb_gather(aglb,aout,desc_a,info) + if (me==psb_root_) then + write(aname,'(a,i3.3,a)') 'atran.mtx' + call aglb%print(fname=aname,head='Test ') + end if + end block + end if + +end subroutine psb_ld_simple_glob_transpose + + diff --git a/base/tools/psb_d_par_csr_spspmm.f90 b/base/tools/psb_d_par_csr_spspmm.f90 index 7edfbac8b..2e34a32c5 100644 --- a/base/tools/psb_d_par_csr_spspmm.f90 +++ b/base/tools/psb_d_par_csr_spspmm.f90 @@ -39,7 +39,7 @@ ! C = A * B ! ! where all the matrices are stored in CSR. On input and output the matrices -! are stored with column indices in local numbering, but inermediate quantities +! are stored with column indices in local numbering, but intermediate quantities ! are in global numbering because gathering the halo of B to multiply it ! by A implies a potential enlargement of the support. ! Also, B may have a column index space different from its row index space, @@ -61,98 +61,100 @@ ! info - integer, output. ! Error code. ! -!!$Subroutine psb_d_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) -!!$ use psb_base_mod, psb_protect_name => psb_d_par_csr_spspmm -!!$ Implicit None -!!$ -!!$ type(psb_d_csr_sparse_mat),intent(in) :: acsr -!!$ type(psb_d_csr_sparse_mat),intent(inout) :: bcsr -!!$ type(psb_d_csr_sparse_mat),intent(out) :: ccsr -!!$ type(psb_desc_type),intent(in) :: desc_a -!!$ type(psb_desc_type),intent(inout) :: desc_c -!!$ integer(psb_ipk_), intent(out) :: info -!!$ integer(psb_ipk_), intent(in), optional :: data -!!$ ! ...local scalars.... -!!$ integer(psb_ipk_) :: ictxt, np,me -!!$ integer(psb_ipk_) :: ncol, nnz -!!$ type(psb_d_csr_sparse_mat) :: tcsr1 -!!$ logical :: update_desc_c -!!$ integer(psb_ipk_) :: debug_level, debug_unit, err_act -!!$ character(len=20) :: name, ch_err -!!$ -!!$ if(psb_get_errstatus() /= 0) return -!!$ info=psb_success_ -!!$ name='psb_d_p_csr_spspmm' -!!$ call psb_erractionsave(err_act) -!!$ if (psb_errstatus_fatal()) then -!!$ info = psb_err_internal_error_ ; goto 9999 -!!$ end if -!!$ debug_unit = psb_get_debug_unit() -!!$ debug_level = psb_get_debug_level() -!!$ -!!$ ictxt = desc_a%get_context() -!!$ -!!$ call psb_info(ictxt, me, np) -!!$ -!!$ if (debug_level >= psb_debug_outer_) & -!!$ & write(debug_unit,*) me,' ',trim(name),': Start' -!!$ -!!$ update_desc_c = desc_c%is_bld() -!!$ -!!$ ! -!!$ ! This is a bit tricky. -!!$ ! DESC_A is the descriptor of (the columns of) A, and therefore -!!$ ! of the rows of B; the columns of B, in the intended usage, span -!!$ ! a different space for which we have DESC_C. -!!$ ! We are gathering the halo rows of B to multiply by A; -!!$ ! now, the columns of B would ideally be kept in -!!$ ! global numbering, so that we can call this repeatedly to accumulate -!!$ ! the product of multiple operators, and convert to local numbering -!!$ ! at the last possible moment. However, this would imply calling -!!$ ! the serial SPSPMM with a matrix B with the GLOBAL number of columns -!!$ ! and this could be very expensive in memory. The solution is to keep B -!!$ ! in local numbering, so that only columns really appearing count, but to -!!$ ! expand the descriptor when gathering the halo, because by performing -!!$ ! the products we are extending the support of the operator; hence -!!$ ! this routine is intended to be called with a temporary descriptor -!!$ ! DESC_C which is in the BUILD state, to allow for such expansion -!!$ ! across multiple products. -!!$ ! The caller will at some later point finalize the descriptor DESC_C. -!!$ ! -!!$ -!!$ ncol = desc_a%get_local_cols() -!!$ call psb_sphalo(bcsr,desc_a,tcsr1,info,& -!!$ & colcnv=.true.,rowscale=.true.,outcol_glob=.true.,col_desc=desc_c,data=data) -!!$ nnz = tcsr1%get_nzeros() -!!$ if (update_desc_c) then -!!$ call desc_c%indxmap%g2lip_ins(tcsr1%ja(1:nnz),info) -!!$ else -!!$ call desc_c%indxmap%g2lip(tcsr1%ja(1:nnz),info) -!!$ end if -!!$ if (info == psb_success_) call psb_rwextd(ncol,bcsr,info,b=tcsr1) -!!$ if (info == psb_success_) call tcsr1%free() -!!$ if(info /= psb_success_) then -!!$ call psb_errpush(psb_err_internal_error_,name,a_err='Extend am3') -!!$ goto 9999 -!!$ end if -!!$ call bcsr%set_ncols(desc_c%get_local_cols()) -!!$ -!!$ -!!$ if (debug_level >= psb_debug_outer_) & -!!$ & write(debug_unit,*) me,' ',trim(name),& -!!$ & 'starting spspmm 3' -!!$ if (debug_level >= psb_debug_outer_) write(debug_unit,*) me,' ',trim(name),& -!!$ & 'starting spspmm ',acsr%get_nrows(),acsr%get_ncols(),bcsr%get_nrows(),bcsr%get_ncols() -!!$ call psb_spspmm(acsr,bcsr,ccsr,info) -!!$ -!!$ call psb_erractionrestore(err_act) -!!$ return -!!$ -!!$9999 call psb_error_handler(ictxt,err_act) -!!$ -!!$ return -!!$ -!!$End Subroutine psb_d_par_csr_spspmm +Subroutine psb_d_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) + use psb_base_mod, psb_protect_name => psb_d_par_csr_spspmm + Implicit None + + type(psb_d_csr_sparse_mat),intent(in) :: acsr + type(psb_d_csr_sparse_mat),intent(inout) :: bcsr + type(psb_d_csr_sparse_mat),intent(out) :: ccsr + type(psb_desc_type),intent(in) :: desc_a + type(psb_desc_type),intent(inout) :: desc_c + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: data + ! ...local scalars.... + integer(psb_ipk_) :: ictxt, np,me + integer(psb_ipk_) :: ncol, nnz + type(psb_ld_csr_sparse_mat) :: ltcsr + type(psb_d_csr_sparse_mat) :: tcsr + logical :: update_desc_c + integer(psb_ipk_) :: debug_level, debug_unit, err_act + character(len=20) :: name, ch_err + + if(psb_get_errstatus() /= 0) return + info=psb_success_ + name='psb_d_p_csr_spspmm' + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt = desc_a%get_context() + + call psb_info(ictxt, me, np) + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),': Start' + + update_desc_c = desc_c%is_bld() + + ! + ! This is a bit tricky. + ! DESC_A is the descriptor of (the columns of) A, and therefore + ! of the rows of B; the columns of B, in the intended usage, span + ! a different space for which we have DESC_C. + ! We are gathering the halo rows of B to multiply by A; + ! now, the columns of B would ideally be kept in + ! global numbering, so that we can call this repeatedly to accumulate + ! the product of multiple operators, and convert to local numbering + ! at the last possible moment. However, this would imply calling + ! the serial SPSPMM with a matrix B with the GLOBAL number of columns + ! and this could be very expensive in memory. The solution is to keep B + ! in local numbering, so that only columns really appearing count, but to + ! expand the descriptor when gathering the halo, because by performing + ! the products we are extending the support of the operator; hence + ! this routine is intended to be called with a temporary descriptor + ! DESC_C which is in the BUILD state, to allow for such expansion + ! across multiple products. + ! The caller will at some later point finalize the descriptor DESC_C. + ! + + ncol = desc_a%get_local_cols() + call psb_sphalo(bcsr,desc_a,ltcsr,info,& + & colcnv=.true.,rowscale=.true.,outcol_glob=.true.,col_desc=desc_c,data=data) + nnz = ltcsr%get_nzeros() + if (update_desc_c) then + call desc_c%indxmap%g2lip_ins(ltcsr%ja(1:nnz),info) + else + call desc_c%indxmap%g2lip(ltcsr%ja(1:nnz),info) + end if + call ltcsr%mv_to_ifmt(tcsr,info) + if (info == psb_success_) call psb_rwextd(ncol,bcsr,info,b=tcsr) + if (info == psb_success_) call tcsr%free() + if(info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,a_err='Extend am3') + goto 9999 + end if + call bcsr%set_ncols(desc_c%get_local_cols()) + + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),& + & 'starting spspmm 3' + if (debug_level >= psb_debug_outer_) write(debug_unit,*) me,' ',trim(name),& + & 'starting spspmm ',acsr%get_nrows(),acsr%get_ncols(),bcsr%get_nrows(),bcsr%get_ncols() + call psb_spspmm(acsr,bcsr,ccsr,info) + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(ictxt,err_act) + + return + +End Subroutine psb_d_par_csr_spspmm Subroutine psb_ld_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) use psb_base_mod, psb_protect_name => psb_ld_par_csr_spspmm diff --git a/base/tools/psb_dspasb.f90 b/base/tools/psb_dspasb.f90 index c2434c09c..542e6901e 100644 --- a/base/tools/psb_dspasb.f90 +++ b/base/tools/psb_dspasb.f90 @@ -122,11 +122,11 @@ subroutine psb_dspasb(a,desc_a, info, afmt, upd, dupl, mold) end if - IF (debug_level >= psb_debug_ext_) then + if (debug_level >= psb_debug_ext_) then ch_err=a%get_fmt() write(debug_unit, *) me,' ',trim(name),': From SPCNV',& & info,' ',ch_err - end IF + end if if (psb_errstatus_fatal()) then info=psb_err_from_subroutine_ diff --git a/base/tools/psb_dsphalo.F90 b/base/tools/psb_dsphalo.F90 index 032a139cd..8d800f6db 100644 --- a/base/tools/psb_dsphalo.F90 +++ b/base/tools/psb_dsphalo.F90 @@ -31,11 +31,26 @@ ! ! File: psb_dsphalo.f90 ! -! Subroutine: psb_dsphalo +! Subroutine: psb_dsphalo psb_ldsphalo ! This routine does the retrieval of remote matrix rows. -! Note that retrieval is done through GTBLK, therefore it should work -! for any matrix format in A; as for the output, default is CSR. -! +! Retrieval is done through GETROW, therefore it should work +! for any matrix format in A; as for the output, default is CSR. +! +! There is also a specialized version ld_CSR whose interface +! is adapted for the needs of d_par_csr_spspmm. +! +! There are three possible exchange algorithms: +! 1. Use MPI_Alltoallv +! 2. Use psb_simple_a2av +! 3. Use psb_simple_triad_a2av +! Default choice is 3. The MPI variant has proved to be inefficient; +! that is because it is not persistent, therefore you pay the initialization price +! every time, and it is not optimized for a sparse communication pattern, +! most MPI implementations assume that all communications are non-empty. +! The PSB_SIMPLE variants reuse the same communicator, and go for a simplistic +! sequence of sends/receive that is quite efficient for a sparse communication +! pattern. To be refined/reviewed in the future to compare with neighbour +! persistent collectives. ! ! Arguments: ! a - type(psb_dspmat_type) The local part of input matrix A @@ -55,9 +70,6 @@ ! psb_comm_ext_ use ext_index ! psb_comm_ovrl_ DISABLED for this routine. ! -#undef SP_A2AV_MPI -#undef SP_A2AV_XI -#define SP_A2AV_MAT Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,& & rowscale,colscale,outfmt,data) use psb_base_mod, psb_protect_name => psb_dsphalo @@ -314,16 +326,36 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,& call psb_errpush(info,name,a_err=ch_err); goto 9999 end if - - call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_dpk_,& - & acoo%val,rvsz,brvindx,psb_mpi_r_dpk_,icomm,minfo) - call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & acoo%val,iarcv,jarcv,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& + & acoo%val,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& + & iarcv,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& + & jarcv,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_mpi_) + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_dpk_,& + & acoo%val,rvsz,brvindx,psb_mpi_r_dpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& & iarcv,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & jarcv,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & jarcv,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select + if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='mpi_alltoallv' + ch_err='alltoallv' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if @@ -390,16 +422,36 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,& goto 9999 end if + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& + & acoo%val,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& + & acoo%ia,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& + & acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_mpi_) + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_dpk_,& + & acoo%val,rvsz,brvindx,psb_mpi_r_dpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select - call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_dpk_,& - & acoo%val,rvsz,brvindx,psb_mpi_r_dpk_,icomm,minfo) - call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_ipk_,& - & acoo%ia,rvsz,brvindx,psb_mpi_ipk_,icomm,minfo) - call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_ipk_,& - & acoo%ja,rvsz,brvindx,psb_mpi_ipk_,icomm,minfo) if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='mpi_alltoallv' + ch_err='alltoallv' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if @@ -506,8 +558,7 @@ Subroutine psb_ldsphalo(a,desc_a,blk,info,rowcnv,colcnv,& integer(psb_ipk_), intent(in), optional :: data ! ...local scalars.... integer(psb_ipk_) :: ictxt, np,me - integer(psb_ipk_) :: counter, proc, i, & - & n_el_send,n_el_recv,& + integer(psb_ipk_) :: counter, proc, i, n_el_send,n_el_recv, & & n_elem, j, ipx,mat_recv, idxs,idxr,nz,& & data_,totxch,nxs, nxr, ncg integer(psb_lpk_) :: r, k, irmin, irmax, icmin, icmax, iszs, iszr, & @@ -718,16 +769,37 @@ Subroutine psb_ldsphalo(a,desc_a,blk,info,rowcnv,colcnv,& goto 9999 end if + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& + & acoo%val,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& + & acoo%ia,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& + & acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_mpi_) + + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_dpk_,& + & acoo%val,rvsz,brvindx,psb_mpi_r_dpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select - call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_dpk_,& - & acoo%val,rvsz,brvindx,psb_mpi_r_dpk_,icomm,minfo) - call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) if (info /= psb_success_) then info=psb_err_from_subroutine_ - call psb_errpush(info,name,a_err='mpi_alltoallv') + call psb_errpush(info,name,a_err='alltoallv') goto 9999 end if @@ -829,12 +901,11 @@ Subroutine psb_ld_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& type(psb_desc_type),Intent(in), optional, target :: col_desc ! ...local scalars.... integer(psb_ipk_) :: ictxt, np,me - integer(psb_ipk_) :: counter,proc,i, & - & n_el_send,k,n_el_recv,r,& - & n_elem, j, ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& - & irmin,icmin,data_,totxch,nxs, nxr,& - & err_act, nsnds, nrcvs - integer(psb_lpk_) :: ngtz,irmax,icmax,l1, lnr, lnc, lnnz, ncg, jpx, idx, tot_elem + integer(psb_ipk_) :: counter,proc,i, n_el_send,n_el_recv,& + & n_elem, j,ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& + & data_,totxch,nxs, nxr, err_act, nsnds, nrcvs + integer(psb_lpk_) :: ngtz,irmax,icmax,irmin,icmin,l1, lnr, lnc, lnnz, & + & r, k, ncg, jpx, idx, tot_elem integer(psb_mpk_) :: icomm, minfo integer(psb_mpk_), allocatable :: brvindx(:), & & rvsz(:), bsdindx(:),sdsz(:) @@ -1054,32 +1125,36 @@ Subroutine psb_ld_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& goto 9999 end if -#if defined(SP_A2AV_MPI) - call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_dpk_,& - & acoo%val,rvsz,brvindx,psb_mpi_r_dpk_,icomm,minfo) - if (minfo == mpi_success) & - & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo == mpi_success) & - & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo /= mpi_success) info = minfo -#elif defined(SP_A2AV_XI) - call ld_my_a2av(valsnd,sdsz,bsdindx,& + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& & acoo%val,rvsz,brvindx,ictxt,info) - if (info == psb_success_) call i_my_a2av(iasnd,sdsz,bsdindx,& + if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& & acoo%ia,rvsz,brvindx,ictxt,info) - if (info == psb_success_) call i_my_a2av(jasnd,sdsz,bsdindx,& + if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& & acoo%ja,rvsz,brvindx,ictxt,info) -#elif defined(SP_A2AV_MAT) - call ld_coo_my_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ipdxv,ictxt,icomm,info) -#else - choke on me @! -#endif + case(psb_sp_a2av_mpi_) + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_dpk_,& + & acoo%val,rvsz,brvindx,psb_mpi_r_dpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select + if (info /= psb_success_) then info=psb_err_from_subroutine_ - call psb_errpush(info,name,a_err='mpi_alltoallv') + call psb_errpush(info,name,a_err='alltoallv') goto 9999 end if @@ -1163,185 +1238,376 @@ Subroutine psb_ld_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& return -#if defined(SP_A2AV_XI) || defined(SP_A2AV_MAT) -contains +End Subroutine psb_ld_csr_halo -#if defined(SP_A2AV_MAT) - subroutine ld_coo_my_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & valrcv,iarcv,jarcv,rvsz,brvindx,ipdxv,ictxt,icomm,info) +Subroutine psb_d_ld_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& + & rowscale,colscale,data,outcol_glob,col_desc) + use psb_base_mod, psb_protect_name => psb_d_ld_csr_halo #ifdef MPI_MOD - use mpi + use mpi #endif - Implicit None + Implicit None #ifdef MPI_H - include 'mpif.h' + include 'mpif.h' #endif - real(psb_dpk_), intent(in) :: valsnd(:) - integer(psb_ipk_), intent(in) :: ipdxv(:) - integer(psb_lpk_), intent(in) :: iasnd(:), jasnd(:) - real(psb_dpk_), intent(out) :: valrcv(:) - integer(psb_lpk_), intent(out) :: iarcv(:), jarcv(:) - integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_mpk_), intent(in) :: icomm - integer(psb_ipk_), intent(out) :: info - !Local variables - integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz, counter - integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret - integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) - call psb_info(ictxt,iam,np) - if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz))= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),': Start' + + if (present(rowcnv)) then + rowcnv_ = rowcnv + else + rowcnv_ = .true. + endif + if (present(colcnv)) then + colcnv_ = colcnv + else + colcnv_ = .true. + endif + if (present(rowscale)) then + rowscale_ = rowscale + else + rowscale_ = .false. + endif + if (present(colscale)) then + colscale_ = colscale + else + colscale_ = .false. + endif + if (present(data)) then + data_ = data + else + data_ = psb_comm_halo_ + endif + if (present(outcol_glob)) then + outcol_glob_ = outcol_glob + else + outcol_glob_ = .false. + endif + if (present(col_desc)) then + col_desc_ => col_desc + else + col_desc_ => desc_a + end if + + Allocate(brvindx(np+1),& + & rvsz(np),sdsz(np),bsdindx(np+1), acoo,stat=info) + + if (info /= psb_success_) then + info=psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + end if + + If (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Data selector',data_ + select case(data_) + case(psb_comm_halo_,psb_comm_ext_ ) + ! Do not accept OVRLAP_INDEX any longer. + case default + call psb_errpush(psb_err_from_subroutine_,name,a_err='wrong Data selector') + goto 9999 + end select - counter=1 - Do - ip=ipdxv(counter) - if (ip == -1) exit - n_el_recv = ipdxv(counter+psb_n_elem_recv_) - counter = counter+n_el_recv - n_el_send = ipdxv(counter+psb_n_elem_send_) - prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) - sz = rvsz(ip+1) - if (sz > 0) then - idx = brvindx(ip+1) - p2ptag = psb_double_swap_tag - call mpi_irecv(valrcv(idx+1:idx+sz),sz,& - & psb_mpi_r_dpk_,prcid(ip+1),& - & p2ptag, icomm,rvhd(ip+1,1),iret) - p2ptag = psb_int_swap_tag - call mpi_irecv(iarcv(idx+1:idx+sz),sz,& - & psb_mpi_lpk_,prcid(ip+1),& - & p2ptag, icomm,rvhd(ip+1,2),iret) - call mpi_irecv(jarcv(idx+1:idx+sz),sz,& - & psb_mpi_lpk_,prcid(ip+1),& - & p2ptag, icomm,rvhd(ip+1,3),iret) - end if - counter = counter+n_el_send+3 + sdsz(:)=0 + rvsz(:)=0 + l1 = 0 + brvindx(1) = 0 + bsdindx(1) = 0 + counter=1 + idx = 0 + idxs = 0 + idxr = 0 + + call desc_a%get_list(data_,pdxv,totxch,nxr,nxs,info) + ipdxv = pdxv%get_vect() + ! For all rows in the halo descriptor, extract the row size + lnr = 0 + Do + proc=ipdxv(counter) + if (proc == -1) exit + n_el_recv = ipdxv(counter+psb_n_elem_recv_) + counter = counter+n_el_recv + n_el_send = ipdxv(counter+psb_n_elem_send_) + tot_elem = 0 + Do j=0,n_el_send-1 + idx = ipdxv(counter+psb_elem_send_+j) + n_elem = a%get_nz_row(idx) + tot_elem = tot_elem+n_elem Enddo + sdsz(proc+1) = tot_elem + lnr = lnr + n_el_recv + counter = counter+n_el_send+3 + Enddo + ! + ! Exchange row sizes, so as to know sends/receives. + ! This is different from the halo exchange because the + ! size of the rows may vary, as opposed to fixed + ! (multi) vector row size. + ! + call mpi_alltoall(sdsz,1,psb_mpi_mpk_,& + & rvsz,1,psb_mpi_mpk_,icomm,minfo) + + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='mpi_alltoall') + goto 9999 + end if + nsnds = count(sdsz /= 0) + nrcvs = count(rvsz /= 0) + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Done initial alltoall',nsnds,nrcvs - counter=1 - Do - ip=ipdxv(counter) - if (ip == -1) exit - n_el_recv = ipdxv(counter+psb_n_elem_recv_) - counter = counter+n_el_recv - n_el_send = ipdxv(counter+psb_n_elem_send_) - if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) - sz = sdsz(ip+1) - if (sz > 0) then - idx = bsdindx(ip+1) - p2ptag = psb_double_swap_tag - call mpi_send(valsnd(idx+1:idx+sz),sz,& - & psb_mpi_r_dpk_,prcid(ip+1),& - & p2ptag, icomm,iret) - p2ptag = psb_int_swap_tag - call mpi_send(iasnd(idx+1:idx+sz),sz,& - & psb_mpi_lpk_,prcid(ip+1),& - & p2ptag, icomm,iret) - call mpi_send(jasnd(idx+1:idx+sz),sz,& - & psb_mpi_lpk_,prcid(ip+1),& - & p2ptag, icomm,iret) + idxs = 0 + idxr = 0 + counter = 1 + Do + proc=ipdxv(counter) + if (proc == -1) exit + n_el_recv = ipdxv(counter+psb_n_elem_recv_) + counter = counter+n_el_recv + n_el_send = ipdxv(counter+psb_n_elem_send_) + + bsdindx(proc+1) = idxs + idxs = idxs + sdsz(proc+1) + brvindx(proc+1) = idxr + idxr = idxr + rvsz(proc+1) + counter = counter+n_el_send+3 + Enddo + + iszr = sum(rvsz) + mat_recv = iszr + iszs = sum(sdsz) + + lnnz = max(iszr,iszs,ione) + lnc = a%get_ncols() + call acoo%allocate(lnr,lnc,lnnz) + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Sizes:',acoo%get_size(),& + & ' Send:',sdsz(:),' Receive:',rvsz(:) + + call psb_ensure_size(max(iszs,1),iasnd,info) + if (info == psb_success_) call psb_ensure_size(max(iszs,1),jasnd,info) + if (info == psb_success_) call psb_ensure_size(max(iszs,1),liasnd,info) + if (info == psb_success_) call psb_ensure_size(max(iszs,1),ljasnd,info) + if (info == psb_success_) call psb_ensure_size(max(iszs,1),valsnd,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='ensure_size') + goto 9999 + end if + + l1 = 0 + ipx = 1 + counter=1 + idx = 0 + ! + ! Make sure to get all columns in csget. + ! This is necessary when sphalo is used to compute a transpose, + ! as opposed to just gathering halo for spspmm purposes. + ! + ncg = huge(ncg) + tot_elem = 0 + Do + proc = ipdxv(counter) + if (proc == -1) exit + n_el_recv = ipdxv(counter+psb_n_elem_recv_) + counter = counter+n_el_recv + n_el_send = ipdxv(counter+psb_n_elem_send_) + + Do j=0,n_el_send-1 + idx = ipdxv(counter+psb_elem_send_+j) + n_elem = a%get_nz_row(idx) + call a%csget(idx,idx,ngtz,iasnd,jasnd,valsnd,info,& + & append=.true.,nzin=tot_elem,jmax=ncg) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_sp_getrow') + goto 9999 end if - counter = counter+n_el_send+3 + tot_elem = tot_elem+ngtz Enddo + counter = counter+n_el_send+3 + Enddo + nz = tot_elem - counter=1 - Do - ip=ipdxv(counter) - if (ip == -1) exit - n_el_recv = ipdxv(counter+psb_n_elem_recv_) - counter = counter+n_el_recv - n_el_send = ipdxv(counter+psb_n_elem_send_) - sz = rvsz(ip+1) - if (sz > 0) then - call mpi_wait(rvhd(ip+1,1),p2pstat,iret) - call mpi_wait(rvhd(ip+1,2),p2pstat,iret) - call mpi_wait(rvhd(ip+1,3),p2pstat,iret) - end if - counter = counter+n_el_send+3 - Enddo + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Going for alltoallv',iszs,iszr + if (rowcnv_) then + call psb_loc_to_glob(iasnd(1:nz),liasnd(1:nz),desc_a,info,iact='I') + else + liasnd(1:nz) = iasnd(1:nz) + end if + if (colcnv_) then + call psb_loc_to_glob(jasnd(1:nz),ljasnd(1:nz),col_desc_,info,iact='I') + else + ljasnd(1:nz) = jasnd(1:nz) + end if + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_loc_to_glob') + goto 9999 + end if + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,liasnd,ljasnd,sdsz,bsdindx,& + & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& + & acoo%val,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(liasnd,sdsz,bsdindx,& + & acoo%ia,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(ljasnd,sdsz,bsdindx,& + & acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_mpi_) + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_dpk_,& + & acoo%val,rvsz,brvindx,psb_mpi_r_dpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(liasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(ljasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select - end subroutine ld_coo_my_a2av -#endif -#if defined(SP_A2AV_XI) - subroutine ld_my_a2av(valsnd,sdsz,bsdindx,& - & valrcv,rvsz,brvindx,ictxt,info) - real(psb_dpk_), intent(in) :: valsnd(:) - real(psb_dpk_), intent(out) :: valrcv(:) - integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_ipk_), intent(out) :: info + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='alltoallv') + goto 9999 + end if + + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Done alltoallv' + ! + ! Convert into local numbering + ! + if (rowcnv_) call psb_glob_to_loc(acoo%ia(1:iszr),desc_a,info,iact='I') + ! + ! This seems to be the correct output condition + ! + if (colcnv_.and.(.not.outcol_glob_)) & + & call psb_glob_to_loc(acoo%ja(1:iszr),col_desc_,info,iact='I') - integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psbglob_to_loc') + goto 9999 + end if - call psb_info(ictxt,iam,np) - if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz))0).and.(k>0)) Then + l1=l1+1 + acoo%val(l1) = acoo%val(i) + acoo%ia(l1) = r + acoo%ja(l1) = k + irmin = min(irmin,r) + irmax = max(irmax,r) + icmin = min(icmin,k) + icmax = max(icmax,k) + End If + Enddo + if (rowscale_) then + call acoo%set_nrows(max(irmax-irmin+1,0)) + acoo%ia(1:l1) = acoo%ia(1:l1) - irmin + 1 + else + call acoo%set_nrows(irmax) + end if + if (colscale_) then + call acoo%set_ncols(max(icmax-icmin+1,0)) + acoo%ja(1:l1) = acoo%ja(1:l1) - icmin + 1 + else + call acoo%set_ncols(icmax) + end if - do ip = 0, np-1 - sz = sdsz(ip+1) - if (sz > 0) then - idx = bsdindx(ip+1) - call psb_snd(ictxt,valsnd(idx+1:idx+sz),ip) - end if - end do + call acoo%set_nzeros(l1) + call acoo%set_sorted(.false.) - do ip = 0, np-1 - sz = rvsz(ip+1) - if (sz > 0) then - idx = brvindx(ip+1) - call psb_rcv(ictxt,valrcv(idx+1:idx+sz),ip) - end if - end do - - end subroutine ld_my_a2av + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),& + & ': End data exchange',counter,l1 - subroutine i_my_a2av(valsnd,sdsz,bsdindx,& - & valrcv,rvsz,brvindx,ictxt,info) - integer(psb_ipk_), intent(in) :: valsnd(:) - integer(psb_ipk_), intent(out) :: valrcv(:) - integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_ipk_), intent(out) :: info - + call acoo%fix(info) + if (info == psb_success_) call acoo%mv_to_fmt(blk,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_spcnv') + goto 9999 + end if - integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz + Deallocate(brvindx,bsdindx,rvsz,sdsz,& + & iasnd,jasnd,valsnd,stat=info) + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Done' - call psb_info(ictxt,iam,np) - if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then - idx = bsdindx(ip+1) - call psb_snd(ictxt,valsnd(idx+1:idx+sz),ip) - end if - end do +9999 call psb_error_handler(ictxt,err_act) - do ip = 0, np-1 - sz = rvsz(ip+1) - if (sz > 0) then - idx = brvindx(ip+1) - call psb_rcv(ictxt,valrcv(idx+1:idx+sz),ip) - end if - end do - - end subroutine i_my_a2av -#endif -#endif -End Subroutine psb_ld_csr_halo + return + +End Subroutine psb_d_ld_csr_halo diff --git a/base/tools/psb_dspins.f90 b/base/tools/psb_dspins.F90 similarity index 99% rename from base/tools/psb_dspins.f90 rename to base/tools/psb_dspins.F90 index b774358b0..4018a36a8 100644 --- a/base/tools/psb_dspins.f90 +++ b/base/tools/psb_dspins.F90 @@ -288,6 +288,7 @@ subroutine psb_dspins_csr_lirp(nr,irp,ja,val,irw,a,desc_a,info,rebuild,local) end subroutine psb_dspins_csr_lirp +#if defined(IPK4) && defined(LPK8) subroutine psb_dspins_csr_iirp(nr,irw,irp,ja,val,a,desc_a,info,rebuild,local) use psb_base_mod, psb_protect_name => psb_dspins_csr_iirp use psi_mod @@ -384,6 +385,7 @@ subroutine psb_dspins_csr_iirp(nr,irw,irp,ja,val,a,desc_a,info,rebuild,local) return end subroutine psb_dspins_csr_iirp +#endif subroutine psb_dspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) use psb_base_mod, psb_protect_name => psb_dspins_2desc diff --git a/base/tools/psb_glob_to_loc.f90 b/base/tools/psb_glob_to_loc.f90 index 51b3f70d8..79799d195 100644 --- a/base/tools/psb_glob_to_loc.f90 +++ b/base/tools/psb_glob_to_loc.f90 @@ -60,10 +60,9 @@ subroutine psb_glob_to_loc2v(x,y,desc_a,info,iact,owned) !....locals.... integer(psb_ipk_) :: n, ictxt, iam, np - character :: act - integer(psb_ipk_) :: int_err(5), err_act - integer(psb_ipk_), parameter :: zero=0 - character(len=20) :: name + character :: act + integer(psb_ipk_) :: err_act + character(len=20) :: name if(psb_get_errstatus() /= 0) return info=psb_success_ @@ -181,10 +180,9 @@ subroutine psb_glob_to_loc1v(x,desc_a,info,iact,owned) !....locals.... integer(psb_ipk_) :: n - character :: act + character :: act integer(psb_ipk_) :: err_act - integer(psb_ipk_), parameter :: zero=0 - character(len=20) :: name + character(len=20) :: name integer(psb_ipk_) :: ictxt, iam, np if(psb_get_errstatus() /= 0) return diff --git a/base/tools/psb_i2allc_a.f90 b/base/tools/psb_i2allc_a.f90 new file mode 100644 index 000000000..3d453ea84 --- /dev/null +++ b/base/tools/psb_i2allc_a.f90 @@ -0,0 +1,246 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! 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: psb_i2allc.f90 +! +! Function: psb_i2alloc +! Allocates dense matrix for PSBLAS routines. +! The descriptor may be in either the build or assembled state. +! +! Arguments: +! x - the matrix to be allocated. +! desc_a - the communication descriptor. +! info - Return code +! n - optional number of columns. +! lb - optional lower bound on column indices +subroutine psb_i2alloc(x, desc_a, info, n, lb) + use psb_base_mod, psb_protect_name => psb_i2alloc + use psi_mod + implicit none + + !....parameters... + integer(psb_i2pk_), allocatable, intent(out) :: x(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_),intent(out) :: info + integer(psb_ipk_), optional, intent(in) :: n, lb + + !locals + integer(psb_ipk_) :: err,nr,i,j,n_,err_act + integer(psb_ipk_) :: ictxt,np,me + integer(psb_ipk_) :: exch(3) + character(len=20) :: name + + name='psb_geall' + info = psb_success_ + err = 0 + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + + 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 + + !... check m and n parameters.... + if (.not.psb_is_ok_desc(desc_a)) then + info = psb_err_input_matrix_unassembled_ + call psb_errpush(info,name) + goto 9999 + endif + + if (present(n)) then + n_ = n + else + n_ = 1 + endif + !global check on n parameters + if (me == psb_root_) then + exch(1)=n_ + call psb_bcast(ictxt,exch(1),root=psb_root_) + else + call psb_bcast(ictxt,exch(1),root=psb_root_) + if (exch(1) /= n_) then + info=psb_err_parm_differs_among_procs_ + call psb_errpush(info,name,i_err=(/ione/)) + goto 9999 + endif + endif + + !....allocate x ..... + if (psb_is_asb_desc(desc_a).or.psb_is_upd_desc(desc_a)) then + nr = max(1,desc_a%get_local_cols()) + else if (psb_is_bld_desc(desc_a)) then + nr = max(1,desc_a%get_local_rows()) + else + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='Invalid desc_a') + goto 9999 + endif + + call psb_realloc(nr,n_,x,info,lb2=lb) + if (info /= psb_success_) then + info=psb_err_alloc_request_ + call psb_errpush(info,name,i_err=(/nr*n_/),a_err='integer(psb_i2pk_)') + goto 9999 + endif + + x(:,:) = i2zero + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(ictxt,err_act) + + return + +end subroutine psb_i2alloc + +!!$ +!!$ Parallel Sparse BLAS version 3.5 +!!$ (C) Copyright 2006-2018 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari +!!$ +!!$ 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. +!!$ +!!$ +! +! Function: psb_i2allocv +! Allocates dense matrix for PSBLAS routines +! The descriptor may be in either the build or assembled state. +! +! Arguments: +! x(:) - the matrix to be allocated. +! desc_a - the communication descriptor. +! info - return code +subroutine psb_i2allocv(x, desc_a,info,n) + use psb_base_mod, psb_protect_name => psb_i2allocv + use psi_mod + implicit none + + !....parameters... + integer(psb_i2pk_), allocatable, intent(out) :: x(:) + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_),intent(out) :: info + integer(psb_ipk_), optional, intent(in) :: n + + !locals + integer(psb_ipk_) :: nr,i,err_act + integer(psb_ipk_) :: ictxt, np,me + integer(psb_ipk_) :: debug_level, debug_unit + character(len=20) :: name + + info=psb_success_ + name='psb_geall' + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt=desc_a%get_context() + + call psb_info(ictxt, me, np) + ! ....verify blacs grid correctness.. + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + !... check m and n parameters.... + if (.not.psb_is_ok_desc(desc_a)) then + info = psb_err_input_matrix_unassembled_ + call psb_errpush(info,name) + goto 9999 + endif + + ! As this is a rank-1 array, optional parameter N is actually ignored. + + !....allocate x ..... + if (psb_is_asb_desc(desc_a).or.psb_is_upd_desc(desc_a)) then + nr = max(1,desc_a%get_local_cols()) + else if (psb_is_bld_desc(desc_a)) then + nr = max(1,desc_a%get_local_rows()) + else + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='Invalid desc_a') + goto 9999 + endif + + call psb_realloc(nr,x,info) + if (info /= psb_success_) then + info=psb_err_alloc_request_ + call psb_errpush(info,name,i_err=(/nr/),a_err='integer(psb_i2pk_)') + goto 9999 + endif + + x(:) = i2zero + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(ictxt,err_act) + + return + +end subroutine psb_i2allocv + diff --git a/base/tools/psb_i2asb_a.f90 b/base/tools/psb_i2asb_a.f90 new file mode 100644 index 000000000..4e7cc9b04 --- /dev/null +++ b/base/tools/psb_i2asb_a.f90 @@ -0,0 +1,259 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! 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: psb_i2asb.f90 +! +! Subroutine: psb_i2asb +! Assembles a dense matrix for PSBLAS routines +! Since the allocation may have been called with the desciptor +! in the build state we make sure that X has a number of rows +! allowing for the halo indices, reallocating if necessary. +! We also call the halo routine for good measure. +! +! Arguments: +! x(:,:) - integer, allocatable The matrix to be assembled. +! desc_a - type(psb_desc_type). The communication descriptor. +! info - integer. return code +subroutine psb_i2asb(x, desc_a, info, scratch) + use psb_base_mod, psb_protect_name => psb_i2asb + implicit none + + type(psb_desc_type), intent(in) :: desc_a + integer(psb_i2pk_), allocatable, intent(inout) :: x(:,:) + integer(psb_ipk_), intent(out) :: info + logical, intent(in), optional :: scratch + + ! local variables + integer(psb_ipk_) :: ictxt,np,me,nrow,ncol, err_act + integer(psb_ipk_) :: i1sz, i2sz + integer(psb_ipk_) :: debug_level, debug_unit + logical :: scratch_ + character(len=20) :: name, ch_err + + info=psb_success_ + name='psb_i2geasb_m' + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + scratch_ = .false. + if (present(scratch)) scratch_ = scratch + + if (.not.psb_is_ok_desc(desc_a)) then + info=psb_err_input_matrix_unassembled_ + call psb_errpush(info,name) + goto 9999 + endif + ictxt = desc_a%get_context() + + call psb_info(ictxt, me, np) + + + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),': start: ',np,& + & desc_a%get_dectype() + ! ....verify blacs grid correctness.. + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + else if (.not.psb_is_asb_desc(desc_a)) then + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),' error ' + info = psb_err_input_matrix_unassembled_ + call psb_errpush(info,name) + goto 9999 + endif + + ! check size + ictxt = desc_a%get_context() + nrow = desc_a%get_local_rows() + ncol = desc_a%get_local_cols() + i1sz = size(x,dim=1) + i2sz = size(x,dim=2) + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),': ',i1sz,i2sz,nrow,ncol + + if (i1sz < ncol) then + call psb_realloc(ncol,i2sz,x,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_realloc') + goto 9999 + endif + endif + + if (.not.scratch_) then + ! ..update halo elements.. + call psb_halo(x,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_halo' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + end if + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),': end' + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(ictxt,err_act) + + return + +end subroutine psb_i2asb + + +!!$ +!!$ Parallel Sparse BLAS version 3.5 +!!$ (C) Copyright 2006-2018 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari +!!$ +!!$ 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: psb_i2asb +! Assembles a dense matrix for PSBLAS routines +! Since the allocation may have been called with the desciptor +! in the build state we make sure that X has a number of rows +! allowing for the halo indices, reallocating if necessary. +! We also call the halo routine for good measure. +! +! Arguments: +! x(:) - integer, allocatable The matrix to be assembled. +! desc_a - type(psb_desc_type). The communication descriptor. +! info - integer. Return code +subroutine psb_i2asbv(x, desc_a, info, scratch) + use psb_base_mod, psb_protect_name => psb_i2asbv + implicit none + + type(psb_desc_type), intent(in) :: desc_a + integer(psb_i2pk_), allocatable, intent(inout) :: x(:) + integer(psb_ipk_), intent(out) :: info + logical, intent(in), optional :: scratch + + ! local variables + integer(psb_ipk_) :: ictxt,np,me + integer(psb_ipk_) :: i1sz,nrow,ncol, err_act + integer(psb_ipk_) :: debug_level, debug_unit + logical :: scratch_ + character(len=20) :: name,ch_err + + info = psb_success_ + name = 'psb_i2geasb_v' + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + + ictxt = desc_a%get_context() + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + scratch_ = .false. + if (present(scratch)) scratch_ = scratch + + call psb_info(ictxt, me, np) + + ! ....verify blacs grid correctness.. + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + else if (.not.psb_is_asb_desc(desc_a)) then + info = psb_err_input_matrix_unassembled_ + call psb_errpush(info,name) + goto 9999 + endif + + nrow = desc_a%get_local_rows() + ncol = desc_a%get_local_cols() + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),': sizes: ',nrow,ncol + i1sz = size(x) + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),': sizes ',i1sz,ncol + if (i1sz < ncol) then + call psb_realloc(ncol,x,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_realloc') + goto 9999 + endif + endif + + if (.not.scratch_) then + ! ..update halo elements.. + call psb_halo(x,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='f90_pshalo' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + end if + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),': end' + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(ictxt,err_act) + + return + +end subroutine psb_i2asbv diff --git a/base/tools/psb_i2free_a.f90 b/base/tools/psb_i2free_a.f90 new file mode 100644 index 000000000..5e6736261 --- /dev/null +++ b/base/tools/psb_i2free_a.f90 @@ -0,0 +1,164 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! 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: psb_i2free.f90 +! +! Subroutine: psb_i2free +! frees a dense matrix structure +! +! Arguments: +! x(:,:) - integer, allocatable The dense matrix to be freed. +! desc_a - type(psb_desc_type). The communication descriptor. +! info - integer. Return code +subroutine psb_i2free(x, desc_a, info) + use psb_base_mod, psb_protect_name => psb_i2free + implicit none + + !....parameters... + integer(psb_i2pk_),allocatable, intent(inout) :: x(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(out) :: info + + !...locals.... + integer(psb_ipk_) :: ictxt,np,me, err_act + character(len=20) :: name + + name='psb_i2free' + info=psb_success_ + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + + if (.not.psb_is_ok_desc(desc_a)) then + info=psb_err_forgot_spall_ + call psb_errpush(info,name) + return + end if + + ictxt=desc_a%get_context() + + call psb_info(ictxt, me, np) + ! ....verify blacs grid correctness.. + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + if (.not.allocated(x)) then + info=psb_err_forgot_spall_ + call psb_errpush(info,name) + goto 9999 + end if + + !deallocate x + deallocate(x,stat=info) + if (info /= psb_no_err_) then + info=psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + endif + + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(ictxt,err_act) + + return + +end subroutine psb_i2free + + + +! Subroutine: psb_i2freev +! frees a dense matrix structure +! +! Arguments: +! x(:) - integer, allocatable The dense matrix to be freed. +! desc_a - type(psb_desc_type). The communication descriptor. +! info - integer. Return code +subroutine psb_i2freev(x, desc_a, info) + use psb_base_mod, psb_protect_name => psb_i2freev + implicit none + !....parameters... + integer(psb_i2pk_),allocatable, intent(inout) :: x(:) + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(out) :: info + + !...locals.... + integer(psb_ipk_) :: ictxt,np,me, err_act + character(len=20) :: name + + name='psb_i2freev' + info=psb_success_ + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + + if (.not.psb_is_ok_desc(desc_a)) then + info=psb_err_forgot_spall_ + call psb_errpush(info,name) + goto 9999 + end if + 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 (.not.allocated(x)) then + info=psb_err_forgot_spall_ + call psb_errpush(info,name) + goto 9999 + end if + + !deallocate x + deallocate(x,stat=info) + if (info /= psb_no_err_) then + info=psb_err_alloc_dealloc_ + call psb_errpush(info,name) + endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(ictxt,err_act) + + return + +end subroutine psb_i2freev diff --git a/base/tools/psb_i2ins_a.f90 b/base/tools/psb_i2ins_a.f90 new file mode 100644 index 000000000..76d7c260e --- /dev/null +++ b/base/tools/psb_i2ins_a.f90 @@ -0,0 +1,367 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! 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: psb_i2insvi +! Insert dense submatrix to dense matrix. Note: the row indices in IRW +! are assumed to be in global numbering and are converted on the fly. +! Row indices not belonging to the current process are silently discarded. +! +! Arguments: +! m - integer. Number of rows of submatrix belonging to +! val to be inserted. +! irw(:) - integer Row indices of rows of val (global numbering) +! val(:) - integer The source dense submatrix. +! x(:) - integer The destination dense matrix. +! desc_a - type(psb_desc_type). The communication descriptor. +! info - integer. return code +! dupl - integer What to do with duplicates: +! psb_dupl_ovwrt_ overwrite +! psb_dupl_add_ add +subroutine psb_i2insvi(m, irw, val, x, desc_a, info, dupl,local) + use psb_base_mod, psb_protect_name => psb_i2insvi + use psi_mod + implicit none + + ! m rows number of submatrix belonging to val to be inserted + + ! ix x global-row corresponding to position at which val submatrix + ! must be inserted + + !....parameters... + integer(psb_ipk_), intent(in) :: m + integer(psb_lpk_), intent(in) :: irw(:) + integer(psb_i2pk_), intent(in) :: val(:) + integer(psb_i2pk_),intent(inout) :: x(:) + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), optional, intent(in) :: dupl + logical, intent(in), optional :: local + + !locals..... + integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act + integer(psb_lpk_) :: mglob + integer(psb_ipk_) :: ictxt,np, me, dupl_ + integer(psb_ipk_), allocatable :: irl(:) + logical :: local_ + character(len=20) :: name + + name = 'psb_i2insvi' + info=psb_success_ + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + + if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + return + end if + + 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 + + !... check parameters.... + if (m < 0) then + info = psb_err_iarg_neg_ + call psb_errpush(info,name,i_err=(/ione,m/)) + goto 9999 + else if (size(x, dim=1) < desc_a%get_local_rows()) then + info = 310 + call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/)) + goto 9999 + endif + + if (m == 0) return + loc_rows = desc_a%get_local_rows() + loc_cols = desc_a%get_local_cols() + mglob = desc_a%get_global_rows() + + allocate(irl(m),stat=info) + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + endif + + if (present(dupl)) then + dupl_ = dupl + else + dupl_ = psb_dupl_ovwrt_ + endif + if (present(local)) then + local_ = local + else + local_ = .false. + endif + + if (local_) then + irl(1:m) = irw(1:m) + else + call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.) + end if + select case(dupl_) + case(psb_dupl_ovwrt_) + do i = 1, m + !loop over all val's rows + + ! row actual block row + if (irl(i) > 0) then + ! this row belongs to me + ! copy i-th row of block val in x + x(irl(i)) = val(i) + end if + enddo + + case(psb_dupl_add_) + + do i = 1, m + !loop over all val's rows + + if (irl(i) > 0) then + ! this row belongs to me + ! copy i-th row of block val in x + x(irl(i)) = x(irl(i)) + val(i) + end if + enddo + + case default + info = 321 + call psb_errpush(info,name) + goto 9999 + end select + deallocate(irl) + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(ictxt,err_act) + + return + +end subroutine psb_i2insvi + + + + +!!$ +!!$ Parallel Sparse BLAS version 3.5 +!!$ (C) Copyright 2006-2018 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari +!!$ +!!$ 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: psb_i2insi +! Insert dense submatrix to dense matrix. Note: the row indices in IRW +! are assumed to be in global numbering and are converted on the fly. +! Row indices not belonging to the current process are silently discarded. +! +! Arguments: +! m - integer. Number of rows of submatrix belonging to +! val to be inserted. +! irw(:) - integer Row indices of rows of val (global numbering) +! val(:,:) - integer The source dense submatrix. +! x(:,:) - integer The destination dense matrix. +! desc_a - type(psb_desc_type). The communication descriptor. +! info - integer. return code +! dupl - integer What to do with duplicates: +! psb_dupl_ovwrt_ overwrite +! psb_dupl_add_ add +subroutine psb_i2insi(m, irw, val, x, desc_a, info, dupl,local) + use psb_base_mod, psb_protect_name => psb_i2insi + use psi_mod + implicit none + + ! m rows number of submatrix belonging to val to be inserted + + ! ix x global-row corresponding to position at which val submatrix + ! must be inserted + + !....parameters... + integer(psb_ipk_), intent(in) :: m + integer(psb_lpk_), intent(in) :: irw(:) + integer(psb_i2pk_), intent(in) :: val(:,:) + integer(psb_i2pk_),intent(inout) :: x(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), optional, intent(in) :: dupl + logical, intent(in), optional :: local + + !locals..... + integer(psb_ipk_) :: i,loc_row,j,n, loc_rows,loc_cols,err_act + integer(psb_lpk_) :: mglob + integer(psb_ipk_) :: ictxt,np,me,dupl_ + integer(psb_ipk_), allocatable :: irl(:) + logical :: local_ + character(len=20) :: name + + name = 'psb_i2insi' + info = psb_success_ + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + + if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + return + end if + + 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 + + !... check parameters.... + if (m < 0) then + info = psb_err_iarg_neg_ + call psb_errpush(info,name,i_err=(/ione,m/)) + goto 9999 + else if (size(x, dim=1) < desc_a%get_local_rows()) then + info = 310 + call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/)) + goto 9999 + endif + if (m == 0) return + + loc_rows = desc_a%get_local_rows() + loc_cols = desc_a%get_local_cols() + mglob = desc_a%get_global_rows() + + n = min(size(val,2),size(x,2)) + + if (present(dupl)) then + dupl_ = dupl + else + dupl_ = psb_dupl_ovwrt_ + endif + + allocate(irl(m),stat=info) + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + endif + if (present(local)) then + local_ = local + else + local_ = .false. + endif + + if (local_) then + irl(1:m) = irw(1:m) + else + call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.) + end if + + select case(dupl_) + case(psb_dupl_ovwrt_) + do i = 1, m + !loop over all val's rows + + ! row actual block row + loc_row = irl(i) + if (loc_row > 0) then + ! this row belongs to me + ! copy i-th row of block val in x + do j=1,n + x(loc_row,j) = val(i,j) + end do + end if + enddo + + case(psb_dupl_add_) + + do i = 1, m + !loop over all val's rows + + ! row actual block row + loc_row = irl(i) + if (loc_row > 0) then + ! this row belongs to me + ! copy i-th row of block val in x + do j=1,n + x(loc_row,j) = x(loc_row,j) + val(i,j) + end do + end if + enddo + + case default + info = 321 + call psb_errpush(info,name) + goto 9999 + end select + deallocate(irl) + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(ictxt,err_act) + + return + +end subroutine psb_i2insi + diff --git a/base/tools/psb_icdasb.F90 b/base/tools/psb_icdasb.F90 index 7176d1856..6b2ba1990 100644 --- a/base/tools/psb_icdasb.F90 +++ b/base/tools/psb_icdasb.F90 @@ -65,6 +65,10 @@ subroutine psb_icdasb(desc,info,ext_hv,mold) integer(psb_ipk_) :: i, n_col, dectype, err_act, n_row integer(psb_mpk_) :: np,me, icomm, ictxt logical :: ext_hv_ + logical, parameter :: do_timings=.false. + integer(psb_ipk_), save :: idx_phase1=-1, idx_phase2=-1, idx_phase3=-1 + integer(psb_ipk_), save :: idx_phase11=-1, idx_phase12=-1, idx_phase13=-1 + integer(psb_ipk_), save :: idx_total=-1 integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -81,7 +85,22 @@ subroutine psb_icdasb(desc,info,ext_hv,mold) n_row = desc%get_local_rows() n_col = desc%get_local_cols() icomm = desc%get_mpic() + if ((do_timings).and.(idx_total==-1)) & + & idx_total = psb_get_timer_idx("ICDASB: total ") + if ((do_timings).and.(idx_phase1==-1)) & + & idx_phase1 = psb_get_timer_idx("ICDASB: phase1 ") + if ((do_timings).and.(idx_phase2==-1)) & + & idx_phase2 = psb_get_timer_idx("ICDASB: phase2") + if ((do_timings).and.(idx_phase3==-1)) & + & idx_phase3 = psb_get_timer_idx("ICDASB: phase3") +!!$ if ((do_timings).and.(idx_phase11==-1)) & +!!$ & idx_phase11 = psb_get_timer_idx("ICDASB: phase11 ") +!!$ if ((do_timings).and.(idx_phase12==-1)) & +!!$ & idx_phase12 = psb_get_timer_idx("ICDASB: phase12") +!!$ if ((do_timings).and.(idx_phase13==-1)) & +!!$ & idx_phase13 = psb_get_timer_idx("ICDASB: phase13") + call psb_tic(idx_total) ! check on blacs grid call psb_info(ictxt, me, np) if (np == -1) then @@ -115,6 +134,7 @@ subroutine psb_icdasb(desc,info,ext_hv,mold) & write(debug_unit, *) me,' ',trim(name),': start' if (allocated(desc%indxmap)) then + if (do_timings) call psb_tic(idx_phase1) if (.not.ext_hv_) then call psi_bld_tmphalo(desc,info) if (info /= psb_success_) then @@ -122,7 +142,8 @@ subroutine psb_icdasb(desc,info,ext_hv,mold) goto 9999 end if end if - + if (do_timings) call psb_toc(idx_phase1) + if (do_timings) call psb_tic(idx_phase2) ! Take out the lists for ovrlap, halo and ext... call psb_move_alloc(desc%ovrlap_index,ovrlap_index,info) call psb_move_alloc(desc%halo_index,halo_index,info) @@ -144,6 +165,8 @@ subroutine psb_icdasb(desc,info,ext_hv,mold) call psb_errpush(info,name) goto 9999 end if + if (do_timings) call psb_toc(idx_phase2) + if (do_timings) call psb_tic(idx_phase3) call desc%indxmap%asb(info) if (info == psb_success_) then @@ -154,14 +177,14 @@ subroutine psb_icdasb(desc,info,ext_hv,mold) write(0,*) 'Error from internal indxmap asb ',info info = psb_success_ end if - + if (do_timings) call psb_toc(idx_phase3) else info = psb_err_invalid_cd_state_ call psb_errpush(info,name) goto 9999 endif - + call psb_toc(idx_total) if (debug_level >= psb_debug_ext_) & & write(debug_unit,*) me,' ',trim(name),': Done' diff --git a/base/tools/psb_s_glob_transpose.F90 b/base/tools/psb_s_glob_transpose.F90 new file mode 100644 index 000000000..afc4d3745 --- /dev/null +++ b/base/tools/psb_s_glob_transpose.F90 @@ -0,0 +1,902 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! 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: psb_s_glob_transpose.f90 +! +! Subroutine: psb_s_glob_transpose +! Version: real +! +! This file provides multiple related versions of a parallel +! global transpose +! +! B = A^T +! +! There are some variations of this routine, that are accounted for +! in the workhorse psb_ls_coo_glob_transpose +! 1. The row and column spaces can share the same descriptor +! This essentially means that the descriptor relates to a +! matrix with a symmetric pattern. Examples are: symmetric +! matrices, matrices with symmetric pattern, lower or +! upper halves of such matrices +! 2. The row and column index spaces are different +! In this case you need to have two descriptor on input, +! plus if you want the output to be distributed according +! to the row descriptor, you will still need a new descriptor +! because even if the row distribution is the same, the pattern +! will be different. +! +! This is handled in the workhorse by having one mandatory and +! two optional descriptors: +! 1. If only the mandatory descriptor is present, then it is assumed that it +! is both row and column descriptor, and that it is sufficient. +! 2. If two descriptors are available, then use the second +! 3. If the third output descriptor is available, then rebuild it +! after the data exchange. +! +! The main transpose algorithm works like this: +! 1. Compute sizes: any entry A(I,J) with J in the halo will have +! to be sent to the process owning J, so walk through the +! matrix and compute all the send sizes, then do an alltoall to figure +! the receive sizes; +! 2. Adjust send bufffers; +! 3. Perform a local transpose; +! 4. Split the matrix: all local entries stay, all halo entries go into +! the send buffers, and are converted to global numbering; +! 5. Do the all-to-all (see below for a discussion of the alternative +! communication strategies) +! 6. The receive is in the extra section of the ACOO buffer; convert +! the row indices to local numbering, and discard extra ones (there will +! be some) +! 7. If desc_rx was requested, make sure to insert the (new) column indices +! 8. Cleanup and sort the output matrix +! 9. Copy back into AIN or ATRANS if requested. +! +! There are three possible exchange algorithms: +! 1. Use MPI_Alltoallv +! 2. Use psb_simple_a2av +! 3. Use psb_simple_triad_a2av +! Default choice is 3. The MPI variant has proved to be inefficient; +! that is because it is not persistent, therefore you pay the initialization price +! every time, and it is not optimized for a sparse communication pattern, +! most MPI implementations assume that all communications are non-empty. +! The PSB_SIMPLE variants reuse the same communicator, and go for a simplistic +! sequence of sends/receive that is quite efficient for a sparse communication +! pattern. To be refined/reviewed in the future to compare with neighbour +! persistent collectives. +! +! +subroutine psb_ls_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) +#ifdef MPI_MOD + use mpi +#endif + use psb_base_mod, psb_protect_name => psb_ls_coo_glob_transpose + Implicit None +#ifdef MPI_H + include 'mpif.h' +#endif + type(psb_ls_coo_sparse_mat), intent(inout) :: ain + type(psb_desc_type), intent(inout), target :: desc_r + type(psb_ls_coo_sparse_mat), intent(out), optional :: atrans + type(psb_desc_type), intent(inout), target, optional :: desc_c + type(psb_desc_type), intent(out), optional :: desc_rx + integer(psb_ipk_), intent(out) :: info + + ! ...local scalars.... + integer(psb_ipk_) :: ictxt, np,me + integer(psb_ipk_) :: counter,proc, err_act, j + integer(psb_lpk_) :: i, k, idx, r, ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& + & l1, nsnds, nrcvs, nr,nc,nzl, hlstart, nzt, nzd + integer(psb_mpk_) :: icomm, minfo + integer(psb_mpk_), allocatable :: brvindx(:), & + & rvsz(:), bsdindx(:), sdsz(:), tsdx(:), trvx(:) + integer(psb_ipk_), allocatable :: halo_owner(:) + integer(psb_lpk_), allocatable :: iasnd(:), jasnd(:) + real(psb_spk_), allocatable :: valsnd(:) + type(psb_ls_coo_sparse_mat), allocatable :: acoo + logical :: rowcnv_,colcnv_,rowscale_,colscale_,outcol_glob_ + type(psb_desc_type), pointer :: p_desc_c + character(len=5) :: outfmt_ + integer(psb_ipk_) :: debug_level, debug_unit + character(len=20) :: name, ch_err + + if(psb_get_errstatus() /= 0) return + info=psb_success_ + name='mld_glob_transpose' + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt = desc_r%get_context() + icomm = desc_r%get_mpic() + + Call psb_info(ictxt, me, np) + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),': Start' + + if (present(desc_c)) then + p_desc_c => desc_c + else + p_desc_c => desc_r + end if + + Allocate(brvindx(np+1),& + & rvsz(np),sdsz(np),bsdindx(np+1), acoo,stat=info) + + if (info /= psb_success_) then + info=psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + end if + + + sdsz(:)=0 + rvsz(:)=0 + l1 = 0 + brvindx(1) = 0 + bsdindx(1) = 0 + counter=1 + idx = 0 + idxs = 0 + idxr = 0 + + if (present(atrans)) then + call ain%cp_to_coo(acoo,info) + else + call ain%mv_to_coo(acoo,info) + end if + + + ! + ! Compute number of entries in the + ! halo part, sorted by destination process + ! + nr = desc_r%get_local_rows() + nc = p_desc_c%get_local_cols() + nzl = acoo%get_nzeros() + hlstart = p_desc_c%get_local_rows() + do k=1, nzl + j = acoo%ja(k) + if (j > hlstart) then + call p_desc_c%indxmap%fnd_halo_owner(j,proc,info) + sdsz(proc+1) = sdsz(proc+1) +1 + end if + end do + + ! + ! Exchange sizes, so as to know sends/receives. + ! This is different from the halo exchange because the + ! number of entries was not precomputed in the descriptor, + ! which was vector-oriented and not matrix-entry-oriented + ! + call mpi_alltoall(sdsz,1,psb_mpi_mpk_,& + & rvsz,1,psb_mpi_mpk_,icomm,minfo) + + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='mpi_alltoall') + goto 9999 + end if + nsnds = count(sdsz /= 0) + nrcvs = count(rvsz /= 0) + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Done initial alltoall',nsnds,nrcvs + + idxs = 0 + idxr = 0 + counter = 1 + Do proc = 0, np-1 + bsdindx(proc+1) = idxs + idxs = idxs + sdsz(proc+1) + brvindx(proc+1) = idxr + idxr = idxr + rvsz(proc+1) + Enddo + + tsdx = bsdindx + trvx = brvindx + + iszr = sum(rvsz) + iszs = sum(sdsz) + + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Sizes:',& + & ' Send:',sdsz(:),' Receive:',rvsz(:) + + call psb_ensure_size(max(iszs,1),iasnd,info) + if (info == psb_success_) call psb_ensure_size(max(iszs,1),jasnd,info) + if (info == psb_success_) call psb_ensure_size(max(iszs,1),valsnd,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='ensure_size') + goto 9999 + end if + + ! + ! Now, transpose the matrix, then split between itself + ! and the send buffers + ! + call acoo%transp() + if (acoo%get_nzeros()/= nzl) then + write(0,*) me,'Something strange upon transpose: ',nzl,acoo%get_nzeros() + end if + nzl = acoo%get_nzeros() + hlstart = p_desc_c%get_local_rows() + + + nzd = 0 + do k = 1, nzl + j = acoo%ia(k) + if (j<=hlstart) then + nzd = nzd + 1 + acoo%ia(nzd) = acoo%ia(k) + acoo%ja(nzd) = acoo%ja(k) + acoo%val(nzd) = acoo%val(k) + else + call p_desc_c%indxmap%fnd_halo_owner(j,proc,info) + tsdx(proc+1) = tsdx(proc+1) +1 + iasnd(tsdx(proc+1)) = acoo%ia(k) + jasnd(tsdx(proc+1)) = acoo%ja(k) + valsnd(tsdx(proc+1)) = acoo%val(k) + end if + end do + call acoo%set_nzeros(nzd) + ! + ! Put halo entries in global numbering + ! + call desc_r%indxmap%l2gip(jasnd(1:iszs),info) + call p_desc_c%indxmap%l2gip(iasnd(1:iszs),info) + ! And exchange data. + ! Normally we'll use our SIMPLE A2AV and not MPI, because + ! the communication pattern is sparse, so ours is more + ! efficient. Using ACOO for the receive buffers. + nzl = acoo%get_nzeros() + call acoo%ensure_size(nzl+iszr) + + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & acoo%val(nzl+1:nzl+iszr),acoo%ia(nzl+1:nzl+iszr),& + & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& + & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& + & acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& + & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_mpi_) + + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_spk_,& + & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_r_spk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select + + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='alltoallv') + goto 9999 + end if + + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Done alltoallv' + + if (present(desc_rx)) then + ! + ! Extend the appropriate descriptor; started as R but on + ! transpose it now describes C + ! + call desc_r%clone(desc_rx,info) + call psb_cd_reinit(desc_rx,info) + ! + ! Take out non-local rows + ! + call psb_glob_to_loc(acoo%ia(nzl+1:nzl+iszr),p_desc_c,info,iact='I',owned=.true.) + call psb_coo_clean_negidx_inner(iszr,acoo%ia(nzl+1:nzl+iszr),acoo%ja(nzl+1:nzl+iszr),& + & acoo%val(nzl+1:nzl+iszr),nzt,info) + call desc_rx%g2lip_ins(acoo%ja(nzl+1:nzl+nzt),info) + call psb_cdasb(desc_rx,info) + nzl = nzl + nzt + call acoo%set_nzeros(nzl) + nzl = acoo%get_nzeros() + call acoo%set_sorted(.false.) + ! + ! Insert to extend descriptor + ! + call acoo%set_nrows(p_desc_c%get_local_rows()) + call acoo%set_ncols(desc_rx%get_local_cols()) + !write(0,*) me,' Trans RX ',acoo%get_nrows(),acoo%get_ncols(),acoo%get_nzeros() + else + ! + ! + ! Take out non-local rows + ! + call psb_glob_to_loc(acoo%ia(nzl+1:nzl+iszr),p_desc_c,info,iact='I',owned=.true.) + call psb_glob_to_loc(acoo%ja(nzl+1:nzl+iszr),desc_r,info,iact='I') + call psb_coo_clean_negidx_inner(iszr,acoo%ia(nzl+1:nzl+iszr),acoo%ja(nzl+1:nzl+iszr),& + & acoo%val(nzl+1:nzl+iszr),nzt,info) + + nzl = nzl + nzt + call acoo%set_nzeros(nzl) + nzl = acoo%get_nzeros() + call acoo%set_sorted(.false.) + + call acoo%set_nrows(p_desc_c%get_local_rows()) + call acoo%set_ncols(desc_r%get_local_cols()) + !write(0,*) me,' Trans R- ',acoo%get_nrows(),acoo%get_ncols(),acoo%get_nzeros() + end if + +!!$ write(0,*) me,' Sanity check after rx%g2l :',count(acoo%ja(1:nzl)<0) + + + call acoo%fix(info) + nzl = acoo%get_nzeros() + + if (present(atrans)) then + call atrans%mv_from_coo(acoo,info) + else + call ain%mv_from_coo(acoo,info) + end if + Deallocate(brvindx,bsdindx,rvsz,sdsz,& + & iasnd,jasnd,valsnd,stat=info) + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Done' + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(ictxt,err_act) + + return +end subroutine psb_ls_coo_glob_transpose + +subroutine psb_s_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) +#ifdef MPI_MOD + use mpi +#endif + use psb_base_mod, psb_protect_name => psb_s_coo_glob_transpose + Implicit None +#ifdef MPI_H + include 'mpif.h' +#endif + type(psb_s_coo_sparse_mat), intent(inout) :: ain + type(psb_desc_type), intent(inout), target :: desc_r + type(psb_s_coo_sparse_mat), intent(out), optional :: atrans + type(psb_desc_type), intent(inout), target, optional :: desc_c + type(psb_desc_type), intent(out), optional :: desc_rx + integer(psb_ipk_), intent(out) :: info + + integer(psb_ipk_) :: ictxt, np,me + integer(psb_ipk_) :: counter,proc, err_act, j + integer(psb_ipk_) :: i, k, idx, r, ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& + & l1, nsnds, nrcvs, nr,nc,nzl, hlstart, nzd + integer(psb_lpk_) :: nzt, lszr + integer(psb_mpk_) :: icomm, minfo + integer(psb_mpk_), allocatable :: brvindx(:), & + & rvsz(:), bsdindx(:), sdsz(:), tsdx(:), trvx(:) + integer(psb_ipk_), allocatable :: halo_owner(:) + integer(psb_lpk_), allocatable :: iasnd(:), jasnd(:),iarcv(:),jarcv(:) + real(psb_spk_), allocatable :: valsnd(:) + type(psb_s_coo_sparse_mat), allocatable :: acoo + logical :: rowcnv_,colcnv_,rowscale_,colscale_,outcol_glob_ + type(psb_desc_type), pointer :: p_desc_c + character(len=5) :: outfmt_ + integer(psb_ipk_) :: debug_level, debug_unit + character(len=20) :: name, ch_err + + if(psb_get_errstatus() /= 0) return + info=psb_success_ + name='mld_glob_transpose' + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt = desc_r%get_context() + icomm = desc_r%get_mpic() + + Call psb_info(ictxt, me, np) + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),': Start' + + if (present(desc_c)) then + p_desc_c => desc_c + else + p_desc_c => desc_r + end if + + Allocate(brvindx(np+1),& + & rvsz(np),sdsz(np),bsdindx(np+1), acoo,stat=info) + + if (info /= psb_success_) then + info=psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + end if + + + sdsz(:)=0 + rvsz(:)=0 + l1 = 0 + brvindx(1) = 0 + bsdindx(1) = 0 + counter=1 + idx = 0 + idxs = 0 + idxr = 0 + + if (present(atrans)) then + call ain%cp_to_coo(acoo,info) + else + call ain%mv_to_coo(acoo,info) + end if + + + ! + ! Compute number of entries in the + ! halo part, sorted by destination process + ! + nr = desc_r%get_local_rows() + nc = p_desc_c%get_local_cols() + nzl = acoo%get_nzeros() + hlstart = p_desc_c%get_local_rows() + do k=1, nzl + j = acoo%ja(k) + if (j > hlstart) then + call p_desc_c%indxmap%fnd_halo_owner(j,proc,info) + sdsz(proc+1) = sdsz(proc+1) +1 + end if + end do + + ! + ! Exchange sizes, so as to know sends/receives. + ! This is different from the halo exchange because the + ! number of entries was not precomputed in the descriptor, + ! which was vector-oriented and not matrix-entry-oriented + ! + call mpi_alltoall(sdsz,1,psb_mpi_mpk_,& + & rvsz,1,psb_mpi_mpk_,icomm,minfo) + + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='mpi_alltoall') + goto 9999 + end if + nsnds = count(sdsz /= 0) + nrcvs = count(rvsz /= 0) + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Done initial alltoall',nsnds,nrcvs + + idxs = 0 + idxr = 0 + counter = 1 + Do proc = 0, np-1 + bsdindx(proc+1) = idxs + idxs = idxs + sdsz(proc+1) + brvindx(proc+1) = idxr + idxr = idxr + rvsz(proc+1) + Enddo + + tsdx = bsdindx + trvx = brvindx + + iszr = sum(rvsz) + iszs = sum(sdsz) + + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Sizes:',& + & ' Send:',sdsz(:),' Receive:',rvsz(:) + + call psb_ensure_size(max(iszs,1),iasnd,info) + if (info == psb_success_) call psb_ensure_size(max(iszs,1),jasnd,info) + if (info == psb_success_) call psb_ensure_size(max(iszs,1),valsnd,info) + if (info == psb_success_) call psb_ensure_size(max(iszr,1),iarcv,info) + if (info == psb_success_) call psb_ensure_size(max(iszr,1),jarcv,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='ensure_size') + goto 9999 + end if + + ! + ! Now, transpose the matrix, then split between itself + ! and the send buffers + ! + call acoo%transp() + if (acoo%get_nzeros()/= nzl) then + write(0,*) me,'Something strange upon transpose: ',nzl,acoo%get_nzeros() + end if + nzl = acoo%get_nzeros() + hlstart = p_desc_c%get_local_rows() + + + nzd = 0 + do k = 1, nzl + j = acoo%ia(k) + if (j<=hlstart) then + nzd = nzd + 1 + acoo%ia(nzd) = acoo%ia(k) + acoo%ja(nzd) = acoo%ja(k) + acoo%val(nzd) = acoo%val(k) + else + call p_desc_c%indxmap%fnd_halo_owner(j,proc,info) + tsdx(proc+1) = tsdx(proc+1) +1 + iasnd(tsdx(proc+1)) = acoo%ia(k) + jasnd(tsdx(proc+1)) = acoo%ja(k) + valsnd(tsdx(proc+1)) = acoo%val(k) + end if + end do + call acoo%set_nzeros(nzd) + ! + ! Put halo entries in global numbering + ! + call desc_r%indxmap%l2gip(jasnd(1:iszs),info) + call p_desc_c%indxmap%l2gip(iasnd(1:iszs),info) + ! And exchange data. + ! Normally we'll use our SIMPLE A2AV and not MPI, because + ! the communication pattern is sparse, so ours is more + ! efficient. Using ACOO for the receive buffers. + nzl = acoo%get_nzeros() + call acoo%ensure_size(nzl+iszr) + + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & acoo%val(nzl+1:nzl+iszr),iarcv(1:iszr),& + & jarcv(1:iszr),rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& + & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& + & iarcv(1:iszr),rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& + & jarcv(1:iszr),rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_mpi_) + + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_spk_,& + & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_r_spk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & iarcv(1:iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & jarcv(1:iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select + + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='alltoallv') + goto 9999 + end if + + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Done alltoallv' + + if (present(desc_rx)) then + ! + ! Extend the appropriate descriptor; started as R but on + ! transpose it now describes C + ! + call desc_r%clone(desc_rx,info) + call psb_cd_reinit(desc_rx,info) + ! + ! Take out non-local rows + ! + call psb_glob_to_loc(iarcv(1:iszr),p_desc_c,info,iact='I',owned=.true.) + lszr = iszr + call psb_coo_clean_negidx_inner(lszr,iarcv(1:iszr),jarcv(1:iszr),& + & acoo%val(nzl+1:nzl+iszr),nzt,info) + call desc_rx%g2lip_ins(jarcv(1:nzt),info) + call psb_cdasb(desc_rx,info) + acoo%ia(nzl+1:nzl+nzt) = iarcv(1:nzt) + acoo%ja(nzl+1:nzl+nzt) = jarcv(1:nzt) + nzl = nzl + nzt + call acoo%set_nzeros(nzl) + nzl = acoo%get_nzeros() + call acoo%set_sorted(.false.) + ! + ! Insert to extend descriptor + ! + call acoo%set_nrows(p_desc_c%get_local_rows()) + call acoo%set_ncols(desc_rx%get_local_cols()) + !write(0,*) me,' Trans RX ',acoo%get_nrows(),acoo%get_ncols(),acoo%get_nzeros() + else + ! + ! + ! Take out non-local rows + ! + call psb_glob_to_loc(iarcv(1:iszr),p_desc_c,info,iact='I',owned=.true.) + call psb_glob_to_loc(jarcv(1:iszr),desc_r,info,iact='I') + lszr = iszr + call psb_coo_clean_negidx_inner(lszr,iarcv(1:iszr),jarcv(1:iszr),& + & acoo%val(nzl+1:nzl+iszr),nzt,info) + acoo%ia(nzl+1:nzl+nzt) = iarcv(1:nzt) + acoo%ja(nzl+1:nzl+nzt) = jarcv(1:nzt) + nzl = nzl + nzt + call acoo%set_nzeros(nzl) + nzl = acoo%get_nzeros() + call acoo%set_sorted(.false.) + + call acoo%set_nrows(p_desc_c%get_local_rows()) + call acoo%set_ncols(desc_r%get_local_cols()) + !write(0,*) me,' Trans R- ',acoo%get_nrows(),acoo%get_ncols(),acoo%get_nzeros() + end if + +!!$ write(0,*) me,' Sanity check after rx%g2l :',count(acoo%ja(1:nzl)<0) + + + call acoo%fix(info) + nzl = acoo%get_nzeros() + + if (present(atrans)) then + call atrans%mv_from_coo(acoo,info) + else + call ain%mv_from_coo(acoo,info) + end if + Deallocate(brvindx,bsdindx,rvsz,sdsz,& + & iasnd,jasnd,valsnd,& + & iarcv,jarcv,stat=info) + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Done' + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(ictxt,err_act) + + return +end subroutine psb_s_coo_glob_transpose + +subroutine psb_s_simple_glob_transpose_ip(ain,desc_a,info) + use psb_base_mod, psb_protect_name => psb_s_simple_glob_transpose_ip + implicit none + type(psb_sspmat_type), intent(inout) :: ain + type(psb_desc_type) :: desc_a + integer(psb_ipk_), intent(out) :: info + + ! + ! BEWARE: This routine works under the assumption + ! that the same DESC_A works for both A and A^T, which + ! essentially means that A has a symmetric pattern. + ! + type(psb_s_coo_sparse_mat) :: tmpc1, tmpc2 + integer(psb_ipk_) :: nz1, nz2, nzh, nz + integer(psb_ipk_) :: ictxt, me, np + integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz + integer(psb_lpk_), allocatable :: ilv(:) + character(len=80) :: aname + logical, parameter :: debug=.false., dump=.false., debug_sync=.false. + + ictxt = desc_a%get_context() + call psb_info(ictxt,me,np) + + nrow = desc_a%get_local_rows() + ncol = desc_a%get_local_cols() + if (debug_sync) then + call psb_barrier(ictxt) + if (me == 0) write(0,*) 'Start htranspose ' + end if + + + call ain%mv_to(tmpc1) + call psb_glob_transpose(tmpc1, desc_a,info,atrans=tmpc2) + call ain%mv_from(tmpc2) + + if (dump) then + block + type(psb_lsspmat_type) :: aglb + write(aname,'(a,i3.3,a)') 'atran-',me,'.mtx' + call ain%print(fname=aname,head='atrans ') + call psb_gather(aglb,ain,desc_a,info) + if (me==psb_root_) then + write(aname,'(a,i3.3,a)') 'atran.mtx' + call aglb%print(fname=aname,head='Test ') + end if + end block + end if + +end subroutine psb_s_simple_glob_transpose_ip + +subroutine psb_s_simple_glob_transpose(ain,aout,desc_a,info) + use psb_base_mod, psb_protect_name => psb_s_simple_glob_transpose + implicit none + type(psb_sspmat_type), intent(in) :: ain + type(psb_sspmat_type), intent(out) :: aout + type(psb_desc_type) :: desc_a + integer(psb_ipk_), intent(out) :: info + + ! + ! BEWARE: This routine works under the assumption + ! that the same DESC_A works for both A and A^T, which + ! essentially means that A has a symmetric pattern. + ! + type(psb_s_coo_sparse_mat) :: tmpc1, tmpc2 + integer(psb_ipk_) :: nz1, nz2, nzh, nz + integer(psb_ipk_) :: ictxt, me, np + integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz + integer(psb_lpk_), allocatable :: ilv(:) + character(len=80) :: aname + logical, parameter :: debug=.false., dump=.false., debug_sync=.false. + + ictxt = desc_a%get_context() + call psb_info(ictxt,me,np) + + nrow = desc_a%get_local_rows() + ncol = desc_a%get_local_cols() + if (debug_sync) then + call psb_barrier(ictxt) + if (me == 0) write(0,*) 'Start htranspose ' + end if + + + call ain%cp_to(tmpc1) + call psb_glob_transpose(tmpc1, desc_a,info,atrans=tmpc2) + call aout%mv_from(tmpc2) + + if (dump) then + block + type(psb_lsspmat_type) :: aglb + + write(aname,'(a,i3.3,a)') 'atran-',me,'.mtx' + call aout%print(fname=aname,head='atrans ') + call psb_gather(aglb,aout,desc_a,info) + if (me==psb_root_) then + write(aname,'(a,i3.3,a)') 'atran.mtx' + call aglb%print(fname=aname,head='Test ') + end if + end block + end if + +end subroutine psb_s_simple_glob_transpose + +subroutine psb_ls_simple_glob_transpose_ip(ain,desc_a,info) + use psb_base_mod, psb_protect_name => psb_ls_simple_glob_transpose_ip + implicit none + type(psb_lsspmat_type), intent(inout) :: ain + type(psb_desc_type) :: desc_a + integer(psb_ipk_), intent(out) :: info + + ! + ! BEWARE: This routine works under the assumption + ! that the same DESC_A works for both A and A^T, which + ! essentially means that A has a symmetric pattern. + ! + type(psb_ls_coo_sparse_mat) :: tmpc1, tmpc2 + integer(psb_ipk_) :: nz1, nz2, nzh, nz + integer(psb_ipk_) :: ictxt, me, np + integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz + integer(psb_lpk_), allocatable :: ilv(:) + character(len=80) :: aname + logical, parameter :: debug=.false., dump=.false., debug_sync=.false. + + ictxt = desc_a%get_context() + call psb_info(ictxt,me,np) + + nrow = desc_a%get_local_rows() + ncol = desc_a%get_local_cols() + if (debug_sync) then + call psb_barrier(ictxt) + if (me == 0) write(0,*) 'Start htranspose ' + end if + + + call ain%mv_to(tmpc1) + call psb_glob_transpose(tmpc1, desc_a,info,atrans=tmpc2) + call ain%mv_from(tmpc2) + + if (dump) then + block + type(psb_lsspmat_type) :: aglb + write(aname,'(a,i3.3,a)') 'atran-',me,'.mtx' + call ain%print(fname=aname,head='atrans ',iv=ilv) + call psb_gather(aglb,ain,desc_a,info) + if (me==psb_root_) then + write(aname,'(a,i3.3,a)') 'atran.mtx' + call aglb%print(fname=aname,head='Test ') + end if + end block + end if + +end subroutine psb_ls_simple_glob_transpose_ip + +subroutine psb_ls_simple_glob_transpose(ain,aout,desc_a,info) + use psb_base_mod, psb_protect_name => psb_ls_simple_glob_transpose + implicit none + type(psb_lsspmat_type), intent(in) :: ain + type(psb_lsspmat_type), intent(out) :: aout + type(psb_desc_type) :: desc_a + integer(psb_ipk_), intent(out) :: info + + ! + ! BEWARE: This routine works under the assumption + ! that the same DESC_A works for both A and A^T, which + ! essentially means that A has a symmetric pattern. + ! + type(psb_ls_coo_sparse_mat) :: tmpc1, tmpc2 + integer(psb_ipk_) :: nz1, nz2, nzh, nz + integer(psb_ipk_) :: ictxt, me, np + integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz + integer(psb_lpk_), allocatable :: ilv(:) + character(len=80) :: aname + logical, parameter :: debug=.false., dump=.false., debug_sync=.false. + + ictxt = desc_a%get_context() + call psb_info(ictxt,me,np) + + nrow = desc_a%get_local_rows() + ncol = desc_a%get_local_cols() + if (debug_sync) then + call psb_barrier(ictxt) + if (me == 0) write(0,*) 'Start htranspose ' + end if + + + call ain%cp_to(tmpc1) + call psb_glob_transpose(tmpc1, desc_a,info,atrans=tmpc2) + call aout%mv_from(tmpc2) + + if (dump) then + block + type(psb_lsspmat_type) :: aglb + + write(aname,'(a,i3.3,a)') 'atran-',me,'.mtx' + call aout%print(fname=aname,head='atrans ',iv=ilv) + call psb_gather(aglb,aout,desc_a,info) + if (me==psb_root_) then + write(aname,'(a,i3.3,a)') 'atran.mtx' + call aglb%print(fname=aname,head='Test ') + end if + end block + end if + +end subroutine psb_ls_simple_glob_transpose + + diff --git a/base/tools/psb_s_par_csr_spspmm.f90 b/base/tools/psb_s_par_csr_spspmm.f90 index b998ffc65..fba99f275 100644 --- a/base/tools/psb_s_par_csr_spspmm.f90 +++ b/base/tools/psb_s_par_csr_spspmm.f90 @@ -39,7 +39,7 @@ ! C = A * B ! ! where all the matrices are stored in CSR. On input and output the matrices -! are stored with column indices in local numbering, but inermediate quantities +! are stored with column indices in local numbering, but intermediate quantities ! are in global numbering because gathering the halo of B to multiply it ! by A implies a potential enlargement of the support. ! Also, B may have a column index space different from its row index space, @@ -61,98 +61,100 @@ ! info - integer, output. ! Error code. ! -!!$Subroutine psb_s_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) -!!$ use psb_base_mod, psb_protect_name => psb_s_par_csr_spspmm -!!$ Implicit None -!!$ -!!$ type(psb_s_csr_sparse_mat),intent(in) :: acsr -!!$ type(psb_s_csr_sparse_mat),intent(inout) :: bcsr -!!$ type(psb_s_csr_sparse_mat),intent(out) :: ccsr -!!$ type(psb_desc_type),intent(in) :: desc_a -!!$ type(psb_desc_type),intent(inout) :: desc_c -!!$ integer(psb_ipk_), intent(out) :: info -!!$ integer(psb_ipk_), intent(in), optional :: data -!!$ ! ...local scalars.... -!!$ integer(psb_ipk_) :: ictxt, np,me -!!$ integer(psb_ipk_) :: ncol, nnz -!!$ type(psb_s_csr_sparse_mat) :: tcsr1 -!!$ logical :: update_desc_c -!!$ integer(psb_ipk_) :: debug_level, debug_unit, err_act -!!$ character(len=20) :: name, ch_err -!!$ -!!$ if(psb_get_errstatus() /= 0) return -!!$ info=psb_success_ -!!$ name='psb_s_p_csr_spspmm' -!!$ call psb_erractionsave(err_act) -!!$ if (psb_errstatus_fatal()) then -!!$ info = psb_err_internal_error_ ; goto 9999 -!!$ end if -!!$ debug_unit = psb_get_debug_unit() -!!$ debug_level = psb_get_debug_level() -!!$ -!!$ ictxt = desc_a%get_context() -!!$ -!!$ call psb_info(ictxt, me, np) -!!$ -!!$ if (debug_level >= psb_debug_outer_) & -!!$ & write(debug_unit,*) me,' ',trim(name),': Start' -!!$ -!!$ update_desc_c = desc_c%is_bld() -!!$ -!!$ ! -!!$ ! This is a bit tricky. -!!$ ! DESC_A is the descriptor of (the columns of) A, and therefore -!!$ ! of the rows of B; the columns of B, in the intended usage, span -!!$ ! a different space for which we have DESC_C. -!!$ ! We are gathering the halo rows of B to multiply by A; -!!$ ! now, the columns of B would ideally be kept in -!!$ ! global numbering, so that we can call this repeatedly to accumulate -!!$ ! the product of multiple operators, and convert to local numbering -!!$ ! at the last possible moment. However, this would imply calling -!!$ ! the serial SPSPMM with a matrix B with the GLOBAL number of columns -!!$ ! and this could be very expensive in memory. The solution is to keep B -!!$ ! in local numbering, so that only columns really appearing count, but to -!!$ ! expand the descriptor when gathering the halo, because by performing -!!$ ! the products we are extending the support of the operator; hence -!!$ ! this routine is intended to be called with a temporary descriptor -!!$ ! DESC_C which is in the BUILD state, to allow for such expansion -!!$ ! across multiple products. -!!$ ! The caller will at some later point finalize the descriptor DESC_C. -!!$ ! -!!$ -!!$ ncol = desc_a%get_local_cols() -!!$ call psb_sphalo(bcsr,desc_a,tcsr1,info,& -!!$ & colcnv=.true.,rowscale=.true.,outcol_glob=.true.,col_desc=desc_c,data=data) -!!$ nnz = tcsr1%get_nzeros() -!!$ if (update_desc_c) then -!!$ call desc_c%indxmap%g2lip_ins(tcsr1%ja(1:nnz),info) -!!$ else -!!$ call desc_c%indxmap%g2lip(tcsr1%ja(1:nnz),info) -!!$ end if -!!$ if (info == psb_success_) call psb_rwextd(ncol,bcsr,info,b=tcsr1) -!!$ if (info == psb_success_) call tcsr1%free() -!!$ if(info /= psb_success_) then -!!$ call psb_errpush(psb_err_internal_error_,name,a_err='Extend am3') -!!$ goto 9999 -!!$ end if -!!$ call bcsr%set_ncols(desc_c%get_local_cols()) -!!$ -!!$ -!!$ if (debug_level >= psb_debug_outer_) & -!!$ & write(debug_unit,*) me,' ',trim(name),& -!!$ & 'starting spspmm 3' -!!$ if (debug_level >= psb_debug_outer_) write(debug_unit,*) me,' ',trim(name),& -!!$ & 'starting spspmm ',acsr%get_nrows(),acsr%get_ncols(),bcsr%get_nrows(),bcsr%get_ncols() -!!$ call psb_spspmm(acsr,bcsr,ccsr,info) -!!$ -!!$ call psb_erractionrestore(err_act) -!!$ return -!!$ -!!$9999 call psb_error_handler(ictxt,err_act) -!!$ -!!$ return -!!$ -!!$End Subroutine psb_s_par_csr_spspmm +Subroutine psb_s_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) + use psb_base_mod, psb_protect_name => psb_s_par_csr_spspmm + Implicit None + + type(psb_s_csr_sparse_mat),intent(in) :: acsr + type(psb_s_csr_sparse_mat),intent(inout) :: bcsr + type(psb_s_csr_sparse_mat),intent(out) :: ccsr + type(psb_desc_type),intent(in) :: desc_a + type(psb_desc_type),intent(inout) :: desc_c + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: data + ! ...local scalars.... + integer(psb_ipk_) :: ictxt, np,me + integer(psb_ipk_) :: ncol, nnz + type(psb_ls_csr_sparse_mat) :: ltcsr + type(psb_s_csr_sparse_mat) :: tcsr + logical :: update_desc_c + integer(psb_ipk_) :: debug_level, debug_unit, err_act + character(len=20) :: name, ch_err + + if(psb_get_errstatus() /= 0) return + info=psb_success_ + name='psb_s_p_csr_spspmm' + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt = desc_a%get_context() + + call psb_info(ictxt, me, np) + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),': Start' + + update_desc_c = desc_c%is_bld() + + ! + ! This is a bit tricky. + ! DESC_A is the descriptor of (the columns of) A, and therefore + ! of the rows of B; the columns of B, in the intended usage, span + ! a different space for which we have DESC_C. + ! We are gathering the halo rows of B to multiply by A; + ! now, the columns of B would ideally be kept in + ! global numbering, so that we can call this repeatedly to accumulate + ! the product of multiple operators, and convert to local numbering + ! at the last possible moment. However, this would imply calling + ! the serial SPSPMM with a matrix B with the GLOBAL number of columns + ! and this could be very expensive in memory. The solution is to keep B + ! in local numbering, so that only columns really appearing count, but to + ! expand the descriptor when gathering the halo, because by performing + ! the products we are extending the support of the operator; hence + ! this routine is intended to be called with a temporary descriptor + ! DESC_C which is in the BUILD state, to allow for such expansion + ! across multiple products. + ! The caller will at some later point finalize the descriptor DESC_C. + ! + + ncol = desc_a%get_local_cols() + call psb_sphalo(bcsr,desc_a,ltcsr,info,& + & colcnv=.true.,rowscale=.true.,outcol_glob=.true.,col_desc=desc_c,data=data) + nnz = ltcsr%get_nzeros() + if (update_desc_c) then + call desc_c%indxmap%g2lip_ins(ltcsr%ja(1:nnz),info) + else + call desc_c%indxmap%g2lip(ltcsr%ja(1:nnz),info) + end if + call ltcsr%mv_to_ifmt(tcsr,info) + if (info == psb_success_) call psb_rwextd(ncol,bcsr,info,b=tcsr) + if (info == psb_success_) call tcsr%free() + if(info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,a_err='Extend am3') + goto 9999 + end if + call bcsr%set_ncols(desc_c%get_local_cols()) + + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),& + & 'starting spspmm 3' + if (debug_level >= psb_debug_outer_) write(debug_unit,*) me,' ',trim(name),& + & 'starting spspmm ',acsr%get_nrows(),acsr%get_ncols(),bcsr%get_nrows(),bcsr%get_ncols() + call psb_spspmm(acsr,bcsr,ccsr,info) + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(ictxt,err_act) + + return + +End Subroutine psb_s_par_csr_spspmm Subroutine psb_ls_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) use psb_base_mod, psb_protect_name => psb_ls_par_csr_spspmm diff --git a/base/tools/psb_sspasb.f90 b/base/tools/psb_sspasb.f90 index 58241a922..01187497a 100644 --- a/base/tools/psb_sspasb.f90 +++ b/base/tools/psb_sspasb.f90 @@ -122,11 +122,11 @@ subroutine psb_sspasb(a,desc_a, info, afmt, upd, dupl, mold) end if - IF (debug_level >= psb_debug_ext_) then + if (debug_level >= psb_debug_ext_) then ch_err=a%get_fmt() write(debug_unit, *) me,' ',trim(name),': From SPCNV',& & info,' ',ch_err - end IF + end if if (psb_errstatus_fatal()) then info=psb_err_from_subroutine_ diff --git a/base/tools/psb_ssphalo.F90 b/base/tools/psb_ssphalo.F90 index 1cd942f12..038e72a51 100644 --- a/base/tools/psb_ssphalo.F90 +++ b/base/tools/psb_ssphalo.F90 @@ -31,11 +31,26 @@ ! ! File: psb_ssphalo.f90 ! -! Subroutine: psb_ssphalo +! Subroutine: psb_ssphalo psb_lssphalo ! This routine does the retrieval of remote matrix rows. -! Note that retrieval is done through GTBLK, therefore it should work -! for any matrix format in A; as for the output, default is CSR. -! +! Retrieval is done through GETROW, therefore it should work +! for any matrix format in A; as for the output, default is CSR. +! +! There is also a specialized version ls_CSR whose interface +! is adapted for the needs of s_par_csr_spspmm. +! +! There are three possible exchange algorithms: +! 1. Use MPI_Alltoallv +! 2. Use psb_simple_a2av +! 3. Use psb_simple_triad_a2av +! Default choice is 3. The MPI variant has proved to be inefficient; +! that is because it is not persistent, therefore you pay the initialization price +! every time, and it is not optimized for a sparse communication pattern, +! most MPI implementations assume that all communications are non-empty. +! The PSB_SIMPLE variants reuse the same communicator, and go for a simplistic +! sequence of sends/receive that is quite efficient for a sparse communication +! pattern. To be refined/reviewed in the future to compare with neighbour +! persistent collectives. ! ! Arguments: ! a - type(psb_sspmat_type) The local part of input matrix A @@ -55,9 +70,6 @@ ! psb_comm_ext_ use ext_index ! psb_comm_ovrl_ DISABLED for this routine. ! -#undef SP_A2AV_MPI -#undef SP_A2AV_XI -#define SP_A2AV_MAT Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,& & rowscale,colscale,outfmt,data) use psb_base_mod, psb_protect_name => psb_ssphalo @@ -314,16 +326,36 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,& call psb_errpush(info,name,a_err=ch_err); goto 9999 end if - - call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_spk_,& - & acoo%val,rvsz,brvindx,psb_mpi_r_spk_,icomm,minfo) - call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & acoo%val,iarcv,jarcv,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& + & acoo%val,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& + & iarcv,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& + & jarcv,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_mpi_) + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_spk_,& + & acoo%val,rvsz,brvindx,psb_mpi_r_spk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& & iarcv,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & jarcv,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & jarcv,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select + if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='mpi_alltoallv' + ch_err='alltoallv' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if @@ -390,16 +422,36 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,& goto 9999 end if + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& + & acoo%val,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& + & acoo%ia,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& + & acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_mpi_) + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_spk_,& + & acoo%val,rvsz,brvindx,psb_mpi_r_spk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select - call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_spk_,& - & acoo%val,rvsz,brvindx,psb_mpi_r_spk_,icomm,minfo) - call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_ipk_,& - & acoo%ia,rvsz,brvindx,psb_mpi_ipk_,icomm,minfo) - call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_ipk_,& - & acoo%ja,rvsz,brvindx,psb_mpi_ipk_,icomm,minfo) if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='mpi_alltoallv' + ch_err='alltoallv' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if @@ -506,8 +558,7 @@ Subroutine psb_lssphalo(a,desc_a,blk,info,rowcnv,colcnv,& integer(psb_ipk_), intent(in), optional :: data ! ...local scalars.... integer(psb_ipk_) :: ictxt, np,me - integer(psb_ipk_) :: counter, proc, i, & - & n_el_send,n_el_recv,& + integer(psb_ipk_) :: counter, proc, i, n_el_send,n_el_recv, & & n_elem, j, ipx,mat_recv, idxs,idxr,nz,& & data_,totxch,nxs, nxr, ncg integer(psb_lpk_) :: r, k, irmin, irmax, icmin, icmax, iszs, iszr, & @@ -718,16 +769,37 @@ Subroutine psb_lssphalo(a,desc_a,blk,info,rowcnv,colcnv,& goto 9999 end if + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& + & acoo%val,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& + & acoo%ia,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& + & acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_mpi_) + + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_spk_,& + & acoo%val,rvsz,brvindx,psb_mpi_r_spk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select - call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_spk_,& - & acoo%val,rvsz,brvindx,psb_mpi_r_spk_,icomm,minfo) - call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) if (info /= psb_success_) then info=psb_err_from_subroutine_ - call psb_errpush(info,name,a_err='mpi_alltoallv') + call psb_errpush(info,name,a_err='alltoallv') goto 9999 end if @@ -829,12 +901,11 @@ Subroutine psb_ls_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& type(psb_desc_type),Intent(in), optional, target :: col_desc ! ...local scalars.... integer(psb_ipk_) :: ictxt, np,me - integer(psb_ipk_) :: counter,proc,i, & - & n_el_send,k,n_el_recv,r,& - & n_elem, j, ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& - & irmin,icmin,data_,totxch,nxs, nxr,& - & err_act, nsnds, nrcvs - integer(psb_lpk_) :: ngtz,irmax,icmax,l1, lnr, lnc, lnnz, ncg, jpx, idx, tot_elem + integer(psb_ipk_) :: counter,proc,i, n_el_send,n_el_recv,& + & n_elem, j,ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& + & data_,totxch,nxs, nxr, err_act, nsnds, nrcvs + integer(psb_lpk_) :: ngtz,irmax,icmax,irmin,icmin,l1, lnr, lnc, lnnz, & + & r, k, ncg, jpx, idx, tot_elem integer(psb_mpk_) :: icomm, minfo integer(psb_mpk_), allocatable :: brvindx(:), & & rvsz(:), bsdindx(:),sdsz(:) @@ -1054,32 +1125,36 @@ Subroutine psb_ls_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& goto 9999 end if -#if defined(SP_A2AV_MPI) - call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_spk_,& - & acoo%val,rvsz,brvindx,psb_mpi_r_spk_,icomm,minfo) - if (minfo == mpi_success) & - & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo == mpi_success) & - & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo /= mpi_success) info = minfo -#elif defined(SP_A2AV_XI) - call ls_my_a2av(valsnd,sdsz,bsdindx,& + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& & acoo%val,rvsz,brvindx,ictxt,info) - if (info == psb_success_) call i_my_a2av(iasnd,sdsz,bsdindx,& + if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& & acoo%ia,rvsz,brvindx,ictxt,info) - if (info == psb_success_) call i_my_a2av(jasnd,sdsz,bsdindx,& + if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& & acoo%ja,rvsz,brvindx,ictxt,info) -#elif defined(SP_A2AV_MAT) - call ls_coo_my_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ipdxv,ictxt,icomm,info) -#else - choke on me @! -#endif + case(psb_sp_a2av_mpi_) + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_spk_,& + & acoo%val,rvsz,brvindx,psb_mpi_r_spk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select + if (info /= psb_success_) then info=psb_err_from_subroutine_ - call psb_errpush(info,name,a_err='mpi_alltoallv') + call psb_errpush(info,name,a_err='alltoallv') goto 9999 end if @@ -1163,185 +1238,376 @@ Subroutine psb_ls_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& return -#if defined(SP_A2AV_XI) || defined(SP_A2AV_MAT) -contains +End Subroutine psb_ls_csr_halo -#if defined(SP_A2AV_MAT) - subroutine ls_coo_my_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & valrcv,iarcv,jarcv,rvsz,brvindx,ipdxv,ictxt,icomm,info) +Subroutine psb_s_ls_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& + & rowscale,colscale,data,outcol_glob,col_desc) + use psb_base_mod, psb_protect_name => psb_s_ls_csr_halo #ifdef MPI_MOD - use mpi + use mpi #endif - Implicit None + Implicit None #ifdef MPI_H - include 'mpif.h' + include 'mpif.h' #endif - real(psb_spk_), intent(in) :: valsnd(:) - integer(psb_ipk_), intent(in) :: ipdxv(:) - integer(psb_lpk_), intent(in) :: iasnd(:), jasnd(:) - real(psb_spk_), intent(out) :: valrcv(:) - integer(psb_lpk_), intent(out) :: iarcv(:), jarcv(:) - integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_mpk_), intent(in) :: icomm - integer(psb_ipk_), intent(out) :: info - !Local variables - integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz, counter - integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret - integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) - call psb_info(ictxt,iam,np) - if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz))= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),': Start' + + if (present(rowcnv)) then + rowcnv_ = rowcnv + else + rowcnv_ = .true. + endif + if (present(colcnv)) then + colcnv_ = colcnv + else + colcnv_ = .true. + endif + if (present(rowscale)) then + rowscale_ = rowscale + else + rowscale_ = .false. + endif + if (present(colscale)) then + colscale_ = colscale + else + colscale_ = .false. + endif + if (present(data)) then + data_ = data + else + data_ = psb_comm_halo_ + endif + if (present(outcol_glob)) then + outcol_glob_ = outcol_glob + else + outcol_glob_ = .false. + endif + if (present(col_desc)) then + col_desc_ => col_desc + else + col_desc_ => desc_a + end if + + Allocate(brvindx(np+1),& + & rvsz(np),sdsz(np),bsdindx(np+1), acoo,stat=info) + + if (info /= psb_success_) then + info=psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + end if + + If (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Data selector',data_ + select case(data_) + case(psb_comm_halo_,psb_comm_ext_ ) + ! Do not accept OVRLAP_INDEX any longer. + case default + call psb_errpush(psb_err_from_subroutine_,name,a_err='wrong Data selector') + goto 9999 + end select - counter=1 - Do - ip=ipdxv(counter) - if (ip == -1) exit - n_el_recv = ipdxv(counter+psb_n_elem_recv_) - counter = counter+n_el_recv - n_el_send = ipdxv(counter+psb_n_elem_send_) - prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) - sz = rvsz(ip+1) - if (sz > 0) then - idx = brvindx(ip+1) - p2ptag = psb_real_swap_tag - call mpi_irecv(valrcv(idx+1:idx+sz),sz,& - & psb_mpi_r_spk_,prcid(ip+1),& - & p2ptag, icomm,rvhd(ip+1,1),iret) - p2ptag = psb_int_swap_tag - call mpi_irecv(iarcv(idx+1:idx+sz),sz,& - & psb_mpi_lpk_,prcid(ip+1),& - & p2ptag, icomm,rvhd(ip+1,2),iret) - call mpi_irecv(jarcv(idx+1:idx+sz),sz,& - & psb_mpi_lpk_,prcid(ip+1),& - & p2ptag, icomm,rvhd(ip+1,3),iret) - end if - counter = counter+n_el_send+3 + sdsz(:)=0 + rvsz(:)=0 + l1 = 0 + brvindx(1) = 0 + bsdindx(1) = 0 + counter=1 + idx = 0 + idxs = 0 + idxr = 0 + + call desc_a%get_list(data_,pdxv,totxch,nxr,nxs,info) + ipdxv = pdxv%get_vect() + ! For all rows in the halo descriptor, extract the row size + lnr = 0 + Do + proc=ipdxv(counter) + if (proc == -1) exit + n_el_recv = ipdxv(counter+psb_n_elem_recv_) + counter = counter+n_el_recv + n_el_send = ipdxv(counter+psb_n_elem_send_) + tot_elem = 0 + Do j=0,n_el_send-1 + idx = ipdxv(counter+psb_elem_send_+j) + n_elem = a%get_nz_row(idx) + tot_elem = tot_elem+n_elem Enddo + sdsz(proc+1) = tot_elem + lnr = lnr + n_el_recv + counter = counter+n_el_send+3 + Enddo + ! + ! Exchange row sizes, so as to know sends/receives. + ! This is different from the halo exchange because the + ! size of the rows may vary, as opposed to fixed + ! (multi) vector row size. + ! + call mpi_alltoall(sdsz,1,psb_mpi_mpk_,& + & rvsz,1,psb_mpi_mpk_,icomm,minfo) + + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='mpi_alltoall') + goto 9999 + end if + nsnds = count(sdsz /= 0) + nrcvs = count(rvsz /= 0) + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Done initial alltoall',nsnds,nrcvs - counter=1 - Do - ip=ipdxv(counter) - if (ip == -1) exit - n_el_recv = ipdxv(counter+psb_n_elem_recv_) - counter = counter+n_el_recv - n_el_send = ipdxv(counter+psb_n_elem_send_) - if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) - sz = sdsz(ip+1) - if (sz > 0) then - idx = bsdindx(ip+1) - p2ptag = psb_real_swap_tag - call mpi_send(valsnd(idx+1:idx+sz),sz,& - & psb_mpi_r_spk_,prcid(ip+1),& - & p2ptag, icomm,iret) - p2ptag = psb_int_swap_tag - call mpi_send(iasnd(idx+1:idx+sz),sz,& - & psb_mpi_lpk_,prcid(ip+1),& - & p2ptag, icomm,iret) - call mpi_send(jasnd(idx+1:idx+sz),sz,& - & psb_mpi_lpk_,prcid(ip+1),& - & p2ptag, icomm,iret) + idxs = 0 + idxr = 0 + counter = 1 + Do + proc=ipdxv(counter) + if (proc == -1) exit + n_el_recv = ipdxv(counter+psb_n_elem_recv_) + counter = counter+n_el_recv + n_el_send = ipdxv(counter+psb_n_elem_send_) + + bsdindx(proc+1) = idxs + idxs = idxs + sdsz(proc+1) + brvindx(proc+1) = idxr + idxr = idxr + rvsz(proc+1) + counter = counter+n_el_send+3 + Enddo + + iszr = sum(rvsz) + mat_recv = iszr + iszs = sum(sdsz) + + lnnz = max(iszr,iszs,ione) + lnc = a%get_ncols() + call acoo%allocate(lnr,lnc,lnnz) + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Sizes:',acoo%get_size(),& + & ' Send:',sdsz(:),' Receive:',rvsz(:) + + call psb_ensure_size(max(iszs,1),iasnd,info) + if (info == psb_success_) call psb_ensure_size(max(iszs,1),jasnd,info) + if (info == psb_success_) call psb_ensure_size(max(iszs,1),liasnd,info) + if (info == psb_success_) call psb_ensure_size(max(iszs,1),ljasnd,info) + if (info == psb_success_) call psb_ensure_size(max(iszs,1),valsnd,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='ensure_size') + goto 9999 + end if + + l1 = 0 + ipx = 1 + counter=1 + idx = 0 + ! + ! Make sure to get all columns in csget. + ! This is necessary when sphalo is used to compute a transpose, + ! as opposed to just gathering halo for spspmm purposes. + ! + ncg = huge(ncg) + tot_elem = 0 + Do + proc = ipdxv(counter) + if (proc == -1) exit + n_el_recv = ipdxv(counter+psb_n_elem_recv_) + counter = counter+n_el_recv + n_el_send = ipdxv(counter+psb_n_elem_send_) + + Do j=0,n_el_send-1 + idx = ipdxv(counter+psb_elem_send_+j) + n_elem = a%get_nz_row(idx) + call a%csget(idx,idx,ngtz,iasnd,jasnd,valsnd,info,& + & append=.true.,nzin=tot_elem,jmax=ncg) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_sp_getrow') + goto 9999 end if - counter = counter+n_el_send+3 + tot_elem = tot_elem+ngtz Enddo + counter = counter+n_el_send+3 + Enddo + nz = tot_elem - counter=1 - Do - ip=ipdxv(counter) - if (ip == -1) exit - n_el_recv = ipdxv(counter+psb_n_elem_recv_) - counter = counter+n_el_recv - n_el_send = ipdxv(counter+psb_n_elem_send_) - sz = rvsz(ip+1) - if (sz > 0) then - call mpi_wait(rvhd(ip+1,1),p2pstat,iret) - call mpi_wait(rvhd(ip+1,2),p2pstat,iret) - call mpi_wait(rvhd(ip+1,3),p2pstat,iret) - end if - counter = counter+n_el_send+3 - Enddo + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Going for alltoallv',iszs,iszr + if (rowcnv_) then + call psb_loc_to_glob(iasnd(1:nz),liasnd(1:nz),desc_a,info,iact='I') + else + liasnd(1:nz) = iasnd(1:nz) + end if + if (colcnv_) then + call psb_loc_to_glob(jasnd(1:nz),ljasnd(1:nz),col_desc_,info,iact='I') + else + ljasnd(1:nz) = jasnd(1:nz) + end if + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_loc_to_glob') + goto 9999 + end if + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,liasnd,ljasnd,sdsz,bsdindx,& + & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& + & acoo%val,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(liasnd,sdsz,bsdindx,& + & acoo%ia,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(ljasnd,sdsz,bsdindx,& + & acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_mpi_) + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_spk_,& + & acoo%val,rvsz,brvindx,psb_mpi_r_spk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(liasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(ljasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select - end subroutine ls_coo_my_a2av -#endif -#if defined(SP_A2AV_XI) - subroutine ls_my_a2av(valsnd,sdsz,bsdindx,& - & valrcv,rvsz,brvindx,ictxt,info) - real(psb_spk_), intent(in) :: valsnd(:) - real(psb_spk_), intent(out) :: valrcv(:) - integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_ipk_), intent(out) :: info + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='alltoallv') + goto 9999 + end if + + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Done alltoallv' + ! + ! Convert into local numbering + ! + if (rowcnv_) call psb_glob_to_loc(acoo%ia(1:iszr),desc_a,info,iact='I') + ! + ! This seems to be the correct output condition + ! + if (colcnv_.and.(.not.outcol_glob_)) & + & call psb_glob_to_loc(acoo%ja(1:iszr),col_desc_,info,iact='I') - integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psbglob_to_loc') + goto 9999 + end if - call psb_info(ictxt,iam,np) - if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz))0).and.(k>0)) Then + l1=l1+1 + acoo%val(l1) = acoo%val(i) + acoo%ia(l1) = r + acoo%ja(l1) = k + irmin = min(irmin,r) + irmax = max(irmax,r) + icmin = min(icmin,k) + icmax = max(icmax,k) + End If + Enddo + if (rowscale_) then + call acoo%set_nrows(max(irmax-irmin+1,0)) + acoo%ia(1:l1) = acoo%ia(1:l1) - irmin + 1 + else + call acoo%set_nrows(irmax) + end if + if (colscale_) then + call acoo%set_ncols(max(icmax-icmin+1,0)) + acoo%ja(1:l1) = acoo%ja(1:l1) - icmin + 1 + else + call acoo%set_ncols(icmax) + end if - do ip = 0, np-1 - sz = sdsz(ip+1) - if (sz > 0) then - idx = bsdindx(ip+1) - call psb_snd(ictxt,valsnd(idx+1:idx+sz),ip) - end if - end do + call acoo%set_nzeros(l1) + call acoo%set_sorted(.false.) - do ip = 0, np-1 - sz = rvsz(ip+1) - if (sz > 0) then - idx = brvindx(ip+1) - call psb_rcv(ictxt,valrcv(idx+1:idx+sz),ip) - end if - end do - - end subroutine ls_my_a2av + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),& + & ': End data exchange',counter,l1 - subroutine i_my_a2av(valsnd,sdsz,bsdindx,& - & valrcv,rvsz,brvindx,ictxt,info) - integer(psb_ipk_), intent(in) :: valsnd(:) - integer(psb_ipk_), intent(out) :: valrcv(:) - integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_ipk_), intent(out) :: info - + call acoo%fix(info) + if (info == psb_success_) call acoo%mv_to_fmt(blk,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_spcnv') + goto 9999 + end if - integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz + Deallocate(brvindx,bsdindx,rvsz,sdsz,& + & iasnd,jasnd,valsnd,stat=info) + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Done' - call psb_info(ictxt,iam,np) - if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then - idx = bsdindx(ip+1) - call psb_snd(ictxt,valsnd(idx+1:idx+sz),ip) - end if - end do +9999 call psb_error_handler(ictxt,err_act) - do ip = 0, np-1 - sz = rvsz(ip+1) - if (sz > 0) then - idx = brvindx(ip+1) - call psb_rcv(ictxt,valrcv(idx+1:idx+sz),ip) - end if - end do - - end subroutine i_my_a2av -#endif -#endif -End Subroutine psb_ls_csr_halo + return + +End Subroutine psb_s_ls_csr_halo diff --git a/base/tools/psb_sspins.f90 b/base/tools/psb_sspins.F90 similarity index 99% rename from base/tools/psb_sspins.f90 rename to base/tools/psb_sspins.F90 index e1cea6198..7a86e5594 100644 --- a/base/tools/psb_sspins.f90 +++ b/base/tools/psb_sspins.F90 @@ -288,6 +288,7 @@ subroutine psb_sspins_csr_lirp(nr,irp,ja,val,irw,a,desc_a,info,rebuild,local) end subroutine psb_sspins_csr_lirp +#if defined(IPK4) && defined(LPK8) subroutine psb_sspins_csr_iirp(nr,irw,irp,ja,val,a,desc_a,info,rebuild,local) use psb_base_mod, psb_protect_name => psb_sspins_csr_iirp use psi_mod @@ -384,6 +385,7 @@ subroutine psb_sspins_csr_iirp(nr,irw,irp,ja,val,a,desc_a,info,rebuild,local) return end subroutine psb_sspins_csr_iirp +#endif subroutine psb_sspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) use psb_base_mod, psb_protect_name => psb_sspins_2desc diff --git a/base/tools/psb_z_glob_transpose.F90 b/base/tools/psb_z_glob_transpose.F90 new file mode 100644 index 000000000..64cf534b5 --- /dev/null +++ b/base/tools/psb_z_glob_transpose.F90 @@ -0,0 +1,902 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! 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: psb_z_glob_transpose.f90 +! +! Subroutine: psb_z_glob_transpose +! Version: complex +! +! This file provides multiple related versions of a parallel +! global transpose +! +! B = A^T +! +! There are some variations of this routine, that are accounted for +! in the workhorse psb_lz_coo_glob_transpose +! 1. The row and column spaces can share the same descriptor +! This essentially means that the descriptor relates to a +! matrix with a symmetric pattern. Examples are: symmetric +! matrices, matrices with symmetric pattern, lower or +! upper halves of such matrices +! 2. The row and column index spaces are different +! In this case you need to have two descriptor on input, +! plus if you want the output to be distributed according +! to the row descriptor, you will still need a new descriptor +! because even if the row distribution is the same, the pattern +! will be different. +! +! This is handled in the workhorse by having one mandatory and +! two optional descriptors: +! 1. If only the mandatory descriptor is present, then it is assumed that it +! is both row and column descriptor, and that it is sufficient. +! 2. If two descriptors are available, then use the second +! 3. If the third output descriptor is available, then rebuild it +! after the data exchange. +! +! The main transpose algorithm works like this: +! 1. Compute sizes: any entry A(I,J) with J in the halo will have +! to be sent to the process owning J, so walk through the +! matrix and compute all the send sizes, then do an alltoall to figure +! the receive sizes; +! 2. Adjust send bufffers; +! 3. Perform a local transpose; +! 4. Split the matrix: all local entries stay, all halo entries go into +! the send buffers, and are converted to global numbering; +! 5. Do the all-to-all (see below for a discussion of the alternative +! communication strategies) +! 6. The receive is in the extra section of the ACOO buffer; convert +! the row indices to local numbering, and discard extra ones (there will +! be some) +! 7. If desc_rx was requested, make sure to insert the (new) column indices +! 8. Cleanup and sort the output matrix +! 9. Copy back into AIN or ATRANS if requested. +! +! There are three possible exchange algorithms: +! 1. Use MPI_Alltoallv +! 2. Use psb_simple_a2av +! 3. Use psb_simple_triad_a2av +! Default choice is 3. The MPI variant has proved to be inefficient; +! that is because it is not persistent, therefore you pay the initialization price +! every time, and it is not optimized for a sparse communication pattern, +! most MPI implementations assume that all communications are non-empty. +! The PSB_SIMPLE variants reuse the same communicator, and go for a simplistic +! sequence of sends/receive that is quite efficient for a sparse communication +! pattern. To be refined/reviewed in the future to compare with neighbour +! persistent collectives. +! +! +subroutine psb_lz_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) +#ifdef MPI_MOD + use mpi +#endif + use psb_base_mod, psb_protect_name => psb_lz_coo_glob_transpose + Implicit None +#ifdef MPI_H + include 'mpif.h' +#endif + type(psb_lz_coo_sparse_mat), intent(inout) :: ain + type(psb_desc_type), intent(inout), target :: desc_r + type(psb_lz_coo_sparse_mat), intent(out), optional :: atrans + type(psb_desc_type), intent(inout), target, optional :: desc_c + type(psb_desc_type), intent(out), optional :: desc_rx + integer(psb_ipk_), intent(out) :: info + + ! ...local scalars.... + integer(psb_ipk_) :: ictxt, np,me + integer(psb_ipk_) :: counter,proc, err_act, j + integer(psb_lpk_) :: i, k, idx, r, ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& + & l1, nsnds, nrcvs, nr,nc,nzl, hlstart, nzt, nzd + integer(psb_mpk_) :: icomm, minfo + integer(psb_mpk_), allocatable :: brvindx(:), & + & rvsz(:), bsdindx(:), sdsz(:), tsdx(:), trvx(:) + integer(psb_ipk_), allocatable :: halo_owner(:) + integer(psb_lpk_), allocatable :: iasnd(:), jasnd(:) + complex(psb_dpk_), allocatable :: valsnd(:) + type(psb_lz_coo_sparse_mat), allocatable :: acoo + logical :: rowcnv_,colcnv_,rowscale_,colscale_,outcol_glob_ + type(psb_desc_type), pointer :: p_desc_c + character(len=5) :: outfmt_ + integer(psb_ipk_) :: debug_level, debug_unit + character(len=20) :: name, ch_err + + if(psb_get_errstatus() /= 0) return + info=psb_success_ + name='mld_glob_transpose' + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt = desc_r%get_context() + icomm = desc_r%get_mpic() + + Call psb_info(ictxt, me, np) + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),': Start' + + if (present(desc_c)) then + p_desc_c => desc_c + else + p_desc_c => desc_r + end if + + Allocate(brvindx(np+1),& + & rvsz(np),sdsz(np),bsdindx(np+1), acoo,stat=info) + + if (info /= psb_success_) then + info=psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + end if + + + sdsz(:)=0 + rvsz(:)=0 + l1 = 0 + brvindx(1) = 0 + bsdindx(1) = 0 + counter=1 + idx = 0 + idxs = 0 + idxr = 0 + + if (present(atrans)) then + call ain%cp_to_coo(acoo,info) + else + call ain%mv_to_coo(acoo,info) + end if + + + ! + ! Compute number of entries in the + ! halo part, sorted by destination process + ! + nr = desc_r%get_local_rows() + nc = p_desc_c%get_local_cols() + nzl = acoo%get_nzeros() + hlstart = p_desc_c%get_local_rows() + do k=1, nzl + j = acoo%ja(k) + if (j > hlstart) then + call p_desc_c%indxmap%fnd_halo_owner(j,proc,info) + sdsz(proc+1) = sdsz(proc+1) +1 + end if + end do + + ! + ! Exchange sizes, so as to know sends/receives. + ! This is different from the halo exchange because the + ! number of entries was not precomputed in the descriptor, + ! which was vector-oriented and not matrix-entry-oriented + ! + call mpi_alltoall(sdsz,1,psb_mpi_mpk_,& + & rvsz,1,psb_mpi_mpk_,icomm,minfo) + + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='mpi_alltoall') + goto 9999 + end if + nsnds = count(sdsz /= 0) + nrcvs = count(rvsz /= 0) + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Done initial alltoall',nsnds,nrcvs + + idxs = 0 + idxr = 0 + counter = 1 + Do proc = 0, np-1 + bsdindx(proc+1) = idxs + idxs = idxs + sdsz(proc+1) + brvindx(proc+1) = idxr + idxr = idxr + rvsz(proc+1) + Enddo + + tsdx = bsdindx + trvx = brvindx + + iszr = sum(rvsz) + iszs = sum(sdsz) + + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Sizes:',& + & ' Send:',sdsz(:),' Receive:',rvsz(:) + + call psb_ensure_size(max(iszs,1),iasnd,info) + if (info == psb_success_) call psb_ensure_size(max(iszs,1),jasnd,info) + if (info == psb_success_) call psb_ensure_size(max(iszs,1),valsnd,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='ensure_size') + goto 9999 + end if + + ! + ! Now, transpose the matrix, then split between itself + ! and the send buffers + ! + call acoo%transp() + if (acoo%get_nzeros()/= nzl) then + write(0,*) me,'Something strange upon transpose: ',nzl,acoo%get_nzeros() + end if + nzl = acoo%get_nzeros() + hlstart = p_desc_c%get_local_rows() + + + nzd = 0 + do k = 1, nzl + j = acoo%ia(k) + if (j<=hlstart) then + nzd = nzd + 1 + acoo%ia(nzd) = acoo%ia(k) + acoo%ja(nzd) = acoo%ja(k) + acoo%val(nzd) = acoo%val(k) + else + call p_desc_c%indxmap%fnd_halo_owner(j,proc,info) + tsdx(proc+1) = tsdx(proc+1) +1 + iasnd(tsdx(proc+1)) = acoo%ia(k) + jasnd(tsdx(proc+1)) = acoo%ja(k) + valsnd(tsdx(proc+1)) = acoo%val(k) + end if + end do + call acoo%set_nzeros(nzd) + ! + ! Put halo entries in global numbering + ! + call desc_r%indxmap%l2gip(jasnd(1:iszs),info) + call p_desc_c%indxmap%l2gip(iasnd(1:iszs),info) + ! And exchange data. + ! Normally we'll use our SIMPLE A2AV and not MPI, because + ! the communication pattern is sparse, so ours is more + ! efficient. Using ACOO for the receive buffers. + nzl = acoo%get_nzeros() + call acoo%ensure_size(nzl+iszr) + + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & acoo%val(nzl+1:nzl+iszr),acoo%ia(nzl+1:nzl+iszr),& + & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& + & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& + & acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& + & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_mpi_) + + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_dpk_,& + & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_c_dpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select + + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='alltoallv') + goto 9999 + end if + + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Done alltoallv' + + if (present(desc_rx)) then + ! + ! Extend the appropriate descriptor; started as R but on + ! transpose it now describes C + ! + call desc_r%clone(desc_rx,info) + call psb_cd_reinit(desc_rx,info) + ! + ! Take out non-local rows + ! + call psb_glob_to_loc(acoo%ia(nzl+1:nzl+iszr),p_desc_c,info,iact='I',owned=.true.) + call psb_coo_clean_negidx_inner(iszr,acoo%ia(nzl+1:nzl+iszr),acoo%ja(nzl+1:nzl+iszr),& + & acoo%val(nzl+1:nzl+iszr),nzt,info) + call desc_rx%g2lip_ins(acoo%ja(nzl+1:nzl+nzt),info) + call psb_cdasb(desc_rx,info) + nzl = nzl + nzt + call acoo%set_nzeros(nzl) + nzl = acoo%get_nzeros() + call acoo%set_sorted(.false.) + ! + ! Insert to extend descriptor + ! + call acoo%set_nrows(p_desc_c%get_local_rows()) + call acoo%set_ncols(desc_rx%get_local_cols()) + !write(0,*) me,' Trans RX ',acoo%get_nrows(),acoo%get_ncols(),acoo%get_nzeros() + else + ! + ! + ! Take out non-local rows + ! + call psb_glob_to_loc(acoo%ia(nzl+1:nzl+iszr),p_desc_c,info,iact='I',owned=.true.) + call psb_glob_to_loc(acoo%ja(nzl+1:nzl+iszr),desc_r,info,iact='I') + call psb_coo_clean_negidx_inner(iszr,acoo%ia(nzl+1:nzl+iszr),acoo%ja(nzl+1:nzl+iszr),& + & acoo%val(nzl+1:nzl+iszr),nzt,info) + + nzl = nzl + nzt + call acoo%set_nzeros(nzl) + nzl = acoo%get_nzeros() + call acoo%set_sorted(.false.) + + call acoo%set_nrows(p_desc_c%get_local_rows()) + call acoo%set_ncols(desc_r%get_local_cols()) + !write(0,*) me,' Trans R- ',acoo%get_nrows(),acoo%get_ncols(),acoo%get_nzeros() + end if + +!!$ write(0,*) me,' Sanity check after rx%g2l :',count(acoo%ja(1:nzl)<0) + + + call acoo%fix(info) + nzl = acoo%get_nzeros() + + if (present(atrans)) then + call atrans%mv_from_coo(acoo,info) + else + call ain%mv_from_coo(acoo,info) + end if + Deallocate(brvindx,bsdindx,rvsz,sdsz,& + & iasnd,jasnd,valsnd,stat=info) + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Done' + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(ictxt,err_act) + + return +end subroutine psb_lz_coo_glob_transpose + +subroutine psb_z_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) +#ifdef MPI_MOD + use mpi +#endif + use psb_base_mod, psb_protect_name => psb_z_coo_glob_transpose + Implicit None +#ifdef MPI_H + include 'mpif.h' +#endif + type(psb_z_coo_sparse_mat), intent(inout) :: ain + type(psb_desc_type), intent(inout), target :: desc_r + type(psb_z_coo_sparse_mat), intent(out), optional :: atrans + type(psb_desc_type), intent(inout), target, optional :: desc_c + type(psb_desc_type), intent(out), optional :: desc_rx + integer(psb_ipk_), intent(out) :: info + + integer(psb_ipk_) :: ictxt, np,me + integer(psb_ipk_) :: counter,proc, err_act, j + integer(psb_ipk_) :: i, k, idx, r, ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& + & l1, nsnds, nrcvs, nr,nc,nzl, hlstart, nzd + integer(psb_lpk_) :: nzt, lszr + integer(psb_mpk_) :: icomm, minfo + integer(psb_mpk_), allocatable :: brvindx(:), & + & rvsz(:), bsdindx(:), sdsz(:), tsdx(:), trvx(:) + integer(psb_ipk_), allocatable :: halo_owner(:) + integer(psb_lpk_), allocatable :: iasnd(:), jasnd(:),iarcv(:),jarcv(:) + complex(psb_dpk_), allocatable :: valsnd(:) + type(psb_z_coo_sparse_mat), allocatable :: acoo + logical :: rowcnv_,colcnv_,rowscale_,colscale_,outcol_glob_ + type(psb_desc_type), pointer :: p_desc_c + character(len=5) :: outfmt_ + integer(psb_ipk_) :: debug_level, debug_unit + character(len=20) :: name, ch_err + + if(psb_get_errstatus() /= 0) return + info=psb_success_ + name='mld_glob_transpose' + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt = desc_r%get_context() + icomm = desc_r%get_mpic() + + Call psb_info(ictxt, me, np) + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),': Start' + + if (present(desc_c)) then + p_desc_c => desc_c + else + p_desc_c => desc_r + end if + + Allocate(brvindx(np+1),& + & rvsz(np),sdsz(np),bsdindx(np+1), acoo,stat=info) + + if (info /= psb_success_) then + info=psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + end if + + + sdsz(:)=0 + rvsz(:)=0 + l1 = 0 + brvindx(1) = 0 + bsdindx(1) = 0 + counter=1 + idx = 0 + idxs = 0 + idxr = 0 + + if (present(atrans)) then + call ain%cp_to_coo(acoo,info) + else + call ain%mv_to_coo(acoo,info) + end if + + + ! + ! Compute number of entries in the + ! halo part, sorted by destination process + ! + nr = desc_r%get_local_rows() + nc = p_desc_c%get_local_cols() + nzl = acoo%get_nzeros() + hlstart = p_desc_c%get_local_rows() + do k=1, nzl + j = acoo%ja(k) + if (j > hlstart) then + call p_desc_c%indxmap%fnd_halo_owner(j,proc,info) + sdsz(proc+1) = sdsz(proc+1) +1 + end if + end do + + ! + ! Exchange sizes, so as to know sends/receives. + ! This is different from the halo exchange because the + ! number of entries was not precomputed in the descriptor, + ! which was vector-oriented and not matrix-entry-oriented + ! + call mpi_alltoall(sdsz,1,psb_mpi_mpk_,& + & rvsz,1,psb_mpi_mpk_,icomm,minfo) + + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='mpi_alltoall') + goto 9999 + end if + nsnds = count(sdsz /= 0) + nrcvs = count(rvsz /= 0) + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Done initial alltoall',nsnds,nrcvs + + idxs = 0 + idxr = 0 + counter = 1 + Do proc = 0, np-1 + bsdindx(proc+1) = idxs + idxs = idxs + sdsz(proc+1) + brvindx(proc+1) = idxr + idxr = idxr + rvsz(proc+1) + Enddo + + tsdx = bsdindx + trvx = brvindx + + iszr = sum(rvsz) + iszs = sum(sdsz) + + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Sizes:',& + & ' Send:',sdsz(:),' Receive:',rvsz(:) + + call psb_ensure_size(max(iszs,1),iasnd,info) + if (info == psb_success_) call psb_ensure_size(max(iszs,1),jasnd,info) + if (info == psb_success_) call psb_ensure_size(max(iszs,1),valsnd,info) + if (info == psb_success_) call psb_ensure_size(max(iszr,1),iarcv,info) + if (info == psb_success_) call psb_ensure_size(max(iszr,1),jarcv,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='ensure_size') + goto 9999 + end if + + ! + ! Now, transpose the matrix, then split between itself + ! and the send buffers + ! + call acoo%transp() + if (acoo%get_nzeros()/= nzl) then + write(0,*) me,'Something strange upon transpose: ',nzl,acoo%get_nzeros() + end if + nzl = acoo%get_nzeros() + hlstart = p_desc_c%get_local_rows() + + + nzd = 0 + do k = 1, nzl + j = acoo%ia(k) + if (j<=hlstart) then + nzd = nzd + 1 + acoo%ia(nzd) = acoo%ia(k) + acoo%ja(nzd) = acoo%ja(k) + acoo%val(nzd) = acoo%val(k) + else + call p_desc_c%indxmap%fnd_halo_owner(j,proc,info) + tsdx(proc+1) = tsdx(proc+1) +1 + iasnd(tsdx(proc+1)) = acoo%ia(k) + jasnd(tsdx(proc+1)) = acoo%ja(k) + valsnd(tsdx(proc+1)) = acoo%val(k) + end if + end do + call acoo%set_nzeros(nzd) + ! + ! Put halo entries in global numbering + ! + call desc_r%indxmap%l2gip(jasnd(1:iszs),info) + call p_desc_c%indxmap%l2gip(iasnd(1:iszs),info) + ! And exchange data. + ! Normally we'll use our SIMPLE A2AV and not MPI, because + ! the communication pattern is sparse, so ours is more + ! efficient. Using ACOO for the receive buffers. + nzl = acoo%get_nzeros() + call acoo%ensure_size(nzl+iszr) + + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & acoo%val(nzl+1:nzl+iszr),iarcv(1:iszr),& + & jarcv(1:iszr),rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& + & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& + & iarcv(1:iszr),rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& + & jarcv(1:iszr),rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_mpi_) + + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_dpk_,& + & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,psb_mpi_c_dpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & iarcv(1:iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & jarcv(1:iszr),rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select + + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='alltoallv') + goto 9999 + end if + + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Done alltoallv' + + if (present(desc_rx)) then + ! + ! Extend the appropriate descriptor; started as R but on + ! transpose it now describes C + ! + call desc_r%clone(desc_rx,info) + call psb_cd_reinit(desc_rx,info) + ! + ! Take out non-local rows + ! + call psb_glob_to_loc(iarcv(1:iszr),p_desc_c,info,iact='I',owned=.true.) + lszr = iszr + call psb_coo_clean_negidx_inner(lszr,iarcv(1:iszr),jarcv(1:iszr),& + & acoo%val(nzl+1:nzl+iszr),nzt,info) + call desc_rx%g2lip_ins(jarcv(1:nzt),info) + call psb_cdasb(desc_rx,info) + acoo%ia(nzl+1:nzl+nzt) = iarcv(1:nzt) + acoo%ja(nzl+1:nzl+nzt) = jarcv(1:nzt) + nzl = nzl + nzt + call acoo%set_nzeros(nzl) + nzl = acoo%get_nzeros() + call acoo%set_sorted(.false.) + ! + ! Insert to extend descriptor + ! + call acoo%set_nrows(p_desc_c%get_local_rows()) + call acoo%set_ncols(desc_rx%get_local_cols()) + !write(0,*) me,' Trans RX ',acoo%get_nrows(),acoo%get_ncols(),acoo%get_nzeros() + else + ! + ! + ! Take out non-local rows + ! + call psb_glob_to_loc(iarcv(1:iszr),p_desc_c,info,iact='I',owned=.true.) + call psb_glob_to_loc(jarcv(1:iszr),desc_r,info,iact='I') + lszr = iszr + call psb_coo_clean_negidx_inner(lszr,iarcv(1:iszr),jarcv(1:iszr),& + & acoo%val(nzl+1:nzl+iszr),nzt,info) + acoo%ia(nzl+1:nzl+nzt) = iarcv(1:nzt) + acoo%ja(nzl+1:nzl+nzt) = jarcv(1:nzt) + nzl = nzl + nzt + call acoo%set_nzeros(nzl) + nzl = acoo%get_nzeros() + call acoo%set_sorted(.false.) + + call acoo%set_nrows(p_desc_c%get_local_rows()) + call acoo%set_ncols(desc_r%get_local_cols()) + !write(0,*) me,' Trans R- ',acoo%get_nrows(),acoo%get_ncols(),acoo%get_nzeros() + end if + +!!$ write(0,*) me,' Sanity check after rx%g2l :',count(acoo%ja(1:nzl)<0) + + + call acoo%fix(info) + nzl = acoo%get_nzeros() + + if (present(atrans)) then + call atrans%mv_from_coo(acoo,info) + else + call ain%mv_from_coo(acoo,info) + end if + Deallocate(brvindx,bsdindx,rvsz,sdsz,& + & iasnd,jasnd,valsnd,& + & iarcv,jarcv,stat=info) + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Done' + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(ictxt,err_act) + + return +end subroutine psb_z_coo_glob_transpose + +subroutine psb_z_simple_glob_transpose_ip(ain,desc_a,info) + use psb_base_mod, psb_protect_name => psb_z_simple_glob_transpose_ip + implicit none + type(psb_zspmat_type), intent(inout) :: ain + type(psb_desc_type) :: desc_a + integer(psb_ipk_), intent(out) :: info + + ! + ! BEWARE: This routine works under the assumption + ! that the same DESC_A works for both A and A^T, which + ! essentially means that A has a symmetric pattern. + ! + type(psb_z_coo_sparse_mat) :: tmpc1, tmpc2 + integer(psb_ipk_) :: nz1, nz2, nzh, nz + integer(psb_ipk_) :: ictxt, me, np + integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz + integer(psb_lpk_), allocatable :: ilv(:) + character(len=80) :: aname + logical, parameter :: debug=.false., dump=.false., debug_sync=.false. + + ictxt = desc_a%get_context() + call psb_info(ictxt,me,np) + + nrow = desc_a%get_local_rows() + ncol = desc_a%get_local_cols() + if (debug_sync) then + call psb_barrier(ictxt) + if (me == 0) write(0,*) 'Start htranspose ' + end if + + + call ain%mv_to(tmpc1) + call psb_glob_transpose(tmpc1, desc_a,info,atrans=tmpc2) + call ain%mv_from(tmpc2) + + if (dump) then + block + type(psb_lzspmat_type) :: aglb + write(aname,'(a,i3.3,a)') 'atran-',me,'.mtx' + call ain%print(fname=aname,head='atrans ') + call psb_gather(aglb,ain,desc_a,info) + if (me==psb_root_) then + write(aname,'(a,i3.3,a)') 'atran.mtx' + call aglb%print(fname=aname,head='Test ') + end if + end block + end if + +end subroutine psb_z_simple_glob_transpose_ip + +subroutine psb_z_simple_glob_transpose(ain,aout,desc_a,info) + use psb_base_mod, psb_protect_name => psb_z_simple_glob_transpose + implicit none + type(psb_zspmat_type), intent(in) :: ain + type(psb_zspmat_type), intent(out) :: aout + type(psb_desc_type) :: desc_a + integer(psb_ipk_), intent(out) :: info + + ! + ! BEWARE: This routine works under the assumption + ! that the same DESC_A works for both A and A^T, which + ! essentially means that A has a symmetric pattern. + ! + type(psb_z_coo_sparse_mat) :: tmpc1, tmpc2 + integer(psb_ipk_) :: nz1, nz2, nzh, nz + integer(psb_ipk_) :: ictxt, me, np + integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz + integer(psb_lpk_), allocatable :: ilv(:) + character(len=80) :: aname + logical, parameter :: debug=.false., dump=.false., debug_sync=.false. + + ictxt = desc_a%get_context() + call psb_info(ictxt,me,np) + + nrow = desc_a%get_local_rows() + ncol = desc_a%get_local_cols() + if (debug_sync) then + call psb_barrier(ictxt) + if (me == 0) write(0,*) 'Start htranspose ' + end if + + + call ain%cp_to(tmpc1) + call psb_glob_transpose(tmpc1, desc_a,info,atrans=tmpc2) + call aout%mv_from(tmpc2) + + if (dump) then + block + type(psb_lzspmat_type) :: aglb + + write(aname,'(a,i3.3,a)') 'atran-',me,'.mtx' + call aout%print(fname=aname,head='atrans ') + call psb_gather(aglb,aout,desc_a,info) + if (me==psb_root_) then + write(aname,'(a,i3.3,a)') 'atran.mtx' + call aglb%print(fname=aname,head='Test ') + end if + end block + end if + +end subroutine psb_z_simple_glob_transpose + +subroutine psb_lz_simple_glob_transpose_ip(ain,desc_a,info) + use psb_base_mod, psb_protect_name => psb_lz_simple_glob_transpose_ip + implicit none + type(psb_lzspmat_type), intent(inout) :: ain + type(psb_desc_type) :: desc_a + integer(psb_ipk_), intent(out) :: info + + ! + ! BEWARE: This routine works under the assumption + ! that the same DESC_A works for both A and A^T, which + ! essentially means that A has a symmetric pattern. + ! + type(psb_lz_coo_sparse_mat) :: tmpc1, tmpc2 + integer(psb_ipk_) :: nz1, nz2, nzh, nz + integer(psb_ipk_) :: ictxt, me, np + integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz + integer(psb_lpk_), allocatable :: ilv(:) + character(len=80) :: aname + logical, parameter :: debug=.false., dump=.false., debug_sync=.false. + + ictxt = desc_a%get_context() + call psb_info(ictxt,me,np) + + nrow = desc_a%get_local_rows() + ncol = desc_a%get_local_cols() + if (debug_sync) then + call psb_barrier(ictxt) + if (me == 0) write(0,*) 'Start htranspose ' + end if + + + call ain%mv_to(tmpc1) + call psb_glob_transpose(tmpc1, desc_a,info,atrans=tmpc2) + call ain%mv_from(tmpc2) + + if (dump) then + block + type(psb_lzspmat_type) :: aglb + write(aname,'(a,i3.3,a)') 'atran-',me,'.mtx' + call ain%print(fname=aname,head='atrans ',iv=ilv) + call psb_gather(aglb,ain,desc_a,info) + if (me==psb_root_) then + write(aname,'(a,i3.3,a)') 'atran.mtx' + call aglb%print(fname=aname,head='Test ') + end if + end block + end if + +end subroutine psb_lz_simple_glob_transpose_ip + +subroutine psb_lz_simple_glob_transpose(ain,aout,desc_a,info) + use psb_base_mod, psb_protect_name => psb_lz_simple_glob_transpose + implicit none + type(psb_lzspmat_type), intent(in) :: ain + type(psb_lzspmat_type), intent(out) :: aout + type(psb_desc_type) :: desc_a + integer(psb_ipk_), intent(out) :: info + + ! + ! BEWARE: This routine works under the assumption + ! that the same DESC_A works for both A and A^T, which + ! essentially means that A has a symmetric pattern. + ! + type(psb_lz_coo_sparse_mat) :: tmpc1, tmpc2 + integer(psb_ipk_) :: nz1, nz2, nzh, nz + integer(psb_ipk_) :: ictxt, me, np + integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz + integer(psb_lpk_), allocatable :: ilv(:) + character(len=80) :: aname + logical, parameter :: debug=.false., dump=.false., debug_sync=.false. + + ictxt = desc_a%get_context() + call psb_info(ictxt,me,np) + + nrow = desc_a%get_local_rows() + ncol = desc_a%get_local_cols() + if (debug_sync) then + call psb_barrier(ictxt) + if (me == 0) write(0,*) 'Start htranspose ' + end if + + + call ain%cp_to(tmpc1) + call psb_glob_transpose(tmpc1, desc_a,info,atrans=tmpc2) + call aout%mv_from(tmpc2) + + if (dump) then + block + type(psb_lzspmat_type) :: aglb + + write(aname,'(a,i3.3,a)') 'atran-',me,'.mtx' + call aout%print(fname=aname,head='atrans ',iv=ilv) + call psb_gather(aglb,aout,desc_a,info) + if (me==psb_root_) then + write(aname,'(a,i3.3,a)') 'atran.mtx' + call aglb%print(fname=aname,head='Test ') + end if + end block + end if + +end subroutine psb_lz_simple_glob_transpose + + diff --git a/base/tools/psb_z_par_csr_spspmm.f90 b/base/tools/psb_z_par_csr_spspmm.f90 index 71e1b7eeb..3be9d0e8c 100644 --- a/base/tools/psb_z_par_csr_spspmm.f90 +++ b/base/tools/psb_z_par_csr_spspmm.f90 @@ -39,7 +39,7 @@ ! C = A * B ! ! where all the matrices are stored in CSR. On input and output the matrices -! are stored with column indices in local numbering, but inermediate quantities +! are stored with column indices in local numbering, but intermediate quantities ! are in global numbering because gathering the halo of B to multiply it ! by A implies a potential enlargement of the support. ! Also, B may have a column index space different from its row index space, @@ -61,98 +61,100 @@ ! info - integer, output. ! Error code. ! -!!$Subroutine psb_z_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) -!!$ use psb_base_mod, psb_protect_name => psb_z_par_csr_spspmm -!!$ Implicit None -!!$ -!!$ type(psb_z_csr_sparse_mat),intent(in) :: acsr -!!$ type(psb_z_csr_sparse_mat),intent(inout) :: bcsr -!!$ type(psb_z_csr_sparse_mat),intent(out) :: ccsr -!!$ type(psb_desc_type),intent(in) :: desc_a -!!$ type(psb_desc_type),intent(inout) :: desc_c -!!$ integer(psb_ipk_), intent(out) :: info -!!$ integer(psb_ipk_), intent(in), optional :: data -!!$ ! ...local scalars.... -!!$ integer(psb_ipk_) :: ictxt, np,me -!!$ integer(psb_ipk_) :: ncol, nnz -!!$ type(psb_z_csr_sparse_mat) :: tcsr1 -!!$ logical :: update_desc_c -!!$ integer(psb_ipk_) :: debug_level, debug_unit, err_act -!!$ character(len=20) :: name, ch_err -!!$ -!!$ if(psb_get_errstatus() /= 0) return -!!$ info=psb_success_ -!!$ name='psb_z_p_csr_spspmm' -!!$ call psb_erractionsave(err_act) -!!$ if (psb_errstatus_fatal()) then -!!$ info = psb_err_internal_error_ ; goto 9999 -!!$ end if -!!$ debug_unit = psb_get_debug_unit() -!!$ debug_level = psb_get_debug_level() -!!$ -!!$ ictxt = desc_a%get_context() -!!$ -!!$ call psb_info(ictxt, me, np) -!!$ -!!$ if (debug_level >= psb_debug_outer_) & -!!$ & write(debug_unit,*) me,' ',trim(name),': Start' -!!$ -!!$ update_desc_c = desc_c%is_bld() -!!$ -!!$ ! -!!$ ! This is a bit tricky. -!!$ ! DESC_A is the descriptor of (the columns of) A, and therefore -!!$ ! of the rows of B; the columns of B, in the intended usage, span -!!$ ! a different space for which we have DESC_C. -!!$ ! We are gathering the halo rows of B to multiply by A; -!!$ ! now, the columns of B would ideally be kept in -!!$ ! global numbering, so that we can call this repeatedly to accumulate -!!$ ! the product of multiple operators, and convert to local numbering -!!$ ! at the last possible moment. However, this would imply calling -!!$ ! the serial SPSPMM with a matrix B with the GLOBAL number of columns -!!$ ! and this could be very expensive in memory. The solution is to keep B -!!$ ! in local numbering, so that only columns really appearing count, but to -!!$ ! expand the descriptor when gathering the halo, because by performing -!!$ ! the products we are extending the support of the operator; hence -!!$ ! this routine is intended to be called with a temporary descriptor -!!$ ! DESC_C which is in the BUILD state, to allow for such expansion -!!$ ! across multiple products. -!!$ ! The caller will at some later point finalize the descriptor DESC_C. -!!$ ! -!!$ -!!$ ncol = desc_a%get_local_cols() -!!$ call psb_sphalo(bcsr,desc_a,tcsr1,info,& -!!$ & colcnv=.true.,rowscale=.true.,outcol_glob=.true.,col_desc=desc_c,data=data) -!!$ nnz = tcsr1%get_nzeros() -!!$ if (update_desc_c) then -!!$ call desc_c%indxmap%g2lip_ins(tcsr1%ja(1:nnz),info) -!!$ else -!!$ call desc_c%indxmap%g2lip(tcsr1%ja(1:nnz),info) -!!$ end if -!!$ if (info == psb_success_) call psb_rwextd(ncol,bcsr,info,b=tcsr1) -!!$ if (info == psb_success_) call tcsr1%free() -!!$ if(info /= psb_success_) then -!!$ call psb_errpush(psb_err_internal_error_,name,a_err='Extend am3') -!!$ goto 9999 -!!$ end if -!!$ call bcsr%set_ncols(desc_c%get_local_cols()) -!!$ -!!$ -!!$ if (debug_level >= psb_debug_outer_) & -!!$ & write(debug_unit,*) me,' ',trim(name),& -!!$ & 'starting spspmm 3' -!!$ if (debug_level >= psb_debug_outer_) write(debug_unit,*) me,' ',trim(name),& -!!$ & 'starting spspmm ',acsr%get_nrows(),acsr%get_ncols(),bcsr%get_nrows(),bcsr%get_ncols() -!!$ call psb_spspmm(acsr,bcsr,ccsr,info) -!!$ -!!$ call psb_erractionrestore(err_act) -!!$ return -!!$ -!!$9999 call psb_error_handler(ictxt,err_act) -!!$ -!!$ return -!!$ -!!$End Subroutine psb_z_par_csr_spspmm +Subroutine psb_z_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) + use psb_base_mod, psb_protect_name => psb_z_par_csr_spspmm + Implicit None + + type(psb_z_csr_sparse_mat),intent(in) :: acsr + type(psb_z_csr_sparse_mat),intent(inout) :: bcsr + type(psb_z_csr_sparse_mat),intent(out) :: ccsr + type(psb_desc_type),intent(in) :: desc_a + type(psb_desc_type),intent(inout) :: desc_c + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: data + ! ...local scalars.... + integer(psb_ipk_) :: ictxt, np,me + integer(psb_ipk_) :: ncol, nnz + type(psb_lz_csr_sparse_mat) :: ltcsr + type(psb_z_csr_sparse_mat) :: tcsr + logical :: update_desc_c + integer(psb_ipk_) :: debug_level, debug_unit, err_act + character(len=20) :: name, ch_err + + if(psb_get_errstatus() /= 0) return + info=psb_success_ + name='psb_z_p_csr_spspmm' + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt = desc_a%get_context() + + call psb_info(ictxt, me, np) + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),': Start' + + update_desc_c = desc_c%is_bld() + + ! + ! This is a bit tricky. + ! DESC_A is the descriptor of (the columns of) A, and therefore + ! of the rows of B; the columns of B, in the intended usage, span + ! a different space for which we have DESC_C. + ! We are gathering the halo rows of B to multiply by A; + ! now, the columns of B would ideally be kept in + ! global numbering, so that we can call this repeatedly to accumulate + ! the product of multiple operators, and convert to local numbering + ! at the last possible moment. However, this would imply calling + ! the serial SPSPMM with a matrix B with the GLOBAL number of columns + ! and this could be very expensive in memory. The solution is to keep B + ! in local numbering, so that only columns really appearing count, but to + ! expand the descriptor when gathering the halo, because by performing + ! the products we are extending the support of the operator; hence + ! this routine is intended to be called with a temporary descriptor + ! DESC_C which is in the BUILD state, to allow for such expansion + ! across multiple products. + ! The caller will at some later point finalize the descriptor DESC_C. + ! + + ncol = desc_a%get_local_cols() + call psb_sphalo(bcsr,desc_a,ltcsr,info,& + & colcnv=.true.,rowscale=.true.,outcol_glob=.true.,col_desc=desc_c,data=data) + nnz = ltcsr%get_nzeros() + if (update_desc_c) then + call desc_c%indxmap%g2lip_ins(ltcsr%ja(1:nnz),info) + else + call desc_c%indxmap%g2lip(ltcsr%ja(1:nnz),info) + end if + call ltcsr%mv_to_ifmt(tcsr,info) + if (info == psb_success_) call psb_rwextd(ncol,bcsr,info,b=tcsr) + if (info == psb_success_) call tcsr%free() + if(info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,a_err='Extend am3') + goto 9999 + end if + call bcsr%set_ncols(desc_c%get_local_cols()) + + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),& + & 'starting spspmm 3' + if (debug_level >= psb_debug_outer_) write(debug_unit,*) me,' ',trim(name),& + & 'starting spspmm ',acsr%get_nrows(),acsr%get_ncols(),bcsr%get_nrows(),bcsr%get_ncols() + call psb_spspmm(acsr,bcsr,ccsr,info) + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(ictxt,err_act) + + return + +End Subroutine psb_z_par_csr_spspmm Subroutine psb_lz_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) use psb_base_mod, psb_protect_name => psb_lz_par_csr_spspmm diff --git a/base/tools/psb_zspasb.f90 b/base/tools/psb_zspasb.f90 index 9db285505..6cdfc61f0 100644 --- a/base/tools/psb_zspasb.f90 +++ b/base/tools/psb_zspasb.f90 @@ -122,11 +122,11 @@ subroutine psb_zspasb(a,desc_a, info, afmt, upd, dupl, mold) end if - IF (debug_level >= psb_debug_ext_) then + if (debug_level >= psb_debug_ext_) then ch_err=a%get_fmt() write(debug_unit, *) me,' ',trim(name),': From SPCNV',& & info,' ',ch_err - end IF + end if if (psb_errstatus_fatal()) then info=psb_err_from_subroutine_ diff --git a/base/tools/psb_zsphalo.F90 b/base/tools/psb_zsphalo.F90 index 6dc1d82b9..0e32938b6 100644 --- a/base/tools/psb_zsphalo.F90 +++ b/base/tools/psb_zsphalo.F90 @@ -31,11 +31,26 @@ ! ! File: psb_zsphalo.f90 ! -! Subroutine: psb_zsphalo +! Subroutine: psb_zsphalo psb_lzsphalo ! This routine does the retrieval of remote matrix rows. -! Note that retrieval is done through GTBLK, therefore it should work -! for any matrix format in A; as for the output, default is CSR. -! +! Retrieval is done through GETROW, therefore it should work +! for any matrix format in A; as for the output, default is CSR. +! +! There is also a specialized version lz_CSR whose interface +! is adapted for the needs of z_par_csr_spspmm. +! +! There are three possible exchange algorithms: +! 1. Use MPI_Alltoallv +! 2. Use psb_simple_a2av +! 3. Use psb_simple_triad_a2av +! Default choice is 3. The MPI variant has proved to be inefficient; +! that is because it is not persistent, therefore you pay the initialization price +! every time, and it is not optimized for a sparse communication pattern, +! most MPI implementations assume that all communications are non-empty. +! The PSB_SIMPLE variants reuse the same communicator, and go for a simplistic +! sequence of sends/receive that is quite efficient for a sparse communication +! pattern. To be refined/reviewed in the future to compare with neighbour +! persistent collectives. ! ! Arguments: ! a - type(psb_zspmat_type) The local part of input matrix A @@ -55,9 +70,6 @@ ! psb_comm_ext_ use ext_index ! psb_comm_ovrl_ DISABLED for this routine. ! -#undef SP_A2AV_MPI -#undef SP_A2AV_XI -#define SP_A2AV_MAT Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,& & rowscale,colscale,outfmt,data) use psb_base_mod, psb_protect_name => psb_zsphalo @@ -314,16 +326,36 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,& call psb_errpush(info,name,a_err=ch_err); goto 9999 end if - - call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_dpk_,& - & acoo%val,rvsz,brvindx,psb_mpi_c_dpk_,icomm,minfo) - call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & acoo%val,iarcv,jarcv,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& + & acoo%val,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& + & iarcv,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& + & jarcv,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_mpi_) + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_dpk_,& + & acoo%val,rvsz,brvindx,psb_mpi_c_dpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& & iarcv,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & jarcv,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & jarcv,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select + if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='mpi_alltoallv' + ch_err='alltoallv' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if @@ -390,16 +422,36 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,& goto 9999 end if + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& + & acoo%val,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& + & acoo%ia,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& + & acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_mpi_) + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_dpk_,& + & acoo%val,rvsz,brvindx,psb_mpi_c_dpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select - call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_dpk_,& - & acoo%val,rvsz,brvindx,psb_mpi_c_dpk_,icomm,minfo) - call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_ipk_,& - & acoo%ia,rvsz,brvindx,psb_mpi_ipk_,icomm,minfo) - call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_ipk_,& - & acoo%ja,rvsz,brvindx,psb_mpi_ipk_,icomm,minfo) if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='mpi_alltoallv' + ch_err='alltoallv' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if @@ -506,8 +558,7 @@ Subroutine psb_lzsphalo(a,desc_a,blk,info,rowcnv,colcnv,& integer(psb_ipk_), intent(in), optional :: data ! ...local scalars.... integer(psb_ipk_) :: ictxt, np,me - integer(psb_ipk_) :: counter, proc, i, & - & n_el_send,n_el_recv,& + integer(psb_ipk_) :: counter, proc, i, n_el_send,n_el_recv, & & n_elem, j, ipx,mat_recv, idxs,idxr,nz,& & data_,totxch,nxs, nxr, ncg integer(psb_lpk_) :: r, k, irmin, irmax, icmin, icmax, iszs, iszr, & @@ -718,16 +769,37 @@ Subroutine psb_lzsphalo(a,desc_a,blk,info,rowcnv,colcnv,& goto 9999 end if + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& + & acoo%val,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& + & acoo%ia,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& + & acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_mpi_) + + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_dpk_,& + & acoo%val,rvsz,brvindx,psb_mpi_c_dpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select - call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_dpk_,& - & acoo%val,rvsz,brvindx,psb_mpi_c_dpk_,icomm,minfo) - call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) if (info /= psb_success_) then info=psb_err_from_subroutine_ - call psb_errpush(info,name,a_err='mpi_alltoallv') + call psb_errpush(info,name,a_err='alltoallv') goto 9999 end if @@ -829,12 +901,11 @@ Subroutine psb_lz_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& type(psb_desc_type),Intent(in), optional, target :: col_desc ! ...local scalars.... integer(psb_ipk_) :: ictxt, np,me - integer(psb_ipk_) :: counter,proc,i, & - & n_el_send,k,n_el_recv,r,& - & n_elem, j, ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& - & irmin,icmin,data_,totxch,nxs, nxr,& - & err_act, nsnds, nrcvs - integer(psb_lpk_) :: ngtz,irmax,icmax,l1, lnr, lnc, lnnz, ncg, jpx, idx, tot_elem + integer(psb_ipk_) :: counter,proc,i, n_el_send,n_el_recv,& + & n_elem, j,ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& + & data_,totxch,nxs, nxr, err_act, nsnds, nrcvs + integer(psb_lpk_) :: ngtz,irmax,icmax,irmin,icmin,l1, lnr, lnc, lnnz, & + & r, k, ncg, jpx, idx, tot_elem integer(psb_mpk_) :: icomm, minfo integer(psb_mpk_), allocatable :: brvindx(:), & & rvsz(:), bsdindx(:),sdsz(:) @@ -1054,32 +1125,36 @@ Subroutine psb_lz_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& goto 9999 end if -#if defined(SP_A2AV_MPI) - call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_dpk_,& - & acoo%val,rvsz,brvindx,psb_mpi_c_dpk_,icomm,minfo) - if (minfo == mpi_success) & - & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo == mpi_success) & - & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& - & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) - if (minfo /= mpi_success) info = minfo -#elif defined(SP_A2AV_XI) - call lz_my_a2av(valsnd,sdsz,bsdindx,& + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& + & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& & acoo%val,rvsz,brvindx,ictxt,info) - if (info == psb_success_) call i_my_a2av(iasnd,sdsz,bsdindx,& + if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& & acoo%ia,rvsz,brvindx,ictxt,info) - if (info == psb_success_) call i_my_a2av(jasnd,sdsz,bsdindx,& + if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& & acoo%ja,rvsz,brvindx,ictxt,info) -#elif defined(SP_A2AV_MAT) - call lz_coo_my_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ipdxv,ictxt,icomm,info) -#else - choke on me @! -#endif + case(psb_sp_a2av_mpi_) + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_dpk_,& + & acoo%val,rvsz,brvindx,psb_mpi_c_dpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select + if (info /= psb_success_) then info=psb_err_from_subroutine_ - call psb_errpush(info,name,a_err='mpi_alltoallv') + call psb_errpush(info,name,a_err='alltoallv') goto 9999 end if @@ -1163,185 +1238,376 @@ Subroutine psb_lz_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& return -#if defined(SP_A2AV_XI) || defined(SP_A2AV_MAT) -contains +End Subroutine psb_lz_csr_halo -#if defined(SP_A2AV_MAT) - subroutine lz_coo_my_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & valrcv,iarcv,jarcv,rvsz,brvindx,ipdxv,ictxt,icomm,info) +Subroutine psb_z_lz_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& + & rowscale,colscale,data,outcol_glob,col_desc) + use psb_base_mod, psb_protect_name => psb_z_lz_csr_halo #ifdef MPI_MOD - use mpi + use mpi #endif - Implicit None + Implicit None #ifdef MPI_H - include 'mpif.h' + include 'mpif.h' #endif - complex(psb_dpk_), intent(in) :: valsnd(:) - integer(psb_ipk_), intent(in) :: ipdxv(:) - integer(psb_lpk_), intent(in) :: iasnd(:), jasnd(:) - complex(psb_dpk_), intent(out) :: valrcv(:) - integer(psb_lpk_), intent(out) :: iarcv(:), jarcv(:) - integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_mpk_), intent(in) :: icomm - integer(psb_ipk_), intent(out) :: info - !Local variables - integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz, counter - integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret - integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) - call psb_info(ictxt,iam,np) - if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz))= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),': Start' + + if (present(rowcnv)) then + rowcnv_ = rowcnv + else + rowcnv_ = .true. + endif + if (present(colcnv)) then + colcnv_ = colcnv + else + colcnv_ = .true. + endif + if (present(rowscale)) then + rowscale_ = rowscale + else + rowscale_ = .false. + endif + if (present(colscale)) then + colscale_ = colscale + else + colscale_ = .false. + endif + if (present(data)) then + data_ = data + else + data_ = psb_comm_halo_ + endif + if (present(outcol_glob)) then + outcol_glob_ = outcol_glob + else + outcol_glob_ = .false. + endif + if (present(col_desc)) then + col_desc_ => col_desc + else + col_desc_ => desc_a + end if + + Allocate(brvindx(np+1),& + & rvsz(np),sdsz(np),bsdindx(np+1), acoo,stat=info) + + if (info /= psb_success_) then + info=psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + end if + + If (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Data selector',data_ + select case(data_) + case(psb_comm_halo_,psb_comm_ext_ ) + ! Do not accept OVRLAP_INDEX any longer. + case default + call psb_errpush(psb_err_from_subroutine_,name,a_err='wrong Data selector') + goto 9999 + end select - counter=1 - Do - ip=ipdxv(counter) - if (ip == -1) exit - n_el_recv = ipdxv(counter+psb_n_elem_recv_) - counter = counter+n_el_recv - n_el_send = ipdxv(counter+psb_n_elem_send_) - prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) - sz = rvsz(ip+1) - if (sz > 0) then - idx = brvindx(ip+1) - p2ptag = psb_dcomplex_swap_tag - call mpi_irecv(valrcv(idx+1:idx+sz),sz,& - & psb_mpi_c_dpk_,prcid(ip+1),& - & p2ptag, icomm,rvhd(ip+1,1),iret) - p2ptag = psb_int_swap_tag - call mpi_irecv(iarcv(idx+1:idx+sz),sz,& - & psb_mpi_lpk_,prcid(ip+1),& - & p2ptag, icomm,rvhd(ip+1,2),iret) - call mpi_irecv(jarcv(idx+1:idx+sz),sz,& - & psb_mpi_lpk_,prcid(ip+1),& - & p2ptag, icomm,rvhd(ip+1,3),iret) - end if - counter = counter+n_el_send+3 + sdsz(:)=0 + rvsz(:)=0 + l1 = 0 + brvindx(1) = 0 + bsdindx(1) = 0 + counter=1 + idx = 0 + idxs = 0 + idxr = 0 + + call desc_a%get_list(data_,pdxv,totxch,nxr,nxs,info) + ipdxv = pdxv%get_vect() + ! For all rows in the halo descriptor, extract the row size + lnr = 0 + Do + proc=ipdxv(counter) + if (proc == -1) exit + n_el_recv = ipdxv(counter+psb_n_elem_recv_) + counter = counter+n_el_recv + n_el_send = ipdxv(counter+psb_n_elem_send_) + tot_elem = 0 + Do j=0,n_el_send-1 + idx = ipdxv(counter+psb_elem_send_+j) + n_elem = a%get_nz_row(idx) + tot_elem = tot_elem+n_elem Enddo + sdsz(proc+1) = tot_elem + lnr = lnr + n_el_recv + counter = counter+n_el_send+3 + Enddo + ! + ! Exchange row sizes, so as to know sends/receives. + ! This is different from the halo exchange because the + ! size of the rows may vary, as opposed to fixed + ! (multi) vector row size. + ! + call mpi_alltoall(sdsz,1,psb_mpi_mpk_,& + & rvsz,1,psb_mpi_mpk_,icomm,minfo) + + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='mpi_alltoall') + goto 9999 + end if + nsnds = count(sdsz /= 0) + nrcvs = count(rvsz /= 0) + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Done initial alltoall',nsnds,nrcvs - counter=1 - Do - ip=ipdxv(counter) - if (ip == -1) exit - n_el_recv = ipdxv(counter+psb_n_elem_recv_) - counter = counter+n_el_recv - n_el_send = ipdxv(counter+psb_n_elem_send_) - if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) - sz = sdsz(ip+1) - if (sz > 0) then - idx = bsdindx(ip+1) - p2ptag = psb_dcomplex_swap_tag - call mpi_send(valsnd(idx+1:idx+sz),sz,& - & psb_mpi_c_dpk_,prcid(ip+1),& - & p2ptag, icomm,iret) - p2ptag = psb_int_swap_tag - call mpi_send(iasnd(idx+1:idx+sz),sz,& - & psb_mpi_lpk_,prcid(ip+1),& - & p2ptag, icomm,iret) - call mpi_send(jasnd(idx+1:idx+sz),sz,& - & psb_mpi_lpk_,prcid(ip+1),& - & p2ptag, icomm,iret) + idxs = 0 + idxr = 0 + counter = 1 + Do + proc=ipdxv(counter) + if (proc == -1) exit + n_el_recv = ipdxv(counter+psb_n_elem_recv_) + counter = counter+n_el_recv + n_el_send = ipdxv(counter+psb_n_elem_send_) + + bsdindx(proc+1) = idxs + idxs = idxs + sdsz(proc+1) + brvindx(proc+1) = idxr + idxr = idxr + rvsz(proc+1) + counter = counter+n_el_send+3 + Enddo + + iszr = sum(rvsz) + mat_recv = iszr + iszs = sum(sdsz) + + lnnz = max(iszr,iszs,ione) + lnc = a%get_ncols() + call acoo%allocate(lnr,lnc,lnnz) + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Sizes:',acoo%get_size(),& + & ' Send:',sdsz(:),' Receive:',rvsz(:) + + call psb_ensure_size(max(iszs,1),iasnd,info) + if (info == psb_success_) call psb_ensure_size(max(iszs,1),jasnd,info) + if (info == psb_success_) call psb_ensure_size(max(iszs,1),liasnd,info) + if (info == psb_success_) call psb_ensure_size(max(iszs,1),ljasnd,info) + if (info == psb_success_) call psb_ensure_size(max(iszs,1),valsnd,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='ensure_size') + goto 9999 + end if + + l1 = 0 + ipx = 1 + counter=1 + idx = 0 + ! + ! Make sure to get all columns in csget. + ! This is necessary when sphalo is used to compute a transpose, + ! as opposed to just gathering halo for spspmm purposes. + ! + ncg = huge(ncg) + tot_elem = 0 + Do + proc = ipdxv(counter) + if (proc == -1) exit + n_el_recv = ipdxv(counter+psb_n_elem_recv_) + counter = counter+n_el_recv + n_el_send = ipdxv(counter+psb_n_elem_send_) + + Do j=0,n_el_send-1 + idx = ipdxv(counter+psb_elem_send_+j) + n_elem = a%get_nz_row(idx) + call a%csget(idx,idx,ngtz,iasnd,jasnd,valsnd,info,& + & append=.true.,nzin=tot_elem,jmax=ncg) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_sp_getrow') + goto 9999 end if - counter = counter+n_el_send+3 + tot_elem = tot_elem+ngtz Enddo + counter = counter+n_el_send+3 + Enddo + nz = tot_elem - counter=1 - Do - ip=ipdxv(counter) - if (ip == -1) exit - n_el_recv = ipdxv(counter+psb_n_elem_recv_) - counter = counter+n_el_recv - n_el_send = ipdxv(counter+psb_n_elem_send_) - sz = rvsz(ip+1) - if (sz > 0) then - call mpi_wait(rvhd(ip+1,1),p2pstat,iret) - call mpi_wait(rvhd(ip+1,2),p2pstat,iret) - call mpi_wait(rvhd(ip+1,3),p2pstat,iret) - end if - counter = counter+n_el_send+3 - Enddo + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Going for alltoallv',iszs,iszr + if (rowcnv_) then + call psb_loc_to_glob(iasnd(1:nz),liasnd(1:nz),desc_a,info,iact='I') + else + liasnd(1:nz) = iasnd(1:nz) + end if + if (colcnv_) then + call psb_loc_to_glob(jasnd(1:nz),ljasnd(1:nz),col_desc_,info,iact='I') + else + ljasnd(1:nz) = jasnd(1:nz) + end if + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_loc_to_glob') + goto 9999 + end if + select case(psb_get_sp_a2av_alg()) + case(psb_sp_a2av_smpl_triad_) + call psb_simple_triad_a2av(valsnd,liasnd,ljasnd,sdsz,bsdindx,& + & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_smpl_v_) + call psb_simple_a2av(valsnd,sdsz,bsdindx,& + & acoo%val,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(liasnd,sdsz,bsdindx,& + & acoo%ia,rvsz,brvindx,ictxt,info) + if (info == psb_success_) call psb_simple_a2av(ljasnd,sdsz,bsdindx,& + & acoo%ja,rvsz,brvindx,ictxt,info) + case(psb_sp_a2av_mpi_) + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_dpk_,& + & acoo%val,rvsz,brvindx,psb_mpi_c_dpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(liasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ia,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo == mpi_success) & + & call mpi_alltoallv(ljasnd,sdsz,bsdindx,psb_mpi_lpk_,& + & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) + if (minfo /= mpi_success) info = minfo + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='wrong A2AV alg selector') + goto 9999 + end select - end subroutine lz_coo_my_a2av -#endif -#if defined(SP_A2AV_XI) - subroutine lz_my_a2av(valsnd,sdsz,bsdindx,& - & valrcv,rvsz,brvindx,ictxt,info) - complex(psb_dpk_), intent(in) :: valsnd(:) - complex(psb_dpk_), intent(out) :: valrcv(:) - integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_ipk_), intent(out) :: info + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='alltoallv') + goto 9999 + end if + + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Done alltoallv' + ! + ! Convert into local numbering + ! + if (rowcnv_) call psb_glob_to_loc(acoo%ia(1:iszr),desc_a,info,iact='I') + ! + ! This seems to be the correct output condition + ! + if (colcnv_.and.(.not.outcol_glob_)) & + & call psb_glob_to_loc(acoo%ja(1:iszr),col_desc_,info,iact='I') - integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psbglob_to_loc') + goto 9999 + end if - call psb_info(ictxt,iam,np) - if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz))0).and.(k>0)) Then + l1=l1+1 + acoo%val(l1) = acoo%val(i) + acoo%ia(l1) = r + acoo%ja(l1) = k + irmin = min(irmin,r) + irmax = max(irmax,r) + icmin = min(icmin,k) + icmax = max(icmax,k) + End If + Enddo + if (rowscale_) then + call acoo%set_nrows(max(irmax-irmin+1,0)) + acoo%ia(1:l1) = acoo%ia(1:l1) - irmin + 1 + else + call acoo%set_nrows(irmax) + end if + if (colscale_) then + call acoo%set_ncols(max(icmax-icmin+1,0)) + acoo%ja(1:l1) = acoo%ja(1:l1) - icmin + 1 + else + call acoo%set_ncols(icmax) + end if - do ip = 0, np-1 - sz = sdsz(ip+1) - if (sz > 0) then - idx = bsdindx(ip+1) - call psb_snd(ictxt,valsnd(idx+1:idx+sz),ip) - end if - end do + call acoo%set_nzeros(l1) + call acoo%set_sorted(.false.) - do ip = 0, np-1 - sz = rvsz(ip+1) - if (sz > 0) then - idx = brvindx(ip+1) - call psb_rcv(ictxt,valrcv(idx+1:idx+sz),ip) - end if - end do - - end subroutine lz_my_a2av + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),& + & ': End data exchange',counter,l1 - subroutine i_my_a2av(valsnd,sdsz,bsdindx,& - & valrcv,rvsz,brvindx,ictxt,info) - integer(psb_ipk_), intent(in) :: valsnd(:) - integer(psb_ipk_), intent(out) :: valrcv(:) - integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_ipk_), intent(out) :: info - + call acoo%fix(info) + if (info == psb_success_) call acoo%mv_to_fmt(blk,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_spcnv') + goto 9999 + end if - integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz + Deallocate(brvindx,bsdindx,rvsz,sdsz,& + & iasnd,jasnd,valsnd,stat=info) + if (debug_level >= psb_debug_outer_)& + & write(debug_unit,*) me,' ',trim(name),': Done' - call psb_info(ictxt,iam,np) - if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then - idx = bsdindx(ip+1) - call psb_snd(ictxt,valsnd(idx+1:idx+sz),ip) - end if - end do +9999 call psb_error_handler(ictxt,err_act) - do ip = 0, np-1 - sz = rvsz(ip+1) - if (sz > 0) then - idx = brvindx(ip+1) - call psb_rcv(ictxt,valrcv(idx+1:idx+sz),ip) - end if - end do - - end subroutine i_my_a2av -#endif -#endif -End Subroutine psb_lz_csr_halo + return + +End Subroutine psb_z_lz_csr_halo diff --git a/base/tools/psb_zspins.f90 b/base/tools/psb_zspins.F90 similarity index 99% rename from base/tools/psb_zspins.f90 rename to base/tools/psb_zspins.F90 index f7129ce5a..6926bdc05 100644 --- a/base/tools/psb_zspins.f90 +++ b/base/tools/psb_zspins.F90 @@ -288,6 +288,7 @@ subroutine psb_zspins_csr_lirp(nr,irp,ja,val,irw,a,desc_a,info,rebuild,local) end subroutine psb_zspins_csr_lirp +#if defined(IPK4) && defined(LPK8) subroutine psb_zspins_csr_iirp(nr,irw,irp,ja,val,a,desc_a,info,rebuild,local) use psb_base_mod, psb_protect_name => psb_zspins_csr_iirp use psi_mod @@ -384,6 +385,7 @@ subroutine psb_zspins_csr_iirp(nr,irw,irp,ja,val,a,desc_a,info,rebuild,local) return end subroutine psb_zspins_csr_iirp +#endif subroutine psb_zspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) use psb_base_mod, psb_protect_name => psb_zspins_2desc diff --git a/docs/html/index.html b/docs/html/index.html index b53f97f39..0cca7b4cb 100644 --- a/docs/html/index.html +++ b/docs/html/index.html @@ -197,13 +197,13 @@ href="userhtmlsu73.html#x85-1220007.17" id="QQ2-85-150">psb_rcv — Receive
8 Error handling
 8.1 psb_errpush +href="userhtmlsu74.html#x87-1240008.1" id="QQ2-87-154">psb_errpush — Pushes an error code onto the error stack
 8.2 psb_error +href="userhtmlsu75.html#x88-1250008.2" id="QQ2-88-155">psb_error — Prints the error stack content and aborts execution
 8.3 psb_set_errverbosity +href="userhtmlsu76.html#x89-1260008.3" id="QQ2-89-156">psb_set_errverbosity — Sets the verbosity of error messages
 8.4 psb_set_erraction +href="userhtmlsu77.html#x90-1270008.4" id="QQ2-90-157">psb_set_erraction — Set the type of action to be taken upon error condition
9 Utilities
 9.1 psb_rcv — Receive
8 Error handling
 8.1 psb_errpush +href="userhtmlsu74.html#x87-1240008.1" id="QQ2-87-154">psb_errpush — Pushes an error code onto the error stack
 8.2 psb_error +href="userhtmlsu75.html#x88-1250008.2" id="QQ2-88-155">psb_error — Prints the error stack content and aborts execution
 8.3 psb_set_errverbosity +href="userhtmlsu76.html#x89-1260008.3" id="QQ2-89-156">psb_set_errverbosity — Sets the verbosity of error messages
 8.4 psb_set_erraction +href="userhtmlsu77.html#x90-1270008.4" id="QQ2-90-157">psb_set_erraction — Set the type of action to be taken upon error condition
9 Utilities
 9.1 psb_rcv — Receive data
8 Error handling
 8.1 psb_errpush +href="userhtmlsu74.html#x87-1240008.1">psb_errpush — Pushes an error code onto the error stack
 8.2 psb_error +href="userhtmlsu75.html#x88-1250008.2">psb_error — Prints the error stack content and aborts execution
 8.3 psb_set_errverbosity +href="userhtmlsu76.html#x89-1260008.3">psb_set_errverbosity — Sets the verbosity of error messages
 8.4 psb_set_erraction +href="userhtmlsu77.html#x90-1270008.4">psb_set_erraction — Set the type of action to be taken upon error condition
9 Utilities
 9.1 7. >

PIC

Figure 1:

PIC

Figure 2: An integer value that contains an error code. >

PIC


Figure 7: a performs a scaling on the overlap elements >

PIC


Figure 8: -psb_errpush +psb_errpush — Pushes an error code onto the error stack @@ -10,13 +10,12 @@ -

[

[next] [tail] [up]

8.1 psb_errpush

-

Pushes an error code onto the error stack + id="x87-1240008.1">psb_errpush — Pushes an error code onto the error stack

- - -

[next] [front] [ -psb_error +psb_error — Prints the error stack content and aborts execution @@ -10,15 +10,14 @@ -

[

[next] [prev] [prev-tail] [tail] [up]

8.2 psb_error

-

Prints the error stack content and aborts execution + id="x88-1250008.2">psb_error — Prints the error stack content and aborts execution

-psb_set_errverbosity +psb_set_errverbosity — Sets the verbosity of error messages @@ -10,15 +10,14 @@ -

[

[next] [prev] [prev-tail] [tail] [up]

8.3 psb_set_errverbosity

-

Sets the verbosity of error messages + id="x89-1260008.3">psb_set_errverbosity — Sets the verbosity of error messages

-psb_set_erraction +psb_set_erraction — Set the type of action to be taken upon error condition @@ -10,14 +10,14 @@ -

[

[prev] [prev-tail] [tail] [up]

8.4 psb_set_erraction

-

Set the type of action to be taken upon error condition + id="x90-1270008.4">psb_set_erraction — Set the type of action to be taken upon error +condition

An integer value; 0 means no error has been detected.

+ + +

[front] [up]

diff --git a/docs/psblas-3.7.pdf b/docs/psblas-3.7.pdf index 0cefd9c20..f2024eb49 100644 --- a/docs/psblas-3.7.pdf +++ b/docs/psblas-3.7.pdf @@ -1084,19 +1084,19 @@ endobj /Type /ObjStm /N 100 /First 877 -/Length 7331 +/Length 7538 >> stream 403 0 407 48 408 127 411 175 412 257 415 305 416 361 419 409 420 452 423 494 424 540 427 587 428 662 431 709 432 797 435 844 436 917 439 964 440 1038 443 1085 444 1151 447 1198 448 1252 451 1299 452 1380 455 1427 456 1483 459 1530 460 1581 463 1629 464 1675 467 1723 468 1773 471 1821 472 1871 475 1919 476 1984 479 2032 480 2097 483 2145 -484 2205 487 2253 488 2298 491 2346 492 2394 495 2436 496 2467 499 2514 500 2547 503 2594 -504 2625 507 2672 508 2717 511 2764 512 2806 515 2848 516 2874 519 2921 520 3024 523 3071 -524 3170 527 3217 528 3318 531 3365 532 3466 535 3513 536 3614 539 3661 540 3764 543 3807 -544 3848 547 3896 548 3953 551 4001 552 4055 555 4103 556 4168 559 4216 560 4293 563 4341 -564 4400 567 4448 568 4499 571 4542 572 4577 575 4625 576 4697 577 4742 580 4856 581 4912 -3 4968 578 5022 588 5127 590 5241 587 5298 635 5364 591 5858 592 6004 593 6150 594 6302 +484 2205 487 2253 488 2298 491 2346 492 2394 495 2436 496 2467 499 2514 500 2594 503 2641 +504 2729 507 2776 508 2863 511 2910 512 3013 515 3055 516 3081 519 3128 520 3231 523 3278 +524 3377 527 3424 528 3525 531 3572 532 3673 535 3720 536 3821 539 3868 540 3971 543 4014 +544 4055 547 4103 548 4160 551 4208 552 4262 555 4310 556 4375 559 4423 560 4500 563 4548 +564 4607 567 4655 568 4706 571 4749 572 4784 575 4832 576 4904 577 4949 580 5063 581 5119 +3 5175 578 5229 588 5334 590 5448 587 5505 635 5571 591 6065 592 6211 593 6357 594 6509 % 403 0 obj << /S /GoTo /D (subsection.6.24) >> % 407 0 obj @@ -1192,19 +1192,19 @@ stream % 496 0 obj << /S /GoTo /D (subsection.8.1) >> % 499 0 obj -(8.1 psb\137errpush) +(8.1 psb\137errpush \204 Pushes an error code onto the error stack) % 500 0 obj << /S /GoTo /D (subsection.8.2) >> % 503 0 obj -(8.2 psb\137error) +(8.2 psb\137error \204 Prints the error stack content and aborts execution) % 504 0 obj << /S /GoTo /D (subsection.8.3) >> % 507 0 obj -(8.3 psb\137set\137errverbosity) +(8.3 psb\137set\137errverbosity \204 Sets the verbosity of error messages) % 508 0 obj << /S /GoTo /D (subsection.8.4) >> % 511 0 obj -(8.4 psb\137set\137erraction) +(8.4 psb\137set\137erraction \204 Set the type of action to be taken upon error condition) % 512 0 obj << /S /GoTo /D (section.9) >> % 515 0 obj @@ -1936,9 +1936,9 @@ ET endstream endobj -739 0 obj +738 0 obj << -/Length 18635 +/Length 17894 >> stream 0 g 0 G @@ -1959,677 +1959,655 @@ BT [-1084(92)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -41.5 -12.094 Td [(6.15)-522(psb)]TJ + -41.5 -12.382 Td [(6.15)-522(psb)]TJ ET q -1 0 0 1 153.351 694.234 cm +1 0 0 1 153.351 693.946 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 156.339 694.035 Td [(gefree)-333(|)-334(F)84(rees)-334(a)-333(dense)-334(matrix)]TJ +/F8 9.9626 Tf 156.339 693.747 Td [(gefree)-333(|)-334(F)84(rees)-334(a)-333(dense)-334(matrix)]TJ 0 g 0 G [-773(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-1084(93)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -41.5 -12.094 Td [(6.16)-522(psb)]TJ + -41.5 -12.382 Td [(6.16)-522(psb)]TJ ET q -1 0 0 1 153.351 682.14 cm +1 0 0 1 153.351 681.564 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 156.339 681.941 Td [(gelp)-333(|)-334(Applies)-333(a)-333(left)-334(p)-27(erm)27(utation)-333(to)-333(a)-334(dense)-333(matrix)]TJ +/F8 9.9626 Tf 156.339 681.365 Td [(gelp)-333(|)-334(Applies)-333(a)-333(left)-334(p)-27(erm)27(utation)-333(to)-333(a)-334(dense)-333(matrix)]TJ 0 g 0 G [-317(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-1084(94)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -41.5 -12.095 Td [(6.17)-522(psb)]TJ + -41.5 -12.383 Td [(6.17)-522(psb)]TJ ET q -1 0 0 1 153.351 670.046 cm +1 0 0 1 153.351 669.182 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 156.339 669.846 Td [(glob)]TJ +/F8 9.9626 Tf 156.339 668.982 Td [(glob)]TJ ET q -1 0 0 1 175.202 670.046 cm +1 0 0 1 175.202 669.182 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 178.191 669.846 Td [(to)]TJ +/F8 9.9626 Tf 178.191 668.982 Td [(to)]TJ ET q -1 0 0 1 187.644 670.046 cm +1 0 0 1 187.644 669.182 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 190.633 669.846 Td [(lo)-28(c)-333(|)-333(G)-1(l)1(obal)-334(to)-333(lo)-28(cal)-333(indices)-334(con)28(v)28(ertion)]TJ +/F8 9.9626 Tf 190.633 668.982 Td [(lo)-28(c)-333(|)-333(G)-1(l)1(obal)-334(to)-333(lo)-28(cal)-333(indices)-334(con)28(v)28(ertion)]TJ 0 g 0 G [-821(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-1083(95)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -75.794 -12.094 Td [(6.18)-522(psb)]TJ + -75.794 -12.382 Td [(6.18)-522(psb)]TJ ET q -1 0 0 1 153.351 657.951 cm +1 0 0 1 153.351 656.8 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 156.339 657.752 Td [(lo)-28(c)]TJ +/F8 9.9626 Tf 156.339 656.6 Td [(lo)-28(c)]TJ ET q -1 0 0 1 169.39 657.951 cm +1 0 0 1 169.39 656.8 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 172.379 657.752 Td [(to)]TJ +/F8 9.9626 Tf 172.379 656.6 Td [(to)]TJ ET q -1 0 0 1 181.833 657.951 cm +1 0 0 1 181.833 656.8 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 184.822 657.752 Td [(glob)-333(|)-334(Lo)-27(cal)-334(to)-333(global)-333(indices)-334(con)28(v)28(ersion)]TJ +/F8 9.9626 Tf 184.822 656.6 Td [(glob)-333(|)-334(Lo)-27(cal)-334(to)-333(global)-333(indices)-334(con)28(v)28(ersion)]TJ 0 g 0 G [-753(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-1084(97)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -69.983 -12.094 Td [(6.19)-522(psb)]TJ + -69.983 -12.382 Td [(6.19)-522(psb)]TJ ET q -1 0 0 1 153.351 645.857 cm +1 0 0 1 153.351 644.417 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 156.339 645.658 Td [(is)]TJ +/F8 9.9626 Tf 156.339 644.218 Td [(is)]TJ ET q -1 0 0 1 163.634 645.857 cm +1 0 0 1 163.634 644.417 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 166.623 645.658 Td [(o)28(wned)-334(|)]TJ +/F8 9.9626 Tf 166.623 644.218 Td [(o)28(wned)-334(|)]TJ 0 g 0 G [-1135(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-1084(98)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -51.784 -12.094 Td [(6.20)-522(psb)]TJ + -51.784 -12.382 Td [(6.20)-522(psb)]TJ ET q -1 0 0 1 153.351 633.763 cm +1 0 0 1 153.351 632.035 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 156.339 633.564 Td [(o)28(wned)]TJ +/F8 9.9626 Tf 156.339 631.836 Td [(o)28(wned)]TJ ET q -1 0 0 1 184.334 633.763 cm +1 0 0 1 184.334 632.035 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 187.323 633.564 Td [(index)-333(|)]TJ +/F8 9.9626 Tf 187.323 631.836 Td [(index)-333(|)]TJ 0 g 0 G [-1002(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-1083(99)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -72.484 -12.094 Td [(6.21)-522(psb)]TJ + -72.484 -12.382 Td [(6.21)-522(psb)]TJ ET q -1 0 0 1 153.351 621.669 cm +1 0 0 1 153.351 619.653 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 156.339 621.47 Td [(is)]TJ +/F8 9.9626 Tf 156.339 619.454 Td [(is)]TJ ET q -1 0 0 1 163.634 621.669 cm +1 0 0 1 163.634 619.653 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 166.623 621.47 Td [(lo)-28(cal)-333(|)]TJ +/F8 9.9626 Tf 166.623 619.454 Td [(lo)-28(cal)-333(|)]TJ 0 g 0 G [-1080(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-584(100)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -51.784 -12.095 Td [(6.22)-522(psb)]TJ + -51.784 -12.382 Td [(6.22)-522(psb)]TJ ET q -1 0 0 1 153.351 609.575 cm +1 0 0 1 153.351 607.271 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 156.339 609.375 Td [(lo)-28(cal)]TJ +/F8 9.9626 Tf 156.339 607.072 Td [(lo)-28(cal)]TJ ET q -1 0 0 1 177.139 609.575 cm +1 0 0 1 177.139 607.271 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 180.128 609.375 Td [(index)-333(|)]TJ +/F8 9.9626 Tf 180.128 607.072 Td [(index)-333(|)]TJ 0 g 0 G [-947(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-584(101)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -65.289 -12.094 Td [(6.23)-522(psb)]TJ + -65.289 -12.382 Td [(6.23)-522(psb)]TJ ET q -1 0 0 1 153.351 597.481 cm +1 0 0 1 153.351 594.889 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 156.339 597.281 Td [(get)]TJ +/F8 9.9626 Tf 156.339 594.69 Td [(get)]TJ ET q -1 0 0 1 170.221 597.481 cm +1 0 0 1 170.221 594.889 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 173.209 597.281 Td [(b)-28(oundary)-333(|)-333(Extract)-334(list)-333(of)-333(b)-28(oundary)-333(elemen)28(ts)]TJ +/F8 9.9626 Tf 173.209 594.69 Td [(b)-28(oundary)-333(|)-333(Extract)-334(list)-333(of)-333(b)-28(oundary)-333(elemen)28(ts)]TJ 0 g 0 G [-330(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-584(102)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -58.37 -12.094 Td [(6.24)-522(psb)]TJ + -58.37 -12.382 Td [(6.24)-522(psb)]TJ ET q -1 0 0 1 153.351 585.386 cm +1 0 0 1 153.351 582.507 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 156.339 585.187 Td [(get)]TJ +/F8 9.9626 Tf 156.339 582.307 Td [(get)]TJ ET q -1 0 0 1 170.221 585.386 cm +1 0 0 1 170.221 582.507 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 173.209 585.187 Td [(o)28(v)28(e)-1(r)1(lap)-334(|)-333(Extract)-333(list)-334(of)-333(o)28(v)28(erlap)-334(elemen)28(ts)]TJ +/F8 9.9626 Tf 173.209 582.307 Td [(o)28(v)28(e)-1(r)1(lap)-334(|)-333(Extract)-333(list)-334(of)-333(o)28(v)28(erlap)-334(elemen)28(ts)]TJ 0 g 0 G [-830(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)]TJ 0 g 0 G [-584(103)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -58.37 -12.094 Td [(6.25)-522(psb)]TJ + -58.37 -12.382 Td [(6.25)-522(psb)]TJ ET q -1 0 0 1 153.351 573.292 cm +1 0 0 1 153.351 570.125 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 156.339 573.093 Td [(sp)]TJ +/F8 9.9626 Tf 156.339 569.925 Td [(sp)]TJ ET q -1 0 0 1 166.402 573.292 cm +1 0 0 1 166.402 570.125 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 169.39 573.093 Td [(getro)28(w)-334(|)-333(Extract)-333(ro)28(w\050s)-1(\051)-333(from)-333(a)-333(s)-1(p)1(arse)-334(matrix)]TJ +/F8 9.9626 Tf 169.39 569.925 Td [(getro)28(w)-334(|)-333(Extract)-333(ro)28(w\050s)-1(\051)-333(from)-333(a)-333(s)-1(p)1(arse)-334(matrix)]TJ 0 g 0 G [-810(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-584(104)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -54.551 -12.094 Td [(6.26)-522(psb)]TJ + -54.551 -12.382 Td [(6.26)-522(psb)]TJ ET q -1 0 0 1 153.351 561.198 cm +1 0 0 1 153.351 557.742 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 156.339 560.999 Td [(sizeof)-333(|)-334(Memory)-333(o)-28(ccupation)]TJ +/F8 9.9626 Tf 156.339 557.543 Td [(sizeof)-333(|)-334(Memory)-333(o)-28(ccupation)]TJ 0 g 0 G [-520(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-583(106)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -41.5 -12.094 Td [(6.27)-522(Sorting)-333(utilities)-334(|)]TJ + -41.5 -12.382 Td [(6.27)-522(Sorting)-333(utilities)-334(|)]TJ 0 g 0 G [-775(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-584(107)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -/F27 9.9626 Tf -14.944 -22.15 Td [(7)-925(P)32(arallel)-384(en)32(vironmen)32(t)-383(routines)]TJ +/F27 9.9626 Tf -14.944 -22.629 Td [(7)-925(P)32(arallel)-384(en)32(vironmen)32(t)-383(routines)]TJ 0 g 0 G [-16316(109)]TJ 0 0 1 rg 0 0 1 RG -/F8 9.9626 Tf 14.944 -12.094 Td [(7.1)-1022(psb)]TJ +/F8 9.9626 Tf 14.944 -12.382 Td [(7.1)-1022(psb)]TJ ET q -1 0 0 1 153.351 514.86 cm +1 0 0 1 153.351 510.349 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 156.339 514.661 Td [(init)-333(|)-334(Initializes)-333(PSBLAS)-333(parallel)-333(e)-1(n)28(vironmen)28(t)]TJ +/F8 9.9626 Tf 156.339 510.15 Td [(init)-333(|)-334(Initializes)-333(PSBLAS)-333(parallel)-333(e)-1(n)28(vironmen)28(t)]TJ 0 g 0 G [-920(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-584(110)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -41.5 -12.094 Td [(7.2)-1022(psb)]TJ + -41.5 -12.383 Td [(7.2)-1022(psb)]TJ ET q -1 0 0 1 153.351 502.766 cm +1 0 0 1 153.351 497.967 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 156.339 502.567 Td [(info)-329(|)-328(Return)-329(information)-329(ab)-27(out)-329(PSBLAS)-329(parallel)-328(en)27(vir)1(on-)]TJ -18.586 -11.956 Td [(men)28(t)]TJ +/F8 9.9626 Tf 156.339 497.767 Td [(info)-329(|)-328(Return)-329(information)-329(ab)-27(out)-329(PSBLAS)-329(parallel)-328(en)27(vir)1(on-)]TJ -18.586 -11.955 Td [(men)28(t)]TJ 0 g 0 G [-478(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-584(111)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -22.914 -12.094 Td [(7.3)-1022(psb)]TJ + -22.914 -12.382 Td [(7.3)-1022(psb)]TJ ET q -1 0 0 1 153.351 478.717 cm +1 0 0 1 153.351 473.629 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 156.339 478.517 Td [(exit)-333(|)-334(Exit)-333(from)-333(PSBLAS)-334(p)1(arallel)-334(en)28(vironmen)28(t)]TJ +/F8 9.9626 Tf 156.339 473.43 Td [(exit)-333(|)-334(Exit)-333(from)-333(PSBLAS)-334(p)1(arallel)-334(en)28(vironmen)28(t)]TJ 0 g 0 G [-742(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-584(112)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -41.5 -12.094 Td [(7.4)-1022(psb)]TJ + -41.5 -12.382 Td [(7.4)-1022(psb)]TJ ET q -1 0 0 1 153.351 466.622 cm +1 0 0 1 153.351 461.247 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 156.339 466.423 Td [(get)]TJ +/F8 9.9626 Tf 156.339 461.048 Td [(get)]TJ ET q -1 0 0 1 170.221 466.622 cm +1 0 0 1 170.221 461.247 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 173.209 466.423 Td [(mpi)]TJ +/F8 9.9626 Tf 173.209 461.048 Td [(mpi)]TJ ET q -1 0 0 1 190.412 466.622 cm +1 0 0 1 190.412 461.247 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 193.4 466.423 Td [(comm)-334(|)-333(Get)-333(the)-334(MPI)-333(comm)28(unicator)]TJ +/F8 9.9626 Tf 193.4 461.048 Td [(comm)-334(|)-333(Get)-333(the)-334(MPI)-333(comm)28(unicator)]TJ 0 g 0 G [-868(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-584(113)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -78.561 -12.094 Td [(7.5)-1022(psb)]TJ + -78.561 -12.382 Td [(7.5)-1022(psb)]TJ ET q -1 0 0 1 153.351 454.528 cm +1 0 0 1 153.351 448.865 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 156.339 454.329 Td [(get)]TJ +/F8 9.9626 Tf 156.339 448.666 Td [(get)]TJ ET q -1 0 0 1 170.221 454.528 cm +1 0 0 1 170.221 448.865 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 173.209 454.329 Td [(mpi)]TJ +/F8 9.9626 Tf 173.209 448.666 Td [(mpi)]TJ ET q -1 0 0 1 190.412 454.528 cm +1 0 0 1 190.412 448.865 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 193.4 454.329 Td [(rank)-333(|)-334(Get)-333(the)-333(MPI)-334(rank)]TJ +/F8 9.9626 Tf 193.4 448.666 Td [(rank)-333(|)-334(Get)-333(the)-333(MPI)-334(rank)]TJ 0 g 0 G [-282(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-584(114)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -78.561 -12.094 Td [(7.6)-1022(psb)]TJ + -78.561 -12.382 Td [(7.6)-1022(psb)]TJ ET q -1 0 0 1 153.351 442.434 cm +1 0 0 1 153.351 436.483 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 156.339 442.235 Td [(wtime)-333(|)-334(W)84(all)-334(clo)-28(c)28(k)-333(timing)]TJ +/F8 9.9626 Tf 156.339 436.284 Td [(wtime)-333(|)-334(W)84(all)-334(clo)-28(c)28(k)-333(timing)]TJ 0 g 0 G [-445(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-584(115)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -41.5 -12.094 Td [(7.7)-1022(psb)]TJ + -41.5 -12.382 Td [(7.7)-1022(psb)]TJ ET q -1 0 0 1 153.351 430.34 cm +1 0 0 1 153.351 424.101 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 156.339 430.141 Td [(barrier)-333(|)-334(Sinc)28(hronization)-333(p)-28(oin)28(t)-333(parallel)-333(en)27(vironmen)28(t)]TJ +/F8 9.9626 Tf 156.339 423.902 Td [(barrier)-333(|)-334(Sinc)28(hronization)-333(p)-28(oin)28(t)-333(parallel)-333(en)27(vironmen)28(t)]TJ 0 g 0 G [-845(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-584(116)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -41.5 -12.095 Td [(7.8)-1022(psb)]TJ + -41.5 -12.383 Td [(7.8)-1022(psb)]TJ ET q -1 0 0 1 153.351 418.246 cm +1 0 0 1 153.351 411.719 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 156.339 418.046 Td [(ab)-28(ort)-333(|)-333(Ab)-28(ort)-333(a)-334(computation)]TJ +/F8 9.9626 Tf 156.339 411.519 Td [(ab)-28(ort)-333(|)-333(Ab)-28(ort)-333(a)-334(computation)]TJ 0 g 0 G [-717(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-583(117)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -41.5 -12.094 Td [(7.9)-1022(psb)]TJ + -41.5 -12.382 Td [(7.9)-1022(psb)]TJ ET q -1 0 0 1 153.351 406.151 cm +1 0 0 1 153.351 399.337 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 156.339 405.952 Td [(b)-28(cast)-333(|)-334(Broadcast)-333(data)]TJ +/F8 9.9626 Tf 156.339 399.137 Td [(b)-28(cast)-333(|)-334(Broadcast)-333(data)]TJ 0 g 0 G [-278(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-584(118)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -41.5 -12.094 Td [(7.10)-522(psb)]TJ + -41.5 -12.382 Td [(7.10)-522(psb)]TJ ET q -1 0 0 1 153.351 394.057 cm +1 0 0 1 153.351 386.954 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 156.339 393.858 Td [(sum)-333(|)-334(Global)-333(sum)]TJ +/F8 9.9626 Tf 156.339 386.755 Td [(sum)-333(|)-334(Global)-333(sum)]TJ 0 g 0 G [-900(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-584(119)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -41.5 -12.094 Td [(7.11)-522(psb)]TJ + -41.5 -12.382 Td [(7.11)-522(psb)]TJ ET q -1 0 0 1 153.351 381.963 cm +1 0 0 1 153.351 374.572 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 156.339 381.764 Td [(max)-333(|)-334(Global)-333(maxim)28(um)]TJ +/F8 9.9626 Tf 156.339 374.373 Td [(max)-333(|)-334(Global)-333(maxim)28(um)]TJ 0 g 0 G [-605(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-583(120)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -41.5 -12.094 Td [(7.12)-522(psb)]TJ + -41.5 -12.382 Td [(7.12)-522(psb)]TJ ET q -1 0 0 1 153.351 369.869 cm +1 0 0 1 153.351 362.19 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 156.339 369.67 Td [(min)-333(|)-334(Global)-333(minim)28(um)]TJ +/F8 9.9626 Tf 156.339 361.991 Td [(min)-333(|)-334(Global)-333(minim)28(um)]TJ 0 g 0 G [-994(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)]TJ 0 g 0 G [-584(121)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -41.5 -12.094 Td [(7.13)-522(psb)]TJ + -41.5 -12.382 Td [(7.13)-522(psb)]TJ ET q -1 0 0 1 153.351 357.775 cm +1 0 0 1 153.351 349.808 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 156.339 357.576 Td [(amx)-333(|)-334(Global)-333(maxim)28(um)-334(absolute)-333(v)56(alue)]TJ +/F8 9.9626 Tf 156.339 349.609 Td [(amx)-333(|)-334(Global)-333(maxim)28(um)-334(absolute)-333(v)56(alue)]TJ 0 g 0 G [-294(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-584(122)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -41.5 -12.095 Td [(7.14)-522(psb)]TJ + -41.5 -12.382 Td [(7.14)-522(psb)]TJ ET q -1 0 0 1 153.351 345.681 cm +1 0 0 1 153.351 337.426 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 156.339 345.481 Td [(amn)-333(|)-334(Global)-333(minim)28(um)-334(absolu)1(te)-334(v)56(alue)]TJ +/F8 9.9626 Tf 156.339 337.227 Td [(amn)-333(|)-334(Global)-333(minim)28(um)-334(absolu)1(te)-334(v)56(alue)]TJ 0 g 0 G [-461(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-584(123)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -41.5 -12.094 Td [(7.15)-522(psb)]TJ + -41.5 -12.383 Td [(7.15)-522(psb)]TJ ET q -1 0 0 1 153.351 333.586 cm +1 0 0 1 153.351 325.044 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 156.339 333.387 Td [(nrm2)-333(|)-334(Global)-333(2-norm)-333(reduction)]TJ +/F8 9.9626 Tf 156.339 324.844 Td [(nrm2)-333(|)-334(Global)-333(2-norm)-333(reduction)]TJ 0 g 0 G [-847(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-584(124)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -41.5 -12.094 Td [(7.16)-522(psb)]TJ + -41.5 -12.382 Td [(7.16)-522(psb)]TJ ET q -1 0 0 1 153.351 321.492 cm +1 0 0 1 153.351 312.662 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 156.339 321.293 Td [(snd)-333(|)-334(Send)-333(data)]TJ +/F8 9.9626 Tf 156.339 312.462 Td [(snd)-333(|)-334(Send)-333(data)]TJ 0 g 0 G [-1023(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-584(125)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -41.5 -12.094 Td [(7.17)-522(psb)]TJ + -41.5 -12.382 Td [(7.17)-522(psb)]TJ ET q -1 0 0 1 153.351 309.398 cm +1 0 0 1 153.351 300.279 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 156.339 309.199 Td [(rcv)-333(|)-334(Receiv)28(e)-333(data)]TJ +/F8 9.9626 Tf 156.339 300.08 Td [(rcv)-333(|)-334(Receiv)28(e)-333(data)]TJ 0 g 0 G [-762(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-583(126)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -/F27 9.9626 Tf -56.444 -22.15 Td [(8)-925(Error)-383(handling)]TJ +/F27 9.9626 Tf -56.444 -22.629 Td [(8)-925(Error)-383(handling)]TJ 0 g 0 G [-23812(127)]TJ 0 0 1 rg 0 0 1 RG -/F8 9.9626 Tf 14.944 -12.094 Td [(8.1)-1022(psb)]TJ +/F8 9.9626 Tf 14.944 -12.382 Td [(8.1)-1022(psb)]TJ ET q -1 0 0 1 153.351 275.154 cm +1 0 0 1 153.351 265.268 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 156.339 274.955 Td [(errpush)]TJ +/F8 9.9626 Tf 156.339 265.069 Td [(errpush)-333(|)-334(Pushes)-333(an)-333(error)-334(co)-27(de)-334(on)28(to)-333(the)-334(error)-333(stac)28(k)]TJ 0 g 0 G - [-629(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ + [-1026(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-584(129)]TJ + [-583(129)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -41.5 -12.094 Td [(8.2)-1022(psb)]TJ + -41.5 -12.383 Td [(8.2)-1022(psb)]TJ ET q -1 0 0 1 153.351 263.06 cm +1 0 0 1 153.351 252.886 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 156.339 262.861 Td [(error)]TJ +/F8 9.9626 Tf 156.339 252.686 Td [(error)-333(|)-334(Prin)28(ts)-333(the)-333(e)-1(r)1(ror)-334(stac)28(k)-333(con)27(ten)28(t)-333(and)-333(ab)-28(orts)-333(e)-1(xecution)]TJ 0 g 0 G - [-1020(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)]TJ 0 g 0 G - [-584(130)]TJ + [-1087(130)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -41.5 -12.094 Td [(8.3)-1022(psb)]TJ + -41.5 -12.382 Td [(8.3)-1022(psb)]TJ ET q -1 0 0 1 153.351 250.966 cm +1 0 0 1 153.351 240.504 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 156.339 250.767 Td [(set)]TJ +/F8 9.9626 Tf 156.339 240.304 Td [(set)]TJ ET q -1 0 0 1 169.169 250.966 cm +1 0 0 1 169.169 240.504 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 172.158 250.767 Td [(errv)28(erb)-28(osit)28(y)]TJ +/F8 9.9626 Tf 172.158 240.304 Td [(errv)28(erb)-28(osit)28(y)-333(|)-334(Sets)-333(the)-334(v)28(erb)-27(os)-1(it)28(y)-333(of)-333(error)-334(messages)]TJ 0 g 0 G - [-1010(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ + [-804(.)-500(.)-500(.)]TJ 0 g 0 G [-584(131)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -57.319 -12.094 Td [(8.4)-1022(psb)]TJ + -57.319 -12.382 Td [(8.4)-1022(psb)]TJ ET q -1 0 0 1 153.351 238.872 cm +1 0 0 1 153.351 228.121 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 156.339 238.673 Td [(set)]TJ +/F8 9.9626 Tf 156.339 227.922 Td [(set)]TJ ET q -1 0 0 1 169.169 238.872 cm +1 0 0 1 169.169 228.121 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 172.158 238.673 Td [(erraction)]TJ +/F8 9.9626 Tf 172.158 227.922 Td [(erraction)-274(|)-274(Set)-275(th)1(e)-275(t)28(yp)-28(e)-274(of)-274(action)-274(to)-274(b)-28(e)-274(tak)27(en)-274(up)-27(on)-275(error)]TJ -34.405 -11.955 Td [(condition)]TJ 0 g 0 G - [-769(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ + [-950(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-584(132)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -/F27 9.9626 Tf -72.263 -22.15 Td [(9)-925(Utilities)]TJ +/F27 9.9626 Tf -37.858 -22.629 Td [(9)-925(Utilities)]TJ 0 g 0 G [-27238(133)]TJ 0 0 1 rg 0 0 1 RG -/F8 9.9626 Tf 14.944 -12.094 Td [(9.1)-1490(h)28(b)]TJ +/F8 9.9626 Tf 14.944 -12.383 Td [(9.1)-1490(h)28(b)]TJ ET q -1 0 0 1 153.803 204.628 cm +1 0 0 1 153.803 181.155 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 156.792 204.429 Td [(read)-468(|)-467(Read)-468(a)-468(sparse)-468(matri)1(x)-468(from)-468(a)-467(\014le)-468(in)-468(the)-467(Harw)27(ell{)]TJ -19.039 -11.955 Td [(Bo)-28(eing)-333(format)]TJ +/F8 9.9626 Tf 156.792 180.955 Td [(read)-468(|)-467(Read)-468(a)-468(sparse)-468(matri)1(x)-468(from)-468(a)-467(\014le)-468(in)-468(the)-467(Harw)27(ell{)]TJ -19.039 -11.955 Td [(Bo)-28(eing)-333(format)]TJ 0 g 0 G [-294(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-583(134)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -22.914 -12.094 Td [(9.2)-1022(h)28(b)]TJ + -22.914 -12.382 Td [(9.2)-1022(h)28(b)]TJ ET q -1 0 0 1 149.144 180.579 cm +1 0 0 1 149.144 156.817 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 152.133 180.38 Td [(write)-291(|)-290(W)83(rite)-290(a)-291(sparse)-290(matrix)-291(to)-290(a)-291(\014le)-290(in)-291(the)-290(Harw)28(ell{Bo)-28(eing)]TJ -14.38 -11.956 Td [(format)]TJ +/F8 9.9626 Tf 152.133 156.618 Td [(write)-291(|)-290(W)83(rite)-290(a)-291(sparse)-290(matrix)-291(to)-290(a)-291(\014le)-290(in)-291(the)-290(Harw)28(ell{Bo)-28(eing)]TJ -14.38 -11.955 Td [(format)]TJ 0 g 0 G [-530(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)]TJ 0 g 0 G [-584(135)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -22.914 -12.094 Td [(9.3)-1022(mm)]TJ -ET -q -1 0 0 1 154.956 156.529 cm -[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S -Q -BT -/F8 9.9626 Tf 157.944 156.33 Td [(mat)]TJ -ET -q -1 0 0 1 175.7 156.529 cm -[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S -Q -BT -/F8 9.9626 Tf 178.689 156.33 Td [(read)-313(|)-314(Read)-313(a)-313(sparse)-314(matrix)-313(from)-313(a)-314(\014le)-313(in)-313(the)-314(Matr)1(ix-)]TJ -40.935 -11.955 Td [(Mark)28(et)-333(format)]TJ -0 g 0 G - [-945(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ -0 g 0 G - [-584(136)]TJ -0 g 0 G -0 0 1 rg 0 0 1 RG - -22.915 -12.094 Td [(9.4)-1022(mm)]TJ + -22.914 -12.382 Td [(9.3)-1022(mm)]TJ ET q 1 0 0 1 154.956 132.48 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 157.944 132.281 Td [(arra)28(y)]TJ +/F8 9.9626 Tf 157.944 132.281 Td [(mat)]TJ ET q -1 0 0 1 181.29 132.48 cm +1 0 0 1 175.7 132.48 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 184.279 132.281 Td [(read)-346(|)-346(Read)-346(a)-347(dense)-346(arra)28(y)-346(from)-346(a)-346(\014le)-347(in)-346(the)-346(Matrix-)]TJ -46.526 -11.955 Td [(Mark)28(et)-334(format)]TJ +/F8 9.9626 Tf 178.689 132.281 Td [(read)-313(|)-314(Read)-313(a)-313(sparse)-314(matrix)-313(from)-313(a)-314(\014le)-313(in)-313(the)-314(Matr)1(ix-)]TJ -40.935 -11.955 Td [(Mark)28(et)-333(format)]TJ 0 g 0 G - [-944(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ + [-945(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-584(137)]TJ + [-584(136)]TJ 0 g 0 G 0 g 0 G - 129.847 -29.888 Td [(iii)]TJ + 129.846 -29.888 Td [(iii)]TJ 0 g 0 G ET @@ -2640,7 +2618,7 @@ endobj /Type /ObjStm /N 100 /First 927 -/Length 16607 +/Length 16599 >> stream 595 0 596 152 597 309 598 459 599 605 600 757 601 914 602 1071 603 1228 604 1385 @@ -2652,7 +2630,7 @@ stream 657 9425 658 9577 659 9729 660 9881 661 10033 662 10185 663 10337 664 10489 665 10642 666 10795 667 10948 668 11101 669 11254 670 11407 671 11560 672 11706 673 11858 674 12010 675 12162 676 12314 677 12460 678 12612 679 12764 680 12916 681 13067 682 13218 683 13369 684 13520 685 13672 686 13824 -687 13976 688 14127 689 14279 694 14431 691 14488 738 14567 690 15069 695 15222 696 15375 697 15527 +687 13976 688 14127 689 14279 694 14431 691 14488 737 14567 690 15061 695 15214 696 15367 697 15519 % 595 0 obj << /Type /Annot @@ -3396,14 +3374,14 @@ stream /Font << /F8 585 0 R /F27 584 0 R >> /ProcSet [ /PDF /Text ] >> -% 738 0 obj +% 737 0 obj << /Type /Page -/Contents 739 0 R -/Resources 737 0 R +/Contents 738 0 R +/Resources 736 0 R /MediaBox [0 0 595.276 841.89] /Parent 586 0 R -/Annots [ 690 0 R 695 0 R 696 0 R 697 0 R 698 0 R 699 0 R 700 0 R 701 0 R 702 0 R 703 0 R 704 0 R 705 0 R 706 0 R 707 0 R 708 0 R 709 0 R 710 0 R 741 0 R 711 0 R 712 0 R 713 0 R 714 0 R 715 0 R 716 0 R 717 0 R 718 0 R 719 0 R 720 0 R 721 0 R 722 0 R 723 0 R 724 0 R 725 0 R 726 0 R 727 0 R 728 0 R 729 0 R 730 0 R 731 0 R 732 0 R 742 0 R 733 0 R 743 0 R 734 0 R 744 0 R 735 0 R 745 0 R ] +/Annots [ 690 0 R 695 0 R 696 0 R 697 0 R 698 0 R 699 0 R 700 0 R 701 0 R 702 0 R 703 0 R 704 0 R 705 0 R 706 0 R 707 0 R 708 0 R 709 0 R 710 0 R 740 0 R 711 0 R 712 0 R 713 0 R 714 0 R 715 0 R 716 0 R 717 0 R 718 0 R 719 0 R 720 0 R 721 0 R 722 0 R 723 0 R 724 0 R 725 0 R 726 0 R 727 0 R 728 0 R 729 0 R 730 0 R 741 0 R 731 0 R 732 0 R 742 0 R 733 0 R 743 0 R 734 0 R 744 0 R ] >> % 690 0 obj << @@ -3418,7 +3396,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 691.101 289.396 701.949] +/Rect [113.843 690.813 289.396 701.661] /A << /S /GoTo /D (subsection.6.15) >> >> % 696 0 obj @@ -3426,7 +3404,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 679.007 386.92 689.855] +/Rect [113.843 678.431 386.92 689.279] /A << /S /GoTo /D (subsection.6.16) >> >> % 697 0 obj @@ -3434,7 +3412,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 666.913 366.405 677.761] +/Rect [113.843 666.049 366.405 676.897] /A << /S /GoTo /D (subsection.6.17) >> >> @@ -3442,28 +3420,49 @@ endstream endobj 759 0 obj << -/Length 3702 +/Length 4396 >> stream 0 g 0 G 0 g 0 G 0 0 1 rg 0 0 1 RG BT -/F8 9.9626 Tf 165.649 706.129 Td [(9.5)-1022(mm)]TJ +/F8 9.9626 Tf 165.649 706.129 Td [(9.4)-1022(mm)]TJ ET q 1 0 0 1 205.765 706.328 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 208.754 706.129 Td [(mat)]TJ +/F8 9.9626 Tf 208.754 706.129 Td [(arra)28(y)]TJ ET q -1 0 0 1 226.51 706.328 cm +1 0 0 1 232.1 706.328 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 229.498 706.129 Td [(write)-368(|)-367(W)83(rite)-368(a)-367(sparse)-368(matrix)-367(to)-368(a)-368(\014le)-367(in)-368(the)-367(Matrix-)]TJ -40.935 -11.955 Td [(Mark)28(et)-334(f)1(ormat)]TJ +/F8 9.9626 Tf 235.089 706.129 Td [(read)-346(|)-346(Read)-346(a)-347(dense)-346(arra)28(y)-346(from)-346(a)-346(\014le)-347(in)-346(the)-346(Matrix-)]TJ -46.526 -11.955 Td [(Mark)28(et)-334(f)1(ormat)]TJ +0 g 0 G + [-945(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ +0 g 0 G + [-584(137)]TJ +0 g 0 G +0 0 1 rg 0 0 1 RG + -22.914 -11.955 Td [(9.5)-1022(mm)]TJ +ET +q +1 0 0 1 205.765 682.418 cm +[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S +Q +BT +/F8 9.9626 Tf 208.754 682.219 Td [(mat)]TJ +ET +q +1 0 0 1 226.51 682.418 cm +[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S +Q +BT +/F8 9.9626 Tf 229.498 682.219 Td [(write)-368(|)-367(W)83(rite)-368(a)-367(sparse)-368(matrix)-367(to)-368(a)-368(\014le)-367(in)-368(the)-367(Matrix-)]TJ -40.935 -11.956 Td [(Mark)28(et)-334(f)1(ormat)]TJ 0 g 0 G [-945(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G @@ -3473,29 +3472,29 @@ BT -22.914 -11.955 Td [(9.6)-1022(mm)]TJ ET q -1 0 0 1 205.765 682.418 cm +1 0 0 1 205.765 658.507 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 208.754 682.219 Td [(arra)28(y)]TJ +/F8 9.9626 Tf 208.754 658.308 Td [(arra)28(y)]TJ ET q -1 0 0 1 232.1 682.418 cm +1 0 0 1 232.1 658.507 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 235.089 682.219 Td [(write)-297(|)-296(W)83(rite)-297(a)-296(dense)-297(arra)28(y)-297(from)-296(a)-297(\014le)-297(in)-296(the)-297(Matrix-)]TJ -46.526 -11.956 Td [(Mark)28(et)-334(f)1(ormat)]TJ +/F8 9.9626 Tf 235.089 658.308 Td [(write)-297(|)-296(W)83(rite)-297(a)-296(dense)-297(arra)28(y)-297(from)-296(a)-297(\014le)-297(in)-296(the)-297(Matrix-)]TJ -46.526 -11.955 Td [(Mark)28(et)-334(f)1(ormat)]TJ 0 g 0 G [-945(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-584(139)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -/F27 9.9626 Tf -37.858 -21.917 Td [(10)-350(Preconditioner)-383(routines)]TJ +/F27 9.9626 Tf -37.858 -21.918 Td [(10)-350(Preconditioner)-383(routines)]TJ 0 g 0 G [-19367(140)]TJ 0 0 1 rg 0 0 1 RG -/F8 9.9626 Tf 14.944 -11.956 Td [(10.1)-522(init)-333(|)-334(Initialize)-333(a)-333(preconditioner)]TJ +/F8 9.9626 Tf 14.944 -11.955 Td [(10.1)-522(init)-333(|)-334(Initialize)-333(a)-333(preconditioner)]TJ 0 g 0 G [-694(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G @@ -3516,7 +3515,7 @@ BT [-584(144)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - 0 -11.955 Td [(10.4)-522(descr)-334(|)-333(Prin)28(ts)-333(a)-334(description)-333(of)-333(curren)28(t)-334(preconditioner)]TJ + 0 -11.956 Td [(10.4)-522(descr)-334(|)-333(Prin)28(ts)-333(a)-334(description)-333(of)-333(curren)28(t)-334(preconditioner)]TJ 0 g 0 G [-705(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G @@ -3530,38 +3529,38 @@ BT [-583(146)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - 0 -11.956 Td [(10.6)-522(free)-334(|)-333(F)83(ree)-333(a)-333(preconditioner)]TJ + 0 -11.955 Td [(10.6)-522(free)-334(|)-333(F)83(ree)-333(a)-333(preconditioner)]TJ 0 g 0 G [-1008(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-583(147)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -/F27 9.9626 Tf -14.944 -21.917 Td [(11)-350(Iterativ)32(e)-384(M)1(etho)-32(ds)]TJ +/F27 9.9626 Tf -14.944 -21.918 Td [(11)-350(Iterativ)32(e)-384(M)1(etho)-32(ds)]TJ 0 g 0 G [-22176(148)]TJ 0 0 1 rg 0 0 1 RG -/F8 9.9626 Tf 14.944 -11.956 Td [(11.1)-522(psb)]TJ +/F8 9.9626 Tf 14.944 -11.955 Td [(11.1)-522(psb)]TJ ET q -1 0 0 1 204.16 542.941 cm +1 0 0 1 204.16 519.03 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 207.149 542.742 Td [(krylo)28(v)-333(|)-334(Krylo)28(v)-333(Metho)-28(ds)-333(Driv)28(e)-1(r)-333(Routine)]TJ +/F8 9.9626 Tf 207.149 518.831 Td [(krylo)28(v)-333(|)-334(Krylo)28(v)-333(Metho)-28(ds)-333(Driv)28(e)-1(r)-333(Routine)]TJ 0 g 0 G [-317(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-584(149)]TJ 0 g 0 G 0 g 0 G - 111.399 -452.304 Td [(iv)]TJ + 111.399 -428.393 Td [(iv)]TJ 0 g 0 G ET endstream endobj -775 0 obj +776 0 obj << /Length 8518 >> @@ -3617,7 +3616,7 @@ ET endstream endobj -795 0 obj +796 0 obj << /Length 5579 >> @@ -3664,20 +3663,20 @@ ET endstream endobj -791 0 obj +792 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./figures/psblas.pdf) /PTEX.PageNumber 1 -/PTEX.InfoDict 798 0 R +/PTEX.InfoDict 799 0 R /BBox [0 0 197 215] /Resources << /ProcSet [ /PDF /Text ] /ExtGState << -/R7 799 0 R ->>/Font << /R8 800 0 R>> +/R7 800 0 R +>>/Font << /R8 801 0 R>> >> /Length 898 /Filter /FlateDecode @@ -3698,7 +3697,7 @@ x «Ͻ'ƒÇ›ÇÇùaÚ>=|9Êh±Büuæ¹£$îËLËàq·–ÑÃÊŸ5×k^Þ½;>íN÷Ûi™ZŠ\V+9D£­8îNËLÓG™÷×»~0+¾’”àŠ'¢ˆ±íúmw>o÷;{·=ŸŽûEý—»a¥ÃѲîîÝâ8SË4Â%ÕÇ¥_¾œžNÛ#OαéƒùüÐ endstream endobj -802 0 obj +803 0 obj << /Filter /FlateDecode /Subtype /Type1C @@ -3718,7 +3717,7 @@ p IZ¹t4¤w!}^€gì½—ú€h9@±^è Ò…s2•=3B2H>ÉçynÞÌû7ŠC‰#ˆþhñÚï-whèÇGtBŒV²Õºø`uÞ1èFæ3ÑvðøçÓ÷à´ÛoÝ34\z"ž“,P&+š´®¿Ú»oB03¼å㣶xsÉÝä!FáŽ/†m'~¼êŒn?àßvaÝDëÑ÷ì+°¥¸5ïšôt0Ü ¶æ+ÉÔ·ÆsRz…t¥J–xFzëþƒöÁQîè`û¼/dŠº2›åž™j@7GÛú.º?Üwyc$O‘œÀI‘(S¥ME®ƒßŒô| Áõ^`‚2!-›’"VîIN™"Ì‚B-ÌÎe³/uV9:Î6:.Ç°ÿMɪH endstream endobj -808 0 obj +809 0 obj << /Length 8854 >> @@ -3767,7 +3766,7 @@ ET endstream endobj -824 0 obj +825 0 obj << /Length 5346 >> @@ -3844,20 +3843,20 @@ ET endstream endobj -821 0 obj +822 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./figures/points.pdf) /PTEX.PageNumber 1 -/PTEX.InfoDict 827 0 R +/PTEX.InfoDict 828 0 R /BBox [0 0 274 308] /Resources << /ProcSet [ /PDF /Text ] /ExtGState << -/R7 828 0 R ->>/Font << /R8 829 0 R>> +/R7 829 0 R +>>/Font << /R8 830 0 R>> >> /Length 1397 /Filter /FlateDecode @@ -3867,30 +3866,30 @@ x – 󣄠¹3ÊBü=®§«æ±bA‡HŒ}Ï©c·í²»?­é”ׄÿäïÍeùö]_?ü¾¤Ó©d êwßGüðaù´d"®òçæ²¾¾ä}ÍíëÕûe4­ß ,äýÔ×sÿ»º,_ýx÷Ç/w×·¯®~[¾»ZÞ.ø›Œ1¸ð™âuóâ¯ïÿ¼ûùúáoO*žþx/þÃõí½Î22Tø<ᜇd†&Âoî/×ïV˜âÿõèCê1V^õd¨æõãR ¬Û9ŸÎç¶^–ºµÓ¾ÍšÚýÝz¦zõ¯7‹!€S®ûj짔êJÚR¿–ðWZSöN•m˜´ ide«3çûfyÿõROÛú×|J_F¿~]~z2ò–}×òVÐÕämë¦Î€sQ<I<³¦uiüd¸r͵9.Ö¤¢ÆR’ÉÑãY~ОÐCÑÝ¥Ÿ}öçÙ^â<3LA ‰c‹YÒ¶®ôçY¯qž&mCÙØâÌû懣ç—Ñ#|H–_rƧšÇÒ³,wš0s>}yüÇ5ÒNóË p%U¤ –ðW@E’§$§•|¡pxõE`&ÆøåU ™¤ó«›%AÝIUÍ0Gš]ý‘&ûÖM’ î Jšx÷¬…T.ù)~¼C²8˜}~‚­ÛÍWÛ¢íÁvKÑö¶K,8ÛÍ—&†`[C*—ü¨ONÔÇs­ƒ ½m‚ê ò9؆Áu¶!×`{P9¦m‚êKI7oÛB*—ü¨O샹~ñ̳·Ç'­¡Á^ÝIaÏvRy!œzw'ó¤`Íx"0.Ѥb'…iÄù|ùÌs¼žP:-%X/[´^º“#Àa°há…dÞPÓY/)Z‡Ýqˆ&-VŠÖ½ON¬Çtnƒ®G±À¹ÍY–& é›Ë’וB¿Ìœ¤¡¹M…ÁnngäŽ%¤Ò#ØœÃÉÙÇ‚"d;’Àô)ùÃ(˜\X‹³Ž¥²£0}Z¡pø#`Ó†Sò‹%Hvt§Ð̧f£`ú`-Î+”ÐŽQ4ó9ƒ…Ç,x›O/,îf,z»âißn«ªÝìv«$½úæ-ÜŒå`?›“禩™|,ˆ7cïó™;Ìñº@!osõé]Š¦?ݲta0€yýÒ¥¤Zdy›«OïRÜ<%9­äƒ€[}拇ú6m8uõIPžþhǃf>m))…YÞæê“ Ò<%9­äƒ€[}ækçÿÜæ“WO’rõ= A} £ Ñ0'Ë 9‘S,irêÕ÷+\_ã­uâÝ¿›ÑÆE?æóé{¦ƒÙÇá'È‹ÎB#4_²$&†`[–’qq‘‘&/> Mõ5^_'†`[Bý˜OõºÖÁ–%©¡ ª/]07o[šqq ’&/M Íõ5^_'nÞ¶†4.ú1Ÿ6ØsýÜ¥%]Š!ƒCÞgVe@Ù–‹’…$)š5-ƒÃØ5}‡ä²?ÖLg+‡ |>{é>hO‘jøX5~,ê>–0àxÕ},1’š¬ác ”ø±ŠûX€5‹ûXb$3òø³ Ú…t¡í¡=Å>tpº8Õ‡’Ô$iÎ>´-ö¡Ç%ÀšTÔXJR#ÞgL¼í“-J/0®jãȶw.Þâªick£Z,”Ô¤š^”Ñk·ì«éUÝ ‹¯WjÇ‚µÛçƒ.ÁºUE³zÉgýãPˆ,é"›Ñe±ûÌ‹:t˜!*%~ Ö *«QÊÒ@emPMÓ1:¾Þ’àX¼÷(˜®4æ ¤Nƒ¾]þÎJ¦' endstream endobj -746 0 obj +745 0 obj << /Type /ObjStm /N 100 /First 919 -/Length 15220 +/Length 15247 >> stream -698 0 699 153 700 306 701 458 702 611 703 763 704 916 705 1068 706 1221 707 1374 -708 1527 709 1672 710 1824 741 1976 711 2127 712 2279 713 2430 714 2582 715 2733 716 2884 -717 3035 718 3187 719 3340 720 3492 721 3644 722 3796 723 3949 724 4101 725 4253 726 4406 -727 4552 728 4703 729 4855 730 5007 731 5159 732 5305 742 5457 733 5607 743 5759 734 5910 -744 6062 735 6212 745 6364 740 6514 737 6570 758 6649 736 6879 761 7031 747 7183 762 7335 -748 7487 749 7634 750 7787 751 7939 752 8092 753 8244 754 8396 755 8549 756 8695 760 8848 -757 8905 774 8984 763 9190 764 9339 765 9490 766 9642 767 9796 768 9947 769 10096 770 10245 -771 10393 772 10541 7 10689 773 10743 794 10835 798 10985 799 11226 800 11268 801 11654 788 11954 -789 12099 790 12247 11 12394 797 12450 793 12505 807 12625 792 12775 804 12921 805 13070 809 13218 -15 13274 815 13329 817 13386 806 13443 823 13638 827 13780 828 13894 829 13936 819 14005 820 14153 +698 0 699 153 700 306 701 459 702 611 703 764 704 917 705 1069 706 1222 707 1374 +708 1527 709 1673 710 1825 740 1977 711 2128 712 2280 713 2432 714 2584 715 2735 716 2886 +717 3037 718 3189 719 3341 720 3493 721 3645 722 3798 723 3951 724 4103 725 4256 726 4409 +727 4555 728 4707 729 4859 730 5011 741 5163 731 5314 732 5460 742 5611 733 5762 743 5914 +734 6065 744 6217 739 6367 736 6423 758 6502 735 6748 761 6900 746 7052 762 7204 747 7356 +763 7508 748 7660 749 7807 750 7960 751 8112 752 8265 753 8418 754 8570 755 8723 756 8870 +760 9023 757 9080 775 9159 764 9365 765 9514 766 9665 767 9817 768 9971 769 10122 770 10271 +771 10420 772 10568 773 10716 7 10864 774 10918 795 11010 799 11160 800 11401 801 11443 802 11829 +789 12129 790 12274 791 12422 11 12569 798 12625 794 12680 808 12800 793 12950 805 13096 806 13245 +810 13393 15 13449 816 13504 818 13561 807 13618 824 13813 828 13955 829 14069 830 14111 820 14180 % 698 0 obj << /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 654.819 367.083 665.667] +/Rect [113.843 653.667 367.083 664.515] /A << /S /GoTo /D (subsection.6.18) >> >> % 699 0 obj @@ -3898,7 +3897,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 642.725 211.621 653.573] +/Rect [113.843 641.285 211.621 652.133] /A << /S /GoTo /D (subsection.6.19) >> >> % 700 0 obj @@ -3906,7 +3905,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 630.63 228.447 641.479] +/Rect [113.843 628.903 228.447 639.751] /A << /S /GoTo /D (subsection.6.20) >> >> % 701 0 obj @@ -3914,7 +3913,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 618.536 204.426 629.384] +/Rect [113.843 616.52 204.426 627.369] /A << /S /GoTo /D (subsection.6.21) >> >> % 702 0 obj @@ -3922,7 +3921,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 606.442 221.252 617.29] +/Rect [113.843 604.138 221.252 614.987] /A << /S /GoTo /D (subsection.6.22) >> >> % 703 0 obj @@ -3930,7 +3929,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 594.348 379.049 605.196] +/Rect [113.843 591.756 379.049 602.604] /A << /S /GoTo /D (subsection.6.23) >> >> % 704 0 obj @@ -3938,7 +3937,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 582.254 358.57 593.102] +/Rect [113.843 579.374 358.57 590.222] /A << /S /GoTo /D (subsection.6.24) >> >> % 705 0 obj @@ -3946,7 +3945,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 569.606 374.261 581.561] +/Rect [113.843 566.438 374.261 578.394] /A << /S /GoTo /D (subsection.6.25) >> >> % 706 0 obj @@ -3954,7 +3953,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 558.065 284.166 568.913] +/Rect [113.843 554.61 284.166 565.458] /A << /S /GoTo /D (subsection.6.26) >> >> % 707 0 obj @@ -3962,7 +3961,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 545.971 222.962 556.819] +/Rect [113.843 542.228 222.962 553.076] /A << /S /GoTo /D (subsection.6.27) >> >> % 708 0 obj @@ -3970,7 +3969,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [98.899 525.759 264.868 534.67] +/Rect [98.899 521.535 264.868 530.446] /A << /S /GoTo /D (section.7) >> >> % 709 0 obj @@ -3978,7 +3977,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 511.727 365.417 522.576] +/Rect [113.843 507.216 365.417 518.064] /A << /S /GoTo /D (subsection.7.1) >> >> % 710 0 obj @@ -3986,15 +3985,15 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 499.633 444.603 510.481] +/Rect [113.843 494.834 444.603 505.682] /A << /S /GoTo /D (subsection.7.2) >> >> -% 741 0 obj +% 740 0 obj << /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [98.899 489.615 160.612 498.028] +/Rect [98.899 484.816 160.612 493.229] /A << /S /GoTo /D (subsection.7.2) >> >> % 711 0 obj @@ -4002,7 +4001,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 475.584 367.188 486.432] +/Rect [113.843 470.497 367.188 481.345] /A << /S /GoTo /D (subsection.7.3) >> >> % 712 0 obj @@ -4010,7 +4009,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 463.49 358.186 474.338] +/Rect [113.843 458.114 358.186 468.963] /A << /S /GoTo /D (subsection.7.4) >> >> % 713 0 obj @@ -4018,7 +4017,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 451.395 309.784 462.244] +/Rect [113.843 445.732 309.784 456.581] /A << /S /GoTo /D (subsection.7.5) >> >> % 714 0 obj @@ -4026,7 +4025,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 439.301 277.164 450.15] +/Rect [113.843 433.35 277.164 444.198] /A << /S /GoTo /D (subsection.7.6) >> >> % 715 0 obj @@ -4034,7 +4033,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 427.207 389.41 438.055] +/Rect [113.843 420.968 389.41 431.816] /A << /S /GoTo /D (subsection.7.7) >> >> % 716 0 obj @@ -4042,7 +4041,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 415.113 289.95 425.961] +/Rect [113.843 408.586 289.95 419.434] /A << /S /GoTo /D (subsection.7.8) >> >> % 717 0 obj @@ -4050,7 +4049,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 403.019 263.327 413.867] +/Rect [113.843 396.204 263.327 407.052] /A << /S /GoTo /D (subsection.7.9) >> >> % 718 0 obj @@ -4058,7 +4057,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 390.925 241.645 401.773] +/Rect [113.843 383.822 241.645 394.67] /A << /S /GoTo /D (subsection.7.10) >> >> % 719 0 obj @@ -4066,7 +4065,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 378.83 267.824 389.679] +/Rect [113.843 371.44 267.824 382.288] /A << /S /GoTo /D (subsection.7.11) >> >> % 720 0 obj @@ -4074,7 +4073,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 366.736 263.95 377.584] +/Rect [113.843 359.057 263.95 369.906] /A << /S /GoTo /D (subsection.7.12) >> >> % 721 0 obj @@ -4082,7 +4081,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 354.642 332.914 365.49] +/Rect [113.843 346.675 332.914 357.523] /A << /S /GoTo /D (subsection.7.13) >> >> % 722 0 obj @@ -4090,7 +4089,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 342.548 331.253 353.396] +/Rect [113.843 334.293 331.253 345.141] /A << /S /GoTo /D (subsection.7.14) >> >> % 723 0 obj @@ -4098,7 +4097,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 330.454 304.16 341.302] +/Rect [113.843 321.911 304.16 332.759] /A << /S /GoTo /D (subsection.7.15) >> >> % 724 0 obj @@ -4106,7 +4105,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 318.36 232.664 329.208] +/Rect [113.843 309.529 232.664 320.377] /A << /S /GoTo /D (subsection.7.16) >> >> % 725 0 obj @@ -4114,7 +4113,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 306.265 243.014 317.114] +/Rect [113.843 297.147 243.014 307.995] /A << /S /GoTo /D (subsection.7.17) >> >> % 726 0 obj @@ -4122,7 +4121,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [98.899 284.116 190.188 294.964] +/Rect [98.899 274.517 190.188 285.365] /A << /S /GoTo /D (section.8) >> >> % 727 0 obj @@ -4130,7 +4129,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 272.022 190.102 282.87] +/Rect [113.843 262.135 387.611 272.983] /A << /S /GoTo /D (subsection.8.1) >> >> % 728 0 obj @@ -4138,7 +4137,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 259.927 178.451 270.776] +/Rect [113.843 249.753 418.828 260.601] /A << /S /GoTo /D (subsection.8.2) >> >> % 729 0 obj @@ -4146,7 +4145,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 247.833 225.043 258.681] +/Rect [113.843 237.371 397.563 248.219] /A << /S /GoTo /D (subsection.8.3) >> >> % 730 0 obj @@ -4154,7 +4153,15 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 235.739 211.953 246.587] +/Rect [113.843 224.989 444.603 235.837] +/A << /S /GoTo /D (subsection.8.4) >> +>> +% 741 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [98.899 214.971 179.154 223.882] /A << /S /GoTo /D (subsection.8.4) >> >> % 731 0 obj @@ -4162,7 +4169,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [98.899 215.527 156.061 224.438] +/Rect [98.899 192.341 156.061 201.252] /A << /S /GoTo /D (section.9) >> >> % 732 0 obj @@ -4170,7 +4177,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 201.495 444.603 212.344] +/Rect [113.843 178.022 444.603 188.87] /A << /S /GoTo /D (subsection.9.1) >> >> % 742 0 obj @@ -4178,7 +4185,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [98.899 189.54 201.182 200.388] +/Rect [98.899 166.067 201.182 176.915] /A << /S /GoTo /D (subsection.9.1) >> >> % 733 0 obj @@ -4186,7 +4193,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 177.446 444.603 188.294] +/Rect [113.843 153.685 444.603 164.533] /A << /S /GoTo /D (subsection.9.2) >> >> % 743 0 obj @@ -4194,7 +4201,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [98.899 167.428 167.835 176.339] +/Rect [98.899 143.667 167.835 152.578] /A << /S /GoTo /D (subsection.9.2) >> >> % 734 0 obj @@ -4202,7 +4209,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 153.397 444.603 164.245] +/Rect [113.843 129.347 444.603 140.196] /A << /S /GoTo /D (subsection.9.3) >> >> % 744 0 obj @@ -4210,30 +4217,14 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [98.899 143.379 202.455 152.29] +/Rect [98.899 119.329 202.455 128.24] /A << /S /GoTo /D (subsection.9.3) >> >> -% 735 0 obj +% 739 0 obj << -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 129.347 444.603 140.196] -/A << /S /GoTo /D (subsection.9.4) >> +/D [737 0 R /XYZ 98.895 753.953 null] >> -% 745 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [98.899 119.329 202.455 128.24] -/A << /S /GoTo /D (subsection.9.4) >> ->> -% 740 0 obj -<< -/D [738 0 R /XYZ 98.895 753.953 null] ->> -% 737 0 obj +% 736 0 obj << /Font << /F8 585 0 R /F27 584 0 R >> /ProcSet [ /PDF /Text ] @@ -4245,15 +4236,15 @@ stream /Resources 757 0 R /MediaBox [0 0 595.276 841.89] /Parent 586 0 R -/Annots [ 736 0 R 761 0 R 747 0 R 762 0 R 748 0 R 749 0 R 750 0 R 751 0 R 752 0 R 753 0 R 754 0 R 755 0 R 756 0 R ] +/Annots [ 735 0 R 761 0 R 746 0 R 762 0 R 747 0 R 763 0 R 748 0 R 749 0 R 750 0 R 751 0 R 752 0 R 753 0 R 754 0 R 755 0 R 756 0 R ] >> -% 736 0 obj +% 735 0 obj << /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 703.195 495.412 714.044] -/A << /S /GoTo /D (subsection.9.5) >> +/A << /S /GoTo /D (subsection.9.4) >> >> % 761 0 obj << @@ -4261,15 +4252,15 @@ stream /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] /Rect [149.709 693.177 253.265 702.088] -/A << /S /GoTo /D (subsection.9.5) >> +/A << /S /GoTo /D (subsection.9.4) >> >> -% 747 0 obj +% 746 0 obj << /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 679.285 495.412 690.133] -/A << /S /GoTo /D (subsection.9.6) >> +/A << /S /GoTo /D (subsection.9.5) >> >> % 762 0 obj << @@ -4277,6 +4268,22 @@ stream /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] /Rect [149.709 669.267 253.265 678.178] +/A << /S /GoTo /D (subsection.9.5) >> +>> +% 747 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [164.653 655.375 495.412 666.223] +/A << /S /GoTo /D (subsection.9.6) >> +>> +% 763 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [149.709 645.357 253.265 654.268] /A << /S /GoTo /D (subsection.9.6) >> >> % 748 0 obj @@ -4284,7 +4291,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [149.709 647.349 285.284 656.26] +/Rect [149.709 623.439 285.284 632.35] /A << /S /GoTo /D (section.10) >> >> % 749 0 obj @@ -4292,7 +4299,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [164.653 633.457 333.243 644.305] +/Rect [164.653 609.547 333.243 620.395] /A << /S /GoTo /D (subsection.10.1) >> >> % 750 0 obj @@ -4300,7 +4307,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [164.653 621.502 330.116 632.35] +/Rect [164.653 597.591 330.116 608.44] /A << /S /GoTo /D (subsection.10.2) >> >> % 751 0 obj @@ -4308,7 +4315,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [164.653 609.547 379.901 620.395] +/Rect [164.653 585.636 379.901 596.484] /A << /S /GoTo /D (subsection.10.3) >> >> % 752 0 obj @@ -4316,7 +4323,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [164.653 597.591 426.117 608.44] +/Rect [164.653 573.681 426.117 584.529] /A << /S /GoTo /D (subsection.10.4) >> >> % 753 0 obj @@ -4324,7 +4331,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [164.653 585.636 351.01 596.484] +/Rect [164.653 561.726 351.01 572.574] /A << /S /GoTo /D (subsection.10.5) >> >> % 754 0 obj @@ -4332,7 +4339,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [164.653 573.681 314.618 584.529] +/Rect [164.653 549.771 314.618 560.619] /A << /S /GoTo /D (subsection.10.6) >> >> % 755 0 obj @@ -4340,7 +4347,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [149.709 553.7 257.299 562.611] +/Rect [149.709 529.79 257.299 538.701] /A << /S /GoTo /D (section.11) >> >> % 756 0 obj @@ -4348,7 +4355,7 @@ stream /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] -/Rect [164.653 539.808 391.237 550.656] +/Rect [164.653 515.898 391.237 526.746] /A << /S /GoTo /D (subsection.11.1) >> >> % 760 0 obj @@ -4360,16 +4367,16 @@ stream /Font << /F8 585 0 R /F27 584 0 R >> /ProcSet [ /PDF /Text ] >> -% 774 0 obj +% 775 0 obj << /Type /Page -/Contents 775 0 R -/Resources 773 0 R +/Contents 776 0 R +/Resources 774 0 R /MediaBox [0 0 595.276 841.89] -/Parent 777 0 R -/Annots [ 763 0 R 764 0 R 765 0 R 766 0 R 767 0 R 768 0 R 769 0 R 770 0 R 771 0 R 772 0 R ] +/Parent 778 0 R +/Annots [ 764 0 R 765 0 R 766 0 R 767 0 R 768 0 R 769 0 R 770 0 R 771 0 R 772 0 R 773 0 R ] >> -% 763 0 obj +% 764 0 obj << /Type /Annot /Subtype /Link @@ -4377,7 +4384,7 @@ stream /Rect [408.982 586.91 420.937 595.323] /A << /S /GoTo /D (cite.metcalf) >> >> -% 764 0 obj +% 765 0 obj << /Type /Annot /Subtype /Link @@ -4385,7 +4392,7 @@ stream /Rect [277.684 514.913 289.639 523.326] /A << /S /GoTo /D (cite.Sparse03) >> >> -% 765 0 obj +% 766 0 obj << /Type /Annot /Subtype /Link @@ -4393,7 +4400,7 @@ stream /Rect [265.763 502.958 272.737 511.371] /A << /S /GoTo /D (cite.DesPat:11) >> >> -% 766 0 obj +% 767 0 obj << /Type /Annot /Subtype /Link @@ -4401,7 +4408,7 @@ stream /Rect [276.283 502.958 288.238 511.371] /A << /S /GoTo /D (cite.RouXiaXu:11) >> >> -% 767 0 obj +% 768 0 obj << /Type /Annot /Subtype /Link @@ -4409,7 +4416,7 @@ stream /Rect [210.166 442.916 222.121 451.329] /A << /S /GoTo /D (cite.machiels) >> >> -% 768 0 obj +% 769 0 obj << /Type /Annot /Subtype /Link @@ -4417,7 +4424,7 @@ stream /Rect [241.566 370.919 248.54 379.332] /A << /S /GoTo /D (cite.sblas97) >> >> -% 769 0 obj +% 770 0 obj << /Type /Annot /Subtype /Link @@ -4425,7 +4432,7 @@ stream /Rect [252.056 370.919 259.03 379.332] /A << /S /GoTo /D (cite.sblas02) >> >> -% 770 0 obj +% 771 0 obj << /Type /Annot /Subtype /Link @@ -4433,7 +4440,7 @@ stream /Rect [227.473 358.964 239.428 367.377] /A << /S /GoTo /D (cite.BLAS1) >> >> -% 771 0 obj +% 772 0 obj << /Type /Annot /Subtype /Link @@ -4441,7 +4448,7 @@ stream /Rect [243.524 358.964 250.498 367.377] /A << /S /GoTo /D (cite.BLAS2) >> >> -% 772 0 obj +% 773 0 obj << /Type /Annot /Subtype /Link @@ -4451,23 +4458,23 @@ stream >> % 7 0 obj << -/D [774 0 R /XYZ 99.895 716.092 null] +/D [775 0 R /XYZ 99.895 716.092 null] >> -% 773 0 obj +% 774 0 obj << -/Font << /F16 582 0 R /F8 585 0 R /F17 776 0 R >> +/Font << /F16 582 0 R /F8 585 0 R /F17 777 0 R >> /ProcSet [ /PDF /Text ] >> -% 794 0 obj +% 795 0 obj << /Type /Page -/Contents 795 0 R -/Resources 793 0 R +/Contents 796 0 R +/Resources 794 0 R /MediaBox [0 0 595.276 841.89] -/Parent 777 0 R -/Annots [ 788 0 R 789 0 R 790 0 R ] +/Parent 778 0 R +/Annots [ 789 0 R 790 0 R 791 0 R ] >> -% 798 0 obj +% 799 0 obj << /Producer (GPL Ghostscript 9.04) /CreationDate (D:20111215145523+01'00') @@ -4476,15 +4483,15 @@ stream /Creator (fig2dev Version 3.2 Patchlevel 5d) /Author (sfilippo@donald \(Salvatore Filippone\)) >> -% 799 0 obj +% 800 0 obj << /Type /ExtGState /OPM 1 >> -% 800 0 obj +% 801 0 obj << /BaseFont /JEJNJE+Times-Roman -/FontDescriptor 801 0 R +/FontDescriptor 802 0 R /Type /Font /FirstChar 32 /LastChar 116 @@ -4492,7 +4499,7 @@ stream /Encoding /WinAnsiEncoding /Subtype /Type1 >> -% 801 0 obj +% 802 0 obj << /Type /FontDescriptor /FontName /JEJNJE+Times-Roman @@ -4506,9 +4513,9 @@ stream /MissingWidth 500 /XHeight 460 /CharSet (/A/B/F/I/L/M/P/S/a/c/e/f/g/i/l/n/o/p/r/s/space/t/three/two/zero) -/FontFile3 802 0 R +/FontFile3 803 0 R >> -% 788 0 obj +% 789 0 obj << /Type /Annot /Subtype /Link @@ -4516,7 +4523,7 @@ stream /Rect [310.543 541.042 317.517 551.89] /A << /S /GoTo /D (figure.1) >> >> -% 789 0 obj +% 790 0 obj << /Type /Annot /Subtype /Link @@ -4524,7 +4531,7 @@ stream /Rect [446.018 471.248 452.992 479.661] /A << /S /GoTo /D (cite.BLACS) >> >> -% 790 0 obj +% 791 0 obj << /Type /Annot /Subtype /Link @@ -4534,28 +4541,28 @@ stream >> % 11 0 obj << -/D [794 0 R /XYZ 150.705 677.433 null] +/D [795 0 R /XYZ 150.705 677.433 null] >> -% 797 0 obj +% 798 0 obj << -/D [794 0 R /XYZ 258.703 263.3 null] +/D [795 0 R /XYZ 258.703 263.3 null] >> -% 793 0 obj +% 794 0 obj << -/Font << /F8 585 0 R /F16 582 0 R /F11 796 0 R >> -/XObject << /Im1 791 0 R >> +/Font << /F8 585 0 R /F16 582 0 R /F11 797 0 R >> +/XObject << /Im1 792 0 R >> /ProcSet [ /PDF /Text ] >> -% 807 0 obj +% 808 0 obj << /Type /Page -/Contents 808 0 R -/Resources 806 0 R +/Contents 809 0 R +/Resources 807 0 R /MediaBox [0 0 595.276 841.89] -/Parent 777 0 R -/Annots [ 792 0 R 804 0 R 805 0 R ] +/Parent 778 0 R +/Annots [ 793 0 R 805 0 R 806 0 R ] >> -% 792 0 obj +% 793 0 obj << /Type /Annot /Subtype /Link @@ -4563,7 +4570,7 @@ stream /Rect [219.5 609.491 231.455 617.904] /A << /S /GoTo /D (cite.METIS) >> >> -% 804 0 obj +% 805 0 obj << /Type /Annot /Subtype /Link @@ -4571,7 +4578,7 @@ stream /Rect [210.854 546.467 217.316 558.506] /A << /S /GoTo /D (Hfootnote.1) >> >> -% 805 0 obj +% 806 0 obj << /Type /Annot /Subtype /Link @@ -4579,54 +4586,54 @@ stream /Rect [155.908 188.124 162.37 200.163] /A << /S /GoTo /D (Hfootnote.2) >> >> -% 809 0 obj +% 810 0 obj << -/D [807 0 R /XYZ 98.895 753.953 null] +/D [808 0 R /XYZ 98.895 753.953 null] >> % 15 0 obj << -/D [807 0 R /XYZ 99.895 515.919 null] +/D [808 0 R /XYZ 99.895 515.919 null] >> -% 815 0 obj +% 816 0 obj << -/D [807 0 R /XYZ 115.138 167.688 null] +/D [808 0 R /XYZ 115.138 167.688 null] >> -% 817 0 obj +% 818 0 obj << -/D [807 0 R /XYZ 115.138 158.184 null] +/D [808 0 R /XYZ 115.138 158.184 null] >> -% 806 0 obj +% 807 0 obj << -/Font << /F8 585 0 R /F17 776 0 R /F30 810 0 R /F7 811 0 R /F16 582 0 R /F11 796 0 R /F10 812 0 R /F14 813 0 R /F27 584 0 R /F32 814 0 R /F31 816 0 R >> +/Font << /F8 585 0 R /F17 777 0 R /F30 811 0 R /F7 812 0 R /F16 582 0 R /F11 797 0 R /F10 813 0 R /F14 814 0 R /F27 584 0 R /F32 815 0 R /F31 817 0 R >> /ProcSet [ /PDF /Text ] >> -% 823 0 obj +% 824 0 obj << /Type /Page -/Contents 824 0 R -/Resources 822 0 R +/Contents 825 0 R +/Resources 823 0 R /MediaBox [0 0 595.276 841.89] -/Parent 777 0 R -/Annots [ 819 0 R 820 0 R ] +/Parent 778 0 R +/Annots [ 820 0 R 821 0 R ] >> -% 827 0 obj +% 828 0 obj << /Producer (ESP Ghostscript 815.03) /CreationDate (D:20070123225315) /ModDate (D:20070123225315) >> -% 828 0 obj +% 829 0 obj << /Type /ExtGState /OPM 1 >> -% 829 0 obj +% 830 0 obj << /BaseFont /Times-Roman /Type /Font /Subtype /Type1 >> -% 819 0 obj +% 820 0 obj << /Type /Annot /Subtype /Link @@ -4634,18 +4641,10 @@ stream /Rect [294.665 637.885 301.639 646.297] /A << /S /GoTo /D (cite.2007c) >> >> -% 820 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[0 1 0] -/Rect [305.735 637.885 312.709 646.297] -/A << /S /GoTo /D (cite.2007d) >> ->> endstream endobj -837 0 obj +838 0 obj << /Length 5462 >> @@ -4735,7 +4734,7 @@ ET endstream endobj -842 0 obj +843 0 obj << /Length 8659 >> @@ -4783,7 +4782,7 @@ ET endstream endobj -856 0 obj +857 0 obj << /Length 7719 >> @@ -4877,7 +4876,7 @@ ET endstream endobj -877 0 obj +878 0 obj << /Length 7473 >> @@ -4933,7 +4932,7 @@ ET endstream endobj -888 0 obj +889 0 obj << /Length 8464 >> @@ -5073,7 +5072,7 @@ ET endstream endobj -896 0 obj +897 0 obj << /Length 6827 >> @@ -5200,7 +5199,7 @@ ET endstream endobj -907 0 obj +908 0 obj << /Length 5178 >> @@ -5311,7 +5310,7 @@ ET endstream endobj -922 0 obj +923 0 obj << /Length 5236 >> @@ -5440,7 +5439,7 @@ ET endstream endobj -926 0 obj +927 0 obj << /Length 4435 >> @@ -5558,7 +5557,538 @@ ET endstream endobj -931 0 obj +832 0 obj +<< +/Type /ObjStm +/N 100 +/First 875 +/Length 9119 +>> +stream +821 0 826 148 827 205 19 262 823 318 837 477 834 619 835 765 839 912 836 968 +842 1073 844 1187 23 1244 846 1300 847 1357 848 1414 849 1470 850 1527 851 1583 852 1638 +853 1695 841 1752 856 1882 840 2016 858 2164 859 2220 860 2276 861 2332 862 2387 863 2443 +864 2499 865 2555 866 2611 867 2667 868 2723 869 2779 870 2835 871 2891 872 2947 855 3004 +877 3134 854 3276 875 3428 879 3575 27 3632 880 3688 881 3745 882 3802 883 3859 884 3916 +885 3973 31 4030 876 4086 888 4229 886 4363 890 4510 35 4566 39 4621 891 4676 887 4733 +896 4851 892 5001 893 5148 894 5300 898 5452 899 5509 900 5566 901 5623 902 5680 903 5737 +895 5794 907 5886 904 6028 905 6180 909 6332 910 6388 911 6444 912 6500 913 6555 914 6611 +915 6667 916 6723 917 6779 918 6835 906 6892 922 6984 919 7126 920 7272 924 7418 43 7475 +47 7531 51 7587 55 7643 921 7699 926 7817 928 7931 59 7987 63 8042 67 8097 925 8152 +% 821 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[0 1 0] +/Rect [305.735 637.885 312.709 646.297] +/A << /S /GoTo /D (cite.2007d) >> +>> +% 826 0 obj +<< +/D [824 0 R /XYZ 149.705 753.953 null] +>> +% 827 0 obj +<< +/D [824 0 R /XYZ 303.562 347.015 null] +>> +% 19 0 obj +<< +/D [824 0 R /XYZ 150.705 272.271 null] +>> +% 823 0 obj +<< +/Font << /F27 584 0 R /F8 585 0 R /F14 814 0 R /F11 797 0 R /F10 813 0 R /F16 582 0 R >> +/XObject << /Im2 822 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 837 0 obj +<< +/Type /Page +/Contents 838 0 R +/Resources 836 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 778 0 R +/Annots [ 834 0 R 835 0 R ] +>> +% 834 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [406.358 354.515 413.331 366.47] +/A << /S /GoTo /D (section.3) >> +>> +% 835 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [173.863 318.352 180.837 330.307] +/A << /S /GoTo /D (section.6) >> +>> +% 839 0 obj +<< +/D [837 0 R /XYZ 98.895 753.953 null] +>> +% 836 0 obj +<< +/Font << /F27 584 0 R /F8 585 0 R /F14 814 0 R /F30 811 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 842 0 obj +<< +/Type /Page +/Contents 843 0 R +/Resources 841 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 778 0 R +>> +% 844 0 obj +<< +/D [842 0 R /XYZ 149.705 753.953 null] +>> +% 23 0 obj +<< +/D [842 0 R /XYZ 150.705 716.092 null] +>> +% 846 0 obj +<< +/D [842 0 R /XYZ 150.705 284.758 null] +>> +% 847 0 obj +<< +/D [842 0 R /XYZ 150.705 263.953 null] +>> +% 848 0 obj +<< +/D [842 0 R /XYZ 150.705 242.87 null] +>> +% 849 0 obj +<< +/D [842 0 R /XYZ 150.705 221.788 null] +>> +% 850 0 obj +<< +/D [842 0 R /XYZ 150.705 188.75 null] +>> +% 851 0 obj +<< +/D [842 0 R /XYZ 150.705 167.6 null] +>> +% 852 0 obj +<< +/D [842 0 R /XYZ 150.705 148.591 null] +>> +% 853 0 obj +<< +/D [842 0 R /XYZ 150.705 132.072 null] +>> +% 841 0 obj +<< +/Font << /F16 582 0 R /F8 585 0 R /F11 797 0 R /F30 811 0 R /F9 845 0 R /F17 777 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 856 0 obj +<< +/Type /Page +/Contents 857 0 R +/Resources 855 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 874 0 R +/Annots [ 840 0 R ] +>> +% 840 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [176.109 690.964 182.571 703.28] +/A << /S /GoTo /D (Hfootnote.3) >> +>> +% 858 0 obj +<< +/D [856 0 R /XYZ 98.895 753.953 null] +>> +% 859 0 obj +<< +/D [856 0 R /XYZ 99.895 716.092 null] +>> +% 860 0 obj +<< +/D [856 0 R /XYZ 99.895 686.739 null] +>> +% 861 0 obj +<< +/D [856 0 R /XYZ 99.895 618.93 null] +>> +% 862 0 obj +<< +/D [856 0 R /XYZ 99.895 596.257 null] +>> +% 863 0 obj +<< +/D [856 0 R /XYZ 99.895 573.861 null] +>> +% 864 0 obj +<< +/D [856 0 R /XYZ 99.895 539.509 null] +>> +% 865 0 obj +<< +/D [856 0 R /XYZ 99.895 517.113 null] +>> +% 866 0 obj +<< +/D [856 0 R /XYZ 99.895 494.716 null] +>> +% 867 0 obj +<< +/D [856 0 R /XYZ 99.895 469.986 null] +>> +% 868 0 obj +<< +/D [856 0 R /XYZ 99.895 440.855 null] +>> +% 869 0 obj +<< +/D [856 0 R /XYZ 99.895 411.448 null] +>> +% 870 0 obj +<< +/D [856 0 R /XYZ 99.895 393.995 null] +>> +% 871 0 obj +<< +/D [856 0 R /XYZ 99.895 376.819 null] +>> +% 872 0 obj +<< +/D [856 0 R /XYZ 115.138 139.255 null] +>> +% 855 0 obj +<< +/Font << /F8 585 0 R /F30 811 0 R /F7 812 0 R /F32 815 0 R /F31 817 0 R /F45 873 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 877 0 obj +<< +/Type /Page +/Contents 878 0 R +/Resources 876 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 874 0 R +/Annots [ 854 0 R 875 0 R ] +>> +% 854 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [269.731 674.788 284.454 683.699] +/A << /S /GoTo /D (subsection.2.3) >> +>> +% 875 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [169.998 271.903 176.972 282.751] +/A << /S /GoTo /D (section.3) >> +>> +% 879 0 obj +<< +/D [877 0 R /XYZ 149.705 753.953 null] +>> +% 27 0 obj +<< +/D [877 0 R /XYZ 150.705 716.092 null] +>> +% 880 0 obj +<< +/D [877 0 R /XYZ 150.705 671.799 null] +>> +% 881 0 obj +<< +/D [877 0 R /XYZ 150.705 649.383 null] +>> +% 882 0 obj +<< +/D [877 0 R /XYZ 150.705 576.158 null] +>> +% 883 0 obj +<< +/D [877 0 R /XYZ 150.705 530.385 null] +>> +% 884 0 obj +<< +/D [877 0 R /XYZ 150.705 497.951 null] +>> +% 885 0 obj +<< +/D [877 0 R /XYZ 150.705 478.303 null] +>> +% 31 0 obj +<< +/D [877 0 R /XYZ 150.705 424.511 null] +>> +% 876 0 obj +<< +/Font << /F27 584 0 R /F8 585 0 R /F11 797 0 R /F9 845 0 R /F30 811 0 R /F16 582 0 R /F17 777 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 888 0 obj +<< +/Type /Page +/Contents 889 0 R +/Resources 887 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 874 0 R +/Annots [ 886 0 R ] +>> +% 886 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [269.318 174.287 276.292 185.135] +/A << /S /GoTo /D (section.6) >> +>> +% 890 0 obj +<< +/D [888 0 R /XYZ 98.895 753.953 null] +>> +% 35 0 obj +<< +/D [888 0 R /XYZ 99.895 716.092 null] +>> +% 39 0 obj +<< +/D [888 0 R /XYZ 99.895 280.417 null] +>> +% 891 0 obj +<< +/D [888 0 R /XYZ 342.427 237.273 null] +>> +% 887 0 obj +<< +/Font << /F16 582 0 R /F8 585 0 R /F30 811 0 R /F27 584 0 R /F14 814 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 896 0 obj +<< +/Type /Page +/Contents 897 0 R +/Resources 895 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 874 0 R +/Annots [ 892 0 R 893 0 R 894 0 R ] +>> +% 892 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [452.103 399.657 459.077 411.612] +/A << /S /GoTo /D (section.6) >> +>> +% 893 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [356.323 194.074 371.046 204.923] +/A << /S /GoTo /D (subsection.3.3) >> +>> +% 894 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [356.323 149.756 371.046 160.604] +/A << /S /GoTo /D (subsection.3.3) >> +>> +% 898 0 obj +<< +/D [896 0 R /XYZ 149.705 753.953 null] +>> +% 899 0 obj +<< +/D [896 0 R /XYZ 150.705 294.274 null] +>> +% 900 0 obj +<< +/D [896 0 R /XYZ 150.705 278.093 null] +>> +% 901 0 obj +<< +/D [896 0 R /XYZ 150.705 261.911 null] +>> +% 902 0 obj +<< +/D [896 0 R /XYZ 150.705 245.729 null] +>> +% 903 0 obj +<< +/D [896 0 R /XYZ 150.705 229.547 null] +>> +% 895 0 obj +<< +/Font << /F14 814 0 R /F8 585 0 R /F27 584 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 907 0 obj +<< +/Type /Page +/Contents 908 0 R +/Resources 906 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 874 0 R +/Annots [ 904 0 R 905 0 R ] +>> +% 904 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [305.513 611.433 320.236 622.281] +/A << /S /GoTo /D (subsection.3.3) >> +>> +% 905 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [305.513 564.905 320.236 575.753] +/A << /S /GoTo /D (subsection.3.3) >> +>> +% 909 0 obj +<< +/D [907 0 R /XYZ 98.895 753.953 null] +>> +% 910 0 obj +<< +/D [907 0 R /XYZ 99.895 716.092 null] +>> +% 911 0 obj +<< +/D [907 0 R /XYZ 99.895 701.526 null] +>> +% 912 0 obj +<< +/D [907 0 R /XYZ 99.895 684.24 null] +>> +% 913 0 obj +<< +/D [907 0 R /XYZ 99.895 666.954 null] +>> +% 914 0 obj +<< +/D [907 0 R /XYZ 99.895 649.667 null] +>> +% 915 0 obj +<< +/D [907 0 R /XYZ 99.895 535.287 null] +>> +% 916 0 obj +<< +/D [907 0 R /XYZ 99.895 518.001 null] +>> +% 917 0 obj +<< +/D [907 0 R /XYZ 99.895 500.715 null] +>> +% 918 0 obj +<< +/D [907 0 R /XYZ 147.412 273.553 null] +>> +% 906 0 obj +<< +/Font << /F8 585 0 R /F27 584 0 R /F30 811 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 922 0 obj +<< +/Type /Page +/Contents 923 0 R +/Resources 921 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 874 0 R +/Annots [ 919 0 R 920 0 R ] +>> +% 919 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [351.231 524.53 358.204 536.485] +/A << /S /GoTo /D (section.1) >> +>> +% 920 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [186.34 314.707 193.314 326.662] +/A << /S /GoTo /D (section.1) >> +>> +% 924 0 obj +<< +/D [922 0 R /XYZ 149.705 753.953 null] +>> +% 43 0 obj +<< +/D [922 0 R /XYZ 150.705 716.092 null] +>> +% 47 0 obj +<< +/D [922 0 R /XYZ 150.705 697.684 null] +>> +% 51 0 obj +<< +/D [922 0 R /XYZ 150.705 499.816 null] +>> +% 55 0 obj +<< +/D [922 0 R /XYZ 150.705 289.993 null] +>> +% 921 0 obj +<< +/Font << /F27 584 0 R /F30 811 0 R /F8 585 0 R /F14 814 0 R /F10 813 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 926 0 obj +<< +/Type /Page +/Contents 927 0 R +/Resources 925 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 929 0 R +>> +% 928 0 obj +<< +/D [926 0 R /XYZ 98.895 753.953 null] +>> +% 59 0 obj +<< +/D [926 0 R /XYZ 99.895 716.092 null] +>> +% 63 0 obj +<< +/D [926 0 R /XYZ 99.895 530.879 null] +>> +% 67 0 obj +<< +/D [926 0 R /XYZ 99.895 277.278 null] +>> +% 925 0 obj +<< +/Font << /F27 584 0 R /F30 811 0 R /F8 585 0 R >> +/ProcSet [ /PDF /Text ] +>> + +endstream +endobj +932 0 obj << /Length 4956 >> @@ -5725,538 +6255,7 @@ ET endstream endobj -832 0 obj -<< -/Type /ObjStm -/N 100 -/First 874 -/Length 9084 ->> -stream -825 0 826 57 19 114 822 170 836 329 833 471 834 617 838 764 835 820 841 925 -843 1039 23 1096 845 1152 846 1209 847 1266 848 1322 849 1379 850 1435 851 1490 852 1547 -840 1604 855 1734 839 1868 857 2016 858 2072 859 2128 860 2184 861 2239 862 2295 863 2351 -864 2407 865 2463 866 2519 867 2575 868 2631 869 2687 870 2743 871 2799 854 2856 876 2986 -853 3128 874 3280 878 3427 27 3484 879 3540 880 3597 881 3654 882 3711 883 3768 884 3825 -31 3882 875 3938 887 4081 885 4215 889 4362 35 4418 39 4473 890 4528 886 4585 895 4703 -891 4853 892 5000 893 5152 897 5304 898 5361 899 5418 900 5475 901 5532 902 5589 894 5646 -906 5738 903 5880 904 6032 908 6184 909 6240 910 6296 911 6352 912 6407 913 6463 914 6519 -915 6575 916 6631 917 6687 905 6744 921 6836 918 6978 919 7124 923 7270 43 7327 47 7383 -51 7439 55 7495 920 7551 925 7669 927 7783 59 7839 63 7894 67 7949 924 8004 930 8096 -% 825 0 obj -<< -/D [823 0 R /XYZ 149.705 753.953 null] ->> -% 826 0 obj -<< -/D [823 0 R /XYZ 303.562 347.015 null] ->> -% 19 0 obj -<< -/D [823 0 R /XYZ 150.705 272.271 null] ->> -% 822 0 obj -<< -/Font << /F27 584 0 R /F8 585 0 R /F14 813 0 R /F11 796 0 R /F10 812 0 R /F16 582 0 R >> -/XObject << /Im2 821 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 836 0 obj -<< -/Type /Page -/Contents 837 0 R -/Resources 835 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 777 0 R -/Annots [ 833 0 R 834 0 R ] ->> -% 833 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [406.358 354.515 413.331 366.47] -/A << /S /GoTo /D (section.3) >> ->> -% 834 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [173.863 318.352 180.837 330.307] -/A << /S /GoTo /D (section.6) >> ->> -% 838 0 obj -<< -/D [836 0 R /XYZ 98.895 753.953 null] ->> -% 835 0 obj -<< -/Font << /F27 584 0 R /F8 585 0 R /F14 813 0 R /F30 810 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 841 0 obj -<< -/Type /Page -/Contents 842 0 R -/Resources 840 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 777 0 R ->> -% 843 0 obj -<< -/D [841 0 R /XYZ 149.705 753.953 null] ->> -% 23 0 obj -<< -/D [841 0 R /XYZ 150.705 716.092 null] ->> -% 845 0 obj -<< -/D [841 0 R /XYZ 150.705 284.758 null] ->> -% 846 0 obj -<< -/D [841 0 R /XYZ 150.705 263.953 null] ->> -% 847 0 obj -<< -/D [841 0 R /XYZ 150.705 242.87 null] ->> -% 848 0 obj -<< -/D [841 0 R /XYZ 150.705 221.788 null] ->> -% 849 0 obj -<< -/D [841 0 R /XYZ 150.705 188.75 null] ->> -% 850 0 obj -<< -/D [841 0 R /XYZ 150.705 167.6 null] ->> -% 851 0 obj -<< -/D [841 0 R /XYZ 150.705 148.591 null] ->> -% 852 0 obj -<< -/D [841 0 R /XYZ 150.705 132.072 null] ->> -% 840 0 obj -<< -/Font << /F16 582 0 R /F8 585 0 R /F11 796 0 R /F30 810 0 R /F9 844 0 R /F17 776 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 855 0 obj -<< -/Type /Page -/Contents 856 0 R -/Resources 854 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 873 0 R -/Annots [ 839 0 R ] ->> -% 839 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [176.109 690.964 182.571 703.28] -/A << /S /GoTo /D (Hfootnote.3) >> ->> -% 857 0 obj -<< -/D [855 0 R /XYZ 98.895 753.953 null] ->> -% 858 0 obj -<< -/D [855 0 R /XYZ 99.895 716.092 null] ->> -% 859 0 obj -<< -/D [855 0 R /XYZ 99.895 686.739 null] ->> -% 860 0 obj -<< -/D [855 0 R /XYZ 99.895 618.93 null] ->> -% 861 0 obj -<< -/D [855 0 R /XYZ 99.895 596.257 null] ->> -% 862 0 obj -<< -/D [855 0 R /XYZ 99.895 573.861 null] ->> -% 863 0 obj -<< -/D [855 0 R /XYZ 99.895 539.509 null] ->> -% 864 0 obj -<< -/D [855 0 R /XYZ 99.895 517.113 null] ->> -% 865 0 obj -<< -/D [855 0 R /XYZ 99.895 494.716 null] ->> -% 866 0 obj -<< -/D [855 0 R /XYZ 99.895 469.986 null] ->> -% 867 0 obj -<< -/D [855 0 R /XYZ 99.895 440.855 null] ->> -% 868 0 obj -<< -/D [855 0 R /XYZ 99.895 411.448 null] ->> -% 869 0 obj -<< -/D [855 0 R /XYZ 99.895 393.995 null] ->> -% 870 0 obj -<< -/D [855 0 R /XYZ 99.895 376.819 null] ->> -% 871 0 obj -<< -/D [855 0 R /XYZ 115.138 139.255 null] ->> -% 854 0 obj -<< -/Font << /F8 585 0 R /F30 810 0 R /F7 811 0 R /F32 814 0 R /F31 816 0 R /F45 872 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 876 0 obj -<< -/Type /Page -/Contents 877 0 R -/Resources 875 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 873 0 R -/Annots [ 853 0 R 874 0 R ] ->> -% 853 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [269.731 674.788 284.454 683.699] -/A << /S /GoTo /D (subsection.2.3) >> ->> -% 874 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [169.998 271.903 176.972 282.751] -/A << /S /GoTo /D (section.3) >> ->> -% 878 0 obj -<< -/D [876 0 R /XYZ 149.705 753.953 null] ->> -% 27 0 obj -<< -/D [876 0 R /XYZ 150.705 716.092 null] ->> -% 879 0 obj -<< -/D [876 0 R /XYZ 150.705 671.799 null] ->> -% 880 0 obj -<< -/D [876 0 R /XYZ 150.705 649.383 null] ->> -% 881 0 obj -<< -/D [876 0 R /XYZ 150.705 576.158 null] ->> -% 882 0 obj -<< -/D [876 0 R /XYZ 150.705 530.385 null] ->> -% 883 0 obj -<< -/D [876 0 R /XYZ 150.705 497.951 null] ->> -% 884 0 obj -<< -/D [876 0 R /XYZ 150.705 478.303 null] ->> -% 31 0 obj -<< -/D [876 0 R /XYZ 150.705 424.511 null] ->> -% 875 0 obj -<< -/Font << /F27 584 0 R /F8 585 0 R /F11 796 0 R /F9 844 0 R /F30 810 0 R /F16 582 0 R /F17 776 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 887 0 obj -<< -/Type /Page -/Contents 888 0 R -/Resources 886 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 873 0 R -/Annots [ 885 0 R ] ->> -% 885 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [269.318 174.287 276.292 185.135] -/A << /S /GoTo /D (section.6) >> ->> -% 889 0 obj -<< -/D [887 0 R /XYZ 98.895 753.953 null] ->> -% 35 0 obj -<< -/D [887 0 R /XYZ 99.895 716.092 null] ->> -% 39 0 obj -<< -/D [887 0 R /XYZ 99.895 280.417 null] ->> -% 890 0 obj -<< -/D [887 0 R /XYZ 342.427 237.273 null] ->> -% 886 0 obj -<< -/Font << /F16 582 0 R /F8 585 0 R /F30 810 0 R /F27 584 0 R /F14 813 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 895 0 obj -<< -/Type /Page -/Contents 896 0 R -/Resources 894 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 873 0 R -/Annots [ 891 0 R 892 0 R 893 0 R ] ->> -% 891 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [452.103 399.657 459.077 411.612] -/A << /S /GoTo /D (section.6) >> ->> -% 892 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [356.323 194.074 371.046 204.923] -/A << /S /GoTo /D (subsection.3.3) >> ->> -% 893 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [356.323 149.756 371.046 160.604] -/A << /S /GoTo /D (subsection.3.3) >> ->> -% 897 0 obj -<< -/D [895 0 R /XYZ 149.705 753.953 null] ->> -% 898 0 obj -<< -/D [895 0 R /XYZ 150.705 294.274 null] ->> -% 899 0 obj -<< -/D [895 0 R /XYZ 150.705 278.093 null] ->> -% 900 0 obj -<< -/D [895 0 R /XYZ 150.705 261.911 null] ->> -% 901 0 obj -<< -/D [895 0 R /XYZ 150.705 245.729 null] ->> -% 902 0 obj -<< -/D [895 0 R /XYZ 150.705 229.547 null] ->> -% 894 0 obj -<< -/Font << /F14 813 0 R /F8 585 0 R /F27 584 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 906 0 obj -<< -/Type /Page -/Contents 907 0 R -/Resources 905 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 873 0 R -/Annots [ 903 0 R 904 0 R ] ->> -% 903 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [305.513 611.433 320.236 622.281] -/A << /S /GoTo /D (subsection.3.3) >> ->> -% 904 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [305.513 564.905 320.236 575.753] -/A << /S /GoTo /D (subsection.3.3) >> ->> -% 908 0 obj -<< -/D [906 0 R /XYZ 98.895 753.953 null] ->> -% 909 0 obj -<< -/D [906 0 R /XYZ 99.895 716.092 null] ->> -% 910 0 obj -<< -/D [906 0 R /XYZ 99.895 701.526 null] ->> -% 911 0 obj -<< -/D [906 0 R /XYZ 99.895 684.24 null] ->> -% 912 0 obj -<< -/D [906 0 R /XYZ 99.895 666.954 null] ->> -% 913 0 obj -<< -/D [906 0 R /XYZ 99.895 649.667 null] ->> -% 914 0 obj -<< -/D [906 0 R /XYZ 99.895 535.287 null] ->> -% 915 0 obj -<< -/D [906 0 R /XYZ 99.895 518.001 null] ->> -% 916 0 obj -<< -/D [906 0 R /XYZ 99.895 500.715 null] ->> -% 917 0 obj -<< -/D [906 0 R /XYZ 147.412 273.553 null] ->> -% 905 0 obj -<< -/Font << /F8 585 0 R /F27 584 0 R /F30 810 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 921 0 obj -<< -/Type /Page -/Contents 922 0 R -/Resources 920 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 873 0 R -/Annots [ 918 0 R 919 0 R ] ->> -% 918 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [351.231 524.53 358.204 536.485] -/A << /S /GoTo /D (section.1) >> ->> -% 919 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [186.34 314.707 193.314 326.662] -/A << /S /GoTo /D (section.1) >> ->> -% 923 0 obj -<< -/D [921 0 R /XYZ 149.705 753.953 null] ->> -% 43 0 obj -<< -/D [921 0 R /XYZ 150.705 716.092 null] ->> -% 47 0 obj -<< -/D [921 0 R /XYZ 150.705 697.684 null] ->> -% 51 0 obj -<< -/D [921 0 R /XYZ 150.705 499.816 null] ->> -% 55 0 obj -<< -/D [921 0 R /XYZ 150.705 289.993 null] ->> -% 920 0 obj -<< -/Font << /F27 584 0 R /F30 810 0 R /F8 585 0 R /F14 813 0 R /F10 812 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 925 0 obj -<< -/Type /Page -/Contents 926 0 R -/Resources 924 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 928 0 R ->> -% 927 0 obj -<< -/D [925 0 R /XYZ 98.895 753.953 null] ->> -% 59 0 obj -<< -/D [925 0 R /XYZ 99.895 716.092 null] ->> -% 63 0 obj -<< -/D [925 0 R /XYZ 99.895 530.879 null] ->> -% 67 0 obj -<< -/D [925 0 R /XYZ 99.895 277.278 null] ->> -% 924 0 obj -<< -/Font << /F27 584 0 R /F30 810 0 R /F8 585 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 930 0 obj -<< -/Type /Page -/Contents 931 0 R -/Resources 929 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 928 0 R ->> - -endstream -endobj -937 0 obj +938 0 obj << /Length 5918 >> @@ -6352,7 +6351,7 @@ ET endstream endobj -944 0 obj +945 0 obj << /Length 9167 >> @@ -6642,7 +6641,7 @@ ET endstream endobj -952 0 obj +953 0 obj << /Length 5963 >> @@ -6820,7 +6819,7 @@ ET endstream endobj -956 0 obj +957 0 obj << /Length 3543 >> @@ -6906,7 +6905,7 @@ ET endstream endobj -961 0 obj +962 0 obj << /Length 3749 >> @@ -7013,7 +7012,7 @@ ET endstream endobj -966 0 obj +967 0 obj << /Length 4632 >> @@ -7115,7 +7114,7 @@ ET endstream endobj -970 0 obj +971 0 obj << /Length 4114 >> @@ -7196,7 +7195,7 @@ ET endstream endobj -974 0 obj +975 0 obj << /Length 4061 >> @@ -7286,7 +7285,7 @@ ET endstream endobj -978 0 obj +979 0 obj << /Length 5497 >> @@ -7373,7 +7372,7 @@ ET endstream endobj -984 0 obj +985 0 obj << /Length 7723 >> @@ -7650,7 +7649,7 @@ ET endstream endobj -990 0 obj +991 0 obj << /Length 3718 >> @@ -7734,7 +7733,7 @@ ET endstream endobj -997 0 obj +998 0 obj << /Length 3840 >> @@ -7801,7 +7800,7 @@ ET endstream endobj -1004 0 obj +1005 0 obj << /Length 4654 >> @@ -7892,7 +7891,7 @@ ET endstream endobj -1010 0 obj +1011 0 obj << /Length 3667 >> @@ -7996,7 +7995,544 @@ ET endstream endobj -1015 0 obj +935 0 obj +<< +/Type /ObjStm +/N 100 +/First 885 +/Length 8978 +>> +stream +931 0 933 114 71 171 75 227 934 283 79 339 83 395 930 451 937 543 939 657 +87 713 91 768 95 823 936 878 944 970 940 1120 941 1276 942 1426 946 1571 99 1628 +103 1684 947 1741 948 1798 943 1855 952 1960 954 2074 950 2130 107 2187 111 2243 115 2299 +951 2355 956 2447 958 2561 119 2618 959 2674 123 2731 955 2788 961 2880 963 2994 127 3050 +131 3106 135 3162 960 3218 966 3310 968 3424 139 3481 143 3538 965 3595 970 3687 972 3801 +147 3857 151 3913 969 3969 974 4061 976 4175 155 4232 159 4289 163 4346 973 4403 978 4495 +980 4609 167 4665 977 4721 984 4813 981 4955 982 5102 986 5248 171 5305 175 5362 179 5419 +183 5476 987 5533 983 5590 990 5695 992 5809 988 5865 187 5922 191 5978 195 6034 989 6090 +997 6182 994 6324 995 6469 999 6614 199 6671 996 6728 1004 6820 1001 6958 1006 7105 204 7163 +208 7220 212 7276 1007 7333 1003 7392 1010 7511 1002 7649 1012 7797 1008 7856 216 7915 1009 7973 +% 931 0 obj +<< +/Type /Page +/Contents 932 0 R +/Resources 930 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 929 0 R +>> +% 933 0 obj +<< +/D [931 0 R /XYZ 149.705 753.953 null] +>> +% 71 0 obj +<< +/D [931 0 R /XYZ 150.705 716.092 null] +>> +% 75 0 obj +<< +/D [931 0 R /XYZ 150.705 527.714 null] +>> +% 934 0 obj +<< +/D [931 0 R /XYZ 395.482 368.65 null] +>> +% 79 0 obj +<< +/D [931 0 R /XYZ 150.705 321.259 null] +>> +% 83 0 obj +<< +/D [931 0 R /XYZ 150.705 203.963 null] +>> +% 930 0 obj +<< +/Font << /F27 584 0 R /F30 811 0 R /F8 585 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 937 0 obj +<< +/Type /Page +/Contents 938 0 R +/Resources 936 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 929 0 R +>> +% 939 0 obj +<< +/D [937 0 R /XYZ 98.895 753.953 null] +>> +% 87 0 obj +<< +/D [937 0 R /XYZ 99.895 585.142 null] +>> +% 91 0 obj +<< +/D [937 0 R /XYZ 99.895 467.965 null] +>> +% 95 0 obj +<< +/D [937 0 R /XYZ 99.895 257.286 null] +>> +% 936 0 obj +<< +/Font << /F27 584 0 R /F8 585 0 R /F30 811 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 944 0 obj +<< +/Type /Page +/Contents 945 0 R +/Resources 943 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 929 0 R +/Annots [ 940 0 R 941 0 R 942 0 R ] +>> +% 940 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[0 1 0] +/Rect [188.06 277.052 200.015 285.465] +/A << /S /GoTo /D (cite.DesignPatterns) >> +>> +% 941 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[0 1 0] +/Rect [268.904 277.052 280.86 285.465] +/A << /S /GoTo /D (cite.Sparse03) >> +>> +% 942 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [459.496 274.562 466.47 286.517] +/A << /S /GoTo /D (figure.4) >> +>> +% 946 0 obj +<< +/D [944 0 R /XYZ 149.705 753.953 null] +>> +% 99 0 obj +<< +/D [944 0 R /XYZ 150.705 553.709 null] +>> +% 103 0 obj +<< +/D [944 0 R /XYZ 150.705 332.359 null] +>> +% 947 0 obj +<< +/D [944 0 R /XYZ 171.358 301.959 null] +>> +% 948 0 obj +<< +/D [944 0 R /XYZ 455.673 168.146 null] +>> +% 943 0 obj +<< +/Font << /F27 584 0 R /F8 585 0 R /F30 811 0 R /F16 582 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 952 0 obj +<< +/Type /Page +/Contents 953 0 R +/Resources 951 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 929 0 R +>> +% 954 0 obj +<< +/D [952 0 R /XYZ 98.895 753.953 null] +>> +% 950 0 obj +<< +/D [952 0 R /XYZ 155.008 667.994 null] +>> +% 107 0 obj +<< +/D [952 0 R /XYZ 99.895 382.599 null] +>> +% 111 0 obj +<< +/D [952 0 R /XYZ 99.895 364.643 null] +>> +% 115 0 obj +<< +/D [952 0 R /XYZ 99.895 191.212 null] +>> +% 951 0 obj +<< +/Font << /F30 811 0 R /F8 585 0 R /F27 584 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 956 0 obj +<< +/Type /Page +/Contents 957 0 R +/Resources 955 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 929 0 R +>> +% 958 0 obj +<< +/D [956 0 R /XYZ 149.705 753.953 null] +>> +% 119 0 obj +<< +/D [956 0 R /XYZ 150.705 611.35 null] +>> +% 959 0 obj +<< +/D [956 0 R /XYZ 150.705 387.487 null] +>> +% 123 0 obj +<< +/D [956 0 R /XYZ 150.705 324.426 null] +>> +% 955 0 obj +<< +/Font << /F27 584 0 R /F8 585 0 R /F30 811 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 961 0 obj +<< +/Type /Page +/Contents 962 0 R +/Resources 960 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 964 0 R +>> +% 963 0 obj +<< +/D [961 0 R /XYZ 98.895 753.953 null] +>> +% 127 0 obj +<< +/D [961 0 R /XYZ 99.895 716.092 null] +>> +% 131 0 obj +<< +/D [961 0 R /XYZ 99.895 527.657 null] +>> +% 135 0 obj +<< +/D [961 0 R /XYZ 99.895 326.521 null] +>> +% 960 0 obj +<< +/Font << /F27 584 0 R /F30 811 0 R /F8 585 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 966 0 obj +<< +/Type /Page +/Contents 967 0 R +/Resources 965 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 964 0 R +>> +% 968 0 obj +<< +/D [966 0 R /XYZ 149.705 753.953 null] +>> +% 139 0 obj +<< +/D [966 0 R /XYZ 150.705 716.092 null] +>> +% 143 0 obj +<< +/D [966 0 R /XYZ 150.705 475.461 null] +>> +% 965 0 obj +<< +/Font << /F27 584 0 R /F30 811 0 R /F8 585 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 970 0 obj +<< +/Type /Page +/Contents 971 0 R +/Resources 969 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 964 0 R +>> +% 972 0 obj +<< +/D [970 0 R /XYZ 98.895 753.953 null] +>> +% 147 0 obj +<< +/D [970 0 R /XYZ 99.895 716.092 null] +>> +% 151 0 obj +<< +/D [970 0 R /XYZ 99.895 384.228 null] +>> +% 969 0 obj +<< +/Font << /F27 584 0 R /F30 811 0 R /F8 585 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 974 0 obj +<< +/Type /Page +/Contents 975 0 R +/Resources 973 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 964 0 R +>> +% 976 0 obj +<< +/D [974 0 R /XYZ 149.705 753.953 null] +>> +% 155 0 obj +<< +/D [974 0 R /XYZ 150.705 716.092 null] +>> +% 159 0 obj +<< +/D [974 0 R /XYZ 150.705 483.063 null] +>> +% 163 0 obj +<< +/D [974 0 R /XYZ 150.705 248.041 null] +>> +% 973 0 obj +<< +/Font << /F27 584 0 R /F30 811 0 R /F8 585 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 978 0 obj +<< +/Type /Page +/Contents 979 0 R +/Resources 977 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 964 0 R +>> +% 980 0 obj +<< +/D [978 0 R /XYZ 98.895 753.953 null] +>> +% 167 0 obj +<< +/D [978 0 R /XYZ 99.895 476.867 null] +>> +% 977 0 obj +<< +/Font << /F27 584 0 R /F8 585 0 R /F30 811 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 984 0 obj +<< +/Type /Page +/Contents 985 0 R +/Resources 983 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 964 0 R +/Annots [ 981 0 R 982 0 R ] +>> +% 981 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [250.191 165.213 257.165 176.061] +/A << /S /GoTo /D (section.6) >> +>> +% 982 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [343.178 129.347 350.152 140.196] +/A << /S /GoTo /D (figure.5) >> +>> +% 986 0 obj +<< +/D [984 0 R /XYZ 149.705 753.953 null] +>> +% 171 0 obj +<< +/D [984 0 R /XYZ 150.705 716.092 null] +>> +% 175 0 obj +<< +/D [984 0 R /XYZ 150.705 588.122 null] +>> +% 179 0 obj +<< +/D [984 0 R /XYZ 150.705 402.035 null] +>> +% 183 0 obj +<< +/D [984 0 R /XYZ 150.705 233.858 null] +>> +% 987 0 obj +<< +/D [984 0 R /XYZ 171.961 204.012 null] +>> +% 983 0 obj +<< +/Font << /F27 584 0 R /F30 811 0 R /F8 585 0 R /F16 582 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 990 0 obj +<< +/Type /Page +/Contents 991 0 R +/Resources 989 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 993 0 R +>> +% 992 0 obj +<< +/D [990 0 R /XYZ 98.895 753.953 null] +>> +% 988 0 obj +<< +/D [990 0 R /XYZ 157.678 433.055 null] +>> +% 187 0 obj +<< +/D [990 0 R /XYZ 99.895 391.443 null] +>> +% 191 0 obj +<< +/D [990 0 R /XYZ 99.895 374.453 null] +>> +% 195 0 obj +<< +/D [990 0 R /XYZ 99.895 195.366 null] +>> +% 989 0 obj +<< +/Font << /F27 584 0 R /F8 585 0 R /F30 811 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 997 0 obj +<< +/Type /Page +/Contents 998 0 R +/Resources 996 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 993 0 R +/Annots [ 994 0 R 995 0 R ] +>> +% 994 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [432.897 385.356 439.871 396.204] +/A << /S /GoTo /D (table.1) >> +>> +% 995 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [432.897 241.508 439.871 252.356] +/A << /S /GoTo /D (table.1) >> +>> +% 999 0 obj +<< +/D [997 0 R /XYZ 149.705 753.953 null] +>> +% 199 0 obj +<< +/D [997 0 R /XYZ 150.705 612.689 null] +>> +% 996 0 obj +<< +/Font << /F27 584 0 R /F8 585 0 R /F30 811 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1004 0 obj +<< +/Type /Page +/Contents 1005 0 R +/Resources 1003 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 993 0 R +/Annots [ 1001 0 R ] +>> +% 1001 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [126.875 152.981 133.849 164.106] +/A << /S /GoTo /D (figure.6) >> +>> +% 1006 0 obj +<< +/D [1004 0 R /XYZ 98.895 753.953 null] +>> +% 204 0 obj +<< +/D [1004 0 R /XYZ 99.895 716.092 null] +>> +% 208 0 obj +<< +/D [1004 0 R /XYZ 99.895 430.45 null] +>> +% 212 0 obj +<< +/D [1004 0 R /XYZ 99.895 226.068 null] +>> +% 1007 0 obj +<< +/D [1004 0 R /XYZ 257.563 168.146 null] +>> +% 1003 0 obj +<< +/Font << /F27 584 0 R /F30 811 0 R /F8 585 0 R /F11 797 0 R /F16 582 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1010 0 obj +<< +/Type /Page +/Contents 1011 0 R +/Resources 1009 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 993 0 R +/Annots [ 1002 0 R ] +>> +% 1002 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [297.652 591.268 304.626 602.116] +/A << /S /GoTo /D (section.6) >> +>> +% 1012 0 obj +<< +/D [1010 0 R /XYZ 149.705 753.953 null] +>> +% 1008 0 obj +<< +/D [1010 0 R /XYZ 206.288 656.371 null] +>> +% 216 0 obj +<< +/D [1010 0 R /XYZ 150.705 622.553 null] +>> +% 1009 0 obj +<< +/Font << /F47 1013 0 R /F8 585 0 R /F16 582 0 R /F30 811 0 R /F27 584 0 R >> +/ProcSet [ /PDF /Text ] +>> + +endstream +endobj +1016 0 obj << /Length 157 >> @@ -8012,544 +8548,7 @@ ET endstream endobj -934 0 obj -<< -/Type /ObjStm -/N 100 -/First 886 -/Length 8982 ->> -stream -932 0 71 57 75 113 933 169 79 225 83 281 929 337 936 429 938 543 87 599 -91 654 95 709 935 764 943 856 939 1006 940 1162 941 1312 945 1457 99 1514 103 1570 -946 1627 947 1684 942 1741 951 1846 953 1960 949 2016 107 2073 111 2129 115 2185 950 2241 -955 2333 957 2447 119 2504 958 2560 123 2617 954 2674 960 2766 962 2880 127 2936 131 2992 -135 3048 959 3104 965 3196 967 3310 139 3367 143 3424 964 3481 969 3573 971 3687 147 3743 -151 3799 968 3855 973 3947 975 4061 155 4118 159 4175 163 4232 972 4289 977 4381 979 4495 -167 4551 976 4607 983 4699 980 4841 981 4988 985 5134 171 5191 175 5248 179 5305 183 5362 -986 5419 982 5476 989 5581 991 5695 987 5751 187 5808 191 5864 195 5920 988 5976 996 6068 -993 6210 994 6355 998 6500 199 6557 995 6614 1003 6706 1000 6844 1005 6991 204 7049 208 7106 -212 7162 1006 7219 1002 7278 1009 7397 1001 7535 1011 7683 1007 7742 216 7801 1008 7859 1014 7979 -% 932 0 obj -<< -/D [930 0 R /XYZ 149.705 753.953 null] ->> -% 71 0 obj -<< -/D [930 0 R /XYZ 150.705 716.092 null] ->> -% 75 0 obj -<< -/D [930 0 R /XYZ 150.705 527.714 null] ->> -% 933 0 obj -<< -/D [930 0 R /XYZ 395.482 368.65 null] ->> -% 79 0 obj -<< -/D [930 0 R /XYZ 150.705 321.259 null] ->> -% 83 0 obj -<< -/D [930 0 R /XYZ 150.705 203.963 null] ->> -% 929 0 obj -<< -/Font << /F27 584 0 R /F30 810 0 R /F8 585 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 936 0 obj -<< -/Type /Page -/Contents 937 0 R -/Resources 935 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 928 0 R ->> -% 938 0 obj -<< -/D [936 0 R /XYZ 98.895 753.953 null] ->> -% 87 0 obj -<< -/D [936 0 R /XYZ 99.895 585.142 null] ->> -% 91 0 obj -<< -/D [936 0 R /XYZ 99.895 467.965 null] ->> -% 95 0 obj -<< -/D [936 0 R /XYZ 99.895 257.286 null] ->> -% 935 0 obj -<< -/Font << /F27 584 0 R /F8 585 0 R /F30 810 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 943 0 obj -<< -/Type /Page -/Contents 944 0 R -/Resources 942 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 928 0 R -/Annots [ 939 0 R 940 0 R 941 0 R ] ->> -% 939 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[0 1 0] -/Rect [188.06 277.052 200.015 285.465] -/A << /S /GoTo /D (cite.DesignPatterns) >> ->> -% 940 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[0 1 0] -/Rect [268.904 277.052 280.86 285.465] -/A << /S /GoTo /D (cite.Sparse03) >> ->> -% 941 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [459.496 274.562 466.47 286.517] -/A << /S /GoTo /D (figure.4) >> ->> -% 945 0 obj -<< -/D [943 0 R /XYZ 149.705 753.953 null] ->> -% 99 0 obj -<< -/D [943 0 R /XYZ 150.705 553.709 null] ->> -% 103 0 obj -<< -/D [943 0 R /XYZ 150.705 332.359 null] ->> -% 946 0 obj -<< -/D [943 0 R /XYZ 171.358 301.959 null] ->> -% 947 0 obj -<< -/D [943 0 R /XYZ 455.673 168.146 null] ->> -% 942 0 obj -<< -/Font << /F27 584 0 R /F8 585 0 R /F30 810 0 R /F16 582 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 951 0 obj -<< -/Type /Page -/Contents 952 0 R -/Resources 950 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 928 0 R ->> -% 953 0 obj -<< -/D [951 0 R /XYZ 98.895 753.953 null] ->> -% 949 0 obj -<< -/D [951 0 R /XYZ 155.008 667.994 null] ->> -% 107 0 obj -<< -/D [951 0 R /XYZ 99.895 382.599 null] ->> -% 111 0 obj -<< -/D [951 0 R /XYZ 99.895 364.643 null] ->> -% 115 0 obj -<< -/D [951 0 R /XYZ 99.895 191.212 null] ->> -% 950 0 obj -<< -/Font << /F30 810 0 R /F8 585 0 R /F27 584 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 955 0 obj -<< -/Type /Page -/Contents 956 0 R -/Resources 954 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 928 0 R ->> -% 957 0 obj -<< -/D [955 0 R /XYZ 149.705 753.953 null] ->> -% 119 0 obj -<< -/D [955 0 R /XYZ 150.705 611.35 null] ->> -% 958 0 obj -<< -/D [955 0 R /XYZ 150.705 387.487 null] ->> -% 123 0 obj -<< -/D [955 0 R /XYZ 150.705 324.426 null] ->> -% 954 0 obj -<< -/Font << /F27 584 0 R /F8 585 0 R /F30 810 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 960 0 obj -<< -/Type /Page -/Contents 961 0 R -/Resources 959 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 963 0 R ->> -% 962 0 obj -<< -/D [960 0 R /XYZ 98.895 753.953 null] ->> -% 127 0 obj -<< -/D [960 0 R /XYZ 99.895 716.092 null] ->> -% 131 0 obj -<< -/D [960 0 R /XYZ 99.895 527.657 null] ->> -% 135 0 obj -<< -/D [960 0 R /XYZ 99.895 326.521 null] ->> -% 959 0 obj -<< -/Font << /F27 584 0 R /F30 810 0 R /F8 585 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 965 0 obj -<< -/Type /Page -/Contents 966 0 R -/Resources 964 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 963 0 R ->> -% 967 0 obj -<< -/D [965 0 R /XYZ 149.705 753.953 null] ->> -% 139 0 obj -<< -/D [965 0 R /XYZ 150.705 716.092 null] ->> -% 143 0 obj -<< -/D [965 0 R /XYZ 150.705 475.461 null] ->> -% 964 0 obj -<< -/Font << /F27 584 0 R /F30 810 0 R /F8 585 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 969 0 obj -<< -/Type /Page -/Contents 970 0 R -/Resources 968 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 963 0 R ->> -% 971 0 obj -<< -/D [969 0 R /XYZ 98.895 753.953 null] ->> -% 147 0 obj -<< -/D [969 0 R /XYZ 99.895 716.092 null] ->> -% 151 0 obj -<< -/D [969 0 R /XYZ 99.895 384.228 null] ->> -% 968 0 obj -<< -/Font << /F27 584 0 R /F30 810 0 R /F8 585 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 973 0 obj -<< -/Type /Page -/Contents 974 0 R -/Resources 972 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 963 0 R ->> -% 975 0 obj -<< -/D [973 0 R /XYZ 149.705 753.953 null] ->> -% 155 0 obj -<< -/D [973 0 R /XYZ 150.705 716.092 null] ->> -% 159 0 obj -<< -/D [973 0 R /XYZ 150.705 483.063 null] ->> -% 163 0 obj -<< -/D [973 0 R /XYZ 150.705 248.041 null] ->> -% 972 0 obj -<< -/Font << /F27 584 0 R /F30 810 0 R /F8 585 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 977 0 obj -<< -/Type /Page -/Contents 978 0 R -/Resources 976 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 963 0 R ->> -% 979 0 obj -<< -/D [977 0 R /XYZ 98.895 753.953 null] ->> -% 167 0 obj -<< -/D [977 0 R /XYZ 99.895 476.867 null] ->> -% 976 0 obj -<< -/Font << /F27 584 0 R /F8 585 0 R /F30 810 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 983 0 obj -<< -/Type /Page -/Contents 984 0 R -/Resources 982 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 963 0 R -/Annots [ 980 0 R 981 0 R ] ->> -% 980 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [250.191 165.213 257.165 176.061] -/A << /S /GoTo /D (section.6) >> ->> -% 981 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [343.178 129.347 350.152 140.196] -/A << /S /GoTo /D (figure.5) >> ->> -% 985 0 obj -<< -/D [983 0 R /XYZ 149.705 753.953 null] ->> -% 171 0 obj -<< -/D [983 0 R /XYZ 150.705 716.092 null] ->> -% 175 0 obj -<< -/D [983 0 R /XYZ 150.705 588.122 null] ->> -% 179 0 obj -<< -/D [983 0 R /XYZ 150.705 402.035 null] ->> -% 183 0 obj -<< -/D [983 0 R /XYZ 150.705 233.858 null] ->> -% 986 0 obj -<< -/D [983 0 R /XYZ 171.961 204.012 null] ->> -% 982 0 obj -<< -/Font << /F27 584 0 R /F30 810 0 R /F8 585 0 R /F16 582 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 989 0 obj -<< -/Type /Page -/Contents 990 0 R -/Resources 988 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 992 0 R ->> -% 991 0 obj -<< -/D [989 0 R /XYZ 98.895 753.953 null] ->> -% 987 0 obj -<< -/D [989 0 R /XYZ 157.678 433.055 null] ->> -% 187 0 obj -<< -/D [989 0 R /XYZ 99.895 391.443 null] ->> -% 191 0 obj -<< -/D [989 0 R /XYZ 99.895 374.453 null] ->> -% 195 0 obj -<< -/D [989 0 R /XYZ 99.895 195.366 null] ->> -% 988 0 obj -<< -/Font << /F27 584 0 R /F8 585 0 R /F30 810 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 996 0 obj -<< -/Type /Page -/Contents 997 0 R -/Resources 995 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 992 0 R -/Annots [ 993 0 R 994 0 R ] ->> -% 993 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [432.897 385.356 439.871 396.204] -/A << /S /GoTo /D (table.1) >> ->> -% 994 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [432.897 241.508 439.871 252.356] -/A << /S /GoTo /D (table.1) >> ->> -% 998 0 obj -<< -/D [996 0 R /XYZ 149.705 753.953 null] ->> -% 199 0 obj -<< -/D [996 0 R /XYZ 150.705 612.689 null] ->> -% 995 0 obj -<< -/Font << /F27 584 0 R /F8 585 0 R /F30 810 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1003 0 obj -<< -/Type /Page -/Contents 1004 0 R -/Resources 1002 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 992 0 R -/Annots [ 1000 0 R ] ->> -% 1000 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [126.875 152.981 133.849 164.106] -/A << /S /GoTo /D (figure.6) >> ->> -% 1005 0 obj -<< -/D [1003 0 R /XYZ 98.895 753.953 null] ->> -% 204 0 obj -<< -/D [1003 0 R /XYZ 99.895 716.092 null] ->> -% 208 0 obj -<< -/D [1003 0 R /XYZ 99.895 430.45 null] ->> -% 212 0 obj -<< -/D [1003 0 R /XYZ 99.895 226.068 null] ->> -% 1006 0 obj -<< -/D [1003 0 R /XYZ 257.563 168.146 null] ->> -% 1002 0 obj -<< -/Font << /F27 584 0 R /F30 810 0 R /F8 585 0 R /F11 796 0 R /F16 582 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1009 0 obj -<< -/Type /Page -/Contents 1010 0 R -/Resources 1008 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 992 0 R -/Annots [ 1001 0 R ] ->> -% 1001 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [297.652 591.268 304.626 602.116] -/A << /S /GoTo /D (section.6) >> ->> -% 1011 0 obj -<< -/D [1009 0 R /XYZ 149.705 753.953 null] ->> -% 1007 0 obj -<< -/D [1009 0 R /XYZ 206.288 656.371 null] ->> -% 216 0 obj -<< -/D [1009 0 R /XYZ 150.705 622.553 null] ->> -% 1008 0 obj -<< -/Font << /F47 1012 0 R /F8 585 0 R /F16 582 0 R /F30 810 0 R /F27 584 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1014 0 obj -<< -/Type /Page -/Contents 1015 0 R -/Resources 1013 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 992 0 R ->> - -endstream -endobj -1027 0 obj +1028 0 obj << /Length 7331 >> @@ -8730,7 +8729,7 @@ ET endstream endobj -1033 0 obj +1034 0 obj << /Length 2659 >> @@ -8804,7 +8803,7 @@ ET endstream endobj -1043 0 obj +1044 0 obj << /Length 7709 >> @@ -8991,7 +8990,7 @@ ET endstream endobj -1049 0 obj +1050 0 obj << /Length 5125 >> @@ -9078,7 +9077,7 @@ ET endstream endobj -1065 0 obj +1066 0 obj << /Length 8426 >> @@ -9272,7 +9271,7 @@ ET endstream endobj -1070 0 obj +1071 0 obj << /Length 624 >> @@ -9291,7 +9290,7 @@ ET endstream endobj -1077 0 obj +1078 0 obj << /Length 6875 >> @@ -9448,7 +9447,7 @@ ET endstream endobj -1082 0 obj +1083 0 obj << /Length 4549 >> @@ -9527,7 +9526,7 @@ ET endstream endobj -1096 0 obj +1097 0 obj << /Length 6320 >> @@ -9688,7 +9687,7 @@ ET endstream endobj -1104 0 obj +1105 0 obj << /Length 7168 >> @@ -9849,7 +9848,7 @@ ET endstream endobj -1109 0 obj +1110 0 obj << /Length 3885 >> @@ -9924,7 +9923,7 @@ ET endstream endobj -1122 0 obj +1123 0 obj << /Length 7328 >> @@ -10081,47 +10080,55 @@ ET endstream endobj -1017 0 obj +1018 0 obj << /Type /ObjStm /N 100 -/First 983 -/Length 11572 +/First 986 +/Length 11547 >> stream -1016 0 220 58 1013 115 1026 195 1018 378 1019 524 1020 668 1021 814 1022 960 1023 1104 -1028 1250 224 1309 999 1367 1025 1424 1032 1556 1024 1713 1029 1860 1030 2003 1034 2149 1031 2207 -1042 2313 1036 2488 1037 2631 1038 2777 1039 2920 1040 3065 1044 3211 228 3270 1045 3328 1041 3387 -1048 3532 1046 3671 1050 3817 1051 3875 1052 3933 1053 3991 1054 4049 1055 4108 1056 4166 1047 4225 -1064 4344 1057 4528 1058 4672 1059 4817 1060 4961 1061 5107 1062 5254 1066 5399 232 5458 1067 5516 -1063 5575 1069 5720 1071 5838 1068 5896 1076 5976 1072 6133 1073 6276 1074 6421 1078 6568 236 6627 -1079 6685 1075 6743 1081 6888 1083 7006 1084 7064 1085 7122 1086 7180 1087 7239 1088 7298 1089 7357 -1080 7416 1095 7535 1091 7692 1092 7836 1093 7982 1097 8128 240 8187 1098 8245 1094 8304 1103 8449 -1099 8606 1100 8750 1101 8896 1105 9043 244 9101 1106 9158 1102 9217 1108 9374 1110 9492 1111 9551 -1112 9610 1113 9669 1114 9728 1115 9787 1116 9846 1107 9905 1121 9998 1117 10155 1118 10298 1119 10443 -% 1016 0 obj +1015 0 1017 117 220 175 1014 232 1027 312 1019 495 1020 641 1021 785 1022 931 1023 1077 +1024 1221 1029 1367 224 1426 1000 1484 1026 1542 1033 1674 1025 1831 1030 1978 1031 2121 1035 2267 +1032 2325 1043 2431 1037 2606 1038 2749 1039 2895 1040 3038 1041 3183 1045 3329 228 3388 1046 3446 +1042 3505 1049 3650 1047 3789 1051 3935 1052 3993 1053 4051 1054 4109 1055 4167 1056 4226 1057 4284 +1048 4343 1065 4462 1058 4646 1059 4790 1060 4935 1061 5079 1062 5225 1063 5372 1067 5517 232 5576 +1068 5634 1064 5693 1070 5838 1072 5956 1069 6014 1077 6094 1073 6251 1074 6394 1075 6539 1079 6686 +236 6745 1080 6803 1076 6861 1082 7006 1084 7124 1085 7182 1086 7240 1087 7298 1088 7357 1089 7416 +1090 7475 1081 7534 1096 7653 1092 7810 1093 7954 1094 8100 1098 8246 240 8305 1099 8363 1095 8422 +1104 8567 1100 8724 1101 8868 1102 9014 1106 9161 244 9219 1107 9276 1103 9335 1109 9492 1111 9610 +1112 9669 1113 9728 1114 9787 1115 9846 1116 9905 1117 9964 1108 10023 1122 10116 1118 10273 1119 10416 +% 1015 0 obj << -/D [1014 0 R /XYZ 98.895 753.953 null] +/Type /Page +/Contents 1016 0 R +/Resources 1014 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 993 0 R +>> +% 1017 0 obj +<< +/D [1015 0 R /XYZ 98.895 753.953 null] >> % 220 0 obj << -/D [1014 0 R /XYZ 99.895 716.092 null] +/D [1015 0 R /XYZ 99.895 716.092 null] >> -% 1013 0 obj +% 1014 0 obj << /Font << /F16 582 0 R /F8 585 0 R >> /ProcSet [ /PDF /Text ] >> -% 1026 0 obj +% 1027 0 obj << /Type /Page -/Contents 1027 0 R -/Resources 1025 0 R +/Contents 1028 0 R +/Resources 1026 0 R /MediaBox [0 0 595.276 841.89] -/Parent 992 0 R -/Annots [ 1018 0 R 1019 0 R 1020 0 R 1021 0 R 1022 0 R 1023 0 R ] +/Parent 993 0 R +/Annots [ 1019 0 R 1020 0 R 1021 0 R 1022 0 R 1023 0 R 1024 0 R ] >> -% 1018 0 obj +% 1019 0 obj << /Type /Annot /Subtype /Link @@ -10129,7 +10136,7 @@ stream /Rect [432.897 401.949 439.871 412.798] /A << /S /GoTo /D (table.1) >> >> -% 1019 0 obj +% 1020 0 obj << /Type /Annot /Subtype /Link @@ -10137,7 +10144,7 @@ stream /Rect [419.358 333.522 495.412 344.647] /A << /S /GoTo /D (vdata) >> >> -% 1020 0 obj +% 1021 0 obj << /Type /Annot /Subtype /Link @@ -10145,7 +10152,7 @@ stream /Rect [379.142 321.844 386.116 332.692] /A << /S /GoTo /D (table.1) >> >> -% 1021 0 obj +% 1022 0 obj << /Type /Annot /Subtype /Link @@ -10153,7 +10160,7 @@ stream /Rect [432.897 241.738 439.871 252.586] /A << /S /GoTo /D (table.1) >> >> -% 1022 0 obj +% 1023 0 obj << /Type /Annot /Subtype /Link @@ -10161,7 +10168,7 @@ stream /Rect [419.358 173.311 495.412 184.436] /A << /S /GoTo /D (vdata) >> >> -% 1023 0 obj +% 1024 0 obj << /Type /Annot /Subtype /Link @@ -10169,33 +10176,33 @@ stream /Rect [396.435 161.632 403.409 172.481] /A << /S /GoTo /D (table.1) >> >> -% 1028 0 obj +% 1029 0 obj << -/D [1026 0 R /XYZ 149.705 753.953 null] +/D [1027 0 R /XYZ 149.705 753.953 null] >> % 224 0 obj << -/D [1026 0 R /XYZ 150.705 716.092 null] +/D [1027 0 R /XYZ 150.705 716.092 null] >> -% 999 0 obj +% 1000 0 obj << -/D [1026 0 R /XYZ 318.451 539.42 null] +/D [1027 0 R /XYZ 318.451 539.42 null] >> -% 1025 0 obj +% 1026 0 obj << -/Font << /F16 582 0 R /F8 585 0 R /F11 796 0 R /F14 813 0 R /F30 810 0 R /F27 584 0 R >> +/Font << /F16 582 0 R /F8 585 0 R /F11 797 0 R /F14 814 0 R /F30 811 0 R /F27 584 0 R >> /ProcSet [ /PDF /Text ] >> -% 1032 0 obj +% 1033 0 obj << /Type /Page -/Contents 1033 0 R -/Resources 1031 0 R +/Contents 1034 0 R +/Resources 1032 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1035 0 R -/Annots [ 1024 0 R 1029 0 R 1030 0 R ] +/Parent 1036 0 R +/Annots [ 1025 0 R 1030 0 R 1031 0 R ] >> -% 1024 0 obj +% 1025 0 obj << /Type /Annot /Subtype /Link @@ -10203,7 +10210,7 @@ stream /Rect [259.464 679.008 326.522 690.133] /A << /S /GoTo /D (descdata) >> >> -% 1029 0 obj +% 1030 0 obj << /Type /Annot /Subtype /Link @@ -10211,7 +10218,7 @@ stream /Rect [368.549 589.345 444.603 600.47] /A << /S /GoTo /D (vdata) >> >> -% 1030 0 obj +% 1031 0 obj << /Type /Annot /Subtype /Link @@ -10219,25 +10226,25 @@ stream /Rect [345.558 577.666 352.532 588.514] /A << /S /GoTo /D (table.1) >> >> -% 1034 0 obj +% 1035 0 obj << -/D [1032 0 R /XYZ 98.895 753.953 null] +/D [1033 0 R /XYZ 98.895 753.953 null] >> -% 1031 0 obj +% 1032 0 obj << -/Font << /F8 585 0 R /F27 584 0 R /F30 810 0 R /F11 796 0 R >> +/Font << /F8 585 0 R /F27 584 0 R /F30 811 0 R /F11 797 0 R >> /ProcSet [ /PDF /Text ] >> -% 1042 0 obj +% 1043 0 obj << /Type /Page -/Contents 1043 0 R -/Resources 1041 0 R +/Contents 1044 0 R +/Resources 1042 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1035 0 R -/Annots [ 1036 0 R 1037 0 R 1038 0 R 1039 0 R 1040 0 R ] +/Parent 1036 0 R +/Annots [ 1037 0 R 1038 0 R 1039 0 R 1040 0 R 1041 0 R ] >> -% 1036 0 obj +% 1037 0 obj << /Type /Annot /Subtype /Link @@ -10245,7 +10252,7 @@ stream /Rect [419.358 355.465 495.412 366.59] /A << /S /GoTo /D (vdata) >> >> -% 1037 0 obj +% 1038 0 obj << /Type /Annot /Subtype /Link @@ -10253,7 +10260,7 @@ stream /Rect [379.142 343.787 386.116 354.635] /A << /S /GoTo /D (table.2) >> >> -% 1038 0 obj +% 1039 0 obj << /Type /Annot /Subtype /Link @@ -10261,7 +10268,7 @@ stream /Rect [419.358 264.06 495.412 275.185] /A << /S /GoTo /D (vdata) >> >> -% 1039 0 obj +% 1040 0 obj << /Type /Annot /Subtype /Link @@ -10269,7 +10276,7 @@ stream /Rect [379.353 252.382 386.327 263.23] /A << /S /GoTo /D (table.2) >> >> -% 1040 0 obj +% 1041 0 obj << /Type /Annot /Subtype /Link @@ -10277,91 +10284,91 @@ stream /Rect [310.273 172.655 377.331 183.78] /A << /S /GoTo /D (descdata) >> >> -% 1044 0 obj +% 1045 0 obj << -/D [1042 0 R /XYZ 149.705 753.953 null] +/D [1043 0 R /XYZ 149.705 753.953 null] >> % 228 0 obj << -/D [1042 0 R /XYZ 150.705 716.092 null] ->> -% 1045 0 obj -<< -/D [1042 0 R /XYZ 318.451 490.516 null] ->> -% 1041 0 obj -<< -/Font << /F16 582 0 R /F8 585 0 R /F11 796 0 R /F14 813 0 R /F10 812 0 R /F30 810 0 R /F27 584 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1048 0 obj -<< -/Type /Page -/Contents 1049 0 R -/Resources 1047 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1035 0 R -/Annots [ 1046 0 R ] +/D [1043 0 R /XYZ 150.705 716.092 null] >> % 1046 0 obj << +/D [1043 0 R /XYZ 318.451 490.516 null] +>> +% 1042 0 obj +<< +/Font << /F16 582 0 R /F8 585 0 R /F11 797 0 R /F14 814 0 R /F10 813 0 R /F30 811 0 R /F27 584 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1049 0 obj +<< +/Type /Page +/Contents 1050 0 R +/Resources 1048 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1036 0 R +/Annots [ 1047 0 R ] +>> +% 1047 0 obj +<< /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] /Rect [382.088 603.569 389.062 614.417] /A << /S /GoTo /D (table.2) >> >> -% 1050 0 obj -<< -/D [1048 0 R /XYZ 98.895 753.953 null] ->> % 1051 0 obj << -/D [1048 0 R /XYZ 99.895 512.854 null] +/D [1049 0 R /XYZ 98.895 753.953 null] >> % 1052 0 obj << -/D [1048 0 R /XYZ 99.895 453.133 null] +/D [1049 0 R /XYZ 99.895 512.854 null] >> % 1053 0 obj << -/D [1048 0 R /XYZ 124.802 455.07 null] +/D [1049 0 R /XYZ 99.895 453.133 null] >> % 1054 0 obj << -/D [1048 0 R /XYZ 124.802 443.115 null] +/D [1049 0 R /XYZ 124.802 455.07 null] >> % 1055 0 obj << -/D [1048 0 R /XYZ 124.802 431.16 null] +/D [1049 0 R /XYZ 124.802 443.115 null] >> % 1056 0 obj << -/D [1048 0 R /XYZ 124.802 419.205 null] ->> -% 1047 0 obj -<< -/Font << /F8 585 0 R /F27 584 0 R /F30 810 0 R /F11 796 0 R /F16 582 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1064 0 obj -<< -/Type /Page -/Contents 1065 0 R -/Resources 1063 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1035 0 R -/Annots [ 1057 0 R 1058 0 R 1059 0 R 1060 0 R 1061 0 R 1062 0 R ] +/D [1049 0 R /XYZ 124.802 431.16 null] >> % 1057 0 obj << +/D [1049 0 R /XYZ 124.802 419.205 null] +>> +% 1048 0 obj +<< +/Font << /F8 585 0 R /F27 584 0 R /F30 811 0 R /F11 797 0 R /F16 582 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1065 0 obj +<< +/Type /Page +/Contents 1066 0 R +/Resources 1064 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1036 0 R +/Annots [ 1058 0 R 1059 0 R 1060 0 R 1061 0 R 1062 0 R 1063 0 R ] +>> +% 1058 0 obj +<< /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] /Rect [419.358 382.111 495.412 393.236] /A << /S /GoTo /D (vdata) >> >> -% 1058 0 obj +% 1059 0 obj << /Type /Annot /Subtype /Link @@ -10369,7 +10376,7 @@ stream /Rect [379.142 370.432 386.116 381.28] /A << /S /GoTo /D (table.3) >> >> -% 1059 0 obj +% 1060 0 obj << /Type /Annot /Subtype /Link @@ -10377,7 +10384,7 @@ stream /Rect [419.358 291.951 495.412 303.076] /A << /S /GoTo /D (vdata) >> >> -% 1060 0 obj +% 1061 0 obj << /Type /Annot /Subtype /Link @@ -10385,7 +10392,7 @@ stream /Rect [379.353 280.273 386.327 291.121] /A << /S /GoTo /D (table.3) >> >> -% 1061 0 obj +% 1062 0 obj << /Type /Annot /Subtype /Link @@ -10393,7 +10400,7 @@ stream /Rect [310.273 201.792 377.331 212.917] /A << /S /GoTo /D (descdata) >> >> -% 1062 0 obj +% 1063 0 obj << /Type /Annot /Subtype /Link @@ -10401,50 +10408,50 @@ stream /Rect [202.013 119.329 208.986 128.24] /A << /S /GoTo /D (table.2) >> >> -% 1066 0 obj +% 1067 0 obj << -/D [1064 0 R /XYZ 149.705 753.953 null] +/D [1065 0 R /XYZ 149.705 753.953 null] >> % 232 0 obj << -/D [1064 0 R /XYZ 150.705 716.092 null] ->> -% 1067 0 obj -<< -/D [1064 0 R /XYZ 318.451 510.309 null] ->> -% 1063 0 obj -<< -/Font << /F16 582 0 R /F8 585 0 R /F11 796 0 R /F14 813 0 R /F10 812 0 R /F30 810 0 R /F27 584 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1069 0 obj -<< -/Type /Page -/Contents 1070 0 R -/Resources 1068 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1035 0 R ->> -% 1071 0 obj -<< -/D [1069 0 R /XYZ 98.895 753.953 null] +/D [1065 0 R /XYZ 150.705 716.092 null] >> % 1068 0 obj << +/D [1065 0 R /XYZ 318.451 510.309 null] +>> +% 1064 0 obj +<< +/Font << /F16 582 0 R /F8 585 0 R /F11 797 0 R /F14 814 0 R /F10 813 0 R /F30 811 0 R /F27 584 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1070 0 obj +<< +/Type /Page +/Contents 1071 0 R +/Resources 1069 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1036 0 R +>> +% 1072 0 obj +<< +/D [1070 0 R /XYZ 98.895 753.953 null] +>> +% 1069 0 obj +<< /Font << /F27 584 0 R /F8 585 0 R >> /ProcSet [ /PDF /Text ] >> -% 1076 0 obj +% 1077 0 obj << /Type /Page -/Contents 1077 0 R -/Resources 1075 0 R +/Contents 1078 0 R +/Resources 1076 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1035 0 R -/Annots [ 1072 0 R 1073 0 R 1074 0 R ] +/Parent 1036 0 R +/Annots [ 1073 0 R 1074 0 R 1075 0 R ] >> -% 1072 0 obj +% 1073 0 obj << /Type /Annot /Subtype /Link @@ -10452,7 +10459,7 @@ stream /Rect [419.358 315.41 495.412 326.535] /A << /S /GoTo /D (vdata) >> >> -% 1073 0 obj +% 1074 0 obj << /Type /Annot /Subtype /Link @@ -10460,7 +10467,7 @@ stream /Rect [376.221 303.732 383.195 314.58] /A << /S /GoTo /D (table.4) >> >> -% 1074 0 obj +% 1075 0 obj << /Type /Annot /Subtype /Link @@ -10468,74 +10475,74 @@ stream /Rect [310.273 233.372 377.331 244.497] /A << /S /GoTo /D (descdata) >> >> -% 1078 0 obj +% 1079 0 obj << -/D [1076 0 R /XYZ 149.705 753.953 null] +/D [1077 0 R /XYZ 149.705 753.953 null] >> % 236 0 obj << -/D [1076 0 R /XYZ 150.705 716.092 null] ->> -% 1079 0 obj -<< -/D [1076 0 R /XYZ 318.451 459.44 null] ->> -% 1075 0 obj -<< -/Font << /F16 582 0 R /F8 585 0 R /F11 796 0 R /F14 813 0 R /F10 812 0 R /F30 810 0 R /F27 584 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1081 0 obj -<< -/Type /Page -/Contents 1082 0 R -/Resources 1080 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1090 0 R ->> -% 1083 0 obj -<< -/D [1081 0 R /XYZ 98.895 753.953 null] ->> -% 1084 0 obj -<< -/D [1081 0 R /XYZ 99.895 576.615 null] ->> -% 1085 0 obj -<< -/D [1081 0 R /XYZ 99.895 516.894 null] ->> -% 1086 0 obj -<< -/D [1081 0 R /XYZ 124.802 518.831 null] ->> -% 1087 0 obj -<< -/D [1081 0 R /XYZ 124.802 506.876 null] ->> -% 1088 0 obj -<< -/D [1081 0 R /XYZ 124.802 494.921 null] ->> -% 1089 0 obj -<< -/D [1081 0 R /XYZ 124.802 482.966 null] +/D [1077 0 R /XYZ 150.705 716.092 null] >> % 1080 0 obj << -/Font << /F27 584 0 R /F8 585 0 R /F11 796 0 R /F30 810 0 R /F16 582 0 R >> +/D [1077 0 R /XYZ 318.451 459.44 null] +>> +% 1076 0 obj +<< +/Font << /F16 582 0 R /F8 585 0 R /F11 797 0 R /F14 814 0 R /F10 813 0 R /F30 811 0 R /F27 584 0 R >> /ProcSet [ /PDF /Text ] >> -% 1095 0 obj +% 1082 0 obj << /Type /Page -/Contents 1096 0 R -/Resources 1094 0 R +/Contents 1083 0 R +/Resources 1081 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1090 0 R -/Annots [ 1091 0 R 1092 0 R 1093 0 R ] +/Parent 1091 0 R >> -% 1091 0 obj +% 1084 0 obj +<< +/D [1082 0 R /XYZ 98.895 753.953 null] +>> +% 1085 0 obj +<< +/D [1082 0 R /XYZ 99.895 576.615 null] +>> +% 1086 0 obj +<< +/D [1082 0 R /XYZ 99.895 516.894 null] +>> +% 1087 0 obj +<< +/D [1082 0 R /XYZ 124.802 518.831 null] +>> +% 1088 0 obj +<< +/D [1082 0 R /XYZ 124.802 506.876 null] +>> +% 1089 0 obj +<< +/D [1082 0 R /XYZ 124.802 494.921 null] +>> +% 1090 0 obj +<< +/D [1082 0 R /XYZ 124.802 482.966 null] +>> +% 1081 0 obj +<< +/Font << /F27 584 0 R /F8 585 0 R /F11 797 0 R /F30 811 0 R /F16 582 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1096 0 obj +<< +/Type /Page +/Contents 1097 0 R +/Resources 1095 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1091 0 R +/Annots [ 1092 0 R 1093 0 R 1094 0 R ] +>> +% 1092 0 obj << /Type /Annot /Subtype /Link @@ -10543,7 +10550,7 @@ stream /Rect [419.358 401.031 495.412 412.156] /A << /S /GoTo /D (vdata) >> >> -% 1092 0 obj +% 1093 0 obj << /Type /Annot /Subtype /Link @@ -10551,7 +10558,7 @@ stream /Rect [376.221 389.353 383.195 400.201] /A << /S /GoTo /D (table.5) >> >> -% 1093 0 obj +% 1094 0 obj << /Type /Annot /Subtype /Link @@ -10559,41 +10566,41 @@ stream /Rect [310.273 321.33 377.331 332.455] /A << /S /GoTo /D (descdata) >> >> -% 1097 0 obj +% 1098 0 obj << -/D [1095 0 R /XYZ 149.705 753.953 null] +/D [1096 0 R /XYZ 149.705 753.953 null] >> % 240 0 obj << -/D [1095 0 R /XYZ 150.705 716.092 null] ->> -% 1098 0 obj -<< -/D [1095 0 R /XYZ 318.451 537.464 null] ->> -% 1094 0 obj -<< -/Font << /F16 582 0 R /F8 585 0 R /F11 796 0 R /F14 813 0 R /F10 812 0 R /F30 810 0 R /F27 584 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1103 0 obj -<< -/Type /Page -/Contents 1104 0 R -/Resources 1102 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1090 0 R -/Annots [ 1099 0 R 1100 0 R 1101 0 R ] +/D [1096 0 R /XYZ 150.705 716.092 null] >> % 1099 0 obj << +/D [1096 0 R /XYZ 318.451 537.464 null] +>> +% 1095 0 obj +<< +/Font << /F16 582 0 R /F8 585 0 R /F11 797 0 R /F14 814 0 R /F10 813 0 R /F30 811 0 R /F27 584 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1104 0 obj +<< +/Type /Page +/Contents 1105 0 R +/Resources 1103 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1091 0 R +/Annots [ 1100 0 R 1101 0 R 1102 0 R ] +>> +% 1100 0 obj +<< /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] /Rect [368.549 359.763 444.603 370.887] /A << /S /GoTo /D (vdata) >> >> -% 1100 0 obj +% 1101 0 obj << /Type /Annot /Subtype /Link @@ -10601,7 +10608,7 @@ stream /Rect [325.411 348.084 332.385 358.932] /A << /S /GoTo /D (table.6) >> >> -% 1101 0 obj +% 1102 0 obj << /Type /Annot /Subtype /Link @@ -10609,74 +10616,74 @@ stream /Rect [259.464 281.168 326.522 292.293] /A << /S /GoTo /D (descdata) >> >> -% 1105 0 obj +% 1106 0 obj << -/D [1103 0 R /XYZ 98.895 753.953 null] +/D [1104 0 R /XYZ 98.895 753.953 null] >> % 244 0 obj << -/D [1103 0 R /XYZ 99.895 716.092 null] +/D [1104 0 R /XYZ 99.895 716.092 null] >> -% 1106 0 obj +% 1107 0 obj << -/D [1103 0 R /XYZ 267.641 490.109 null] +/D [1104 0 R /XYZ 267.641 490.109 null] >> -% 1102 0 obj +% 1103 0 obj << -/Font << /F16 582 0 R /F8 585 0 R /F11 796 0 R /F14 813 0 R /F10 812 0 R /F7 811 0 R /F30 810 0 R /F27 584 0 R >> +/Font << /F16 582 0 R /F8 585 0 R /F11 797 0 R /F14 814 0 R /F10 813 0 R /F7 812 0 R /F30 811 0 R /F27 584 0 R >> /ProcSet [ /PDF /Text ] >> -% 1108 0 obj +% 1109 0 obj << /Type /Page -/Contents 1109 0 R -/Resources 1107 0 R +/Contents 1110 0 R +/Resources 1108 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1090 0 R ->> -% 1110 0 obj -<< -/D [1108 0 R /XYZ 149.705 753.953 null] +/Parent 1091 0 R >> % 1111 0 obj << -/D [1108 0 R /XYZ 150.705 632.405 null] +/D [1109 0 R /XYZ 149.705 753.953 null] >> % 1112 0 obj << -/D [1108 0 R /XYZ 150.705 572.685 null] +/D [1109 0 R /XYZ 150.705 632.405 null] >> % 1113 0 obj << -/D [1108 0 R /XYZ 175.611 574.622 null] +/D [1109 0 R /XYZ 150.705 572.685 null] >> % 1114 0 obj << -/D [1108 0 R /XYZ 175.611 562.667 null] +/D [1109 0 R /XYZ 175.611 574.622 null] >> % 1115 0 obj << -/D [1108 0 R /XYZ 175.611 550.712 null] +/D [1109 0 R /XYZ 175.611 562.667 null] >> % 1116 0 obj << -/D [1108 0 R /XYZ 175.611 538.757 null] +/D [1109 0 R /XYZ 175.611 550.712 null] >> -% 1107 0 obj +% 1117 0 obj +<< +/D [1109 0 R /XYZ 175.611 538.757 null] +>> +% 1108 0 obj << /Font << /F27 584 0 R /F8 585 0 R /F16 582 0 R >> /ProcSet [ /PDF /Text ] >> -% 1121 0 obj +% 1122 0 obj << /Type /Page -/Contents 1122 0 R -/Resources 1120 0 R +/Contents 1123 0 R +/Resources 1121 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1090 0 R -/Annots [ 1117 0 R 1118 0 R 1119 0 R ] +/Parent 1091 0 R +/Annots [ 1118 0 R 1119 0 R 1120 0 R ] >> -% 1117 0 obj +% 1118 0 obj << /Type /Annot /Subtype /Link @@ -10684,7 +10691,7 @@ stream /Rect [368.549 289.84 444.603 300.965] /A << /S /GoTo /D (vdata) >> >> -% 1118 0 obj +% 1119 0 obj << /Type /Annot /Subtype /Link @@ -10692,18 +10699,10 @@ stream /Rect [325.411 278.162 332.385 289.01] /A << /S /GoTo /D (table.7) >> >> -% 1119 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [259.464 208.355 326.522 219.48] -/A << /S /GoTo /D (descdata) >> ->> endstream endobj -1128 0 obj +1129 0 obj << /Length 625 >> @@ -10722,7 +10721,7 @@ ET endstream endobj -1135 0 obj +1136 0 obj << /Length 6477 >> @@ -10893,7 +10892,7 @@ ET endstream endobj -1141 0 obj +1142 0 obj << /Length 4643 >> @@ -10972,7 +10971,7 @@ ET endstream endobj -1154 0 obj +1155 0 obj << /Length 6140 >> @@ -11133,7 +11132,7 @@ ET endstream endobj -1161 0 obj +1162 0 obj << /Length 5520 >> @@ -11287,7 +11286,7 @@ ET endstream endobj -1168 0 obj +1169 0 obj << /Length 5557 >> @@ -11441,7 +11440,7 @@ ET endstream endobj -1179 0 obj +1180 0 obj << /Length 7334 >> @@ -11616,7 +11615,7 @@ ET endstream endobj -1194 0 obj +1195 0 obj << /Length 6993 >> @@ -11746,7 +11745,7 @@ ET endstream endobj -1201 0 obj +1202 0 obj << /Length 6783 >> @@ -11858,7 +11857,7 @@ ET endstream endobj -1212 0 obj +1213 0 obj << /Length 7790 >> @@ -12016,7 +12015,7 @@ ET endstream endobj -1218 0 obj +1219 0 obj << /Length 4678 >> @@ -12075,7 +12074,7 @@ ET endstream endobj -1229 0 obj +1230 0 obj << /Length 7444 >> @@ -12294,68 +12293,76 @@ ET endstream endobj -1125 0 obj +1126 0 obj << /Type /ObjStm /N 100 -/First 989 -/Length 12346 +/First 992 +/Length 12438 >> stream -1123 0 248 58 1124 115 1120 174 1127 331 1129 449 1126 508 1134 588 1130 745 1131 889 -1132 1035 1136 1182 252 1240 1137 1297 1133 1356 1140 1501 1142 1619 1143 1678 1144 1737 1145 1796 -1146 1855 1147 1914 1148 1973 1139 2032 1153 2151 1149 2308 1150 2452 1151 2597 1155 2744 256 2802 -1156 2859 1152 2918 1160 3062 1157 3210 1158 3355 1162 3502 260 3561 1163 3619 1159 3678 1167 3822 -1164 3970 1165 4115 1169 4262 264 4320 1171 4377 1166 4436 1178 4582 1172 4748 1173 4895 1174 5040 -1175 5184 1180 5331 268 5390 1181 5448 1182 5507 1183 5566 1184 5625 1177 5684 1193 5841 1176 6043 -1185 6190 1186 6333 1187 6479 1188 6626 1189 6777 1190 6928 1191 7078 1195 7223 1192 7281 1200 7387 -1197 7526 1202 7672 272 7731 1203 7789 1199 7848 1211 8019 1198 8212 1204 8360 1205 8504 1206 8651 -1207 8798 1208 8942 1209 9089 1213 9235 1210 9293 1217 9425 1214 9573 1215 9720 1219 9867 1216 9926 -1228 10032 1220 10225 1221 10369 1222 10515 1223 10659 1224 10805 1225 10952 1226 11096 1230 11242 276 11300 -% 1123 0 obj +1120 0 1124 146 248 204 1125 261 1121 320 1128 477 1130 595 1127 654 1135 734 1131 891 +1132 1035 1133 1181 1137 1328 252 1386 1138 1443 1134 1502 1141 1647 1143 1765 1144 1824 1145 1883 +1146 1942 1147 2001 1148 2060 1149 2119 1140 2178 1154 2297 1150 2454 1151 2598 1152 2743 1156 2890 +256 2948 1157 3005 1153 3064 1161 3208 1158 3356 1159 3501 1163 3648 260 3707 1164 3765 1160 3824 +1168 3968 1165 4116 1166 4261 1170 4408 264 4466 1172 4523 1167 4582 1179 4728 1173 4894 1174 5041 +1175 5186 1176 5330 1181 5477 268 5536 1182 5594 1183 5653 1184 5712 1185 5771 1178 5830 1194 5987 +1177 6189 1186 6336 1187 6479 1188 6625 1189 6772 1190 6923 1191 7074 1192 7224 1196 7369 1193 7427 +1201 7533 1198 7672 1203 7818 272 7877 1204 7935 1200 7994 1212 8165 1199 8358 1205 8506 1206 8650 +1207 8797 1208 8944 1209 9088 1210 9235 1214 9381 1211 9439 1218 9571 1215 9719 1216 9866 1220 10013 +1217 10072 1229 10178 1221 10371 1222 10515 1223 10661 1224 10805 1225 10951 1226 11098 1227 11242 1231 11388 +% 1120 0 obj << -/D [1121 0 R /XYZ 98.895 753.953 null] ->> -% 248 0 obj -<< -/D [1121 0 R /XYZ 99.895 716.092 null] +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [259.464 208.355 326.522 219.48] +/A << /S /GoTo /D (descdata) >> >> % 1124 0 obj << -/D [1121 0 R /XYZ 267.641 432.072 null] +/D [1122 0 R /XYZ 98.895 753.953 null] >> -% 1120 0 obj +% 248 0 obj << -/Font << /F16 582 0 R /F8 585 0 R /F11 796 0 R /F14 813 0 R /F10 812 0 R /F7 811 0 R /F30 810 0 R /F27 584 0 R >> +/D [1122 0 R /XYZ 99.895 716.092 null] +>> +% 1125 0 obj +<< +/D [1122 0 R /XYZ 267.641 432.072 null] +>> +% 1121 0 obj +<< +/Font << /F16 582 0 R /F8 585 0 R /F11 797 0 R /F14 814 0 R /F10 813 0 R /F7 812 0 R /F30 811 0 R /F27 584 0 R >> /ProcSet [ /PDF /Text ] >> -% 1127 0 obj +% 1128 0 obj << /Type /Page -/Contents 1128 0 R -/Resources 1126 0 R +/Contents 1129 0 R +/Resources 1127 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1090 0 R +/Parent 1091 0 R >> -% 1129 0 obj +% 1130 0 obj << -/D [1127 0 R /XYZ 149.705 753.953 null] +/D [1128 0 R /XYZ 149.705 753.953 null] >> -% 1126 0 obj +% 1127 0 obj << /Font << /F27 584 0 R /F8 585 0 R >> /ProcSet [ /PDF /Text ] >> -% 1134 0 obj +% 1135 0 obj << /Type /Page -/Contents 1135 0 R -/Resources 1133 0 R +/Contents 1136 0 R +/Resources 1134 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1138 0 R -/Annots [ 1130 0 R 1131 0 R 1132 0 R ] +/Parent 1139 0 R +/Annots [ 1131 0 R 1132 0 R 1133 0 R ] >> -% 1130 0 obj +% 1131 0 obj << /Type /Annot /Subtype /Link @@ -12363,7 +12370,7 @@ stream /Rect [368.549 316.653 444.603 327.778] /A << /S /GoTo /D (vdata) >> >> -% 1131 0 obj +% 1132 0 obj << /Type /Annot /Subtype /Link @@ -12371,7 +12378,7 @@ stream /Rect [325.411 304.975 332.385 315.823] /A << /S /GoTo /D (table.8) >> >> -% 1132 0 obj +% 1133 0 obj << /Type /Annot /Subtype /Link @@ -12379,82 +12386,82 @@ stream /Rect [259.464 234.201 326.522 245.325] /A << /S /GoTo /D (descdata) >> >> -% 1136 0 obj +% 1137 0 obj << -/D [1134 0 R /XYZ 98.895 753.953 null] +/D [1135 0 R /XYZ 98.895 753.953 null] >> % 252 0 obj << -/D [1134 0 R /XYZ 99.895 716.092 null] +/D [1135 0 R /XYZ 99.895 716.092 null] >> -% 1137 0 obj +% 1138 0 obj << -/D [1134 0 R /XYZ 267.641 500.643 null] +/D [1135 0 R /XYZ 267.641 500.643 null] >> -% 1133 0 obj +% 1134 0 obj << -/Font << /F16 582 0 R /F8 585 0 R /F11 796 0 R /F14 813 0 R /F10 812 0 R /F27 584 0 R /F30 810 0 R >> +/Font << /F16 582 0 R /F8 585 0 R /F11 797 0 R /F14 814 0 R /F10 813 0 R /F27 584 0 R /F30 811 0 R >> /ProcSet [ /PDF /Text ] >> -% 1140 0 obj +% 1141 0 obj << /Type /Page -/Contents 1141 0 R -/Resources 1139 0 R +/Contents 1142 0 R +/Resources 1140 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1138 0 R ->> -% 1142 0 obj -<< -/D [1140 0 R /XYZ 149.705 753.953 null] +/Parent 1139 0 R >> % 1143 0 obj << -/D [1140 0 R /XYZ 150.705 564.659 null] +/D [1141 0 R /XYZ 149.705 753.953 null] >> % 1144 0 obj << -/D [1140 0 R /XYZ 150.705 504.939 null] +/D [1141 0 R /XYZ 150.705 564.659 null] >> % 1145 0 obj << -/D [1140 0 R /XYZ 175.611 506.876 null] +/D [1141 0 R /XYZ 150.705 504.939 null] >> % 1146 0 obj << -/D [1140 0 R /XYZ 175.611 494.921 null] +/D [1141 0 R /XYZ 175.611 506.876 null] >> % 1147 0 obj << -/D [1140 0 R /XYZ 175.611 482.966 null] +/D [1141 0 R /XYZ 175.611 494.921 null] >> % 1148 0 obj << -/D [1140 0 R /XYZ 175.611 471.011 null] ->> -% 1139 0 obj -<< -/Font << /F27 584 0 R /F8 585 0 R /F11 796 0 R /F30 810 0 R /F16 582 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1153 0 obj -<< -/Type /Page -/Contents 1154 0 R -/Resources 1152 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1138 0 R -/Annots [ 1149 0 R 1150 0 R 1151 0 R ] +/D [1141 0 R /XYZ 175.611 482.966 null] >> % 1149 0 obj << +/D [1141 0 R /XYZ 175.611 471.011 null] +>> +% 1140 0 obj +<< +/Font << /F27 584 0 R /F8 585 0 R /F11 797 0 R /F30 811 0 R /F16 582 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1154 0 obj +<< +/Type /Page +/Contents 1155 0 R +/Resources 1153 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1139 0 R +/Annots [ 1150 0 R 1151 0 R 1152 0 R ] +>> +% 1150 0 obj +<< /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] /Rect [368.549 404.491 444.603 415.616] /A << /S /GoTo /D (vdata) >> >> -% 1150 0 obj +% 1151 0 obj << /Type /Annot /Subtype /Link @@ -12462,7 +12469,7 @@ stream /Rect [325.411 392.812 332.385 403.66] /A << /S /GoTo /D (table.9) >> >> -% 1151 0 obj +% 1152 0 obj << /Type /Annot /Subtype /Link @@ -12470,41 +12477,41 @@ stream /Rect [259.464 324.789 326.522 335.914] /A << /S /GoTo /D (descdata) >> >> -% 1155 0 obj +% 1156 0 obj << -/D [1153 0 R /XYZ 98.895 753.953 null] +/D [1154 0 R /XYZ 98.895 753.953 null] >> % 256 0 obj << -/D [1153 0 R /XYZ 99.895 716.092 null] ->> -% 1156 0 obj -<< -/D [1153 0 R /XYZ 267.641 540.923 null] ->> -% 1152 0 obj -<< -/Font << /F16 582 0 R /F8 585 0 R /F11 796 0 R /F14 813 0 R /F7 811 0 R /F30 810 0 R /F27 584 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1160 0 obj -<< -/Type /Page -/Contents 1161 0 R -/Resources 1159 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1138 0 R -/Annots [ 1157 0 R 1158 0 R ] +/D [1154 0 R /XYZ 99.895 716.092 null] >> % 1157 0 obj << +/D [1154 0 R /XYZ 267.641 540.923 null] +>> +% 1153 0 obj +<< +/Font << /F16 582 0 R /F8 585 0 R /F11 797 0 R /F14 814 0 R /F7 812 0 R /F30 811 0 R /F27 584 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1161 0 obj +<< +/Type /Page +/Contents 1162 0 R +/Resources 1160 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1139 0 R +/Annots [ 1158 0 R 1159 0 R ] +>> +% 1158 0 obj +<< /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] /Rect [310.273 342.722 387.792 353.847] /A << /S /GoTo /D (spdata) >> >> -% 1158 0 obj +% 1159 0 obj << /Type /Annot /Subtype /Link @@ -12512,41 +12519,41 @@ stream /Rect [310.273 274.976 377.331 286.101] /A << /S /GoTo /D (descdata) >> >> -% 1162 0 obj +% 1163 0 obj << -/D [1160 0 R /XYZ 149.705 753.953 null] +/D [1161 0 R /XYZ 149.705 753.953 null] >> % 260 0 obj << -/D [1160 0 R /XYZ 150.705 716.092 null] ->> -% 1163 0 obj -<< -/D [1160 0 R /XYZ 320.941 513.305 null] ->> -% 1159 0 obj -<< -/Font << /F16 582 0 R /F8 585 0 R /F11 796 0 R /F14 813 0 R /F7 811 0 R /F27 584 0 R /F30 810 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1167 0 obj -<< -/Type /Page -/Contents 1168 0 R -/Resources 1166 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1138 0 R -/Annots [ 1164 0 R 1165 0 R ] +/D [1161 0 R /XYZ 150.705 716.092 null] >> % 1164 0 obj << +/D [1161 0 R /XYZ 320.941 513.305 null] +>> +% 1160 0 obj +<< +/Font << /F16 582 0 R /F8 585 0 R /F11 797 0 R /F14 814 0 R /F7 812 0 R /F27 584 0 R /F30 811 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1168 0 obj +<< +/Type /Page +/Contents 1169 0 R +/Resources 1167 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1139 0 R +/Annots [ 1165 0 R 1166 0 R ] +>> +% 1165 0 obj +<< /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] /Rect [259.464 342.722 336.983 353.847] /A << /S /GoTo /D (spdata) >> >> -% 1165 0 obj +% 1166 0 obj << /Type /Annot /Subtype /Link @@ -12554,41 +12561,41 @@ stream /Rect [259.464 274.976 326.522 286.101] /A << /S /GoTo /D (descdata) >> >> -% 1169 0 obj +% 1170 0 obj << -/D [1167 0 R /XYZ 98.895 753.953 null] +/D [1168 0 R /XYZ 98.895 753.953 null] >> % 264 0 obj << -/D [1167 0 R /XYZ 99.895 716.092 null] ->> -% 1171 0 obj -<< -/D [1167 0 R /XYZ 270.132 513.305 null] ->> -% 1166 0 obj -<< -/Font << /F16 582 0 R /F8 585 0 R /F11 796 0 R /F14 813 0 R /F13 1170 0 R /F27 584 0 R /F30 810 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1178 0 obj -<< -/Type /Page -/Contents 1179 0 R -/Resources 1177 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1138 0 R -/Annots [ 1172 0 R 1173 0 R 1174 0 R 1175 0 R ] +/D [1168 0 R /XYZ 99.895 716.092 null] >> % 1172 0 obj << +/D [1168 0 R /XYZ 270.132 513.305 null] +>> +% 1167 0 obj +<< +/Font << /F16 582 0 R /F8 585 0 R /F11 797 0 R /F14 814 0 R /F13 1171 0 R /F27 584 0 R /F30 811 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1179 0 obj +<< +/Type /Page +/Contents 1180 0 R +/Resources 1178 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1139 0 R +/Annots [ 1173 0 R 1174 0 R 1175 0 R 1176 0 R ] +>> +% 1173 0 obj +<< /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] /Rect [432.897 274.798 444.852 285.646] /A << /S /GoTo /D (table.12) >> >> -% 1173 0 obj +% 1174 0 obj << /Type /Annot /Subtype /Link @@ -12596,7 +12603,7 @@ stream /Rect [310.273 207.773 387.792 218.898] /A << /S /GoTo /D (spdata) >> >> -% 1174 0 obj +% 1175 0 obj << /Type /Annot /Subtype /Link @@ -12604,7 +12611,7 @@ stream /Rect [419.358 141.026 495.412 152.151] /A << /S /GoTo /D (vdata) >> >> -% 1175 0 obj +% 1176 0 obj << /Type /Annot /Subtype /Link @@ -12612,45 +12619,45 @@ stream /Rect [376.818 129.347 388.773 140.196] /A << /S /GoTo /D (table.12) >> >> -% 1180 0 obj +% 1181 0 obj << -/D [1178 0 R /XYZ 149.705 753.953 null] +/D [1179 0 R /XYZ 149.705 753.953 null] >> % 268 0 obj << -/D [1178 0 R /XYZ 150.705 716.092 null] ->> -% 1181 0 obj -<< -/D [1178 0 R /XYZ 290.613 661.837 null] +/D [1179 0 R /XYZ 150.705 716.092 null] >> % 1182 0 obj << -/D [1178 0 R /XYZ 287.475 645.402 null] +/D [1179 0 R /XYZ 290.613 661.837 null] >> % 1183 0 obj << -/D [1178 0 R /XYZ 286.835 628.966 null] +/D [1179 0 R /XYZ 287.475 645.402 null] >> % 1184 0 obj << -/D [1178 0 R /XYZ 320.941 449.071 null] +/D [1179 0 R /XYZ 286.835 628.966 null] >> -% 1177 0 obj +% 1185 0 obj << -/Font << /F16 582 0 R /F8 585 0 R /F11 796 0 R /F14 813 0 R /F10 812 0 R /F7 811 0 R /F27 584 0 R /F30 810 0 R >> +/D [1179 0 R /XYZ 320.941 449.071 null] +>> +% 1178 0 obj +<< +/Font << /F16 582 0 R /F8 585 0 R /F11 797 0 R /F14 814 0 R /F10 813 0 R /F7 812 0 R /F27 584 0 R /F30 811 0 R >> /ProcSet [ /PDF /Text ] >> -% 1193 0 obj +% 1194 0 obj << /Type /Page -/Contents 1194 0 R -/Resources 1192 0 R +/Contents 1195 0 R +/Resources 1193 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1196 0 R -/Annots [ 1176 0 R 1185 0 R 1186 0 R 1187 0 R 1188 0 R 1189 0 R 1190 0 R 1191 0 R ] +/Parent 1197 0 R +/Annots [ 1177 0 R 1186 0 R 1187 0 R 1188 0 R 1189 0 R 1190 0 R 1191 0 R 1192 0 R ] >> -% 1176 0 obj +% 1177 0 obj << /Type /Annot /Subtype /Link @@ -12658,7 +12665,7 @@ stream /Rect [382.088 655.375 394.043 666.223] /A << /S /GoTo /D (table.12) >> >> -% 1185 0 obj +% 1186 0 obj << /Type /Annot /Subtype /Link @@ -12666,7 +12673,7 @@ stream /Rect [368.549 588.68 444.603 599.805] /A << /S /GoTo /D (vdata) >> >> -% 1186 0 obj +% 1187 0 obj << /Type /Annot /Subtype /Link @@ -12674,7 +12681,7 @@ stream /Rect [326.219 577.002 338.174 587.85] /A << /S /GoTo /D (table.12) >> >> -% 1187 0 obj +% 1188 0 obj << /Type /Annot /Subtype /Link @@ -12682,7 +12689,7 @@ stream /Rect [259.464 498.352 326.522 509.477] /A << /S /GoTo /D (descdata) >> >> -% 1188 0 obj +% 1189 0 obj << /Type /Annot /Subtype /Link @@ -12690,7 +12697,7 @@ stream /Rect [346.389 461.435 353.363 472.284] /A << /S /GoTo /D (equation.4.1) >> >> -% 1189 0 obj +% 1190 0 obj << /Type /Annot /Subtype /Link @@ -12698,7 +12705,7 @@ stream /Rect [345.393 446.823 352.367 457.672] /A << /S /GoTo /D (equation.4.2) >> >> -% 1190 0 obj +% 1191 0 obj << /Type /Annot /Subtype /Link @@ -12706,7 +12713,7 @@ stream /Rect [345.697 432.212 352.671 443.06] /A << /S /GoTo /D (equation.4.3) >> >> -% 1191 0 obj +% 1192 0 obj << /Type /Annot /Subtype /Link @@ -12714,25 +12721,25 @@ stream /Rect [203.009 190.452 214.964 201.3] /A << /S /GoTo /D (table.12) >> >> -% 1195 0 obj +% 1196 0 obj << -/D [1193 0 R /XYZ 98.895 753.953 null] +/D [1194 0 R /XYZ 98.895 753.953 null] >> -% 1192 0 obj +% 1193 0 obj << -/Font << /F27 584 0 R /F8 585 0 R /F11 796 0 R /F30 810 0 R >> +/Font << /F27 584 0 R /F8 585 0 R /F11 797 0 R /F30 811 0 R >> /ProcSet [ /PDF /Text ] >> -% 1200 0 obj +% 1201 0 obj << /Type /Page -/Contents 1201 0 R -/Resources 1199 0 R +/Contents 1202 0 R +/Resources 1200 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1196 0 R -/Annots [ 1197 0 R ] +/Parent 1197 0 R +/Annots [ 1198 0 R ] >> -% 1197 0 obj +% 1198 0 obj << /Type /Annot /Subtype /Link @@ -12740,33 +12747,33 @@ stream /Rect [432.897 117.392 444.852 128.24] /A << /S /GoTo /D (table.13) >> >> -% 1202 0 obj +% 1203 0 obj << -/D [1200 0 R /XYZ 149.705 753.953 null] +/D [1201 0 R /XYZ 149.705 753.953 null] >> % 272 0 obj << -/D [1200 0 R /XYZ 150.705 716.092 null] +/D [1201 0 R /XYZ 150.705 716.092 null] >> -% 1203 0 obj +% 1204 0 obj << -/D [1200 0 R /XYZ 320.941 258.477 null] +/D [1201 0 R /XYZ 320.941 258.477 null] >> -% 1199 0 obj +% 1200 0 obj << -/Font << /F16 582 0 R /F8 585 0 R /F11 796 0 R /F14 813 0 R /F13 1170 0 R /F7 811 0 R /F10 812 0 R /F30 810 0 R /F27 584 0 R >> +/Font << /F16 582 0 R /F8 585 0 R /F11 797 0 R /F14 814 0 R /F13 1171 0 R /F7 812 0 R /F10 813 0 R /F30 811 0 R /F27 584 0 R >> /ProcSet [ /PDF /Text ] >> -% 1211 0 obj +% 1212 0 obj << /Type /Page -/Contents 1212 0 R -/Resources 1210 0 R +/Contents 1213 0 R +/Resources 1211 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1196 0 R -/Annots [ 1198 0 R 1204 0 R 1205 0 R 1206 0 R 1207 0 R 1208 0 R 1209 0 R ] +/Parent 1197 0 R +/Annots [ 1199 0 R 1205 0 R 1206 0 R 1207 0 R 1208 0 R 1209 0 R 1210 0 R ] >> -% 1198 0 obj +% 1199 0 obj << /Type /Annot /Subtype /Link @@ -12774,7 +12781,7 @@ stream /Rect [307.672 655.375 314.646 666.223] /A << /S /GoTo /D (section.3) >> >> -% 1204 0 obj +% 1205 0 obj << /Type /Annot /Subtype /Link @@ -12782,7 +12789,7 @@ stream /Rect [368.549 586.627 444.603 597.752] /A << /S /GoTo /D (vdata) >> >> -% 1205 0 obj +% 1206 0 obj << /Type /Annot /Subtype /Link @@ -12790,7 +12797,7 @@ stream /Rect [326.008 574.949 337.963 585.797] /A << /S /GoTo /D (table.13) >> >> -% 1206 0 obj +% 1207 0 obj << /Type /Annot /Subtype /Link @@ -12798,7 +12805,7 @@ stream /Rect [382.088 494.523 394.043 505.372] /A << /S /GoTo /D (table.13) >> >> -% 1207 0 obj +% 1208 0 obj << /Type /Annot /Subtype /Link @@ -12806,7 +12813,7 @@ stream /Rect [368.549 425.776 444.603 436.901] /A << /S /GoTo /D (vdata) >> >> -% 1208 0 obj +% 1209 0 obj << /Type /Annot /Subtype /Link @@ -12814,7 +12821,7 @@ stream /Rect [326.219 414.098 338.174 424.946] /A << /S /GoTo /D (table.13) >> >> -% 1209 0 obj +% 1210 0 obj << /Type /Annot /Subtype /Link @@ -12822,25 +12829,25 @@ stream /Rect [259.464 333.395 326.522 344.52] /A << /S /GoTo /D (descdata) >> >> -% 1213 0 obj +% 1214 0 obj << -/D [1211 0 R /XYZ 98.895 753.953 null] +/D [1212 0 R /XYZ 98.895 753.953 null] >> -% 1210 0 obj +% 1211 0 obj << -/Font << /F27 584 0 R /F8 585 0 R /F11 796 0 R /F14 813 0 R /F30 810 0 R /F17 776 0 R >> +/Font << /F27 584 0 R /F8 585 0 R /F11 797 0 R /F14 814 0 R /F30 811 0 R /F17 777 0 R >> /ProcSet [ /PDF /Text ] >> -% 1217 0 obj +% 1218 0 obj << /Type /Page -/Contents 1218 0 R -/Resources 1216 0 R +/Contents 1219 0 R +/Resources 1217 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1196 0 R -/Annots [ 1214 0 R 1215 0 R ] +/Parent 1197 0 R +/Annots [ 1215 0 R 1216 0 R ] >> -% 1214 0 obj +% 1215 0 obj << /Type /Annot /Subtype /Link @@ -12848,7 +12855,7 @@ stream /Rect [213.636 410.238 225.591 419.149] /A << /S /GoTo /D (table.13) >> >> -% 1215 0 obj +% 1216 0 obj << /Type /Annot /Subtype /Link @@ -12856,25 +12863,25 @@ stream /Rect [253.818 228.974 265.774 239.822] /A << /S /GoTo /D (table.13) >> >> -% 1219 0 obj +% 1220 0 obj << -/D [1217 0 R /XYZ 149.705 753.953 null] +/D [1218 0 R /XYZ 149.705 753.953 null] >> -% 1216 0 obj +% 1217 0 obj << -/Font << /F8 585 0 R /F27 584 0 R /F11 796 0 R /F30 810 0 R >> +/Font << /F8 585 0 R /F27 584 0 R /F11 797 0 R /F30 811 0 R >> /ProcSet [ /PDF /Text ] >> -% 1228 0 obj +% 1229 0 obj << /Type /Page -/Contents 1229 0 R -/Resources 1227 0 R +/Contents 1230 0 R +/Resources 1228 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1196 0 R -/Annots [ 1220 0 R 1221 0 R 1222 0 R 1223 0 R 1224 0 R 1225 0 R 1226 0 R ] +/Parent 1197 0 R +/Annots [ 1221 0 R 1222 0 R 1223 0 R 1224 0 R 1225 0 R 1226 0 R 1227 0 R ] >> -% 1220 0 obj +% 1221 0 obj << /Type /Annot /Subtype /Link @@ -12882,7 +12889,7 @@ stream /Rect [265.833 388.024 341.887 399.149] /A << /S /GoTo /D (vdata) >> >> -% 1221 0 obj +% 1222 0 obj << /Type /Annot /Subtype /Link @@ -12890,7 +12897,7 @@ stream /Rect [225.425 376.346 232.399 387.194] /A << /S /GoTo /D (table.2) >> >> -% 1222 0 obj +% 1223 0 obj << /Type /Annot /Subtype /Link @@ -12898,7 +12905,7 @@ stream /Rect [265.833 305.353 341.887 316.478] /A << /S /GoTo /D (vdata) >> >> -% 1223 0 obj +% 1224 0 obj << /Type /Annot /Subtype /Link @@ -12906,7 +12913,7 @@ stream /Rect [225.425 293.674 232.399 304.523] /A << /S /GoTo /D (table.2) >> >> -% 1224 0 obj +% 1225 0 obj << /Type /Annot /Subtype /Link @@ -12914,7 +12921,7 @@ stream /Rect [259.464 222.682 326.522 233.807] /A << /S /GoTo /D (descdata) >> >> -% 1225 0 obj +% 1226 0 obj << /Type /Annot /Subtype /Link @@ -12922,7 +12929,7 @@ stream /Rect [265.833 129.071 341.887 140.196] /A << /S /GoTo /D (vdata) >> >> -% 1226 0 obj +% 1227 0 obj << /Type /Annot /Subtype /Link @@ -12930,18 +12937,14 @@ stream /Rect [245.572 117.392 257.527 128.24] /A << /S /GoTo /D (table.14) >> >> -% 1230 0 obj +% 1231 0 obj << -/D [1228 0 R /XYZ 98.895 753.953 null] ->> -% 276 0 obj -<< -/D [1228 0 R /XYZ 99.895 716.092 null] +/D [1229 0 R /XYZ 98.895 753.953 null] >> endstream endobj -1235 0 obj +1236 0 obj << /Length 625 >> @@ -12960,7 +12963,7 @@ ET endstream endobj -1246 0 obj +1247 0 obj << /Length 7432 >> @@ -13154,7 +13157,7 @@ ET endstream endobj -1252 0 obj +1253 0 obj << /Length 1485 >> @@ -13203,7 +13206,7 @@ ET endstream endobj -1261 0 obj +1262 0 obj << /Length 7499 >> @@ -13397,7 +13400,7 @@ ET endstream endobj -1267 0 obj +1268 0 obj << /Length 651 >> @@ -13417,7 +13420,7 @@ ET endstream endobj -1275 0 obj +1276 0 obj << /Length 7269 >> @@ -13614,7 +13617,7 @@ ET endstream endobj -1285 0 obj +1286 0 obj << /Length 3196 >> @@ -13667,20 +13670,20 @@ ET endstream endobj -1281 0 obj +1282 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./figures/try8x8.pdf) /PTEX.PageNumber 1 -/PTEX.InfoDict 1288 0 R +/PTEX.InfoDict 1289 0 R /BBox [0 0 498 439] /Resources << /ProcSet [ /PDF /Text ] /ExtGState << -/R7 1289 0 R ->>/Font << /R8 1290 0 R/R10 1291 0 R>> +/R7 1290 0 R +>>/Font << /R8 1291 0 R/R10 1292 0 R>> >> /Length 3349 /Filter /FlateDecode @@ -13692,7 +13695,7 @@ U1 †¸úµ6ÔÉ–O¹¬ÌWbàzSE 0¬àË®—Ψxܳ>P…Uƒ|úˆò¬Öhˆ³>ÜÝâð^ðyÿÔŽX<‰ï’<ÂÇfÔ1â@aÐMŠC5Ú¢"mZ½!qVÖÆ¢4"{^›ëéŠÏúÜÐZÌÈ&ŒÐÅLh=ébnh#ü©n¶BUÌ„&×]Õ ÝÅFS5Cg_QUÍðӂȯZ£!ö²{U5'"ýÈCS5 žßÛæzÖæI¿®+®÷ó'MÕ <Ïû«Ö†:%>A©ªfè\dðy׎X<™§úºv¬¸Þ¡4U3ð<ï¯ZêD ùp¥ªš¡â³þ®±xOðuíXÉ×9/<ŠRUÍÀ‰¿|p+q¥ªš¡³¨Áçý];bñ$>žÖëÚ±âz?ŽÒTÍÀó¼¿jm¨“~/žú[™¯Ä<¸ë‘Ïú»vÄâÉ|Cú€‹‘¯s^x(¥ªšá]ú€[!ÎúðS)MÕ ÞPÌïms=k_’} ×ONËÌê˜Gd×X¥YgSjT3âÔr°-J#²{Ë®ç_ŤŒ¹¡µ˜‘M¡‹™ÐzÒÅÜÐFøSÝl…ª˜ M®÷Ó[ÎÏŸŸåùËãý¤†¿õ8šÇ÷‰<ÿÓ”ÿüúøýQ=Æ×oÏ?~}üøåzÖöüúχÿeK}ŽãýÜò±ž_{üôCýô¹Ï£üÐ>}¥”:~ü<ðóÄωŸ×§Ÿ¿þåíÝíýŸšÇóë/Îñé뿟ߟvñvÿ®Ý¾k×ïÚeoë»öõ]{Þí·¯??·~¢ûCÞŸ#²ÚaYïá÷…–aXŽí)Ãüã—÷'W¯û³êíãýŸ¼žkà®3Ô{οþõÝ*ŸþðøÓ×Çßßÿþ{Ü endstream endobj -1294 0 obj +1295 0 obj << /Filter /FlateDecode /Subtype /Type1C @@ -13751,7 +13754,7 @@ r §¶¦^<ÜÛrc¨¯@vŒñ6@ì>Ƀ¿]Wž$Ÿ’‚Žòg]Qõïæ¡ yú½%N»©”Ô­®¡ÿ U…··OÀû›ÄëC’¿ð\uƒÏÏnÞ_~å¶ÏCðÀ ›*¤é%™4€Éó¾÷vÜýÉÜ¢%‰كœ‹l0^2”«›ÃFŒ~ 996®=¹¯§­½§/¹ ¼`ðÍ/üvà Ípć0µ´e4:GÕ*ð­Ùîó,ÕÈ-¥%¥|€ 4×TtÐuuúü$5¥”…Û‡+ëJ\Þf§o´Ë[q¼æÁ¯ñ€ˆC +ðÓE€Ï'Ãl>Ž„hà,@Ñ[hZßBÁAñ¾ÿ¸Mrïë òeJ}­×xsi@ŒB¿`Ð_ ðö‡„³À£‚)×y`mq»GÜÚÚúz’Û½bøáÙòMà‚æ| Ët„Zû€®ˆ)Њ ùÙŽ›èuµNÒÁŽc°©pÊM”SWáo3„©°r#€«½å] a×5ÄéÊÍ¿+Wy{ê?q*>;^›Z9ëÚÕ —ºyÞƇŒ¬pºˆ‹€'óÑ‚ó\©h"Õ²¿k¶px”’¦ÑتTŒÛÛRà)ú§°oǤ°„p!ÈUK¹ÍQìÿ,…KŸ endstream endobj -1295 0 obj +1296 0 obj << /Filter /FlateDecode /Subtype /Type1C @@ -13824,7 +13827,7 @@ k ÒOWk'T²_Ž–Pài³ì¤®¦$1R¸(Ïlç?Àÿñå¼£ endstream endobj -1298 0 obj +1299 0 obj << /Length 3050 >> @@ -13844,7 +13847,7 @@ ET endstream endobj -1307 0 obj +1308 0 obj << /Length 8492 >> @@ -14113,7 +14116,7 @@ ET endstream endobj -1319 0 obj +1320 0 obj << /Length 5866 >> @@ -14167,7 +14170,7 @@ ET endstream endobj -1327 0 obj +1328 0 obj << /Length 3619 >> @@ -14187,7 +14190,7 @@ ET endstream endobj -1331 0 obj +1332 0 obj << /Length 325 >> @@ -14218,20 +14221,20 @@ ET endstream endobj -1314 0 obj +1315 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./figures/try8x8_ov.pdf) /PTEX.PageNumber 1 -/PTEX.InfoDict 1333 0 R +/PTEX.InfoDict 1334 0 R /BBox [0 0 516 439] /Resources << /ProcSet [ /PDF /Text ] /ExtGState << -/R7 1334 0 R ->>/Font << /R8 1335 0 R/R10 1336 0 R>> +/R7 1335 0 R +>>/Font << /R8 1336 0 R/R10 1337 0 R>> >> /Length 3413 /Filter /FlateDecode @@ -14245,7 +14248,7 @@ x >÷­ õïÅ7z3óm‘W=ò™¿ªOækª¨ù*óÕ#_e}0¾h;ׇ©›öÄ‚ÏýUm°xßPyPÇp}gZz®ŽÎâˆè«43©cˆŸLÂ̵1Y][V½üέ¦†5½xò–Ï]Oh5ÕE_ÐZèSYd…UÑZR½´â6Tl4©^lÉ]·íMª×µ6ÔNÉ‹»&ž%Ä›ºõ)ÕÃýÍ?Ô‹'ñQõ†:V\ïꛉÁ¿Ö†ÚU ñ¦n±Ý|îêˆÅ“ù zC+®wu‹mÐàƒ_kCí*¾Â\Ýb[=øÜ?Ô‹'ñ •Gè˜_ß™–ž«£³8"ºÇ*ÍÌÐ1ŸLÂ̵1Y=Æ¢zÚð¬÷mŒ,…uÑZMuÑ´úTYaUô„&Õ[ö…›:ÖZG¨žvõ_ºP=ß-Fü®5lËãouÃYË*ïoþ¦ŽX<‰½M+®7uÓy„àsÿ®µ¡6‰Ácü­n:±|îoêˆÅ“ù°§ÛÔ±âzS7¤>÷ïZj?˜|®bä+ÌT|æoêˆÅ“ø¸}ÛÔ±’¯2/P=ò™×ÚP[¿àƒŠ1þ` z¼¿ù›:bñ$>îÔ6u¬¸ÞÔM§W‚Ïý»Ö†Úå}qÇwf¾-òàªG>ó7uÄâÉ|Mõ#_e^ z䫬ÆïZ£ÁÎõaꦓ9Áçþ¦ŽX<‰o¨<¨c¸¾3-=WGgqDô«43©cˆŸLÂ̵1YÝö¬zy?¶¥ž5½xò–Ï]Oh5ÕE_ÐZèSYd…UÑZR½tNÆm¨ØÔn†]·ÚÍðÓ3ˆïZ£Áö, ífณguj7 ?ÏUõÒ‘Ø%ñ¹º ífàóÜßµ6Ô¡ðQņv3tè)øÜ?Õ‹'óAõ¦:V\ïê6´›Ïs×ÚPçcÈÚÍÐq-ñ™ª#Oâ£êMu¬ä«Ì Uoh7Ç_jðQõºÖnŒ?˜ªÞÔn†.â繪^:Óâ6Tlj7Cà‚Ïý]kCzyñÌÌ|[äª7µ›†|YõÒñ·k®W·¡Ý òUÖã»Öh°s}¸º ífðþõÁøy®ª§“*nRÇfìfÄàë,Žˆî±J33tlÄnFI ¶ÉÒˆèy.ª§Ó)žõ¾ í‘‘¥0¢.zB«©.ú‚ÖBŸÊ"+¬ŠžÐ¤zíÐn†Û®b­i7Cg _Vµ›á§ _µFƒmYbü­n81iYåýͨ#OâãAÀC+®7uÓ©ÈàsÕÚP‡Ácü­n:7|î?Ô‹'óáÌß¡Ž×›ºé®?Œ÷Æå‡ñ¶ŽùÃxü0î÷øúz~ÙëDõ¹žDí‡E]Ó×…aXŽí!Í>øïŸ×düoõ–‘¿Ö«\¯ç­ÜýÌ•çë»ýô—w-ÿ/Iÿõv×ï!o'ÈŸÿ`[G. endstream endobj -1339 0 obj +1340 0 obj << /Filter /FlateDecode /Subtype /Type1C @@ -14304,7 +14307,7 @@ r §¶¦^<ÜÛrc¨¯@vŒñ6@ì>Ƀ¿]Wž$Ÿ’‚Žòg]Qõïæ¡ yú½%N»©”Ô­®¡ÿ U…··OÀû›ÄëC’¿ð\uƒÏÏnÞ_~å¶ÏCðÀ ›*¤é%™4€Éó¾÷vÜýÉÜ¢%‰كœ‹l0^2”«›ÃFŒ~ 996®=¹¯§­½§/¹ ¼`ðÍ/üvà Ípć0µ´e4:GÕ*ð­Ùîó,ÕÈ-¥%¥|€ 4×TtÐuuúü$5¥”…Û‡+ëJ\Þf§o´Ë[q¼æÁ¯ñ€ˆC +ðÓE€Ï'Ãl>Ž„hà,@Ñ[hZßBÁAñ¾ÿ¸Mrïë òeJ}­×xsi@ŒB¿`Ð_ ðö‡„³À£‚)×y`mq»GÜÚÚúz’Û½bøáÙòMà‚æ| Ët„Zû€®ˆ)Њ ùÙŽ›èuµNÒÁŽc°©pÊM”SWáo3„©°r#€«½å] a×5ÄéÊÍ¿+Wy{ê?q*>;^›Z9ëÚÕ —ºyÞƇŒ¬pºˆ‹€'óÑ‚ó\©h"Õ²¿k¶px”’¦ÑتTŒÛÛRà)ú§°oǤ°„p!ÈUK¹ÍQìÿ,…KŸ endstream endobj -1340 0 obj +1341 0 obj << /Filter /FlateDecode /Subtype /Type1C @@ -14377,7 +14380,7 @@ k ÒOWk'T²_Ž–Pài³ì¤®¦$1R¸(Ïlç?Àÿñå¼£ endstream endobj -1346 0 obj +1347 0 obj << /Length 9376 >> @@ -14658,60 +14661,64 @@ ET endstream endobj -1232 0 obj +1233 0 obj << /Type /ObjStm /N 100 -/First 993 -/Length 12573 +/First 991 +/Length 12570 >> stream -1231 0 1227 59 1234 191 1236 309 1233 368 1245 448 1237 623 1238 767 1239 912 1240 1056 -1241 1201 1247 1348 280 1406 1248 1463 1244 1522 1251 1654 1242 1802 1243 1946 1253 2093 1250 2152 -1260 2245 1254 2420 1255 2564 1256 2710 1257 2856 1258 3000 1262 3147 284 3205 1263 3262 1259 3321 -1266 3453 1264 3592 1268 3740 288 3799 1265 3857 1274 3937 1269 4094 1270 4238 1271 4385 1276 4532 -292 4590 1277 4647 1278 4706 1279 4764 1280 4822 1273 4880 1284 5012 1288 5160 1289 5287 1290 5330 -1291 5537 1292 5775 1293 6051 1272 6287 1282 6434 1286 6580 1287 6639 1283 6698 1297 6846 1299 6964 -1296 7022 1306 7103 1302 7260 1303 7404 1304 7551 1308 7697 296 7756 1309 7814 1310 7873 1311 7932 -1312 7991 1305 8050 1318 8195 1313 8352 1315 8499 1316 8644 1320 8791 1321 8849 1322 8907 1323 8965 -1317 9022 1326 9154 1328 9272 1325 9331 1330 9411 1333 9529 1334 9656 1335 9699 1336 9906 1337 10144 -1338 10420 1332 10656 1324 10714 1329 10773 1345 10869 1341 11026 1342 11170 1343 11317 1347 11463 300 11522 -% 1231 0 obj +276 0 1232 57 1228 116 1235 248 1237 366 1234 425 1246 505 1238 680 1239 824 1240 969 +1241 1113 1242 1258 1248 1405 280 1463 1249 1520 1245 1579 1252 1711 1243 1859 1244 2003 1254 2150 +1251 2209 1261 2302 1255 2477 1256 2621 1257 2767 1258 2913 1259 3057 1263 3204 284 3262 1264 3319 +1260 3378 1267 3510 1265 3649 1269 3797 288 3856 1266 3914 1275 3994 1270 4151 1271 4295 1272 4442 +1277 4589 292 4647 1278 4704 1279 4763 1280 4821 1281 4879 1274 4937 1285 5069 1289 5217 1290 5344 +1291 5387 1292 5594 1293 5832 1294 6108 1273 6344 1283 6491 1287 6637 1288 6696 1284 6755 1298 6903 +1300 7021 1297 7079 1307 7160 1303 7317 1304 7461 1305 7608 1309 7754 296 7813 1310 7871 1311 7930 +1312 7989 1313 8048 1306 8107 1319 8252 1314 8409 1316 8556 1317 8701 1321 8848 1322 8906 1323 8964 +1324 9022 1318 9079 1327 9211 1329 9329 1326 9388 1331 9468 1334 9586 1335 9713 1336 9756 1337 9963 +1338 10201 1339 10477 1333 10713 1325 10771 1330 10830 1346 10926 1342 11083 1343 11227 1344 11374 1348 11520 +% 276 0 obj << -/D [1228 0 R /XYZ 270.132 534.109 null] +/D [1229 0 R /XYZ 99.895 716.092 null] >> -% 1227 0 obj +% 1232 0 obj << -/Font << /F16 582 0 R /F8 585 0 R /F11 796 0 R /F14 813 0 R /F30 810 0 R /F27 584 0 R >> +/D [1229 0 R /XYZ 270.132 534.109 null] +>> +% 1228 0 obj +<< +/Font << /F16 582 0 R /F8 585 0 R /F11 797 0 R /F14 814 0 R /F30 811 0 R /F27 584 0 R >> /ProcSet [ /PDF /Text ] >> -% 1234 0 obj +% 1235 0 obj << /Type /Page -/Contents 1235 0 R -/Resources 1233 0 R +/Contents 1236 0 R +/Resources 1234 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1196 0 R +/Parent 1197 0 R >> -% 1236 0 obj +% 1237 0 obj << -/D [1234 0 R /XYZ 149.705 753.953 null] +/D [1235 0 R /XYZ 149.705 753.953 null] >> -% 1233 0 obj +% 1234 0 obj << /Font << /F27 584 0 R /F8 585 0 R >> /ProcSet [ /PDF /Text ] >> -% 1245 0 obj +% 1246 0 obj << /Type /Page -/Contents 1246 0 R -/Resources 1244 0 R +/Contents 1247 0 R +/Resources 1245 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1249 0 R -/Annots [ 1237 0 R 1238 0 R 1239 0 R 1240 0 R 1241 0 R ] +/Parent 1250 0 R +/Annots [ 1238 0 R 1239 0 R 1240 0 R 1241 0 R 1242 0 R ] >> -% 1237 0 obj +% 1238 0 obj << /Type /Annot /Subtype /Link @@ -14719,7 +14726,7 @@ stream /Rect [265.833 407.619 341.887 418.744] /A << /S /GoTo /D (vdata) >> >> -% 1238 0 obj +% 1239 0 obj << /Type /Annot /Subtype /Link @@ -14727,7 +14734,7 @@ stream /Rect [225.425 395.94 232.399 406.789] /A << /S /GoTo /D (table.2) >> >> -% 1239 0 obj +% 1240 0 obj << /Type /Annot /Subtype /Link @@ -14735,7 +14742,7 @@ stream /Rect [265.833 327.999 341.887 339.124] /A << /S /GoTo /D (vdata) >> >> -% 1240 0 obj +% 1241 0 obj << /Type /Annot /Subtype /Link @@ -14743,7 +14750,7 @@ stream /Rect [225.425 316.32 232.399 327.169] /A << /S /GoTo /D (table.2) >> >> -% 1241 0 obj +% 1242 0 obj << /Type /Annot /Subtype /Link @@ -14751,33 +14758,33 @@ stream /Rect [259.464 248.379 326.522 259.504] /A << /S /GoTo /D (descdata) >> >> -% 1247 0 obj +% 1248 0 obj << -/D [1245 0 R /XYZ 98.895 753.953 null] +/D [1246 0 R /XYZ 98.895 753.953 null] >> % 280 0 obj << -/D [1245 0 R /XYZ 99.895 716.092 null] +/D [1246 0 R /XYZ 99.895 716.092 null] >> -% 1248 0 obj +% 1249 0 obj << -/D [1245 0 R /XYZ 270.132 543.606 null] +/D [1246 0 R /XYZ 270.132 543.606 null] >> -% 1244 0 obj +% 1245 0 obj << -/Font << /F16 582 0 R /F8 585 0 R /F11 796 0 R /F14 813 0 R /F30 810 0 R /F27 584 0 R >> +/Font << /F16 582 0 R /F8 585 0 R /F11 797 0 R /F14 814 0 R /F30 811 0 R /F27 584 0 R >> /ProcSet [ /PDF /Text ] >> -% 1251 0 obj +% 1252 0 obj << /Type /Page -/Contents 1252 0 R -/Resources 1250 0 R +/Contents 1253 0 R +/Resources 1251 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1249 0 R -/Annots [ 1242 0 R 1243 0 R ] +/Parent 1250 0 R +/Annots [ 1243 0 R 1244 0 R ] >> -% 1242 0 obj +% 1243 0 obj << /Type /Annot /Subtype /Link @@ -14785,7 +14792,7 @@ stream /Rect [316.642 690.964 392.696 702.088] /A << /S /GoTo /D (vdata) >> >> -% 1243 0 obj +% 1244 0 obj << /Type /Annot /Subtype /Link @@ -14793,25 +14800,25 @@ stream /Rect [296.381 679.285 308.336 690.133] /A << /S /GoTo /D (table.14) >> >> -% 1253 0 obj +% 1254 0 obj << -/D [1251 0 R /XYZ 149.705 753.953 null] +/D [1252 0 R /XYZ 149.705 753.953 null] >> -% 1250 0 obj +% 1251 0 obj << -/Font << /F8 585 0 R /F27 584 0 R /F30 810 0 R >> +/Font << /F8 585 0 R /F27 584 0 R /F30 811 0 R >> /ProcSet [ /PDF /Text ] >> -% 1260 0 obj +% 1261 0 obj << /Type /Page -/Contents 1261 0 R -/Resources 1259 0 R +/Contents 1262 0 R +/Resources 1260 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1249 0 R -/Annots [ 1254 0 R 1255 0 R 1256 0 R 1257 0 R 1258 0 R ] +/Parent 1250 0 R +/Annots [ 1255 0 R 1256 0 R 1257 0 R 1258 0 R 1259 0 R ] >> -% 1254 0 obj +% 1255 0 obj << /Type /Annot /Subtype /Link @@ -14819,7 +14826,7 @@ stream /Rect [265.833 429.544 341.887 440.669] /A << /S /GoTo /D (vdata) >> >> -% 1255 0 obj +% 1256 0 obj << /Type /Annot /Subtype /Link @@ -14827,7 +14834,7 @@ stream /Rect [225.425 417.865 232.399 428.713] /A << /S /GoTo /D (table.2) >> >> -% 1256 0 obj +% 1257 0 obj << /Type /Annot /Subtype /Link @@ -14835,7 +14842,7 @@ stream /Rect [259.464 351.49 326.522 362.615] /A << /S /GoTo /D (descdata) >> >> -% 1257 0 obj +% 1258 0 obj << /Type /Annot /Subtype /Link @@ -14843,7 +14850,7 @@ stream /Rect [265.833 201.014 341.887 212.139] /A << /S /GoTo /D (vdata) >> >> -% 1258 0 obj +% 1259 0 obj << /Type /Annot /Subtype /Link @@ -14851,63 +14858,63 @@ stream /Rect [245.572 189.336 257.527 200.184] /A << /S /GoTo /D (table.16) >> >> -% 1262 0 obj +% 1263 0 obj << -/D [1260 0 R /XYZ 98.895 753.953 null] +/D [1261 0 R /XYZ 98.895 753.953 null] >> % 284 0 obj << -/D [1260 0 R /XYZ 99.895 716.092 null] ->> -% 1263 0 obj -<< -/D [1260 0 R /XYZ 270.132 556.917 null] ->> -% 1259 0 obj -<< -/Font << /F16 582 0 R /F8 585 0 R /F11 796 0 R /F14 813 0 R /F30 810 0 R /F27 584 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1266 0 obj -<< -/Type /Page -/Contents 1267 0 R -/Resources 1265 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1249 0 R -/Annots [ 1264 0 R ] +/D [1261 0 R /XYZ 99.895 716.092 null] >> % 1264 0 obj << +/D [1261 0 R /XYZ 270.132 556.917 null] +>> +% 1260 0 obj +<< +/Font << /F16 582 0 R /F8 585 0 R /F11 797 0 R /F14 814 0 R /F30 811 0 R /F27 584 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1267 0 obj +<< +/Type /Page +/Contents 1268 0 R +/Resources 1266 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1250 0 R +/Annots [ 1265 0 R ] +>> +% 1265 0 obj +<< /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] /Rect [350.345 657.464 357.319 668.312] /A << /S /GoTo /D (section.6) >> >> -% 1268 0 obj +% 1269 0 obj << -/D [1266 0 R /XYZ 149.705 753.953 null] +/D [1267 0 R /XYZ 149.705 753.953 null] >> % 288 0 obj << -/D [1266 0 R /XYZ 150.705 716.092 null] +/D [1267 0 R /XYZ 150.705 716.092 null] >> -% 1265 0 obj +% 1266 0 obj << /Font << /F16 582 0 R /F8 585 0 R >> /ProcSet [ /PDF /Text ] >> -% 1274 0 obj +% 1275 0 obj << /Type /Page -/Contents 1275 0 R -/Resources 1273 0 R +/Contents 1276 0 R +/Resources 1274 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1249 0 R -/Annots [ 1269 0 R 1270 0 R 1271 0 R ] +/Parent 1250 0 R +/Annots [ 1270 0 R 1271 0 R 1272 0 R ] >> -% 1269 0 obj +% 1270 0 obj << /Type /Annot /Subtype /Link @@ -14915,7 +14922,7 @@ stream /Rect [368.549 343.463 444.603 354.588] /A << /S /GoTo /D (vdata) >> >> -% 1270 0 obj +% 1271 0 obj << /Type /Annot /Subtype /Link @@ -14923,7 +14930,7 @@ stream /Rect [325.411 331.785 337.366 342.633] /A << /S /GoTo /D (table.17) >> >> -% 1271 0 obj +% 1272 0 obj << /Type /Annot /Subtype /Link @@ -14931,59 +14938,59 @@ stream /Rect [294.721 264.029 361.779 275.154] /A << /S /GoTo /D (descdata) >> >> -% 1276 0 obj +% 1277 0 obj << -/D [1274 0 R /XYZ 98.895 753.953 null] +/D [1275 0 R /XYZ 98.895 753.953 null] >> % 292 0 obj << -/D [1274 0 R /XYZ 99.895 716.092 null] ->> -% 1277 0 obj -<< -/D [1274 0 R /XYZ 270.132 514.036 null] +/D [1275 0 R /XYZ 99.895 716.092 null] >> % 1278 0 obj << -/D [1274 0 R /XYZ 99.895 482.745 null] +/D [1275 0 R /XYZ 270.132 514.036 null] >> % 1279 0 obj << -/D [1274 0 R /XYZ 99.895 484.682 null] +/D [1275 0 R /XYZ 99.895 482.745 null] >> % 1280 0 obj << -/D [1274 0 R /XYZ 99.895 472.727 null] +/D [1275 0 R /XYZ 99.895 484.682 null] >> -% 1273 0 obj +% 1281 0 obj << -/Font << /F16 582 0 R /F8 585 0 R /F11 796 0 R /F14 813 0 R /F27 584 0 R /F30 810 0 R >> +/D [1275 0 R /XYZ 99.895 472.727 null] +>> +% 1274 0 obj +<< +/Font << /F16 582 0 R /F8 585 0 R /F11 797 0 R /F14 814 0 R /F27 584 0 R /F30 811 0 R >> /ProcSet [ /PDF /Text ] >> -% 1284 0 obj +% 1285 0 obj << /Type /Page -/Contents 1285 0 R -/Resources 1283 0 R +/Contents 1286 0 R +/Resources 1284 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1249 0 R -/Annots [ 1272 0 R 1282 0 R ] +/Parent 1250 0 R +/Annots [ 1273 0 R 1283 0 R ] >> -% 1288 0 obj +% 1289 0 obj << /Producer (GPL Ghostscript 9.22) /CreationDate (D:20180323100645Z00'00') /ModDate (D:20180323100645Z00'00') >> -% 1289 0 obj +% 1290 0 obj << /Type /ExtGState /OPM 1 >> -% 1290 0 obj +% 1291 0 obj << /BaseFont /XYUGDR+Times-Roman -/FontDescriptor 1292 0 R +/FontDescriptor 1293 0 R /Type /Font /FirstChar 48 /LastChar 57 @@ -14991,10 +14998,10 @@ stream /Encoding /WinAnsiEncoding /Subtype /Type1 >> -% 1291 0 obj +% 1292 0 obj << /BaseFont /XISTAL+Times-Bold -/FontDescriptor 1293 0 R +/FontDescriptor 1294 0 R /Type /Font /FirstChar 48 /LastChar 80 @@ -15002,7 +15009,7 @@ stream /Encoding /WinAnsiEncoding /Subtype /Type1 >> -% 1292 0 obj +% 1293 0 obj << /Type /FontDescriptor /FontName /XYUGDR+Times-Roman @@ -15015,9 +15022,9 @@ stream /StemV 71 /MissingWidth 250 /CharSet (/eight/five/four/nine/one/seven/six/three/two/zero) -/FontFile3 1294 0 R +/FontFile3 1295 0 R >> -% 1293 0 obj +% 1294 0 obj << /Type /FontDescriptor /FontName /XISTAL+Times-Bold @@ -15030,9 +15037,9 @@ stream /StemV 90 /MissingWidth 250 /CharSet (/P/one/zero) -/FontFile3 1295 0 R +/FontFile3 1296 0 R >> -% 1272 0 obj +% 1273 0 obj << /Type /Annot /Subtype /Link @@ -15040,7 +15047,7 @@ stream /Rect [213.636 625.431 225.591 634.343] /A << /S /GoTo /D (table.17) >> >> -% 1282 0 obj +% 1283 0 obj << /Type /Annot /Subtype /Link @@ -15048,47 +15055,47 @@ stream /Rect [457.906 278.167 464.88 290.786] /A << /S /GoTo /D (figure.7) >> >> -% 1286 0 obj -<< -/D [1284 0 R /XYZ 149.705 753.953 null] ->> % 1287 0 obj << -/D [1284 0 R /XYZ 283.692 317.353 null] +/D [1285 0 R /XYZ 149.705 753.953 null] >> -% 1283 0 obj +% 1288 0 obj << -/Font << /F27 584 0 R /F8 585 0 R /F11 796 0 R /F16 582 0 R /F30 810 0 R >> -/XObject << /Im3 1281 0 R >> +/D [1285 0 R /XYZ 283.692 317.353 null] +>> +% 1284 0 obj +<< +/Font << /F27 584 0 R /F8 585 0 R /F11 797 0 R /F16 582 0 R /F30 811 0 R >> +/XObject << /Im3 1282 0 R >> /ProcSet [ /PDF /Text ] >> +% 1298 0 obj +<< +/Type /Page +/Contents 1299 0 R +/Resources 1297 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1302 0 R +>> +% 1300 0 obj +<< +/D [1298 0 R /XYZ 98.895 753.953 null] +>> % 1297 0 obj << -/Type /Page -/Contents 1298 0 R -/Resources 1296 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1301 0 R ->> -% 1299 0 obj -<< -/D [1297 0 R /XYZ 98.895 753.953 null] ->> -% 1296 0 obj -<< -/Font << /F46 1300 0 R /F8 585 0 R >> +/Font << /F46 1301 0 R /F8 585 0 R >> /ProcSet [ /PDF /Text ] >> -% 1306 0 obj +% 1307 0 obj << /Type /Page -/Contents 1307 0 R -/Resources 1305 0 R +/Contents 1308 0 R +/Resources 1306 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1301 0 R -/Annots [ 1302 0 R 1303 0 R 1304 0 R ] +/Parent 1302 0 R +/Annots [ 1303 0 R 1304 0 R 1305 0 R ] >> -% 1302 0 obj +% 1303 0 obj << /Type /Annot /Subtype /Link @@ -15096,7 +15103,7 @@ stream /Rect [419.358 343.981 495.412 355.106] /A << /S /GoTo /D (vdata) >> >> -% 1303 0 obj +% 1304 0 obj << /Type /Annot /Subtype /Link @@ -15104,7 +15111,7 @@ stream /Rect [376.221 332.303 388.176 343.151] /A << /S /GoTo /D (table.18) >> >> -% 1304 0 obj +% 1305 0 obj << /Type /Annot /Subtype /Link @@ -15112,53 +15119,53 @@ stream /Rect [345.53 264.991 412.588 276.116] /A << /S /GoTo /D (descdata) >> >> -% 1308 0 obj +% 1309 0 obj << -/D [1306 0 R /XYZ 149.705 753.953 null] +/D [1307 0 R /XYZ 149.705 753.953 null] >> % 296 0 obj << -/D [1306 0 R /XYZ 150.705 716.092 null] ->> -% 1309 0 obj -<< -/D [1306 0 R /XYZ 320.941 511.222 null] +/D [1307 0 R /XYZ 150.705 716.092 null] >> % 1310 0 obj << -/D [1306 0 R /XYZ 150.705 480.819 null] +/D [1307 0 R /XYZ 320.941 511.222 null] >> % 1311 0 obj << -/D [1306 0 R /XYZ 150.705 482.756 null] +/D [1307 0 R /XYZ 150.705 480.819 null] >> % 1312 0 obj << -/D [1306 0 R /XYZ 150.705 470.801 null] ->> -% 1305 0 obj -<< -/Font << /F16 582 0 R /F8 585 0 R /F11 796 0 R /F14 813 0 R /F10 812 0 R /F27 584 0 R /F30 810 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1318 0 obj -<< -/Type /Page -/Contents 1319 0 R -/Resources 1317 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1301 0 R -/Annots [ 1313 0 R 1315 0 R 1316 0 R ] +/D [1307 0 R /XYZ 150.705 482.756 null] >> % 1313 0 obj << +/D [1307 0 R /XYZ 150.705 470.801 null] +>> +% 1306 0 obj +<< +/Font << /F16 582 0 R /F8 585 0 R /F11 797 0 R /F14 814 0 R /F10 813 0 R /F27 584 0 R /F30 811 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1319 0 obj +<< +/Type /Page +/Contents 1320 0 R +/Resources 1318 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1302 0 R +/Annots [ 1314 0 R 1316 0 R 1317 0 R ] +>> +% 1314 0 obj +<< /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] /Rect [203.009 555.748 214.964 566.597] /A << /S /GoTo /D (table.18) >> >> -% 1315 0 obj +% 1316 0 obj << /Type /Annot /Subtype /Link @@ -15166,7 +15173,7 @@ stream /Rect [407.019 326.22 413.993 338.84] /A << /S /GoTo /D (figure.8) >> >> -% 1316 0 obj +% 1317 0 obj << /Type /Annot /Subtype /Link @@ -15174,67 +15181,67 @@ stream /Rect [306.759 302.697 313.733 313.546] /A << /S /GoTo /D (figure.7) >> >> -% 1320 0 obj -<< -/D [1318 0 R /XYZ 98.895 753.953 null] ->> % 1321 0 obj << -/D [1318 0 R /XYZ 99.895 465.033 null] +/D [1319 0 R /XYZ 98.895 753.953 null] >> % 1322 0 obj << -/D [1318 0 R /XYZ 99.895 431.215 null] +/D [1319 0 R /XYZ 99.895 465.033 null] >> % 1323 0 obj << -/D [1318 0 R /XYZ 99.895 387.38 null] +/D [1319 0 R /XYZ 99.895 431.215 null] >> -% 1317 0 obj +% 1324 0 obj << -/Font << /F27 584 0 R /F8 585 0 R /F11 796 0 R /F16 582 0 R /F10 812 0 R /F30 810 0 R >> +/D [1319 0 R /XYZ 99.895 387.38 null] +>> +% 1318 0 obj +<< +/Font << /F27 584 0 R /F8 585 0 R /F11 797 0 R /F16 582 0 R /F10 813 0 R /F30 811 0 R >> /ProcSet [ /PDF /Text ] >> +% 1327 0 obj +<< +/Type /Page +/Contents 1328 0 R +/Resources 1326 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1302 0 R +>> +% 1329 0 obj +<< +/D [1327 0 R /XYZ 149.705 753.953 null] +>> % 1326 0 obj << -/Type /Page -/Contents 1327 0 R -/Resources 1325 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1301 0 R ->> -% 1328 0 obj -<< -/D [1326 0 R /XYZ 149.705 753.953 null] ->> -% 1325 0 obj -<< -/Font << /F31 816 0 R /F8 585 0 R >> +/Font << /F31 817 0 R /F8 585 0 R >> /ProcSet [ /PDF /Text ] >> -% 1330 0 obj +% 1331 0 obj << /Type /Page -/Contents 1331 0 R -/Resources 1329 0 R +/Contents 1332 0 R +/Resources 1330 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1301 0 R +/Parent 1302 0 R >> -% 1333 0 obj +% 1334 0 obj << /Producer (GPL Ghostscript 9.22) /CreationDate (D:20180323100658Z00'00') /ModDate (D:20180323100658Z00'00') >> -% 1334 0 obj +% 1335 0 obj << /Type /ExtGState /OPM 1 >> -% 1335 0 obj +% 1336 0 obj << /BaseFont /XYUGDR+Times-Roman -/FontDescriptor 1337 0 R +/FontDescriptor 1338 0 R /Type /Font /FirstChar 48 /LastChar 57 @@ -15242,10 +15249,10 @@ stream /Encoding /WinAnsiEncoding /Subtype /Type1 >> -% 1336 0 obj +% 1337 0 obj << /BaseFont /XISTAL+Times-Bold -/FontDescriptor 1338 0 R +/FontDescriptor 1339 0 R /Type /Font /FirstChar 48 /LastChar 80 @@ -15253,7 +15260,7 @@ stream /Encoding /WinAnsiEncoding /Subtype /Type1 >> -% 1337 0 obj +% 1338 0 obj << /Type /FontDescriptor /FontName /XYUGDR+Times-Roman @@ -15266,9 +15273,9 @@ stream /StemV 71 /MissingWidth 250 /CharSet (/eight/five/four/nine/one/seven/six/three/two/zero) -/FontFile3 1339 0 R +/FontFile3 1340 0 R >> -% 1338 0 obj +% 1339 0 obj << /Type /FontDescriptor /FontName /XISTAL+Times-Bold @@ -15281,32 +15288,32 @@ stream /StemV 90 /MissingWidth 250 /CharSet (/P/one/zero) -/FontFile3 1340 0 R +/FontFile3 1341 0 R >> -% 1332 0 obj +% 1333 0 obj << -/D [1330 0 R /XYZ 98.895 753.953 null] +/D [1331 0 R /XYZ 98.895 753.953 null] >> -% 1324 0 obj +% 1325 0 obj << -/D [1330 0 R /XYZ 232.883 272.519 null] +/D [1331 0 R /XYZ 232.883 272.519 null] >> -% 1329 0 obj +% 1330 0 obj << /Font << /F8 585 0 R >> -/XObject << /Im4 1314 0 R >> +/XObject << /Im4 1315 0 R >> /ProcSet [ /PDF /Text ] >> -% 1345 0 obj +% 1346 0 obj << /Type /Page -/Contents 1346 0 R -/Resources 1344 0 R +/Contents 1347 0 R +/Resources 1345 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1301 0 R -/Annots [ 1341 0 R 1342 0 R 1343 0 R ] +/Parent 1302 0 R +/Annots [ 1342 0 R 1343 0 R 1344 0 R ] >> -% 1341 0 obj +% 1342 0 obj << /Type /Annot /Subtype /Link @@ -15314,7 +15321,7 @@ stream /Rect [419.358 295.182 495.412 306.307] /A << /S /GoTo /D (vdata) >> >> -% 1342 0 obj +% 1343 0 obj << /Type /Annot /Subtype /Link @@ -15322,7 +15329,7 @@ stream /Rect [256.807 285.441 268.762 294.352] /A << /S /GoTo /D (table.19) >> >> -% 1343 0 obj +% 1344 0 obj << /Type /Annot /Subtype /Link @@ -15330,18 +15337,14 @@ stream /Rect [345.53 215.901 412.588 227.026] /A << /S /GoTo /D (descdata) >> >> -% 1347 0 obj +% 1348 0 obj << -/D [1345 0 R /XYZ 149.705 753.953 null] ->> -% 300 0 obj -<< -/D [1345 0 R /XYZ 150.705 716.092 null] +/D [1346 0 R /XYZ 149.705 753.953 null] >> endstream endobj -1355 0 obj +1356 0 obj << /Length 1455 >> @@ -15371,7 +15374,7 @@ ET endstream endobj -1362 0 obj +1363 0 obj << /Length 7813 >> @@ -15585,7 +15588,7 @@ ET endstream endobj -1371 0 obj +1372 0 obj << /Length 4181 >> @@ -15718,7 +15721,7 @@ ET endstream endobj -1375 0 obj +1376 0 obj << /Length 6550 >> @@ -15775,7 +15778,7 @@ ET endstream endobj -1380 0 obj +1381 0 obj << /Length 6638 >> @@ -15853,7 +15856,7 @@ ET endstream endobj -1386 0 obj +1387 0 obj << /Length 10049 >> @@ -15924,7 +15927,7 @@ ET endstream endobj -1391 0 obj +1392 0 obj << /Length 2660 >> @@ -15959,7 +15962,7 @@ ET endstream endobj -1402 0 obj +1403 0 obj << /Length 7181 >> @@ -16044,7 +16047,7 @@ ET endstream endobj -1407 0 obj +1408 0 obj << /Length 3156 >> @@ -16087,7 +16090,7 @@ ET endstream endobj -1416 0 obj +1417 0 obj << /Length 6223 >> @@ -16221,7 +16224,7 @@ ET endstream endobj -1423 0 obj +1424 0 obj << /Length 3287 >> @@ -16319,7 +16322,7 @@ ET endstream endobj -1428 0 obj +1429 0 obj << /Length 2253 >> @@ -16388,7 +16391,7 @@ ET endstream endobj -1434 0 obj +1435 0 obj << /Length 5932 >> @@ -16498,7 +16501,7 @@ ET endstream endobj -1439 0 obj +1440 0 obj << /Length 1587 >> @@ -16521,7 +16524,7 @@ ET endstream endobj -1447 0 obj +1448 0 obj << /Length 4897 >> @@ -16628,7 +16631,7 @@ ET endstream endobj -1455 0 obj +1456 0 obj << /Length 5716 >> @@ -16689,7 +16692,588 @@ ET endstream endobj -1461 0 obj +1353 0 obj +<< +/Type /ObjStm +/N 100 +/First 975 +/Length 10528 +>> +stream +300 0 1349 58 1350 117 1351 176 1352 235 1345 294 1355 451 1357 569 1354 627 1362 720 +1359 859 1364 1005 304 1064 1365 1122 1366 1181 1367 1240 1361 1299 1371 1456 1360 1613 1368 1757 +1369 1900 1373 2046 1370 2104 1375 2210 1377 2328 308 2387 312 2445 1374 2503 1380 2635 1378 2774 +1382 2921 1383 2979 1379 3037 1386 3156 1384 3295 1388 3453 1389 3512 1385 3571 1391 3703 1393 3821 +1394 3879 1395 3937 1396 3995 1397 4053 1398 4111 1390 4167 1402 4247 1400 4386 1404 4531 316 4590 +1401 4648 1407 4767 1405 4906 1409 5064 1410 5122 1411 5180 1412 5238 1406 5296 1416 5402 1413 5550 +1414 5696 1418 5842 320 5901 1419 5959 1415 6018 1423 6124 1420 6272 1421 6418 1425 6565 324 6623 +1422 6680 1428 6786 1426 6925 1430 7070 328 7129 1427 7187 1434 7293 1431 7441 1432 7585 1436 7732 +332 7790 1433 7847 1439 7979 1441 8097 1442 8156 1443 8215 1438 8274 1447 8354 1444 8502 1445 8648 +1449 8791 336 8849 1450 8906 1451 8964 1452 9022 1446 9080 1455 9199 1457 9317 340 9376 1454 9434 +% 300 0 obj +<< +/D [1346 0 R /XYZ 150.705 716.092 null] +>> +% 1349 0 obj +<< +/D [1346 0 R /XYZ 320.941 466.542 null] +>> +% 1350 0 obj +<< +/D [1346 0 R /XYZ 150.705 435.558 null] +>> +% 1351 0 obj +<< +/D [1346 0 R /XYZ 150.705 435.558 null] +>> +% 1352 0 obj +<< +/D [1346 0 R /XYZ 150.705 423.603 null] +>> +% 1345 0 obj +<< +/Font << /F16 582 0 R /F8 585 0 R /F11 797 0 R /F14 814 0 R /F10 813 0 R /F7 812 0 R /F27 584 0 R /F30 811 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1355 0 obj +<< +/Type /Page +/Contents 1356 0 R +/Resources 1354 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1358 0 R +>> +% 1357 0 obj +<< +/D [1355 0 R /XYZ 98.895 753.953 null] +>> +% 1354 0 obj +<< +/Font << /F27 584 0 R /F8 585 0 R /F30 811 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1362 0 obj +<< +/Type /Page +/Contents 1363 0 R +/Resources 1361 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1358 0 R +/Annots [ 1359 0 R ] +>> +% 1359 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [345.53 210.686 412.588 221.811] +/A << /S /GoTo /D (descdata) >> +>> +% 1364 0 obj +<< +/D [1362 0 R /XYZ 149.705 753.953 null] +>> +% 304 0 obj +<< +/D [1362 0 R /XYZ 150.705 716.092 null] +>> +% 1365 0 obj +<< +/D [1362 0 R /XYZ 320.941 451.038 null] +>> +% 1366 0 obj +<< +/D [1362 0 R /XYZ 150.705 417.777 null] +>> +% 1367 0 obj +<< +/D [1362 0 R /XYZ 150.705 417.777 null] +>> +% 1361 0 obj +<< +/Font << /F16 582 0 R /F8 585 0 R /F11 797 0 R /F10 813 0 R /F14 814 0 R /F7 812 0 R /F27 584 0 R /F30 811 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1371 0 obj +<< +/Type /Page +/Contents 1372 0 R +/Resources 1370 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1358 0 R +/Annots [ 1360 0 R 1368 0 R 1369 0 R ] +>> +% 1360 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [285.522 643.143 361.576 654.268] +/A << /S /GoTo /D (vdata) >> +>> +% 1368 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [123.806 543.516 199.86 554.641] +/A << /S /GoTo /D (vdata) >> +>> +% 1369 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [422.94 543.516 434.896 554.641] +/A << /S /GoTo /D (table.20) >> +>> +% 1373 0 obj +<< +/D [1371 0 R /XYZ 98.895 753.953 null] +>> +% 1370 0 obj +<< +/Font << /F27 584 0 R /F8 585 0 R /F30 811 0 R /F11 797 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1375 0 obj +<< +/Type /Page +/Contents 1376 0 R +/Resources 1374 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1358 0 R +>> +% 1377 0 obj +<< +/D [1375 0 R /XYZ 149.705 753.953 null] +>> +% 308 0 obj +<< +/D [1375 0 R /XYZ 150.705 716.092 null] +>> +% 312 0 obj +<< +/D [1375 0 R /XYZ 150.705 693.474 null] +>> +% 1374 0 obj +<< +/Font << /F16 582 0 R /F30 811 0 R /F8 585 0 R /F27 584 0 R /F11 797 0 R /F14 814 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1380 0 obj +<< +/Type /Page +/Contents 1381 0 R +/Resources 1379 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1358 0 R +/Annots [ 1378 0 R ] +>> +% 1378 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [294.721 325.282 361.779 336.407] +/A << /S /GoTo /D (descdata) >> +>> +% 1382 0 obj +<< +/D [1380 0 R /XYZ 98.895 753.953 null] +>> +% 1383 0 obj +<< +/D [1380 0 R /XYZ 99.895 234.372 null] +>> +% 1379 0 obj +<< +/Font << /F27 584 0 R /F8 585 0 R /F30 811 0 R /F11 797 0 R /F16 582 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1386 0 obj +<< +/Type /Page +/Contents 1387 0 R +/Resources 1385 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1358 0 R +/Annots [ 1384 0 R ] +>> +% 1384 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [408.792 215.702 431.263 226.827] +/A << /S /GoTo /D (subsubsection.2.3.1) >> +>> +% 1388 0 obj +<< +/D [1386 0 R /XYZ 149.705 753.953 null] +>> +% 1389 0 obj +<< +/D [1386 0 R /XYZ 150.705 134.155 null] +>> +% 1385 0 obj +<< +/Font << /F30 811 0 R /F8 585 0 R /F27 584 0 R /F14 814 0 R /F11 797 0 R /F10 813 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1391 0 obj +<< +/Type /Page +/Contents 1392 0 R +/Resources 1390 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1399 0 R +>> +% 1393 0 obj +<< +/D [1391 0 R /XYZ 98.895 753.953 null] +>> +% 1394 0 obj +<< +/D [1391 0 R /XYZ 99.895 716.092 null] +>> +% 1395 0 obj +<< +/D [1391 0 R /XYZ 99.895 688.251 null] +>> +% 1396 0 obj +<< +/D [1391 0 R /XYZ 99.895 668.049 null] +>> +% 1397 0 obj +<< +/D [1391 0 R /XYZ 99.895 626.428 null] +>> +% 1398 0 obj +<< +/D [1391 0 R /XYZ 99.895 568.7 null] +>> +% 1390 0 obj +<< +/Font << /F8 585 0 R /F30 811 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1402 0 obj +<< +/Type /Page +/Contents 1403 0 R +/Resources 1401 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1399 0 R +/Annots [ 1400 0 R ] +>> +% 1400 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [345.53 117.115 412.588 128.24] +/A << /S /GoTo /D (descdata) >> +>> +% 1404 0 obj +<< +/D [1402 0 R /XYZ 149.705 753.953 null] +>> +% 316 0 obj +<< +/D [1402 0 R /XYZ 150.705 716.092 null] +>> +% 1401 0 obj +<< +/Font << /F16 582 0 R /F30 811 0 R /F8 585 0 R /F11 797 0 R /F27 584 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1407 0 obj +<< +/Type /Page +/Contents 1408 0 R +/Resources 1406 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1399 0 R +/Annots [ 1405 0 R ] +>> +% 1405 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [274.574 402.324 297.045 413.172] +/A << /S /GoTo /D (subsubsection.2.3.1) >> +>> +% 1409 0 obj +<< +/D [1407 0 R /XYZ 98.895 753.953 null] +>> +% 1410 0 obj +<< +/D [1407 0 R /XYZ 99.895 496.913 null] +>> +% 1411 0 obj +<< +/D [1407 0 R /XYZ 99.895 475.051 null] +>> +% 1412 0 obj +<< +/D [1407 0 R /XYZ 99.895 431.215 null] +>> +% 1406 0 obj +<< +/Font << /F27 584 0 R /F8 585 0 R /F11 797 0 R /F16 582 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1416 0 obj +<< +/Type /Page +/Contents 1417 0 R +/Resources 1415 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1399 0 R +/Annots [ 1413 0 R 1414 0 R ] +>> +% 1413 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [345.53 560.993 412.588 572.118] +/A << /S /GoTo /D (descdata) >> +>> +% 1414 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [345.53 403.583 412.588 414.708] +/A << /S /GoTo /D (descdata) >> +>> +% 1418 0 obj +<< +/D [1416 0 R /XYZ 149.705 753.953 null] +>> +% 320 0 obj +<< +/D [1416 0 R /XYZ 150.705 716.092 null] +>> +% 1419 0 obj +<< +/D [1416 0 R /XYZ 150.705 313.144 null] +>> +% 1415 0 obj +<< +/Font << /F16 582 0 R /F30 811 0 R /F27 584 0 R /F8 585 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1423 0 obj +<< +/Type /Page +/Contents 1424 0 R +/Resources 1422 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1399 0 R +/Annots [ 1420 0 R 1421 0 R ] +>> +% 1420 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [294.721 574.94 361.779 586.065] +/A << /S /GoTo /D (descdata) >> +>> +% 1421 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [294.721 485.277 361.779 496.401] +/A << /S /GoTo /D (descdata) >> +>> +% 1425 0 obj +<< +/D [1423 0 R /XYZ 98.895 753.953 null] +>> +% 324 0 obj +<< +/D [1423 0 R /XYZ 99.895 716.092 null] +>> +% 1422 0 obj +<< +/Font << /F16 582 0 R /F30 811 0 R /F27 584 0 R /F8 585 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1428 0 obj +<< +/Type /Page +/Contents 1429 0 R +/Resources 1427 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1399 0 R +/Annots [ 1426 0 R ] +>> +% 1426 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [345.53 574.94 412.588 586.065] +/A << /S /GoTo /D (descdata) >> +>> +% 1430 0 obj +<< +/D [1428 0 R /XYZ 149.705 753.953 null] +>> +% 328 0 obj +<< +/D [1428 0 R /XYZ 150.705 716.092 null] +>> +% 1427 0 obj +<< +/Font << /F16 582 0 R /F30 811 0 R /F27 584 0 R /F8 585 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1434 0 obj +<< +/Type /Page +/Contents 1435 0 R +/Resources 1433 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1437 0 R +/Annots [ 1431 0 R 1432 0 R ] +>> +% 1431 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [294.721 453.24 372.239 464.364] +/A << /S /GoTo /D (spdata) >> +>> +% 1432 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [294.721 209.896 361.779 221.021] +/A << /S /GoTo /D (descdata) >> +>> +% 1436 0 obj +<< +/D [1434 0 R /XYZ 98.895 753.953 null] +>> +% 332 0 obj +<< +/D [1434 0 R /XYZ 99.895 716.092 null] +>> +% 1433 0 obj +<< +/Font << /F16 582 0 R /F30 811 0 R /F8 585 0 R /F27 584 0 R /F11 797 0 R /F14 814 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1439 0 obj +<< +/Type /Page +/Contents 1440 0 R +/Resources 1438 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1437 0 R +>> +% 1441 0 obj +<< +/D [1439 0 R /XYZ 149.705 753.953 null] +>> +% 1442 0 obj +<< +/D [1439 0 R /XYZ 150.705 716.092 null] +>> +% 1443 0 obj +<< +/D [1439 0 R /XYZ 150.705 664.341 null] +>> +% 1438 0 obj +<< +/Font << /F8 585 0 R /F30 811 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1447 0 obj +<< +/Type /Page +/Contents 1448 0 R +/Resources 1446 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1437 0 R +/Annots [ 1444 0 R 1445 0 R ] +>> +% 1444 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [294.721 574.94 361.779 586.065] +/A << /S /GoTo /D (descdata) >> +>> +% 1445 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [294.721 405.575 372.239 416.7] +/A << /S /GoTo /D (spdata) >> +>> +% 1449 0 obj +<< +/D [1447 0 R /XYZ 98.895 753.953 null] +>> +% 336 0 obj +<< +/D [1447 0 R /XYZ 99.895 716.092 null] +>> +% 1450 0 obj +<< +/D [1447 0 R /XYZ 99.895 315.137 null] +>> +% 1451 0 obj +<< +/D [1447 0 R /XYZ 99.895 293.274 null] +>> +% 1452 0 obj +<< +/D [1447 0 R /XYZ 99.895 273.349 null] +>> +% 1446 0 obj +<< +/Font << /F16 582 0 R /F30 811 0 R /F27 584 0 R /F8 585 0 R /F11 797 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1455 0 obj +<< +/Type /Page +/Contents 1456 0 R +/Resources 1454 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1437 0 R +>> +% 1457 0 obj +<< +/D [1455 0 R /XYZ 149.705 753.953 null] +>> +% 340 0 obj +<< +/D [1455 0 R /XYZ 150.705 716.092 null] +>> +% 1454 0 obj +<< +/Font << /F16 582 0 R /F30 811 0 R /F27 584 0 R /F8 585 0 R /F11 797 0 R >> +/ProcSet [ /PDF /Text ] +>> + +endstream +endobj +1462 0 obj << /Length 7378 >> @@ -16815,593 +17399,7 @@ ET endstream endobj -1352 0 obj -<< -/Type /ObjStm -/N 100 -/First 976 -/Length 10628 ->> -stream -1348 0 1349 59 1350 118 1351 177 1344 236 1354 393 1356 511 1353 569 1361 662 1358 801 -1363 947 304 1006 1364 1064 1365 1123 1366 1182 1360 1241 1370 1398 1359 1555 1367 1699 1368 1842 -1372 1988 1369 2046 1374 2152 1376 2270 308 2329 312 2387 1373 2445 1379 2577 1377 2716 1381 2863 -1382 2921 1378 2979 1385 3098 1383 3237 1387 3395 1388 3454 1384 3513 1390 3645 1392 3763 1393 3821 -1394 3879 1395 3937 1396 3995 1397 4053 1389 4109 1401 4189 1399 4328 1403 4473 316 4532 1400 4590 -1406 4709 1404 4848 1408 5006 1409 5064 1410 5122 1411 5180 1405 5238 1415 5344 1412 5492 1413 5638 -1417 5784 320 5843 1418 5901 1414 5960 1422 6066 1419 6214 1420 6360 1424 6507 324 6565 1421 6622 -1427 6728 1425 6867 1429 7012 328 7071 1426 7129 1433 7235 1430 7383 1431 7527 1435 7674 332 7732 -1432 7789 1438 7921 1440 8039 1441 8098 1442 8157 1437 8216 1446 8296 1443 8444 1444 8590 1448 8733 -336 8791 1449 8848 1450 8906 1451 8964 1445 9022 1454 9141 1456 9259 340 9318 1453 9376 1460 9495 -% 1348 0 obj -<< -/D [1345 0 R /XYZ 320.941 466.542 null] ->> -% 1349 0 obj -<< -/D [1345 0 R /XYZ 150.705 435.558 null] ->> -% 1350 0 obj -<< -/D [1345 0 R /XYZ 150.705 435.558 null] ->> -% 1351 0 obj -<< -/D [1345 0 R /XYZ 150.705 423.603 null] ->> -% 1344 0 obj -<< -/Font << /F16 582 0 R /F8 585 0 R /F11 796 0 R /F14 813 0 R /F10 812 0 R /F7 811 0 R /F27 584 0 R /F30 810 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1354 0 obj -<< -/Type /Page -/Contents 1355 0 R -/Resources 1353 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1357 0 R ->> -% 1356 0 obj -<< -/D [1354 0 R /XYZ 98.895 753.953 null] ->> -% 1353 0 obj -<< -/Font << /F27 584 0 R /F8 585 0 R /F30 810 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1361 0 obj -<< -/Type /Page -/Contents 1362 0 R -/Resources 1360 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1357 0 R -/Annots [ 1358 0 R ] ->> -% 1358 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [345.53 210.686 412.588 221.811] -/A << /S /GoTo /D (descdata) >> ->> -% 1363 0 obj -<< -/D [1361 0 R /XYZ 149.705 753.953 null] ->> -% 304 0 obj -<< -/D [1361 0 R /XYZ 150.705 716.092 null] ->> -% 1364 0 obj -<< -/D [1361 0 R /XYZ 320.941 451.038 null] ->> -% 1365 0 obj -<< -/D [1361 0 R /XYZ 150.705 417.777 null] ->> -% 1366 0 obj -<< -/D [1361 0 R /XYZ 150.705 417.777 null] ->> -% 1360 0 obj -<< -/Font << /F16 582 0 R /F8 585 0 R /F11 796 0 R /F10 812 0 R /F14 813 0 R /F7 811 0 R /F27 584 0 R /F30 810 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1370 0 obj -<< -/Type /Page -/Contents 1371 0 R -/Resources 1369 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1357 0 R -/Annots [ 1359 0 R 1367 0 R 1368 0 R ] ->> -% 1359 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [285.522 643.143 361.576 654.268] -/A << /S /GoTo /D (vdata) >> ->> -% 1367 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [123.806 543.516 199.86 554.641] -/A << /S /GoTo /D (vdata) >> ->> -% 1368 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [422.94 543.516 434.896 554.641] -/A << /S /GoTo /D (table.20) >> ->> -% 1372 0 obj -<< -/D [1370 0 R /XYZ 98.895 753.953 null] ->> -% 1369 0 obj -<< -/Font << /F27 584 0 R /F8 585 0 R /F30 810 0 R /F11 796 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1374 0 obj -<< -/Type /Page -/Contents 1375 0 R -/Resources 1373 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1357 0 R ->> -% 1376 0 obj -<< -/D [1374 0 R /XYZ 149.705 753.953 null] ->> -% 308 0 obj -<< -/D [1374 0 R /XYZ 150.705 716.092 null] ->> -% 312 0 obj -<< -/D [1374 0 R /XYZ 150.705 693.474 null] ->> -% 1373 0 obj -<< -/Font << /F16 582 0 R /F30 810 0 R /F8 585 0 R /F27 584 0 R /F11 796 0 R /F14 813 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1379 0 obj -<< -/Type /Page -/Contents 1380 0 R -/Resources 1378 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1357 0 R -/Annots [ 1377 0 R ] ->> -% 1377 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [294.721 325.282 361.779 336.407] -/A << /S /GoTo /D (descdata) >> ->> -% 1381 0 obj -<< -/D [1379 0 R /XYZ 98.895 753.953 null] ->> -% 1382 0 obj -<< -/D [1379 0 R /XYZ 99.895 234.372 null] ->> -% 1378 0 obj -<< -/Font << /F27 584 0 R /F8 585 0 R /F30 810 0 R /F11 796 0 R /F16 582 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1385 0 obj -<< -/Type /Page -/Contents 1386 0 R -/Resources 1384 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1357 0 R -/Annots [ 1383 0 R ] ->> -% 1383 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [408.792 215.702 431.263 226.827] -/A << /S /GoTo /D (subsubsection.2.3.1) >> ->> -% 1387 0 obj -<< -/D [1385 0 R /XYZ 149.705 753.953 null] ->> -% 1388 0 obj -<< -/D [1385 0 R /XYZ 150.705 134.155 null] ->> -% 1384 0 obj -<< -/Font << /F30 810 0 R /F8 585 0 R /F27 584 0 R /F14 813 0 R /F11 796 0 R /F10 812 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1390 0 obj -<< -/Type /Page -/Contents 1391 0 R -/Resources 1389 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1398 0 R ->> -% 1392 0 obj -<< -/D [1390 0 R /XYZ 98.895 753.953 null] ->> -% 1393 0 obj -<< -/D [1390 0 R /XYZ 99.895 716.092 null] ->> -% 1394 0 obj -<< -/D [1390 0 R /XYZ 99.895 688.251 null] ->> -% 1395 0 obj -<< -/D [1390 0 R /XYZ 99.895 668.049 null] ->> -% 1396 0 obj -<< -/D [1390 0 R /XYZ 99.895 626.428 null] ->> -% 1397 0 obj -<< -/D [1390 0 R /XYZ 99.895 568.7 null] ->> -% 1389 0 obj -<< -/Font << /F8 585 0 R /F30 810 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1401 0 obj -<< -/Type /Page -/Contents 1402 0 R -/Resources 1400 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1398 0 R -/Annots [ 1399 0 R ] ->> -% 1399 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [345.53 117.115 412.588 128.24] -/A << /S /GoTo /D (descdata) >> ->> -% 1403 0 obj -<< -/D [1401 0 R /XYZ 149.705 753.953 null] ->> -% 316 0 obj -<< -/D [1401 0 R /XYZ 150.705 716.092 null] ->> -% 1400 0 obj -<< -/Font << /F16 582 0 R /F30 810 0 R /F8 585 0 R /F11 796 0 R /F27 584 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1406 0 obj -<< -/Type /Page -/Contents 1407 0 R -/Resources 1405 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1398 0 R -/Annots [ 1404 0 R ] ->> -% 1404 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [274.574 402.324 297.045 413.172] -/A << /S /GoTo /D (subsubsection.2.3.1) >> ->> -% 1408 0 obj -<< -/D [1406 0 R /XYZ 98.895 753.953 null] ->> -% 1409 0 obj -<< -/D [1406 0 R /XYZ 99.895 496.913 null] ->> -% 1410 0 obj -<< -/D [1406 0 R /XYZ 99.895 475.051 null] ->> -% 1411 0 obj -<< -/D [1406 0 R /XYZ 99.895 431.215 null] ->> -% 1405 0 obj -<< -/Font << /F27 584 0 R /F8 585 0 R /F11 796 0 R /F16 582 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1415 0 obj -<< -/Type /Page -/Contents 1416 0 R -/Resources 1414 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1398 0 R -/Annots [ 1412 0 R 1413 0 R ] ->> -% 1412 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [345.53 560.993 412.588 572.118] -/A << /S /GoTo /D (descdata) >> ->> -% 1413 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [345.53 403.583 412.588 414.708] -/A << /S /GoTo /D (descdata) >> ->> -% 1417 0 obj -<< -/D [1415 0 R /XYZ 149.705 753.953 null] ->> -% 320 0 obj -<< -/D [1415 0 R /XYZ 150.705 716.092 null] ->> -% 1418 0 obj -<< -/D [1415 0 R /XYZ 150.705 313.144 null] ->> -% 1414 0 obj -<< -/Font << /F16 582 0 R /F30 810 0 R /F27 584 0 R /F8 585 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1422 0 obj -<< -/Type /Page -/Contents 1423 0 R -/Resources 1421 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1398 0 R -/Annots [ 1419 0 R 1420 0 R ] ->> -% 1419 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [294.721 574.94 361.779 586.065] -/A << /S /GoTo /D (descdata) >> ->> -% 1420 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [294.721 485.277 361.779 496.401] -/A << /S /GoTo /D (descdata) >> ->> -% 1424 0 obj -<< -/D [1422 0 R /XYZ 98.895 753.953 null] ->> -% 324 0 obj -<< -/D [1422 0 R /XYZ 99.895 716.092 null] ->> -% 1421 0 obj -<< -/Font << /F16 582 0 R /F30 810 0 R /F27 584 0 R /F8 585 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1427 0 obj -<< -/Type /Page -/Contents 1428 0 R -/Resources 1426 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1398 0 R -/Annots [ 1425 0 R ] ->> -% 1425 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [345.53 574.94 412.588 586.065] -/A << /S /GoTo /D (descdata) >> ->> -% 1429 0 obj -<< -/D [1427 0 R /XYZ 149.705 753.953 null] ->> -% 328 0 obj -<< -/D [1427 0 R /XYZ 150.705 716.092 null] ->> -% 1426 0 obj -<< -/Font << /F16 582 0 R /F30 810 0 R /F27 584 0 R /F8 585 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1433 0 obj -<< -/Type /Page -/Contents 1434 0 R -/Resources 1432 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1436 0 R -/Annots [ 1430 0 R 1431 0 R ] ->> -% 1430 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [294.721 453.24 372.239 464.364] -/A << /S /GoTo /D (spdata) >> ->> -% 1431 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [294.721 209.896 361.779 221.021] -/A << /S /GoTo /D (descdata) >> ->> -% 1435 0 obj -<< -/D [1433 0 R /XYZ 98.895 753.953 null] ->> -% 332 0 obj -<< -/D [1433 0 R /XYZ 99.895 716.092 null] ->> -% 1432 0 obj -<< -/Font << /F16 582 0 R /F30 810 0 R /F8 585 0 R /F27 584 0 R /F11 796 0 R /F14 813 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1438 0 obj -<< -/Type /Page -/Contents 1439 0 R -/Resources 1437 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1436 0 R ->> -% 1440 0 obj -<< -/D [1438 0 R /XYZ 149.705 753.953 null] ->> -% 1441 0 obj -<< -/D [1438 0 R /XYZ 150.705 716.092 null] ->> -% 1442 0 obj -<< -/D [1438 0 R /XYZ 150.705 664.341 null] ->> -% 1437 0 obj -<< -/Font << /F8 585 0 R /F30 810 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1446 0 obj -<< -/Type /Page -/Contents 1447 0 R -/Resources 1445 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1436 0 R -/Annots [ 1443 0 R 1444 0 R ] ->> -% 1443 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [294.721 574.94 361.779 586.065] -/A << /S /GoTo /D (descdata) >> ->> -% 1444 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [294.721 405.575 372.239 416.7] -/A << /S /GoTo /D (spdata) >> ->> -% 1448 0 obj -<< -/D [1446 0 R /XYZ 98.895 753.953 null] ->> -% 336 0 obj -<< -/D [1446 0 R /XYZ 99.895 716.092 null] ->> -% 1449 0 obj -<< -/D [1446 0 R /XYZ 99.895 315.137 null] ->> -% 1450 0 obj -<< -/D [1446 0 R /XYZ 99.895 293.274 null] ->> -% 1451 0 obj -<< -/D [1446 0 R /XYZ 99.895 273.349 null] ->> -% 1445 0 obj -<< -/Font << /F16 582 0 R /F30 810 0 R /F27 584 0 R /F8 585 0 R /F11 796 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1454 0 obj -<< -/Type /Page -/Contents 1455 0 R -/Resources 1453 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1436 0 R ->> -% 1456 0 obj -<< -/D [1454 0 R /XYZ 149.705 753.953 null] ->> -% 340 0 obj -<< -/D [1454 0 R /XYZ 150.705 716.092 null] ->> -% 1453 0 obj -<< -/Font << /F16 582 0 R /F30 810 0 R /F27 584 0 R /F8 585 0 R /F11 796 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1460 0 obj -<< -/Type /Page -/Contents 1461 0 R -/Resources 1459 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1436 0 R -/Annots [ 1452 0 R 1457 0 R 1458 0 R ] ->> - -endstream -endobj -1471 0 obj +1472 0 obj << /Length 3810 >> @@ -17440,7 +17438,7 @@ ET endstream endobj -1483 0 obj +1484 0 obj << /Length 6651 >> @@ -17575,7 +17573,7 @@ ET endstream endobj -1488 0 obj +1489 0 obj << /Length 2255 >> @@ -17614,7 +17612,7 @@ ET endstream endobj -1500 0 obj +1501 0 obj << /Length 3097 >> @@ -17705,7 +17703,7 @@ ET endstream endobj -1506 0 obj +1507 0 obj << /Length 3985 >> @@ -17804,7 +17802,7 @@ ET endstream endobj -1513 0 obj +1514 0 obj << /Length 5118 >> @@ -17910,7 +17908,7 @@ ET endstream endobj -1519 0 obj +1520 0 obj << /Length 6852 >> @@ -18024,7 +18022,7 @@ ET endstream endobj -1523 0 obj +1524 0 obj << /Length 1111 >> @@ -18051,7 +18049,7 @@ ET endstream endobj -1533 0 obj +1534 0 obj << /Length 5226 >> @@ -18206,7 +18204,7 @@ ET endstream endobj -1539 0 obj +1540 0 obj << /Length 3389 >> @@ -18304,7 +18302,7 @@ ET endstream endobj -1543 0 obj +1544 0 obj << /Length 3466 >> @@ -18356,7 +18354,7 @@ ET endstream endobj -1548 0 obj +1549 0 obj << /Length 6552 >> @@ -18459,7 +18457,7 @@ ET endstream endobj -1552 0 obj +1553 0 obj << /Length 705 >> @@ -18482,7 +18480,7 @@ ET endstream endobj -1559 0 obj +1560 0 obj << /Length 5730 >> @@ -18581,7 +18579,7 @@ ET endstream endobj -1565 0 obj +1566 0 obj << /Length 3294 >> @@ -18665,25 +18663,34 @@ ET endstream endobj -1468 0 obj +1469 0 obj << /Type /ObjStm /N 100 -/First 976 -/Length 10549 +/First 977 +/Length 10649 >> stream -1452 0 1457 146 1458 291 1462 436 1463 494 1464 552 1465 610 1466 668 1467 726 1459 784 -1470 903 1472 1021 1473 1080 1474 1139 1475 1198 1476 1257 1477 1315 1478 1374 1469 1433 1482 1526 -1479 1674 1480 1820 1484 1965 344 2023 1481 2080 1487 2186 1489 2304 1490 2363 1491 2422 1492 2481 -1493 2540 1494 2599 1495 2658 1486 2716 1499 2796 1496 2944 1497 3088 1501 3235 348 3293 1498 3350 -1505 3456 1502 3604 1503 3748 1507 3894 352 3953 1508 4011 1504 4070 1512 4176 1509 4324 1510 4469 -1514 4613 356 4671 1511 4728 1518 4847 1515 4995 1516 5141 1520 5285 360 5344 1517 5402 1522 5521 -1524 5639 1525 5697 1526 5755 1521 5813 1532 5906 1528 6063 1529 6209 1530 6353 1534 6496 364 6555 -1531 6613 1538 6732 1535 6880 1536 7023 1540 7169 368 7227 1537 7284 1542 7390 1544 7508 372 7567 -1541 7625 1547 7757 1545 7896 1549 8042 376 8100 1546 8157 1551 8276 1553 8394 1554 8453 1555 8512 -1550 8571 1558 8651 1556 8790 1560 8937 380 8995 1557 9052 1564 9171 1562 9310 1566 9456 384 9515 -% 1452 0 obj +1461 0 1453 157 1458 303 1459 448 1463 593 1464 651 1465 709 1466 767 1467 825 1468 883 +1460 941 1471 1060 1473 1178 1474 1237 1475 1296 1476 1355 1477 1414 1478 1472 1479 1531 1470 1590 +1483 1683 1480 1831 1481 1977 1485 2122 344 2180 1482 2237 1488 2343 1490 2461 1491 2520 1492 2579 +1493 2638 1494 2697 1495 2756 1496 2815 1487 2873 1500 2953 1497 3101 1498 3245 1502 3392 348 3450 +1499 3507 1506 3613 1503 3761 1504 3905 1508 4051 352 4110 1509 4168 1505 4227 1513 4333 1510 4481 +1511 4626 1515 4770 356 4828 1512 4885 1519 5004 1516 5152 1517 5298 1521 5442 360 5501 1518 5559 +1523 5678 1525 5796 1526 5854 1527 5912 1522 5970 1533 6063 1529 6220 1530 6366 1531 6510 1535 6653 +364 6712 1532 6770 1539 6889 1536 7037 1537 7180 1541 7326 368 7384 1538 7441 1543 7547 1545 7665 +372 7724 1542 7782 1548 7914 1546 8053 1550 8199 376 8257 1547 8314 1552 8433 1554 8551 1555 8610 +1556 8669 1551 8728 1559 8808 1557 8947 1561 9094 380 9152 1558 9209 1565 9328 1563 9467 1567 9613 +% 1461 0 obj +<< +/Type /Page +/Contents 1462 0 R +/Resources 1460 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1437 0 R +/Annots [ 1453 0 R 1458 0 R 1459 0 R ] +>> +% 1453 0 obj << /Type /Annot /Subtype /Link @@ -18691,7 +18698,7 @@ stream /Rect [261.152 655.098 328.21 666.223] /A << /S /GoTo /D (descdata) >> >> -% 1457 0 obj +% 1458 0 obj << /Type /Annot /Subtype /Link @@ -18699,7 +18706,7 @@ stream /Rect [294.721 488.124 372.239 499.249] /A << /S /GoTo /D (spdata) >> >> -% 1458 0 obj +% 1459 0 obj << /Type /Annot /Subtype /Link @@ -18707,94 +18714,94 @@ stream /Rect [261.152 420.91 328.21 432.035] /A << /S /GoTo /D (descdata) >> >> -% 1462 0 obj -<< -/D [1460 0 R /XYZ 98.895 753.953 null] ->> % 1463 0 obj << -/D [1460 0 R /XYZ 99.895 321.172 null] +/D [1461 0 R /XYZ 98.895 753.953 null] >> % 1464 0 obj << -/D [1460 0 R /XYZ 99.895 289.823 null] +/D [1461 0 R /XYZ 99.895 321.172 null] >> % 1465 0 obj << -/D [1460 0 R /XYZ 99.895 256.537 null] +/D [1461 0 R /XYZ 99.895 289.823 null] >> % 1466 0 obj << -/D [1460 0 R /XYZ 99.895 189.322 null] +/D [1461 0 R /XYZ 99.895 256.537 null] >> % 1467 0 obj << -/D [1460 0 R /XYZ 99.895 169.929 null] +/D [1461 0 R /XYZ 99.895 189.322 null] >> -% 1459 0 obj +% 1468 0 obj << -/Font << /F27 584 0 R /F8 585 0 R /F30 810 0 R /F16 582 0 R /F11 796 0 R >> +/D [1461 0 R /XYZ 99.895 169.929 null] +>> +% 1460 0 obj +<< +/Font << /F27 584 0 R /F8 585 0 R /F30 811 0 R /F16 582 0 R /F11 797 0 R >> /ProcSet [ /PDF /Text ] >> -% 1470 0 obj +% 1471 0 obj << /Type /Page -/Contents 1471 0 R -/Resources 1469 0 R +/Contents 1472 0 R +/Resources 1470 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1436 0 R ->> -% 1472 0 obj -<< -/D [1470 0 R /XYZ 149.705 753.953 null] +/Parent 1437 0 R >> % 1473 0 obj << -/D [1470 0 R /XYZ 150.705 716.092 null] +/D [1471 0 R /XYZ 149.705 753.953 null] >> % 1474 0 obj << -/D [1470 0 R /XYZ 150.705 652.386 null] +/D [1471 0 R /XYZ 150.705 716.092 null] >> % 1475 0 obj << -/D [1470 0 R /XYZ 150.705 607.997 null] +/D [1471 0 R /XYZ 150.705 652.386 null] >> % 1476 0 obj << -/D [1470 0 R /XYZ 150.705 576.67 null] +/D [1471 0 R /XYZ 150.705 607.997 null] >> % 1477 0 obj << -/D [1470 0 R /XYZ 150.705 544.789 null] +/D [1471 0 R /XYZ 150.705 576.67 null] >> % 1478 0 obj << -/D [1470 0 R /XYZ 150.705 500.954 null] ->> -% 1469 0 obj -<< -/Font << /F8 585 0 R /F11 796 0 R /F14 813 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1482 0 obj -<< -/Type /Page -/Contents 1483 0 R -/Resources 1481 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1485 0 R -/Annots [ 1479 0 R 1480 0 R ] +/D [1471 0 R /XYZ 150.705 544.789 null] >> % 1479 0 obj << +/D [1471 0 R /XYZ 150.705 500.954 null] +>> +% 1470 0 obj +<< +/Font << /F8 585 0 R /F11 797 0 R /F14 814 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1483 0 obj +<< +/Type /Page +/Contents 1484 0 R +/Resources 1482 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1486 0 R +/Annots [ 1480 0 R 1481 0 R ] +>> +% 1480 0 obj +<< /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] /Rect [294.721 576.23 361.779 587.355] /A << /S /GoTo /D (descdata) >> >> -% 1480 0 obj +% 1481 0 obj << /Type /Annot /Subtype /Link @@ -18802,78 +18809,78 @@ stream /Rect [294.721 205.776 372.239 216.901] /A << /S /GoTo /D (spdata) >> >> -% 1484 0 obj +% 1485 0 obj << -/D [1482 0 R /XYZ 98.895 753.953 null] +/D [1483 0 R /XYZ 98.895 753.953 null] >> % 344 0 obj << -/D [1482 0 R /XYZ 99.895 716.092 null] +/D [1483 0 R /XYZ 99.895 716.092 null] >> -% 1481 0 obj +% 1482 0 obj << -/Font << /F16 582 0 R /F30 810 0 R /F27 584 0 R /F8 585 0 R >> +/Font << /F16 582 0 R /F30 811 0 R /F27 584 0 R /F8 585 0 R >> /ProcSet [ /PDF /Text ] >> -% 1487 0 obj +% 1488 0 obj << /Type /Page -/Contents 1488 0 R -/Resources 1486 0 R +/Contents 1489 0 R +/Resources 1487 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1485 0 R ->> -% 1489 0 obj -<< -/D [1487 0 R /XYZ 149.705 753.953 null] +/Parent 1486 0 R >> % 1490 0 obj << -/D [1487 0 R /XYZ 150.705 716.092 null] +/D [1488 0 R /XYZ 149.705 753.953 null] >> % 1491 0 obj << -/D [1487 0 R /XYZ 150.705 687.975 null] +/D [1488 0 R /XYZ 150.705 716.092 null] >> % 1492 0 obj << -/D [1487 0 R /XYZ 150.705 668.326 null] +/D [1488 0 R /XYZ 150.705 687.975 null] >> % 1493 0 obj << -/D [1487 0 R /XYZ 150.705 624.491 null] +/D [1488 0 R /XYZ 150.705 668.326 null] >> % 1494 0 obj << -/D [1487 0 R /XYZ 150.705 580.655 null] +/D [1488 0 R /XYZ 150.705 624.491 null] >> % 1495 0 obj << -/D [1487 0 R /XYZ 150.705 560.73 null] ->> -% 1486 0 obj -<< -/Font << /F8 585 0 R /F30 810 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1499 0 obj -<< -/Type /Page -/Contents 1500 0 R -/Resources 1498 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1485 0 R -/Annots [ 1496 0 R 1497 0 R ] +/D [1488 0 R /XYZ 150.705 580.655 null] >> % 1496 0 obj << +/D [1488 0 R /XYZ 150.705 560.73 null] +>> +% 1487 0 obj +<< +/Font << /F8 585 0 R /F30 811 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1500 0 obj +<< +/Type /Page +/Contents 1501 0 R +/Resources 1499 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1486 0 R +/Annots [ 1497 0 R 1498 0 R ] +>> +% 1497 0 obj +<< /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] /Rect [294.721 574.94 372.239 586.065] /A << /S /GoTo /D (spdata) >> >> -% 1497 0 obj +% 1498 0 obj << /Type /Annot /Subtype /Link @@ -18881,29 +18888,29 @@ stream /Rect [294.721 507.194 361.779 518.319] /A << /S /GoTo /D (descdata) >> >> -% 1501 0 obj +% 1502 0 obj << -/D [1499 0 R /XYZ 98.895 753.953 null] +/D [1500 0 R /XYZ 98.895 753.953 null] >> % 348 0 obj << -/D [1499 0 R /XYZ 99.895 716.092 null] +/D [1500 0 R /XYZ 99.895 716.092 null] >> -% 1498 0 obj +% 1499 0 obj << -/Font << /F16 582 0 R /F30 810 0 R /F27 584 0 R /F8 585 0 R >> +/Font << /F16 582 0 R /F30 811 0 R /F27 584 0 R /F8 585 0 R >> /ProcSet [ /PDF /Text ] >> -% 1505 0 obj +% 1506 0 obj << /Type /Page -/Contents 1506 0 R -/Resources 1504 0 R +/Contents 1507 0 R +/Resources 1505 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1485 0 R -/Annots [ 1502 0 R 1503 0 R ] +/Parent 1486 0 R +/Annots [ 1503 0 R 1504 0 R ] >> -% 1502 0 obj +% 1503 0 obj << /Type /Annot /Subtype /Link @@ -18911,7 +18918,7 @@ stream /Rect [345.53 560.993 423.049 572.118] /A << /S /GoTo /D (spdata) >> >> -% 1503 0 obj +% 1504 0 obj << /Type /Annot /Subtype /Link @@ -18919,41 +18926,41 @@ stream /Rect [345.53 493.247 412.588 504.372] /A << /S /GoTo /D (descdata) >> >> -% 1507 0 obj +% 1508 0 obj << -/D [1505 0 R /XYZ 149.705 753.953 null] +/D [1506 0 R /XYZ 149.705 753.953 null] >> % 352 0 obj << -/D [1505 0 R /XYZ 150.705 716.092 null] ->> -% 1508 0 obj -<< -/D [1505 0 R /XYZ 150.705 313.144 null] ->> -% 1504 0 obj -<< -/Font << /F16 582 0 R /F30 810 0 R /F27 584 0 R /F8 585 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1512 0 obj -<< -/Type /Page -/Contents 1513 0 R -/Resources 1511 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1485 0 R -/Annots [ 1509 0 R 1510 0 R ] +/D [1506 0 R /XYZ 150.705 716.092 null] >> % 1509 0 obj << +/D [1506 0 R /XYZ 150.705 313.144 null] +>> +% 1505 0 obj +<< +/Font << /F16 582 0 R /F30 811 0 R /F27 584 0 R /F8 585 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1513 0 obj +<< +/Type /Page +/Contents 1514 0 R +/Resources 1512 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1486 0 R +/Annots [ 1510 0 R 1511 0 R ] +>> +% 1510 0 obj +<< /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] /Rect [261.152 574.94 328.21 586.065] /A << /S /GoTo /D (descdata) >> >> -% 1510 0 obj +% 1511 0 obj << /Type /Annot /Subtype /Link @@ -18961,29 +18968,29 @@ stream /Rect [213.774 290.009 289.828 301.134] /A << /S /GoTo /D (vdata) >> >> -% 1514 0 obj +% 1515 0 obj << -/D [1512 0 R /XYZ 98.895 753.953 null] +/D [1513 0 R /XYZ 98.895 753.953 null] >> % 356 0 obj << -/D [1512 0 R /XYZ 99.895 716.092 null] +/D [1513 0 R /XYZ 99.895 716.092 null] >> -% 1511 0 obj +% 1512 0 obj << -/Font << /F16 582 0 R /F30 810 0 R /F27 584 0 R /F8 585 0 R /F11 796 0 R >> +/Font << /F16 582 0 R /F30 811 0 R /F27 584 0 R /F8 585 0 R /F11 797 0 R >> /ProcSet [ /PDF /Text ] >> -% 1518 0 obj +% 1519 0 obj << /Type /Page -/Contents 1519 0 R -/Resources 1517 0 R +/Contents 1520 0 R +/Resources 1518 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1485 0 R -/Annots [ 1515 0 R 1516 0 R ] +/Parent 1486 0 R +/Annots [ 1516 0 R 1517 0 R ] >> -% 1515 0 obj +% 1516 0 obj << /Type /Annot /Subtype /Link @@ -18991,7 +18998,7 @@ stream /Rect [345.53 363.459 412.588 374.584] /A << /S /GoTo /D (descdata) >> >> -% 1516 0 obj +% 1517 0 obj << /Type /Annot /Subtype /Link @@ -18999,54 +19006,54 @@ stream /Rect [416.591 141.026 492.645 152.151] /A << /S /GoTo /D (vdata) >> >> -% 1520 0 obj +% 1521 0 obj << -/D [1518 0 R /XYZ 149.705 753.953 null] +/D [1519 0 R /XYZ 149.705 753.953 null] >> % 360 0 obj << -/D [1518 0 R /XYZ 150.705 716.092 null] +/D [1519 0 R /XYZ 150.705 716.092 null] >> -% 1517 0 obj +% 1518 0 obj << -/Font << /F16 582 0 R /F30 810 0 R /F27 584 0 R /F8 585 0 R /F11 796 0 R >> +/Font << /F16 582 0 R /F30 811 0 R /F27 584 0 R /F8 585 0 R /F11 797 0 R >> /ProcSet [ /PDF /Text ] >> -% 1522 0 obj +% 1523 0 obj << /Type /Page -/Contents 1523 0 R -/Resources 1521 0 R +/Contents 1524 0 R +/Resources 1522 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1527 0 R ->> -% 1524 0 obj -<< -/D [1522 0 R /XYZ 98.895 753.953 null] +/Parent 1528 0 R >> % 1525 0 obj << -/D [1522 0 R /XYZ 99.895 632.405 null] +/D [1523 0 R /XYZ 98.895 753.953 null] >> % 1526 0 obj << -/D [1522 0 R /XYZ 99.895 609.989 null] +/D [1523 0 R /XYZ 99.895 632.405 null] >> -% 1521 0 obj +% 1527 0 obj +<< +/D [1523 0 R /XYZ 99.895 609.989 null] +>> +% 1522 0 obj << /Font << /F27 584 0 R /F8 585 0 R /F16 582 0 R >> /ProcSet [ /PDF /Text ] >> -% 1532 0 obj +% 1533 0 obj << /Type /Page -/Contents 1533 0 R -/Resources 1531 0 R +/Contents 1534 0 R +/Resources 1532 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1527 0 R -/Annots [ 1528 0 R 1529 0 R 1530 0 R ] +/Parent 1528 0 R +/Annots [ 1529 0 R 1530 0 R 1531 0 R ] >> -% 1528 0 obj +% 1529 0 obj << /Type /Annot /Subtype /Link @@ -19054,7 +19061,7 @@ stream /Rect [311.962 574.94 379.019 586.065] /A << /S /GoTo /D (descdata) >> >> -% 1529 0 obj +% 1530 0 obj << /Type /Annot /Subtype /Link @@ -19062,7 +19069,7 @@ stream /Rect [320.727 483.284 396.781 494.409] /A << /S /GoTo /D (vdata) >> >> -% 1530 0 obj +% 1531 0 obj << /Type /Annot /Subtype /Link @@ -19070,29 +19077,29 @@ stream /Rect [238.542 381.665 314.596 392.79] /A << /S /GoTo /D (vdata) >> >> -% 1534 0 obj +% 1535 0 obj << -/D [1532 0 R /XYZ 149.705 753.953 null] +/D [1533 0 R /XYZ 149.705 753.953 null] >> % 364 0 obj << -/D [1532 0 R /XYZ 150.705 716.092 null] +/D [1533 0 R /XYZ 150.705 716.092 null] >> -% 1531 0 obj +% 1532 0 obj << -/Font << /F16 582 0 R /F30 810 0 R /F27 584 0 R /F8 585 0 R /F11 796 0 R >> +/Font << /F16 582 0 R /F30 811 0 R /F27 584 0 R /F8 585 0 R /F11 797 0 R >> /ProcSet [ /PDF /Text ] >> -% 1538 0 obj +% 1539 0 obj << /Type /Page -/Contents 1539 0 R -/Resources 1537 0 R +/Contents 1540 0 R +/Resources 1538 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1527 0 R -/Annots [ 1535 0 R 1536 0 R ] +/Parent 1528 0 R +/Annots [ 1536 0 R 1537 0 R ] >> -% 1535 0 obj +% 1536 0 obj << /Type /Annot /Subtype /Link @@ -19100,7 +19107,7 @@ stream /Rect [187.733 562.985 263.787 574.11] /A << /S /GoTo /D (vdata) >> >> -% 1536 0 obj +% 1537 0 obj << /Type /Annot /Subtype /Link @@ -19108,50 +19115,50 @@ stream /Rect [261.152 483.284 328.21 494.409] /A << /S /GoTo /D (descdata) >> >> -% 1540 0 obj +% 1541 0 obj << -/D [1538 0 R /XYZ 98.895 753.953 null] +/D [1539 0 R /XYZ 98.895 753.953 null] >> % 368 0 obj << -/D [1538 0 R /XYZ 99.895 716.092 null] +/D [1539 0 R /XYZ 99.895 716.092 null] >> -% 1537 0 obj +% 1538 0 obj << -/Font << /F16 582 0 R /F30 810 0 R /F27 584 0 R /F8 585 0 R >> +/Font << /F16 582 0 R /F30 811 0 R /F27 584 0 R /F8 585 0 R >> /ProcSet [ /PDF /Text ] >> -% 1542 0 obj +% 1543 0 obj << /Type /Page -/Contents 1543 0 R -/Resources 1541 0 R +/Contents 1544 0 R +/Resources 1542 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1527 0 R +/Parent 1528 0 R >> -% 1544 0 obj +% 1545 0 obj << -/D [1542 0 R /XYZ 149.705 753.953 null] +/D [1543 0 R /XYZ 149.705 753.953 null] >> % 372 0 obj << -/D [1542 0 R /XYZ 150.705 716.092 null] +/D [1543 0 R /XYZ 150.705 716.092 null] >> -% 1541 0 obj +% 1542 0 obj << -/Font << /F16 582 0 R /F30 810 0 R /F27 584 0 R /F8 585 0 R /F11 796 0 R /F10 812 0 R >> +/Font << /F16 582 0 R /F30 811 0 R /F27 584 0 R /F8 585 0 R /F11 797 0 R /F10 813 0 R >> /ProcSet [ /PDF /Text ] >> -% 1547 0 obj +% 1548 0 obj << /Type /Page -/Contents 1548 0 R -/Resources 1546 0 R +/Contents 1549 0 R +/Resources 1547 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1527 0 R -/Annots [ 1545 0 R ] +/Parent 1528 0 R +/Annots [ 1546 0 R ] >> -% 1545 0 obj +% 1546 0 obj << /Type /Annot /Subtype /Link @@ -19159,84 +19166,84 @@ stream /Rect [294.721 484.86 361.779 495.985] /A << /S /GoTo /D (descdata) >> >> -% 1549 0 obj +% 1550 0 obj << -/D [1547 0 R /XYZ 98.895 753.953 null] +/D [1548 0 R /XYZ 98.895 753.953 null] >> % 376 0 obj << -/D [1547 0 R /XYZ 99.895 716.092 null] +/D [1548 0 R /XYZ 99.895 716.092 null] >> -% 1546 0 obj +% 1547 0 obj << -/Font << /F16 582 0 R /F30 810 0 R /F27 584 0 R /F8 585 0 R /F11 796 0 R >> +/Font << /F16 582 0 R /F30 811 0 R /F27 584 0 R /F8 585 0 R /F11 797 0 R >> /ProcSet [ /PDF /Text ] >> -% 1551 0 obj +% 1552 0 obj << /Type /Page -/Contents 1552 0 R -/Resources 1550 0 R +/Contents 1553 0 R +/Resources 1551 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1527 0 R ->> -% 1553 0 obj -<< -/D [1551 0 R /XYZ 149.705 753.953 null] +/Parent 1528 0 R >> % 1554 0 obj << -/D [1551 0 R /XYZ 150.705 716.092 null] +/D [1552 0 R /XYZ 149.705 753.953 null] >> % 1555 0 obj << -/D [1551 0 R /XYZ 150.705 688.251 null] ->> -% 1550 0 obj -<< -/Font << /F8 585 0 R /F30 810 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1558 0 obj -<< -/Type /Page -/Contents 1559 0 R -/Resources 1557 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1561 0 R -/Annots [ 1556 0 R ] +/D [1552 0 R /XYZ 150.705 716.092 null] >> % 1556 0 obj << +/D [1552 0 R /XYZ 150.705 688.251 null] +>> +% 1551 0 obj +<< +/Font << /F8 585 0 R /F30 811 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1559 0 obj +<< +/Type /Page +/Contents 1560 0 R +/Resources 1558 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1562 0 R +/Annots [ 1557 0 R ] +>> +% 1557 0 obj +<< /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] /Rect [294.721 483.284 361.779 494.409] /A << /S /GoTo /D (descdata) >> >> -% 1560 0 obj +% 1561 0 obj << -/D [1558 0 R /XYZ 98.895 753.953 null] +/D [1559 0 R /XYZ 98.895 753.953 null] >> % 380 0 obj << -/D [1558 0 R /XYZ 99.895 716.092 null] +/D [1559 0 R /XYZ 99.895 716.092 null] >> -% 1557 0 obj +% 1558 0 obj << -/Font << /F16 582 0 R /F30 810 0 R /F27 584 0 R /F8 585 0 R /F11 796 0 R >> +/Font << /F16 582 0 R /F30 811 0 R /F27 584 0 R /F8 585 0 R /F11 797 0 R >> /ProcSet [ /PDF /Text ] >> -% 1564 0 obj +% 1565 0 obj << /Type /Page -/Contents 1565 0 R -/Resources 1563 0 R +/Contents 1566 0 R +/Resources 1564 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1561 0 R -/Annots [ 1562 0 R ] +/Parent 1562 0 R +/Annots [ 1563 0 R ] >> -% 1562 0 obj +% 1563 0 obj << /Type /Annot /Subtype /Link @@ -19244,18 +19251,14 @@ stream /Rect [345.53 495.239 412.588 506.364] /A << /S /GoTo /D (descdata) >> >> -% 1566 0 obj +% 1567 0 obj << -/D [1564 0 R /XYZ 149.705 753.953 null] ->> -% 384 0 obj -<< -/D [1564 0 R /XYZ 150.705 716.092 null] +/D [1565 0 R /XYZ 149.705 753.953 null] >> endstream endobj -1572 0 obj +1573 0 obj << /Length 4991 >> @@ -19347,7 +19350,7 @@ ET endstream endobj -1578 0 obj +1579 0 obj << /Length 3263 >> @@ -19431,7 +19434,7 @@ ET endstream endobj -1584 0 obj +1585 0 obj << /Length 4975 >> @@ -19523,7 +19526,7 @@ ET endstream endobj -1590 0 obj +1591 0 obj << /Length 3846 >> @@ -19604,7 +19607,7 @@ ET endstream endobj -1597 0 obj +1598 0 obj << /Length 3666 >> @@ -19685,7 +19688,7 @@ ET endstream endobj -1605 0 obj +1606 0 obj << /Length 5828 >> @@ -19774,7 +19777,7 @@ ET endstream endobj -1609 0 obj +1610 0 obj << /Length 3702 >> @@ -19813,7 +19816,7 @@ ET endstream endobj -1619 0 obj +1620 0 obj << /Length 4138 >> @@ -19926,7 +19929,7 @@ ET endstream endobj -1623 0 obj +1624 0 obj << /Length 5773 >> @@ -20008,7 +20011,7 @@ ET endstream endobj -1627 0 obj +1628 0 obj << /Length 6992 >> @@ -20116,7 +20119,7 @@ ET endstream endobj -1640 0 obj +1641 0 obj << /Length 182 >> @@ -20132,7 +20135,7 @@ ET endstream endobj -1645 0 obj +1646 0 obj << /Length 5584 >> @@ -20206,7 +20209,7 @@ ET endstream endobj -1651 0 obj +1652 0 obj << /Length 4667 >> @@ -20262,7 +20265,7 @@ ET endstream endobj -1657 0 obj +1658 0 obj << /Length 4365 >> @@ -20315,7 +20318,7 @@ ET endstream endobj -1664 0 obj +1665 0 obj << /Length 2621 >> @@ -20373,7 +20376,7 @@ ET endstream endobj -1668 0 obj +1669 0 obj << /Length 3470 >> @@ -20435,7 +20438,552 @@ ET endstream endobj -1672 0 obj +1569 0 obj +<< +/Type /ObjStm +/N 100 +/First 971 +/Length 9711 +>> +stream +384 0 1568 58 1564 117 1572 236 1570 375 1574 522 388 580 1575 637 1571 695 1578 814 +1576 953 1580 1099 392 1158 1581 1216 1577 1275 1584 1394 1582 1533 1586 1680 396 1738 1587 1795 +1583 1853 1590 1972 1588 2111 1592 2257 400 2316 1593 2374 1594 2432 1589 2491 1597 2597 1595 2736 +1599 2882 405 2940 1600 2997 1601 3055 1596 3113 1605 3219 1603 3358 1607 3502 409 3561 1604 3619 +1609 3738 1611 3856 1612 3914 1613 3972 1614 4030 1608 4088 1619 4207 1615 4364 1616 4508 1617 4654 +1621 4799 413 4858 1618 4916 1623 5035 1625 5153 417 5211 1622 5268 1627 5387 1629 5505 1630 5564 +1631 5623 1632 5682 1633 5741 1634 5800 1635 5859 1636 5917 1637 5976 1638 6035 1626 6094 1640 6212 +1642 6330 421 6388 1639 6445 1645 6525 1647 6643 425 6702 1648 6760 1649 6819 1644 6878 1651 7010 +1653 7128 429 7186 1654 7243 1655 7300 1650 7358 1657 7490 1659 7608 433 7667 1660 7725 1661 7784 +1662 7843 1656 7902 1664 8034 1666 8152 437 8210 1663 8267 1668 8373 1670 8491 441 8550 1667 8608 +% 384 0 obj +<< +/D [1565 0 R /XYZ 150.705 716.092 null] +>> +% 1568 0 obj +<< +/D [1565 0 R /XYZ 150.705 382.883 null] +>> +% 1564 0 obj +<< +/Font << /F16 582 0 R /F30 811 0 R /F27 584 0 R /F8 585 0 R /F11 797 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1572 0 obj +<< +/Type /Page +/Contents 1573 0 R +/Resources 1571 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1562 0 R +/Annots [ 1570 0 R ] +>> +% 1570 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [294.721 495.239 361.779 506.364] +/A << /S /GoTo /D (descdata) >> +>> +% 1574 0 obj +<< +/D [1572 0 R /XYZ 98.895 753.953 null] +>> +% 388 0 obj +<< +/D [1572 0 R /XYZ 99.895 716.092 null] +>> +% 1575 0 obj +<< +/D [1572 0 R /XYZ 99.895 259.346 null] +>> +% 1571 0 obj +<< +/Font << /F16 582 0 R /F30 811 0 R /F27 584 0 R /F8 585 0 R /F11 797 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1578 0 obj +<< +/Type /Page +/Contents 1579 0 R +/Resources 1577 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1562 0 R +/Annots [ 1576 0 R ] +>> +% 1576 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [345.53 495.239 412.588 506.364] +/A << /S /GoTo /D (descdata) >> +>> +% 1580 0 obj +<< +/D [1578 0 R /XYZ 149.705 753.953 null] +>> +% 392 0 obj +<< +/D [1578 0 R /XYZ 150.705 716.092 null] +>> +% 1581 0 obj +<< +/D [1578 0 R /XYZ 150.705 382.883 null] +>> +% 1577 0 obj +<< +/Font << /F16 582 0 R /F30 811 0 R /F27 584 0 R /F8 585 0 R /F11 797 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1584 0 obj +<< +/Type /Page +/Contents 1585 0 R +/Resources 1583 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1562 0 R +/Annots [ 1582 0 R ] +>> +% 1582 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [294.721 495.239 361.779 506.364] +/A << /S /GoTo /D (descdata) >> +>> +% 1586 0 obj +<< +/D [1584 0 R /XYZ 98.895 753.953 null] +>> +% 396 0 obj +<< +/D [1584 0 R /XYZ 99.895 716.092 null] +>> +% 1587 0 obj +<< +/D [1584 0 R /XYZ 99.895 259.346 null] +>> +% 1583 0 obj +<< +/Font << /F16 582 0 R /F30 811 0 R /F27 584 0 R /F8 585 0 R /F11 797 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1590 0 obj +<< +/Type /Page +/Contents 1591 0 R +/Resources 1589 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1562 0 R +/Annots [ 1588 0 R ] +>> +% 1588 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [345.53 560.993 412.588 572.118] +/A << /S /GoTo /D (descdata) >> +>> +% 1592 0 obj +<< +/D [1590 0 R /XYZ 149.705 753.953 null] +>> +% 400 0 obj +<< +/D [1590 0 R /XYZ 150.705 716.092 null] +>> +% 1593 0 obj +<< +/D [1590 0 R /XYZ 150.705 356.98 null] +>> +% 1594 0 obj +<< +/D [1590 0 R /XYZ 150.705 313.144 null] +>> +% 1589 0 obj +<< +/Font << /F16 582 0 R /F30 811 0 R /F27 584 0 R /F8 585 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1597 0 obj +<< +/Type /Page +/Contents 1598 0 R +/Resources 1596 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1602 0 R +/Annots [ 1595 0 R ] +>> +% 1595 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [294.721 574.94 361.779 586.065] +/A << /S /GoTo /D (descdata) >> +>> +% 1599 0 obj +<< +/D [1597 0 R /XYZ 98.895 753.953 null] +>> +% 405 0 obj +<< +/D [1597 0 R /XYZ 99.895 716.092 null] +>> +% 1600 0 obj +<< +/D [1597 0 R /XYZ 99.895 370.928 null] +>> +% 1601 0 obj +<< +/D [1597 0 R /XYZ 99.895 339.047 null] +>> +% 1596 0 obj +<< +/Font << /F16 582 0 R /F30 811 0 R /F27 584 0 R /F8 585 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1605 0 obj +<< +/Type /Page +/Contents 1606 0 R +/Resources 1604 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1602 0 R +/Annots [ 1603 0 R ] +>> +% 1603 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [345.53 484.857 423.049 495.982] +/A << /S /GoTo /D (spdata) >> +>> +% 1607 0 obj +<< +/D [1605 0 R /XYZ 149.705 753.953 null] +>> +% 409 0 obj +<< +/D [1605 0 R /XYZ 150.705 716.092 null] +>> +% 1604 0 obj +<< +/Font << /F16 582 0 R /F30 811 0 R /F27 584 0 R /F8 585 0 R /F11 797 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1609 0 obj +<< +/Type /Page +/Contents 1610 0 R +/Resources 1608 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1602 0 R +>> +% 1611 0 obj +<< +/D [1609 0 R /XYZ 98.895 753.953 null] +>> +% 1612 0 obj +<< +/D [1609 0 R /XYZ 99.895 496.913 null] +>> +% 1613 0 obj +<< +/D [1609 0 R /XYZ 99.895 439.185 null] +>> +% 1614 0 obj +<< +/D [1609 0 R /XYZ 99.895 418.983 null] +>> +% 1608 0 obj +<< +/Font << /F27 584 0 R /F8 585 0 R /F30 811 0 R /F16 582 0 R /F11 797 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1619 0 obj +<< +/Type /Page +/Contents 1620 0 R +/Resources 1618 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1602 0 R +/Annots [ 1615 0 R 1616 0 R 1617 0 R ] +>> +% 1615 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [345.53 529.112 423.049 540.237] +/A << /S /GoTo /D (spdata) >> +>> +% 1616 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [345.53 461.366 412.588 472.491] +/A << /S /GoTo /D (descdata) >> +>> +% 1617 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [372.153 405.575 439.211 416.7] +/A << /S /GoTo /D (precdata) >> +>> +% 1621 0 obj +<< +/D [1619 0 R /XYZ 149.705 753.953 null] +>> +% 413 0 obj +<< +/D [1619 0 R /XYZ 150.705 716.092 null] +>> +% 1618 0 obj +<< +/Font << /F16 582 0 R /F8 585 0 R /F30 811 0 R /F27 584 0 R /F11 797 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1623 0 obj +<< +/Type /Page +/Contents 1624 0 R +/Resources 1622 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1602 0 R +>> +% 1625 0 obj +<< +/D [1623 0 R /XYZ 98.895 753.953 null] +>> +% 417 0 obj +<< +/D [1623 0 R /XYZ 99.895 716.092 null] +>> +% 1622 0 obj +<< +/Font << /F16 582 0 R /F30 811 0 R /F8 585 0 R /F11 797 0 R /F27 584 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1627 0 obj +<< +/Type /Page +/Contents 1628 0 R +/Resources 1626 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1602 0 R +>> +% 1629 0 obj +<< +/D [1627 0 R /XYZ 149.705 753.953 null] +>> +% 1630 0 obj +<< +/D [1627 0 R /XYZ 150.705 702.144 null] +>> +% 1631 0 obj +<< +/D [1627 0 R /XYZ 150.705 668.326 null] +>> +% 1632 0 obj +<< +/D [1627 0 R /XYZ 150.705 624.491 null] +>> +% 1633 0 obj +<< +/D [1627 0 R /XYZ 150.705 556.745 null] +>> +% 1634 0 obj +<< +/D [1627 0 R /XYZ 150.705 500.954 null] +>> +% 1635 0 obj +<< +/D [1627 0 R /XYZ 150.705 468.52 null] +>> +% 1636 0 obj +<< +/D [1627 0 R /XYZ 150.705 425.182 null] +>> +% 1637 0 obj +<< +/D [1627 0 R /XYZ 150.705 383.395 null] +>> +% 1638 0 obj +<< +/D [1627 0 R /XYZ 150.705 355.499 null] +>> +% 1626 0 obj +<< +/Font << /F16 582 0 R /F8 585 0 R /F11 797 0 R /F14 814 0 R /F7 812 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1640 0 obj +<< +/Type /Page +/Contents 1641 0 R +/Resources 1639 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1643 0 R +>> +% 1642 0 obj +<< +/D [1640 0 R /XYZ 98.895 753.953 null] +>> +% 421 0 obj +<< +/D [1640 0 R /XYZ 99.895 716.092 null] +>> +% 1639 0 obj +<< +/Font << /F16 582 0 R /F8 585 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1645 0 obj +<< +/Type /Page +/Contents 1646 0 R +/Resources 1644 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1643 0 R +>> +% 1647 0 obj +<< +/D [1645 0 R /XYZ 149.705 753.953 null] +>> +% 425 0 obj +<< +/D [1645 0 R /XYZ 150.705 716.092 null] +>> +% 1648 0 obj +<< +/D [1645 0 R /XYZ 150.705 235.436 null] +>> +% 1649 0 obj +<< +/D [1645 0 R /XYZ 150.705 213.573 null] +>> +% 1644 0 obj +<< +/Font << /F16 582 0 R /F30 811 0 R /F8 585 0 R /F27 584 0 R /F11 797 0 R /F14 814 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1651 0 obj +<< +/Type /Page +/Contents 1652 0 R +/Resources 1650 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1643 0 R +>> +% 1653 0 obj +<< +/D [1651 0 R /XYZ 98.895 753.953 null] +>> +% 429 0 obj +<< +/D [1651 0 R /XYZ 99.895 716.092 null] +>> +% 1654 0 obj +<< +/D [1651 0 R /XYZ 99.895 349.01 null] +>> +% 1655 0 obj +<< +/D [1651 0 R /XYZ 99.895 315.192 null] +>> +% 1650 0 obj +<< +/Font << /F16 582 0 R /F30 811 0 R /F8 585 0 R /F27 584 0 R /F14 814 0 R /F11 797 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1657 0 obj +<< +/Type /Page +/Contents 1658 0 R +/Resources 1656 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1643 0 R +>> +% 1659 0 obj +<< +/D [1657 0 R /XYZ 149.705 753.953 null] +>> +% 433 0 obj +<< +/D [1657 0 R /XYZ 150.705 716.092 null] +>> +% 1660 0 obj +<< +/D [1657 0 R /XYZ 150.705 442.659 null] +>> +% 1661 0 obj +<< +/D [1657 0 R /XYZ 150.705 396.886 null] +>> +% 1662 0 obj +<< +/D [1657 0 R /XYZ 150.705 365.005 null] +>> +% 1656 0 obj +<< +/Font << /F16 582 0 R /F30 811 0 R /F8 585 0 R /F27 584 0 R /F11 797 0 R /F14 814 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1664 0 obj +<< +/Type /Page +/Contents 1665 0 R +/Resources 1663 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1643 0 R +>> +% 1666 0 obj +<< +/D [1664 0 R /XYZ 98.895 753.953 null] +>> +% 437 0 obj +<< +/D [1664 0 R /XYZ 99.895 716.092 null] +>> +% 1663 0 obj +<< +/Font << /F16 582 0 R /F30 811 0 R /F8 585 0 R /F27 584 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1668 0 obj +<< +/Type /Page +/Contents 1669 0 R +/Resources 1667 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1643 0 R +>> +% 1670 0 obj +<< +/D [1668 0 R /XYZ 149.705 753.953 null] +>> +% 441 0 obj +<< +/D [1668 0 R /XYZ 150.705 716.092 null] +>> +% 1667 0 obj +<< +/Font << /F16 582 0 R /F30 811 0 R /F8 585 0 R /F11 797 0 R /F27 584 0 R /F14 814 0 R >> +/ProcSet [ /PDF /Text ] +>> + +endstream +endobj +1673 0 obj << /Length 1191 >> @@ -20472,556 +21020,7 @@ ET endstream endobj -1568 0 obj -<< -/Type /ObjStm -/N 100 -/First 973 -/Length 9773 ->> -stream -1567 0 1563 59 1571 178 1569 317 1573 464 388 522 1574 579 1570 637 1577 756 1575 895 -1579 1041 392 1100 1580 1158 1576 1217 1583 1336 1581 1475 1585 1622 396 1680 1586 1737 1582 1795 -1589 1914 1587 2053 1591 2199 400 2258 1592 2316 1593 2374 1588 2433 1596 2539 1594 2678 1598 2824 -405 2882 1599 2939 1600 2997 1595 3055 1604 3161 1602 3300 1606 3444 409 3503 1603 3561 1608 3680 -1610 3798 1611 3856 1612 3914 1613 3972 1607 4030 1618 4149 1614 4306 1615 4450 1616 4596 1620 4741 -413 4800 1617 4858 1622 4977 1624 5095 417 5153 1621 5210 1626 5329 1628 5447 1629 5506 1630 5565 -1631 5624 1632 5683 1633 5742 1634 5801 1635 5859 1636 5918 1637 5977 1625 6036 1639 6154 1641 6272 -421 6330 1638 6387 1644 6467 1646 6585 425 6644 1647 6702 1648 6761 1643 6820 1650 6952 1652 7070 -429 7128 1653 7185 1654 7242 1649 7300 1656 7432 1658 7550 433 7609 1659 7667 1660 7726 1661 7785 -1655 7844 1663 7976 1665 8094 437 8152 1662 8209 1667 8315 1669 8433 441 8492 1666 8550 1671 8682 -% 1567 0 obj -<< -/D [1564 0 R /XYZ 150.705 382.883 null] ->> -% 1563 0 obj -<< -/Font << /F16 582 0 R /F30 810 0 R /F27 584 0 R /F8 585 0 R /F11 796 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1571 0 obj -<< -/Type /Page -/Contents 1572 0 R -/Resources 1570 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1561 0 R -/Annots [ 1569 0 R ] ->> -% 1569 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [294.721 495.239 361.779 506.364] -/A << /S /GoTo /D (descdata) >> ->> -% 1573 0 obj -<< -/D [1571 0 R /XYZ 98.895 753.953 null] ->> -% 388 0 obj -<< -/D [1571 0 R /XYZ 99.895 716.092 null] ->> -% 1574 0 obj -<< -/D [1571 0 R /XYZ 99.895 259.346 null] ->> -% 1570 0 obj -<< -/Font << /F16 582 0 R /F30 810 0 R /F27 584 0 R /F8 585 0 R /F11 796 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1577 0 obj -<< -/Type /Page -/Contents 1578 0 R -/Resources 1576 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1561 0 R -/Annots [ 1575 0 R ] ->> -% 1575 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [345.53 495.239 412.588 506.364] -/A << /S /GoTo /D (descdata) >> ->> -% 1579 0 obj -<< -/D [1577 0 R /XYZ 149.705 753.953 null] ->> -% 392 0 obj -<< -/D [1577 0 R /XYZ 150.705 716.092 null] ->> -% 1580 0 obj -<< -/D [1577 0 R /XYZ 150.705 382.883 null] ->> -% 1576 0 obj -<< -/Font << /F16 582 0 R /F30 810 0 R /F27 584 0 R /F8 585 0 R /F11 796 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1583 0 obj -<< -/Type /Page -/Contents 1584 0 R -/Resources 1582 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1561 0 R -/Annots [ 1581 0 R ] ->> -% 1581 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [294.721 495.239 361.779 506.364] -/A << /S /GoTo /D (descdata) >> ->> -% 1585 0 obj -<< -/D [1583 0 R /XYZ 98.895 753.953 null] ->> -% 396 0 obj -<< -/D [1583 0 R /XYZ 99.895 716.092 null] ->> -% 1586 0 obj -<< -/D [1583 0 R /XYZ 99.895 259.346 null] ->> -% 1582 0 obj -<< -/Font << /F16 582 0 R /F30 810 0 R /F27 584 0 R /F8 585 0 R /F11 796 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1589 0 obj -<< -/Type /Page -/Contents 1590 0 R -/Resources 1588 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1561 0 R -/Annots [ 1587 0 R ] ->> -% 1587 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [345.53 560.993 412.588 572.118] -/A << /S /GoTo /D (descdata) >> ->> -% 1591 0 obj -<< -/D [1589 0 R /XYZ 149.705 753.953 null] ->> -% 400 0 obj -<< -/D [1589 0 R /XYZ 150.705 716.092 null] ->> -% 1592 0 obj -<< -/D [1589 0 R /XYZ 150.705 356.98 null] ->> -% 1593 0 obj -<< -/D [1589 0 R /XYZ 150.705 313.144 null] ->> -% 1588 0 obj -<< -/Font << /F16 582 0 R /F30 810 0 R /F27 584 0 R /F8 585 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1596 0 obj -<< -/Type /Page -/Contents 1597 0 R -/Resources 1595 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1601 0 R -/Annots [ 1594 0 R ] ->> -% 1594 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [294.721 574.94 361.779 586.065] -/A << /S /GoTo /D (descdata) >> ->> -% 1598 0 obj -<< -/D [1596 0 R /XYZ 98.895 753.953 null] ->> -% 405 0 obj -<< -/D [1596 0 R /XYZ 99.895 716.092 null] ->> -% 1599 0 obj -<< -/D [1596 0 R /XYZ 99.895 370.928 null] ->> -% 1600 0 obj -<< -/D [1596 0 R /XYZ 99.895 339.047 null] ->> -% 1595 0 obj -<< -/Font << /F16 582 0 R /F30 810 0 R /F27 584 0 R /F8 585 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1604 0 obj -<< -/Type /Page -/Contents 1605 0 R -/Resources 1603 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1601 0 R -/Annots [ 1602 0 R ] ->> -% 1602 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [345.53 484.857 423.049 495.982] -/A << /S /GoTo /D (spdata) >> ->> -% 1606 0 obj -<< -/D [1604 0 R /XYZ 149.705 753.953 null] ->> -% 409 0 obj -<< -/D [1604 0 R /XYZ 150.705 716.092 null] ->> -% 1603 0 obj -<< -/Font << /F16 582 0 R /F30 810 0 R /F27 584 0 R /F8 585 0 R /F11 796 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1608 0 obj -<< -/Type /Page -/Contents 1609 0 R -/Resources 1607 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1601 0 R ->> -% 1610 0 obj -<< -/D [1608 0 R /XYZ 98.895 753.953 null] ->> -% 1611 0 obj -<< -/D [1608 0 R /XYZ 99.895 496.913 null] ->> -% 1612 0 obj -<< -/D [1608 0 R /XYZ 99.895 439.185 null] ->> -% 1613 0 obj -<< -/D [1608 0 R /XYZ 99.895 418.983 null] ->> -% 1607 0 obj -<< -/Font << /F27 584 0 R /F8 585 0 R /F30 810 0 R /F16 582 0 R /F11 796 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1618 0 obj -<< -/Type /Page -/Contents 1619 0 R -/Resources 1617 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1601 0 R -/Annots [ 1614 0 R 1615 0 R 1616 0 R ] ->> -% 1614 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [345.53 529.112 423.049 540.237] -/A << /S /GoTo /D (spdata) >> ->> -% 1615 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [345.53 461.366 412.588 472.491] -/A << /S /GoTo /D (descdata) >> ->> -% 1616 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [372.153 405.575 439.211 416.7] -/A << /S /GoTo /D (precdata) >> ->> -% 1620 0 obj -<< -/D [1618 0 R /XYZ 149.705 753.953 null] ->> -% 413 0 obj -<< -/D [1618 0 R /XYZ 150.705 716.092 null] ->> -% 1617 0 obj -<< -/Font << /F16 582 0 R /F8 585 0 R /F30 810 0 R /F27 584 0 R /F11 796 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1622 0 obj -<< -/Type /Page -/Contents 1623 0 R -/Resources 1621 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1601 0 R ->> -% 1624 0 obj -<< -/D [1622 0 R /XYZ 98.895 753.953 null] ->> -% 417 0 obj -<< -/D [1622 0 R /XYZ 99.895 716.092 null] ->> -% 1621 0 obj -<< -/Font << /F16 582 0 R /F30 810 0 R /F8 585 0 R /F11 796 0 R /F27 584 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1626 0 obj -<< -/Type /Page -/Contents 1627 0 R -/Resources 1625 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1601 0 R ->> -% 1628 0 obj -<< -/D [1626 0 R /XYZ 149.705 753.953 null] ->> -% 1629 0 obj -<< -/D [1626 0 R /XYZ 150.705 702.144 null] ->> -% 1630 0 obj -<< -/D [1626 0 R /XYZ 150.705 668.326 null] ->> -% 1631 0 obj -<< -/D [1626 0 R /XYZ 150.705 624.491 null] ->> -% 1632 0 obj -<< -/D [1626 0 R /XYZ 150.705 556.745 null] ->> -% 1633 0 obj -<< -/D [1626 0 R /XYZ 150.705 500.954 null] ->> -% 1634 0 obj -<< -/D [1626 0 R /XYZ 150.705 468.52 null] ->> -% 1635 0 obj -<< -/D [1626 0 R /XYZ 150.705 425.182 null] ->> -% 1636 0 obj -<< -/D [1626 0 R /XYZ 150.705 383.395 null] ->> -% 1637 0 obj -<< -/D [1626 0 R /XYZ 150.705 355.499 null] ->> -% 1625 0 obj -<< -/Font << /F16 582 0 R /F8 585 0 R /F11 796 0 R /F14 813 0 R /F7 811 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1639 0 obj -<< -/Type /Page -/Contents 1640 0 R -/Resources 1638 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1642 0 R ->> -% 1641 0 obj -<< -/D [1639 0 R /XYZ 98.895 753.953 null] ->> -% 421 0 obj -<< -/D [1639 0 R /XYZ 99.895 716.092 null] ->> -% 1638 0 obj -<< -/Font << /F16 582 0 R /F8 585 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1644 0 obj -<< -/Type /Page -/Contents 1645 0 R -/Resources 1643 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1642 0 R ->> -% 1646 0 obj -<< -/D [1644 0 R /XYZ 149.705 753.953 null] ->> -% 425 0 obj -<< -/D [1644 0 R /XYZ 150.705 716.092 null] ->> -% 1647 0 obj -<< -/D [1644 0 R /XYZ 150.705 235.436 null] ->> -% 1648 0 obj -<< -/D [1644 0 R /XYZ 150.705 213.573 null] ->> -% 1643 0 obj -<< -/Font << /F16 582 0 R /F30 810 0 R /F8 585 0 R /F27 584 0 R /F11 796 0 R /F14 813 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1650 0 obj -<< -/Type /Page -/Contents 1651 0 R -/Resources 1649 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1642 0 R ->> -% 1652 0 obj -<< -/D [1650 0 R /XYZ 98.895 753.953 null] ->> -% 429 0 obj -<< -/D [1650 0 R /XYZ 99.895 716.092 null] ->> -% 1653 0 obj -<< -/D [1650 0 R /XYZ 99.895 349.01 null] ->> -% 1654 0 obj -<< -/D [1650 0 R /XYZ 99.895 315.192 null] ->> -% 1649 0 obj -<< -/Font << /F16 582 0 R /F30 810 0 R /F8 585 0 R /F27 584 0 R /F14 813 0 R /F11 796 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1656 0 obj -<< -/Type /Page -/Contents 1657 0 R -/Resources 1655 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1642 0 R ->> -% 1658 0 obj -<< -/D [1656 0 R /XYZ 149.705 753.953 null] ->> -% 433 0 obj -<< -/D [1656 0 R /XYZ 150.705 716.092 null] ->> -% 1659 0 obj -<< -/D [1656 0 R /XYZ 150.705 442.659 null] ->> -% 1660 0 obj -<< -/D [1656 0 R /XYZ 150.705 396.886 null] ->> -% 1661 0 obj -<< -/D [1656 0 R /XYZ 150.705 365.005 null] ->> -% 1655 0 obj -<< -/Font << /F16 582 0 R /F30 810 0 R /F8 585 0 R /F27 584 0 R /F11 796 0 R /F14 813 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1663 0 obj -<< -/Type /Page -/Contents 1664 0 R -/Resources 1662 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1642 0 R ->> -% 1665 0 obj -<< -/D [1663 0 R /XYZ 98.895 753.953 null] ->> -% 437 0 obj -<< -/D [1663 0 R /XYZ 99.895 716.092 null] ->> -% 1662 0 obj -<< -/Font << /F16 582 0 R /F30 810 0 R /F8 585 0 R /F27 584 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1667 0 obj -<< -/Type /Page -/Contents 1668 0 R -/Resources 1666 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1642 0 R ->> -% 1669 0 obj -<< -/D [1667 0 R /XYZ 149.705 753.953 null] ->> -% 441 0 obj -<< -/D [1667 0 R /XYZ 150.705 716.092 null] ->> -% 1666 0 obj -<< -/Font << /F16 582 0 R /F30 810 0 R /F8 585 0 R /F11 796 0 R /F27 584 0 R /F14 813 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1671 0 obj -<< -/Type /Page -/Contents 1672 0 R -/Resources 1670 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1674 0 R ->> - -endstream -endobj -1678 0 obj +1679 0 obj << /Length 1511 >> @@ -21058,7 +21057,7 @@ ET endstream endobj -1682 0 obj +1683 0 obj << /Length 1370 >> @@ -21095,7 +21094,7 @@ ET endstream endobj -1686 0 obj +1687 0 obj << /Length 4543 >> @@ -21147,7 +21146,7 @@ ET endstream endobj -1690 0 obj +1691 0 obj << /Length 5157 >> @@ -21207,7 +21206,7 @@ ET endstream endobj -1696 0 obj +1697 0 obj << /Length 5196 >> @@ -21267,7 +21266,7 @@ ET endstream endobj -1702 0 obj +1703 0 obj << /Length 5171 >> @@ -21327,7 +21326,7 @@ ET endstream endobj -1709 0 obj +1710 0 obj << /Length 5288 >> @@ -21387,7 +21386,7 @@ ET endstream endobj -1715 0 obj +1716 0 obj << /Length 5259 >> @@ -21447,7 +21446,7 @@ ET endstream endobj -1721 0 obj +1722 0 obj << /Length 6258 >> @@ -21518,7 +21517,7 @@ ET endstream endobj -1729 0 obj +1730 0 obj << /Length 5357 >> @@ -21575,7 +21574,7 @@ ET endstream endobj -1734 0 obj +1735 0 obj << /Length 5375 >> @@ -21631,7 +21630,7 @@ ET endstream endobj -1741 0 obj +1742 0 obj << /Length 6381 >> @@ -21655,7 +21654,7 @@ ET endstream endobj -1748 0 obj +1749 0 obj << /Length 7207 >> @@ -21806,9 +21805,9 @@ ET endstream endobj -1778 0 obj +1779 0 obj << -/Length 3734 +/Length 3730 >> stream 0 g 0 G @@ -21821,46 +21820,46 @@ q []0 d 0 J 0.398 w 0 0 m 4.035 0 l S Q BT -/F16 11.9552 Tf 155.621 706.129 Td [(errpush)]TJ/F8 9.9626 Tf -55.726 -18.389 Td [(Pushes)-333(an)-334(error)-333(co)-28(de)-333(on)28(to)-334(the)-333(error)-333(stac)27(k)]TJ/F27 9.9626 Tf 1.377 -17.933 Td [(c)-138(a)-138(l)-139(l)]TJ/F8 9.9626 Tf 29.712 0 Td [(p)-120(s)-121(b)]TJ +/F16 11.9552 Tf 155.621 706.129 Td [(errpush)-469(|)-468(Pushes)-469(an)-469(error)-468(co)-31(de)-469(on)31(to)-468(the)-469(error)]TJ -25.091 -13.948 Td [(stac)31(k)]TJ/F27 9.9626 Tf -29.258 -24.367 Td [(c)-138(a)-138(l)-139(l)]TJ/F8 9.9626 Tf 29.712 0 Td [(p)-120(s)-121(b)]TJ ET q -1 0 0 1 150.181 670.006 cm +1 0 0 1 150.181 668.014 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 154.37 669.807 Td [(e)-121(r)-120(r)-120(p)-121(u)-120(s)-121(h)-226(\050)-244(e)-138(r)-138(r)]TJ +/F8 9.9626 Tf 154.37 667.814 Td [(e)-121(r)-120(r)-120(p)-121(u)-120(s)-121(h)-226(\050)-244(e)-138(r)-138(r)]TJ ET q -1 0 0 1 219.855 670.006 cm +1 0 0 1 219.855 668.014 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 224.221 669.807 Td [(c)-438(,)-825(r)]TJ +/F8 9.9626 Tf 224.221 667.814 Td [(c)-438(,)-825(r)]TJ ET q -1 0 0 1 249.141 670.006 cm +1 0 0 1 249.141 668.014 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 252.772 669.807 Td [(n)-64(a)-65(m)-64(e)-290(,)-923(i)]TJ +/F8 9.9626 Tf 252.772 667.814 Td [(n)-64(a)-65(m)-64(e)-290(,)-923(i)]TJ ET q -1 0 0 1 297.774 670.006 cm +1 0 0 1 297.774 668.014 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 302.378 669.807 Td [(e)-162(r)-162(r)-485(,)-913(a)]TJ +/F8 9.9626 Tf 302.378 667.814 Td [(e)-162(r)-162(r)-485(,)-913(a)]TJ ET q -1 0 0 1 341.632 670.006 cm +1 0 0 1 341.632 668.014 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 346.136 669.807 Td [(e)-152(r)-152(r)-258(\051)]TJ +/F8 9.9626 Tf 346.136 667.814 Td [(e)-152(r)-152(r)-258(\051)]TJ 0 g 0 G 0 g 0 G 0 g 0 G -/F27 9.9626 Tf -246.241 -27.896 Td [(T)32(yp)-32(e:)]TJ +/F27 9.9626 Tf -246.241 -17.933 Td [(T)32(yp)-32(e:)]TJ 0 g 0 G /F8 9.9626 Tf 33.797 0 Td [(Async)28(hronous.)]TJ 0 g 0 G @@ -21870,48 +21869,48 @@ BT 0 -19.925 Td [(err)]TJ ET q -1 0 0 1 115.271 602.26 cm +1 0 0 1 115.271 610.23 cm []0 d 0 J 0.398 w 0 0 m 3.437 0 l S Q BT -/F27 9.9626 Tf 118.708 602.061 Td [(c)]TJ +/F27 9.9626 Tf 118.708 610.031 Td [(c)]TJ 0 g 0 G -/F8 9.9626 Tf 10.073 0 Td [(the)-333(error)-334(co)-27(de)]TJ -3.979 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.379 -11.956 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf -29.611 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(in)]TJ/F8 9.9626 Tf 9.547 0 Td [(.)]TJ -43.033 -11.955 Td [(Sp)-28(eci\014ed)-333(as:)-445(an)-333(in)28(teger.)]TJ +/F8 9.9626 Tf 10.073 0 Td [(the)-333(error)-334(co)-27(de)]TJ -3.979 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.379 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf -29.611 -11.956 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(in)]TJ/F8 9.9626 Tf 9.547 0 Td [(.)]TJ -43.033 -11.955 Td [(Sp)-28(eci\014ed)-333(as:)-445(an)-333(in)28(teger.)]TJ 0 g 0 G /F27 9.9626 Tf -24.907 -19.925 Td [(r)]TJ ET q -1 0 0 1 105.301 534.514 cm +1 0 0 1 105.301 542.484 cm []0 d 0 J 0.398 w 0 0 m 3.437 0 l S Q BT -/F27 9.9626 Tf 108.738 534.315 Td [(name)]TJ +/F27 9.9626 Tf 108.738 542.285 Td [(name)]TJ 0 g 0 G /F8 9.9626 Tf 31.715 0 Td [(the)-333(soutine)-334(where)-333(the)-333(error)-334(has)-333(b)-28(een)-333(caugh)28(t.)]TJ -15.651 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.379 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf -29.611 -11.956 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(in)]TJ/F8 9.9626 Tf 9.547 0 Td [(.)]TJ -43.033 -11.955 Td [(Sp)-28(eci\014ed)-333(as:)-445(a)-333(string.)]TJ 0 g 0 G /F27 9.9626 Tf -24.907 -31.88 Td [(i)]TJ ET q -1 0 0 1 103.765 454.813 cm +1 0 0 1 103.765 462.783 cm []0 d 0 J 0.398 w 0 0 m 3.437 0 l S Q BT -/F27 9.9626 Tf 107.202 454.614 Td [(err)]TJ +/F27 9.9626 Tf 107.202 462.584 Td [(err)]TJ 0 g 0 G -/F8 9.9626 Tf 19.67 0 Td [(addional)-333(info)-333(for)-334(error)-333(co)-28(de)]TJ -2.07 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.379 -11.956 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(optional)]TJ/F8 9.9626 Tf -29.611 -11.955 Td [(Sp)-28(eci\014ed)-333(as:)-445(an)-333(in)28(teger)-333(arra)27(y)]TJ +/F8 9.9626 Tf 19.67 0 Td [(addional)-333(info)-333(for)-334(error)-333(co)-28(de)]TJ -2.07 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.379 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(optional)]TJ/F8 9.9626 Tf -29.611 -11.956 Td [(Sp)-28(eci\014ed)-333(as:)-445(an)-333(in)28(teger)-333(arra)27(y)]TJ 0 g 0 G /F27 9.9626 Tf -24.907 -31.88 Td [(a)]TJ ET q -1 0 0 1 106.152 387.067 cm +1 0 0 1 106.152 395.037 cm []0 d 0 J 0.398 w 0 0 m 3.437 0 l S Q BT -/F27 9.9626 Tf 109.589 386.868 Td [(err)]TJ +/F27 9.9626 Tf 109.589 394.838 Td [(err)]TJ 0 g 0 G -/F8 9.9626 Tf 19.669 0 Td [(addional)-333(info)-333(for)-334(error)-333(co)-28(de)]TJ -4.456 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.379 -11.956 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(optional)]TJ/F8 9.9626 Tf -29.611 -11.955 Td [(Sp)-28(eci\014ed)-333(as:)-445(a)-333(string.)]TJ +/F8 9.9626 Tf 19.669 0 Td [(addional)-333(info)-333(for)-334(error)-333(co)-28(de)]TJ -4.456 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.379 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(optional)]TJ/F8 9.9626 Tf -29.611 -11.956 Td [(Sp)-28(eci\014ed)-333(as:)-445(a)-333(string.)]TJ 0 g 0 G - 139.477 -260.564 Td [(129)]TJ + 139.477 -268.534 Td [(129)]TJ 0 g 0 G ET @@ -21921,342 +21920,350 @@ endobj << /Type /ObjStm /N 100 -/First 972 -/Length 8779 +/First 973 +/Length 8840 >> stream -1673 0 445 58 1670 115 1677 221 1679 339 449 398 1676 456 1681 562 1683 680 453 738 -1680 795 1685 901 1687 1019 457 1078 1684 1136 1689 1268 1691 1386 461 1444 1692 1501 1693 1559 -1688 1617 1695 1749 1697 1867 465 1926 1698 1984 1699 2043 1694 2102 1701 2234 1703 2352 469 2410 -1704 2467 1705 2525 1700 2583 1708 2715 1710 2833 473 2892 1711 2950 1712 3009 1707 3068 1714 3200 -1716 3318 477 3376 1717 3433 1718 3491 1713 3549 1720 3681 1722 3799 481 3858 1723 3916 1724 3974 -1726 4033 1719 4091 1728 4261 1730 4379 485 4437 1731 4494 1727 4551 1733 4683 1735 4801 489 4860 -1736 4918 1732 4976 1740 5108 1737 5256 1738 5402 1742 5549 493 5607 1739 5664 1747 5757 1749 5875 -1750 5934 1751 5993 1753 6052 1754 6111 1755 6170 1756 6229 1757 6288 1758 6346 1759 6405 1760 6464 -1761 6523 1762 6582 1763 6641 1764 6700 1765 6759 1766 6818 1767 6875 1768 6934 1769 6993 1770 7052 -1771 7111 1772 7170 1773 7229 1774 7288 1775 7347 1744 7405 1745 7464 1746 7523 1777 7631 1779 7749 -% 1673 0 obj +1672 0 1674 118 445 176 1671 233 1678 339 1680 457 449 516 1677 574 1682 680 1684 798 +453 856 1681 913 1686 1019 1688 1137 457 1196 1685 1254 1690 1386 1692 1504 461 1562 1693 1619 +1694 1677 1689 1735 1696 1867 1698 1985 465 2044 1699 2102 1700 2161 1695 2220 1702 2352 1704 2470 +469 2528 1705 2585 1706 2643 1701 2701 1709 2833 1711 2951 473 3010 1712 3068 1713 3127 1708 3186 +1715 3318 1717 3436 477 3494 1718 3551 1719 3609 1714 3667 1721 3799 1723 3917 481 3976 1724 4034 +1725 4092 1727 4151 1720 4209 1729 4379 1731 4497 485 4555 1732 4612 1728 4669 1734 4801 1736 4919 +489 4978 1737 5036 1733 5094 1741 5226 1738 5374 1739 5520 1743 5667 493 5725 1740 5782 1748 5875 +1750 5993 1751 6052 1752 6111 1754 6170 1755 6229 1756 6288 1757 6347 1758 6406 1759 6464 1760 6523 +1761 6582 1762 6641 1763 6700 1764 6759 1765 6818 1766 6877 1767 6936 1768 6993 1769 7052 1770 7111 +1771 7170 1772 7229 1773 7288 1774 7347 1775 7406 1776 7465 1745 7523 1746 7582 1747 7641 1778 7749 +% 1672 0 obj << -/D [1671 0 R /XYZ 98.895 753.953 null] +/Type /Page +/Contents 1673 0 R +/Resources 1671 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1676 0 R +>> +% 1674 0 obj +<< +/D [1672 0 R /XYZ 98.895 753.953 null] >> % 445 0 obj << -/D [1671 0 R /XYZ 99.895 716.092 null] +/D [1672 0 R /XYZ 99.895 716.092 null] >> -% 1670 0 obj +% 1671 0 obj << -/Font << /F16 582 0 R /F30 810 0 R /F8 585 0 R /F27 584 0 R >> +/Font << /F16 582 0 R /F30 811 0 R /F8 585 0 R /F27 584 0 R >> /ProcSet [ /PDF /Text ] >> -% 1677 0 obj +% 1678 0 obj << /Type /Page -/Contents 1678 0 R -/Resources 1676 0 R +/Contents 1679 0 R +/Resources 1677 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1674 0 R ->> -% 1679 0 obj -<< -/D [1677 0 R /XYZ 149.705 753.953 null] ->> -% 449 0 obj -<< -/D [1677 0 R /XYZ 150.705 716.092 null] ->> -% 1676 0 obj -<< -/Font << /F16 582 0 R /F30 810 0 R /F8 585 0 R /F27 584 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1681 0 obj -<< -/Type /Page -/Contents 1682 0 R -/Resources 1680 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1674 0 R ->> -% 1683 0 obj -<< -/D [1681 0 R /XYZ 98.895 753.953 null] ->> -% 453 0 obj -<< -/D [1681 0 R /XYZ 99.895 716.092 null] +/Parent 1676 0 R >> % 1680 0 obj << -/Font << /F16 582 0 R /F30 810 0 R /F8 585 0 R /F27 584 0 R >> +/D [1678 0 R /XYZ 149.705 753.953 null] +>> +% 449 0 obj +<< +/D [1678 0 R /XYZ 150.705 716.092 null] +>> +% 1677 0 obj +<< +/Font << /F16 582 0 R /F30 811 0 R /F8 585 0 R /F27 584 0 R >> /ProcSet [ /PDF /Text ] >> -% 1685 0 obj +% 1682 0 obj << /Type /Page -/Contents 1686 0 R -/Resources 1684 0 R +/Contents 1683 0 R +/Resources 1681 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1674 0 R ->> -% 1687 0 obj -<< -/D [1685 0 R /XYZ 149.705 753.953 null] ->> -% 457 0 obj -<< -/D [1685 0 R /XYZ 150.705 716.092 null] +/Parent 1676 0 R >> % 1684 0 obj << -/Font << /F16 582 0 R /F30 810 0 R /F8 585 0 R /F27 584 0 R /F11 796 0 R /F14 813 0 R >> +/D [1682 0 R /XYZ 98.895 753.953 null] +>> +% 453 0 obj +<< +/D [1682 0 R /XYZ 99.895 716.092 null] +>> +% 1681 0 obj +<< +/Font << /F16 582 0 R /F30 811 0 R /F8 585 0 R /F27 584 0 R >> /ProcSet [ /PDF /Text ] >> -% 1689 0 obj +% 1686 0 obj << /Type /Page -/Contents 1690 0 R -/Resources 1688 0 R +/Contents 1687 0 R +/Resources 1685 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1674 0 R ->> -% 1691 0 obj -<< -/D [1689 0 R /XYZ 98.895 753.953 null] ->> -% 461 0 obj -<< -/D [1689 0 R /XYZ 99.895 716.092 null] ->> -% 1692 0 obj -<< -/D [1689 0 R /XYZ 99.895 247.391 null] ->> -% 1693 0 obj -<< -/D [1689 0 R /XYZ 99.895 213.573 null] +/Parent 1676 0 R >> % 1688 0 obj << -/Font << /F16 582 0 R /F30 810 0 R /F8 585 0 R /F27 584 0 R /F14 813 0 R /F11 796 0 R >> +/D [1686 0 R /XYZ 149.705 753.953 null] +>> +% 457 0 obj +<< +/D [1686 0 R /XYZ 150.705 716.092 null] +>> +% 1685 0 obj +<< +/Font << /F16 582 0 R /F30 811 0 R /F8 585 0 R /F27 584 0 R /F11 797 0 R /F14 814 0 R >> /ProcSet [ /PDF /Text ] >> -% 1695 0 obj +% 1690 0 obj << /Type /Page -/Contents 1696 0 R -/Resources 1694 0 R +/Contents 1691 0 R +/Resources 1689 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1674 0 R +/Parent 1676 0 R >> -% 1697 0 obj +% 1692 0 obj << -/D [1695 0 R /XYZ 149.705 753.953 null] +/D [1690 0 R /XYZ 98.895 753.953 null] >> -% 465 0 obj +% 461 0 obj << -/D [1695 0 R /XYZ 150.705 716.092 null] +/D [1690 0 R /XYZ 99.895 716.092 null] >> -% 1698 0 obj +% 1693 0 obj << -/D [1695 0 R /XYZ 150.705 247.391 null] ->> -% 1699 0 obj -<< -/D [1695 0 R /XYZ 150.705 213.573 null] +/D [1690 0 R /XYZ 99.895 247.391 null] >> % 1694 0 obj << -/Font << /F16 582 0 R /F30 810 0 R /F8 585 0 R /F27 584 0 R /F14 813 0 R /F11 796 0 R >> +/D [1690 0 R /XYZ 99.895 213.573 null] +>> +% 1689 0 obj +<< +/Font << /F16 582 0 R /F30 811 0 R /F8 585 0 R /F27 584 0 R /F14 814 0 R /F11 797 0 R >> /ProcSet [ /PDF /Text ] >> -% 1701 0 obj +% 1696 0 obj << /Type /Page -/Contents 1702 0 R -/Resources 1700 0 R +/Contents 1697 0 R +/Resources 1695 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1706 0 R +/Parent 1676 0 R >> -% 1703 0 obj +% 1698 0 obj << -/D [1701 0 R /XYZ 98.895 753.953 null] +/D [1696 0 R /XYZ 149.705 753.953 null] >> -% 469 0 obj +% 465 0 obj << -/D [1701 0 R /XYZ 99.895 716.092 null] +/D [1696 0 R /XYZ 150.705 716.092 null] >> -% 1704 0 obj +% 1699 0 obj << -/D [1701 0 R /XYZ 99.895 247.391 null] ->> -% 1705 0 obj -<< -/D [1701 0 R /XYZ 99.895 213.573 null] +/D [1696 0 R /XYZ 150.705 247.391 null] >> % 1700 0 obj << -/Font << /F16 582 0 R /F30 810 0 R /F8 585 0 R /F27 584 0 R /F14 813 0 R /F11 796 0 R >> +/D [1696 0 R /XYZ 150.705 213.573 null] +>> +% 1695 0 obj +<< +/Font << /F16 582 0 R /F30 811 0 R /F8 585 0 R /F27 584 0 R /F14 814 0 R /F11 797 0 R >> /ProcSet [ /PDF /Text ] >> -% 1708 0 obj +% 1702 0 obj << /Type /Page -/Contents 1709 0 R -/Resources 1707 0 R +/Contents 1703 0 R +/Resources 1701 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1706 0 R +/Parent 1707 0 R >> -% 1710 0 obj +% 1704 0 obj << -/D [1708 0 R /XYZ 149.705 753.953 null] +/D [1702 0 R /XYZ 98.895 753.953 null] >> -% 473 0 obj +% 469 0 obj << -/D [1708 0 R /XYZ 150.705 716.092 null] +/D [1702 0 R /XYZ 99.895 716.092 null] +>> +% 1705 0 obj +<< +/D [1702 0 R /XYZ 99.895 247.391 null] +>> +% 1706 0 obj +<< +/D [1702 0 R /XYZ 99.895 213.573 null] +>> +% 1701 0 obj +<< +/Font << /F16 582 0 R /F30 811 0 R /F8 585 0 R /F27 584 0 R /F14 814 0 R /F11 797 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1709 0 obj +<< +/Type /Page +/Contents 1710 0 R +/Resources 1708 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1707 0 R >> % 1711 0 obj << -/D [1708 0 R /XYZ 150.705 235.436 null] +/D [1709 0 R /XYZ 149.705 753.953 null] +>> +% 473 0 obj +<< +/D [1709 0 R /XYZ 150.705 716.092 null] >> % 1712 0 obj << -/D [1708 0 R /XYZ 150.705 201.618 null] ->> -% 1707 0 obj -<< -/Font << /F16 582 0 R /F30 810 0 R /F8 585 0 R /F27 584 0 R /F14 813 0 R /F11 796 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1714 0 obj -<< -/Type /Page -/Contents 1715 0 R -/Resources 1713 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1706 0 R ->> -% 1716 0 obj -<< -/D [1714 0 R /XYZ 98.895 753.953 null] ->> -% 477 0 obj -<< -/D [1714 0 R /XYZ 99.895 716.092 null] ->> -% 1717 0 obj -<< -/D [1714 0 R /XYZ 99.895 235.436 null] ->> -% 1718 0 obj -<< -/D [1714 0 R /XYZ 99.895 201.618 null] +/D [1709 0 R /XYZ 150.705 235.436 null] >> % 1713 0 obj << -/Font << /F16 582 0 R /F30 810 0 R /F8 585 0 R /F27 584 0 R /F14 813 0 R /F11 796 0 R >> +/D [1709 0 R /XYZ 150.705 201.618 null] +>> +% 1708 0 obj +<< +/Font << /F16 582 0 R /F30 811 0 R /F8 585 0 R /F27 584 0 R /F14 814 0 R /F11 797 0 R >> /ProcSet [ /PDF /Text ] >> -% 1720 0 obj +% 1715 0 obj << /Type /Page -/Contents 1721 0 R -/Resources 1719 0 R +/Contents 1716 0 R +/Resources 1714 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1706 0 R +/Parent 1707 0 R >> -% 1722 0 obj +% 1717 0 obj << -/D [1720 0 R /XYZ 149.705 753.953 null] +/D [1715 0 R /XYZ 98.895 753.953 null] >> -% 481 0 obj +% 477 0 obj << -/D [1720 0 R /XYZ 150.705 716.092 null] +/D [1715 0 R /XYZ 99.895 716.092 null] >> -% 1723 0 obj +% 1718 0 obj << -/D [1720 0 R /XYZ 150.705 272.94 null] ->> -% 1724 0 obj -<< -/D [1720 0 R /XYZ 150.705 239.973 null] ->> -% 1726 0 obj -<< -/D [1720 0 R /XYZ 150.705 152.13 null] +/D [1715 0 R /XYZ 99.895 235.436 null] >> % 1719 0 obj << -/Font << /F16 582 0 R /F30 810 0 R /F8 585 0 R /F27 584 0 R /F14 813 0 R /F11 796 0 R /F10 812 0 R /F1 1725 0 R /F7 811 0 R >> +/D [1715 0 R /XYZ 99.895 201.618 null] +>> +% 1714 0 obj +<< +/Font << /F16 582 0 R /F30 811 0 R /F8 585 0 R /F27 584 0 R /F14 814 0 R /F11 797 0 R >> /ProcSet [ /PDF /Text ] >> -% 1728 0 obj +% 1721 0 obj << /Type /Page -/Contents 1729 0 R -/Resources 1727 0 R +/Contents 1722 0 R +/Resources 1720 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1706 0 R +/Parent 1707 0 R >> -% 1730 0 obj +% 1723 0 obj << -/D [1728 0 R /XYZ 98.895 753.953 null] +/D [1721 0 R /XYZ 149.705 753.953 null] >> -% 485 0 obj +% 481 0 obj << -/D [1728 0 R /XYZ 99.895 716.092 null] +/D [1721 0 R /XYZ 150.705 716.092 null] >> -% 1731 0 obj +% 1724 0 obj << -/D [1728 0 R /XYZ 99.895 223.48 null] +/D [1721 0 R /XYZ 150.705 272.94 null] +>> +% 1725 0 obj +<< +/D [1721 0 R /XYZ 150.705 239.973 null] >> % 1727 0 obj << -/Font << /F16 582 0 R /F30 810 0 R /F8 585 0 R /F27 584 0 R /F11 796 0 R /F14 813 0 R >> +/D [1721 0 R /XYZ 150.705 152.13 null] +>> +% 1720 0 obj +<< +/Font << /F16 582 0 R /F30 811 0 R /F8 585 0 R /F27 584 0 R /F14 814 0 R /F11 797 0 R /F10 813 0 R /F1 1726 0 R /F7 812 0 R >> /ProcSet [ /PDF /Text ] >> -% 1733 0 obj +% 1729 0 obj << /Type /Page -/Contents 1734 0 R -/Resources 1732 0 R +/Contents 1730 0 R +/Resources 1728 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1706 0 R +/Parent 1707 0 R >> -% 1735 0 obj +% 1731 0 obj << -/D [1733 0 R /XYZ 149.705 753.953 null] +/D [1729 0 R /XYZ 98.895 753.953 null] >> -% 489 0 obj +% 485 0 obj << -/D [1733 0 R /XYZ 150.705 716.092 null] ->> -% 1736 0 obj -<< -/D [1733 0 R /XYZ 150.705 223.48 null] +/D [1729 0 R /XYZ 99.895 716.092 null] >> % 1732 0 obj << -/Font << /F16 582 0 R /F30 810 0 R /F8 585 0 R /F27 584 0 R /F11 796 0 R /F14 813 0 R >> +/D [1729 0 R /XYZ 99.895 223.48 null] +>> +% 1728 0 obj +<< +/Font << /F16 582 0 R /F30 811 0 R /F8 585 0 R /F27 584 0 R /F11 797 0 R /F14 814 0 R >> /ProcSet [ /PDF /Text ] >> -% 1740 0 obj +% 1734 0 obj << /Type /Page -/Contents 1741 0 R -/Resources 1739 0 R +/Contents 1735 0 R +/Resources 1733 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1743 0 R -/Annots [ 1737 0 R 1738 0 R ] +/Parent 1707 0 R +>> +% 1736 0 obj +<< +/D [1734 0 R /XYZ 149.705 753.953 null] +>> +% 489 0 obj +<< +/D [1734 0 R /XYZ 150.705 716.092 null] >> % 1737 0 obj << +/D [1734 0 R /XYZ 150.705 223.48 null] +>> +% 1733 0 obj +<< +/Font << /F16 582 0 R /F30 811 0 R /F8 585 0 R /F27 584 0 R /F11 797 0 R /F14 814 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1741 0 obj +<< +/Type /Page +/Contents 1742 0 R +/Resources 1740 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1744 0 R +/Annots [ 1738 0 R 1739 0 R ] +>> +% 1738 0 obj +<< /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] /Rect [145.477 501.77 152.451 512.895] /A << /S /GoTo /D (figure.9) >> >> -% 1738 0 obj +% 1739 0 obj << /Type /Annot /Subtype /Link @@ -22264,162 +22271,158 @@ stream /Rect [146.734 346.63 158.689 357.478] /A << /S /GoTo /D (figure.10) >> >> -% 1742 0 obj +% 1743 0 obj << -/D [1740 0 R /XYZ 98.895 753.953 null] +/D [1741 0 R /XYZ 98.895 753.953 null] >> % 493 0 obj << -/D [1740 0 R /XYZ 99.895 716.092 null] +/D [1741 0 R /XYZ 99.895 716.092 null] >> -% 1739 0 obj +% 1740 0 obj << -/Font << /F16 582 0 R /F8 585 0 R /F30 810 0 R >> +/Font << /F16 582 0 R /F8 585 0 R /F30 811 0 R >> /ProcSet [ /PDF /Text ] >> -% 1747 0 obj +% 1748 0 obj << /Type /Page -/Contents 1748 0 R -/Resources 1746 0 R +/Contents 1749 0 R +/Resources 1747 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1743 0 R ->> -% 1749 0 obj -<< -/D [1747 0 R /XYZ 149.705 753.953 null] +/Parent 1744 0 R >> % 1750 0 obj << -/D [1747 0 R /XYZ 159.073 687.737 null] +/D [1748 0 R /XYZ 149.705 753.953 null] >> % 1751 0 obj << -/D [1747 0 R /XYZ 159.073 691.025 null] +/D [1748 0 R /XYZ 159.073 687.737 null] >> -% 1753 0 obj +% 1752 0 obj << -/D [1747 0 R /XYZ 159.073 680.066 null] +/D [1748 0 R /XYZ 159.073 691.025 null] >> % 1754 0 obj << -/D [1747 0 R /XYZ 159.073 669.107 null] +/D [1748 0 R /XYZ 159.073 680.066 null] >> % 1755 0 obj << -/D [1747 0 R /XYZ 159.073 658.148 null] +/D [1748 0 R /XYZ 159.073 669.107 null] >> % 1756 0 obj << -/D [1747 0 R /XYZ 159.073 647.189 null] +/D [1748 0 R /XYZ 159.073 658.148 null] >> % 1757 0 obj << -/D [1747 0 R /XYZ 159.073 636.23 null] +/D [1748 0 R /XYZ 159.073 647.189 null] >> % 1758 0 obj << -/D [1747 0 R /XYZ 159.073 625.271 null] +/D [1748 0 R /XYZ 159.073 636.23 null] >> % 1759 0 obj << -/D [1747 0 R /XYZ 159.073 614.312 null] +/D [1748 0 R /XYZ 159.073 625.271 null] >> % 1760 0 obj << -/D [1747 0 R /XYZ 159.073 603.353 null] +/D [1748 0 R /XYZ 159.073 614.312 null] >> % 1761 0 obj << -/D [1747 0 R /XYZ 159.073 592.394 null] +/D [1748 0 R /XYZ 159.073 603.353 null] >> % 1762 0 obj << -/D [1747 0 R /XYZ 159.073 581.436 null] +/D [1748 0 R /XYZ 159.073 592.394 null] >> % 1763 0 obj << -/D [1747 0 R /XYZ 159.073 570.477 null] +/D [1748 0 R /XYZ 159.073 581.436 null] >> % 1764 0 obj << -/D [1747 0 R /XYZ 159.073 559.518 null] +/D [1748 0 R /XYZ 159.073 570.477 null] >> % 1765 0 obj << -/D [1747 0 R /XYZ 159.073 548.559 null] +/D [1748 0 R /XYZ 159.073 559.518 null] >> % 1766 0 obj << -/D [1747 0 R /XYZ 159.073 537.6 null] +/D [1748 0 R /XYZ 159.073 548.559 null] >> % 1767 0 obj << -/D [1747 0 R /XYZ 159.073 526.641 null] +/D [1748 0 R /XYZ 159.073 537.6 null] >> % 1768 0 obj << -/D [1747 0 R /XYZ 159.073 515.682 null] +/D [1748 0 R /XYZ 159.073 526.641 null] >> % 1769 0 obj << -/D [1747 0 R /XYZ 159.073 504.723 null] +/D [1748 0 R /XYZ 159.073 515.682 null] >> % 1770 0 obj << -/D [1747 0 R /XYZ 159.073 493.764 null] +/D [1748 0 R /XYZ 159.073 504.723 null] >> % 1771 0 obj << -/D [1747 0 R /XYZ 159.073 482.805 null] +/D [1748 0 R /XYZ 159.073 493.764 null] >> % 1772 0 obj << -/D [1747 0 R /XYZ 159.073 471.847 null] +/D [1748 0 R /XYZ 159.073 482.805 null] >> % 1773 0 obj << -/D [1747 0 R /XYZ 159.073 460.888 null] +/D [1748 0 R /XYZ 159.073 471.847 null] >> % 1774 0 obj << -/D [1747 0 R /XYZ 159.073 449.929 null] +/D [1748 0 R /XYZ 159.073 460.888 null] >> % 1775 0 obj << -/D [1747 0 R /XYZ 159.073 438.97 null] +/D [1748 0 R /XYZ 159.073 449.929 null] >> -% 1744 0 obj +% 1776 0 obj << -/D [1747 0 R /XYZ 194.261 394.492 null] +/D [1748 0 R /XYZ 159.073 438.97 null] >> % 1745 0 obj << -/D [1747 0 R /XYZ 200.884 149.223 null] +/D [1748 0 R /XYZ 194.261 394.492 null] >> % 1746 0 obj << -/Font << /F53 1752 0 R /F46 1300 0 R /F8 585 0 R /F30 810 0 R >> +/D [1748 0 R /XYZ 200.884 149.223 null] +>> +% 1747 0 obj +<< +/Font << /F53 1753 0 R /F46 1301 0 R /F8 585 0 R /F30 811 0 R >> /ProcSet [ /PDF /Text ] >> -% 1777 0 obj +% 1778 0 obj << /Type /Page -/Contents 1778 0 R -/Resources 1776 0 R +/Contents 1779 0 R +/Resources 1777 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1743 0 R ->> -% 1779 0 obj -<< -/D [1777 0 R /XYZ 98.895 753.953 null] +/Parent 1744 0 R >> endstream endobj -1785 0 obj +1786 0 obj << -/Length 1412 +/Length 1408 >> stream 0 g 0 G @@ -22432,18 +22435,18 @@ q []0 d 0 J 0.398 w 0 0 m 4.035 0 l S Q BT -/F16 11.9552 Tf 206.431 706.129 Td [(error)]TJ/F8 9.9626 Tf -55.726 -18.389 Td [(Prin)28(ts)-333(the)-334(error)-333(stac)28(k)-334(con)28(ten)28(t)-333(and)-334(ab)-27(orts)-334(execution)]TJ/F27 9.9626 Tf 1.377 -17.933 Td [(c)-138(a)-138(l)-139(l)]TJ/F8 9.9626 Tf 29.921 0 Td [(p)-141(s)-142(b)]TJ +/F16 11.9552 Tf 206.431 706.129 Td [(error)-304(|)-304(Prin)31(ts)-304(the)-304(error)-304(stac)32(k)-304(con)31(ten)31(t)-304(and)-304(ab)-31(orts)]TJ -25.091 -13.948 Td [(execution)]TJ/F27 9.9626 Tf -29.258 -24.367 Td [(c)-138(a)-138(l)-139(l)]TJ/F8 9.9626 Tf 29.921 0 Td [(p)-141(s)-142(b)]TJ ET q -1 0 0 1 201.829 670.006 cm +1 0 0 1 201.829 668.014 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 206.228 669.807 Td [(e)-142(r)-141(r)-141(o)-142(r)-247(\050)-245(i)-140(c)-139(o)-140(n)-139(t)-140(x)-140(t)-245(\051)]TJ +/F8 9.9626 Tf 206.228 667.814 Td [(e)-142(r)-141(r)-141(o)-142(r)-247(\050)-245(i)-140(c)-139(o)-140(n)-139(t)-140(x)-140(t)-245(\051)]TJ 0 g 0 G 0 g 0 G 0 g 0 G -/F27 9.9626 Tf -55.523 -27.896 Td [(T)32(yp)-32(e:)]TJ +/F27 9.9626 Tf -55.523 -17.933 Td [(T)32(yp)-32(e:)]TJ 0 g 0 G /F8 9.9626 Tf 33.797 0 Td [(Async)28(hronous.)]TJ 0 g 0 G @@ -22452,17 +22455,17 @@ BT 0 g 0 G 0 -19.925 Td [(icon)32(txt)]TJ 0 g 0 G -/F8 9.9626 Tf 39.989 0 Td [(the)-333(comm)27(unication)-333(con)28(text.)]TJ -15.082 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.378 0 Td [(global)]TJ/F8 9.9626 Tf -32.378 -11.956 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(optional)]TJ/F8 9.9626 Tf -29.611 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.485 0 Td [(in)]TJ/F8 9.9626 Tf 9.548 0 Td [(.)]TJ -43.033 -11.955 Td [(Sp)-28(eci\014ed)-333(as:)-444(an)-334(in)28(teger.)]TJ +/F8 9.9626 Tf 39.989 0 Td [(the)-333(comm)27(unication)-333(con)28(text.)]TJ -15.082 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.378 0 Td [(global)]TJ/F8 9.9626 Tf -32.378 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(optional)]TJ/F8 9.9626 Tf -29.611 -11.956 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.485 0 Td [(in)]TJ/F8 9.9626 Tf 9.548 0 Td [(.)]TJ -43.033 -11.955 Td [(Sp)-28(eci\014ed)-333(as:)-444(an)-334(in)28(teger.)]TJ 0 g 0 G - 139.476 -463.802 Td [(130)]TJ + 139.476 -471.772 Td [(130)]TJ 0 g 0 G ET endstream endobj -1791 0 obj +1792 0 obj << -/Length 1641 +/Length 1645 >> stream 0 g 0 G @@ -22482,25 +22485,25 @@ q []0 d 0 J 0.398 w 0 0 m 4.035 0 l S Q BT -/F16 11.9552 Tf 177.135 706.129 Td [(errv)31(erb)-31(osit)31(y)]TJ/F8 9.9626 Tf -77.24 -18.389 Td [(Sets)-333(the)-334(v)28(erb)-28(osit)28(y)-333(of)-334(error)-333(messages)]TJ/F27 9.9626 Tf 1.377 -17.933 Td [(c)-138(a)-138(l)-139(l)]TJ/F8 9.9626 Tf 30.082 0 Td [(p)-158(s)-157(b)]TJ +/F16 11.9552 Tf 177.135 706.129 Td [(errv)31(erb)-31(osit)31(y)-250(|)-250(Sets)-250(the)-250(v)31(erb)-31(osit)31(y)-250(of)-250(error)-250(mes-)]TJ -46.605 -13.948 Td [(sages)]TJ/F27 9.9626 Tf -29.258 -24.367 Td [(c)-138(a)-138(l)-139(l)]TJ/F8 9.9626 Tf 30.082 0 Td [(p)-158(s)-157(b)]TJ ET q -1 0 0 1 151.663 670.006 cm +1 0 0 1 151.663 668.014 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 156.223 669.807 Td [(s)-158(e)-157(t)]TJ +/F8 9.9626 Tf 156.223 667.814 Td [(s)-158(e)-157(t)]TJ ET q -1 0 0 1 173.764 670.006 cm +1 0 0 1 173.764 668.014 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 178.324 669.807 Td [(e)-158(r)-157(r)-158(v)-158(e)-157(r)-158(b)-157(o)-158(s)-158(i)-157(t)-158(y)-263(\050)-142(v)-142(\051)]TJ +/F8 9.9626 Tf 178.324 667.814 Td [(e)-158(r)-157(r)-158(v)-158(e)-157(r)-158(b)-157(o)-158(s)-158(i)-157(t)-158(y)-263(\050)-142(v)-142(\051)]TJ 0 g 0 G 0 g 0 G 0 g 0 G -/F27 9.9626 Tf -78.429 -27.896 Td [(T)32(yp)-32(e:)]TJ +/F27 9.9626 Tf -78.429 -17.933 Td [(T)32(yp)-32(e:)]TJ 0 g 0 G /F8 9.9626 Tf 33.797 0 Td [(Async)28(hronous.)]TJ 0 g 0 G @@ -22509,17 +22512,17 @@ BT 0 g 0 G 0 -19.925 Td [(v)]TJ 0 g 0 G -/F8 9.9626 Tf 11.028 0 Td [(the)-333(v)27(erb)-27(osit)27(y)-333(lev)28(el)]TJ 13.879 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(global)]TJ/F8 9.9626 Tf -32.379 -11.956 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf -29.611 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(in)]TJ/F8 9.9626 Tf 9.547 0 Td [(.)]TJ -43.033 -11.955 Td [(Sp)-28(eci\014ed)-333(as:)-445(an)-333(in)28(teger.)]TJ +/F8 9.9626 Tf 11.028 0 Td [(the)-333(v)27(erb)-27(osit)27(y)-333(lev)28(el)]TJ 13.879 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(global)]TJ/F8 9.9626 Tf -32.379 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf -29.611 -11.956 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(in)]TJ/F8 9.9626 Tf 9.547 0 Td [(.)]TJ -43.033 -11.955 Td [(Sp)-28(eci\014ed)-333(as:)-445(an)-333(in)28(teger.)]TJ 0 g 0 G - 139.477 -463.802 Td [(131)]TJ + 139.477 -471.772 Td [(131)]TJ 0 g 0 G ET endstream endobj -1797 0 obj +1798 0 obj << -/Length 2114 +/Length 2111 >> stream 0 g 0 G @@ -22539,32 +22542,32 @@ q []0 d 0 J 0.398 w 0 0 m 4.035 0 l S Q BT -/F16 11.9552 Tf 227.945 706.129 Td [(erraction)]TJ/F8 9.9626 Tf -77.24 -18.389 Td [(Set)-333(the)-334(t)28(yp)-28(e)-333(of)-333(action)-334(to)-333(b)-28(e)-333(tak)28(en)-334(up)-27(on)-334(error)-333(condition)]TJ/F27 9.9626 Tf 1.377 -17.933 Td [(c)-138(a)-138(l)-139(l)]TJ/F8 9.9626 Tf 30.09 0 Td [(p)-158(s)-159(b)]TJ +/F16 11.9552 Tf 227.945 706.129 Td [(erraction)-298(|)-298(Set)-298(the)-298(t)32(yp)-32(e)-297(of)-298(action)-298(to)-298(b)-31(e)-298(tak)31(en)]TJ -46.605 -13.948 Td [(up)-31(on)-375(error)-375(condition)]TJ/F27 9.9626 Tf -29.258 -24.367 Td [(c)-138(a)-138(l)-139(l)]TJ/F8 9.9626 Tf 30.09 0 Td [(p)-158(s)-159(b)]TJ ET q -1 0 0 1 202.505 670.006 cm +1 0 0 1 202.505 668.014 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 207.072 669.807 Td [(s)-159(e)-158(t)]TJ +/F8 9.9626 Tf 207.072 667.814 Td [(s)-159(e)-158(t)]TJ ET q -1 0 0 1 224.638 670.006 cm +1 0 0 1 224.638 668.014 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 229.206 669.807 Td [(e)-158(r)-159(r)-158(a)-159(c)-158(t)-159(i)-158(o)-159(n)-264(\050)-265(e)-160(r)-160(r)]TJ +/F8 9.9626 Tf 229.206 667.814 Td [(e)-158(r)-159(r)-158(a)-159(c)-158(t)-159(i)-158(o)-159(n)-264(\050)-265(e)-160(r)-160(r)]TJ ET q -1 0 0 1 307.391 670.006 cm +1 0 0 1 307.391 668.014 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 311.973 669.807 Td [(a)-160(c)-160(t)-265(\051)]TJ +/F8 9.9626 Tf 311.973 667.814 Td [(a)-160(c)-160(t)-265(\051)]TJ 0 g 0 G 0 g 0 G 0 g 0 G -/F27 9.9626 Tf -161.268 -27.896 Td [(T)32(yp)-32(e:)]TJ +/F27 9.9626 Tf -161.268 -17.933 Td [(T)32(yp)-32(e:)]TJ 0 g 0 G /F8 9.9626 Tf 33.797 0 Td [(Async)28(hronous.)]TJ 0 g 0 G @@ -22574,21 +22577,21 @@ BT 0 -19.925 Td [(err)]TJ ET q -1 0 0 1 166.08 602.26 cm +1 0 0 1 166.08 610.23 cm []0 d 0 J 0.398 w 0 0 m 3.437 0 l S Q BT -/F27 9.9626 Tf 169.517 602.061 Td [(act)]TJ +/F27 9.9626 Tf 169.517 610.031 Td [(act)]TJ 0 g 0 G -/F8 9.9626 Tf 20.098 0 Td [(the)-333(t)27(yp)-27(e)-334(of)-333(action.)]TJ -14.004 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(global)]TJ/F8 9.9626 Tf -32.379 -11.956 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.612 0 Td [(required)]TJ/F8 9.9626 Tf -29.612 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(in)]TJ/F8 9.9626 Tf 9.547 0 Td [(.)]TJ -43.033 -11.955 Td [(Sp)-28(eci\014ed)-333(as:)-445(an)-333(in)28(teger.)-445(P)28(ossible)-333(v)55(alu)1(e)-1(s:)]TJ/F30 9.9626 Tf 180.269 0 Td [(psb_act_ret)]TJ/F8 9.9626 Tf 57.534 0 Td [(,)]TJ/F30 9.9626 Tf 6.088 0 Td [(psb_act_abort)]TJ/F8 9.9626 Tf 67.995 0 Td [(.)]TJ +/F8 9.9626 Tf 20.098 0 Td [(the)-333(t)27(yp)-27(e)-334(of)-333(action.)]TJ -14.004 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(global)]TJ/F8 9.9626 Tf -32.379 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.612 0 Td [(required)]TJ/F8 9.9626 Tf -29.612 -11.956 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(in)]TJ/F8 9.9626 Tf 9.547 0 Td [(.)]TJ -43.033 -11.955 Td [(Sp)-28(eci\014ed)-333(as:)-445(an)-333(in)28(teger.)-445(P)28(ossible)-333(v)55(alu)1(e)-1(s:)]TJ/F30 9.9626 Tf 180.269 0 Td [(psb_act_ret)]TJ/F8 9.9626 Tf 57.534 0 Td [(,)]TJ/F30 9.9626 Tf 6.088 0 Td [(psb_act_abort)]TJ/F8 9.9626 Tf 67.995 0 Td [(.)]TJ 0 g 0 G - -172.409 -463.802 Td [(132)]TJ + -172.409 -471.772 Td [(132)]TJ 0 g 0 G ET endstream endobj -1803 0 obj +1804 0 obj << /Length 537 >> @@ -22604,7 +22607,7 @@ ET endstream endobj -1809 0 obj +1810 0 obj << /Length 4784 >> @@ -22688,7 +22691,7 @@ ET endstream endobj -1816 0 obj +1817 0 obj << /Length 5264 >> @@ -22776,7 +22779,7 @@ ET endstream endobj -1823 0 obj +1824 0 obj << /Length 3666 >> @@ -22866,7 +22869,7 @@ ET endstream endobj -1829 0 obj +1830 0 obj << /Length 3717 >> @@ -22938,7 +22941,7 @@ ET endstream endobj -1836 0 obj +1837 0 obj << /Length 4197 >> @@ -23032,7 +23035,7 @@ ET endstream endobj -1842 0 obj +1843 0 obj << /Length 3393 >> @@ -23104,7 +23107,7 @@ ET endstream endobj -1849 0 obj +1850 0 obj << /Length 1215 >> @@ -23128,7 +23131,7 @@ ET endstream endobj -1855 0 obj +1856 0 obj << /Length 5089 >> @@ -23216,7 +23219,7 @@ ET endstream endobj -1864 0 obj +1865 0 obj << /Length 7738 >> @@ -23434,7 +23437,7 @@ ET endstream endobj -1868 0 obj +1869 0 obj << /Length 1094 >> @@ -23453,7 +23456,7 @@ ET endstream endobj -1876 0 obj +1877 0 obj << /Length 5862 >> @@ -23603,7 +23606,7 @@ ET endstream endobj -1881 0 obj +1882 0 obj << /Length 2992 >> @@ -23659,159 +23662,163 @@ ET endstream endobj -1782 0 obj +1783 0 obj << /Type /ObjStm /N 100 -/First 967 -/Length 10032 +/First 968 +/Length 10034 >> stream -497 0 1780 57 1781 115 1776 173 1784 266 1786 384 501 443 1787 501 1788 560 1783 619 -1790 712 1792 830 505 888 1793 945 1794 1003 1789 1061 1796 1154 1798 1272 509 1331 1799 1389 -1800 1448 1795 1507 1802 1613 1804 1731 513 1789 1801 1846 1808 1939 1806 2078 1810 2222 517 2281 -1811 2339 1812 2398 1807 2457 1815 2563 1813 2702 1817 2846 521 2904 1818 2961 1819 3019 1814 3077 -1822 3183 1820 3322 1824 3466 525 3525 1825 3583 1826 3642 1821 3701 1828 3807 1830 3925 529 3983 -1831 4040 1832 4098 1827 4156 1835 4262 1833 4401 1837 4544 533 4603 1838 4661 1839 4720 1834 4779 -1841 4885 1843 5003 537 5061 1844 5118 1845 5176 1840 5234 1848 5340 1850 5458 541 5517 1847 5575 -1854 5681 1851 5829 1852 5976 1856 6126 545 6184 1857 6241 1853 6299 1863 6456 1858 6622 1859 6765 -1860 6909 1861 7056 1865 7203 549 7262 1862 7320 1867 7426 1869 7544 1866 7602 1875 7695 1870 7861 -1871 8007 1872 8150 1873 8297 1877 8441 553 8500 1874 8558 1880 8664 1878 8803 1882 8950 557 9008 -% 497 0 obj -<< -/D [1777 0 R /XYZ 99.895 716.092 null] ->> +1780 0 497 58 1781 115 1782 173 1777 231 1785 324 1787 442 501 501 1788 559 1789 618 +1784 677 1791 770 1793 888 505 946 1794 1003 1795 1061 1790 1119 1797 1212 1799 1330 509 1389 +1800 1447 1801 1506 1796 1565 1803 1671 1805 1789 513 1847 1802 1904 1809 1997 1807 2136 1811 2280 +517 2339 1812 2397 1813 2456 1808 2515 1816 2621 1814 2760 1818 2904 521 2962 1819 3019 1820 3077 +1815 3135 1823 3241 1821 3380 1825 3524 525 3583 1826 3641 1827 3700 1822 3759 1829 3865 1831 3983 +529 4041 1832 4098 1833 4156 1828 4214 1836 4320 1834 4459 1838 4602 533 4661 1839 4719 1840 4778 +1835 4837 1842 4943 1844 5061 537 5119 1845 5176 1846 5234 1841 5292 1849 5398 1851 5516 541 5575 +1848 5633 1855 5739 1852 5887 1853 6034 1857 6184 545 6242 1858 6299 1854 6357 1864 6514 1859 6680 +1860 6823 1861 6967 1862 7114 1866 7261 549 7320 1863 7378 1868 7484 1870 7602 1867 7660 1876 7753 +1871 7919 1872 8065 1873 8208 1874 8355 1878 8499 553 8558 1875 8616 1881 8722 1879 8861 1883 9008 % 1780 0 obj << -/D [1777 0 R /XYZ 99.895 681.762 null] +/D [1778 0 R /XYZ 98.895 753.953 null] +>> +% 497 0 obj +<< +/D [1778 0 R /XYZ 99.895 716.092 null] >> % 1781 0 obj << -/D [1777 0 R /XYZ 99.895 681.762 null] +/D [1778 0 R /XYZ 99.895 679.769 null] >> -% 1776 0 obj +% 1782 0 obj << -/Font << /F16 582 0 R /F8 585 0 R /F27 584 0 R >> +/D [1778 0 R /XYZ 99.895 679.769 null] +>> +% 1777 0 obj +<< +/Font << /F16 582 0 R /F27 584 0 R /F8 585 0 R >> /ProcSet [ /PDF /Text ] >> -% 1784 0 obj +% 1785 0 obj << /Type /Page -/Contents 1785 0 R -/Resources 1783 0 R +/Contents 1786 0 R +/Resources 1784 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1743 0 R ->> -% 1786 0 obj -<< -/D [1784 0 R /XYZ 149.705 753.953 null] ->> -% 501 0 obj -<< -/D [1784 0 R /XYZ 150.705 716.092 null] +/Parent 1744 0 R >> % 1787 0 obj << -/D [1784 0 R /XYZ 150.705 681.762 null] +/D [1785 0 R /XYZ 149.705 753.953 null] +>> +% 501 0 obj +<< +/D [1785 0 R /XYZ 150.705 716.092 null] >> % 1788 0 obj << -/D [1784 0 R /XYZ 150.705 681.762 null] ->> -% 1783 0 obj -<< -/Font << /F16 582 0 R /F8 585 0 R /F27 584 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1790 0 obj -<< -/Type /Page -/Contents 1791 0 R -/Resources 1789 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1743 0 R ->> -% 1792 0 obj -<< -/D [1790 0 R /XYZ 98.895 753.953 null] ->> -% 505 0 obj -<< -/D [1790 0 R /XYZ 99.895 716.092 null] ->> -% 1793 0 obj -<< -/D [1790 0 R /XYZ 99.895 679.825 null] ->> -% 1794 0 obj -<< -/D [1790 0 R /XYZ 99.895 681.762 null] +/D [1785 0 R /XYZ 150.705 679.769 null] >> % 1789 0 obj << -/Font << /F16 582 0 R /F8 585 0 R /F27 584 0 R >> +/D [1785 0 R /XYZ 150.705 679.769 null] +>> +% 1784 0 obj +<< +/Font << /F16 582 0 R /F27 584 0 R /F8 585 0 R >> /ProcSet [ /PDF /Text ] >> -% 1796 0 obj +% 1791 0 obj << /Type /Page -/Contents 1797 0 R -/Resources 1795 0 R +/Contents 1792 0 R +/Resources 1790 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1743 0 R +/Parent 1744 0 R >> -% 1798 0 obj +% 1793 0 obj << -/D [1796 0 R /XYZ 149.705 753.953 null] +/D [1791 0 R /XYZ 98.895 753.953 null] >> -% 509 0 obj +% 505 0 obj << -/D [1796 0 R /XYZ 150.705 716.092 null] +/D [1791 0 R /XYZ 99.895 716.092 null] >> -% 1799 0 obj +% 1794 0 obj << -/D [1796 0 R /XYZ 150.705 679.825 null] ->> -% 1800 0 obj -<< -/D [1796 0 R /XYZ 150.705 681.762 null] +/D [1791 0 R /XYZ 99.895 677.445 null] >> % 1795 0 obj << -/Font << /F16 582 0 R /F8 585 0 R /F27 584 0 R /F30 810 0 R >> +/D [1791 0 R /XYZ 99.895 679.769 null] +>> +% 1790 0 obj +<< +/Font << /F16 582 0 R /F27 584 0 R /F8 585 0 R >> /ProcSet [ /PDF /Text ] >> -% 1802 0 obj +% 1797 0 obj << /Type /Page -/Contents 1803 0 R -/Resources 1801 0 R +/Contents 1798 0 R +/Resources 1796 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1805 0 R +/Parent 1744 0 R >> -% 1804 0 obj +% 1799 0 obj << -/D [1802 0 R /XYZ 98.895 753.953 null] +/D [1797 0 R /XYZ 149.705 753.953 null] >> -% 513 0 obj +% 509 0 obj << -/D [1802 0 R /XYZ 99.895 716.092 null] +/D [1797 0 R /XYZ 150.705 716.092 null] +>> +% 1800 0 obj +<< +/D [1797 0 R /XYZ 150.705 677.445 null] >> % 1801 0 obj << -/Font << /F16 582 0 R /F8 585 0 R /F30 810 0 R >> +/D [1797 0 R /XYZ 150.705 679.769 null] +>> +% 1796 0 obj +<< +/Font << /F16 582 0 R /F27 584 0 R /F8 585 0 R /F30 811 0 R >> /ProcSet [ /PDF /Text ] >> -% 1808 0 obj +% 1803 0 obj << /Type /Page -/Contents 1809 0 R -/Resources 1807 0 R +/Contents 1804 0 R +/Resources 1802 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1805 0 R -/Annots [ 1806 0 R ] +/Parent 1806 0 R >> -% 1806 0 obj +% 1805 0 obj +<< +/D [1803 0 R /XYZ 98.895 753.953 null] +>> +% 513 0 obj +<< +/D [1803 0 R /XYZ 99.895 716.092 null] +>> +% 1802 0 obj +<< +/Font << /F16 582 0 R /F8 585 0 R /F30 811 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1809 0 obj +<< +/Type /Page +/Contents 1810 0 R +/Resources 1808 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1806 0 R +/Annots [ 1807 0 R ] +>> +% 1807 0 obj << /Type /Annot /Subtype /Link @@ -23819,230 +23826,230 @@ stream /Rect [345.53 449.411 423.049 460.536] /A << /S /GoTo /D (spdata) >> >> -% 1810 0 obj +% 1811 0 obj << -/D [1808 0 R /XYZ 149.705 753.953 null] +/D [1809 0 R /XYZ 149.705 753.953 null] >> % 517 0 obj << -/D [1808 0 R /XYZ 150.705 716.092 null] ->> -% 1811 0 obj -<< -/D [1808 0 R /XYZ 150.705 677.445 null] +/D [1809 0 R /XYZ 150.705 716.092 null] >> % 1812 0 obj << -/D [1808 0 R /XYZ 150.705 679.769 null] ->> -% 1807 0 obj -<< -/Font << /F16 582 0 R /F27 584 0 R /F8 585 0 R /F30 810 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1815 0 obj -<< -/Type /Page -/Contents 1816 0 R -/Resources 1814 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1805 0 R -/Annots [ 1813 0 R ] +/D [1809 0 R /XYZ 150.705 677.445 null] >> % 1813 0 obj << +/D [1809 0 R /XYZ 150.705 679.769 null] +>> +% 1808 0 obj +<< +/Font << /F16 582 0 R /F27 584 0 R /F8 585 0 R /F30 811 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1816 0 obj +<< +/Type /Page +/Contents 1817 0 R +/Resources 1815 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1806 0 R +/Annots [ 1814 0 R ] +>> +% 1814 0 obj +<< /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] /Rect [294.721 582.91 372.239 594.035] /A << /S /GoTo /D (spdata) >> >> -% 1817 0 obj +% 1818 0 obj << -/D [1815 0 R /XYZ 98.895 753.953 null] +/D [1816 0 R /XYZ 98.895 753.953 null] >> % 521 0 obj << -/D [1815 0 R /XYZ 99.895 716.092 null] ->> -% 1818 0 obj -<< -/D [1815 0 R /XYZ 99.895 677.445 null] +/D [1816 0 R /XYZ 99.895 716.092 null] >> % 1819 0 obj << -/D [1815 0 R /XYZ 99.895 679.769 null] ->> -% 1814 0 obj -<< -/Font << /F16 582 0 R /F27 584 0 R /F8 585 0 R /F30 810 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1822 0 obj -<< -/Type /Page -/Contents 1823 0 R -/Resources 1821 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1805 0 R -/Annots [ 1820 0 R ] +/D [1816 0 R /XYZ 99.895 677.445 null] >> % 1820 0 obj << +/D [1816 0 R /XYZ 99.895 679.769 null] +>> +% 1815 0 obj +<< +/Font << /F16 582 0 R /F27 584 0 R /F8 585 0 R /F30 811 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1823 0 obj +<< +/Type /Page +/Contents 1824 0 R +/Resources 1822 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1806 0 R +/Annots [ 1821 0 R ] +>> +% 1821 0 obj +<< /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] /Rect [345.53 449.411 423.049 460.536] /A << /S /GoTo /D (spdata) >> >> -% 1824 0 obj +% 1825 0 obj << -/D [1822 0 R /XYZ 149.705 753.953 null] +/D [1823 0 R /XYZ 149.705 753.953 null] >> % 525 0 obj << -/D [1822 0 R /XYZ 150.705 716.092 null] ->> -% 1825 0 obj -<< -/D [1822 0 R /XYZ 150.705 679.769 null] +/D [1823 0 R /XYZ 150.705 716.092 null] >> % 1826 0 obj << -/D [1822 0 R /XYZ 150.705 679.769 null] ->> -% 1821 0 obj -<< -/Font << /F16 582 0 R /F27 584 0 R /F8 585 0 R /F30 810 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1828 0 obj -<< -/Type /Page -/Contents 1829 0 R -/Resources 1827 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1805 0 R ->> -% 1830 0 obj -<< -/D [1828 0 R /XYZ 98.895 753.953 null] ->> -% 529 0 obj -<< -/D [1828 0 R /XYZ 99.895 716.092 null] ->> -% 1831 0 obj -<< -/D [1828 0 R /XYZ 99.895 679.769 null] ->> -% 1832 0 obj -<< -/D [1828 0 R /XYZ 99.895 679.769 null] +/D [1823 0 R /XYZ 150.705 679.769 null] >> % 1827 0 obj << -/Font << /F16 582 0 R /F27 584 0 R /F8 585 0 R /F30 810 0 R >> +/D [1823 0 R /XYZ 150.705 679.769 null] +>> +% 1822 0 obj +<< +/Font << /F16 582 0 R /F27 584 0 R /F8 585 0 R /F30 811 0 R >> /ProcSet [ /PDF /Text ] >> -% 1835 0 obj +% 1829 0 obj << /Type /Page -/Contents 1836 0 R -/Resources 1834 0 R +/Contents 1830 0 R +/Resources 1828 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1805 0 R -/Annots [ 1833 0 R ] +/Parent 1806 0 R +>> +% 1831 0 obj +<< +/D [1829 0 R /XYZ 98.895 753.953 null] +>> +% 529 0 obj +<< +/D [1829 0 R /XYZ 99.895 716.092 null] +>> +% 1832 0 obj +<< +/D [1829 0 R /XYZ 99.895 679.769 null] >> % 1833 0 obj << +/D [1829 0 R /XYZ 99.895 679.769 null] +>> +% 1828 0 obj +<< +/Font << /F16 582 0 R /F27 584 0 R /F8 585 0 R /F30 811 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1836 0 obj +<< +/Type /Page +/Contents 1837 0 R +/Resources 1835 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1806 0 R +/Annots [ 1834 0 R ] +>> +% 1834 0 obj +<< /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] /Rect [345.53 582.91 423.049 594.035] /A << /S /GoTo /D (spdata) >> >> -% 1837 0 obj +% 1838 0 obj << -/D [1835 0 R /XYZ 149.705 753.953 null] +/D [1836 0 R /XYZ 149.705 753.953 null] >> % 533 0 obj << -/D [1835 0 R /XYZ 150.705 716.092 null] ->> -% 1838 0 obj -<< -/D [1835 0 R /XYZ 150.705 679.769 null] +/D [1836 0 R /XYZ 150.705 716.092 null] >> % 1839 0 obj << -/D [1835 0 R /XYZ 150.705 679.769 null] ->> -% 1834 0 obj -<< -/Font << /F16 582 0 R /F27 584 0 R /F8 585 0 R /F30 810 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1841 0 obj -<< -/Type /Page -/Contents 1842 0 R -/Resources 1840 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1846 0 R ->> -% 1843 0 obj -<< -/D [1841 0 R /XYZ 98.895 753.953 null] ->> -% 537 0 obj -<< -/D [1841 0 R /XYZ 99.895 716.092 null] ->> -% 1844 0 obj -<< -/D [1841 0 R /XYZ 99.895 679.769 null] ->> -% 1845 0 obj -<< -/D [1841 0 R /XYZ 99.895 679.769 null] +/D [1836 0 R /XYZ 150.705 679.769 null] >> % 1840 0 obj << -/Font << /F16 582 0 R /F27 584 0 R /F8 585 0 R /F30 810 0 R >> +/D [1836 0 R /XYZ 150.705 679.769 null] +>> +% 1835 0 obj +<< +/Font << /F16 582 0 R /F27 584 0 R /F8 585 0 R /F30 811 0 R >> /ProcSet [ /PDF /Text ] >> -% 1848 0 obj +% 1842 0 obj << /Type /Page -/Contents 1849 0 R -/Resources 1847 0 R +/Contents 1843 0 R +/Resources 1841 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1846 0 R +/Parent 1847 0 R >> -% 1850 0 obj +% 1844 0 obj << -/D [1848 0 R /XYZ 149.705 753.953 null] +/D [1842 0 R /XYZ 98.895 753.953 null] +>> +% 537 0 obj +<< +/D [1842 0 R /XYZ 99.895 716.092 null] +>> +% 1845 0 obj +<< +/D [1842 0 R /XYZ 99.895 679.769 null] +>> +% 1846 0 obj +<< +/D [1842 0 R /XYZ 99.895 679.769 null] +>> +% 1841 0 obj +<< +/Font << /F16 582 0 R /F27 584 0 R /F8 585 0 R /F30 811 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1849 0 obj +<< +/Type /Page +/Contents 1850 0 R +/Resources 1848 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1847 0 R +>> +% 1851 0 obj +<< +/D [1849 0 R /XYZ 149.705 753.953 null] >> % 541 0 obj << -/D [1848 0 R /XYZ 150.705 716.092 null] +/D [1849 0 R /XYZ 150.705 716.092 null] >> -% 1847 0 obj +% 1848 0 obj << -/Font << /F16 582 0 R /F8 585 0 R /F14 813 0 R /F30 810 0 R >> +/Font << /F16 582 0 R /F8 585 0 R /F14 814 0 R /F30 811 0 R >> /ProcSet [ /PDF /Text ] >> -% 1854 0 obj +% 1855 0 obj << /Type /Page -/Contents 1855 0 R -/Resources 1853 0 R +/Contents 1856 0 R +/Resources 1854 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1846 0 R -/Annots [ 1851 0 R 1852 0 R ] +/Parent 1847 0 R +/Annots [ 1852 0 R 1853 0 R ] >> -% 1851 0 obj +% 1852 0 obj << /Type /Annot /Subtype /Link @@ -24050,7 +24057,7 @@ stream /Rect [321.343 443.433 388.401 454.558] /A << /S /GoTo /D (precdata) >> >> -% 1852 0 obj +% 1853 0 obj << /Type /Annot /Subtype /Link @@ -24058,41 +24065,41 @@ stream /Rect [168.831 354.046 175.293 366.086] /A << /S /GoTo /D (Hfootnote.4) >> >> -% 1856 0 obj +% 1857 0 obj << -/D [1854 0 R /XYZ 98.895 753.953 null] +/D [1855 0 R /XYZ 98.895 753.953 null] >> % 545 0 obj << -/D [1854 0 R /XYZ 99.895 716.092 null] ->> -% 1857 0 obj -<< -/D [1854 0 R /XYZ 115.138 129.79 null] ->> -% 1853 0 obj -<< -/Font << /F16 582 0 R /F30 810 0 R /F27 584 0 R /F8 585 0 R /F11 796 0 R /F7 811 0 R /F32 814 0 R /F31 816 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1863 0 obj -<< -/Type /Page -/Contents 1864 0 R -/Resources 1862 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1846 0 R -/Annots [ 1858 0 R 1859 0 R 1860 0 R 1861 0 R ] +/D [1855 0 R /XYZ 99.895 716.092 null] >> % 1858 0 obj << +/D [1855 0 R /XYZ 115.138 129.79 null] +>> +% 1854 0 obj +<< +/Font << /F16 582 0 R /F30 811 0 R /F27 584 0 R /F8 585 0 R /F11 797 0 R /F7 812 0 R /F32 815 0 R /F31 817 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1864 0 obj +<< +/Type /Page +/Contents 1865 0 R +/Resources 1863 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1847 0 R +/Annots [ 1859 0 R 1860 0 R 1861 0 R 1862 0 R ] +>> +% 1859 0 obj +<< /Type /Annot /Subtype /Link /Border[0 0 0]/H/I/C[1 0 0] /Rect [368.666 577.4 446.184 588.524] /A << /S /GoTo /D (spdata) >> >> -% 1859 0 obj +% 1860 0 obj << /Type /Annot /Subtype /Link @@ -24100,7 +24107,7 @@ stream /Rect [447.73 506.7 514.788 517.825] /A << /S /GoTo /D (precdata) >> >> -% 1860 0 obj +% 1861 0 obj << /Type /Annot /Subtype /Link @@ -24108,7 +24115,7 @@ stream /Rect [422.298 436.001 489.356 447.126] /A << /S /GoTo /D (descdata) >> >> -% 1861 0 obj +% 1862 0 obj << /Type /Annot /Subtype /Link @@ -24116,46 +24123,46 @@ stream /Rect [369.385 129.071 436.443 140.196] /A << /S /GoTo /D (precdata) >> >> -% 1865 0 obj +% 1866 0 obj << -/D [1863 0 R /XYZ 149.705 753.953 null] +/D [1864 0 R /XYZ 149.705 753.953 null] >> % 549 0 obj << -/D [1863 0 R /XYZ 150.705 716.092 null] +/D [1864 0 R /XYZ 150.705 716.092 null] >> -% 1862 0 obj +% 1863 0 obj << -/Font << /F16 582 0 R /F30 810 0 R /F27 584 0 R /F8 585 0 R >> +/Font << /F16 582 0 R /F30 811 0 R /F27 584 0 R /F8 585 0 R >> /ProcSet [ /PDF /Text ] >> +% 1868 0 obj +<< +/Type /Page +/Contents 1869 0 R +/Resources 1867 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1847 0 R +>> +% 1870 0 obj +<< +/D [1868 0 R /XYZ 98.895 753.953 null] +>> % 1867 0 obj << -/Type /Page -/Contents 1868 0 R -/Resources 1866 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1846 0 R ->> -% 1869 0 obj -<< -/D [1867 0 R /XYZ 98.895 753.953 null] ->> -% 1866 0 obj -<< -/Font << /F27 584 0 R /F8 585 0 R /F30 810 0 R >> +/Font << /F27 584 0 R /F8 585 0 R /F30 811 0 R >> /ProcSet [ /PDF /Text ] >> -% 1875 0 obj +% 1876 0 obj << /Type /Page -/Contents 1876 0 R -/Resources 1874 0 R +/Contents 1877 0 R +/Resources 1875 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1846 0 R -/Annots [ 1870 0 R 1871 0 R 1872 0 R 1873 0 R ] +/Parent 1847 0 R +/Annots [ 1871 0 R 1872 0 R 1873 0 R 1874 0 R ] >> -% 1870 0 obj +% 1871 0 obj << /Type /Annot /Subtype /Link @@ -24163,7 +24170,7 @@ stream /Rect [372.153 574.94 439.211 586.065] /A << /S /GoTo /D (precdata) >> >> -% 1871 0 obj +% 1872 0 obj << /Type /Annot /Subtype /Link @@ -24171,7 +24178,7 @@ stream /Rect [398.111 519.15 474.165 530.274] /A << /S /GoTo /D (vdata) >> >> -% 1872 0 obj +% 1873 0 obj << /Type /Annot /Subtype /Link @@ -24179,7 +24186,7 @@ stream /Rect [375.695 463.359 442.753 474.484] /A << /S /GoTo /D (descdata) >> >> -% 1873 0 obj +% 1874 0 obj << /Type /Annot /Subtype /Link @@ -24187,29 +24194,29 @@ stream /Rect [398.111 274.069 474.165 285.194] /A << /S /GoTo /D (vdata) >> >> -% 1877 0 obj +% 1878 0 obj << -/D [1875 0 R /XYZ 149.705 753.953 null] +/D [1876 0 R /XYZ 149.705 753.953 null] >> % 553 0 obj << -/D [1875 0 R /XYZ 150.705 716.092 null] +/D [1876 0 R /XYZ 150.705 716.092 null] >> -% 1874 0 obj +% 1875 0 obj << -/Font << /F16 582 0 R /F30 810 0 R /F27 584 0 R /F8 585 0 R >> +/Font << /F16 582 0 R /F30 811 0 R /F27 584 0 R /F8 585 0 R >> /ProcSet [ /PDF /Text ] >> -% 1880 0 obj +% 1881 0 obj << /Type /Page -/Contents 1881 0 R -/Resources 1879 0 R +/Contents 1882 0 R +/Resources 1880 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1883 0 R -/Annots [ 1878 0 R ] +/Parent 1884 0 R +/Annots [ 1879 0 R ] >> -% 1878 0 obj +% 1879 0 obj << /Type /Annot /Subtype /Link @@ -24217,18 +24224,14 @@ stream /Rect [321.343 560.993 388.401 572.118] /A << /S /GoTo /D (precdata) >> >> -% 1882 0 obj +% 1883 0 obj << -/D [1880 0 R /XYZ 98.895 753.953 null] ->> -% 557 0 obj -<< -/D [1880 0 R /XYZ 99.895 716.092 null] +/D [1881 0 R /XYZ 98.895 753.953 null] >> endstream endobj -1887 0 obj +1888 0 obj << /Length 998 >> @@ -24269,7 +24272,7 @@ ET endstream endobj -1893 0 obj +1894 0 obj << /Length 2736 >> @@ -24346,7 +24349,7 @@ ET endstream endobj -1897 0 obj +1898 0 obj << /Length 608 >> @@ -24362,7 +24365,7 @@ ET endstream endobj -1904 0 obj +1905 0 obj << /Length 8324 >> @@ -24512,7 +24515,7 @@ ET endstream endobj -1916 0 obj +1917 0 obj << /Length 7123 >> @@ -24652,7 +24655,7 @@ ET endstream endobj -1921 0 obj +1922 0 obj << /Length 4693 >> @@ -24719,7 +24722,7 @@ ET endstream endobj -1926 0 obj +1927 0 obj << /Length 80 >> @@ -24734,7 +24737,7 @@ ET endstream endobj -1930 0 obj +1931 0 obj << /Length 7014 >> @@ -24798,7 +24801,7 @@ ET endstream endobj -1938 0 obj +1939 0 obj << /Length 3124 >> @@ -24841,7 +24844,7 @@ ET endstream endobj -1961 0 obj +1962 0 obj << /Length1 2422 /Length2 20069 @@ -25021,7 +25024,7 @@ h ©ë–} ¸Œhj¬ÑÉ£f/›IV+\}3bGU ý5"©+IU(€oVžNo±íì⮂Øš¢b"Ñð±öÞ¢:’7cÂéx€ås¯t£! ‹@ïÇ%e)òûÀÒ\ /œCÿsoµ^“ªê- qhÏKä¡p Ú€ó&êØ /_Ïü endstream endobj -1963 0 obj +1964 0 obj << /Length1 2382 /Length2 17618 @@ -25210,7 +25213,7 @@ n òu; endstream endobj -1965 0 obj +1966 0 obj << /Length1 1599 /Length2 8420 @@ -25302,7 +25305,7 @@ I þ¿Tíæ,½€˜à÷oÌãÎ’|×Q¤OŽ9m©2E'ϯHõ!üyÀ>–Y`EüýîË`jà=­‚–¿ÖðÚƒ,Hì½;ã ß3òh|êX‡yö c­Oõ¡Gb„5Ôïß$R”ߘ´§Ð؉48CD #…_K|DÑ Â\"x·n[#Ï0Ê=viñ—ÚO÷ÞZ²`ã¤òI`˜ñ øW"YÛ.÷Óêô½ïÆøn¯ý¼Ã2Ï5*<Û*3±ˆÖâ0ŠEÆ8ðÏ ´©÷×¼øCˆ‰•Í5;Hþ,êõè ðÁ²FCí‡|h4﬚˜A¼_ïS¨À‘´Æ]!`àÀÌôä\㸌Å7äËêTç¥â*{W "« À‚e9•OŠ7íˆÑ@#u¿ëeÆmþVÚÃÆá  /š1‹VúðóÄHûFR7ÃïÈgd׈U¸·t³Ýª7‚¦Æoˆg¼mç[Ú¥E|WÌíPö «{oþu=“2k¤ŠººÄÉz†´`§@ ;ÁÈØMKt¾W‡HôÚä±¹Lì縚ݪW.¶GÄ7^7S_½i´áL°BWÊ.î‹\w¸Y¸±-í0ñÿd#š¬{¸cŸ#žX·B²u˜%ÌH6Ýæ³î®t§rD’žJm-¼‘ãuû¸¾ug9°+wOÿ³¯Üì[€ð‡$þ”â‘I°¤>Åi)“$)ÃØä«T4»mÇ{3W³Çœ¼ŽÒG-g>ç?_ý+¡a„ï©Îç¥4¼<Ý¥.öeØ»D r!QÇ¥Å(|ü|À«Å&gô MZÔ]y%ó/LQÚËÄÛIˆDYýºû0 ÃЮÒÔèûè?š€‡]¬ˆ~On6Ûº•hQ¸:ød@'—¯!ø¸@š*IsPlH¸xû¨_ÓÁjDô±\˜Ýƒg3.«fß»ƒ0„i‰}¡= 3àºñåbPõ™7¬Ûkö4DŸ•rߘº5Ëù¼—zW~Z®BbŠZ$TCW¨Ýµ? endstream endobj -1971 0 obj +1972 0 obj << /Length1 1385 /Length2 6193 @@ -25601,7 +25604,7 @@ U Å[ì,T>c·ÛØ.I£%\FÂœ û_àí€I q!¬W&|÷F;„Ëûw•C¢äÀ;zBìi*¢ü7au¨‘-¾Ì¹˜±Ñ-þªþÁòóX[1``X/cã0èú@WÕ€;¢y€_¯Z~×` endstream endobj -1973 0 obj +1974 0 obj << /Length1 1519 /Length2 8224 @@ -25687,7 +25690,7 @@ t Ùf;á¤&ú}t”áu®"@H¡ƒD¤ë¯¡u1­Ãj+?9>oÝç>D¬qN6®Áyµ ¹K‘Ÿn”;…þøÿÍp9cS&Ü…ŒŽaö¥¨wœX§0i°~ο;°6v¿_ɵ|ªŠW$ÓÓ=;Û ÞîÍí ¿û—²Ñ>®‹ƒd‰oý\ŠhÀ6’³z¡†x-à ÜÓ &Ñ=¼ ¬š—‡AÅä!ž¯:–Àç`bùЂ÷™BÇJ…æ:Y_†±íÊ Í¯Æj$>*ÏX»ßqäBù›ùÀCauFöõ[Ì€ÛŠŸ%ýÂZì¼ …ú×ÀÙH2 (F]9ëCf2!®9}º  㣽i üÌŒ{éb՛جDS`s‰Z§<ïÝV솀(”zí4ÈŠkŽ‡yý 7nW˜Ç2hî`Ïç=0ÚlVMlƘÀ%21öè,ªê3Ä«:”Ù«ÁýSåö+E4 ‘Ïr©J?¿ïƒ·ýêzÞQbÇ^Î-— ÿÄ„÷f(˹jÙUqÓ¹f-q, ì)KŽßAžú«¦N endstream endobj -1975 0 obj +1976 0 obj << /Length1 1413 /Length2 6524 @@ -25761,7 +25764,7 @@ E B9V{‚7-cOgm6×=Uÿqí¼Zþ¤ÕUkew·ƒƒ>øùx^[.ZÜGçýPËn!‹¦–'¥FÛ÷þUÏ-]1‘fj 6OŸóR®fäWg$·œˆr›ädVÕ+ø&K7I¹R„Í°d «à©!ðH„Qéêð: øÎYGdsª† ‰Óz_”üå| endstream endobj -1977 0 obj +1978 0 obj << /Length1 2668 /Length2 23077 @@ -25995,7 +25998,7 @@ HÖ‡X: hì¬ °¸Ò¬—±Æ šf]SL endstream endobj -1979 0 obj +1980 0 obj << /Length1 1425 /Length2 6648 @@ -26074,7 +26077,7 @@ B !ç> +stream +557 0 1880 57 1887 189 1889 307 561 366 1886 424 1893 530 1890 678 1891 824 1895 971 +565 1029 1892 1086 1897 1192 1899 1310 569 1369 1896 1427 1904 1520 1900 1668 1901 1817 1906 1962 +573 2020 1907 2077 1908 2135 1909 2193 1910 2251 1903 2309 1916 2506 1902 2672 1912 2818 1913 2960 +1914 3104 1918 3249 1915 3308 1921 3427 1919 3566 1923 3710 1920 3768 1926 3874 1928 3992 1925 4051 +1930 4118 1932 4236 1933 4294 781 4352 1934 4409 833 4466 831 4523 787 4580 788 4637 804 4694 +784 4751 785 4808 1935 4865 780 4923 1936 4980 1929 5038 1938 5131 1940 5249 949 5308 819 5366 +786 5424 783 5482 779 5540 782 5598 1941 5656 1937 5715 1942 5808 1943 5853 1944 5992 1945 6179 +1946 6673 1947 7002 1948 7345 1949 7474 1950 7495 1951 8001 1952 8046 1953 8736 1954 9064 1955 9145 +1956 9520 1957 10157 1958 10816 1959 11444 1960 12088 1961 12373 1963 13021 1965 13451 1967 13878 1969 14127 +1971 14369 1973 14703 1975 14920 1977 15159 1979 15381 1981 15917 1983 16154 1985 16402 1987 16784 1989 17150 +% 557 0 obj +<< +/D [1881 0 R /XYZ 99.895 716.092 null] +>> +% 1880 0 obj +<< +/Font << /F16 582 0 R /F30 811 0 R /F27 584 0 R /F8 585 0 R /F11 797 0 R /F14 814 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1887 0 obj +<< +/Type /Page +/Contents 1888 0 R +/Resources 1886 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1884 0 R +>> +% 1889 0 obj +<< +/D [1887 0 R /XYZ 149.705 753.953 null] +>> +% 561 0 obj +<< +/D [1887 0 R /XYZ 150.705 716.092 null] +>> +% 1886 0 obj +<< +/Font << /F16 582 0 R /F30 811 0 R /F27 584 0 R /F8 585 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1893 0 obj +<< +/Type /Page +/Contents 1894 0 R +/Resources 1892 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1884 0 R +/Annots [ 1890 0 R 1891 0 R ] +>> +% 1890 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [321.343 574.94 388.401 586.065] +/A << /S /GoTo /D (precdata) >> +>> +% 1891 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [321.343 499.224 388.401 510.349] +/A << /S /GoTo /D (precdata) >> +>> +% 1895 0 obj +<< +/D [1893 0 R /XYZ 98.895 753.953 null] +>> +% 565 0 obj +<< +/D [1893 0 R /XYZ 99.895 716.092 null] +>> +% 1892 0 obj +<< +/Font << /F16 582 0 R /F30 811 0 R /F27 584 0 R /F8 585 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1897 0 obj +<< +/Type /Page +/Contents 1898 0 R +/Resources 1896 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1884 0 R +>> +% 1899 0 obj +<< +/D [1897 0 R /XYZ 149.705 753.953 null] +>> +% 569 0 obj +<< +/D [1897 0 R /XYZ 150.705 716.092 null] +>> +% 1896 0 obj +<< +/Font << /F16 582 0 R /F8 585 0 R /F30 811 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1904 0 obj +<< +/Type /Page +/Contents 1905 0 R +/Resources 1903 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1884 0 R +/Annots [ 1900 0 R 1901 0 R ] +>> +% 1900 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [333.769 276.229 340.23 288.268] +/A << /S /GoTo /D (Hfootnote.5) >> +>> +% 1901 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [294.721 134.549 372.239 145.674] +/A << /S /GoTo /D (spdata) >> +>> +% 1906 0 obj +<< +/D [1904 0 R /XYZ 98.895 753.953 null] +>> +% 573 0 obj +<< +/D [1904 0 R /XYZ 99.895 716.092 null] +>> +% 1907 0 obj +<< +/D [1904 0 R /XYZ 99.895 446.608 null] +>> +% 1908 0 obj +<< +/D [1904 0 R /XYZ 99.895 446.608 null] +>> +% 1909 0 obj +<< +/D [1904 0 R /XYZ 99.895 434.653 null] +>> +% 1910 0 obj +<< +/D [1904 0 R /XYZ 115.138 129.79 null] +>> +% 1903 0 obj +<< +/Font << /F16 582 0 R /F8 585 0 R /F27 584 0 R /F11 797 0 R /F14 814 0 R /F10 813 0 R /F7 812 0 R /F30 811 0 R /F32 815 0 R /F31 817 0 R /F33 1911 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1916 0 obj +<< +/Type /Page +/Contents 1917 0 R +/Resources 1915 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1884 0 R +/Annots [ 1902 0 R 1912 0 R 1913 0 R 1914 0 R ] +>> +% 1902 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [345.53 655.098 412.588 666.223] +/A << /S /GoTo /D (precdata) >> +>> +% 1912 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [398.111 585.075 474.165 596.2] +/A << /S /GoTo /D (vdata) >> +>> +% 1913 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [398.111 515.052 474.165 526.177] +/A << /S /GoTo /D (vdata) >> +>> +% 1914 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [345.53 375.006 412.588 386.13] +/A << /S /GoTo /D (descdata) >> +>> +% 1918 0 obj +<< +/D [1916 0 R /XYZ 149.705 753.953 null] +>> +% 1915 0 obj +<< +/Font << /F27 584 0 R /F8 585 0 R /F30 811 0 R /F11 797 0 R /F14 814 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1921 0 obj +<< +/Type /Page +/Contents 1922 0 R +/Resources 1920 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1924 0 R +/Annots [ 1919 0 R ] +>> +% 1919 0 obj +<< +/Type /Annot +/Subtype /Link +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [347.301 555.472 423.355 566.597] +/A << /S /GoTo /D (vdata) >> +>> +% 1923 0 obj +<< +/D [1921 0 R /XYZ 98.895 753.953 null] +>> +% 1920 0 obj +<< +/Font << /F27 584 0 R /F8 585 0 R /F30 811 0 R /F11 797 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1926 0 obj +<< +/Type /Page +/Contents 1927 0 R +/Resources 1925 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1924 0 R +>> +% 1928 0 obj +<< +/D [1926 0 R /XYZ 149.705 753.953 null] +>> +% 1925 0 obj +<< +/Font << /F8 585 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1930 0 obj +<< +/Type /Page +/Contents 1931 0 R +/Resources 1929 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1924 0 R +>> +% 1932 0 obj +<< +/D [1930 0 R /XYZ 98.895 753.953 null] +>> +% 1933 0 obj +<< +/D [1930 0 R /XYZ 99.895 724.062 null] +>> +% 781 0 obj +<< +/D [1930 0 R /XYZ 99.895 699.619 null] +>> +% 1934 0 obj +<< +/D [1930 0 R /XYZ 99.895 643.15 null] +>> +% 833 0 obj +<< +/D [1930 0 R /XYZ 99.895 588.618 null] +>> +% 831 0 obj +<< +/D [1930 0 R /XYZ 99.895 534.087 null] +>> +% 787 0 obj +<< +/D [1930 0 R /XYZ 99.895 479.555 null] +>> +% 788 0 obj +<< +/D [1930 0 R /XYZ 99.895 436.978 null] +>> +% 804 0 obj +<< +/D [1930 0 R /XYZ 99.895 394.402 null] +>> +% 784 0 obj +<< +/D [1930 0 R /XYZ 99.895 351.272 null] +>> +% 785 0 obj +<< +/D [1930 0 R /XYZ 99.895 308.696 null] +>> +% 1935 0 obj +<< +/D [1930 0 R /XYZ 99.895 266.119 null] +>> +% 780 0 obj +<< +/D [1930 0 R /XYZ 99.895 223.543 null] +>> +% 1936 0 obj +<< +/D [1930 0 R /XYZ 99.895 180.966 null] +>> +% 1929 0 obj +<< +/Font << /F16 582 0 R /F8 585 0 R /F17 777 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1938 0 obj +<< +/Type /Page +/Contents 1939 0 R +/Resources 1937 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 1924 0 R +>> +% 1940 0 obj +<< +/D [1938 0 R /XYZ 149.705 753.953 null] +>> +% 949 0 obj +<< +/D [1938 0 R /XYZ 150.705 716.092 null] +>> +% 819 0 obj +<< +/D [1938 0 R /XYZ 150.705 688.251 null] +>> +% 786 0 obj +<< +/D [1938 0 R /XYZ 150.705 632.184 null] +>> +% 783 0 obj +<< +/D [1938 0 R /XYZ 150.705 590.562 null] +>> +% 779 0 obj +<< +/D [1938 0 R /XYZ 150.705 544.789 null] +>> +% 782 0 obj +<< +/D [1938 0 R /XYZ 150.705 512.909 null] +>> +% 1941 0 obj +<< +/D [1938 0 R /XYZ 150.705 480.475 null] +>> +% 1937 0 obj +<< +/Font << /F8 585 0 R /F17 777 0 R /F30 811 0 R >> +/ProcSet [ /PDF /Text ] +>> +% 1942 0 obj +[757.3 871.7 778.7 672.4 827.9] +% 1943 0 obj +[575.2 657.4 525.9 657.4 543 361.6 591.7 657.4 328.7 361.6 624.5 328.7 986.1 657.4 591.7 657.4 624.5 488.1 466.8 460.2 657.4] +% 1944 0 obj +[1444.5 1277.8 555.6 1111.1 1111.1 1111.1 1111.1 1111.1 944.5 1277.8 555.6 1000 1444.5 555.6 1000 1444.5 472.2 472.2 527.8 527.8 527.8 527.8 666.7 666.7 1000 1000 1000 1000] +% 1945 0 obj +[285.5 399.7 399.7 513.9 799.4 285.5 342.6 285.5 513.9 513.9 513.9 513.9 513.9 513.9 513.9 513.9 513.9 513.9 513.9 285.5 285.5 285.5 799.4 485.3 485.3 799.4 770.7 727.9 742.3 785 699.4 670.8 806.5 770.7 371 528.1 799.2 642.3 942 770.7 799.4 699.4 799.4 756.5 571 742.3 770.7 770.7 1056.2 770.7 770.7 628.1 285.5 513.9 285.5 513.9 285.5 285.5 513.9 571 456.8 571 457.2 314 513.9 571 285.5 314 542.4 285.5 856.5 571 513.9 571 542.4 402 405.4 399.7 571 542.4 742.3 542.4 542.4 456.8] +% 1946 0 obj +[892.9 339.3 892.9 585.3 892.9 585.3 892.9 892.9 892.9 892.9 892.9 892.9 892.9 1138.9 585.3 585.3 892.9 892.9 892.9 892.9 892.9 892.9 892.9 892.9 892.9 892.9 892.9 892.9 1138.9 1138.9 892.9 892.9 1138.9 1138.9 585.3 585.3 1138.9 1138.9 1138.9 892.9 1138.9 1138.9 708.3 708.3 1138.9 1138.9 1138.9 892.9 329.4 1138.9] +% 1947 0 obj +[525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525] +% 1948 0 obj +[531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3] +% 1949 0 obj +[533.6] +% 1950 0 obj +[413.2 413.2 531.3 826.4 295.1 354.2 295.1 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 295.1 295.1 295.1 826.4 501.7 501.7 826.4 795.8 752.1 767.4 811.1 722.6 693.1 833.5 795.8 382.6 545.5 825.4 663.6 972.9 795.8 826.4 722.6 826.4 781.6 590.3 767.4 795.8 795.8 1091 795.8 795.8 649.3 295.1 531.3 295.1 531.3 295.1 295.1 531.3 590.3 472.2 590.3 472.2 324.7 531.3 590.3 295.1 324.7 560.8 295.1 885.4 590.3 531.3 590.3 560.8 414.1 419.1 413.2 590.3 560.8 767.4 560.8 560.8] +% 1951 0 obj +[611.1 611.1 611.1 611.1 611.1] +% 1952 0 obj +[777.8 277.8 777.8 500 777.8 500 777.8 777.8 777.8 777.8 777.8 777.8 777.8 1000 500 500 777.8 777.8 777.8 777.8 777.8 777.8 777.8 777.8 777.8 777.8 777.8 777.8 1000 1000 777.8 777.8 1000 1000 500 500 1000 1000 1000 777.8 1000 1000 611.1 611.1 1000 1000 1000 777.8 275 1000 666.7 666.7 888.9 888.9 0 0 555.6 555.6 666.7 500 722.2 722.2 777.8 777.8 611.1 798.5 656.8 526.5 771.4 527.8 718.7 594.9 844.5 544.5 677.8 762 689.7 1200.9 820.5 796.1 695.6 816.7 847.5 605.6 544.6 625.8 612.8 987.8 713.3 668.3 724.7 666.7 666.7 666.7 666.7 666.7 611.1 611.1 444.4 444.4 444.4 444.4 500 500 388.9 388.9 277.8 500 500 611.1 500 277.8 833.3 750 833.3 416.7 666.7 666.7 777.8 777.8 444.4] +% 1953 0 obj +[339.3 892.9 585.3 892.9 585.3 610.1 859.1 863.2 819.4 934.1 838.7 724.5 889.4 935.6 506.3 632 959.9 783.7 1089.4 904.9 868.9 727.3 899.7 860.6 701.5 674.8 778.2 674.6 1074.4 936.9 671.5 778.4 462.3 462.3 462.3 1138.9 1138.9 478.2 619.7 502.4 510.5 594.7 542 557.1 557.3 668.8 404.2 472.7 607.3 361.3 1013.7 706.2] +% 1954 0 obj +[569.5 569.5 569.5 569.5 569.5 569.5 569.5 569.5 569.5 569.5 323.4] +% 1955 0 obj +[525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525] +% 1956 0 obj +[639.7 565.6 517.7 444.4 405.9 437.5 496.5 469.4 353.9 576.2 583.3 602.6 494 437.5 570 517 571.4 437.2 540.3 595.8 625.7 651.4 622.5 466.3 591.4 828.1 517 362.8 654.2 1000 1000 1000 1000 277.8 277.8 500 500 500 500 500 500 500 500 500 500 500 500 277.8 277.8 777.8 500 777.8 500 530.9 750 758.5 714.7 827.9 738.2 643.1 786.3 831.3 439.6 554.5 849.3 680.6 970.1 803.5 762.8 642 790.6 759.3 613.2 584.4 682.8 583.3 944.4 828.5 580.6 682.6 388.9 388.9 388.9 1000 1000 416.7 528.6 429.2 432.8 520.5 465.6 489.6 477 576.2 344.5 411.8 520.6 298.4 878 600.2 484.7 503.1 446.4 451.2 468.8 361.1 572.5 484.7 715.9 571.5 490.3 465.1] +% 1957 0 obj +[613.3 562.2 587.8 881.7 894.4 306.7 332.2 511.1 511.1 511.1 511.1 511.1 831.3 460 536.7 715.6 715.6 511.1 882.8 985 766.7 255.6 306.7 514.4 817.8 769.1 817.8 766.7 306.7 408.9 408.9 511.1 766.7 306.7 357.8 306.7 511.1 511.1 511.1 511.1 511.1 511.1 511.1 511.1 511.1 511.1 511.1 306.7 306.7 306.7 766.7 511.1 511.1 766.7 743.3 703.9 715.6 755 678.3 652.8 773.6 743.3 385.6 525 768.9 627.2 896.7 743.3 766.7 678.3 766.7 729.4 562.2 715.6 743.3 743.3 998.9 743.3 743.3 613.3 306.7 514.4 306.7 511.1 306.7 306.7 511.1 460 460 511.1 460 306.7 460 511.1 306.7 306.7 460 255.6 817.8 562.2 511.1 511.1 460 421.7 408.9 332.2 536.7 460 664.4 463.9 485.6] +% 1958 0 obj +[583.3 555.6 555.6 833.3 833.3 277.8 305.6 500 500 500 500 500 750 444.4 500 722.2 777.8 500 902.8 1013.9 777.8 277.8 277.8 500 833.3 500 833.3 777.8 277.8 388.9 388.9 500 777.8 277.8 333.3 277.8 500 500 500 500 500 500 500 500 500 500 500 277.8 277.8 277.8 777.8 472.2 472.2 777.8 750 708.3 722.2 763.9 680.6 652.8 784.7 750 361.1 513.9 777.8 625 916.7 750 777.8 680.6 777.8 736.1 555.6 722.2 750 750 1027.8 750 750 611.1 277.8 500 277.8 500 277.8 277.8 500 555.6 444.4 555.6 444.4 305.6 500 555.6 277.8 305.6 527.8 277.8 833.3 555.6 500 555.6 527.8 391.7 394.4 388.9 555.6 527.8 722.2 527.8 527.8 444.4 500 1000] +% 1959 0 obj +[670.8 638.9 638.9 958.3 958.3 319.4 351.4 575 575 575 575 575 869.4 511.1 597.2 830.6 894.4 575 1041.7 1169.4 894.4 319.4 350 602.8 958.3 575 958.3 894.4 319.4 447.2 447.2 575 894.4 319.4 383.3 319.4 575 575 575 575 575 575 575 575 575 575 575 319.4 319.4 350 894.4 543.1 543.1 894.4 869.4 818.1 830.6 881.9 755.6 723.6 904.2 900 436.1 594.4 901.4 691.7 1091.7 900 863.9 786.1 863.9 862.5 638.9 800 884.7 869.4 1188.9 869.4 869.4 702.8 319.4 602.8 319.4 575 319.4 319.4 559 638.9 511.1 638.9 527.1 351.4 575 638.9 319.4 351.4 606.9 319.4 958.3 638.9 575 638.9 606.9 473.6 453.6 447.2 638.9 606.9 830.6 606.9 606.9 511.1 575 1150] +% 1960 0 obj +[726.9 688.4 700 738.4 663.4 638.4 756.7 726.9 376.9 513.4 751.9 613.4 876.9 726.9 750 663.4 750 713.4 550 700 726.9 726.9 976.9 726.9 726.9 600 300 500 300 500 300 300 500 450 450 500 450 300 450 500 300 300 450 250 800 550 500 500 450 412.5 400 325 525 450 650 450 475] +% 1961 0 obj +[625 625 937.5 937.5 312.5 343.7 562.5 562.5 562.5 562.5 562.5 849.5 500 574.1 812.5 875 562.5 1018.5 1143.5 875 312.5 342.6 581 937.5 562.5 937.5 875 312.5 437.5 437.5 562.5 875 312.5 375 312.5 562.5 562.5 562.5 562.5 562.5 562.5 562.5 562.5 562.5 562.5 562.5 312.5 312.5 342.6 875 531.2 531.2 875 849.5 799.8 812.5 862.3 738.4 707.2 884.3 879.6 419 581 880.8 675.9 1067.1 879.6 844.9 768.5 844.9 839.1 625 782.4 864.6 849.5 1162 849.5 849.5 687.5 312.5 581 312.5 562.5 312.5 312.5 546.9 625 500 625 513.3 343.7 562.5 625 312.5 343.7 593.7 312.5 937.5 625 562.5 625 593.7 459.5 443.8 437.5 625 593.7 812.5 593.7 593.7 500 562.5 1125] +% 1963 0 obj +<< +/Type /FontDescriptor +/FontName /RAJOBS+CMBX10 +/Flags 4 +/FontBBox [-56 -250 1164 750] +/Ascent 694 +/CapHeight 686 +/Descent -194 +/ItalicAngle 0 +/StemV 114 +/XHeight 444 +/CharSet (/A/B/C/D/E/F/G/H/I/J/L/M/N/O/P/R/S/T/U/V/Z/a/b/c/colon/comma/d/e/eight/emdash/endash/equal/f/ff/ffi/fi/five/fl/four/g/h/hyphen/i/j/k/l/m/n/nine/o/one/p/period/q/quoteright/r/s/seven/six/t/three/two/u/v/w/x/y/z/zero) +/FontFile 1962 0 R +>> +% 1965 0 obj +<< +/Type /FontDescriptor +/FontName /BWDLNI+CMBX12 +/Flags 4 +/FontBBox [-53 -251 1139 750] +/Ascent 694 +/CapHeight 686 +/Descent -194 +/ItalicAngle 0 +/StemV 109 +/XHeight 444 +/CharSet (/A/B/C/D/E/F/G/H/I/K/L/M/N/O/P/Q/R/S/T/U/V/W/a/b/c/d/e/eight/emdash/endash/f/ffi/fi/five/four/g/h/hyphen/i/k/l/m/n/nine/o/one/p/parenleft/parenright/period/q/quoteright/r/s/seven/six/t/three/two/u/v/w/x/y/z/zero) +/FontFile 1964 0 R +>> +% 1967 0 obj +<< +/Type /FontDescriptor +/FontName /VUBHOM+CMBX9 +/Flags 4 +/FontBBox [-58 -250 1195 750] +/Ascent 694 +/CapHeight 686 +/Descent -194 +/ItalicAngle 0 +/StemV 117 +/XHeight 444 +/CharSet (/a/b/c/d/e/f/g/h/i/l/n/o/q/r/s/t/u) +/FontFile 1966 0 R +>> +% 1969 0 obj +<< +/Type /FontDescriptor +/FontName /OUFNAH+CMEX10 +/Flags 4 +/FontBBox [-24 -2960 1454 772] +/Ascent 40 +/CapHeight 0 +/Descent -600 +/ItalicAngle 0 +/StemV 47 +/XHeight 431 +/CharSet (/radicalBigg/summationdisplay) +/FontFile 1968 0 R +>> +% 1971 0 obj +<< +/Type /FontDescriptor +/FontName /HKHZAC+CMMI10 +/Flags 4 +/FontBBox [-32 -250 1048 750] +/Ascent 694 +/CapHeight 683 +/Descent -194 +/ItalicAngle -14 +/StemV 72 +/XHeight 431 +/CharSet (/A/C/D/G/I/L/N/O/P/Q/T/U/X/a/alpha/b/beta/c/comma/d/e/f/g/greater/i/j/k/l/less/m/n/o/p/period/r/s/slash/t/u/v/w/x/y/z) +/FontFile 1970 0 R +>> +% 1973 0 obj +<< +/Type /FontDescriptor +/FontName /RVPZIX+CMMI5 +/Flags 4 +/FontBBox [37 -250 1349 750] +/Ascent 694 +/CapHeight 683 +/Descent -194 +/ItalicAngle -14 +/StemV 90 +/XHeight 431 +/CharSet (/i) +/FontFile 1972 0 R +>> +% 1975 0 obj +<< +/Type /FontDescriptor +/FontName /ZUYGVH+CMMI7 +/Flags 4 +/FontBBox [-1 -250 1171 750] +/Ascent 694 +/CapHeight 683 +/Descent -194 +/ItalicAngle -14 +/StemV 81 +/XHeight 431 +/CharSet (/H/I/T/a/comma/i/j/k/m/n) +/FontFile 1974 0 R +>> +% 1977 0 obj +<< +/Type /FontDescriptor +/FontName /ZOAUSA+CMMI8 +/Flags 4 +/FontBBox [-24 -250 1110 750] +/Ascent 694 +/CapHeight 683 +/Descent -194 +/ItalicAngle -14 +/StemV 78 +/XHeight 431 +/CharSet (/C/F/G) +/FontFile 1976 0 R +>> +% 1979 0 obj +<< +/Type /FontDescriptor +/FontName /WUKOCR+CMR10 +/Flags 4 +/FontBBox [-40 -250 1009 750] +/Ascent 694 +/CapHeight 683 +/Descent -194 +/ItalicAngle 0 +/StemV 69 +/XHeight 431 +/CharSet (/A/B/C/D/E/F/G/H/I/J/K/L/M/N/O/P/R/S/T/U/V/W/X/a/ampersand/b/bracketleft/bracketright/c/colon/comma/d/e/eight/emdash/endash/equal/f/ff/ffi/fi/five/fl/four/g/h/hyphen/i/j/k/l/m/n/nine/o/one/p/parenleft/parenright/period/plus/q/quotedblleft/quotedblright/quoteright/r/s/semicolon/seven/six/slash/t/three/two/u/v/w/x/y/z/zero) +/FontFile 1978 0 R +>> +% 1981 0 obj +<< +/Type /FontDescriptor +/FontName /UJRPBG+CMR6 +/Flags 4 +/FontBBox [-20 -250 1193 750] +/Ascent 694 +/CapHeight 683 +/Descent -194 +/ItalicAngle 0 +/StemV 83 +/XHeight 431 +/CharSet (/five/four/one/three/two) +/FontFile 1980 0 R +>> +% 1983 0 obj +<< +/Type /FontDescriptor +/FontName /GIODUE+CMR7 +/Flags 4 +/FontBBox [-27 -250 1122 750] +/Ascent 694 +/CapHeight 683 +/Descent -194 +/ItalicAngle 0 +/StemV 79 +/XHeight 431 +/CharSet (/colon/five/four/one/three/two/zero) +/FontFile 1982 0 R +>> +% 1985 0 obj +<< +/Type /FontDescriptor +/FontName /HFTEUS+CMR8 +/Flags 4 +/FontBBox [-36 -250 1070 750] +/Ascent 694 +/CapHeight 683 +/Descent -194 +/ItalicAngle 0 +/StemV 76 +/XHeight 431 +/CharSet (/B/G/I/L/N/O/P/T/X/a/b/c/colon/comma/d/e/eight/f/five/four/g/h/hyphen/i/k/l/m/n/nine/o/one/p/parenleft/parenright/period/q/r/s/seven/six/slash/t/three/two/u/v/w/x/y/zero) +/FontFile 1984 0 R +>> +% 1987 0 obj +<< +/Type /FontDescriptor +/FontName /KKURMF+CMR9 +/Flags 4 +/FontBBox [-39 -250 1036 750] +/Ascent 694 +/CapHeight 683 +/Descent -194 +/ItalicAngle 0 +/StemV 74 +/XHeight 431 +/CharSet (/B/G/I/L/O/P/X/a/b/c/comma/d/e/eight/equal/f/five/four/g/h/i/m/n/nine/o/one/p/parenleft/parenright/period/quoteright/r/s/seven/six/t/three/two/u/x/z/zero) +/FontFile 1986 0 R +>> +% 1989 0 obj +<< +/Type /FontDescriptor +/FontName /IMOIOS+CMSY10 +/Flags 4 +/FontBBox [-29 -960 1116 775] +/Ascent 750 +/CapHeight 683 +/Descent -194 +/ItalicAngle -14 +/StemV 40 +/XHeight 431 +/CharSet (/B/H/I/arrowleft/bar/bardbl/braceleft/braceright/bullet/element/greaterequal/lessequal/minus/negationslash/radical/section) +/FontFile 1988 0 R +>> + +endstream +endobj +1990 0 obj << /Length1 1392 /Length2 6093 @@ -26643,639 +27267,7 @@ H C¸FíÕHo¢v¬ÎBõé:T~5©|AšQÙ31åõ7 [¬ä'ñAO&VP2,‹Ã©– ×$Ä;_Á K«×ùM“+ã‘eô÷ý..ÁA¼Mó&’O{®Îx=––r"]߆B‡¬º„ÿ¶M«ÑÚ3?†eÌÁŒá‡“QÞÈmÚ¯„Á6&3»eäNušÁŠ·³U`¤ðN6Ê@ |õ^ö(Ì®‡Pˆr@¸Í€ endstream endobj -1884 0 obj -<< -/Type /ObjStm -/N 100 -/First 989 -/Length 18652 ->> -stream -1879 0 1886 132 1888 250 561 309 1885 367 1892 473 1889 621 1890 767 1894 914 565 972 -1891 1029 1896 1135 1898 1253 569 1312 1895 1370 1903 1463 1899 1611 1900 1760 1905 1905 573 1963 -1906 2020 1907 2078 1908 2136 1909 2194 1902 2252 1915 2449 1901 2615 1911 2761 1912 2903 1913 3047 -1917 3192 1914 3251 1920 3370 1918 3509 1922 3653 1919 3711 1925 3817 1927 3935 1924 3994 1929 4061 -1931 4179 1932 4237 780 4295 1933 4352 831 4409 830 4466 786 4523 787 4580 803 4637 783 4694 -784 4751 1934 4808 779 4866 1935 4923 1928 4981 1937 5074 1939 5192 948 5251 818 5309 785 5367 -782 5425 778 5483 781 5541 1940 5599 1936 5658 1941 5751 1942 5796 1943 5935 1944 6122 1945 6616 -1946 6945 1947 7288 1948 7417 1949 7438 1950 7944 1951 7989 1952 8679 1953 9007 1954 9088 1955 9463 -1956 10100 1957 10759 1958 11387 1959 12031 1960 12316 1962 12964 1964 13394 1966 13821 1968 14070 1970 14312 -1972 14646 1974 14863 1976 15102 1978 15324 1980 15860 1982 16097 1984 16345 1986 16727 1988 17093 1990 17432 -% 1879 0 obj -<< -/Font << /F16 582 0 R /F30 810 0 R /F27 584 0 R /F8 585 0 R /F11 796 0 R /F14 813 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1886 0 obj -<< -/Type /Page -/Contents 1887 0 R -/Resources 1885 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1883 0 R ->> -% 1888 0 obj -<< -/D [1886 0 R /XYZ 149.705 753.953 null] ->> -% 561 0 obj -<< -/D [1886 0 R /XYZ 150.705 716.092 null] ->> -% 1885 0 obj -<< -/Font << /F16 582 0 R /F30 810 0 R /F27 584 0 R /F8 585 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1892 0 obj -<< -/Type /Page -/Contents 1893 0 R -/Resources 1891 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1883 0 R -/Annots [ 1889 0 R 1890 0 R ] ->> -% 1889 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [321.343 574.94 388.401 586.065] -/A << /S /GoTo /D (precdata) >> ->> -% 1890 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [321.343 499.224 388.401 510.349] -/A << /S /GoTo /D (precdata) >> ->> -% 1894 0 obj -<< -/D [1892 0 R /XYZ 98.895 753.953 null] ->> -% 565 0 obj -<< -/D [1892 0 R /XYZ 99.895 716.092 null] ->> -% 1891 0 obj -<< -/Font << /F16 582 0 R /F30 810 0 R /F27 584 0 R /F8 585 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1896 0 obj -<< -/Type /Page -/Contents 1897 0 R -/Resources 1895 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1883 0 R ->> -% 1898 0 obj -<< -/D [1896 0 R /XYZ 149.705 753.953 null] ->> -% 569 0 obj -<< -/D [1896 0 R /XYZ 150.705 716.092 null] ->> -% 1895 0 obj -<< -/Font << /F16 582 0 R /F8 585 0 R /F30 810 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1903 0 obj -<< -/Type /Page -/Contents 1904 0 R -/Resources 1902 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1883 0 R -/Annots [ 1899 0 R 1900 0 R ] ->> -% 1899 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [333.769 276.229 340.23 288.268] -/A << /S /GoTo /D (Hfootnote.5) >> ->> -% 1900 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [294.721 134.549 372.239 145.674] -/A << /S /GoTo /D (spdata) >> ->> -% 1905 0 obj -<< -/D [1903 0 R /XYZ 98.895 753.953 null] ->> -% 573 0 obj -<< -/D [1903 0 R /XYZ 99.895 716.092 null] ->> -% 1906 0 obj -<< -/D [1903 0 R /XYZ 99.895 446.608 null] ->> -% 1907 0 obj -<< -/D [1903 0 R /XYZ 99.895 446.608 null] ->> -% 1908 0 obj -<< -/D [1903 0 R /XYZ 99.895 434.653 null] ->> -% 1909 0 obj -<< -/D [1903 0 R /XYZ 115.138 129.79 null] ->> -% 1902 0 obj -<< -/Font << /F16 582 0 R /F8 585 0 R /F27 584 0 R /F11 796 0 R /F14 813 0 R /F10 812 0 R /F7 811 0 R /F30 810 0 R /F32 814 0 R /F31 816 0 R /F33 1910 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1915 0 obj -<< -/Type /Page -/Contents 1916 0 R -/Resources 1914 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1883 0 R -/Annots [ 1901 0 R 1911 0 R 1912 0 R 1913 0 R ] ->> -% 1901 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [345.53 655.098 412.588 666.223] -/A << /S /GoTo /D (precdata) >> ->> -% 1911 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [398.111 585.075 474.165 596.2] -/A << /S /GoTo /D (vdata) >> ->> -% 1912 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [398.111 515.052 474.165 526.177] -/A << /S /GoTo /D (vdata) >> ->> -% 1913 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [345.53 375.006 412.588 386.13] -/A << /S /GoTo /D (descdata) >> ->> -% 1917 0 obj -<< -/D [1915 0 R /XYZ 149.705 753.953 null] ->> -% 1914 0 obj -<< -/Font << /F27 584 0 R /F8 585 0 R /F30 810 0 R /F11 796 0 R /F14 813 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1920 0 obj -<< -/Type /Page -/Contents 1921 0 R -/Resources 1919 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1923 0 R -/Annots [ 1918 0 R ] ->> -% 1918 0 obj -<< -/Type /Annot -/Subtype /Link -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [347.301 555.472 423.355 566.597] -/A << /S /GoTo /D (vdata) >> ->> -% 1922 0 obj -<< -/D [1920 0 R /XYZ 98.895 753.953 null] ->> -% 1919 0 obj -<< -/Font << /F27 584 0 R /F8 585 0 R /F30 810 0 R /F11 796 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1925 0 obj -<< -/Type /Page -/Contents 1926 0 R -/Resources 1924 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1923 0 R ->> -% 1927 0 obj -<< -/D [1925 0 R /XYZ 149.705 753.953 null] ->> -% 1924 0 obj -<< -/Font << /F8 585 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1929 0 obj -<< -/Type /Page -/Contents 1930 0 R -/Resources 1928 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1923 0 R ->> -% 1931 0 obj -<< -/D [1929 0 R /XYZ 98.895 753.953 null] ->> -% 1932 0 obj -<< -/D [1929 0 R /XYZ 99.895 724.062 null] ->> -% 780 0 obj -<< -/D [1929 0 R /XYZ 99.895 699.619 null] ->> -% 1933 0 obj -<< -/D [1929 0 R /XYZ 99.895 643.15 null] ->> -% 831 0 obj -<< -/D [1929 0 R /XYZ 99.895 588.618 null] ->> -% 830 0 obj -<< -/D [1929 0 R /XYZ 99.895 534.087 null] ->> -% 786 0 obj -<< -/D [1929 0 R /XYZ 99.895 479.555 null] ->> -% 787 0 obj -<< -/D [1929 0 R /XYZ 99.895 436.978 null] ->> -% 803 0 obj -<< -/D [1929 0 R /XYZ 99.895 394.402 null] ->> -% 783 0 obj -<< -/D [1929 0 R /XYZ 99.895 351.272 null] ->> -% 784 0 obj -<< -/D [1929 0 R /XYZ 99.895 308.696 null] ->> -% 1934 0 obj -<< -/D [1929 0 R /XYZ 99.895 266.119 null] ->> -% 779 0 obj -<< -/D [1929 0 R /XYZ 99.895 223.543 null] ->> -% 1935 0 obj -<< -/D [1929 0 R /XYZ 99.895 180.966 null] ->> -% 1928 0 obj -<< -/Font << /F16 582 0 R /F8 585 0 R /F17 776 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1937 0 obj -<< -/Type /Page -/Contents 1938 0 R -/Resources 1936 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 1923 0 R ->> -% 1939 0 obj -<< -/D [1937 0 R /XYZ 149.705 753.953 null] ->> -% 948 0 obj -<< -/D [1937 0 R /XYZ 150.705 716.092 null] ->> -% 818 0 obj -<< -/D [1937 0 R /XYZ 150.705 688.251 null] ->> -% 785 0 obj -<< -/D [1937 0 R /XYZ 150.705 632.184 null] ->> -% 782 0 obj -<< -/D [1937 0 R /XYZ 150.705 590.562 null] ->> -% 778 0 obj -<< -/D [1937 0 R /XYZ 150.705 544.789 null] ->> -% 781 0 obj -<< -/D [1937 0 R /XYZ 150.705 512.909 null] ->> -% 1940 0 obj -<< -/D [1937 0 R /XYZ 150.705 480.475 null] ->> -% 1936 0 obj -<< -/Font << /F8 585 0 R /F17 776 0 R /F30 810 0 R >> -/ProcSet [ /PDF /Text ] ->> -% 1941 0 obj -[757.3 871.7 778.7 672.4 827.9] -% 1942 0 obj -[575.2 657.4 525.9 657.4 543 361.6 591.7 657.4 328.7 361.6 624.5 328.7 986.1 657.4 591.7 657.4 624.5 488.1 466.8 460.2 657.4] -% 1943 0 obj -[1444.5 1277.8 555.6 1111.1 1111.1 1111.1 1111.1 1111.1 944.5 1277.8 555.6 1000 1444.5 555.6 1000 1444.5 472.2 472.2 527.8 527.8 527.8 527.8 666.7 666.7 1000 1000 1000 1000] -% 1944 0 obj -[285.5 399.7 399.7 513.9 799.4 285.5 342.6 285.5 513.9 513.9 513.9 513.9 513.9 513.9 513.9 513.9 513.9 513.9 513.9 285.5 285.5 285.5 799.4 485.3 485.3 799.4 770.7 727.9 742.3 785 699.4 670.8 806.5 770.7 371 528.1 799.2 642.3 942 770.7 799.4 699.4 799.4 756.5 571 742.3 770.7 770.7 1056.2 770.7 770.7 628.1 285.5 513.9 285.5 513.9 285.5 285.5 513.9 571 456.8 571 457.2 314 513.9 571 285.5 314 542.4 285.5 856.5 571 513.9 571 542.4 402 405.4 399.7 571 542.4 742.3 542.4 542.4 456.8] -% 1945 0 obj -[892.9 339.3 892.9 585.3 892.9 585.3 892.9 892.9 892.9 892.9 892.9 892.9 892.9 1138.9 585.3 585.3 892.9 892.9 892.9 892.9 892.9 892.9 892.9 892.9 892.9 892.9 892.9 892.9 1138.9 1138.9 892.9 892.9 1138.9 1138.9 585.3 585.3 1138.9 1138.9 1138.9 892.9 1138.9 1138.9 708.3 708.3 1138.9 1138.9 1138.9 892.9 329.4 1138.9] -% 1946 0 obj -[525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525] -% 1947 0 obj -[531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3] -% 1948 0 obj -[533.6] -% 1949 0 obj -[413.2 413.2 531.3 826.4 295.1 354.2 295.1 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 295.1 295.1 295.1 826.4 501.7 501.7 826.4 795.8 752.1 767.4 811.1 722.6 693.1 833.5 795.8 382.6 545.5 825.4 663.6 972.9 795.8 826.4 722.6 826.4 781.6 590.3 767.4 795.8 795.8 1091 795.8 795.8 649.3 295.1 531.3 295.1 531.3 295.1 295.1 531.3 590.3 472.2 590.3 472.2 324.7 531.3 590.3 295.1 324.7 560.8 295.1 885.4 590.3 531.3 590.3 560.8 414.1 419.1 413.2 590.3 560.8 767.4 560.8 560.8] -% 1950 0 obj -[611.1 611.1 611.1 611.1 611.1] -% 1951 0 obj -[777.8 277.8 777.8 500 777.8 500 777.8 777.8 777.8 777.8 777.8 777.8 777.8 1000 500 500 777.8 777.8 777.8 777.8 777.8 777.8 777.8 777.8 777.8 777.8 777.8 777.8 1000 1000 777.8 777.8 1000 1000 500 500 1000 1000 1000 777.8 1000 1000 611.1 611.1 1000 1000 1000 777.8 275 1000 666.7 666.7 888.9 888.9 0 0 555.6 555.6 666.7 500 722.2 722.2 777.8 777.8 611.1 798.5 656.8 526.5 771.4 527.8 718.7 594.9 844.5 544.5 677.8 762 689.7 1200.9 820.5 796.1 695.6 816.7 847.5 605.6 544.6 625.8 612.8 987.8 713.3 668.3 724.7 666.7 666.7 666.7 666.7 666.7 611.1 611.1 444.4 444.4 444.4 444.4 500 500 388.9 388.9 277.8 500 500 611.1 500 277.8 833.3 750 833.3 416.7 666.7 666.7 777.8 777.8 444.4] -% 1952 0 obj -[339.3 892.9 585.3 892.9 585.3 610.1 859.1 863.2 819.4 934.1 838.7 724.5 889.4 935.6 506.3 632 959.9 783.7 1089.4 904.9 868.9 727.3 899.7 860.6 701.5 674.8 778.2 674.6 1074.4 936.9 671.5 778.4 462.3 462.3 462.3 1138.9 1138.9 478.2 619.7 502.4 510.5 594.7 542 557.1 557.3 668.8 404.2 472.7 607.3 361.3 1013.7 706.2] -% 1953 0 obj -[569.5 569.5 569.5 569.5 569.5 569.5 569.5 569.5 569.5 569.5 323.4] -% 1954 0 obj -[525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525] -% 1955 0 obj -[639.7 565.6 517.7 444.4 405.9 437.5 496.5 469.4 353.9 576.2 583.3 602.6 494 437.5 570 517 571.4 437.2 540.3 595.8 625.7 651.4 622.5 466.3 591.4 828.1 517 362.8 654.2 1000 1000 1000 1000 277.8 277.8 500 500 500 500 500 500 500 500 500 500 500 500 277.8 277.8 777.8 500 777.8 500 530.9 750 758.5 714.7 827.9 738.2 643.1 786.3 831.3 439.6 554.5 849.3 680.6 970.1 803.5 762.8 642 790.6 759.3 613.2 584.4 682.8 583.3 944.4 828.5 580.6 682.6 388.9 388.9 388.9 1000 1000 416.7 528.6 429.2 432.8 520.5 465.6 489.6 477 576.2 344.5 411.8 520.6 298.4 878 600.2 484.7 503.1 446.4 451.2 468.8 361.1 572.5 484.7 715.9 571.5 490.3 465.1] -% 1956 0 obj -[613.3 562.2 587.8 881.7 894.4 306.7 332.2 511.1 511.1 511.1 511.1 511.1 831.3 460 536.7 715.6 715.6 511.1 882.8 985 766.7 255.6 306.7 514.4 817.8 769.1 817.8 766.7 306.7 408.9 408.9 511.1 766.7 306.7 357.8 306.7 511.1 511.1 511.1 511.1 511.1 511.1 511.1 511.1 511.1 511.1 511.1 306.7 306.7 306.7 766.7 511.1 511.1 766.7 743.3 703.9 715.6 755 678.3 652.8 773.6 743.3 385.6 525 768.9 627.2 896.7 743.3 766.7 678.3 766.7 729.4 562.2 715.6 743.3 743.3 998.9 743.3 743.3 613.3 306.7 514.4 306.7 511.1 306.7 306.7 511.1 460 460 511.1 460 306.7 460 511.1 306.7 306.7 460 255.6 817.8 562.2 511.1 511.1 460 421.7 408.9 332.2 536.7 460 664.4 463.9 485.6] -% 1957 0 obj -[583.3 555.6 555.6 833.3 833.3 277.8 305.6 500 500 500 500 500 750 444.4 500 722.2 777.8 500 902.8 1013.9 777.8 277.8 277.8 500 833.3 500 833.3 777.8 277.8 388.9 388.9 500 777.8 277.8 333.3 277.8 500 500 500 500 500 500 500 500 500 500 500 277.8 277.8 277.8 777.8 472.2 472.2 777.8 750 708.3 722.2 763.9 680.6 652.8 784.7 750 361.1 513.9 777.8 625 916.7 750 777.8 680.6 777.8 736.1 555.6 722.2 750 750 1027.8 750 750 611.1 277.8 500 277.8 500 277.8 277.8 500 555.6 444.4 555.6 444.4 305.6 500 555.6 277.8 305.6 527.8 277.8 833.3 555.6 500 555.6 527.8 391.7 394.4 388.9 555.6 527.8 722.2 527.8 527.8 444.4 500 1000] -% 1958 0 obj -[670.8 638.9 638.9 958.3 958.3 319.4 351.4 575 575 575 575 575 869.4 511.1 597.2 830.6 894.4 575 1041.7 1169.4 894.4 319.4 350 602.8 958.3 575 958.3 894.4 319.4 447.2 447.2 575 894.4 319.4 383.3 319.4 575 575 575 575 575 575 575 575 575 575 575 319.4 319.4 350 894.4 543.1 543.1 894.4 869.4 818.1 830.6 881.9 755.6 723.6 904.2 900 436.1 594.4 901.4 691.7 1091.7 900 863.9 786.1 863.9 862.5 638.9 800 884.7 869.4 1188.9 869.4 869.4 702.8 319.4 602.8 319.4 575 319.4 319.4 559 638.9 511.1 638.9 527.1 351.4 575 638.9 319.4 351.4 606.9 319.4 958.3 638.9 575 638.9 606.9 473.6 453.6 447.2 638.9 606.9 830.6 606.9 606.9 511.1 575 1150] -% 1959 0 obj -[726.9 688.4 700 738.4 663.4 638.4 756.7 726.9 376.9 513.4 751.9 613.4 876.9 726.9 750 663.4 750 713.4 550 700 726.9 726.9 976.9 726.9 726.9 600 300 500 300 500 300 300 500 450 450 500 450 300 450 500 300 300 450 250 800 550 500 500 450 412.5 400 325 525 450 650 450 475] -% 1960 0 obj -[625 625 937.5 937.5 312.5 343.7 562.5 562.5 562.5 562.5 562.5 849.5 500 574.1 812.5 875 562.5 1018.5 1143.5 875 312.5 342.6 581 937.5 562.5 937.5 875 312.5 437.5 437.5 562.5 875 312.5 375 312.5 562.5 562.5 562.5 562.5 562.5 562.5 562.5 562.5 562.5 562.5 562.5 312.5 312.5 342.6 875 531.2 531.2 875 849.5 799.8 812.5 862.3 738.4 707.2 884.3 879.6 419 581 880.8 675.9 1067.1 879.6 844.9 768.5 844.9 839.1 625 782.4 864.6 849.5 1162 849.5 849.5 687.5 312.5 581 312.5 562.5 312.5 312.5 546.9 625 500 625 513.3 343.7 562.5 625 312.5 343.7 593.7 312.5 937.5 625 562.5 625 593.7 459.5 443.8 437.5 625 593.7 812.5 593.7 593.7 500 562.5 1125] -% 1962 0 obj -<< -/Type /FontDescriptor -/FontName /RAJOBS+CMBX10 -/Flags 4 -/FontBBox [-56 -250 1164 750] -/Ascent 694 -/CapHeight 686 -/Descent -194 -/ItalicAngle 0 -/StemV 114 -/XHeight 444 -/CharSet (/A/B/C/D/E/F/G/H/I/J/L/M/N/O/P/R/S/T/U/V/Z/a/b/c/colon/comma/d/e/eight/emdash/endash/equal/f/ff/ffi/fi/five/fl/four/g/h/hyphen/i/j/k/l/m/n/nine/o/one/p/period/q/quoteright/r/s/seven/six/t/three/two/u/v/w/x/y/z/zero) -/FontFile 1961 0 R ->> -% 1964 0 obj -<< -/Type /FontDescriptor -/FontName /BWDLNI+CMBX12 -/Flags 4 -/FontBBox [-53 -251 1139 750] -/Ascent 694 -/CapHeight 686 -/Descent -194 -/ItalicAngle 0 -/StemV 109 -/XHeight 444 -/CharSet (/A/B/C/D/E/F/G/H/I/K/L/M/N/O/P/Q/R/S/T/U/V/W/a/b/c/d/e/eight/emdash/endash/f/ffi/fi/five/four/g/h/hyphen/i/k/l/m/n/nine/o/one/p/parenleft/parenright/period/q/quoteright/r/s/seven/six/t/three/two/u/v/w/x/y/z/zero) -/FontFile 1963 0 R ->> -% 1966 0 obj -<< -/Type /FontDescriptor -/FontName /VUBHOM+CMBX9 -/Flags 4 -/FontBBox [-58 -250 1195 750] -/Ascent 694 -/CapHeight 686 -/Descent -194 -/ItalicAngle 0 -/StemV 117 -/XHeight 444 -/CharSet (/a/b/c/d/e/f/g/h/i/l/n/o/q/r/s/t/u) -/FontFile 1965 0 R ->> -% 1968 0 obj -<< -/Type /FontDescriptor -/FontName /OUFNAH+CMEX10 -/Flags 4 -/FontBBox [-24 -2960 1454 772] -/Ascent 40 -/CapHeight 0 -/Descent -600 -/ItalicAngle 0 -/StemV 47 -/XHeight 431 -/CharSet (/radicalBigg/summationdisplay) -/FontFile 1967 0 R ->> -% 1970 0 obj -<< -/Type /FontDescriptor -/FontName /HKHZAC+CMMI10 -/Flags 4 -/FontBBox [-32 -250 1048 750] -/Ascent 694 -/CapHeight 683 -/Descent -194 -/ItalicAngle -14 -/StemV 72 -/XHeight 431 -/CharSet (/A/C/D/G/I/L/N/O/P/Q/T/U/X/a/alpha/b/beta/c/comma/d/e/f/g/greater/i/j/k/l/less/m/n/o/p/period/r/s/slash/t/u/v/w/x/y/z) -/FontFile 1969 0 R ->> -% 1972 0 obj -<< -/Type /FontDescriptor -/FontName /RVPZIX+CMMI5 -/Flags 4 -/FontBBox [37 -250 1349 750] -/Ascent 694 -/CapHeight 683 -/Descent -194 -/ItalicAngle -14 -/StemV 90 -/XHeight 431 -/CharSet (/i) -/FontFile 1971 0 R ->> -% 1974 0 obj -<< -/Type /FontDescriptor -/FontName /ZUYGVH+CMMI7 -/Flags 4 -/FontBBox [-1 -250 1171 750] -/Ascent 694 -/CapHeight 683 -/Descent -194 -/ItalicAngle -14 -/StemV 81 -/XHeight 431 -/CharSet (/H/I/T/a/comma/i/j/k/m/n) -/FontFile 1973 0 R ->> -% 1976 0 obj -<< -/Type /FontDescriptor -/FontName /ZOAUSA+CMMI8 -/Flags 4 -/FontBBox [-24 -250 1110 750] -/Ascent 694 -/CapHeight 683 -/Descent -194 -/ItalicAngle -14 -/StemV 78 -/XHeight 431 -/CharSet (/C/F/G) -/FontFile 1975 0 R ->> -% 1978 0 obj -<< -/Type /FontDescriptor -/FontName /WUKOCR+CMR10 -/Flags 4 -/FontBBox [-40 -250 1009 750] -/Ascent 694 -/CapHeight 683 -/Descent -194 -/ItalicAngle 0 -/StemV 69 -/XHeight 431 -/CharSet (/A/B/C/D/E/F/G/H/I/J/K/L/M/N/O/P/R/S/T/U/V/W/X/a/ampersand/b/bracketleft/bracketright/c/colon/comma/d/e/eight/emdash/endash/equal/f/ff/ffi/fi/five/fl/four/g/h/hyphen/i/j/k/l/m/n/nine/o/one/p/parenleft/parenright/period/plus/q/quotedblleft/quotedblright/quoteright/r/s/semicolon/seven/six/slash/t/three/two/u/v/w/x/y/z/zero) -/FontFile 1977 0 R ->> -% 1980 0 obj -<< -/Type /FontDescriptor -/FontName /UJRPBG+CMR6 -/Flags 4 -/FontBBox [-20 -250 1193 750] -/Ascent 694 -/CapHeight 683 -/Descent -194 -/ItalicAngle 0 -/StemV 83 -/XHeight 431 -/CharSet (/five/four/one/three/two) -/FontFile 1979 0 R ->> -% 1982 0 obj -<< -/Type /FontDescriptor -/FontName /GIODUE+CMR7 -/Flags 4 -/FontBBox [-27 -250 1122 750] -/Ascent 694 -/CapHeight 683 -/Descent -194 -/ItalicAngle 0 -/StemV 79 -/XHeight 431 -/CharSet (/colon/five/four/one/three/two/zero) -/FontFile 1981 0 R ->> -% 1984 0 obj -<< -/Type /FontDescriptor -/FontName /HFTEUS+CMR8 -/Flags 4 -/FontBBox [-36 -250 1070 750] -/Ascent 694 -/CapHeight 683 -/Descent -194 -/ItalicAngle 0 -/StemV 76 -/XHeight 431 -/CharSet (/B/G/I/L/N/O/P/T/X/a/b/c/colon/comma/d/e/eight/f/five/four/g/h/hyphen/i/k/l/m/n/nine/o/one/p/parenleft/parenright/period/q/r/s/seven/six/slash/t/three/two/u/v/w/x/y/zero) -/FontFile 1983 0 R ->> -% 1986 0 obj -<< -/Type /FontDescriptor -/FontName /KKURMF+CMR9 -/Flags 4 -/FontBBox [-39 -250 1036 750] -/Ascent 694 -/CapHeight 683 -/Descent -194 -/ItalicAngle 0 -/StemV 74 -/XHeight 431 -/CharSet (/B/G/I/L/O/P/X/a/b/c/comma/d/e/eight/equal/f/five/four/g/h/i/m/n/nine/o/one/p/parenleft/parenright/period/quoteright/r/s/seven/six/t/three/two/u/x/z/zero) -/FontFile 1985 0 R ->> -% 1988 0 obj -<< -/Type /FontDescriptor -/FontName /IMOIOS+CMSY10 -/Flags 4 -/FontBBox [-29 -960 1116 775] -/Ascent 750 -/CapHeight 683 -/Descent -194 -/ItalicAngle -14 -/StemV 40 -/XHeight 431 -/CharSet (/B/H/I/arrowleft/bar/bardbl/braceleft/braceright/bullet/element/greaterequal/lessequal/minus/negationslash/radical/section) -/FontFile 1987 0 R ->> -% 1990 0 obj -<< -/Type /FontDescriptor -/FontName /XNLILI+CMSY7 -/Flags 4 -/FontBBox [-15 -951 1251 782] -/Ascent 750 -/CapHeight 683 -/Descent -194 -/ItalicAngle -14 -/StemV 49 -/XHeight 431 -/CharSet (/infinity/minus) -/FontFile 1989 0 R ->> - -endstream -endobj -1991 0 obj +1993 0 obj << /Length1 2199 /Length2 18119 @@ -27447,7 +27439,7 @@ s Xjç ?ñi•zâDRuõêøsuaÑSÔàT­ÃßkÀ;¢ÝÖ§_‚Í+_2(ï*O¦¢Ÿ+5HM¢“¥Ê膽A1ë‹IYÚªÀl9%—d½~QŠc,óAeÃ[€Þ»wIÝ¢f(ß'BTn˜nŠ³g¶ôÿ endstream endobj -1994 0 obj +1995 0 obj << /Length1 1699 /Length2 10351 @@ -27554,7 +27546,7 @@ qO' ÔX¦Ç ë¾A±©µ ÷•©SÞt²•äoC‹Kžr 0ìE·½õ1”O®&é ò™\e;HË lüqάa]Ÿ´þ_i0yÏ4Þ ^2’™Óè0‘ endstream endobj -1996 0 obj +1997 0 obj << /Length1 2460 /Length2 17290 @@ -27742,7 +27734,7 @@ e s£7ƒæM9-‘ùÆìª@¯Ð®R³±îB#„:Þ‰À×£‚lÉV÷ÌŒÜeƒ¶üUw²ÚÄ¿J·"™1 ×C±W|M`¯/ˆ©ïÑÕn­Æ$è”õÎÓÏw³½íΛ_®×7SŸ£¬›¹¿ `²Îkss½Þ‰o1½,ÈíÂؽ„­IIøßÏäŠÁÖs>9y U.Ï&†²Ëï:Ü.mQG-+ñ´N‚êÌM¢91 endstream endobj -1998 0 obj +1999 0 obj << /Length1 1494 /Length2 2555 @@ -27806,7 +27798,7 @@ currentfile eexec &Ì¡‰ç·Y5<1B îdlaà;À«9^¿'l„Hn,³ÛúºW˜÷ƒ{ÐÊY³µ¬Ô[œvñ endstream endobj -2000 0 obj +2001 0 obj << /Length1 1656 /Length2 8404 @@ -27916,25 +27908,40 @@ e §Öga!.ΘÍþâ:Øâܨ+. endstream endobj -1993 0 obj +1992 0 obj << /Type /ObjStm /N 100 -/First 956 -/Length 12939 +/First 958 +/Length 13084 >> stream -1992 0 1995 373 1997 636 1999 1115 2001 1347 584 1631 582 1772 1752 1913 1725 2054 796 2196 -844 2337 812 2478 1910 2618 585 2758 814 2898 811 3036 816 3174 1300 3313 813 3453 1170 3593 -776 3732 583 3873 810 4014 872 4155 1012 4295 586 4436 777 4549 873 4662 928 4775 963 4888 -992 5001 1035 5118 1090 5238 1138 5358 1196 5478 1249 5598 1301 5718 1357 5838 1398 5958 1436 6078 -1485 6198 1527 6318 1561 6438 1601 6558 1642 6678 1674 6798 1706 6918 1743 7038 1805 7158 1846 7278 -1883 7398 1923 7518 2002 7620 2003 7735 2004 7856 2005 7977 2006 8098 2007 8192 2008 8288 574 8357 -570 8417 566 8528 562 8602 558 8690 554 8778 550 8866 546 8954 542 9028 538 9153 534 9227 -530 9315 526 9403 522 9491 518 9579 514 9653 510 9778 506 9852 502 9940 498 10028 494 10102 -490 10227 486 10301 482 10389 478 10477 474 10565 470 10653 466 10741 462 10829 458 10917 454 11005 -450 11093 446 11181 442 11269 438 11357 434 11445 430 11533 426 11621 422 11695 418 11821 414 11895 -% 1992 0 obj +1991 0 1994 231 1996 604 1998 867 2000 1346 2002 1578 584 1862 582 2003 1753 2144 1726 2285 +797 2427 845 2568 813 2709 1911 2849 585 2989 815 3129 812 3267 817 3405 1301 3544 814 3684 +1171 3824 777 3963 583 4104 811 4245 873 4386 1013 4526 586 4667 778 4780 874 4893 929 5006 +964 5119 993 5232 1036 5349 1091 5469 1139 5589 1197 5709 1250 5829 1302 5949 1358 6069 1399 6189 +1437 6309 1486 6429 1528 6549 1562 6669 1602 6789 1643 6909 1676 7029 1707 7149 1744 7269 1806 7389 +1847 7509 1884 7629 1924 7749 2003 7851 2004 7966 2005 8087 2006 8208 2007 8329 2008 8423 2009 8519 +574 8588 570 8648 566 8759 562 8833 558 8921 554 9009 550 9097 546 9185 542 9259 538 9384 +534 9458 530 9546 526 9634 522 9722 518 9810 514 9884 510 10009 506 10083 502 10171 498 10259 +494 10333 490 10458 486 10532 482 10620 478 10708 474 10796 470 10884 466 10972 462 11060 458 11148 +454 11236 450 11324 446 11412 442 11500 438 11588 434 11676 430 11764 426 11852 422 11926 418 12052 +% 1991 0 obj +<< +/Type /FontDescriptor +/FontName /XNLILI+CMSY7 +/Flags 4 +/FontBBox [-15 -951 1251 782] +/Ascent 750 +/CapHeight 683 +/Descent -194 +/ItalicAngle -14 +/StemV 49 +/XHeight 431 +/CharSet (/infinity/minus) +/FontFile 1990 0 R +>> +% 1994 0 obj << /Type /FontDescriptor /FontName /HBJLDT+CMTI10 @@ -27947,9 +27954,9 @@ stream /StemV 68 /XHeight 431 /CharSet (/A/B/C/D/E/F/G/I/L/M/N/O/P/R/S/T/U/V/a/b/c/colon/d/e/f/ff/fi/five/g/h/hyphen/i/j/l/m/n/nine/o/one/p/period/q/quoteright/r/s/slash/t/three/two/u/v/w/x/y/zero) -/FontFile 1991 0 R +/FontFile 1993 0 R >> -% 1995 0 obj +% 1996 0 obj << /Type /FontDescriptor /FontName /OZJPZO+CMTI12 @@ -27962,9 +27969,9 @@ stream /StemV 63 /XHeight 431 /CharSet (/A/B/L/P/S/a/b/c/d/e/f/g/h/i/l/n/o/p/r/s/t/u/y) -/FontFile 1994 0 R +/FontFile 1995 0 R >> -% 1997 0 obj +% 1998 0 obj << /Type /FontDescriptor /FontName /TJSMYH+CMTT10 @@ -27977,9 +27984,9 @@ stream /StemV 69 /XHeight 431 /CharSet (/A/B/C/D/E/F/I/K/L/M/N/O/P/R/S/T/U/W/Y/a/ampersand/asciitilde/asterisk/b/backslash/bracketleft/bracketright/c/colon/comma/d/e/equal/f/four/g/h/hyphen/i/j/k/l/m/n/o/one/p/parenleft/parenright/percent/period/plus/q/r/s/six/slash/t/three/two/u/underscore/v/w/x/y/z/zero) -/FontFile 1996 0 R +/FontFile 1997 0 R >> -% 1999 0 obj +% 2000 0 obj << /Type /FontDescriptor /FontName /HZGQIC+CMTT8 @@ -27992,9 +27999,9 @@ stream /StemV 76 /XHeight 431 /CharSet (/b/c/e/i/l/n/p/r/s/t) -/FontFile 1998 0 R +/FontFile 1999 0 R >> -% 2001 0 obj +% 2002 0 obj << /Type /FontDescriptor /FontName /KMUHVJ+CMTT9 @@ -28007,440 +28014,440 @@ stream /StemV 74 /XHeight 431 /CharSet (/T/a/b/c/colon/comma/d/e/l/n/o/p/parenleft/parenright/r/s/t/underscore/y) -/FontFile 2000 0 R +/FontFile 2001 0 R >> % 584 0 obj << /Type /Font /Subtype /Type1 /BaseFont /RAJOBS+CMBX10 -/FontDescriptor 1962 0 R +/FontDescriptor 1963 0 R /FirstChar 11 /LastChar 124 -/Widths 1958 0 R +/Widths 1959 0 R >> % 582 0 obj << /Type /Font /Subtype /Type1 /BaseFont /BWDLNI+CMBX12 -/FontDescriptor 1964 0 R +/FontDescriptor 1965 0 R /FirstChar 12 /LastChar 124 -/Widths 1960 0 R +/Widths 1961 0 R >> -% 1752 0 obj +% 1753 0 obj << /Type /Font /Subtype /Type1 /BaseFont /VUBHOM+CMBX9 -/FontDescriptor 1966 0 R +/FontDescriptor 1967 0 R /FirstChar 97 /LastChar 117 -/Widths 1942 0 R +/Widths 1943 0 R >> -% 1725 0 obj +% 1726 0 obj << /Type /Font /Subtype /Type1 /BaseFont /OUFNAH+CMEX10 -/FontDescriptor 1968 0 R +/FontDescriptor 1969 0 R /FirstChar 88 /LastChar 115 -/Widths 1943 0 R +/Widths 1944 0 R >> -% 796 0 obj +% 797 0 obj << /Type /Font /Subtype /Type1 /BaseFont /HKHZAC+CMMI10 -/FontDescriptor 1970 0 R +/FontDescriptor 1971 0 R /FirstChar 11 /LastChar 122 -/Widths 1955 0 R +/Widths 1956 0 R >> -% 844 0 obj +% 845 0 obj << /Type /Font /Subtype /Type1 /BaseFont /RVPZIX+CMMI5 -/FontDescriptor 1972 0 R +/FontDescriptor 1973 0 R /FirstChar 105 /LastChar 105 -/Widths 1948 0 R +/Widths 1949 0 R >> -% 812 0 obj +% 813 0 obj << /Type /Font /Subtype /Type1 /BaseFont /ZUYGVH+CMMI7 -/FontDescriptor 1974 0 R +/FontDescriptor 1975 0 R /FirstChar 59 /LastChar 110 -/Widths 1952 0 R +/Widths 1953 0 R >> -% 1910 0 obj +% 1911 0 obj << /Type /Font /Subtype /Type1 /BaseFont /ZOAUSA+CMMI8 -/FontDescriptor 1976 0 R +/FontDescriptor 1977 0 R /FirstChar 67 /LastChar 71 -/Widths 1941 0 R +/Widths 1942 0 R >> % 585 0 obj << /Type /Font /Subtype /Type1 /BaseFont /WUKOCR+CMR10 -/FontDescriptor 1978 0 R +/FontDescriptor 1979 0 R /FirstChar 11 /LastChar 124 -/Widths 1957 0 R +/Widths 1958 0 R +>> +% 815 0 obj +<< +/Type /Font +/Subtype /Type1 +/BaseFont /UJRPBG+CMR6 +/FontDescriptor 1981 0 R +/FirstChar 49 +/LastChar 53 +/Widths 1951 0 R +>> +% 812 0 obj +<< +/Type /Font +/Subtype /Type1 +/BaseFont /GIODUE+CMR7 +/FontDescriptor 1983 0 R +/FirstChar 48 +/LastChar 58 +/Widths 1954 0 R +>> +% 817 0 obj +<< +/Type /Font +/Subtype /Type1 +/BaseFont /HFTEUS+CMR8 +/FontDescriptor 1985 0 R +/FirstChar 40 +/LastChar 121 +/Widths 1950 0 R +>> +% 1301 0 obj +<< +/Type /Font +/Subtype /Type1 +/BaseFont /KKURMF+CMR9 +/FontDescriptor 1987 0 R +/FirstChar 39 +/LastChar 122 +/Widths 1945 0 R >> % 814 0 obj << /Type /Font /Subtype /Type1 -/BaseFont /UJRPBG+CMR6 -/FontDescriptor 1980 0 R -/FirstChar 49 -/LastChar 53 -/Widths 1950 0 R ->> -% 811 0 obj -<< -/Type /Font -/Subtype /Type1 -/BaseFont /GIODUE+CMR7 -/FontDescriptor 1982 0 R -/FirstChar 48 -/LastChar 58 -/Widths 1953 0 R ->> -% 816 0 obj -<< -/Type /Font -/Subtype /Type1 -/BaseFont /HFTEUS+CMR8 -/FontDescriptor 1984 0 R -/FirstChar 40 -/LastChar 121 -/Widths 1949 0 R ->> -% 1300 0 obj -<< -/Type /Font -/Subtype /Type1 -/BaseFont /KKURMF+CMR9 -/FontDescriptor 1986 0 R -/FirstChar 39 -/LastChar 122 -/Widths 1944 0 R ->> -% 813 0 obj -<< -/Type /Font -/Subtype /Type1 /BaseFont /IMOIOS+CMSY10 -/FontDescriptor 1988 0 R +/FontDescriptor 1989 0 R /FirstChar 0 /LastChar 120 -/Widths 1951 0 R +/Widths 1952 0 R >> -% 1170 0 obj +% 1171 0 obj << /Type /Font /Subtype /Type1 /BaseFont /XNLILI+CMSY7 -/FontDescriptor 1990 0 R +/FontDescriptor 1991 0 R /FirstChar 0 /LastChar 49 -/Widths 1945 0 R +/Widths 1946 0 R >> -% 776 0 obj +% 777 0 obj << /Type /Font /Subtype /Type1 /BaseFont /HBJLDT+CMTI10 -/FontDescriptor 1992 0 R +/FontDescriptor 1994 0 R /FirstChar 11 /LastChar 121 -/Widths 1956 0 R +/Widths 1957 0 R >> % 583 0 obj << /Type /Font /Subtype /Type1 /BaseFont /OZJPZO+CMTI12 -/FontDescriptor 1995 0 R +/FontDescriptor 1996 0 R /FirstChar 65 /LastChar 121 -/Widths 1959 0 R +/Widths 1960 0 R >> -% 810 0 obj +% 811 0 obj << /Type /Font /Subtype /Type1 /BaseFont /TJSMYH+CMTT10 -/FontDescriptor 1997 0 R +/FontDescriptor 1998 0 R /FirstChar 37 /LastChar 126 -/Widths 1954 0 R +/Widths 1955 0 R >> -% 872 0 obj +% 873 0 obj << /Type /Font /Subtype /Type1 /BaseFont /HZGQIC+CMTT8 -/FontDescriptor 1999 0 R +/FontDescriptor 2000 0 R /FirstChar 98 /LastChar 116 -/Widths 1947 0 R +/Widths 1948 0 R >> -% 1012 0 obj +% 1013 0 obj << /Type /Font /Subtype /Type1 /BaseFont /KMUHVJ+CMTT9 -/FontDescriptor 2001 0 R +/FontDescriptor 2002 0 R /FirstChar 40 /LastChar 121 -/Widths 1946 0 R +/Widths 1947 0 R >> % 586 0 obj << /Type /Pages /Count 6 -/Parent 2002 0 R -/Kids [577 0 R 588 0 R 635 0 R 692 0 R 738 0 R 758 0 R] +/Parent 2003 0 R +/Kids [577 0 R 588 0 R 635 0 R 692 0 R 737 0 R 758 0 R] >> -% 777 0 obj -<< -/Type /Pages -/Count 6 -/Parent 2002 0 R -/Kids [774 0 R 794 0 R 807 0 R 823 0 R 836 0 R 841 0 R] ->> -% 873 0 obj -<< -/Type /Pages -/Count 6 -/Parent 2002 0 R -/Kids [855 0 R 876 0 R 887 0 R 895 0 R 906 0 R 921 0 R] ->> -% 928 0 obj -<< -/Type /Pages -/Count 6 -/Parent 2002 0 R -/Kids [925 0 R 930 0 R 936 0 R 943 0 R 951 0 R 955 0 R] ->> -% 963 0 obj -<< -/Type /Pages -/Count 6 -/Parent 2002 0 R -/Kids [960 0 R 965 0 R 969 0 R 973 0 R 977 0 R 983 0 R] ->> -% 992 0 obj -<< -/Type /Pages -/Count 6 -/Parent 2002 0 R -/Kids [989 0 R 996 0 R 1003 0 R 1009 0 R 1014 0 R 1026 0 R] ->> -% 1035 0 obj +% 778 0 obj << /Type /Pages /Count 6 /Parent 2003 0 R -/Kids [1032 0 R 1042 0 R 1048 0 R 1064 0 R 1069 0 R 1076 0 R] +/Kids [775 0 R 795 0 R 808 0 R 824 0 R 837 0 R 842 0 R] >> -% 1090 0 obj +% 874 0 obj << /Type /Pages /Count 6 /Parent 2003 0 R -/Kids [1081 0 R 1095 0 R 1103 0 R 1108 0 R 1121 0 R 1127 0 R] +/Kids [856 0 R 877 0 R 888 0 R 896 0 R 907 0 R 922 0 R] >> -% 1138 0 obj +% 929 0 obj << /Type /Pages /Count 6 /Parent 2003 0 R -/Kids [1134 0 R 1140 0 R 1153 0 R 1160 0 R 1167 0 R 1178 0 R] +/Kids [926 0 R 931 0 R 937 0 R 944 0 R 952 0 R 956 0 R] >> -% 1196 0 obj +% 964 0 obj << /Type /Pages /Count 6 /Parent 2003 0 R -/Kids [1193 0 R 1200 0 R 1211 0 R 1217 0 R 1228 0 R 1234 0 R] +/Kids [961 0 R 966 0 R 970 0 R 974 0 R 978 0 R 984 0 R] >> -% 1249 0 obj +% 993 0 obj << /Type /Pages /Count 6 /Parent 2003 0 R -/Kids [1245 0 R 1251 0 R 1260 0 R 1266 0 R 1274 0 R 1284 0 R] +/Kids [990 0 R 997 0 R 1004 0 R 1010 0 R 1015 0 R 1027 0 R] >> -% 1301 0 obj -<< -/Type /Pages -/Count 6 -/Parent 2003 0 R -/Kids [1297 0 R 1306 0 R 1318 0 R 1326 0 R 1330 0 R 1345 0 R] ->> -% 1357 0 obj +% 1036 0 obj << /Type /Pages /Count 6 /Parent 2004 0 R -/Kids [1354 0 R 1361 0 R 1370 0 R 1374 0 R 1379 0 R 1385 0 R] +/Kids [1033 0 R 1043 0 R 1049 0 R 1065 0 R 1070 0 R 1077 0 R] >> -% 1398 0 obj +% 1091 0 obj << /Type /Pages /Count 6 /Parent 2004 0 R -/Kids [1390 0 R 1401 0 R 1406 0 R 1415 0 R 1422 0 R 1427 0 R] +/Kids [1082 0 R 1096 0 R 1104 0 R 1109 0 R 1122 0 R 1128 0 R] >> -% 1436 0 obj +% 1139 0 obj << /Type /Pages /Count 6 /Parent 2004 0 R -/Kids [1433 0 R 1438 0 R 1446 0 R 1454 0 R 1460 0 R 1470 0 R] +/Kids [1135 0 R 1141 0 R 1154 0 R 1161 0 R 1168 0 R 1179 0 R] >> -% 1485 0 obj +% 1197 0 obj << /Type /Pages /Count 6 /Parent 2004 0 R -/Kids [1482 0 R 1487 0 R 1499 0 R 1505 0 R 1512 0 R 1518 0 R] +/Kids [1194 0 R 1201 0 R 1212 0 R 1218 0 R 1229 0 R 1235 0 R] >> -% 1527 0 obj +% 1250 0 obj << /Type /Pages /Count 6 /Parent 2004 0 R -/Kids [1522 0 R 1532 0 R 1538 0 R 1542 0 R 1547 0 R 1551 0 R] +/Kids [1246 0 R 1252 0 R 1261 0 R 1267 0 R 1275 0 R 1285 0 R] >> -% 1561 0 obj +% 1302 0 obj << /Type /Pages /Count 6 /Parent 2004 0 R -/Kids [1558 0 R 1564 0 R 1571 0 R 1577 0 R 1583 0 R 1589 0 R] +/Kids [1298 0 R 1307 0 R 1319 0 R 1327 0 R 1331 0 R 1346 0 R] >> -% 1601 0 obj +% 1358 0 obj << /Type /Pages /Count 6 /Parent 2005 0 R -/Kids [1596 0 R 1604 0 R 1608 0 R 1618 0 R 1622 0 R 1626 0 R] +/Kids [1355 0 R 1362 0 R 1371 0 R 1375 0 R 1380 0 R 1386 0 R] >> -% 1642 0 obj +% 1399 0 obj << /Type /Pages /Count 6 /Parent 2005 0 R -/Kids [1639 0 R 1644 0 R 1650 0 R 1656 0 R 1663 0 R 1667 0 R] +/Kids [1391 0 R 1402 0 R 1407 0 R 1416 0 R 1423 0 R 1428 0 R] >> -% 1674 0 obj +% 1437 0 obj << /Type /Pages /Count 6 /Parent 2005 0 R -/Kids [1671 0 R 1677 0 R 1681 0 R 1685 0 R 1689 0 R 1695 0 R] +/Kids [1434 0 R 1439 0 R 1447 0 R 1455 0 R 1461 0 R 1471 0 R] >> -% 1706 0 obj +% 1486 0 obj << /Type /Pages /Count 6 /Parent 2005 0 R -/Kids [1701 0 R 1708 0 R 1714 0 R 1720 0 R 1728 0 R 1733 0 R] +/Kids [1483 0 R 1488 0 R 1500 0 R 1506 0 R 1513 0 R 1519 0 R] >> -% 1743 0 obj +% 1528 0 obj << /Type /Pages /Count 6 /Parent 2005 0 R -/Kids [1740 0 R 1747 0 R 1777 0 R 1784 0 R 1790 0 R 1796 0 R] +/Kids [1523 0 R 1533 0 R 1539 0 R 1543 0 R 1548 0 R 1552 0 R] >> -% 1805 0 obj +% 1562 0 obj << /Type /Pages /Count 6 /Parent 2005 0 R -/Kids [1802 0 R 1808 0 R 1815 0 R 1822 0 R 1828 0 R 1835 0 R] +/Kids [1559 0 R 1565 0 R 1572 0 R 1578 0 R 1584 0 R 1590 0 R] >> -% 1846 0 obj +% 1602 0 obj << /Type /Pages /Count 6 /Parent 2006 0 R -/Kids [1841 0 R 1848 0 R 1854 0 R 1863 0 R 1867 0 R 1875 0 R] +/Kids [1597 0 R 1605 0 R 1609 0 R 1619 0 R 1623 0 R 1627 0 R] >> -% 1883 0 obj +% 1643 0 obj << /Type /Pages /Count 6 /Parent 2006 0 R -/Kids [1880 0 R 1886 0 R 1892 0 R 1896 0 R 1903 0 R 1915 0 R] +/Kids [1640 0 R 1645 0 R 1651 0 R 1657 0 R 1664 0 R 1668 0 R] >> -% 1923 0 obj +% 1676 0 obj +<< +/Type /Pages +/Count 6 +/Parent 2006 0 R +/Kids [1672 0 R 1678 0 R 1682 0 R 1686 0 R 1690 0 R 1696 0 R] +>> +% 1707 0 obj +<< +/Type /Pages +/Count 6 +/Parent 2006 0 R +/Kids [1702 0 R 1709 0 R 1715 0 R 1721 0 R 1729 0 R 1734 0 R] +>> +% 1744 0 obj +<< +/Type /Pages +/Count 6 +/Parent 2006 0 R +/Kids [1741 0 R 1748 0 R 1778 0 R 1785 0 R 1791 0 R 1797 0 R] +>> +% 1806 0 obj +<< +/Type /Pages +/Count 6 +/Parent 2006 0 R +/Kids [1803 0 R 1809 0 R 1816 0 R 1823 0 R 1829 0 R 1836 0 R] +>> +% 1847 0 obj +<< +/Type /Pages +/Count 6 +/Parent 2007 0 R +/Kids [1842 0 R 1849 0 R 1855 0 R 1864 0 R 1868 0 R 1876 0 R] +>> +% 1884 0 obj +<< +/Type /Pages +/Count 6 +/Parent 2007 0 R +/Kids [1881 0 R 1887 0 R 1893 0 R 1897 0 R 1904 0 R 1916 0 R] +>> +% 1924 0 obj << /Type /Pages /Count 4 -/Parent 2006 0 R -/Kids [1920 0 R 1925 0 R 1929 0 R 1937 0 R] ->> -% 2002 0 obj -<< -/Type /Pages -/Count 36 /Parent 2007 0 R -/Kids [586 0 R 777 0 R 873 0 R 928 0 R 963 0 R 992 0 R] +/Kids [1921 0 R 1926 0 R 1930 0 R 1938 0 R] >> % 2003 0 obj << /Type /Pages /Count 36 -/Parent 2007 0 R -/Kids [1035 0 R 1090 0 R 1138 0 R 1196 0 R 1249 0 R 1301 0 R] +/Parent 2008 0 R +/Kids [586 0 R 778 0 R 874 0 R 929 0 R 964 0 R 993 0 R] >> % 2004 0 obj << /Type /Pages /Count 36 -/Parent 2007 0 R -/Kids [1357 0 R 1398 0 R 1436 0 R 1485 0 R 1527 0 R 1561 0 R] +/Parent 2008 0 R +/Kids [1036 0 R 1091 0 R 1139 0 R 1197 0 R 1250 0 R 1302 0 R] >> % 2005 0 obj << /Type /Pages /Count 36 -/Parent 2007 0 R -/Kids [1601 0 R 1642 0 R 1674 0 R 1706 0 R 1743 0 R 1805 0 R] +/Parent 2008 0 R +/Kids [1358 0 R 1399 0 R 1437 0 R 1486 0 R 1528 0 R 1562 0 R] >> % 2006 0 obj << /Type /Pages -/Count 16 -/Parent 2007 0 R -/Kids [1846 0 R 1883 0 R 1923 0 R] +/Count 36 +/Parent 2008 0 R +/Kids [1602 0 R 1643 0 R 1676 0 R 1707 0 R 1744 0 R 1806 0 R] >> % 2007 0 obj << /Type /Pages -/Count 160 -/Kids [2002 0 R 2003 0 R 2004 0 R 2005 0 R 2006 0 R] +/Count 16 +/Parent 2008 0 R +/Kids [1847 0 R 1884 0 R 1924 0 R] >> % 2008 0 obj << +/Type /Pages +/Count 160 +/Kids [2003 0 R 2004 0 R 2005 0 R 2006 0 R 2007 0 R] +>> +% 2009 0 obj +<< /Type /Outlines /First 4 0 R /Last 4 0 R @@ -28769,6 +28776,27 @@ stream /Parent 309 0 R /Prev 414 0 R >> + +endstream +endobj +2010 0 obj +<< +/Type /ObjStm +/N 100 +/First 864 +/Length 9605 +>> +stream +414 0 410 88 406 176 401 264 397 352 393 440 389 528 385 616 381 704 377 792 +373 880 369 968 365 1056 361 1144 357 1232 353 1320 349 1408 345 1496 341 1584 337 1672 +333 1760 329 1848 325 1936 321 2024 317 2112 313 2200 309 2274 305 2400 301 2474 297 2562 +293 2650 289 2724 285 2849 281 2923 277 3011 273 3099 269 3187 265 3275 261 3363 257 3451 +253 3539 249 3627 245 3715 241 3803 237 3891 233 3979 229 4067 225 4155 221 4229 217 4354 +213 4427 209 4514 205 4588 200 4676 196 4764 192 4852 188 4940 184 5014 180 5140 176 5214 +172 5302 168 5390 164 5478 160 5566 156 5654 152 5742 148 5830 144 5918 140 6006 136 6094 +132 6182 128 6270 124 6358 120 6446 116 6534 112 6622 108 6710 104 6784 100 6910 96 6981 +92 7064 88 7146 84 7228 80 7310 76 7392 72 7474 68 7556 64 7638 60 7720 56 7802 +52 7884 48 7966 44 8048 40 8117 36 8226 32 8346 28 8415 24 8471 20 8590 16 8672 % 414 0 obj << /Title 415 0 R @@ -28777,27 +28805,6 @@ stream /Prev 410 0 R /Next 418 0 R >> - -endstream -endobj -2009 0 obj -<< -/Type /ObjStm -/N 100 -/First 863 -/Length 9633 ->> -stream -410 0 406 88 401 176 397 264 393 352 389 440 385 528 381 616 377 704 373 792 -369 880 365 968 361 1056 357 1144 353 1232 349 1320 345 1408 341 1496 337 1584 333 1672 -329 1760 325 1848 321 1936 317 2024 313 2112 309 2186 305 2312 301 2386 297 2474 293 2562 -289 2636 285 2761 281 2835 277 2923 273 3011 269 3099 265 3187 261 3275 257 3363 253 3451 -249 3539 245 3627 241 3715 237 3803 233 3891 229 3979 225 4067 221 4141 217 4266 213 4339 -209 4426 205 4500 200 4588 196 4676 192 4764 188 4852 184 4926 180 5052 176 5126 172 5214 -168 5302 164 5390 160 5478 156 5566 152 5654 148 5742 144 5830 140 5918 136 6006 132 6094 -128 6182 124 6270 120 6358 116 6446 112 6534 108 6622 104 6696 100 6822 96 6893 92 6976 -88 7058 84 7140 80 7222 76 7304 72 7386 68 7468 64 7550 60 7632 56 7714 52 7796 -48 7878 44 7960 40 8029 36 8138 32 8258 28 8327 24 8383 20 8502 16 8584 12 8653 % 410 0 obj << /Title 411 0 R @@ -29597,6 +29604,27 @@ stream /Parent 12 0 R /Next 20 0 R >> + +endstream +endobj +2011 0 obj +<< +/Type /ObjStm +/N 100 +/First 1029 +/Length 20277 +>> +stream +12 0 8 117 4 182 2012 275 2013 471 2014 644 2015 824 2016 1001 2017 1178 2018 1358 +2019 1531 2020 1696 2021 1862 2022 2027 2023 2193 2024 2359 2025 2531 2026 2701 2027 2873 2028 3042 +2029 3211 2030 3383 2031 3553 2032 3725 2033 3895 2034 4067 2035 4250 2036 4460 2037 4674 2038 4878 +2039 5063 2040 5252 2041 5480 2042 5707 2043 5927 2044 6155 2045 6391 2046 6623 2047 6853 2048 7081 +2049 7309 2050 7543 2051 7777 2052 8011 2053 8239 2054 8412 2055 8592 2056 8769 2057 8946 2058 9126 +2059 9304 2060 9484 2061 9662 2062 9842 2063 10020 2064 10191 2065 10355 2066 10522 2067 10694 2068 10864 +2069 11036 2070 11206 2071 11378 2072 11548 2073 11720 2074 11890 2075 12062 2076 12231 2077 12400 2078 12572 +2079 12741 2080 12920 2081 13103 2082 13280 2083 13510 2084 13729 2085 13953 2086 14183 2087 14405 2088 14627 +2089 14855 2090 15083 2091 15313 2092 15538 2093 15763 2094 15993 2095 16215 2096 16437 2097 16659 2098 16920 +2099 17179 2100 17439 2101 17709 2102 17975 2103 18237 2104 18476 2105 18656 2106 18835 2107 19007 2108 19134 % 12 0 obj << /Title 13 0 R @@ -29608,27 +29636,6 @@ stream /Last 32 0 R /Count -4 >> - -endstream -endobj -2010 0 obj -<< -/Type /ObjStm -/N 100 -/First 1030 -/Length 20272 ->> -stream -8 0 4 65 2011 158 2012 354 2013 527 2014 707 2015 884 2016 1061 2017 1241 2018 1414 -2019 1579 2020 1745 2021 1910 2022 2076 2023 2242 2024 2414 2025 2584 2026 2756 2027 2925 2028 3094 -2029 3266 2030 3436 2031 3608 2032 3778 2033 3950 2034 4133 2035 4343 2036 4557 2037 4761 2038 4946 -2039 5135 2040 5363 2041 5590 2042 5810 2043 6038 2044 6274 2045 6506 2046 6736 2047 6964 2048 7192 -2049 7426 2050 7660 2051 7894 2052 8122 2053 8295 2054 8475 2055 8652 2056 8829 2057 9009 2058 9187 -2059 9367 2060 9545 2061 9725 2062 9903 2063 10074 2064 10238 2065 10405 2066 10577 2067 10747 2068 10919 -2069 11089 2070 11261 2071 11431 2072 11603 2073 11773 2074 11945 2075 12114 2076 12283 2077 12455 2078 12624 -2079 12803 2080 12986 2081 13163 2082 13393 2083 13612 2084 13836 2085 14066 2086 14288 2087 14510 2088 14738 -2089 14966 2090 15196 2091 15421 2092 15646 2093 15876 2094 16098 2095 16320 2096 16542 2097 16803 2098 17062 -2099 17322 2100 17592 2101 17858 2102 18120 2103 18358 2104 18538 2105 18717 2106 18889 2107 19016 2108 19130 % 8 0 obj << /Title 9 0 R @@ -29640,509 +29647,509 @@ stream << /Title 5 0 R /A 1 0 R -/Parent 2008 0 R +/Parent 2009 0 R /First 8 0 R /Last 570 0 R /Count -11 >> -% 2011 0 obj -<< -/Names [(Doc-Start) 581 0 R (Hfootnote.1) 815 0 R (Hfootnote.2) 817 0 R (Hfootnote.3) 871 0 R (Hfootnote.4) 1857 0 R (Hfootnote.5) 1909 0 R] -/Limits [(Doc-Start) (Hfootnote.5)] ->> % 2012 0 obj << -/Names [(Item.1) 845 0 R (Item.10) 859 0 R (Item.100) 1631 0 R (Item.101) 1632 0 R (Item.102) 1633 0 R (Item.103) 1634 0 R] -/Limits [(Item.1) (Item.103)] +/Names [(Doc-Start) 581 0 R (Hfootnote.1) 816 0 R (Hfootnote.2) 818 0 R (Hfootnote.3) 872 0 R (Hfootnote.4) 1858 0 R (Hfootnote.5) 1910 0 R] +/Limits [(Doc-Start) (Hfootnote.5)] >> % 2013 0 obj << -/Names [(Item.104) 1635 0 R (Item.105) 1636 0 R (Item.106) 1637 0 R (Item.107) 1647 0 R (Item.108) 1648 0 R (Item.109) 1653 0 R] -/Limits [(Item.104) (Item.109)] +/Names [(Item.1) 846 0 R (Item.10) 860 0 R (Item.100) 1632 0 R (Item.101) 1633 0 R (Item.102) 1634 0 R (Item.103) 1635 0 R] +/Limits [(Item.1) (Item.103)] >> % 2014 0 obj << -/Names [(Item.11) 860 0 R (Item.110) 1654 0 R (Item.111) 1659 0 R (Item.112) 1660 0 R (Item.113) 1661 0 R (Item.114) 1692 0 R] -/Limits [(Item.11) (Item.114)] +/Names [(Item.104) 1636 0 R (Item.105) 1637 0 R (Item.106) 1638 0 R (Item.107) 1648 0 R (Item.108) 1649 0 R (Item.109) 1654 0 R] +/Limits [(Item.104) (Item.109)] >> % 2015 0 obj << -/Names [(Item.115) 1693 0 R (Item.116) 1698 0 R (Item.117) 1699 0 R (Item.118) 1704 0 R (Item.119) 1705 0 R (Item.12) 861 0 R] -/Limits [(Item.115) (Item.12)] +/Names [(Item.11) 861 0 R (Item.110) 1655 0 R (Item.111) 1660 0 R (Item.112) 1661 0 R (Item.113) 1662 0 R (Item.114) 1693 0 R] +/Limits [(Item.11) (Item.114)] >> % 2016 0 obj << -/Names [(Item.120) 1711 0 R (Item.121) 1712 0 R (Item.122) 1717 0 R (Item.123) 1718 0 R (Item.124) 1723 0 R (Item.125) 1724 0 R] -/Limits [(Item.120) (Item.125)] +/Names [(Item.115) 1694 0 R (Item.116) 1699 0 R (Item.117) 1700 0 R (Item.118) 1705 0 R (Item.119) 1706 0 R (Item.12) 862 0 R] +/Limits [(Item.115) (Item.12)] >> % 2017 0 obj << -/Names [(Item.126) 1726 0 R (Item.127) 1731 0 R (Item.128) 1736 0 R (Item.13) 862 0 R (Item.14) 863 0 R (Item.15) 864 0 R] -/Limits [(Item.126) (Item.15)] +/Names [(Item.120) 1712 0 R (Item.121) 1713 0 R (Item.122) 1718 0 R (Item.123) 1719 0 R (Item.124) 1724 0 R (Item.125) 1725 0 R] +/Limits [(Item.120) (Item.125)] >> % 2018 0 obj << -/Names [(Item.16) 865 0 R (Item.17) 866 0 R (Item.18) 867 0 R (Item.19) 868 0 R (Item.2) 846 0 R (Item.20) 869 0 R] -/Limits [(Item.16) (Item.20)] +/Names [(Item.126) 1727 0 R (Item.127) 1732 0 R (Item.128) 1737 0 R (Item.13) 863 0 R (Item.14) 864 0 R (Item.15) 865 0 R] +/Limits [(Item.126) (Item.15)] >> % 2019 0 obj << -/Names [(Item.21) 870 0 R (Item.22) 879 0 R (Item.23) 880 0 R (Item.24) 881 0 R (Item.25) 882 0 R (Item.26) 883 0 R] -/Limits [(Item.21) (Item.26)] +/Names [(Item.16) 866 0 R (Item.17) 867 0 R (Item.18) 868 0 R (Item.19) 869 0 R (Item.2) 847 0 R (Item.20) 870 0 R] +/Limits [(Item.16) (Item.20)] >> % 2020 0 obj << -/Names [(Item.27) 884 0 R (Item.28) 898 0 R (Item.29) 899 0 R (Item.3) 847 0 R (Item.30) 900 0 R (Item.31) 901 0 R] -/Limits [(Item.27) (Item.31)] +/Names [(Item.21) 871 0 R (Item.22) 880 0 R (Item.23) 881 0 R (Item.24) 882 0 R (Item.25) 883 0 R (Item.26) 884 0 R] +/Limits [(Item.21) (Item.26)] >> % 2021 0 obj << -/Names [(Item.32) 902 0 R (Item.33) 909 0 R (Item.34) 910 0 R (Item.35) 911 0 R (Item.36) 912 0 R (Item.37) 913 0 R] -/Limits [(Item.32) (Item.37)] +/Names [(Item.27) 885 0 R (Item.28) 899 0 R (Item.29) 900 0 R (Item.3) 848 0 R (Item.30) 901 0 R (Item.31) 902 0 R] +/Limits [(Item.27) (Item.31)] >> % 2022 0 obj << -/Names [(Item.38) 914 0 R (Item.39) 915 0 R (Item.4) 848 0 R (Item.40) 916 0 R (Item.41) 958 0 R (Item.42) 1051 0 R] -/Limits [(Item.38) (Item.42)] +/Names [(Item.32) 903 0 R (Item.33) 910 0 R (Item.34) 911 0 R (Item.35) 912 0 R (Item.36) 913 0 R (Item.37) 914 0 R] +/Limits [(Item.32) (Item.37)] >> % 2023 0 obj << -/Names [(Item.43) 1084 0 R (Item.44) 1111 0 R (Item.45) 1143 0 R (Item.46) 1321 0 R (Item.47) 1322 0 R (Item.48) 1323 0 R] -/Limits [(Item.43) (Item.48)] +/Names [(Item.38) 915 0 R (Item.39) 916 0 R (Item.4) 849 0 R (Item.40) 917 0 R (Item.41) 959 0 R (Item.42) 1052 0 R] +/Limits [(Item.38) (Item.42)] >> % 2024 0 obj << -/Names [(Item.49) 1382 0 R (Item.5) 849 0 R (Item.50) 1388 0 R (Item.51) 1393 0 R (Item.52) 1394 0 R (Item.53) 1395 0 R] -/Limits [(Item.49) (Item.53)] +/Names [(Item.43) 1085 0 R (Item.44) 1112 0 R (Item.45) 1144 0 R (Item.46) 1322 0 R (Item.47) 1323 0 R (Item.48) 1324 0 R] +/Limits [(Item.43) (Item.48)] >> % 2025 0 obj << -/Names [(Item.54) 1396 0 R (Item.55) 1397 0 R (Item.56) 1409 0 R (Item.57) 1410 0 R (Item.58) 1411 0 R (Item.59) 1418 0 R] -/Limits [(Item.54) (Item.59)] +/Names [(Item.49) 1383 0 R (Item.5) 850 0 R (Item.50) 1389 0 R (Item.51) 1394 0 R (Item.52) 1395 0 R (Item.53) 1396 0 R] +/Limits [(Item.49) (Item.53)] >> % 2026 0 obj << -/Names [(Item.6) 850 0 R (Item.60) 1441 0 R (Item.61) 1442 0 R (Item.62) 1449 0 R (Item.63) 1450 0 R (Item.64) 1451 0 R] -/Limits [(Item.6) (Item.64)] +/Names [(Item.54) 1397 0 R (Item.55) 1398 0 R (Item.56) 1410 0 R (Item.57) 1411 0 R (Item.58) 1412 0 R (Item.59) 1419 0 R] +/Limits [(Item.54) (Item.59)] >> % 2027 0 obj << -/Names [(Item.65) 1463 0 R (Item.66) 1464 0 R (Item.67) 1465 0 R (Item.68) 1466 0 R (Item.69) 1467 0 R (Item.7) 851 0 R] -/Limits [(Item.65) (Item.7)] +/Names [(Item.6) 851 0 R (Item.60) 1442 0 R (Item.61) 1443 0 R (Item.62) 1450 0 R (Item.63) 1451 0 R (Item.64) 1452 0 R] +/Limits [(Item.6) (Item.64)] >> % 2028 0 obj << -/Names [(Item.70) 1473 0 R (Item.71) 1474 0 R (Item.72) 1475 0 R (Item.73) 1476 0 R (Item.74) 1477 0 R (Item.75) 1478 0 R] -/Limits [(Item.70) (Item.75)] +/Names [(Item.65) 1464 0 R (Item.66) 1465 0 R (Item.67) 1466 0 R (Item.68) 1467 0 R (Item.69) 1468 0 R (Item.7) 852 0 R] +/Limits [(Item.65) (Item.7)] >> % 2029 0 obj << -/Names [(Item.76) 1490 0 R (Item.77) 1491 0 R (Item.78) 1492 0 R (Item.79) 1493 0 R (Item.8) 852 0 R (Item.80) 1494 0 R] -/Limits [(Item.76) (Item.80)] +/Names [(Item.70) 1474 0 R (Item.71) 1475 0 R (Item.72) 1476 0 R (Item.73) 1477 0 R (Item.74) 1478 0 R (Item.75) 1479 0 R] +/Limits [(Item.70) (Item.75)] >> % 2030 0 obj << -/Names [(Item.81) 1495 0 R (Item.82) 1508 0 R (Item.83) 1525 0 R (Item.84) 1526 0 R (Item.85) 1554 0 R (Item.86) 1555 0 R] -/Limits [(Item.81) (Item.86)] +/Names [(Item.76) 1491 0 R (Item.77) 1492 0 R (Item.78) 1493 0 R (Item.79) 1494 0 R (Item.8) 853 0 R (Item.80) 1495 0 R] +/Limits [(Item.76) (Item.80)] >> % 2031 0 obj << -/Names [(Item.87) 1567 0 R (Item.88) 1574 0 R (Item.89) 1580 0 R (Item.9) 858 0 R (Item.90) 1586 0 R (Item.91) 1592 0 R] -/Limits [(Item.87) (Item.91)] +/Names [(Item.81) 1496 0 R (Item.82) 1509 0 R (Item.83) 1526 0 R (Item.84) 1527 0 R (Item.85) 1555 0 R (Item.86) 1556 0 R] +/Limits [(Item.81) (Item.86)] >> % 2032 0 obj << -/Names [(Item.92) 1593 0 R (Item.93) 1599 0 R (Item.94) 1600 0 R (Item.95) 1611 0 R (Item.96) 1612 0 R (Item.97) 1613 0 R] -/Limits [(Item.92) (Item.97)] +/Names [(Item.87) 1568 0 R (Item.88) 1575 0 R (Item.89) 1581 0 R (Item.9) 859 0 R (Item.90) 1587 0 R (Item.91) 1593 0 R] +/Limits [(Item.87) (Item.91)] >> % 2033 0 obj << -/Names [(Item.98) 1629 0 R (Item.99) 1630 0 R (cite.2007c) 830 0 R (cite.2007d) 831 0 R (cite.BLACS) 803 0 R (cite.BLAS1) 785 0 R] -/Limits [(Item.98) (cite.BLAS1)] +/Names [(Item.92) 1594 0 R (Item.93) 1600 0 R (Item.94) 1601 0 R (Item.95) 1612 0 R (Item.96) 1613 0 R (Item.97) 1614 0 R] +/Limits [(Item.92) (Item.97)] >> % 2034 0 obj << -/Names [(cite.BLAS2) 786 0 R (cite.BLAS3) 787 0 R (cite.DesPat:11) 780 0 R (cite.DesignPatterns) 948 0 R (cite.KIVA3PSBLAS) 1935 0 R (cite.METIS) 818 0 R] -/Limits [(cite.BLAS2) (cite.METIS)] +/Names [(Item.98) 1630 0 R (Item.99) 1631 0 R (cite.2007c) 831 0 R (cite.2007d) 833 0 R (cite.BLACS) 804 0 R (cite.BLAS1) 786 0 R] +/Limits [(Item.98) (cite.BLAS1)] >> % 2035 0 obj << -/Names [(cite.MPI1) 1940 0 R (cite.PARA04FOREST) 1933 0 R (cite.PSBLAS) 1934 0 R (cite.RouXiaXu:11) 781 0 R (cite.Sparse03) 779 0 R (cite.machiels) 782 0 R] -/Limits [(cite.MPI1) (cite.machiels)] +/Names [(cite.BLAS2) 787 0 R (cite.BLAS3) 788 0 R (cite.DesPat:11) 781 0 R (cite.DesignPatterns) 949 0 R (cite.KIVA3PSBLAS) 1936 0 R (cite.METIS) 819 0 R] +/Limits [(cite.BLAS2) (cite.METIS)] >> % 2036 0 obj << -/Names [(cite.metcalf) 778 0 R (cite.sblas02) 784 0 R (cite.sblas97) 783 0 R (descdata) 890 0 R (equation.4.1) 1181 0 R (equation.4.2) 1182 0 R] -/Limits [(cite.metcalf) (equation.4.2)] +/Names [(cite.MPI1) 1941 0 R (cite.PARA04FOREST) 1934 0 R (cite.PSBLAS) 1935 0 R (cite.RouXiaXu:11) 782 0 R (cite.Sparse03) 780 0 R (cite.machiels) 783 0 R] +/Limits [(cite.MPI1) (cite.machiels)] >> % 2037 0 obj << -/Names [(equation.4.3) 1183 0 R (figure.1) 797 0 R (figure.10) 1745 0 R (figure.2) 826 0 R (figure.3) 917 0 R (figure.4) 949 0 R] -/Limits [(equation.4.3) (figure.4)] +/Names [(cite.metcalf) 779 0 R (cite.sblas02) 785 0 R (cite.sblas97) 784 0 R (descdata) 891 0 R (equation.4.1) 1182 0 R (equation.4.2) 1183 0 R] +/Limits [(cite.metcalf) (equation.4.2)] >> % 2038 0 obj << -/Names [(figure.5) 987 0 R (figure.6) 1007 0 R (figure.7) 1287 0 R (figure.8) 1324 0 R (figure.9) 1744 0 R (lstlisting.-1) 1052 0 R] -/Limits [(figure.5) (lstlisting.-1)] +/Names [(equation.4.3) 1184 0 R (figure.1) 798 0 R (figure.10) 1746 0 R (figure.2) 827 0 R (figure.3) 918 0 R (figure.4) 950 0 R] +/Limits [(equation.4.3) (figure.4)] >> % 2039 0 obj << -/Names [(lstlisting.-10) 1780 0 R (lstlisting.-11) 1787 0 R (lstlisting.-12) 1793 0 R (lstlisting.-13) 1799 0 R (lstlisting.-14) 1811 0 R (lstlisting.-15) 1818 0 R] -/Limits [(lstlisting.-10) (lstlisting.-15)] +/Names [(figure.5) 988 0 R (figure.6) 1008 0 R (figure.7) 1288 0 R (figure.8) 1325 0 R (figure.9) 1745 0 R (lstlisting.-1) 1053 0 R] +/Limits [(figure.5) (lstlisting.-1)] >> % 2040 0 obj << -/Names [(lstlisting.-16) 1825 0 R (lstlisting.-17) 1831 0 R (lstlisting.-18) 1838 0 R (lstlisting.-19) 1844 0 R (lstlisting.-2) 1085 0 R (lstlisting.-20) 1906 0 R] -/Limits [(lstlisting.-16) (lstlisting.-20)] +/Names [(lstlisting.-10) 1781 0 R (lstlisting.-11) 1788 0 R (lstlisting.-12) 1794 0 R (lstlisting.-13) 1800 0 R (lstlisting.-14) 1812 0 R (lstlisting.-15) 1819 0 R] +/Limits [(lstlisting.-10) (lstlisting.-15)] >> % 2041 0 obj << -/Names [(lstlisting.-3) 1112 0 R (lstlisting.-4) 1144 0 R (lstlisting.-5) 1278 0 R (lstlisting.-6) 1310 0 R (lstlisting.-7) 1349 0 R (lstlisting.-8) 1365 0 R] -/Limits [(lstlisting.-3) (lstlisting.-8)] +/Names [(lstlisting.-16) 1826 0 R (lstlisting.-17) 1832 0 R (lstlisting.-18) 1839 0 R (lstlisting.-19) 1845 0 R (lstlisting.-2) 1086 0 R (lstlisting.-20) 1907 0 R] +/Limits [(lstlisting.-16) (lstlisting.-20)] >> % 2042 0 obj << -/Names [(lstlisting.-9) 1750 0 R (lstnumber.-1.1) 1053 0 R (lstnumber.-1.2) 1054 0 R (lstnumber.-1.3) 1055 0 R (lstnumber.-1.4) 1056 0 R (lstnumber.-10.1) 1781 0 R] -/Limits [(lstlisting.-9) (lstnumber.-10.1)] +/Names [(lstlisting.-3) 1113 0 R (lstlisting.-4) 1145 0 R (lstlisting.-5) 1279 0 R (lstlisting.-6) 1311 0 R (lstlisting.-7) 1350 0 R (lstlisting.-8) 1366 0 R] +/Limits [(lstlisting.-3) (lstlisting.-8)] >> % 2043 0 obj << -/Names [(lstnumber.-11.1) 1788 0 R (lstnumber.-12.1) 1794 0 R (lstnumber.-13.1) 1800 0 R (lstnumber.-14.1) 1812 0 R (lstnumber.-15.1) 1819 0 R (lstnumber.-16.1) 1826 0 R] -/Limits [(lstnumber.-11.1) (lstnumber.-16.1)] +/Names [(lstlisting.-9) 1751 0 R (lstnumber.-1.1) 1054 0 R (lstnumber.-1.2) 1055 0 R (lstnumber.-1.3) 1056 0 R (lstnumber.-1.4) 1057 0 R (lstnumber.-10.1) 1782 0 R] +/Limits [(lstlisting.-9) (lstnumber.-10.1)] >> % 2044 0 obj << -/Names [(lstnumber.-17.1) 1832 0 R (lstnumber.-18.1) 1839 0 R (lstnumber.-19.1) 1845 0 R (lstnumber.-2.1) 1086 0 R (lstnumber.-2.2) 1087 0 R (lstnumber.-2.3) 1088 0 R] -/Limits [(lstnumber.-17.1) (lstnumber.-2.3)] +/Names [(lstnumber.-11.1) 1789 0 R (lstnumber.-12.1) 1795 0 R (lstnumber.-13.1) 1801 0 R (lstnumber.-14.1) 1813 0 R (lstnumber.-15.1) 1820 0 R (lstnumber.-16.1) 1827 0 R] +/Limits [(lstnumber.-11.1) (lstnumber.-16.1)] >> % 2045 0 obj << -/Names [(lstnumber.-2.4) 1089 0 R (lstnumber.-20.1) 1907 0 R (lstnumber.-20.2) 1908 0 R (lstnumber.-3.1) 1113 0 R (lstnumber.-3.2) 1114 0 R (lstnumber.-3.3) 1115 0 R] -/Limits [(lstnumber.-2.4) (lstnumber.-3.3)] +/Names [(lstnumber.-17.1) 1833 0 R (lstnumber.-18.1) 1840 0 R (lstnumber.-19.1) 1846 0 R (lstnumber.-2.1) 1087 0 R (lstnumber.-2.2) 1088 0 R (lstnumber.-2.3) 1089 0 R] +/Limits [(lstnumber.-17.1) (lstnumber.-2.3)] >> % 2046 0 obj << -/Names [(lstnumber.-3.4) 1116 0 R (lstnumber.-4.1) 1145 0 R (lstnumber.-4.2) 1146 0 R (lstnumber.-4.3) 1147 0 R (lstnumber.-4.4) 1148 0 R (lstnumber.-5.1) 1279 0 R] -/Limits [(lstnumber.-3.4) (lstnumber.-5.1)] +/Names [(lstnumber.-2.4) 1090 0 R (lstnumber.-20.1) 1908 0 R (lstnumber.-20.2) 1909 0 R (lstnumber.-3.1) 1114 0 R (lstnumber.-3.2) 1115 0 R (lstnumber.-3.3) 1116 0 R] +/Limits [(lstnumber.-2.4) (lstnumber.-3.3)] >> % 2047 0 obj << -/Names [(lstnumber.-5.2) 1280 0 R (lstnumber.-6.1) 1311 0 R (lstnumber.-6.2) 1312 0 R (lstnumber.-7.1) 1350 0 R (lstnumber.-7.2) 1351 0 R (lstnumber.-8.1) 1366 0 R] -/Limits [(lstnumber.-5.2) (lstnumber.-8.1)] +/Names [(lstnumber.-3.4) 1117 0 R (lstnumber.-4.1) 1146 0 R (lstnumber.-4.2) 1147 0 R (lstnumber.-4.3) 1148 0 R (lstnumber.-4.4) 1149 0 R (lstnumber.-5.1) 1280 0 R] +/Limits [(lstnumber.-3.4) (lstnumber.-5.1)] >> % 2048 0 obj << -/Names [(lstnumber.-9.1) 1751 0 R (lstnumber.-9.10) 1761 0 R (lstnumber.-9.11) 1762 0 R (lstnumber.-9.12) 1763 0 R (lstnumber.-9.13) 1764 0 R (lstnumber.-9.14) 1765 0 R] -/Limits [(lstnumber.-9.1) (lstnumber.-9.14)] +/Names [(lstnumber.-5.2) 1281 0 R (lstnumber.-6.1) 1312 0 R (lstnumber.-6.2) 1313 0 R (lstnumber.-7.1) 1351 0 R (lstnumber.-7.2) 1352 0 R (lstnumber.-8.1) 1367 0 R] +/Limits [(lstnumber.-5.2) (lstnumber.-8.1)] >> % 2049 0 obj << -/Names [(lstnumber.-9.15) 1766 0 R (lstnumber.-9.16) 1767 0 R (lstnumber.-9.17) 1768 0 R (lstnumber.-9.18) 1769 0 R (lstnumber.-9.19) 1770 0 R (lstnumber.-9.2) 1753 0 R] -/Limits [(lstnumber.-9.15) (lstnumber.-9.2)] +/Names [(lstnumber.-9.1) 1752 0 R (lstnumber.-9.10) 1762 0 R (lstnumber.-9.11) 1763 0 R (lstnumber.-9.12) 1764 0 R (lstnumber.-9.13) 1765 0 R (lstnumber.-9.14) 1766 0 R] +/Limits [(lstnumber.-9.1) (lstnumber.-9.14)] >> % 2050 0 obj << -/Names [(lstnumber.-9.20) 1771 0 R (lstnumber.-9.21) 1772 0 R (lstnumber.-9.22) 1773 0 R (lstnumber.-9.23) 1774 0 R (lstnumber.-9.24) 1775 0 R (lstnumber.-9.3) 1754 0 R] -/Limits [(lstnumber.-9.20) (lstnumber.-9.3)] +/Names [(lstnumber.-9.15) 1767 0 R (lstnumber.-9.16) 1768 0 R (lstnumber.-9.17) 1769 0 R (lstnumber.-9.18) 1770 0 R (lstnumber.-9.19) 1771 0 R (lstnumber.-9.2) 1754 0 R] +/Limits [(lstnumber.-9.15) (lstnumber.-9.2)] >> % 2051 0 obj << -/Names [(lstnumber.-9.4) 1755 0 R (lstnumber.-9.5) 1756 0 R (lstnumber.-9.6) 1757 0 R (lstnumber.-9.7) 1758 0 R (lstnumber.-9.8) 1759 0 R (lstnumber.-9.9) 1760 0 R] -/Limits [(lstnumber.-9.4) (lstnumber.-9.9)] +/Names [(lstnumber.-9.20) 1772 0 R (lstnumber.-9.21) 1773 0 R (lstnumber.-9.22) 1774 0 R (lstnumber.-9.23) 1775 0 R (lstnumber.-9.24) 1776 0 R (lstnumber.-9.3) 1755 0 R] +/Limits [(lstnumber.-9.20) (lstnumber.-9.3)] >> % 2052 0 obj << -/Names [(page.1) 580 0 R (page.10) 897 0 R (page.100) 1579 0 R (page.101) 1585 0 R (page.102) 1591 0 R (page.103) 1598 0 R] -/Limits [(page.1) (page.103)] +/Names [(lstnumber.-9.4) 1756 0 R (lstnumber.-9.5) 1757 0 R (lstnumber.-9.6) 1758 0 R (lstnumber.-9.7) 1759 0 R (lstnumber.-9.8) 1760 0 R (lstnumber.-9.9) 1761 0 R] +/Limits [(lstnumber.-9.4) (lstnumber.-9.9)] >> % 2053 0 obj << -/Names [(page.104) 1606 0 R (page.105) 1610 0 R (page.106) 1620 0 R (page.107) 1624 0 R (page.108) 1628 0 R (page.109) 1641 0 R] -/Limits [(page.104) (page.109)] +/Names [(page.1) 580 0 R (page.10) 898 0 R (page.100) 1580 0 R (page.101) 1586 0 R (page.102) 1592 0 R (page.103) 1599 0 R] +/Limits [(page.1) (page.103)] >> % 2054 0 obj << -/Names [(page.11) 908 0 R (page.110) 1646 0 R (page.111) 1652 0 R (page.112) 1658 0 R (page.113) 1665 0 R (page.114) 1669 0 R] -/Limits [(page.11) (page.114)] +/Names [(page.104) 1607 0 R (page.105) 1611 0 R (page.106) 1621 0 R (page.107) 1625 0 R (page.108) 1629 0 R (page.109) 1642 0 R] +/Limits [(page.104) (page.109)] >> % 2055 0 obj << -/Names [(page.115) 1673 0 R (page.116) 1679 0 R (page.117) 1683 0 R (page.118) 1687 0 R (page.119) 1691 0 R (page.12) 923 0 R] -/Limits [(page.115) (page.12)] +/Names [(page.11) 909 0 R (page.110) 1647 0 R (page.111) 1653 0 R (page.112) 1659 0 R (page.113) 1666 0 R (page.114) 1670 0 R] +/Limits [(page.11) (page.114)] >> % 2056 0 obj << -/Names [(page.120) 1697 0 R (page.121) 1703 0 R (page.122) 1710 0 R (page.123) 1716 0 R (page.124) 1722 0 R (page.125) 1730 0 R] -/Limits [(page.120) (page.125)] +/Names [(page.115) 1674 0 R (page.116) 1680 0 R (page.117) 1684 0 R (page.118) 1688 0 R (page.119) 1692 0 R (page.12) 924 0 R] +/Limits [(page.115) (page.12)] >> % 2057 0 obj << -/Names [(page.126) 1735 0 R (page.127) 1742 0 R (page.128) 1749 0 R (page.129) 1779 0 R (page.13) 927 0 R (page.130) 1786 0 R] -/Limits [(page.126) (page.130)] +/Names [(page.120) 1698 0 R (page.121) 1704 0 R (page.122) 1711 0 R (page.123) 1717 0 R (page.124) 1723 0 R (page.125) 1731 0 R] +/Limits [(page.120) (page.125)] >> % 2058 0 obj << -/Names [(page.131) 1792 0 R (page.132) 1798 0 R (page.133) 1804 0 R (page.134) 1810 0 R (page.135) 1817 0 R (page.136) 1824 0 R] -/Limits [(page.131) (page.136)] +/Names [(page.126) 1736 0 R (page.127) 1743 0 R (page.128) 1750 0 R (page.129) 1780 0 R (page.13) 928 0 R (page.130) 1787 0 R] +/Limits [(page.126) (page.130)] >> % 2059 0 obj << -/Names [(page.137) 1830 0 R (page.138) 1837 0 R (page.139) 1843 0 R (page.14) 932 0 R (page.140) 1850 0 R (page.141) 1856 0 R] -/Limits [(page.137) (page.141)] +/Names [(page.131) 1793 0 R (page.132) 1799 0 R (page.133) 1805 0 R (page.134) 1811 0 R (page.135) 1818 0 R (page.136) 1825 0 R] +/Limits [(page.131) (page.136)] >> % 2060 0 obj << -/Names [(page.142) 1865 0 R (page.143) 1869 0 R (page.144) 1877 0 R (page.145) 1882 0 R (page.146) 1888 0 R (page.147) 1894 0 R] -/Limits [(page.142) (page.147)] +/Names [(page.137) 1831 0 R (page.138) 1838 0 R (page.139) 1844 0 R (page.14) 933 0 R (page.140) 1851 0 R (page.141) 1857 0 R] +/Limits [(page.137) (page.141)] >> % 2061 0 obj << -/Names [(page.148) 1898 0 R (page.149) 1905 0 R (page.15) 938 0 R (page.150) 1917 0 R (page.151) 1922 0 R (page.152) 1927 0 R] -/Limits [(page.148) (page.152)] +/Names [(page.142) 1866 0 R (page.143) 1870 0 R (page.144) 1878 0 R (page.145) 1883 0 R (page.146) 1889 0 R (page.147) 1895 0 R] +/Limits [(page.142) (page.147)] >> % 2062 0 obj << -/Names [(page.153) 1931 0 R (page.154) 1939 0 R (page.16) 945 0 R (page.17) 953 0 R (page.18) 957 0 R (page.19) 962 0 R] -/Limits [(page.153) (page.19)] +/Names [(page.148) 1899 0 R (page.149) 1906 0 R (page.15) 939 0 R (page.150) 1918 0 R (page.151) 1923 0 R (page.152) 1928 0 R] +/Limits [(page.148) (page.152)] >> % 2063 0 obj << -/Names [(page.2) 590 0 R (page.20) 967 0 R (page.21) 971 0 R (page.22) 975 0 R (page.23) 979 0 R (page.24) 985 0 R] -/Limits [(page.2) (page.24)] +/Names [(page.153) 1932 0 R (page.154) 1940 0 R (page.16) 946 0 R (page.17) 954 0 R (page.18) 958 0 R (page.19) 963 0 R] +/Limits [(page.153) (page.19)] >> % 2064 0 obj << -/Names [(page.25) 991 0 R (page.26) 998 0 R (page.27) 1005 0 R (page.28) 1011 0 R (page.29) 1016 0 R (page.3) 809 0 R] -/Limits [(page.25) (page.3)] +/Names [(page.2) 590 0 R (page.20) 968 0 R (page.21) 972 0 R (page.22) 976 0 R (page.23) 980 0 R (page.24) 986 0 R] +/Limits [(page.2) (page.24)] >> % 2065 0 obj << -/Names [(page.30) 1028 0 R (page.31) 1034 0 R (page.32) 1044 0 R (page.33) 1050 0 R (page.34) 1066 0 R (page.35) 1071 0 R] -/Limits [(page.30) (page.35)] +/Names [(page.25) 992 0 R (page.26) 999 0 R (page.27) 1006 0 R (page.28) 1012 0 R (page.29) 1017 0 R (page.3) 810 0 R] +/Limits [(page.25) (page.3)] >> % 2066 0 obj << -/Names [(page.36) 1078 0 R (page.37) 1083 0 R (page.38) 1097 0 R (page.39) 1105 0 R (page.4) 825 0 R (page.40) 1110 0 R] -/Limits [(page.36) (page.40)] +/Names [(page.30) 1029 0 R (page.31) 1035 0 R (page.32) 1045 0 R (page.33) 1051 0 R (page.34) 1067 0 R (page.35) 1072 0 R] +/Limits [(page.30) (page.35)] >> % 2067 0 obj << -/Names [(page.41) 1123 0 R (page.42) 1129 0 R (page.43) 1136 0 R (page.44) 1142 0 R (page.45) 1155 0 R (page.46) 1162 0 R] -/Limits [(page.41) (page.46)] +/Names [(page.36) 1079 0 R (page.37) 1084 0 R (page.38) 1098 0 R (page.39) 1106 0 R (page.4) 826 0 R (page.40) 1111 0 R] +/Limits [(page.36) (page.40)] >> % 2068 0 obj << -/Names [(page.47) 1169 0 R (page.48) 1180 0 R (page.49) 1195 0 R (page.5) 838 0 R (page.50) 1202 0 R (page.51) 1213 0 R] -/Limits [(page.47) (page.51)] +/Names [(page.41) 1124 0 R (page.42) 1130 0 R (page.43) 1137 0 R (page.44) 1143 0 R (page.45) 1156 0 R (page.46) 1163 0 R] +/Limits [(page.41) (page.46)] >> % 2069 0 obj << -/Names [(page.52) 1219 0 R (page.53) 1230 0 R (page.54) 1236 0 R (page.55) 1247 0 R (page.56) 1253 0 R (page.57) 1262 0 R] -/Limits [(page.52) (page.57)] +/Names [(page.47) 1170 0 R (page.48) 1181 0 R (page.49) 1196 0 R (page.5) 839 0 R (page.50) 1203 0 R (page.51) 1214 0 R] +/Limits [(page.47) (page.51)] >> % 2070 0 obj << -/Names [(page.58) 1268 0 R (page.59) 1276 0 R (page.6) 843 0 R (page.60) 1286 0 R (page.61) 1299 0 R (page.62) 1308 0 R] -/Limits [(page.58) (page.62)] +/Names [(page.52) 1220 0 R (page.53) 1231 0 R (page.54) 1237 0 R (page.55) 1248 0 R (page.56) 1254 0 R (page.57) 1263 0 R] +/Limits [(page.52) (page.57)] >> % 2071 0 obj << -/Names [(page.63) 1320 0 R (page.64) 1328 0 R (page.65) 1332 0 R (page.66) 1347 0 R (page.67) 1356 0 R (page.68) 1363 0 R] -/Limits [(page.63) (page.68)] +/Names [(page.58) 1269 0 R (page.59) 1277 0 R (page.6) 844 0 R (page.60) 1287 0 R (page.61) 1300 0 R (page.62) 1309 0 R] +/Limits [(page.58) (page.62)] >> % 2072 0 obj << -/Names [(page.69) 1372 0 R (page.7) 857 0 R (page.70) 1376 0 R (page.71) 1381 0 R (page.72) 1387 0 R (page.73) 1392 0 R] -/Limits [(page.69) (page.73)] +/Names [(page.63) 1321 0 R (page.64) 1329 0 R (page.65) 1333 0 R (page.66) 1348 0 R (page.67) 1357 0 R (page.68) 1364 0 R] +/Limits [(page.63) (page.68)] >> % 2073 0 obj << -/Names [(page.74) 1403 0 R (page.75) 1408 0 R (page.76) 1417 0 R (page.77) 1424 0 R (page.78) 1429 0 R (page.79) 1435 0 R] -/Limits [(page.74) (page.79)] +/Names [(page.69) 1373 0 R (page.7) 858 0 R (page.70) 1377 0 R (page.71) 1382 0 R (page.72) 1388 0 R (page.73) 1393 0 R] +/Limits [(page.69) (page.73)] >> % 2074 0 obj << -/Names [(page.8) 878 0 R (page.80) 1440 0 R (page.81) 1448 0 R (page.82) 1456 0 R (page.83) 1462 0 R (page.84) 1472 0 R] -/Limits [(page.8) (page.84)] +/Names [(page.74) 1404 0 R (page.75) 1409 0 R (page.76) 1418 0 R (page.77) 1425 0 R (page.78) 1430 0 R (page.79) 1436 0 R] +/Limits [(page.74) (page.79)] >> % 2075 0 obj << -/Names [(page.85) 1484 0 R (page.86) 1489 0 R (page.87) 1501 0 R (page.88) 1507 0 R (page.89) 1514 0 R (page.9) 889 0 R] -/Limits [(page.85) (page.9)] +/Names [(page.8) 879 0 R (page.80) 1441 0 R (page.81) 1449 0 R (page.82) 1457 0 R (page.83) 1463 0 R (page.84) 1473 0 R] +/Limits [(page.8) (page.84)] >> % 2076 0 obj << -/Names [(page.90) 1520 0 R (page.91) 1524 0 R (page.92) 1534 0 R (page.93) 1540 0 R (page.94) 1544 0 R (page.95) 1549 0 R] -/Limits [(page.90) (page.95)] +/Names [(page.85) 1485 0 R (page.86) 1490 0 R (page.87) 1502 0 R (page.88) 1508 0 R (page.89) 1515 0 R (page.9) 890 0 R] +/Limits [(page.85) (page.9)] >> % 2077 0 obj << -/Names [(page.96) 1553 0 R (page.97) 1560 0 R (page.98) 1566 0 R (page.99) 1573 0 R (page.i) 637 0 R (page.ii) 694 0 R] -/Limits [(page.96) (page.ii)] +/Names [(page.90) 1521 0 R (page.91) 1525 0 R (page.92) 1535 0 R (page.93) 1541 0 R (page.94) 1545 0 R (page.95) 1550 0 R] +/Limits [(page.90) (page.95)] >> % 2078 0 obj << -/Names [(page.iii) 740 0 R (page.iv) 760 0 R (precdata) 1006 0 R (section*.1) 638 0 R (section*.2) 1932 0 R (section.1) 7 0 R] -/Limits [(page.iii) (section.1)] +/Names [(page.96) 1554 0 R (page.97) 1561 0 R (page.98) 1567 0 R (page.99) 1574 0 R (page.i) 637 0 R (page.ii) 694 0 R] +/Limits [(page.96) (page.ii)] >> % 2079 0 obj << +/Names [(page.iii) 739 0 R (page.iv) 760 0 R (precdata) 1007 0 R (section*.1) 638 0 R (section*.2) 1933 0 R (section.1) 7 0 R] +/Limits [(page.iii) (section.1)] +>> +% 2080 0 obj +<< /Names [(section.10) 541 0 R (section.11) 569 0 R (section.2) 11 0 R (section.3) 35 0 R (section.4) 220 0 R (section.5) 288 0 R] /Limits [(section.10) (section.5)] >> -% 2080 0 obj +% 2081 0 obj << -/Names [(section.6) 308 0 R (section.7) 421 0 R (section.8) 493 0 R (section.9) 513 0 R (spbasedata) 947 0 R (spdata) 946 0 R] +/Names [(section.6) 308 0 R (section.7) 421 0 R (section.8) 493 0 R (section.9) 513 0 R (spbasedata) 948 0 R (spdata) 947 0 R] /Limits [(section.6) (spdata)] >> -% 2081 0 obj +% 2082 0 obj << /Names [(subsection.10.1) 545 0 R (subsection.10.2) 549 0 R (subsection.10.3) 553 0 R (subsection.10.4) 557 0 R (subsection.10.5) 561 0 R (subsection.10.6) 565 0 R] /Limits [(subsection.10.1) (subsection.10.6)] >> -% 2082 0 obj +% 2083 0 obj << /Names [(subsection.11.1) 573 0 R (subsection.2.1) 15 0 R (subsection.2.2) 19 0 R (subsection.2.3) 23 0 R (subsection.2.4) 31 0 R (subsection.3.1) 39 0 R] /Limits [(subsection.11.1) (subsection.3.1)] >> -% 2083 0 obj +% 2084 0 obj << /Names [(subsection.3.2) 103 0 R (subsection.3.3) 183 0 R (subsection.3.4) 212 0 R (subsection.3.5) 216 0 R (subsection.4.1) 224 0 R (subsection.4.10) 260 0 R] /Limits [(subsection.3.2) (subsection.4.10)] >> -% 2084 0 obj +% 2085 0 obj << /Names [(subsection.4.11) 264 0 R (subsection.4.12) 268 0 R (subsection.4.13) 272 0 R (subsection.4.14) 276 0 R (subsection.4.15) 280 0 R (subsection.4.16) 284 0 R] /Limits [(subsection.4.11) (subsection.4.16)] >> -% 2085 0 obj +% 2086 0 obj << /Names [(subsection.4.2) 228 0 R (subsection.4.3) 232 0 R (subsection.4.4) 236 0 R (subsection.4.5) 240 0 R (subsection.4.6) 244 0 R (subsection.4.7) 248 0 R] /Limits [(subsection.4.2) (subsection.4.7)] >> -% 2086 0 obj +% 2087 0 obj << /Names [(subsection.4.8) 252 0 R (subsection.4.9) 256 0 R (subsection.5.1) 292 0 R (subsection.5.2) 296 0 R (subsection.5.3) 300 0 R (subsection.5.4) 304 0 R] /Limits [(subsection.4.8) (subsection.5.4)] >> -% 2087 0 obj +% 2088 0 obj << /Names [(subsection.6.1) 312 0 R (subsection.6.10) 348 0 R (subsection.6.11) 352 0 R (subsection.6.12) 356 0 R (subsection.6.13) 360 0 R (subsection.6.14) 364 0 R] /Limits [(subsection.6.1) (subsection.6.14)] >> -% 2088 0 obj +% 2089 0 obj << /Names [(subsection.6.15) 368 0 R (subsection.6.16) 372 0 R (subsection.6.17) 376 0 R (subsection.6.18) 380 0 R (subsection.6.19) 384 0 R (subsection.6.2) 316 0 R] /Limits [(subsection.6.15) (subsection.6.2)] >> -% 2089 0 obj +% 2090 0 obj << /Names [(subsection.6.20) 388 0 R (subsection.6.21) 392 0 R (subsection.6.22) 396 0 R (subsection.6.23) 400 0 R (subsection.6.24) 405 0 R (subsection.6.25) 409 0 R] /Limits [(subsection.6.20) (subsection.6.25)] >> -% 2090 0 obj +% 2091 0 obj << /Names [(subsection.6.26) 413 0 R (subsection.6.27) 417 0 R (subsection.6.3) 320 0 R (subsection.6.4) 324 0 R (subsection.6.5) 328 0 R (subsection.6.6) 332 0 R] /Limits [(subsection.6.26) (subsection.6.6)] >> -% 2091 0 obj +% 2092 0 obj << /Names [(subsection.6.7) 336 0 R (subsection.6.8) 340 0 R (subsection.6.9) 344 0 R (subsection.7.1) 425 0 R (subsection.7.10) 461 0 R (subsection.7.11) 465 0 R] /Limits [(subsection.6.7) (subsection.7.11)] >> -% 2092 0 obj +% 2093 0 obj << /Names [(subsection.7.12) 469 0 R (subsection.7.13) 473 0 R (subsection.7.14) 477 0 R (subsection.7.15) 481 0 R (subsection.7.16) 485 0 R (subsection.7.17) 489 0 R] /Limits [(subsection.7.12) (subsection.7.17)] >> -% 2093 0 obj +% 2094 0 obj << /Names [(subsection.7.2) 429 0 R (subsection.7.3) 433 0 R (subsection.7.4) 437 0 R (subsection.7.5) 441 0 R (subsection.7.6) 445 0 R (subsection.7.7) 449 0 R] /Limits [(subsection.7.2) (subsection.7.7)] >> -% 2094 0 obj +% 2095 0 obj << /Names [(subsection.7.8) 453 0 R (subsection.7.9) 457 0 R (subsection.8.1) 497 0 R (subsection.8.2) 501 0 R (subsection.8.3) 505 0 R (subsection.8.4) 509 0 R] /Limits [(subsection.7.8) (subsection.8.4)] >> -% 2095 0 obj +% 2096 0 obj << /Names [(subsection.9.1) 517 0 R (subsection.9.2) 521 0 R (subsection.9.3) 525 0 R (subsection.9.4) 529 0 R (subsection.9.5) 533 0 R (subsection.9.6) 537 0 R] /Limits [(subsection.9.1) (subsection.9.6)] >> -% 2096 0 obj +% 2097 0 obj << /Names [(subsubsection.2.3.1) 27 0 R (subsubsection.3.1.1) 43 0 R (subsubsection.3.1.10) 79 0 R (subsubsection.3.1.11) 83 0 R (subsubsection.3.1.12) 87 0 R (subsubsection.3.1.13) 91 0 R] /Limits [(subsubsection.2.3.1) (subsubsection.3.1.13)] >> -% 2097 0 obj +% 2098 0 obj << /Names [(subsubsection.3.1.14) 95 0 R (subsubsection.3.1.15) 99 0 R (subsubsection.3.1.2) 47 0 R (subsubsection.3.1.3) 51 0 R (subsubsection.3.1.4) 55 0 R (subsubsection.3.1.5) 59 0 R] /Limits [(subsubsection.3.1.14) (subsubsection.3.1.5)] >> -% 2098 0 obj +% 2099 0 obj << /Names [(subsubsection.3.1.6) 63 0 R (subsubsection.3.1.7) 67 0 R (subsubsection.3.1.8) 71 0 R (subsubsection.3.1.9) 75 0 R (subsubsection.3.2.1) 107 0 R (subsubsection.3.2.10) 143 0 R] /Limits [(subsubsection.3.1.6) (subsubsection.3.2.10)] >> -% 2099 0 obj +% 2100 0 obj << /Names [(subsubsection.3.2.11) 147 0 R (subsubsection.3.2.12) 151 0 R (subsubsection.3.2.13) 155 0 R (subsubsection.3.2.14) 159 0 R (subsubsection.3.2.15) 163 0 R (subsubsection.3.2.16) 167 0 R] /Limits [(subsubsection.3.2.11) (subsubsection.3.2.16)] >> -% 2100 0 obj +% 2101 0 obj << /Names [(subsubsection.3.2.17) 171 0 R (subsubsection.3.2.18) 175 0 R (subsubsection.3.2.19) 179 0 R (subsubsection.3.2.2) 111 0 R (subsubsection.3.2.3) 115 0 R (subsubsection.3.2.4) 119 0 R] /Limits [(subsubsection.3.2.17) (subsubsection.3.2.4)] >> -% 2101 0 obj +% 2102 0 obj << /Names [(subsubsection.3.2.5) 123 0 R (subsubsection.3.2.6) 127 0 R (subsubsection.3.2.7) 131 0 R (subsubsection.3.2.8) 135 0 R (subsubsection.3.2.9) 139 0 R (subsubsection.3.3.1) 187 0 R] /Limits [(subsubsection.3.2.5) (subsubsection.3.3.1)] >> -% 2102 0 obj -<< -/Names [(subsubsection.3.3.2) 191 0 R (subsubsection.3.3.3) 195 0 R (subsubsection.3.3.4) 199 0 R (subsubsection.3.3.5) 204 0 R (subsubsection.3.3.6) 208 0 R (table.1) 999 0 R] -/Limits [(subsubsection.3.3.2) (table.1)] ->> % 2103 0 obj << -/Names [(table.10) 1163 0 R (table.11) 1171 0 R (table.12) 1184 0 R (table.13) 1203 0 R (table.14) 1231 0 R (table.15) 1248 0 R] -/Limits [(table.10) (table.15)] +/Names [(subsubsection.3.3.2) 191 0 R (subsubsection.3.3.3) 195 0 R (subsubsection.3.3.4) 199 0 R (subsubsection.3.3.5) 204 0 R (subsubsection.3.3.6) 208 0 R (table.1) 1000 0 R] +/Limits [(subsubsection.3.3.2) (table.1)] >> % 2104 0 obj << -/Names [(table.16) 1263 0 R (table.17) 1277 0 R (table.18) 1309 0 R (table.19) 1348 0 R (table.2) 1045 0 R (table.20) 1364 0 R] -/Limits [(table.16) (table.20)] +/Names [(table.10) 1164 0 R (table.11) 1172 0 R (table.12) 1185 0 R (table.13) 1204 0 R (table.14) 1232 0 R (table.15) 1249 0 R] +/Limits [(table.10) (table.15)] >> % 2105 0 obj << -/Names [(table.3) 1067 0 R (table.4) 1079 0 R (table.5) 1098 0 R (table.6) 1106 0 R (table.7) 1124 0 R (table.8) 1137 0 R] -/Limits [(table.3) (table.8)] +/Names [(table.16) 1264 0 R (table.17) 1278 0 R (table.18) 1310 0 R (table.19) 1349 0 R (table.2) 1046 0 R (table.20) 1365 0 R] +/Limits [(table.16) (table.20)] >> % 2106 0 obj << -/Names [(table.9) 1156 0 R (title.0) 3 0 R (vbasedata) 933 0 R (vdata) 986 0 R] -/Limits [(table.9) (vdata)] +/Names [(table.3) 1068 0 R (table.4) 1080 0 R (table.5) 1099 0 R (table.6) 1107 0 R (table.7) 1125 0 R (table.8) 1138 0 R] +/Limits [(table.3) (table.8)] >> % 2107 0 obj << -/Kids [2011 0 R 2012 0 R 2013 0 R 2014 0 R 2015 0 R 2016 0 R] -/Limits [(Doc-Start) (Item.125)] +/Names [(table.9) 1157 0 R (title.0) 3 0 R (vbasedata) 934 0 R (vdata) 987 0 R] +/Limits [(table.9) (vdata)] >> % 2108 0 obj << -/Kids [2017 0 R 2018 0 R 2019 0 R 2020 0 R 2021 0 R 2022 0 R] -/Limits [(Item.126) (Item.42)] +/Kids [2012 0 R 2013 0 R 2014 0 R 2015 0 R 2016 0 R 2017 0 R] +/Limits [(Doc-Start) (Item.125)] >> endstream endobj -2130 0 obj +2131 0 obj << /Title (Parallel Sparse BLAS V. 3.7.0) /Subject (Parallel Sparse Basic Linear Algebra Subroutines) /Keywords (Computer Science Linear Algebra Fluid Dynamics Parallel Linux MPI PSBLAS Iterative Solvers Preconditioners) /Creator (pdfLaTeX) /Producer ($Id$) /Author()/Title()/Subject()/Creator(LaTeX with hyperref package)/Producer(pdfTeX-1.40.19)/Keywords() +<<<<<<< HEAD /CreationDate (D:20191217194209Z) /ModDate (D:20191217194209Z) +======= +/CreationDate (D:20191218141557Z) +/ModDate (D:20191218141557Z) +>>>>>>> unify_aggr_bld /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.14159265-2.6-1.40.19 (TeX Live 2018) kpathsea version 6.3.0) >> @@ -30150,169 +30157,183 @@ endobj 2110 0 obj << /Type /ObjStm -/N 20 -/First 189 -/Length 2518 +/N 21 +/First 199 +/Length 2640 >> stream -2109 0 2111 111 2112 225 2113 345 2114 469 2115 588 2116 701 2117 812 2118 923 2119 1034 -2120 1152 2121 1277 2122 1403 2123 1533 2124 1654 2125 1774 2126 1899 2127 1997 2128 2081 2129 2116 +2109 0 2111 112 2112 223 2113 337 2114 457 2115 581 2116 700 2117 813 2118 924 2119 1035 +2120 1146 2121 1264 2122 1389 2123 1515 2124 1645 2125 1766 2126 1886 2127 2011 2128 2109 2129 2193 +2130 2228 % 2109 0 obj << -/Kids [2023 0 R 2024 0 R 2025 0 R 2026 0 R 2027 0 R 2028 0 R] -/Limits [(Item.43) (Item.75)] +/Kids [2018 0 R 2019 0 R 2020 0 R 2021 0 R 2022 0 R 2023 0 R] +/Limits [(Item.126) (Item.42)] >> % 2111 0 obj << -/Kids [2029 0 R 2030 0 R 2031 0 R 2032 0 R 2033 0 R 2034 0 R] -/Limits [(Item.76) (cite.METIS)] +/Kids [2024 0 R 2025 0 R 2026 0 R 2027 0 R 2028 0 R 2029 0 R] +/Limits [(Item.43) (Item.75)] >> % 2112 0 obj << -/Kids [2035 0 R 2036 0 R 2037 0 R 2038 0 R 2039 0 R 2040 0 R] -/Limits [(cite.MPI1) (lstlisting.-20)] +/Kids [2030 0 R 2031 0 R 2032 0 R 2033 0 R 2034 0 R 2035 0 R] +/Limits [(Item.76) (cite.METIS)] >> % 2113 0 obj << -/Kids [2041 0 R 2042 0 R 2043 0 R 2044 0 R 2045 0 R 2046 0 R] -/Limits [(lstlisting.-3) (lstnumber.-5.1)] +/Kids [2036 0 R 2037 0 R 2038 0 R 2039 0 R 2040 0 R 2041 0 R] +/Limits [(cite.MPI1) (lstlisting.-20)] >> % 2114 0 obj << -/Kids [2047 0 R 2048 0 R 2049 0 R 2050 0 R 2051 0 R 2052 0 R] -/Limits [(lstnumber.-5.2) (page.103)] +/Kids [2042 0 R 2043 0 R 2044 0 R 2045 0 R 2046 0 R 2047 0 R] +/Limits [(lstlisting.-3) (lstnumber.-5.1)] >> % 2115 0 obj << -/Kids [2053 0 R 2054 0 R 2055 0 R 2056 0 R 2057 0 R 2058 0 R] -/Limits [(page.104) (page.136)] +/Kids [2048 0 R 2049 0 R 2050 0 R 2051 0 R 2052 0 R 2053 0 R] +/Limits [(lstnumber.-5.2) (page.103)] >> % 2116 0 obj << -/Kids [2059 0 R 2060 0 R 2061 0 R 2062 0 R 2063 0 R 2064 0 R] -/Limits [(page.137) (page.3)] +/Kids [2054 0 R 2055 0 R 2056 0 R 2057 0 R 2058 0 R 2059 0 R] +/Limits [(page.104) (page.136)] >> % 2117 0 obj << -/Kids [2065 0 R 2066 0 R 2067 0 R 2068 0 R 2069 0 R 2070 0 R] -/Limits [(page.30) (page.62)] +/Kids [2060 0 R 2061 0 R 2062 0 R 2063 0 R 2064 0 R 2065 0 R] +/Limits [(page.137) (page.3)] >> % 2118 0 obj << -/Kids [2071 0 R 2072 0 R 2073 0 R 2074 0 R 2075 0 R 2076 0 R] -/Limits [(page.63) (page.95)] +/Kids [2066 0 R 2067 0 R 2068 0 R 2069 0 R 2070 0 R 2071 0 R] +/Limits [(page.30) (page.62)] >> % 2119 0 obj << -/Kids [2077 0 R 2078 0 R 2079 0 R 2080 0 R 2081 0 R 2082 0 R] -/Limits [(page.96) (subsection.3.1)] +/Kids [2072 0 R 2073 0 R 2074 0 R 2075 0 R 2076 0 R 2077 0 R] +/Limits [(page.63) (page.95)] >> % 2120 0 obj << -/Kids [2083 0 R 2084 0 R 2085 0 R 2086 0 R 2087 0 R 2088 0 R] -/Limits [(subsection.3.2) (subsection.6.2)] +/Kids [2078 0 R 2079 0 R 2080 0 R 2081 0 R 2082 0 R 2083 0 R] +/Limits [(page.96) (subsection.3.1)] >> % 2121 0 obj << -/Kids [2089 0 R 2090 0 R 2091 0 R 2092 0 R 2093 0 R 2094 0 R] -/Limits [(subsection.6.20) (subsection.8.4)] +/Kids [2084 0 R 2085 0 R 2086 0 R 2087 0 R 2088 0 R 2089 0 R] +/Limits [(subsection.3.2) (subsection.6.2)] >> % 2122 0 obj << -/Kids [2095 0 R 2096 0 R 2097 0 R 2098 0 R 2099 0 R 2100 0 R] -/Limits [(subsection.9.1) (subsubsection.3.2.4)] +/Kids [2090 0 R 2091 0 R 2092 0 R 2093 0 R 2094 0 R 2095 0 R] +/Limits [(subsection.6.20) (subsection.8.4)] >> % 2123 0 obj << -/Kids [2101 0 R 2102 0 R 2103 0 R 2104 0 R 2105 0 R 2106 0 R] -/Limits [(subsubsection.3.2.5) (vdata)] +/Kids [2096 0 R 2097 0 R 2098 0 R 2099 0 R 2100 0 R 2101 0 R] +/Limits [(subsection.9.1) (subsubsection.3.2.4)] >> % 2124 0 obj << -/Kids [2107 0 R 2108 0 R 2109 0 R 2111 0 R 2112 0 R 2113 0 R] -/Limits [(Doc-Start) (lstnumber.-5.1)] +/Kids [2102 0 R 2103 0 R 2104 0 R 2105 0 R 2106 0 R 2107 0 R] +/Limits [(subsubsection.3.2.5) (vdata)] >> % 2125 0 obj << -/Kids [2114 0 R 2115 0 R 2116 0 R 2117 0 R 2118 0 R 2119 0 R] -/Limits [(lstnumber.-5.2) (subsection.3.1)] +/Kids [2108 0 R 2109 0 R 2111 0 R 2112 0 R 2113 0 R 2114 0 R] +/Limits [(Doc-Start) (lstnumber.-5.1)] >> % 2126 0 obj << -/Kids [2120 0 R 2121 0 R 2122 0 R 2123 0 R] -/Limits [(subsection.3.2) (vdata)] +/Kids [2115 0 R 2116 0 R 2117 0 R 2118 0 R 2119 0 R 2120 0 R] +/Limits [(lstnumber.-5.2) (subsection.3.1)] >> % 2127 0 obj << -/Kids [2124 0 R 2125 0 R 2126 0 R] -/Limits [(Doc-Start) (vdata)] +/Kids [2121 0 R 2122 0 R 2123 0 R 2124 0 R] +/Limits [(subsection.3.2) (vdata)] >> % 2128 0 obj << -/Dests 2127 0 R +/Kids [2125 0 R 2126 0 R 2127 0 R] +/Limits [(Doc-Start) (vdata)] >> % 2129 0 obj << +/Dests 2128 0 R +>> +% 2130 0 obj +<< /Type /Catalog -/Pages 2007 0 R -/Outlines 2008 0 R -/Names 2128 0 R +/Pages 2008 0 R +/Outlines 2009 0 R +/Names 2129 0 R /URI (http://ce.uniroma2.it/psblas) /PageMode/UseOutlines/PageLabels<>2<>6<>]>> /OpenAction 576 0 R >> endstream endobj -2131 0 obj +2132 0 obj << /Type /XRef -/Index [0 2132] -/Size 2132 +/Index [0 2133] +/Size 2133 /W [1 3 1] +<<<<<<< HEAD /Root 2129 0 R /Info 2130 0 R /ID [<362C1AAB92CF66A0E508C639DC7E96C3> <362C1AAB92CF66A0E508C639DC7E96C3>] /Length 10660 +======= +/Root 2130 0 R +/Info 2131 0 R +/ID [<6B1E8680CFEF4C06C14E8290AA58B896> <6B1E8680CFEF4C06C14E8290AA58B896>] +/Length 10665 +>>>>>>> unify_aggr_bld >> stream -ÿ”ZÚêHÚêRÙcêZÙb@Ùa  -@ Ù`  @+Ù_ @2Ù^@7Ù]@8Ù\@XÙ[@YÙZ@ZÙY@[ÙX@_ÙW@`ÙV @aÙU!"¦ÙT#$¦ÙS%&¦ÙR'(¦ÙQ)*¦ ÙP+,¦ -ÙO-.¦ ÙN/0¦ÙM12¦ÙL34¦ÙK56¦ÙJ78¦ÙI9:¦ ÙH;<¦"ÙG=>¦&ÙF?@¦'ÙEAB¦(ÙDCD¦,ÙCEF¦-ÙBGH¦1ÙAIJ¦2Ù@KL¦6Ù?MN¦7Ù>OP¦8Ù=QR¦<Ù<ST¦BÙ;UV¦CÙ:WX¦DÙ9YZ¦EÙ8[\¦KÙ7]^¦LÙ6_`¦MÙ5ab¦SÙ4cËR¦XÙ3Ë˦YÙ2Ë˦ZÙ1Ë˦aÙ0ËËùÙ/Ë Ë -ù Ù.Ë Ë ùÙ-Ë Ëù0Ù,ËËù;Ù+ËËùLÙ*ËËùTÙ)ËËeÙ(ËËe Ù'ËËeÙ&ËËe$Ù%ËËe+Ù$ËË e4Ù#Ë!Ë"eHÙ"Ë#Ë$ecÙ!Ë%Ë&Ð Ù Ë'Ë(ÐÙË)Ë*Ð!ÙË+Ë,Ð(ÙË-Ë.ÐBÙË/Ë0ÐcÙË1Ë2H ÙË3Ë4HÙË5Ë6HÙË7Ë8H0ÙË9Ë:H=ÙË;Ë<HDÙË=Ë>HIÙË?Ë@HOÙËAËBHZÙËCËDHaÙËEËF¼ÙËGËH¼&ÙËIËJ¼,ÙËKËL¼3Ù ËMËN¼9Ù ËOËP¼EÙ ËQËR¼KÙ -ËSËT¼OÙ ËUËV¼TÙËWËX¼^ÙËYËZ¼cÙË[Ë\ ÙË]Ë^ ÙË_Ë` ÙËaËb ÙËc”sü Ù”” %Ù”” 2Éc”” 6Éb”” FÉa” ” - JÉ`” ”  PÉ_” ” VÉ^”” ]É]”” aÉ\””‹É[””‹ÉZ””‹ ÉY””‹ ÉX””‹ÉW””‹ÉV”” ‹ÉU”!”"‹#ÉT”#”$‹)ÉS”%”&‹/ÉR”'”(‹6ÉQ”)”*‹;ÉP”+”,‹BÉO”-”.öÉN”/”0öÉM”1”2ö ÉL”3”4öÉK”5”6öÉJ”7”8öÉI”9”:ö$ÉH”;”<ö+ÉG”=”>ö1ÉF”?”@ö8ÉE”A”Bö>ÉD”C”DöDÉC”E”FöJÉB”G”HöSÉA”I”Jö^É@”K”LöcÉ?”M”N\É>”O”P\ É=”Q”R\ É<”S”T\É;”U”V”W”[2}”X”YÉÉÉÉ É”^”\5”]”`”a”b”cƒƒƒƒƒƒƒƒƒƒ ƒ -ƒ ƒ ƒ ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ ƒ!ƒ"ƒ#ƒ$ƒ%ƒ&ƒ'ƒ(ƒ)ƒ.ƒ,”_5Šƒ*ƒ+ƒƒƒƒüƒ/ƒ0ƒ1ƒ2ƒ3ƒ4ƒ5ƒ6ƒ7ƒ8ƒ9ƒ:ƒ;ƒ<ƒ=ƒ>ƒ?ƒ@ƒAƒBƒCƒDƒEƒFƒGƒHƒIƒJƒKƒLƒMƒNƒOƒPƒQƒRƒSƒTƒUƒVƒWƒXƒYƒZƒ[ƒ\ƒ`ƒ^ƒ-ûƒ]ƒaƒbƒcêêêêêêêêêê ê -ê ê êêêêêêêêêêêêêêêêêêê ê!ê"ê#ê%ê'ê)ê.ê,ƒ_Îõê+ê ê$ê&ê(ê*îeê0ê2ê3ê4ê5ê6ê7ê8ê9ê:ê<ê-Y7ê;ê/ê1ê>ê?ê@êAêBêCêDêEêFêGêIê=géÉÉ\=\4\*\>\<\1\2\;\.\/êOêPêQŸrêVêTêJ‰kÉ êSêKêLêMêN¤(\0êWêXê]êU¯ËêYÉÉÉ ÉÉê[Éê\\:êbêcç»@ê^Ò@@ê_ê`êa\-\,(&@@@@*5@@@@ ?Ç@ -É -@ @ @@@@@@@(@&@aÖ@@@@@@@@@@ @!@"@#@$@%ÉÉ@)@3@'€9@*@,@-@.@/@0@1@5@:@4¦@6@9@<@=@>@E@;¾ò@?@@@A@B@C@D@G@H@S@FÙÙ@I@J@K@L@M@N@O@P@Q@R@U@V@\@TîO@W@b@]ÿ@^ɦ@cŽ¦¦bˆ¦ ¦Kþ¦¦¦¦¦¦ cX¦¦¦\9¦¦¦‡c¦¦#¦žê¦¦!¦)¦$¬ý¦%ɦ.¦*»Þ¦+¦3¦/Î2¦0¦9¦4Þ€¦5¦=¦:;¦?¦@¦G¦>N¦A¦F¦J¦N¦H"µ¦IɦP¦Q¦T¦O1w¦Rù ¦V¦^¦\¦U@³¦W¦[¦`¦b¦]S¦_Éù¦ca®ù’uùùùùùù ùù ù…úù -ùùùù¢ÚùÉùùùùùùù­zùùùù'ùËÔù ù!ù"ù#ù$ù%ù&ù)ù*ù+ù,ù-ù.ù2ù(àù/ù1ù5ù3=ù4ù7ù8ù9ù=ù6êù:ù<ùFù>ù?ù@ùAùBùCùDùEÉ ùHùIùJùNùG1ùKùMùPùQùRùVùOIñùSùUù_ùWf.ùXùYùZù[ù\ù]ù^ùaùbùceù`u˜eeÔBeeÀeee e -ee´e e É!eeÜ>eeeeeeeeeeeeîžeee!e"e&e ×e#e%e(e)e-e'¤e*Ée,e/e0e1e2e;e9e.2–e3e5e6e7e8e<e=e>e?e@eAeBeDe:OyeCÉ"eFeLeJeEkeGeIeMeNeOePeQeReTeK…ÃeSeVeWeYeU¤neXe[e\e]e^e_e`eaÐeZ¶ñebÐÌþÐÐÙÐÐÐÐÐ Ð -ÐÐÐЇРРÉ#ÐÐ$ÌÐÐÐÐÐÐÐÐ*ÖÐÐÐÐ"ÐH^Ð Ð$Ð%Ð&Ð5Ð-Ð#K&Ð'Ð)Ð*Ð+Ð,tÐ6Ð9Ð.gÈÐ7Ð8Ð/Ð0Ð1Ð2Ð3Ð4‚ܶKÐ<Ð:ããÐ;ÉÉ$Ð>Ð?Ð@ÐGÐ=ð -ÐAÐCÐDÐEÐFÐI8|ÐJÐKÐPÐHsÐLÐMÐNÐOÐ\ÐSÐQ(šÐRÐ]ÐT6úÐ[ÐUÐVÐWÐXÐYÐZGz‰Ð_Ð`ÐaHÐ^¨!ÐbHHHH -V1HHþxHÉ%H HHH dH -H H HHHHH #&HHH 3¸HHHH M‹HHH!H$H  g¶H"H#H,H% 4H&H'H(H)H*H+É&H.H1H- ™ÕH/H3H8H2 ¶H4H5H6H7H:H;H?H9 °H<H>HAHBHEH@ Û<HCHGHJHF èPHHHLHMHPHK ñZHNÉ'HUHQ -ÃHRHSHTHWHXH^HV -3HYH[H\H]¼HbH_ -"‘H`¼¼¼ Hc -9"¼¼¼¼¼¼ rÞ¼¼ - -€¼ ¼ ¼ ¼¼¼¼¼¼¼¼ -1¼É(¼!¼ -©i¼¼¼¼¼¼¼ ¼#¼$¼'¼" -²u¼%¼)¼*¼.¼( -¾Ë¼+¼-¼0¼1¼4¼/ -Ι¼2¼6¼7¼:¼5 -âÔ¼8¼?¼; -ýÕ¼<¼=¼>É)¼A¼B¼C¼F¼@ i¼D¼H¼I¼L¼G ¼J¼P¼M $Š¼N¼R¼U¼Q 2Q¼S¼Z¼V L&¼W¼X¼Y¼\¼_¼[ O$¼]É*¼a ¼` eüb  ¯    œp      °, -     ½(      ÐÔ     !  à   É+ # & " î¦ $ , ' § ( ) * + . / 0 3 - Z 1 7 4 $Á 5 C 8 ;‹ 9 : ; < = > ? @ A B G D W EÉ, M H X  I K L S N n O Q R Z T € U W X Y ^ [ ‘Ú \ b _ œT `‹ c ª‹É- á‹‹ Õ‹‹ -‹ Û±‹‹‹  áH‹ ‹‹ óD‹‹‹‹‹ ¦‹‹‹‹ ‹ /‹‹‹É.‹&‹! 0Ÿ‹"‹$‹%‹,‹' E„‹(‹*‹+‹3‹- ZL‹.‹0‹1É‹2‹8‹4 rû‹5‹7‹=‹9 ˆ%‹:‹<‹?‹@‹C‹> a‹AÉ/‹_‹`‹a‹D ¶‹‹E‹F‹GÉ‹H‹I‹J‹K‹L‹M‹N‹O‹P‹Q‹R‹S‹T‹U‹V‹W‹X‹Y‹Z‹[‹\‹]‹^ö‹b Òï‹cööÝõö öjööööö - -+ö ö öööÑöööööPöÉ0öö ö¦öööö"ö'ö!.“ö#ö%ö&ö)ö.ö(C`ö*ö,ö-ö4ö/Qïö0ö2ö3ö6ö;ö5`±ö7ö9ö:öAö<qSö=ö?ö@É1öEöB~ÑöCöGöHöLöFƒÍöIöKöNöOöPöQöTöM—ëöRöWöU¶böVöYöZö[ö\ö_öXºåö]öa\ö`ÒöbÉ2Ž\\‚\\\\ -\ ¥\\\ ’\ \\\\\/\\\\\É \\\\\7ð\\!\#\ T\"É3\&\$f’\%\6\'g\(\)\+\3\5\@\7‚Â\8\?\A\B\C\D\E\F\G\H\I\J\K\L\M\N\O\P\Q\R\S\T3\Uçs\V5ø\W]\X{6\Y¼Æ\ZÚÄ\[7\\ œ\]…’\^¥\_ÇZ\` \aHÉ\bpt\c×NÉÛø'ÉVˆÉ¤É´HÉÉ4É5É6É7É8É9É:à4ÞÚÚÚÚÚÚÚÚ Ú -Ú Ú Ú ÚÚÚÚÚÚÚÚÚÚÚÚÚÚÚÚÚÚÚ Ú!Ú"Ú#Ú$Ú%Ú&Ú'Ú(Ú)Ú*Ú+Ú,Ú-Ú.Ú/Ú0Ú1Ú2Ú3Ú4Ú5Ú6Ú7Ú8Ú9Ú:Ú;Ú<Ú=Ú>Ú?Ú@ÚAÚBÚCÚDÚEÚFÚGÚHÚIÚJÚKÚLÚMÚNÚOÚPÚQÚRÚSÚTÚUÚVÚWÚXÚYÚZÚ[Ú\Ú]Ú^Ú_Ú`ÚaÚbÚc>†¡>>>>>>>>> > -> > > >>>>>>„lÓ +ÿ”ZÛéIÛéSÛé[Úc@Úb  +@ Úa  @,Ú` @3Ú_@8Ú^@9Ú]@YÚ\@ZÚ[@[ÚZ@\ÚY@`ÚX@aÚW @bÚV!"§ÚU#$§ÚT%&§ÚS'(§ÚR)*§ +ÚQ+,§ ÚP-.§ ÚO/0§ÚN12§ÚM34§ÚL56§ÚK78§ÚJ9:§!ÚI;<§#ÚH=>§'ÚG?@§(ÚFAB§)ÚECD§-ÚDEF§.ÚCGH§2ÚBIJ§3ÚAKL§7Ú@MN§8Ú?OP§9Ú>QR§=Ú=ST§CÚ<UV§DÚ;WX§EÚ:YZ§FÚ9[\§LÚ8]^§MÚ7_`§NÚ6ab§TÚ5cËR§YÚ4Ë˧ZÚ3Ë˧[Ú2Ë˧bÚ1ËËúÚ0Ë Ë +ú Ú/Ë Ë úÚ.Ë Ëú1Ú-ËËú<Ú,ËËúMÚ+ËËúUÚ*ËËfÚ)ËËf Ú(ËËfÚ'ËËf%Ú&ËËf,Ú%ËË f5Ú$Ë!Ë"fIÚ#Ë#Ë$ÑÚ"Ë%Ë&Ñ Ú!Ë'Ë(ÑÚ Ë)Ë*Ñ"ÚË+Ë,Ñ)ÚË-Ë.ÑCÚË/Ë0IÚË1Ë2I ÚË3Ë4IÚË5Ë6IÚË7Ë8I1ÚË9Ë:I>ÚË;Ë<IEÚË=Ë>IJÚË?Ë@IPÚËAËBI[ÚËCËDIbÚËEËF½ÚËGËH½'ÚËIËJ½-ÚËKËL½4ÚËMËN½:Ú ËOËP½FÚ ËQËR½LÚ ËSËT½PÚ +ËUËV½UÚ ËWËX½_ÚËYËZ!ÚË[Ë\!ÚË]Ë^! ÚË_Ë`!ÚËaËb!ÚËc”sü!Ú””!&Ú””!3Ú””!7Èc””!GÈb” ” +!KÈa” ” !QÈ`” ”!WÈ_””!^È^””!bÈ]””‹È\””‹È[””‹ +ÈZ””‹ÈY””‹ÈX””‹ÈW”” ‹ÈV”!”"‹$ÈU”#”$‹*ÈT”%”&‹0ÈS”'”(‹7ÈR”)”*‹<ÈQ”+”,‹CÈP”-”.÷ÈO”/”0÷ÈN”1”2÷ ÈM”3”4÷ÈL”5”6÷ÈK”7”8÷ÈJ”9”:÷%ÈI”;”<÷,ÈH”=”>÷2ÈG”?”@÷9ÈF”A”B÷?ÈE”C”D÷EÈD”E”F÷KÈC”G”H÷TÈB”I”J÷_ÈA”K”L]È@”M”N]È?”O”P] +È>”Q”R]È=”S”T]È<”U”V”W”[2}”X”YÈÈÈÈÈ”^”\5”]”`”a”b”cƒƒƒƒƒƒƒƒƒƒ ƒ +ƒ ƒ ƒ ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ ƒ!ƒ"ƒ#ƒ$ƒ%ƒ&ƒ'ƒ(ƒ)ƒ.ƒ,”_5Šƒ*ƒ+ƒƒƒƒæƒ/ƒ0ƒ1ƒ2ƒ3ƒ4ƒ5ƒ6ƒ7ƒ8ƒ9ƒ:ƒ;ƒ<ƒ=ƒ>ƒ?ƒ@ƒAƒBƒCƒDƒEƒFƒGƒHƒIƒJƒKƒLƒMƒNƒOƒPƒQƒRƒSƒTƒUƒVƒWƒXƒYƒZƒ[ƒ\ƒ`ƒ^ƒ-‘ʃ]ƒaƒbƒcéééééééééé é +é é ééééééééééééééééééé é!é#é$é&é(é-é+ƒ_ÏÄé*é é"é%é'é)îýé/é1é3é4é5é6é7é8é9é:é;é=é,Wé<é.é0é2é?é@éAéBéCéDéEéFéGéHéJé>hÈÈ]>]5]+]?]=]2]3]<]/]0éPéQéR  +éWéUéKŠÈ +éTéLéMéNéO¤À]1éXéYé^éV°céZÈÈÈ ÈÈé\Èé]];éc@èS@é_Ó5@@é`éaéb].A]-@@@ @*è@@@@ +@z@ È @ @@@@@@@@)@'@b‰@@@@@@@@@ @!@"@#@$@%@&ÈÈ@*@4@(€ì@+@-@.@/@0@1@2@6@;@5žY@7@:@=@>@?@F@<¿¥@@@A@B@C@D@E@H@I@T@GÚŒ@J@K@L@M@N@O@P@Q@R@S@V@W@]@Uï@X@c@^²@_ȧ§9<§§b„§ §LÔ§ §§§§§d.§§§]:§§§ˆ9§§$§ŸÀ§ §"§*§%­Ó§&ȧ/§+¼´§,§4§0ϧ1§:§5ßV§6§>§;ïo§<§@§A§H§?$§B§G§K§O§I#‹§JȧQ§R§U§P2M§Sú §W§_§]§VA‰§X§\§a§c§^Sô§`Èúú…òú“Gúúúúú ú +úúú†Ìú úúúú£¬úÈ úúúúúúú®Lúúú ú(ú̦ú!ú"ú#ú$ú%ú&ú'ú*ú+ú,ú-ú.ú/ú3ú)àèú0ú2ú6ú4ú5ú8ú9ú:ú>ú7¼ú;ú=úGú?Ôú@úAúBúCúDúEúFÈ!úIúJúKúOúH1ÖúLúNúQúRúSúWúPJÃúTúVú`úXgúYúZú[ú\ú]ú^ú_úbúcffúavjffÔûffÀ¿ff f +f ffÃmf fÈ"ffÜ÷fffffffffff fïWfff"f#f'f!f$f&f)f*f.f(]f+Èf-f0f1f2f3f<f:f/3Of4f6f7f8f9f=f>f?f@fAfBfCfEf;P2fDÈ#fGfMfKfFkÀfHfJfNfOfPfQfRfSfUfL†|fTfWfXfZfV¥'fYf\f]f^f_f`fafbÑf[·ªfcÑÎÑÑîÑÑÑÑ Ñ +Ñ ÑÑÑÑœÑ ÑÈ$ÑÑ%áÑÑÑÑÑÑÑÑ+ëÑÑÑ Ñ#ÑIsÑ!Ñ%Ñ&Ñ'Ñ6Ñ.Ñ$L;Ñ(Ñ*Ñ+Ñ,Ñ-u–Ñ7Ñ:Ñ/hÝÑ8Ñ9Ñ0Ñ1Ñ2Ñ3Ñ4Ñ5ƒñ·`Ñ=Ñ;äøÑ<ÈÈ%Ñ?Ñ@ÑAÑHÑ>ñÑBÑDÑEÑFÑGÑJ9‘ÑKÑLÑQÑIˆÑMÑNÑOÑPÑ]ÑTÑR)¯ÑSÑ^ÑU8Ñ\ÑVÑWÑXÑYÑZÑ[H/{žÑ`ÑaÑbIÑ_©6ÑcIIII +:4IIÿŠIÈ&I +III  vI I IIIIII $8III 4ÊIII I NIII"I%I! hÈI#I$I-I& FI'I(I)I*I+I,È'I/I2I. šçI0I4I9I3 ·1I5I6I7I8I;I<I@I: ÃÂI=I?IBICIFIA ÜNIDIHIKIG ébIIIMINIQIL òlIOÈ(IVIR + ÕISITIUIXIYI_IW +EIZI\I]I^½IcI` +#£Ia½½½ +½ +c±½½½½½½  sŒ½½  +€À½ ½ ½½½½½½½½½ +ß½È)½"½ +ª½½½½½½ ½!½$½%½(½# +³#½&½*½+½/½) +¿y½,½.½1½2½5½0 +ÏG½3½7½8½;½6 +ソ9½@½< +þƒ½=½>½?È*½B½C½D½G½A ½E½I½J½M½H ¾½K½Q½N %8½O½S½V½R 2ÿ½T½[½W LÔ½X½Y½Z½]½`½\ OÒ½^È+½b!½a fq½c! «1!!! ‚!!! +!!  ±>! ! !!! ¾:!!!!! Ñæ!!!!!"! á)!! !!È,!$!'!# ï¸!%!-!( ¹!)!*!+!,!/!0!1!4!. l!2!8!5 %Ó!6!D!9 <!:!;!<!=!>!?!@!A!B!C!H!E X*!FÈ-!N!I Y!J!L!M!T!O o*!P!R!S![!U ¢!V!X!Y!Z!_!\ ’ì!]!c!` f!a‹‹ Ñ}‹ â’È.‹‹ Öa‹‹ ‹ Ü…‹ ‹‹  â‹ ‹‹ ô‹‹‹‹‹ z‹‹‹‹!‹ ‹‹‹ È/‹'‹" 1s‹#‹%‹&‹-‹( FX‹)‹+‹,‹4‹. [ ‹/‹1‹2È ‹3‹9‹5 sÏ‹6‹8‹>‹: ˆù‹;‹=‹@‹A‹D‹? ž5‹BÈ0‹`‹a‹b‹E ·_‹F‹G‹HÈ‹I‹J‹K‹L‹M‹N‹O‹P‹Q‹R‹S‹T‹U‹V‹W‹X‹Y‹Z‹[‹\‹]‹^‹_÷‹c ÓÃ÷÷÷Þÿ÷ +÷w÷÷÷ ÷÷  4÷ ÷÷÷÷Þ÷÷÷÷÷Z÷È1÷÷!÷°÷÷÷ ÷#÷(÷"/÷$÷&÷'÷*÷/÷)Dj÷+÷-÷.÷5÷0Rù÷1÷3÷4÷7÷<÷6a»÷8÷:÷;÷B÷=r]÷>÷@÷AÈ2÷F÷CÛ÷D÷H÷I÷M÷G„×÷J÷L÷O÷P÷Q÷R÷U÷N˜õ÷S÷X÷V·l÷W÷Z÷[÷\÷]÷`÷Y»ï÷^÷b]÷aÓ÷cÈ3q€]]Ž]]]] ] +±] ]] ž] ]]]]];]]]]]È ]]]] ]8ü]]"]$]!U ]#È4]']%gž]&]7](h+])]*],]4]6]A]8ƒÎ]9]@]B]C]D]E]F]G]H]I]J]K]L]M]N]O]P]Q]R]S]T]U?]Vè]W7]X^‹]Y|B]Z½Ò][ÛÐ]\C]]!¨]^†ž]_¦‹]`Èf]a +]bIÕ]cºÈÜSשÈ'lÈVãȤnÈ´£ÈÈ5È6È7È8È9È:È;Ì5®ÛÛÛÛÛÛÛ Û +Û Û Û ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ Û!Û"Û#Û$Û%Û&Û'Û(Û)Û*Û+Û,Û-Û.Û/Û0Û1Û2Û3Û4Û5Û6Û7Û8Û9Û:Û;Û<Û=Û>Û?Û@ÛAÛBÛCÛDÛEÛFÛGÛHÛIÛJÛKÛLÛMÛNÛOÛPÛQÛRÛSÛTÛUÛVÛWÛXÛYÛZÛ[Û\Û]Û^Û_Û`ÛaÛbÛc>‡v>>>>>>>>> > +> > > >>>>>>>…A’" endstream endobj startxref -1347795 +1348130 %%EOF diff --git a/docs/src/Makefile b/docs/src/Makefile index 41c751163..78c2bc85b 100644 --- a/docs/src/Makefile +++ b/docs/src/Makefile @@ -289,6 +289,7 @@ define initialize @ln -sf $(TEXLNFIL) tmp @ln -sf $(PWD)/lib/* tmp @ln -sf $(PWD)/$(FIGDIR) tmp + @ln -sf $(PWD)/$(FIGDIR)/*png tmp endef #---------------------------------------------------------------------------- diff --git a/docs/src/commrout.tex b/docs/src/commrout.tex index 93a6102f8..bdfd7c1c7 100644 --- a/docs/src/commrout.tex +++ b/docs/src/commrout.tex @@ -87,7 +87,7 @@ An integer value that contains an error code. \begin{figure}[h] \begin{center} \ifcase\pdfoutput -\includegraphics[scale=0.45]{figures/try8x8.png} +\includegraphics[scale=0.45]{try8x8.png} \or \includegraphics[scale=0.45]{figures/try8x8} \fi @@ -265,7 +265,7 @@ their instances. \begin{figure}[h] \begin{center} \ifcase\pdfoutput -\includegraphics[scale=0.65]{figures/try8x8_ov.png} +\includegraphics[scale=0.65]{try8x8_ov.png} \or {\includegraphics[scale=0.65]{figures/try8x8_ov}} \fi diff --git a/docs/src/error.tex b/docs/src/error.tex index f1fbc3c62..a483d3d10 100644 --- a/docs/src/error.tex +++ b/docs/src/error.tex @@ -119,7 +119,7 @@ Aborting... \end{figure} -\clearpage\subsection{psb\_errpush}{Pushes an error code onto the error +\clearpage\subsection{psb\_errpush --- Pushes an error code onto the error stack} @@ -150,7 +150,7 @@ Type: {\bf optional}\\ Specified as: a string.\\ \end{description} -\clearpage\subsection{psb\_error}{Prints the error stack content and aborts +\clearpage\subsection{psb\_error --- Prints the error stack content and aborts execution} \begin{lstlisting} @@ -169,7 +169,7 @@ Specified as: an integer. -\clearpage\subsection{psb\_set\_errverbosity}{Sets the verbosity of error +\clearpage\subsection{psb\_set\_errverbosity --- Sets the verbosity of error messages} @@ -187,7 +187,7 @@ Intent: {\bf in}.\\ Specified as: an integer. \end{description} -\clearpage\subsection{psb\_set\_erraction}{Set the type of action to be +\clearpage\subsection{psb\_set\_erraction --- Set the type of action to be taken upon error condition} \begin{lstlisting} diff --git a/docs/src/figures/points.png b/docs/src/figures/points.png new file mode 100644 index 000000000..097201d34 Binary files /dev/null and b/docs/src/figures/points.png differ diff --git a/docs/src/figures/psblas.png b/docs/src/figures/psblas.png new file mode 100644 index 000000000..c904340d8 Binary files /dev/null and b/docs/src/figures/psblas.png differ diff --git a/docs/src/figures/try8x8.png b/docs/src/figures/try8x8.png new file mode 100644 index 000000000..4ff4882cf Binary files /dev/null and b/docs/src/figures/try8x8.png differ diff --git a/docs/src/figures/try8x8_ov.png b/docs/src/figures/try8x8_ov.png new file mode 100644 index 000000000..a5025abe6 Binary files /dev/null and b/docs/src/figures/try8x8_ov.png differ diff --git a/docs/src/intro.tex b/docs/src/intro.tex index 16cdd969f..0ee391a51 100644 --- a/docs/src/intro.tex +++ b/docs/src/intro.tex @@ -101,7 +101,7 @@ further details on our communication layer see Sec.~\ref{sec:parenv}. \begin{figure}[h] \begin{center} \ifcase\pdfoutput -\includegraphics[scale=0.65]{figures/psblas.png} +\includegraphics[scale=0.65]{psblas.png} \or \includegraphics[scale=0.65]{figures/psblas} \fi @@ -218,7 +218,7 @@ local rows) is $|{\cal I}_i| + |{\cal B}_i| +|{\cal H}_i|$. \begin{center} \ifcase\pdfoutput %\rotatebox{-90}{ -\includegraphics[scale=0.65]{figures/points.png}%} +\includegraphics[scale=0.65]{points.png}%} \or \rotatebox{-90}{\includegraphics[scale=0.65]{figures/points}} \fi diff --git a/prec/Makefile b/prec/Makefile index 0b9079c55..5b9551f25 100644 --- a/prec/Makefile +++ b/prec/Makefile @@ -27,7 +27,7 @@ lib: $(OBJS) impld /bin/cp -p $(CPUPDFLAG) *$(.mod) $(MODDIR) impld: $(OBJS) - cd impl && $(MAKE) + $(MAKE) -C impl $(OBJS): $(MODDIR)/$(BASEMODNAME)$(.mod) diff --git a/test/fileread/psb_cf_sample.f90 b/test/fileread/psb_cf_sample.f90 index 93957db83..8170a446a 100644 --- a/test/fileread/psb_cf_sample.f90 +++ b/test/fileread/psb_cf_sample.f90 @@ -186,7 +186,7 @@ program psb_cf_sample call psb_barrier(ictxt) call distr_mtpart(psb_root_,ictxt) call getv_mtpart(ivg) - call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,v=ivg) + call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,vg=ivg) case default if (iam == psb_root_) write(psb_out_unit,'("Partition type: block")') diff --git a/test/fileread/psb_df_sample.f90 b/test/fileread/psb_df_sample.f90 index 8dd33fea0..17f821b3a 100644 --- a/test/fileread/psb_df_sample.f90 +++ b/test/fileread/psb_df_sample.f90 @@ -186,7 +186,7 @@ program psb_df_sample call psb_barrier(ictxt) call distr_mtpart(psb_root_,ictxt) call getv_mtpart(ivg) - call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,v=ivg) + call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,vg=ivg) case default if (iam == psb_root_) write(psb_out_unit,'("Partition type: block")') diff --git a/test/fileread/psb_sf_sample.f90 b/test/fileread/psb_sf_sample.f90 index 591e78c58..051270883 100644 --- a/test/fileread/psb_sf_sample.f90 +++ b/test/fileread/psb_sf_sample.f90 @@ -186,7 +186,7 @@ program psb_sf_sample call psb_barrier(ictxt) call distr_mtpart(psb_root_,ictxt) call getv_mtpart(ivg) - call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,v=ivg) + call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,vg=ivg) case default if (iam == psb_root_) write(psb_out_unit,'("Partition type: block")') diff --git a/test/fileread/psb_zf_sample.f90 b/test/fileread/psb_zf_sample.f90 index 40c5a0a2f..a2d54e6a2 100644 --- a/test/fileread/psb_zf_sample.f90 +++ b/test/fileread/psb_zf_sample.f90 @@ -186,7 +186,7 @@ program psb_zf_sample call psb_barrier(ictxt) call distr_mtpart(psb_root_,ictxt) call getv_mtpart(ivg) - call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,v=ivg) + call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,vg=ivg) case default if (iam == psb_root_) write(psb_out_unit,'("Partition type: block")') diff --git a/test/kernel/d_file_spmv.f90 b/test/kernel/d_file_spmv.f90 index dc64a65cb..bc4bb38db 100644 --- a/test/kernel/d_file_spmv.f90 +++ b/test/kernel/d_file_spmv.f90 @@ -35,7 +35,8 @@ program d_file_spmv implicit none ! input parameters - character(len=40) :: kmethd, ptype, mtrx_file, rhs_file + character(len=40) :: kmethd, ptype + character(len=512) :: mtrx_file, rhs_file ! sparse matrices type(psb_dspmat_type) :: a, aux_a @@ -66,8 +67,8 @@ program d_file_spmv integer(psb_ipk_) :: iparm(20) ! other variables - integer(psb_ipk_) :: i,info,j,m_problem - integer(psb_ipk_) :: internal, m,ii,nnzero + integer(psb_lpk_) :: i,j,m_problem + integer(psb_ipk_) :: internal, m,ii,nnzero, info real(psb_dpk_) :: t1, t2, r_amax, b_amax,& &scale,resmx,resmxp, flops, bdwdth real(psb_dpk_) :: tt1, tt2, tflops @@ -175,7 +176,7 @@ program d_file_spmv call part_block(i,m_problem,np,ipv,nv) ivg(i) = ipv(1) enddo - call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,v=ivg) + call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,vg=ivg) else if (ipart == 2) then if (iam==psb_root_) then @@ -188,7 +189,7 @@ program d_file_spmv call psb_barrier(ictxt) call distr_mtpart(psb_root_,ictxt) call getv_mtpart(ivg) - call psb_matdist(aux_a, a, ictxt, desc_a,info,fmt=afmt,v=ivg) + call psb_matdist(aux_a, a, ictxt, desc_a,info,fmt=afmt,vg=ivg) else if (iam==psb_root_) write(psb_out_unit,'("Partition type: default block")') diff --git a/test/kernel/pdgenspmv.f90 b/test/kernel/pdgenspmv.f90 index c587f7fab..1a59902f4 100644 --- a/test/kernel/pdgenspmv.f90 +++ b/test/kernel/pdgenspmv.f90 @@ -34,9 +34,10 @@ module psb_d_pde3d_mod - use psb_base_mod, only : psb_dpk_, psb_ipk_, psb_desc_type,& + use psb_base_mod, only : psb_dpk_, psb_ipk_, psb_lpk_, psb_desc_type,& & psb_dspmat_type, psb_d_vect_type, dzero,& - & psb_d_base_sparse_mat, psb_d_base_vect_type, psb_i_base_vect_type + & psb_d_base_sparse_mat, psb_d_base_vect_type, & + & psb_i_base_vect_type, psb_l_base_vect_type interface function d_func_3d(x,y,z) result(val) @@ -49,7 +50,6 @@ module psb_d_pde3d_mod interface psb_gen_pde3d module procedure psb_d_gen_pde3d end interface psb_gen_pde3d - contains @@ -61,14 +61,90 @@ contains val = dzero end function d_null_func_3d + ! + ! functions parametrizing the differential equation + ! + ! + ! Note: b1, b2 and b3 are the coefficients of the first + ! derivative of the unknown function. The default + ! we apply here is to have them zero, so that the resulting + ! matrix is symmetric/hermitian and suitable for + ! testing with CG and FCG. + ! When testing methods for non-hermitian matrices you can + ! change the B1/B2/B3 functions to e.g. done/sqrt((3*done)) + ! + function b1(x,y,z) + use psb_base_mod, only : psb_dpk_, done, dzero + implicit none + real(psb_dpk_) :: b1 + real(psb_dpk_), intent(in) :: x,y,z + b1=dzero + end function b1 + function b2(x,y,z) + use psb_base_mod, only : psb_dpk_, done, dzero + implicit none + real(psb_dpk_) :: b2 + real(psb_dpk_), intent(in) :: x,y,z + b2=dzero + end function b2 + function b3(x,y,z) + use psb_base_mod, only : psb_dpk_, done, dzero + implicit none + real(psb_dpk_) :: b3 + real(psb_dpk_), intent(in) :: x,y,z + b3=dzero + end function b3 + function c(x,y,z) + use psb_base_mod, only : psb_dpk_, done, dzero + implicit none + real(psb_dpk_) :: c + real(psb_dpk_), intent(in) :: x,y,z + c=dzero + end function c + function a1(x,y,z) + use psb_base_mod, only : psb_dpk_, done, dzero + implicit none + real(psb_dpk_) :: a1 + real(psb_dpk_), intent(in) :: x,y,z + a1=done/80 + end function a1 + function a2(x,y,z) + use psb_base_mod, only : psb_dpk_, done, dzero + implicit none + real(psb_dpk_) :: a2 + real(psb_dpk_), intent(in) :: x,y,z + a2=done/80 + end function a2 + function a3(x,y,z) + use psb_base_mod, only : psb_dpk_, done, dzero + implicit none + real(psb_dpk_) :: a3 + real(psb_dpk_), intent(in) :: x,y,z + a3=done/80 + end function a3 + function g(x,y,z) + use psb_base_mod, only : psb_dpk_, done, dzero + implicit none + real(psb_dpk_) :: g + real(psb_dpk_), intent(in) :: x,y,z + g = dzero + if (x == done) then + g = done + else if (x == dzero) then + g = exp(y**2-z**2) + end if + end function g + + ! ! subroutine to allocate and fill in the coefficient matrix and ! the rhs. ! - subroutine psb_d_gen_pde3d(ictxt,idim,a,bv,xv,desc_a,afmt,& - & a1,a2,a3,b1,b2,b3,c,g,info,f,amold,vmold,imold,nrl,iv) + subroutine psb_d_gen_pde3d(ictxt,idim,a,bv,xv,desc_a,afmt,info,& + & f,amold,vmold,imold,partition,nrl,iv) use psb_base_mod + use psb_util_mod ! ! Discretizes the partial differential equation ! @@ -85,7 +161,6 @@ contains ! Note that if b1=b2=b3=c=0., the PDE is the Laplace equation. ! implicit none - procedure(d_func_3d) :: b1,b2,b3,c,a1,a2,a3,g integer(psb_ipk_) :: idim type(psb_dspmat_type) :: a type(psb_d_vect_type) :: xv,bv @@ -96,7 +171,7 @@ contains class(psb_d_base_sparse_mat), optional :: amold class(psb_d_base_vect_type), optional :: vmold class(psb_i_base_vect_type), optional :: imold - integer(psb_ipk_), optional :: nrl,iv(:) + integer(psb_ipk_), optional :: partition, nrl,iv(:) ! Local variables. @@ -105,16 +180,24 @@ contains type(psb_d_coo_sparse_mat) :: acoo type(psb_d_csr_sparse_mat) :: acsr real(psb_dpk_) :: zt(nb),x,y,z - integer(psb_ipk_) :: m,n,nnz,glob_row,nlr,i,ii,ib,k + integer(psb_ipk_) :: nnz,nr,nlr,i,j,ii,ib,k, partition_ + integer(psb_lpk_) :: m,n,glob_row,nt integer(psb_ipk_) :: ix,iy,iz,ia,indx_owner - integer(psb_ipk_) :: np, iam, nr, nt + ! For 3D partition + ! Note: integer control variables going directly into an MPI call + ! must be 4 bytes, i.e. psb_mpk_ + integer(psb_mpk_) :: npdims(3), npp, minfo + integer(psb_ipk_) :: npx,npy,npz, iamx,iamy,iamz,mynx,myny,mynz + integer(psb_ipk_), allocatable :: bndx(:),bndy(:),bndz(:) + ! Process grid + integer(psb_ipk_) :: np, iam integer(psb_ipk_) :: icoeff - integer(psb_ipk_), allocatable :: irow(:),icol(:),myidx(:) + integer(psb_lpk_), allocatable :: irow(:),icol(:),myidx(:) real(psb_dpk_), allocatable :: val(:) ! deltah dimension of each grid cell ! deltat discretization time real(psb_dpk_) :: deltah, sqdeltah, deltah2 - real(psb_dpk_), parameter :: rhs=0.d0,one=1.d0,zero=0.d0 + real(psb_dpk_), parameter :: rhs=dzero,one=done,zero=dzero real(psb_dpk_) :: t0, t1, t2, t3, tasb, talc, ttot, tgen, tcdasb integer(psb_ipk_) :: err_act procedure(d_func_3d), pointer :: f_ @@ -133,19 +216,32 @@ contains f_ => d_null_func_3d end if - deltah = 1.d0/(idim+2) + deltah = done/(idim+1) sqdeltah = deltah*deltah - deltah2 = 2.d0* deltah + deltah2 = (2*done)* deltah + if (present(partition)) then + if ((1<= partition).and.(partition <= 3)) then + partition_ = partition + else + write(*,*) 'Invalid partition choice ',partition,' defaulting to 3' + partition_ = 3 + end if + else + partition_ = 3 + end if + ! initialize array descriptor and sparse matrix storage. provide an ! estimate of the number of non zeroes - - m = idim*idim*idim + + m = (1_psb_lpk_*idim)*idim*idim n = m - nnz = ((n*9)/(np)) + nnz = ((n*7)/(np)) if(iam == psb_root_) write(psb_out_unit,'("Generating Matrix (size=",i0,")...")')n - - if (.not.present(iv)) then + t0 = psb_wtime() + select case(partition_) + case(1) + ! A BLOCK partition if (present(nrl)) then nr = nrl else @@ -165,24 +261,99 @@ contains call psb_abort(ictxt) return end if - else - if (size(iv) /= m) then - write(psb_err_unit,*) iam, 'Initialization error IV',size(iv),m + + ! + ! First example of use of CDALL: specify for each process a number of + ! contiguous rows + ! + call psb_cdall(ictxt,desc_a,info,nl=nr) + myidx = desc_a%get_global_indices() + nlr = size(myidx) + + case(2) + ! A partition defined by the user through IV + + if (present(iv)) then + if (size(iv) /= m) then + write(psb_err_unit,*) iam, 'Initialization error: wrong IV size',size(iv),m + info = -1 + call psb_barrier(ictxt) + call psb_abort(ictxt) + return + end if + else + write(psb_err_unit,*) iam, 'Initialization error: IV not present' info = -1 call psb_barrier(ictxt) call psb_abort(ictxt) return end if - end if - call psb_barrier(ictxt) - t0 = psb_wtime() - if (present(iv)) then + ! + ! Second example of use of CDALL: specify for each row the + ! process that owns it + ! call psb_cdall(ictxt,desc_a,info,vg=iv) - else - call psb_cdall(ictxt,desc_a,info,nl=nr) - end if + myidx = desc_a%get_global_indices() + nlr = size(myidx) + case(3) + ! A 3-dimensional partition + + ! A nifty MPI function will split the process list + npdims = 0 + call mpi_dims_create(np,3,npdims,info) + npx = npdims(1) + npy = npdims(2) + npz = npdims(3) + + allocate(bndx(0:npx),bndy(0:npy),bndz(0:npz)) + ! We can reuse idx2ijk for process indices as well. + call idx2ijk(iamx,iamy,iamz,iam,npx,npy,npz,base=0) + ! Now let's split the 3D cube in hexahedra + call dist1Didx(bndx,idim,npx) + mynx = bndx(iamx+1)-bndx(iamx) + call dist1Didx(bndy,idim,npy) + myny = bndy(iamy+1)-bndy(iamy) + call dist1Didx(bndz,idim,npz) + mynz = bndz(iamz+1)-bndz(iamz) + + ! How many indices do I own? + nlr = mynx*myny*mynz + allocate(myidx(nlr)) + ! Now, let's generate the list of indices I own + nr = 0 + do i=bndx(iamx),bndx(iamx+1)-1 + do j=bndy(iamy),bndy(iamy+1)-1 + do k=bndz(iamz),bndz(iamz+1)-1 + nr = nr + 1 + call ijk2idx(myidx(nr),i,j,k,idim,idim,idim) + end do + end do + end do + if (nr /= nlr) then + write(psb_err_unit,*) iam,iamx,iamy,iamz, 'Initialization error: NR vs NLR ',& + & nr,nlr,mynx,myny,mynz + info = -1 + call psb_barrier(ictxt) + call psb_abort(ictxt) + end if + + ! + ! Third example of use of CDALL: specify for each process + ! the set of global indices it owns. + ! + call psb_cdall(ictxt,desc_a,info,vl=myidx) + + case default + write(psb_err_unit,*) iam, 'Initialization error: should not get here' + info = -1 + call psb_barrier(ictxt) + call psb_abort(ictxt) + return + end select + + if (info == psb_success_) call psb_spall(a,desc_a,info,nnz=nnz) ! define rhs from boundary conditions; also build initial guess if (info == psb_success_) call psb_geall(xv,desc_a,info) @@ -210,8 +381,6 @@ contains goto 9999 endif - myidx = desc_a%get_global_indices() - nlr = size(myidx) ! loop over rows belonging to current process in a block ! distribution. @@ -226,18 +395,8 @@ contains ! local matrix pointer glob_row=myidx(i) ! compute gridpoint coordinates - if (mod(glob_row,(idim*idim)) == 0) then - ix = glob_row/(idim*idim) - else - ix = glob_row/(idim*idim)+1 - endif - if (mod((glob_row-(ix-1)*idim*idim),idim) == 0) then - iy = (glob_row-(ix-1)*idim*idim)/idim - else - iy = (glob_row-(ix-1)*idim*idim)/idim+1 - endif - iz = glob_row-(ix-1)*idim*idim-(iy-1)*idim - ! x, y, x coordinates + call idx2ijk(ix,iy,iz,glob_row,idim,idim,idim) + ! x, y, z coordinates x = (ix-1)*deltah y = (iy-1)*deltah z = (iz-1)*deltah @@ -250,7 +409,7 @@ contains if (ix == 1) then zt(k) = g(dzero,y,z)*(-val(icoeff)) + zt(k) else - icol(icoeff) = (ix-2)*idim*idim+(iy-1)*idim+(iz) + call ijk2idx(icol(icoeff),ix-1,iy,iz,idim,idim,idim) irow(icoeff) = glob_row icoeff = icoeff+1 endif @@ -259,7 +418,7 @@ contains if (iy == 1) then zt(k) = g(x,dzero,z)*(-val(icoeff)) + zt(k) else - icol(icoeff) = (ix-1)*idim*idim+(iy-2)*idim+(iz) + call ijk2idx(icol(icoeff),ix,iy-1,iz,idim,idim,idim) irow(icoeff) = glob_row icoeff = icoeff+1 endif @@ -268,15 +427,15 @@ contains if (iz == 1) then zt(k) = g(x,y,dzero)*(-val(icoeff)) + zt(k) else - icol(icoeff) = (ix-1)*idim*idim+(iy-1)*idim+(iz-1) + call ijk2idx(icol(icoeff),ix,iy,iz-1,idim,idim,idim) irow(icoeff) = glob_row icoeff = icoeff+1 endif ! term depending on (x,y,z) - val(icoeff)=2.d0*(a1(x,y,z)+a2(x,y,z)+a3(x,y,z))/sqdeltah & + val(icoeff)=(2*done)*(a1(x,y,z)+a2(x,y,z)+a3(x,y,z))/sqdeltah & & + c(x,y,z) - icol(icoeff) = (ix-1)*idim*idim+(iy-1)*idim+(iz) + call ijk2idx(icol(icoeff),ix,iy,iz,idim,idim,idim) irow(icoeff) = glob_row icoeff = icoeff+1 ! term depending on (x,y,z+1) @@ -284,7 +443,7 @@ contains if (iz == idim) then zt(k) = g(x,y,done)*(-val(icoeff)) + zt(k) else - icol(icoeff) = (ix-1)*idim*idim+(iy-1)*idim+(iz+1) + call ijk2idx(icol(icoeff),ix,iy,iz+1,idim,idim,idim) irow(icoeff) = glob_row icoeff = icoeff+1 endif @@ -293,7 +452,7 @@ contains if (iy == idim) then zt(k) = g(x,done,z)*(-val(icoeff)) + zt(k) else - icol(icoeff) = (ix-1)*idim*idim+(iy)*idim+(iz) + call ijk2idx(icol(icoeff),ix,iy+1,iz,idim,idim,idim) irow(icoeff) = glob_row icoeff = icoeff+1 endif @@ -302,7 +461,7 @@ contains if (ix==idim) then zt(k) = g(done,y,z)*(-val(icoeff)) + zt(k) else - icol(icoeff) = (ix)*idim*idim+(iy-1)*idim+(iz) + call ijk2idx(icol(icoeff),ix+1,iy,iz,idim,idim,idim) irow(icoeff) = glob_row icoeff = icoeff+1 endif @@ -312,7 +471,7 @@ contains if(info /= psb_success_) exit call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info) if(info /= psb_success_) exit - zt(:)=0.d0 + zt(:)=dzero call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info) if(info /= psb_success_) exit end do @@ -397,7 +556,7 @@ program pdgenspmv integer(psb_ipk_) :: idim ! miscellaneous - real(psb_dpk_), parameter :: one = 1.d0 + real(psb_dpk_), parameter :: one = done real(psb_dpk_) :: t1, t2, tprec, flops, tflops, tt1, tt2, bdwdth ! sparse matrix and preconditioner @@ -411,7 +570,7 @@ program pdgenspmv integer(psb_ipk_) :: ictxt, iam, np ! solver parameters - integer(psb_ipk_) :: iter, itmax,itrace, istopc, irst, nr + integer(psb_ipk_) :: iter, itmax,itrace, istopc, irst, nr, ipart integer(psb_epk_) :: amatsize, precsize, descsize, d2size, annz, nbytes real(psb_dpk_) :: err, eps integer(psb_ipk_), parameter :: times=10 @@ -452,8 +611,7 @@ program pdgenspmv ! call psb_barrier(ictxt) t1 = psb_wtime() - call psb_gen_pde3d(ictxt,idim,a,bv,xv,desc_a,afmt,& - & a1,a2,a3,b1,b2,b3,c,g,info) + call psb_gen_pde3d(ictxt,idim,a,bv,xv,desc_a,afmt,info) call psb_barrier(ictxt) t2 = psb_wtime() - t1 if(info /= psb_success_) then @@ -607,61 +765,4 @@ contains write(iout,*)' >= 1 do tracing every itrace' write(iout,*)' iterations ' end subroutine pr_usage - - ! - ! functions parametrizing the differential equation - ! - function b1(x,y,z) - use psb_base_mod, only : psb_dpk_ - real(psb_dpk_) :: b1 - real(psb_dpk_), intent(in) :: x,y,z - b1=1.d0/sqrt(3.d0) - end function b1 - function b2(x,y,z) - use psb_base_mod, only : psb_dpk_ - real(psb_dpk_) :: b2 - real(psb_dpk_), intent(in) :: x,y,z - b2=1.d0/sqrt(3.d0) - end function b2 - function b3(x,y,z) - use psb_base_mod, only : psb_dpk_ - real(psb_dpk_) :: b3 - real(psb_dpk_), intent(in) :: x,y,z - b3=1.d0/sqrt(3.d0) - end function b3 - function c(x,y,z) - use psb_base_mod, only : psb_dpk_ - real(psb_dpk_) :: c - real(psb_dpk_), intent(in) :: x,y,z - c=0.d0 - end function c - function a1(x,y,z) - use psb_base_mod, only : psb_dpk_ - real(psb_dpk_) :: a1 - real(psb_dpk_), intent(in) :: x,y,z - a1=1.d0/80 - end function a1 - function a2(x,y,z) - use psb_base_mod, only : psb_dpk_ - real(psb_dpk_) :: a2 - real(psb_dpk_), intent(in) :: x,y,z - a2=1.d0/80 - end function a2 - function a3(x,y,z) - use psb_base_mod, only : psb_dpk_ - real(psb_dpk_) :: a3 - real(psb_dpk_), intent(in) :: x,y,z - a3=1.d0/80 - end function a3 - function g(x,y,z) - use psb_base_mod, only : psb_dpk_, done - real(psb_dpk_) :: g - real(psb_dpk_), intent(in) :: x,y,z - g = dzero - if (x == done) then - g = done - else if (x == dzero) then - g = exp(y**2-z**2) - end if - end function g end program pdgenspmv diff --git a/test/kernel/s_file_spmv.f90 b/test/kernel/s_file_spmv.f90 index fd3b415f3..68decacdb 100644 --- a/test/kernel/s_file_spmv.f90 +++ b/test/kernel/s_file_spmv.f90 @@ -66,8 +66,8 @@ program s_file_spmv integer(psb_ipk_) :: iparm(20) ! other variables - integer(psb_ipk_) :: i,info,j,m_problem - integer(psb_ipk_) :: internal, m,ii,nnzero + integer(psb_lpk_) :: i,j,m_problem + integer(psb_ipk_) :: internal, m,ii,nnzero,info real(psb_dpk_) :: t1, t2, r_amax, b_amax,& &scale,resmx,resmxp, flops, bdwdth real(psb_dpk_) :: tt1, tt2, tflops @@ -175,7 +175,7 @@ program s_file_spmv call part_block(i,m_problem,np,ipv,nv) ivg(i) = ipv(1) enddo - call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,v=ivg) + call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,vg=ivg) else if (ipart == 2) then if (iam==psb_root_) then @@ -188,7 +188,7 @@ program s_file_spmv call psb_barrier(ictxt) call distr_mtpart(psb_root_,ictxt) call getv_mtpart(ivg) - call psb_matdist(aux_a, a, ictxt, desc_a,info,fmt=afmt,v=ivg) + call psb_matdist(aux_a, a, ictxt, desc_a,info,fmt=afmt,vg=ivg) else if (iam==psb_root_) write(psb_out_unit,'("Partition type: default block")') diff --git a/util/psb_c_mat_dist_impl.f90 b/util/psb_c_mat_dist_impl.f90 index dfaeac251..7767ce2e2 100644 --- a/util/psb_c_mat_dist_impl.f90 +++ b/util/psb_c_mat_dist_impl.f90 @@ -30,7 +30,7 @@ ! ! subroutine psb_cmatdist(a_glob, a, ictxt, desc_a,& - & info, parts, v, inroot,fmt,mold) + & info, parts, vg, vsz, inroot,fmt,mold) ! ! an utility subroutine to distribute a matrix among processors ! according to a user defined data distribution, using @@ -83,14 +83,15 @@ subroutine psb_cmatdist(a_glob, a, ictxt, desc_a,& character(len=*), optional :: fmt class(psb_c_base_sparse_mat), optional :: mold procedure(psb_parts), optional :: parts - integer(psb_ipk_), optional :: v(:) + integer(psb_ipk_), optional :: vg(:) + integer(psb_ipk_), optional :: vsz(:) ! local variables - logical :: use_parts, use_v + logical :: use_parts, use_vg, use_vsz integer(psb_ipk_) :: np, iam, np_sharing integer(psb_ipk_) :: k_count, root, liwork, nnzero, nrhs,& & i, ll, nz, isize, iproc, nnr, err, err_act - integer(psb_lpk_) :: i_count, j_count, nrow, ncol, ig + integer(psb_lpk_) :: i_count, j_count, nrow, ncol, ig, lastigp integer(psb_ipk_), allocatable :: iwork(:), iwrk2(:) integer(psb_lpk_), allocatable :: irow(:),icol(:) complex(psb_spk_), allocatable :: val(:) @@ -110,6 +111,16 @@ subroutine psb_cmatdist(a_glob, a, ictxt, desc_a,& root = psb_root_ end if call psb_info(ictxt, iam, np) + + use_parts = present(parts) + use_vg = present(vg) + use_vsz = present(vsz) + if (count((/ use_parts, use_vg, use_vsz /)) /= 1) then + info=psb_err_no_optional_arg_ + call psb_errpush(info,name,a_err=" vg, vsz, parts") + goto 9999 + endif + if (iam == root) then nrow = a_glob%get_nrows() ncol = a_glob%get_ncols() @@ -121,16 +132,13 @@ subroutine psb_cmatdist(a_glob, a, ictxt, desc_a,& endif nnzero = a_glob%get_nzeros() nrhs = 1 + if (use_vsz) then + if (sum(vsz(1:np)) /= nrow) then + write(0,*) 'Input data mismatch :',nrow,sum(vsz(1:np)) + end if + end if + endif - - use_parts = present(parts) - use_v = present(v) - if (count((/ use_parts, use_v /)) /= 1) then - info=psb_err_no_optional_arg_ - call psb_errpush(info,name,a_err=" v, parts") - goto 9999 - endif - ! broadcast informations to other processors call psb_bcast(ictxt,nrow, root) call psb_bcast(ictxt,ncol, root) @@ -149,8 +157,10 @@ subroutine psb_cmatdist(a_glob, a, ictxt, desc_a,& endif if (use_parts) then call psb_cdall(ictxt,desc_a,info,mg=nrow,parts=parts) - else if (use_v) then - call psb_cdall(ictxt,desc_a,info,vg=v) + else if (use_vg) then + call psb_cdall(ictxt,desc_a,info,vg=vg) + else if (use_vsz) then + call psb_cdall(ictxt,desc_a,info,nl=vsz(iam+1)) else info = -1 end if @@ -178,7 +188,10 @@ subroutine psb_cmatdist(a_glob, a, ictxt, desc_a,& end if i_count = 1 - + if (use_vsz) then + iproc = 0 + lastigp = vsz(iproc+1) + end if do while (i_count <= nrow) if (use_parts) then @@ -202,17 +215,27 @@ subroutine psb_cmatdist(a_glob, a, ictxt, desc_a,& if (iwrk2(1) /= iproc ) exit end do end if - else + else if (use_vg) then np_sharing = 1 j_count = i_count - iproc = v(i_count) + iproc = vg(i_count) iwork(1:np_sharing) = iproc do j_count = j_count + 1 if (j_count-i_count >= nb) exit if (j_count > nrow) exit - if (v(j_count) /= iproc ) exit + if (vg(j_count) /= iproc ) exit end do + else if (use_vsz) then + np_sharing = 1 + j_count = i_count + iwork(1:np_sharing) = iproc + do + j_count = j_count + 1 + if (j_count-i_count >= nb) exit + if (j_count > nrow) exit + if (j_count > lastigp) exit + end do end if ! now we should insert rows i_count..j_count-1 @@ -288,6 +311,12 @@ subroutine psb_cmatdist(a_glob, a, ictxt, desc_a,& end do endif i_count = j_count + if ((use_vsz).and.(j_count <= nrow)) then + if (j_count > lastigp) then + iproc = iproc + 1 + lastigp = lastigp + vsz(iproc+1) + end if + end if end do call psb_barrier(ictxt) @@ -342,7 +371,7 @@ end subroutine psb_cmatdist subroutine psb_lcmatdist(a_glob, a, ictxt, desc_a,& - & info, parts, v, inroot,fmt,mold) + & info, parts, vg, vsz, inroot,fmt,mold) ! ! an utility subroutine to distribute a matrix among processors ! according to a user defined data distribution, using @@ -395,15 +424,16 @@ subroutine psb_lcmatdist(a_glob, a, ictxt, desc_a,& character(len=*), optional :: fmt class(psb_c_base_sparse_mat), optional :: mold procedure(psb_parts), optional :: parts - integer(psb_ipk_), optional :: v(:) - + integer(psb_ipk_), optional :: vg(:) + integer(psb_ipk_), optional :: vsz(:) + ! local variables - logical :: use_parts, use_v + logical :: use_parts, use_vg, use_vsz integer(psb_ipk_) :: np, iam, np_sharing, root, iproc integer(psb_ipk_) :: err_act, il, inz integer(psb_lpk_) :: k_count, liwork, nnzero, nrhs,& & i, ll, nz, isize, nnr, err - integer(psb_lpk_) :: i_count, j_count, nrow, ncol, ig + integer(psb_lpk_) :: i_count, j_count, nrow, ncol, ig, lastigp integer(psb_ipk_), allocatable :: iwork(:), iwrk2(:) integer(psb_lpk_), allocatable :: irow(:),icol(:) complex(psb_spk_), allocatable :: val(:) @@ -437,10 +467,11 @@ subroutine psb_lcmatdist(a_glob, a, ictxt, desc_a,& endif use_parts = present(parts) - use_v = present(v) - if (count((/ use_parts, use_v /)) /= 1) then + use_vg = present(vg) + use_vsz = present(vsz) + if (count((/ use_parts, use_vg, use_vsz /)) /= 1) then info=psb_err_no_optional_arg_ - call psb_errpush(info,name,a_err=" v, parts") + call psb_errpush(info,name,a_err=" vg, vsz, parts") goto 9999 endif @@ -462,8 +493,10 @@ subroutine psb_lcmatdist(a_glob, a, ictxt, desc_a,& endif if (use_parts) then call psb_cdall(ictxt,desc_a,info,mg=nrow,parts=parts) - else if (use_v) then - call psb_cdall(ictxt,desc_a,info,vg=v) + else if (use_vg) then + call psb_cdall(ictxt,desc_a,info,vg=vg) + else if (use_vsz) then + call psb_cdall(ictxt,desc_a,info,nl=vsz(iam+1)) else info = -1 end if @@ -492,7 +525,10 @@ subroutine psb_lcmatdist(a_glob, a, ictxt, desc_a,& end if i_count = 1 - + if (use_vsz) then + iproc = 0 + lastigp = vsz(iproc+1) + end if do while (i_count <= nrow) if (use_parts) then @@ -516,17 +552,27 @@ subroutine psb_lcmatdist(a_glob, a, ictxt, desc_a,& if (iwrk2(1) /= iproc ) exit end do end if - else + else if (use_vg) then np_sharing = 1 j_count = i_count - iproc = v(i_count) + iproc = vg(i_count) iwork(1:np_sharing) = iproc do j_count = j_count + 1 if (j_count-i_count >= nb) exit if (j_count > nrow) exit - if (v(j_count) /= iproc ) exit + if (vg(j_count) /= iproc ) exit end do + else if (use_vsz) then + np_sharing = 1 + j_count = i_count + iwork(1:np_sharing) = iproc + do + j_count = j_count + 1 + if (j_count-i_count >= nb) exit + if (j_count > nrow) exit + if (j_count > lastigp) exit + end do end if ! now we should insert rows i_count..j_count-1 @@ -604,6 +650,12 @@ subroutine psb_lcmatdist(a_glob, a, ictxt, desc_a,& end do endif i_count = j_count + if ((use_vsz).and.(j_count <= nrow)) then + if (j_count > lastigp) then + iproc = iproc + 1 + lastigp = lastigp + vsz(iproc+1) + end if + end if end do call psb_barrier(ictxt) diff --git a/util/psb_c_mat_dist_mod.f90 b/util/psb_c_mat_dist_mod.f90 index 422f4e963..c46efd2f4 100644 --- a/util/psb_c_mat_dist_mod.f90 +++ b/util/psb_c_mat_dist_mod.f90 @@ -36,7 +36,7 @@ module psb_c_mat_dist_mod interface psb_matdist subroutine psb_cmatdist(a_glob, a, ictxt, desc_a,& - & info, parts, v, inroot,fmt,mold) + & info, parts, vg, vsz, inroot,fmt,mold) ! ! an utility subroutine to distribute a matrix among processors ! according to a user defined data distribution, using @@ -90,10 +90,11 @@ module psb_c_mat_dist_mod character(len=*), optional :: fmt class(psb_c_base_sparse_mat), optional :: mold procedure(psb_parts), optional :: parts - integer(psb_ipk_), optional :: v(:) + integer(psb_ipk_), optional :: vg(:) + integer(psb_ipk_), optional :: vsz(:) end subroutine psb_cmatdist subroutine psb_lcmatdist(a_glob, a, ictxt, desc_a,& - & info, parts, v, inroot,fmt,mold) + & info, parts, vg, vsz, inroot,fmt,mold) ! ! an utility subroutine to distribute a matrix among processors ! according to a user defined data distribution, using @@ -148,7 +149,8 @@ module psb_c_mat_dist_mod character(len=*), optional :: fmt class(psb_c_base_sparse_mat), optional :: mold procedure(psb_parts), optional :: parts - integer(psb_ipk_), optional :: v(:) + integer(psb_ipk_), optional :: vg(:) + integer(psb_ipk_), optional :: vsz(:) end subroutine psb_lcmatdist end interface diff --git a/util/psb_d_mat_dist_impl.f90 b/util/psb_d_mat_dist_impl.f90 index 90236db29..17df5f696 100644 --- a/util/psb_d_mat_dist_impl.f90 +++ b/util/psb_d_mat_dist_impl.f90 @@ -30,7 +30,7 @@ ! ! subroutine psb_dmatdist(a_glob, a, ictxt, desc_a,& - & info, parts, v, inroot,fmt,mold) + & info, parts, vg, vsz, inroot,fmt,mold) ! ! an utility subroutine to distribute a matrix among processors ! according to a user defined data distribution, using @@ -83,14 +83,15 @@ subroutine psb_dmatdist(a_glob, a, ictxt, desc_a,& character(len=*), optional :: fmt class(psb_d_base_sparse_mat), optional :: mold procedure(psb_parts), optional :: parts - integer(psb_ipk_), optional :: v(:) + integer(psb_ipk_), optional :: vg(:) + integer(psb_ipk_), optional :: vsz(:) ! local variables - logical :: use_parts, use_v + logical :: use_parts, use_vg, use_vsz integer(psb_ipk_) :: np, iam, np_sharing integer(psb_ipk_) :: k_count, root, liwork, nnzero, nrhs,& & i, ll, nz, isize, iproc, nnr, err, err_act - integer(psb_lpk_) :: i_count, j_count, nrow, ncol, ig + integer(psb_lpk_) :: i_count, j_count, nrow, ncol, ig, lastigp integer(psb_ipk_), allocatable :: iwork(:), iwrk2(:) integer(psb_lpk_), allocatable :: irow(:),icol(:) real(psb_dpk_), allocatable :: val(:) @@ -110,6 +111,16 @@ subroutine psb_dmatdist(a_glob, a, ictxt, desc_a,& root = psb_root_ end if call psb_info(ictxt, iam, np) + + use_parts = present(parts) + use_vg = present(vg) + use_vsz = present(vsz) + if (count((/ use_parts, use_vg, use_vsz /)) /= 1) then + info=psb_err_no_optional_arg_ + call psb_errpush(info,name,a_err=" vg, vsz, parts") + goto 9999 + endif + if (iam == root) then nrow = a_glob%get_nrows() ncol = a_glob%get_ncols() @@ -121,16 +132,13 @@ subroutine psb_dmatdist(a_glob, a, ictxt, desc_a,& endif nnzero = a_glob%get_nzeros() nrhs = 1 + if (use_vsz) then + if (sum(vsz(1:np)) /= nrow) then + write(0,*) 'Input data mismatch :',nrow,sum(vsz(1:np)) + end if + end if + endif - - use_parts = present(parts) - use_v = present(v) - if (count((/ use_parts, use_v /)) /= 1) then - info=psb_err_no_optional_arg_ - call psb_errpush(info,name,a_err=" v, parts") - goto 9999 - endif - ! broadcast informations to other processors call psb_bcast(ictxt,nrow, root) call psb_bcast(ictxt,ncol, root) @@ -149,8 +157,10 @@ subroutine psb_dmatdist(a_glob, a, ictxt, desc_a,& endif if (use_parts) then call psb_cdall(ictxt,desc_a,info,mg=nrow,parts=parts) - else if (use_v) then - call psb_cdall(ictxt,desc_a,info,vg=v) + else if (use_vg) then + call psb_cdall(ictxt,desc_a,info,vg=vg) + else if (use_vsz) then + call psb_cdall(ictxt,desc_a,info,nl=vsz(iam+1)) else info = -1 end if @@ -178,7 +188,10 @@ subroutine psb_dmatdist(a_glob, a, ictxt, desc_a,& end if i_count = 1 - + if (use_vsz) then + iproc = 0 + lastigp = vsz(iproc+1) + end if do while (i_count <= nrow) if (use_parts) then @@ -202,17 +215,27 @@ subroutine psb_dmatdist(a_glob, a, ictxt, desc_a,& if (iwrk2(1) /= iproc ) exit end do end if - else + else if (use_vg) then np_sharing = 1 j_count = i_count - iproc = v(i_count) + iproc = vg(i_count) iwork(1:np_sharing) = iproc do j_count = j_count + 1 if (j_count-i_count >= nb) exit if (j_count > nrow) exit - if (v(j_count) /= iproc ) exit + if (vg(j_count) /= iproc ) exit end do + else if (use_vsz) then + np_sharing = 1 + j_count = i_count + iwork(1:np_sharing) = iproc + do + j_count = j_count + 1 + if (j_count-i_count >= nb) exit + if (j_count > nrow) exit + if (j_count > lastigp) exit + end do end if ! now we should insert rows i_count..j_count-1 @@ -288,6 +311,12 @@ subroutine psb_dmatdist(a_glob, a, ictxt, desc_a,& end do endif i_count = j_count + if ((use_vsz).and.(j_count <= nrow)) then + if (j_count > lastigp) then + iproc = iproc + 1 + lastigp = lastigp + vsz(iproc+1) + end if + end if end do call psb_barrier(ictxt) @@ -342,7 +371,7 @@ end subroutine psb_dmatdist subroutine psb_ldmatdist(a_glob, a, ictxt, desc_a,& - & info, parts, v, inroot,fmt,mold) + & info, parts, vg, vsz, inroot,fmt,mold) ! ! an utility subroutine to distribute a matrix among processors ! according to a user defined data distribution, using @@ -395,15 +424,16 @@ subroutine psb_ldmatdist(a_glob, a, ictxt, desc_a,& character(len=*), optional :: fmt class(psb_d_base_sparse_mat), optional :: mold procedure(psb_parts), optional :: parts - integer(psb_ipk_), optional :: v(:) - + integer(psb_ipk_), optional :: vg(:) + integer(psb_ipk_), optional :: vsz(:) + ! local variables - logical :: use_parts, use_v + logical :: use_parts, use_vg, use_vsz integer(psb_ipk_) :: np, iam, np_sharing, root, iproc integer(psb_ipk_) :: err_act, il, inz integer(psb_lpk_) :: k_count, liwork, nnzero, nrhs,& & i, ll, nz, isize, nnr, err - integer(psb_lpk_) :: i_count, j_count, nrow, ncol, ig + integer(psb_lpk_) :: i_count, j_count, nrow, ncol, ig, lastigp integer(psb_ipk_), allocatable :: iwork(:), iwrk2(:) integer(psb_lpk_), allocatable :: irow(:),icol(:) real(psb_dpk_), allocatable :: val(:) @@ -437,10 +467,11 @@ subroutine psb_ldmatdist(a_glob, a, ictxt, desc_a,& endif use_parts = present(parts) - use_v = present(v) - if (count((/ use_parts, use_v /)) /= 1) then + use_vg = present(vg) + use_vsz = present(vsz) + if (count((/ use_parts, use_vg, use_vsz /)) /= 1) then info=psb_err_no_optional_arg_ - call psb_errpush(info,name,a_err=" v, parts") + call psb_errpush(info,name,a_err=" vg, vsz, parts") goto 9999 endif @@ -462,8 +493,10 @@ subroutine psb_ldmatdist(a_glob, a, ictxt, desc_a,& endif if (use_parts) then call psb_cdall(ictxt,desc_a,info,mg=nrow,parts=parts) - else if (use_v) then - call psb_cdall(ictxt,desc_a,info,vg=v) + else if (use_vg) then + call psb_cdall(ictxt,desc_a,info,vg=vg) + else if (use_vsz) then + call psb_cdall(ictxt,desc_a,info,nl=vsz(iam+1)) else info = -1 end if @@ -492,7 +525,10 @@ subroutine psb_ldmatdist(a_glob, a, ictxt, desc_a,& end if i_count = 1 - + if (use_vsz) then + iproc = 0 + lastigp = vsz(iproc+1) + end if do while (i_count <= nrow) if (use_parts) then @@ -516,17 +552,27 @@ subroutine psb_ldmatdist(a_glob, a, ictxt, desc_a,& if (iwrk2(1) /= iproc ) exit end do end if - else + else if (use_vg) then np_sharing = 1 j_count = i_count - iproc = v(i_count) + iproc = vg(i_count) iwork(1:np_sharing) = iproc do j_count = j_count + 1 if (j_count-i_count >= nb) exit if (j_count > nrow) exit - if (v(j_count) /= iproc ) exit + if (vg(j_count) /= iproc ) exit end do + else if (use_vsz) then + np_sharing = 1 + j_count = i_count + iwork(1:np_sharing) = iproc + do + j_count = j_count + 1 + if (j_count-i_count >= nb) exit + if (j_count > nrow) exit + if (j_count > lastigp) exit + end do end if ! now we should insert rows i_count..j_count-1 @@ -604,6 +650,12 @@ subroutine psb_ldmatdist(a_glob, a, ictxt, desc_a,& end do endif i_count = j_count + if ((use_vsz).and.(j_count <= nrow)) then + if (j_count > lastigp) then + iproc = iproc + 1 + lastigp = lastigp + vsz(iproc+1) + end if + end if end do call psb_barrier(ictxt) diff --git a/util/psb_d_mat_dist_mod.f90 b/util/psb_d_mat_dist_mod.f90 index beb7f113d..dc0e49581 100644 --- a/util/psb_d_mat_dist_mod.f90 +++ b/util/psb_d_mat_dist_mod.f90 @@ -36,7 +36,7 @@ module psb_d_mat_dist_mod interface psb_matdist subroutine psb_dmatdist(a_glob, a, ictxt, desc_a,& - & info, parts, v, inroot,fmt,mold) + & info, parts, vg, vsz, inroot,fmt,mold) ! ! an utility subroutine to distribute a matrix among processors ! according to a user defined data distribution, using @@ -90,10 +90,11 @@ module psb_d_mat_dist_mod character(len=*), optional :: fmt class(psb_d_base_sparse_mat), optional :: mold procedure(psb_parts), optional :: parts - integer(psb_ipk_), optional :: v(:) + integer(psb_ipk_), optional :: vg(:) + integer(psb_ipk_), optional :: vsz(:) end subroutine psb_dmatdist subroutine psb_ldmatdist(a_glob, a, ictxt, desc_a,& - & info, parts, v, inroot,fmt,mold) + & info, parts, vg, vsz, inroot,fmt,mold) ! ! an utility subroutine to distribute a matrix among processors ! according to a user defined data distribution, using @@ -148,7 +149,8 @@ module psb_d_mat_dist_mod character(len=*), optional :: fmt class(psb_d_base_sparse_mat), optional :: mold procedure(psb_parts), optional :: parts - integer(psb_ipk_), optional :: v(:) + integer(psb_ipk_), optional :: vg(:) + integer(psb_ipk_), optional :: vsz(:) end subroutine psb_ldmatdist end interface diff --git a/util/psb_i_mmio_impl.f90 b/util/psb_i_mmio_impl.F90 similarity index 99% rename from util/psb_i_mmio_impl.f90 rename to util/psb_i_mmio_impl.F90 index 9a071721e..6d7367b58 100644 --- a/util/psb_i_mmio_impl.f90 +++ b/util/psb_i_mmio_impl.F90 @@ -284,8 +284,7 @@ subroutine mm_ivet1_write(b, header, info, iunit, filename) end subroutine mm_ivet1_write - - +#if defined(IPK4) && defined(LPK8) subroutine mm_lvet_read(b, info, iunit, filename) use psb_base_mod implicit none @@ -536,4 +535,4 @@ subroutine mm_lvet1_write(b, header, info, iunit, filename) end subroutine mm_lvet1_write - +#endif diff --git a/util/psb_mmio_mod.F90 b/util/psb_mmio_mod.F90 index 71fa53b7b..d02b514b0 100644 --- a/util/psb_mmio_mod.F90 +++ b/util/psb_mmio_mod.F90 @@ -125,6 +125,7 @@ module psb_mmio_mod integer(psb_ipk_), optional, intent(in) :: iunit character(len=*), optional, intent(in) :: filename end subroutine mm_ivet2_read +#if defined(IPK4) && defined(LPK8) subroutine mm_lvet_read(b, info, iunit, filename) import :: psb_dpk_, psb_ipk_, psb_lpk_ implicit none @@ -141,6 +142,7 @@ module psb_mmio_mod integer(psb_ipk_), optional, intent(in) :: iunit character(len=*), optional, intent(in) :: filename end subroutine mm_lvet2_read +#endif end interface @@ -244,6 +246,7 @@ module psb_mmio_mod integer(psb_ipk_), optional, intent(in) :: iunit character(len=*), optional, intent(in) :: filename end subroutine mm_ivet1_write +#if defined(IPK4) && defined(LPK8) subroutine mm_lvet2_write(b, header, info, iunit, filename) import :: psb_dpk_, psb_ipk_, psb_lpk_ implicit none @@ -262,6 +265,7 @@ module psb_mmio_mod integer(psb_ipk_), optional, intent(in) :: iunit character(len=*), optional, intent(in) :: filename end subroutine mm_lvet1_write +#endif end interface #if ! defined(HAVE_BUGGY_GENERICS) diff --git a/util/psb_partidx_mod.F90 b/util/psb_partidx_mod.F90 index 0bf67aed6..08fee3802 100644 --- a/util/psb_partidx_mod.F90 +++ b/util/psb_partidx_mod.F90 @@ -47,6 +47,7 @@ module psb_partidx_mod interface ijk2idx module procedure ijk2idx3d, ijk2idxv, ijk2idx2d end interface ijk2idx + interface idx2ijk module procedure lidx2ijk3d, lidx2ijkv, lidx2ijk2d,& & lidx2lijk3d, lidx2lijkv, lidx2lijk2d diff --git a/util/psb_s_mat_dist_impl.f90 b/util/psb_s_mat_dist_impl.f90 index 104340eeb..2ae59c3d5 100644 --- a/util/psb_s_mat_dist_impl.f90 +++ b/util/psb_s_mat_dist_impl.f90 @@ -30,7 +30,7 @@ ! ! subroutine psb_smatdist(a_glob, a, ictxt, desc_a,& - & info, parts, v, inroot,fmt,mold) + & info, parts, vg, vsz, inroot,fmt,mold) ! ! an utility subroutine to distribute a matrix among processors ! according to a user defined data distribution, using @@ -83,14 +83,15 @@ subroutine psb_smatdist(a_glob, a, ictxt, desc_a,& character(len=*), optional :: fmt class(psb_s_base_sparse_mat), optional :: mold procedure(psb_parts), optional :: parts - integer(psb_ipk_), optional :: v(:) + integer(psb_ipk_), optional :: vg(:) + integer(psb_ipk_), optional :: vsz(:) ! local variables - logical :: use_parts, use_v + logical :: use_parts, use_vg, use_vsz integer(psb_ipk_) :: np, iam, np_sharing integer(psb_ipk_) :: k_count, root, liwork, nnzero, nrhs,& & i, ll, nz, isize, iproc, nnr, err, err_act - integer(psb_lpk_) :: i_count, j_count, nrow, ncol, ig + integer(psb_lpk_) :: i_count, j_count, nrow, ncol, ig, lastigp integer(psb_ipk_), allocatable :: iwork(:), iwrk2(:) integer(psb_lpk_), allocatable :: irow(:),icol(:) real(psb_spk_), allocatable :: val(:) @@ -110,6 +111,16 @@ subroutine psb_smatdist(a_glob, a, ictxt, desc_a,& root = psb_root_ end if call psb_info(ictxt, iam, np) + + use_parts = present(parts) + use_vg = present(vg) + use_vsz = present(vsz) + if (count((/ use_parts, use_vg, use_vsz /)) /= 1) then + info=psb_err_no_optional_arg_ + call psb_errpush(info,name,a_err=" vg, vsz, parts") + goto 9999 + endif + if (iam == root) then nrow = a_glob%get_nrows() ncol = a_glob%get_ncols() @@ -121,16 +132,13 @@ subroutine psb_smatdist(a_glob, a, ictxt, desc_a,& endif nnzero = a_glob%get_nzeros() nrhs = 1 + if (use_vsz) then + if (sum(vsz(1:np)) /= nrow) then + write(0,*) 'Input data mismatch :',nrow,sum(vsz(1:np)) + end if + end if + endif - - use_parts = present(parts) - use_v = present(v) - if (count((/ use_parts, use_v /)) /= 1) then - info=psb_err_no_optional_arg_ - call psb_errpush(info,name,a_err=" v, parts") - goto 9999 - endif - ! broadcast informations to other processors call psb_bcast(ictxt,nrow, root) call psb_bcast(ictxt,ncol, root) @@ -149,8 +157,10 @@ subroutine psb_smatdist(a_glob, a, ictxt, desc_a,& endif if (use_parts) then call psb_cdall(ictxt,desc_a,info,mg=nrow,parts=parts) - else if (use_v) then - call psb_cdall(ictxt,desc_a,info,vg=v) + else if (use_vg) then + call psb_cdall(ictxt,desc_a,info,vg=vg) + else if (use_vsz) then + call psb_cdall(ictxt,desc_a,info,nl=vsz(iam+1)) else info = -1 end if @@ -178,7 +188,10 @@ subroutine psb_smatdist(a_glob, a, ictxt, desc_a,& end if i_count = 1 - + if (use_vsz) then + iproc = 0 + lastigp = vsz(iproc+1) + end if do while (i_count <= nrow) if (use_parts) then @@ -202,17 +215,27 @@ subroutine psb_smatdist(a_glob, a, ictxt, desc_a,& if (iwrk2(1) /= iproc ) exit end do end if - else + else if (use_vg) then np_sharing = 1 j_count = i_count - iproc = v(i_count) + iproc = vg(i_count) iwork(1:np_sharing) = iproc do j_count = j_count + 1 if (j_count-i_count >= nb) exit if (j_count > nrow) exit - if (v(j_count) /= iproc ) exit + if (vg(j_count) /= iproc ) exit end do + else if (use_vsz) then + np_sharing = 1 + j_count = i_count + iwork(1:np_sharing) = iproc + do + j_count = j_count + 1 + if (j_count-i_count >= nb) exit + if (j_count > nrow) exit + if (j_count > lastigp) exit + end do end if ! now we should insert rows i_count..j_count-1 @@ -288,6 +311,12 @@ subroutine psb_smatdist(a_glob, a, ictxt, desc_a,& end do endif i_count = j_count + if ((use_vsz).and.(j_count <= nrow)) then + if (j_count > lastigp) then + iproc = iproc + 1 + lastigp = lastigp + vsz(iproc+1) + end if + end if end do call psb_barrier(ictxt) @@ -342,7 +371,7 @@ end subroutine psb_smatdist subroutine psb_lsmatdist(a_glob, a, ictxt, desc_a,& - & info, parts, v, inroot,fmt,mold) + & info, parts, vg, vsz, inroot,fmt,mold) ! ! an utility subroutine to distribute a matrix among processors ! according to a user defined data distribution, using @@ -395,15 +424,16 @@ subroutine psb_lsmatdist(a_glob, a, ictxt, desc_a,& character(len=*), optional :: fmt class(psb_s_base_sparse_mat), optional :: mold procedure(psb_parts), optional :: parts - integer(psb_ipk_), optional :: v(:) - + integer(psb_ipk_), optional :: vg(:) + integer(psb_ipk_), optional :: vsz(:) + ! local variables - logical :: use_parts, use_v + logical :: use_parts, use_vg, use_vsz integer(psb_ipk_) :: np, iam, np_sharing, root, iproc integer(psb_ipk_) :: err_act, il, inz integer(psb_lpk_) :: k_count, liwork, nnzero, nrhs,& & i, ll, nz, isize, nnr, err - integer(psb_lpk_) :: i_count, j_count, nrow, ncol, ig + integer(psb_lpk_) :: i_count, j_count, nrow, ncol, ig, lastigp integer(psb_ipk_), allocatable :: iwork(:), iwrk2(:) integer(psb_lpk_), allocatable :: irow(:),icol(:) real(psb_spk_), allocatable :: val(:) @@ -437,10 +467,11 @@ subroutine psb_lsmatdist(a_glob, a, ictxt, desc_a,& endif use_parts = present(parts) - use_v = present(v) - if (count((/ use_parts, use_v /)) /= 1) then + use_vg = present(vg) + use_vsz = present(vsz) + if (count((/ use_parts, use_vg, use_vsz /)) /= 1) then info=psb_err_no_optional_arg_ - call psb_errpush(info,name,a_err=" v, parts") + call psb_errpush(info,name,a_err=" vg, vsz, parts") goto 9999 endif @@ -462,8 +493,10 @@ subroutine psb_lsmatdist(a_glob, a, ictxt, desc_a,& endif if (use_parts) then call psb_cdall(ictxt,desc_a,info,mg=nrow,parts=parts) - else if (use_v) then - call psb_cdall(ictxt,desc_a,info,vg=v) + else if (use_vg) then + call psb_cdall(ictxt,desc_a,info,vg=vg) + else if (use_vsz) then + call psb_cdall(ictxt,desc_a,info,nl=vsz(iam+1)) else info = -1 end if @@ -492,7 +525,10 @@ subroutine psb_lsmatdist(a_glob, a, ictxt, desc_a,& end if i_count = 1 - + if (use_vsz) then + iproc = 0 + lastigp = vsz(iproc+1) + end if do while (i_count <= nrow) if (use_parts) then @@ -516,17 +552,27 @@ subroutine psb_lsmatdist(a_glob, a, ictxt, desc_a,& if (iwrk2(1) /= iproc ) exit end do end if - else + else if (use_vg) then np_sharing = 1 j_count = i_count - iproc = v(i_count) + iproc = vg(i_count) iwork(1:np_sharing) = iproc do j_count = j_count + 1 if (j_count-i_count >= nb) exit if (j_count > nrow) exit - if (v(j_count) /= iproc ) exit + if (vg(j_count) /= iproc ) exit end do + else if (use_vsz) then + np_sharing = 1 + j_count = i_count + iwork(1:np_sharing) = iproc + do + j_count = j_count + 1 + if (j_count-i_count >= nb) exit + if (j_count > nrow) exit + if (j_count > lastigp) exit + end do end if ! now we should insert rows i_count..j_count-1 @@ -604,6 +650,12 @@ subroutine psb_lsmatdist(a_glob, a, ictxt, desc_a,& end do endif i_count = j_count + if ((use_vsz).and.(j_count <= nrow)) then + if (j_count > lastigp) then + iproc = iproc + 1 + lastigp = lastigp + vsz(iproc+1) + end if + end if end do call psb_barrier(ictxt) diff --git a/util/psb_s_mat_dist_mod.f90 b/util/psb_s_mat_dist_mod.f90 index 3b73e5f8c..c4207da71 100644 --- a/util/psb_s_mat_dist_mod.f90 +++ b/util/psb_s_mat_dist_mod.f90 @@ -36,7 +36,7 @@ module psb_s_mat_dist_mod interface psb_matdist subroutine psb_smatdist(a_glob, a, ictxt, desc_a,& - & info, parts, v, inroot,fmt,mold) + & info, parts, vg, vsz, inroot,fmt,mold) ! ! an utility subroutine to distribute a matrix among processors ! according to a user defined data distribution, using @@ -90,10 +90,11 @@ module psb_s_mat_dist_mod character(len=*), optional :: fmt class(psb_s_base_sparse_mat), optional :: mold procedure(psb_parts), optional :: parts - integer(psb_ipk_), optional :: v(:) + integer(psb_ipk_), optional :: vg(:) + integer(psb_ipk_), optional :: vsz(:) end subroutine psb_smatdist subroutine psb_lsmatdist(a_glob, a, ictxt, desc_a,& - & info, parts, v, inroot,fmt,mold) + & info, parts, vg, vsz, inroot,fmt,mold) ! ! an utility subroutine to distribute a matrix among processors ! according to a user defined data distribution, using @@ -148,7 +149,8 @@ module psb_s_mat_dist_mod character(len=*), optional :: fmt class(psb_s_base_sparse_mat), optional :: mold procedure(psb_parts), optional :: parts - integer(psb_ipk_), optional :: v(:) + integer(psb_ipk_), optional :: vg(:) + integer(psb_ipk_), optional :: vsz(:) end subroutine psb_lsmatdist end interface diff --git a/util/psb_z_mat_dist_impl.f90 b/util/psb_z_mat_dist_impl.f90 index 818f28e4c..d45382f33 100644 --- a/util/psb_z_mat_dist_impl.f90 +++ b/util/psb_z_mat_dist_impl.f90 @@ -30,7 +30,7 @@ ! ! subroutine psb_zmatdist(a_glob, a, ictxt, desc_a,& - & info, parts, v, inroot,fmt,mold) + & info, parts, vg, vsz, inroot,fmt,mold) ! ! an utility subroutine to distribute a matrix among processors ! according to a user defined data distribution, using @@ -83,14 +83,15 @@ subroutine psb_zmatdist(a_glob, a, ictxt, desc_a,& character(len=*), optional :: fmt class(psb_z_base_sparse_mat), optional :: mold procedure(psb_parts), optional :: parts - integer(psb_ipk_), optional :: v(:) + integer(psb_ipk_), optional :: vg(:) + integer(psb_ipk_), optional :: vsz(:) ! local variables - logical :: use_parts, use_v + logical :: use_parts, use_vg, use_vsz integer(psb_ipk_) :: np, iam, np_sharing integer(psb_ipk_) :: k_count, root, liwork, nnzero, nrhs,& & i, ll, nz, isize, iproc, nnr, err, err_act - integer(psb_lpk_) :: i_count, j_count, nrow, ncol, ig + integer(psb_lpk_) :: i_count, j_count, nrow, ncol, ig, lastigp integer(psb_ipk_), allocatable :: iwork(:), iwrk2(:) integer(psb_lpk_), allocatable :: irow(:),icol(:) complex(psb_dpk_), allocatable :: val(:) @@ -110,6 +111,16 @@ subroutine psb_zmatdist(a_glob, a, ictxt, desc_a,& root = psb_root_ end if call psb_info(ictxt, iam, np) + + use_parts = present(parts) + use_vg = present(vg) + use_vsz = present(vsz) + if (count((/ use_parts, use_vg, use_vsz /)) /= 1) then + info=psb_err_no_optional_arg_ + call psb_errpush(info,name,a_err=" vg, vsz, parts") + goto 9999 + endif + if (iam == root) then nrow = a_glob%get_nrows() ncol = a_glob%get_ncols() @@ -121,16 +132,13 @@ subroutine psb_zmatdist(a_glob, a, ictxt, desc_a,& endif nnzero = a_glob%get_nzeros() nrhs = 1 + if (use_vsz) then + if (sum(vsz(1:np)) /= nrow) then + write(0,*) 'Input data mismatch :',nrow,sum(vsz(1:np)) + end if + end if + endif - - use_parts = present(parts) - use_v = present(v) - if (count((/ use_parts, use_v /)) /= 1) then - info=psb_err_no_optional_arg_ - call psb_errpush(info,name,a_err=" v, parts") - goto 9999 - endif - ! broadcast informations to other processors call psb_bcast(ictxt,nrow, root) call psb_bcast(ictxt,ncol, root) @@ -149,8 +157,10 @@ subroutine psb_zmatdist(a_glob, a, ictxt, desc_a,& endif if (use_parts) then call psb_cdall(ictxt,desc_a,info,mg=nrow,parts=parts) - else if (use_v) then - call psb_cdall(ictxt,desc_a,info,vg=v) + else if (use_vg) then + call psb_cdall(ictxt,desc_a,info,vg=vg) + else if (use_vsz) then + call psb_cdall(ictxt,desc_a,info,nl=vsz(iam+1)) else info = -1 end if @@ -178,7 +188,10 @@ subroutine psb_zmatdist(a_glob, a, ictxt, desc_a,& end if i_count = 1 - + if (use_vsz) then + iproc = 0 + lastigp = vsz(iproc+1) + end if do while (i_count <= nrow) if (use_parts) then @@ -202,17 +215,27 @@ subroutine psb_zmatdist(a_glob, a, ictxt, desc_a,& if (iwrk2(1) /= iproc ) exit end do end if - else + else if (use_vg) then np_sharing = 1 j_count = i_count - iproc = v(i_count) + iproc = vg(i_count) iwork(1:np_sharing) = iproc do j_count = j_count + 1 if (j_count-i_count >= nb) exit if (j_count > nrow) exit - if (v(j_count) /= iproc ) exit + if (vg(j_count) /= iproc ) exit end do + else if (use_vsz) then + np_sharing = 1 + j_count = i_count + iwork(1:np_sharing) = iproc + do + j_count = j_count + 1 + if (j_count-i_count >= nb) exit + if (j_count > nrow) exit + if (j_count > lastigp) exit + end do end if ! now we should insert rows i_count..j_count-1 @@ -288,6 +311,12 @@ subroutine psb_zmatdist(a_glob, a, ictxt, desc_a,& end do endif i_count = j_count + if ((use_vsz).and.(j_count <= nrow)) then + if (j_count > lastigp) then + iproc = iproc + 1 + lastigp = lastigp + vsz(iproc+1) + end if + end if end do call psb_barrier(ictxt) @@ -342,7 +371,7 @@ end subroutine psb_zmatdist subroutine psb_lzmatdist(a_glob, a, ictxt, desc_a,& - & info, parts, v, inroot,fmt,mold) + & info, parts, vg, vsz, inroot,fmt,mold) ! ! an utility subroutine to distribute a matrix among processors ! according to a user defined data distribution, using @@ -395,15 +424,16 @@ subroutine psb_lzmatdist(a_glob, a, ictxt, desc_a,& character(len=*), optional :: fmt class(psb_z_base_sparse_mat), optional :: mold procedure(psb_parts), optional :: parts - integer(psb_ipk_), optional :: v(:) - + integer(psb_ipk_), optional :: vg(:) + integer(psb_ipk_), optional :: vsz(:) + ! local variables - logical :: use_parts, use_v + logical :: use_parts, use_vg, use_vsz integer(psb_ipk_) :: np, iam, np_sharing, root, iproc integer(psb_ipk_) :: err_act, il, inz integer(psb_lpk_) :: k_count, liwork, nnzero, nrhs,& & i, ll, nz, isize, nnr, err - integer(psb_lpk_) :: i_count, j_count, nrow, ncol, ig + integer(psb_lpk_) :: i_count, j_count, nrow, ncol, ig, lastigp integer(psb_ipk_), allocatable :: iwork(:), iwrk2(:) integer(psb_lpk_), allocatable :: irow(:),icol(:) complex(psb_dpk_), allocatable :: val(:) @@ -437,10 +467,11 @@ subroutine psb_lzmatdist(a_glob, a, ictxt, desc_a,& endif use_parts = present(parts) - use_v = present(v) - if (count((/ use_parts, use_v /)) /= 1) then + use_vg = present(vg) + use_vsz = present(vsz) + if (count((/ use_parts, use_vg, use_vsz /)) /= 1) then info=psb_err_no_optional_arg_ - call psb_errpush(info,name,a_err=" v, parts") + call psb_errpush(info,name,a_err=" vg, vsz, parts") goto 9999 endif @@ -462,8 +493,10 @@ subroutine psb_lzmatdist(a_glob, a, ictxt, desc_a,& endif if (use_parts) then call psb_cdall(ictxt,desc_a,info,mg=nrow,parts=parts) - else if (use_v) then - call psb_cdall(ictxt,desc_a,info,vg=v) + else if (use_vg) then + call psb_cdall(ictxt,desc_a,info,vg=vg) + else if (use_vsz) then + call psb_cdall(ictxt,desc_a,info,nl=vsz(iam+1)) else info = -1 end if @@ -492,7 +525,10 @@ subroutine psb_lzmatdist(a_glob, a, ictxt, desc_a,& end if i_count = 1 - + if (use_vsz) then + iproc = 0 + lastigp = vsz(iproc+1) + end if do while (i_count <= nrow) if (use_parts) then @@ -516,17 +552,27 @@ subroutine psb_lzmatdist(a_glob, a, ictxt, desc_a,& if (iwrk2(1) /= iproc ) exit end do end if - else + else if (use_vg) then np_sharing = 1 j_count = i_count - iproc = v(i_count) + iproc = vg(i_count) iwork(1:np_sharing) = iproc do j_count = j_count + 1 if (j_count-i_count >= nb) exit if (j_count > nrow) exit - if (v(j_count) /= iproc ) exit + if (vg(j_count) /= iproc ) exit end do + else if (use_vsz) then + np_sharing = 1 + j_count = i_count + iwork(1:np_sharing) = iproc + do + j_count = j_count + 1 + if (j_count-i_count >= nb) exit + if (j_count > nrow) exit + if (j_count > lastigp) exit + end do end if ! now we should insert rows i_count..j_count-1 @@ -604,6 +650,12 @@ subroutine psb_lzmatdist(a_glob, a, ictxt, desc_a,& end do endif i_count = j_count + if ((use_vsz).and.(j_count <= nrow)) then + if (j_count > lastigp) then + iproc = iproc + 1 + lastigp = lastigp + vsz(iproc+1) + end if + end if end do call psb_barrier(ictxt) diff --git a/util/psb_z_mat_dist_mod.f90 b/util/psb_z_mat_dist_mod.f90 index 7d7691013..d10200ddb 100644 --- a/util/psb_z_mat_dist_mod.f90 +++ b/util/psb_z_mat_dist_mod.f90 @@ -36,7 +36,7 @@ module psb_z_mat_dist_mod interface psb_matdist subroutine psb_zmatdist(a_glob, a, ictxt, desc_a,& - & info, parts, v, inroot,fmt,mold) + & info, parts, vg, vsz, inroot,fmt,mold) ! ! an utility subroutine to distribute a matrix among processors ! according to a user defined data distribution, using @@ -90,10 +90,11 @@ module psb_z_mat_dist_mod character(len=*), optional :: fmt class(psb_z_base_sparse_mat), optional :: mold procedure(psb_parts), optional :: parts - integer(psb_ipk_), optional :: v(:) + integer(psb_ipk_), optional :: vg(:) + integer(psb_ipk_), optional :: vsz(:) end subroutine psb_zmatdist subroutine psb_lzmatdist(a_glob, a, ictxt, desc_a,& - & info, parts, v, inroot,fmt,mold) + & info, parts, vg, vsz, inroot,fmt,mold) ! ! an utility subroutine to distribute a matrix among processors ! according to a user defined data distribution, using @@ -148,7 +149,8 @@ module psb_z_mat_dist_mod character(len=*), optional :: fmt class(psb_z_base_sparse_mat), optional :: mold procedure(psb_parts), optional :: parts - integer(psb_ipk_), optional :: v(:) + integer(psb_ipk_), optional :: vg(:) + integer(psb_ipk_), optional :: vsz(:) end subroutine psb_lzmatdist end interface