fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-20 12:52:14 +00:00
Code Issues Packages Projects Releases Wiki Activity

psblas:

Browse Source 
base/modules/psb_desc_type.f90
 base/modules/psb_tools_mod.f90
 base/tools/Makefile
 base/tools/psb_ccdbldext.F90
 base/tools/psb_cd_lstext.f90
 base/tools/psb_cd_reinit.f90
 base/tools/psb_cdcpy.f90
 base/tools/psb_dcdbldext.F90
 base/tools/psb_scdbldext.F90
 base/tools/psb_zcdbldext.F90

psblas: refactor copy, lstext and reinit descriptors to work around
Intel 10 compilation problem.
This commit is contained in:
Salvatore Filippone
2008-06-02 20:59:56 +00:00
parent e30d782178
commit 02b09a9eb5
10 changed files with 302 additions and 253 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/modules/psb_desc_type.f90
-152
View File
@@ -339,17 +339,10 @@ module psb_descriptor_type
end interface
interface psb_cdcpy
module procedure psb_cdcpy
end interface
interface psb_cdtransfer
module procedure psb_cdtransfer
end interface
interface psb_cd_reinit
module procedure psb_cd_reinit
end interface
interface psb_cdfree
module procedure psb_cdfree
@@ -991,95 +984,6 @@ contains
end subroutine psb_cdfree
!
! Subroutine: psb_cdcpy
! Produces a clone of a descriptor.
!
! Arguments:
! desc_in - type(psb_desc_type). The communication descriptor to be cloned.
! desc_out - type(psb_desc_type). The output communication descriptor.
! info - integer. Return code.
subroutine psb_cdcpy(desc_in, desc_out, info)
use psb_realloc_mod
use psb_const_mod
use psb_error_mod
use psb_penv_mod
implicit none
!....parameters...
type(psb_desc_type), intent(in) :: desc_in
type(psb_desc_type), intent(out) :: desc_out
integer, intent(out) :: info
!locals
integer :: np,me,ictxt, err_act
integer :: debug_level, debug_unit
character(len=20) :: name
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
if (psb_get_errstatus() /= 0) return
info = 0
call psb_erractionsave(err_act)
name = 'psb_cdcpy'
ictxt = psb_cd_get_context(desc_in)
! check on blacs grid
call psb_info(ictxt, me, np)
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': Entered'
if (np == -1) then
info = 2010
call psb_errpush(info,name)
goto 9999
endif
call psb_safe_ab_cpy(desc_in%matrix_data,desc_out%matrix_data,info)
if (info == 0) call psb_safe_ab_cpy(desc_in%halo_index,desc_out%halo_index,info)
if (info == 0) call psb_safe_ab_cpy(desc_in%ext_index,desc_out%ext_index,info)
if (info == 0) call psb_safe_ab_cpy(desc_in%ovrlap_index,desc_out%ovrlap_index,info)
if (info == 0) call psb_safe_ab_cpy(desc_in%bnd_elem,desc_out%bnd_elem,info)
if (info == 0) call psb_safe_ab_cpy(desc_in%ovrlap_elem,desc_out%ovrlap_elem,info)
if (info == 0) call psb_safe_ab_cpy(desc_in%ovr_mst_idx,desc_out%ovr_mst_idx,info)
if (info == 0) call psb_safe_ab_cpy(desc_in%loc_to_glob,desc_out%loc_to_glob,info)
if (info == 0) call psb_safe_ab_cpy(desc_in%glob_to_loc,desc_out%glob_to_loc,info)
if (info == 0) call psb_safe_ab_cpy(desc_in%lprm,desc_out%lprm,info)
if (info == 0) call psb_safe_ab_cpy(desc_in%idx_space,desc_out%idx_space,info)
if (info == 0) call psb_safe_ab_cpy(desc_in%hashv,desc_out%hashv,info)
if (info == 0) call psb_safe_ab_cpy(desc_in%glb_lc,desc_out%glb_lc,info)
if (info == 0) then
if (associated(desc_in%avltree)) then
call CloneSearchTree(desc_in%avltree,desc_out%avltree)
end if
end if
if (info /= 0) then
info = 4010
call psb_errpush(info,name)
goto 9999
endif
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': Done'
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_ret_) then
return
else
call psb_error(ictxt)
end if
return
end subroutine psb_cdcpy
!
! Subroutine: psb_cdtransfer
! Transfers data and allocation from in to out; behaves like MOVE_ALLOC, i.e.
! the IN arg is empty (and deallocated) upon exit.
@@ -1284,62 +1188,6 @@ contains
end Subroutine psb_cd_get_recv_idx
Subroutine psb_cd_reinit(desc,info)
use psb_error_mod
use psb_penv_mod
use psb_realloc_mod
Implicit None
! .. Array Arguments ..
Type(psb_desc_type), Intent(inout) :: desc
integer, intent(out) :: info
integer icomm, err_act
! .. Local Scalars ..
Integer :: np, me, ictxt
Integer, allocatable :: tmp_halo(:),tmp_ext(:), tmp_ovr(:)
integer :: debug_level, debug_unit
character(len=20) :: name, ch_err
name='psb_cd_reinit'
info = 0
call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
ictxt = psb_cd_get_context(desc)
icomm = psb_cd_get_mpic(desc)
Call psb_info(ictxt, me, np)
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),': start'
call psb_cd_get_recv_idx(tmp_ovr,desc,psb_comm_ovr_,info,toglob=.true.)
call psb_cd_get_recv_idx(tmp_halo,desc,psb_comm_halo_,info,toglob=.false.)
call psb_cd_get_recv_idx(tmp_ext,desc,psb_comm_ext_,info,toglob=.false.)
call psb_transfer(tmp_ovr,desc%ovrlap_index,info)
call psb_transfer(tmp_halo,desc%halo_index,info)
call psb_transfer(tmp_ext,desc%ext_index,info)
call psb_cd_set_bld(desc,info)
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),': end'
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
Return
End Subroutine psb_cd_reinit
end module psb_descriptor_type
base/modules/psb_tools_mod.f90
+38 -12
View File
@@ -33,6 +33,32 @@ Module psb_tools_mod
use psb_const_mod
use psb_spmat_type
interface psb_cd_reinit
Subroutine psb_cd_reinit(desc,info)
use psb_descriptor_type
Implicit None
! .. Array Arguments ..
Type(psb_desc_type), Intent(inout) :: desc
integer, intent(out) :: info
end Subroutine psb_cd_reinit
end interface
interface psb_cdcpy
subroutine psb_cdcpy(desc_in, desc_out, info)
use psb_descriptor_type
implicit none
!....parameters...
type(psb_desc_type), intent(in) :: desc_in
type(psb_desc_type), intent(out) :: desc_out
integer, intent(out) :: info
end subroutine psb_cdcpy
end interface
interface psb_geall
subroutine psb_salloc(x, desc_a, info, n, lb)
use psb_descriptor_type
@@ -791,8 +817,8 @@ Module psb_tools_mod
integer,intent(out) :: y
integer, intent(out) :: info
character, intent(in), optional :: iact
end subroutine psb_loc_to_glob2s
end subroutine psb_loc_to_glob2s
subroutine psb_loc_to_globs(x,desc_a,info,iact)
use psb_descriptor_type
type(psb_desc_type), intent(in) :: desc_a
@@ -836,7 +862,7 @@ Module psb_tools_mod
interface psb_is_local
module procedure psb_is_local
end interface
interface psb_owned_index
module procedure psb_owned_index, psb_owned_index_v
end interface
@@ -855,7 +881,7 @@ contains
logical :: psb_is_owned
logical :: res
integer :: info
call psb_owned_index(res,idx,desc,info)
if (info /= 0) res=.false.
psb_is_owned = res
@@ -869,7 +895,7 @@ contains
logical :: psb_is_local
logical :: res
integer :: info
call psb_local_index(res,idx,desc,info)
if (info /= 0) res=.false.
psb_is_local = res
@@ -882,11 +908,11 @@ contains
type(psb_desc_type), intent(in) :: desc
logical, intent(out) :: res
integer, intent(out) :: info
integer :: lx
call psb_glob_to_loc(idx,lx,desc,info,iact='I',owned=.true.)
res = (lx>0)
end subroutine psb_owned_index
@@ -903,7 +929,7 @@ contains
res=.false.
if (info /= 0) return
call psb_glob_to_loc(idx,lx,desc,info,iact='I',owned=.true.)
res = (lx>0)
end subroutine psb_owned_index_v
@@ -918,10 +944,10 @@ contains
integer :: lx
call psb_glob_to_loc(idx,lx,desc,info,iact='I',owned=.false.)
res = (lx>0)
end subroutine psb_local_index
subroutine psb_local_index_v(res,idx,desc,info)
use psb_descriptor_type
implicit none
@@ -935,7 +961,7 @@ contains
res=.false.
if (info /= 0) return
call psb_glob_to_loc(idx,lx,desc,info,iact='I',owned=.false.)
res = (lx>0)
end subroutine psb_local_index_v
@@ -1164,7 +1190,7 @@ contains
type(psb_desc_type), intent(inout) :: cd_xt
type(psb_desc_type), intent(in) :: descin, descout
character(len=*), optional, intent(in) :: afmt
integer :: nrow_in, nrow_out, ncol_in, info, ictxt
base/tools/Makefile
+1 -5
View File
@@ -6,6 +6,7 @@ FOBJS = psb_sallc.o psb_sasb.o \
psb_dfree.o psb_dins.o \
psb_cdals.o psb_cdalv.o psb_cd_inloc.o psb_cdins.o psb_cdprt.o \
psb_cdren.o psb_cdrep.o psb_get_overlap.o psb_cd_lstext.o\
psb_cdcpy.o psb_cd_reinit.o \
psb_dspalloc.o psb_dspasb.o \
psb_dspfree.o psb_dspins.o psb_dsprn.o \
psb_sspalloc.o psb_sspasb.o \
@@ -18,11 +19,6 @@ FOBJS = psb_sallc.o psb_sasb.o \
psb_cspalloc.o psb_cspasb.o psb_cspfree.o\
psb_callc.o psb_casb.o psb_cfree.o psb_cins.o \
psb_cspins.o psb_csprn.o psb_map.o psb_inter_desc.o
# \
# psb_s_inter_desc.o psb_s_inter_desc_noidx.o \
# psb_d_inter_desc.o psb_d_inter_desc_noidx.o \
# psb_c_inter_desc.o psb_c_inter_desc_noidx.o \
# psb_z_inter_desc.o psb_z_inter_desc_noidx.o
MPFOBJS = psb_ssphalo.o psb_csphalo.o psb_dsphalo.o psb_zsphalo.o psb_icdasb.o \
psb_dcdbldext.o psb_zcdbldext.o psb_scdbldext.o psb_ccdbldext.o
base/tools/psb_ccdbldext.F90
+1 -6
View File
@@ -61,12 +61,7 @@
!
Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
use psb_tools_mod, psb_protect_name => psb_ccdbldext
use psb_serial_mod
use psb_descriptor_type
use psb_error_mod
use psb_penv_mod
use psb_realloc_mod
use psb_base_mod, psb_protect_name => psb_ccdbldext
use psi_mod
#ifdef MPI_MOD
use mpi
base/tools/psb_cd_lstext.f90
+1 -14
View File
@@ -29,22 +29,9 @@
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
! File: psb_cdbldext.f90
!
! Subroutine: psb_cdbldext
! This routine takes a matrix A with its descriptor, and builds the
! auxiliary descriptor corresponding to the number of overlap levels
! specified on input.
Subroutine psb_cd_lstext(desc_a,in_list,desc_ov,info, mask,extype)
use psb_tools_mod, psb_protect_name => psb_cd_lstext
use psb_serial_mod
use psb_descriptor_type
use psb_error_mod
use psb_penv_mod
use psb_realloc_mod
use psb_base_mod, psb_protect_name => psb_cd_lstext
use psi_mod
Implicit None
base/tools/psb_cd_reinit.f90
+87
View File
@@ -0,0 +1,87 @@
!!$
!!$ Parallel Sparse BLAS version 2.2
!!$ (C) Copyright 2006/2007/2008
!!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari University of Rome Tor Vergata
!!$
!!$ 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_cd_reinit(desc,info)
use psb_base_mod, psb_protect_name => psb_cd_reinit
use psi_mod
Implicit None
! .. Array Arguments ..
Type(psb_desc_type), Intent(inout) :: desc
integer, intent(out) :: info
integer icomm, err_act
! .. Local Scalars ..
Integer :: np, me, ictxt
Integer, allocatable :: tmp_halo(:),tmp_ext(:), tmp_ovr(:)
integer :: debug_level, debug_unit
character(len=20) :: name, ch_err
name='psb_cd_reinit'
info = 0
call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
ictxt = psb_cd_get_context(desc)
icomm = psb_cd_get_mpic(desc)
Call psb_info(ictxt, me, np)
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),': start'
call psb_cd_get_recv_idx(tmp_ovr,desc,psb_comm_ovr_,info,toglob=.true.)
call psb_cd_get_recv_idx(tmp_halo,desc,psb_comm_halo_,info,toglob=.false.)
call psb_cd_get_recv_idx(tmp_ext,desc,psb_comm_ext_,info,toglob=.false.)
call psb_transfer(tmp_ovr,desc%ovrlap_index,info)
call psb_transfer(tmp_halo,desc%halo_index,info)
call psb_transfer(tmp_ext,desc%ext_index,info)
call psb_cd_set_bld(desc,info)
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),': end'
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
Return
End Subroutine psb_cd_reinit
base/tools/psb_cdcpy.f90
+117
View File
@@ -0,0 +1,117 @@
!!$
!!$ Parallel Sparse BLAS version 2.2
!!$ (C) Copyright 2006/2007/2008
!!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari University of Rome Tor Vergata
!!$
!!$ 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_cdcpy
! Produces a clone of a descriptor.
!
! Arguments:
! desc_in - type(psb_desc_type). The communication descriptor to be cloned.
! desc_out - type(psb_desc_type). The output communication descriptor.
! info - integer. Return code.
subroutine psb_cdcpy(desc_in, desc_out, info)
use psb_base_mod, psb_protect_name => psb_cdcpy
implicit none
!....parameters...
type(psb_desc_type), intent(in) :: desc_in
type(psb_desc_type), intent(out) :: desc_out
integer, intent(out) :: info
!locals
integer :: np,me,ictxt, err_act
integer :: debug_level, debug_unit
character(len=20) :: name
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
if (psb_get_errstatus() /= 0) return
info = 0
call psb_erractionsave(err_act)
name = 'psb_cdcpy'
ictxt = psb_cd_get_context(desc_in)
! check on blacs grid
call psb_info(ictxt, me, np)
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': Entered'
if (np == -1) then
info = 2010
call psb_errpush(info,name)
goto 9999
endif
call psb_safe_ab_cpy(desc_in%matrix_data,desc_out%matrix_data,info)
if (info == 0) call psb_safe_ab_cpy(desc_in%halo_index,desc_out%halo_index,info)
if (info == 0) call psb_safe_ab_cpy(desc_in%ext_index,desc_out%ext_index,info)
if (info == 0) call psb_safe_ab_cpy(desc_in%ovrlap_index,desc_out%ovrlap_index,info)
if (info == 0) call psb_safe_ab_cpy(desc_in%bnd_elem,desc_out%bnd_elem,info)
if (info == 0) call psb_safe_ab_cpy(desc_in%ovrlap_elem,desc_out%ovrlap_elem,info)
if (info == 0) call psb_safe_ab_cpy(desc_in%ovr_mst_idx,desc_out%ovr_mst_idx,info)
if (info == 0) call psb_safe_ab_cpy(desc_in%loc_to_glob,desc_out%loc_to_glob,info)
if (info == 0) call psb_safe_ab_cpy(desc_in%glob_to_loc,desc_out%glob_to_loc,info)
if (info == 0) call psb_safe_ab_cpy(desc_in%lprm,desc_out%lprm,info)
if (info == 0) call psb_safe_ab_cpy(desc_in%idx_space,desc_out%idx_space,info)
if (info == 0) call psb_safe_ab_cpy(desc_in%hashv,desc_out%hashv,info)
if (info == 0) call psb_safe_ab_cpy(desc_in%glb_lc,desc_out%glb_lc,info)
if (info == 0) then
if (associated(desc_in%avltree)) then
call CloneSearchTree(desc_in%avltree,desc_out%avltree)
end if
end if
if (info /= 0) then
info = 4010
call psb_errpush(info,name)
goto 9999
endif
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': Done'
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_ret_) then
return
else
call psb_error(ictxt)
end if
return
end subroutine psb_cdcpy
base/tools/psb_dcdbldext.F90
+55 -51
View File
@@ -61,13 +61,7 @@
!
Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
use psb_tools_mod, psb_protect_name => psb_dcdbldext
use psb_serial_mod
use psb_descriptor_type
use psb_error_mod
use psb_penv_mod
use psb_realloc_mod
use psb_base_mod, psb_protect_name => psb_dcdbldext
use psi_mod
#ifdef MPI_MOD
use mpi
@@ -123,7 +117,8 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
Call psb_info(ictxt, me, np)
If (debug_level >= psb_debug_outer_) &
& Write(debug_unit,*) me,' ',trim(name),': start',novr
& Write(debug_unit,*) me,' ',trim(name),&
& ': start',novr
if (present(extype)) then
extype_ = extype
@@ -145,7 +140,8 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
endif
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),':Calling desccpy'
& write(debug_unit,*) me,' ',trim(name),&
& ':Calling desccpy'
call psb_cdcpy(desc_a,desc_ov,info)
if (info /= 0) then
info=4010
@@ -154,7 +150,9 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
goto 9999
end if
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),':From desccpy'
& write(debug_unit,*) me,' ',trim(name),&
& ':From desccpy'
if (novr==0) then
!
! Just copy the input.
@@ -165,7 +163,8 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
If (debug_level >= psb_debug_outer_)then
Write(debug_unit,*) me,' ',trim(name),':BEGIN ',nhalo
Write(debug_unit,*) me,' ',trim(name),&
& ':BEGIN ',nhalo
call psb_barrier(ictxt)
endif
@@ -180,7 +179,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
lworks = ((nztot+m-1)/m)*nhalo
lworkr = ((nztot+m-1)/m)*nhalo
else
info=-1
info = -1
call psb_errpush(info,name)
goto 9999
endif
@@ -235,12 +234,12 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
tmp_ovr_idx(:) = -1
orig_ovr(:) = -1
tmp_halo(:) = -1
counter_e = 1
tot_recv = 0
counter_t = 1
counter_h = 1
counter_o = 1
cntov_o = 1
counter_e = 1
tot_recv = 0
counter_t = 1
counter_h = 1
counter_o = 1
cntov_o = 1
! Init overlap with desc_a%ovrlap (if any)
counter = 1
Do While (desc_a%ovrlap_index(counter) /= -1)
@@ -301,7 +300,8 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
Do i_ovr = 1, novr
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),':Running on overlap level ',i_ovr,' of ',novr
& write(debug_unit,*) me,' ',trim(name),&
& ':Running on overlap level ',i_ovr,' of ',novr
!
! At this point, halo contains a valid halo corresponding to the
@@ -333,7 +333,8 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
end If
tot_recv=tot_recv+n_elem_recv
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),': tot_recv:',proc,n_elem_recv,tot_recv
& write(debug_unit,*) me,' ',trim(name),&
& ': tot_recv:',proc,n_elem_recv,tot_recv
!
!
! The format of the halo vector exists in two forms: 1. Temporary
@@ -368,10 +369,10 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
goto 9999
end if
tmp_ovr_idx(counter_o)=proc
tmp_ovr_idx(counter_o+1)=1
tmp_ovr_idx(counter_o+2)=gidx
tmp_ovr_idx(counter_o+3)=-1
tmp_ovr_idx(counter_o) = proc
tmp_ovr_idx(counter_o+1) = 1
tmp_ovr_idx(counter_o+2) = gidx
tmp_ovr_idx(counter_o+3) = -1
counter_o=counter_o+3
call psb_ensure_size((counter_h+3),tmp_halo,info,pad=-1)
if (info /= 0) then
@@ -380,10 +381,10 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
goto 9999
end if
tmp_halo(counter_h)=proc
tmp_halo(counter_h+1)=1
tmp_halo(counter_h+2)=idx
tmp_halo(counter_h+3)=-1
tmp_halo(counter_h) = proc
tmp_halo(counter_h+1) = 1
tmp_halo(counter_h+2) = idx
tmp_halo(counter_h+3) = -1
counter_h=counter_h+3
@@ -411,10 +412,10 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
goto 9999
end if
tmp_ovr_idx(counter_o)=proc
tmp_ovr_idx(counter_o+1)=1
tmp_ovr_idx(counter_o+2)=gidx
tmp_ovr_idx(counter_o+3)=-1
tmp_ovr_idx(counter_o) = proc
tmp_ovr_idx(counter_o+1) = 1
tmp_ovr_idx(counter_o+2) = gidx
tmp_ovr_idx(counter_o+3) = -1
counter_o=counter_o+3
!
@@ -466,6 +467,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& ':Checktmp_o_i Loop Mid2',tmp_ovr_idx(1:10)
sdsz(proc+1) = tot_elem
idxs = idxs + tot_elem
end if
@@ -517,7 +519,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
lworkr=max(iszr,1)
lworkr = max(iszr,1)
end if
call mpi_alltoallv(works,sdsz,bsdindx,mpi_integer,&
@@ -575,11 +577,11 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
goto 9999
end if
t_halo_in(counter_t)=proc_id
t_halo_in(counter_t+1)=1
t_halo_in(counter_t+2)=lidx
t_halo_in(counter_t+3)=-1
counter_t=counter_t+3
t_halo_in(counter_t) = proc_id
t_halo_in(counter_t+1) = 1
t_halo_in(counter_t+2) = lidx
t_halo_in(counter_t+3) = -1
counter_t = counter_t+3
endif
end Do
n_col = psb_cd_get_local_cols(desc_ov)
@@ -596,8 +598,8 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
! we receive them guarantees that all indices for HALO(I)
! will be less than those for HALO(J) whenever I<J
!
n_col=n_col+1
proc_id=-desc_ov%glob_to_loc(idx)-np-1
n_col = n_col+1
proc_id = -desc_ov%glob_to_loc(idx)-np-1
call psb_ensure_size(n_col,desc_ov%loc_to_glob,info,pad=-1)
if (info /= 0) then
info=4010
@@ -605,8 +607,8 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
goto 9999
end if
desc_ov%glob_to_loc(idx)=n_col
desc_ov%loc_to_glob(n_col)=idx
desc_ov%glob_to_loc(idx) = n_col
desc_ov%loc_to_glob(n_col) = idx
call psb_ensure_size((counter_t+3),t_halo_in,info,pad=-1)
if (info /= 0) then
@@ -615,21 +617,23 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
goto 9999
end if
t_halo_in(counter_t)=proc_id
t_halo_in(counter_t+1)=1
t_halo_in(counter_t+2)=n_col
t_halo_in(counter_t+3)=-1
t_halo_in(counter_t) = proc_id
t_halo_in(counter_t+1) = 1
t_halo_in(counter_t+2) = n_col
t_halo_in(counter_t+3) = -1
counter_t=counter_t+3
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),': Added into t_halo_in from recv',&
&proc_id,n_col,idx
& write(debug_unit,*) me,' ',trim(name),&
& ': Added into t_halo_in from recv',&
& proc_id,n_col,idx
else if (desc_ov%glob_to_loc(idx) < 0) Then
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),':Wrong input to cdbldextbld?',&
&idx,desc_ov%glob_to_loc(idx)
& write(debug_unit,*) me,' ',trim(name),&
& ':Wrong input to cdbldextbld?',&
& idx,desc_ov%glob_to_loc(idx)
End If
End Do
desc_ov%matrix_data(psb_n_col_)=n_col
desc_ov%matrix_data(psb_n_col_) = n_col
end if
base/tools/psb_scdbldext.F90
+1 -7
View File
@@ -61,13 +61,7 @@
!
Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
use psb_tools_mod, psb_protect_name => psb_scdbldext
use psb_serial_mod
use psb_descriptor_type
use psb_error_mod
use psb_penv_mod
use psb_realloc_mod
use psb_base_mod, psb_protect_name => psb_scdbldext
use psi_mod
#ifdef MPI_MOD
use mpi
base/tools/psb_zcdbldext.F90
+1 -6
View File
@@ -61,12 +61,7 @@
!
Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
use psb_tools_mod, psb_protect_name => psb_zcdbldext
use psb_serial_mod
use psb_descriptor_type
use psb_error_mod
use psb_penv_mod
use psb_realloc_mod
use psb_base_mod, psb_protect_name => psb_zcdbldext
use psi_mod
#ifdef MPI_MOD
use mpi