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

Aligned to new names for internal constants.

Browse Source 
Fixed ext field of descriptors. First version; to be further
fixed storing force_hv into the descriptor itself.
psblas3-type-indexed
Salvatore Filippone 20 years ago
parent 6296068177
commit 22686aefa0
188 changed files with 1569 additions and 1181 deletions
Show Stats Download Patch File Download Diff File

33
LICENSE.MD2P4
Unescape Escape View File

@ -1,33 +0,0 @@
MD2P4
Multilevel Domain Decomposition Parallel Preconditioner Package for PSBLAS
for
Parallel Sparse BLAS v2.0
(C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata
Alfredo Buttari University of Rome Tor Vergata
Daniela di Serafino Second University of Naples
Pasqua D'Ambra ICAR-CNR
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 MD2P4 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 MD2P4 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.

2
README
Unescape Escape View File

@ -1,6 +1,6 @@
This directory contains the PSBLAS library, version 2.1.0 This directory contains the PSBLAS library, version 2.1.0
Version 1.0 of the library was described in: Version 1.0 of the library was described in:
S. Filippone, M. Colajanni S. Filippone, M. Colajanni
PSBLAS: A library for parallel linear algebra computation on sparse matrices PSBLAS: A library for parallel linear algebra computation on sparse matrices

2
base/Makefile
Unescape Escape View File

@ -12,7 +12,7 @@ lib:
(cd serial; make lib LIBNAME=$(BASELIBNAME)) (cd serial; make lib LIBNAME=$(BASELIBNAME))
(cd psblas; make lib LIBNAME=$(BASELIBNAME)) (cd psblas; make lib LIBNAME=$(BASELIBNAME))
/bin/cp -p $(HERE)/$(LIBNAME) $(LIBDIR) /bin/cp -p $(HERE)/$(LIBNAME) $(LIBDIR)
/bin/cp -p $(LIBMOD) $(LIBDIR) /bin/cp -p $(LIBMOD) *$(.mod) $(LIBDIR)
clean: clean:
(cd modules; make clean) (cd modules; make clean)

4
base/comm/psb_dgather.f90
Unescape Escape View File

@ -193,7 +193,7 @@ subroutine psb_dgatherm(globx, locx, desc_a, info, iroot,&
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if
@ -365,7 +365,7 @@ subroutine psb_dgatherv(globx, locx, desc_a, info, iroot,&
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if

39
base/comm/psb_dhalo.f90
Unescape Escape View File

@ -45,7 +45,7 @@
! tran - character(optional). ???. ! tran - character(optional). ???.
! mode - integer(optional). ! mode - integer(optional).
! !
subroutine psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode) subroutine psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
use psb_descriptor_type use psb_descriptor_type
use psb_const_mod use psb_const_mod
use psi_mod use psi_mod
@ -60,13 +60,13 @@ subroutine psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
integer, intent(out) :: info integer, intent(out) :: info
real(kind(1.d0)), intent(in), optional :: alpha real(kind(1.d0)), intent(in), optional :: alpha
real(kind(1.d0)), optional, target :: work(:) real(kind(1.d0)), optional, target :: work(:)
integer, intent(in), optional :: mode,jx,ik integer, intent(in), optional :: mode,jx,ik,data
character, intent(in), optional :: tran character, intent(in), optional :: tran
! locals ! locals
integer :: ictxt, np, me,& integer :: ictxt, np, me,&
& err_act, m, n, iix, jjx, ix, ijx, k, maxk, nrow, imode, i,& & err_act, m, n, iix, jjx, ix, ijx, k, maxk, nrow, imode, i,&
& err, liwork & err, liwork,data_
real(kind(1.d0)),pointer :: iwork(:), xp(:,:) real(kind(1.d0)),pointer :: iwork(:), xp(:,:)
character :: ltran character :: ltran
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -115,6 +115,14 @@ subroutine psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
else else
ltran = 'N' ltran = 'N'
endif endif
if (present(data)) then
data_ = data
else
data_ = psb_comm_halo_
endif
if (present(mode)) then if (present(mode)) then
imode = mode imode = mode
else else
@ -177,16 +185,10 @@ subroutine psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
xp => x(iix:size(x,1),jjx:jjx+k-1) xp => x(iix:size(x,1),jjx:jjx+k-1)
if(ltran.eq.'N') then if(ltran.eq.'N') then
call psi_swapdata(imode,k,0.d0,xp,& call psi_swapdata(imode,k,0.d0,xp,&
& desc_a,iwork,info,data=psb_comm_halo_) & desc_a,iwork,info,data=data_)
!!$ call PSI_dSwapData(imode,k,0.d0,x(1,jjx),&
!!$ & size(x,1),desc_a%matrix_data,&
!!$ & desc_a%halo_index,iwork,liwork,info)
else if((ltran.eq.'T').or.(ltran.eq.'H')) then else if((ltran.eq.'T').or.(ltran.eq.'H')) then
call psi_swaptran(imode,k,1.d0,xp,& call psi_swaptran(imode,k,1.d0,xp,&
&desc_a,iwork,info) &desc_a,iwork,info)
!!$ call PSI_dSwapTran(imode,k,1.d0,x(1,jjx),&
!!$ & size(x,1),desc_a%matrix_data,&
!!$ & desc_a%halo_index,iwork,liwork,info)
end if end if
if(info.ne.0) then if(info.ne.0) then
@ -203,7 +205,7 @@ subroutine psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if
@ -257,7 +259,7 @@ end subroutine psb_dhalom
! tran - character(optional). ???. ! tran - character(optional). ???.
! mode - integer(optional). ! mode - integer(optional).
! !
subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode) subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode,data)
use psb_descriptor_type use psb_descriptor_type
use psb_const_mod use psb_const_mod
use psi_mod use psi_mod
@ -272,13 +274,13 @@ subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode)
integer, intent(out) :: info integer, intent(out) :: info
real(kind(1.d0)), intent(in), optional :: alpha real(kind(1.d0)), intent(in), optional :: alpha
real(kind(1.d0)), target, optional :: work(:) real(kind(1.d0)), target, optional :: work(:)
integer, intent(in), optional :: mode integer, intent(in), optional :: mode,data
character, intent(in), optional :: tran character, intent(in), optional :: tran
! locals ! locals
integer :: ictxt, np, me,& integer :: ictxt, np, me,&
& err_act, m, n, iix, jjx, ix, ijx, nrow, imode, i,& & err_act, m, n, iix, jjx, ix, ijx, nrow, imode, i,&
& err, liwork & err, liwork,data_
real(kind(1.d0)),pointer :: iwork(:) real(kind(1.d0)),pointer :: iwork(:)
character :: ltran character :: ltran
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -311,6 +313,11 @@ subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode)
else else
ltran = 'N' ltran = 'N'
endif endif
if (present(data)) then
data_ = data
else
data_ = psb_comm_halo_
endif
if (present(mode)) then if (present(mode)) then
imode = mode imode = mode
else else
@ -368,7 +375,7 @@ subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode)
! exchange halo elements ! exchange halo elements
if(ltran.eq.'N') then if(ltran.eq.'N') then
call psi_swapdata(imode,0.d0,x(iix:size(x)),& call psi_swapdata(imode,0.d0,x(iix:size(x)),&
& desc_a,iwork,info,data=psb_comm_halo_) & desc_a,iwork,info,data=data_)
else if((ltran.eq.'T').or.(ltran.eq.'H')) then else if((ltran.eq.'T').or.(ltran.eq.'H')) then
call psi_swaptran(imode,1.d0,x(iix:size(x)),& call psi_swaptran(imode,1.d0,x(iix:size(x)),&
& desc_a,iwork,info) & desc_a,iwork,info)
@ -388,7 +395,7 @@ subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if

4
base/comm/psb_dovrl.f90
Unescape Escape View File

@ -208,7 +208,7 @@ subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,update)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if
@ -411,7 +411,7 @@ subroutine psb_dovrlv(x,desc_a,info,work,update)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if

4
base/comm/psb_dscatter.f90
Unescape Escape View File

@ -253,7 +253,7 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, iroot,&
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act == act_abort) then if (err_act == psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if
@ -445,7 +445,7 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, iroot)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act == act_abort) then if (err_act == psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if

4
base/comm/psb_ihalo.f90
Unescape Escape View File

@ -199,7 +199,7 @@ subroutine psb_ihalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if
@ -387,7 +387,7 @@ subroutine psb_ihalov(x,desc_a,info,alpha,work,tran,mode)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if

4
base/comm/psb_zgather.f90
Unescape Escape View File

@ -195,7 +195,7 @@ subroutine psb_zgatherm(globx, locx, desc_a, info, iroot,&
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if
@ -368,7 +368,7 @@ subroutine psb_zgatherv(globx, locx, desc_a, info, iroot,&
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if

4
base/comm/psb_zhalo.f90
Unescape Escape View File

@ -198,7 +198,7 @@ subroutine psb_zhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if
@ -384,7 +384,7 @@ subroutine psb_zhalov(x,desc_a,info,alpha,work,tran,mode)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if

4
base/comm/psb_zovrl.f90
Unescape Escape View File

@ -208,7 +208,7 @@ subroutine psb_zovrlm(x,desc_a,info,jx,ik,work,update)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if
@ -412,7 +412,7 @@ subroutine psb_zovrlv(x,desc_a,info,work,update)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if

4
base/comm/psb_zscatter.f90
Unescape Escape View File

@ -253,7 +253,7 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, iroot,&
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act == act_abort) then if (err_act == psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if
@ -445,7 +445,7 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, iroot)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act == act_abort) then if (err_act == psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if

3
base/internals/psi_compute_size.f90
Unescape Escape View File

@ -31,6 +31,7 @@
subroutine psi_compute_size(desc_data, index_in, dl_lda, info) subroutine psi_compute_size(desc_data, index_in, dl_lda, info)
use psb_const_mod use psb_const_mod
use psb_descriptor_type
use psb_error_mod use psb_error_mod
use psb_penv_mod use psb_penv_mod
implicit none implicit none
@ -117,7 +118,7 @@ subroutine psi_compute_size(desc_data, index_in, dl_lda, info)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act == act_abort) then if (err_act == psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if

2
base/internals/psi_crea_bnd_elem.f90
Unescape Escape View File

@ -111,7 +111,7 @@ subroutine psi_crea_bnd_elem(bndel,desc_a,info)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error() call psb_error()
return return
end if end if

2
base/internals/psi_crea_index.f90
Unescape Escape View File

@ -150,7 +150,7 @@ subroutine psi_crea_index(desc_a,index_in,index_out,glob_idx,nxch,nsnd,nrcv,info
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act == act_abort) then if (err_act == psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if

2
base/internals/psi_crea_ovr_elem.f90
Unescape Escape View File

@ -190,7 +190,7 @@ subroutine psi_crea_ovr_elem(desc_overlap,ovr_elem,info)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act == act_abort) then if (err_act == psb_act_abort_) then
call psb_error() call psb_error()
return return
end if end if

2
base/internals/psi_desc_index.f90
Unescape Escape View File

@ -257,7 +257,7 @@ subroutine psi_desc_index(desc,index_in,dep_list,&
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if

1
base/internals/psi_dl_check.f90
Unescape Escape View File

@ -31,6 +31,7 @@
subroutine psi_dl_check(dep_list,dl_lda,np,length_dl) subroutine psi_dl_check(dep_list,dl_lda,np,length_dl)
use psb_const_mod use psb_const_mod
use psb_descriptor_type
implicit none implicit none
integer :: np,dl_lda,length_dl(0:np) integer :: np,dl_lda,length_dl(0:np)

106
base/internals/psi_dswapdata.f90
Unescape Escape View File

@ -48,7 +48,7 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
integer :: ictxt, np, me, point_to_proc, nesd, nerv,& integer :: ictxt, np, me, point_to_proc, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),& & proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, err_act, totxch, ixrec, i, idx_pt,& & idxs, idxr, iret, err_act, totxch, ixrec, i, idx_pt,&
& snd_pt, rcv_pt, pnti & snd_pt, rcv_pt, pnti, data_
integer :: krecvid, ksendid integer :: krecvid, ksendid
integer, allocatable, dimension(:) :: bsdidx, brvidx,& integer, allocatable, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, rvhd, sdhd & sdsz, rvsz, prcid, rvhd, sdhd
@ -90,29 +90,33 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
do_recv = swap_mpi .or. swap_sync .or. swap_recv do_recv = swap_mpi .or. swap_sync .or. swap_recv
if(present(data)) then if(present(data)) then
if(data == psb_comm_halo_) then data_ = data
d_idx => desc_a%halo_index
totxch = desc_a%matrix_data(psb_thal_xch_)
idxr = desc_a%matrix_data(psb_thal_rcv_)
idxs = desc_a%matrix_data(psb_thal_snd_)
else if(data == psb_comm_ovr_) then
d_idx => desc_a%ovrlap_index
totxch = desc_a%matrix_data(psb_tovr_xch_)
idxr = desc_a%matrix_data(psb_tovr_rcv_)
idxs = desc_a%matrix_data(psb_tovr_snd_)
else
d_idx => desc_a%halo_index
totxch = desc_a%matrix_data(psb_thal_xch_)
idxr = desc_a%matrix_data(psb_thal_rcv_)
idxs = desc_a%matrix_data(psb_thal_snd_)
end if
else else
data_ = psb_comm_halo_
end if
select case(data_)
case(psb_comm_halo_)
d_idx => desc_a%halo_index d_idx => desc_a%halo_index
totxch = desc_a%matrix_data(psb_thal_xch_) totxch = desc_a%matrix_data(psb_thal_xch_)
idxr = desc_a%matrix_data(psb_thal_rcv_) idxr = desc_a%matrix_data(psb_thal_rcv_)
idxs = desc_a%matrix_data(psb_thal_snd_) idxs = desc_a%matrix_data(psb_thal_snd_)
end if
case(psb_comm_ovr_)
d_idx => desc_a%ovrlap_index
totxch = desc_a%matrix_data(psb_tovr_xch_)
idxr = desc_a%matrix_data(psb_tovr_rcv_)
idxs = desc_a%matrix_data(psb_tovr_snd_)
case(psb_comm_ext_)
d_idx => desc_a%ext_index
totxch = desc_a%matrix_data(psb_text_xch_)
idxr = desc_a%matrix_data(psb_text_rcv_)
idxs = desc_a%matrix_data(psb_text_snd_)
case default
call psb_errpush(4010,name,a_err='wrong Data selector')
goto 9999
end select
idxr = idxr * n idxr = idxr * n
idxs = idxs * n idxs = idxs * n
@ -146,7 +150,7 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
bsdidx(proc_to_comm) = snd_pt bsdidx(proc_to_comm) = snd_pt
sdsz(proc_to_comm) = n*nesd sdsz(proc_to_comm) = n*nesd
rcv_pt = rcv_pt + n*nerv rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd snd_pt = snd_pt + n*nesd
pnti = pnti + nerv + nesd + 3 pnti = pnti + nerv + nesd + 3
@ -218,7 +222,7 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
proc_to_comm = d_idx(pnti+psb_proc_id_) proc_to_comm = d_idx(pnti+psb_proc_id_)
nerv = d_idx(pnti+psb_n_elem_recv_) nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_) nesd = d_idx(pnti+nerv+psb_n_elem_send_)
if (proc_to_comm < me) then if (proc_to_comm < me) then
call psb_snd(ictxt,sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) call psb_snd(ictxt,sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
call psb_rcv(ictxt,rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) call psb_rcv(ictxt,rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
@ -226,7 +230,7 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
call psb_rcv(ictxt,rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) call psb_rcv(ictxt,rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
call psb_snd(ictxt,sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) call psb_snd(ictxt,sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
end if end if
rcv_pt = rcv_pt + n*nerv rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd snd_pt = snd_pt + n*nesd
pnti = pnti + nerv + nesd + 3 pnti = pnti + nerv + nesd + 3
@ -237,7 +241,7 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
else if (swap_send .and. swap_recv) then else if (swap_send .and. swap_recv) then
! First I post all the non blocking receives ! First I post all the non blocking receives
pnti = 1 pnti = 1
snd_pt = 1 snd_pt = 1
rcv_pt = 1 rcv_pt = 1
@ -251,7 +255,7 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
call mpi_irecv(rcvbuf(rcv_pt),n*nerv,& call mpi_irecv(rcvbuf(rcv_pt),n*nerv,&
& mpi_double_precision,prcid(i),& & mpi_double_precision,prcid(i),&
& p2ptag, icomm,rvhd(i),iret) & p2ptag, icomm,rvhd(i),iret)
rcv_pt = rcv_pt + n*nerv rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd snd_pt = snd_pt + n*nesd
pnti = pnti + nerv + nesd + 3 pnti = pnti + nerv + nesd + 3
@ -288,7 +292,7 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
call psb_errpush(info,name,i_err=int_err) call psb_errpush(info,name,i_err=int_err)
goto 9999 goto 9999
end if end if
rcv_pt = rcv_pt + n*nerv rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd snd_pt = snd_pt + n*nesd
pnti = pnti + nerv + nesd + 3 pnti = pnti + nerv + nesd + 3
@ -304,7 +308,7 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
nesd = d_idx(pnti+nerv+psb_n_elem_send_) nesd = d_idx(pnti+nerv+psb_n_elem_send_)
p2ptag = krecvid(ictxt,proc_to_comm,me) p2ptag = krecvid(ictxt,proc_to_comm,me)
if (proc_to_comm /= me) then if (proc_to_comm /= me) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
@ -316,7 +320,7 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
end if end if
pnti = pnti + nerv + nesd + 3 pnti = pnti + nerv + nesd + 3
end do end do
else if (swap_send) then else if (swap_send) then
@ -329,7 +333,7 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
nerv = d_idx(pnti+psb_n_elem_recv_) nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_) nesd = d_idx(pnti+nerv+psb_n_elem_send_)
call psb_snd(ictxt,sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) call psb_snd(ictxt,sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
rcv_pt = rcv_pt + n*nerv rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd snd_pt = snd_pt + n*nesd
pnti = pnti + nerv + nesd + 3 pnti = pnti + nerv + nesd + 3
@ -398,7 +402,7 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act == act_abort) then if (err_act == psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if
@ -456,7 +460,7 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
integer :: ictxt, np, me, point_to_proc, nesd, nerv,& integer :: ictxt, np, me, point_to_proc, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),& & proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, err_act, totxch, ixrec, i, & & idxs, idxr, iret, err_act, totxch, ixrec, i, &
& idx_pt, snd_pt, rcv_pt, n, pnti & idx_pt, snd_pt, rcv_pt, n, pnti, data_
integer, allocatable, dimension(:) :: bsdidx, brvidx,& integer, allocatable, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, rvhd, sdhd & sdsz, rvsz, prcid, rvhd, sdhd
@ -500,30 +504,34 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
do_recv = swap_mpi .or. swap_sync .or. swap_recv do_recv = swap_mpi .or. swap_sync .or. swap_recv
if(present(data)) then if(present(data)) then
if(data == psb_comm_halo_) then data_ = data
d_idx => desc_a%halo_index
totxch = desc_a%matrix_data(psb_thal_xch_)
idxr = desc_a%matrix_data(psb_thal_rcv_)
idxs = desc_a%matrix_data(psb_thal_snd_)
else if(data == psb_comm_ovr_) then
d_idx => desc_a%ovrlap_index
totxch = desc_a%matrix_data(psb_tovr_xch_)
idxr = desc_a%matrix_data(psb_tovr_rcv_)
idxs = desc_a%matrix_data(psb_tovr_snd_)
else
d_idx => desc_a%halo_index
totxch = desc_a%matrix_data(psb_thal_xch_)
idxr = desc_a%matrix_data(psb_thal_rcv_)
idxs = desc_a%matrix_data(psb_thal_snd_)
end if
else else
data_ = psb_comm_halo_
end if
select case(data_)
case(psb_comm_halo_)
d_idx => desc_a%halo_index d_idx => desc_a%halo_index
totxch = desc_a%matrix_data(psb_thal_xch_) totxch = desc_a%matrix_data(psb_thal_xch_)
idxr = desc_a%matrix_data(psb_thal_rcv_) idxr = desc_a%matrix_data(psb_thal_rcv_)
idxs = desc_a%matrix_data(psb_thal_snd_) idxs = desc_a%matrix_data(psb_thal_snd_)
end if
case(psb_comm_ovr_)
d_idx => desc_a%ovrlap_index
totxch = desc_a%matrix_data(psb_tovr_xch_)
idxr = desc_a%matrix_data(psb_tovr_rcv_)
idxs = desc_a%matrix_data(psb_tovr_snd_)
case(psb_comm_ext_)
d_idx => desc_a%ext_index
totxch = desc_a%matrix_data(psb_text_xch_)
idxr = desc_a%matrix_data(psb_text_rcv_)
idxs = desc_a%matrix_data(psb_text_snd_)
case default
call psb_errpush(4010,name,a_err='wrong Data selector')
goto 9999
end select
idxr = idxr * n idxr = idxr * n
idxs = idxs * n idxs = idxs * n
@ -793,7 +801,7 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act == act_abort) then if (err_act == psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if

4
base/internals/psi_dswaptran.f90
Unescape Escape View File

@ -387,7 +387,7 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act == act_abort) then if (err_act == psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if
@ -791,7 +791,7 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act == act_abort) then if (err_act == psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if

20
base/internals/psi_extrct_dl.f
Unescape Escape View File

@ -120,6 +120,7 @@ c length_dl integer array(0:np)
c length_dl(i) is the length of dep_list(*,i) list c length_dl(i) is the length of dep_list(*,i) list
use psb_penv_mod use psb_penv_mod
use psb_const_mod use psb_const_mod
use psb_error_mod
use psb_descriptor_type use psb_descriptor_type
implicit none implicit none
include 'mpif.h' include 'mpif.h'
@ -141,7 +142,8 @@ c .....local scalars...
parameter (debug=.false.) parameter (debug=.false.)
character name*20 character name*20
name='psi_extrct_dl' name='psi_extrct_dl'
call fcpsb_get_erraction(err_act)
call psb_erractionsave(err_act)
info = 0 info = 0
ictxt = desc_data(psb_ctxt_) ictxt = desc_data(psb_ctxt_)
@ -168,7 +170,9 @@ c ..if number of element to be exchanged !=0
proc=desc_str(i) proc=desc_str(i)
if ((proc.lt.0).or.(proc.ge.nprow)) then if ((proc.lt.0).or.(proc.ge.nprow)) then
if (debug) write(0,*) 'extract error ',i,desc_str(i) if (debug) write(0,*) 'extract error ',i,desc_str(i)
info = 3999 info = 9999
int_err(1) = i
int_err(2) = desc_str(i)
goto 998 goto 998
endif endif
! if((me.eq.1).and.(proc.eq.3))write(0,*)'found 3' ! if((me.eq.1).and.(proc.eq.3))write(0,*)'found 3'
@ -260,12 +264,18 @@ c ... check for errors...
+ dep_list,dl_lda,mpi_integer,icomm,info) + dep_list,dl_lda,mpi_integer,icomm,info)
deallocate(itmp) deallocate(itmp)
call psb_erractionrestore(err_act)
return return
9999 continue 9999 continue
call fcpsb_errpush(info,name,int_err)
if(err_act.eq.act_abort) then call psb_errpush(info,name,i_err=int_err)
call fcpsb_perror(ictxt) call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_ret_) then
return
else
call psb_error()
endif endif
return return

2
base/internals/psi_fnd_owner.f90
Unescape Escape View File

@ -133,7 +133,7 @@ subroutine psi_fnd_owner(nv,idx,iprc,desc,info)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then if (err_act.eq.psb_act_ret_) then
return return
else else
call psb_error(ictxt) call psb_error(ictxt)

4
base/internals/psi_idx_cnv.f90
Unescape Escape View File

@ -139,7 +139,7 @@ subroutine psi_idx_cnv1(nv,idxin,desc,info,mask,owned)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then if (err_act.eq.psb_act_ret_) then
return return
else else
call psb_error(ictxt) call psb_error(ictxt)
@ -326,7 +326,7 @@ subroutine psi_idx_cnv2(nv,idxin,idxout,desc,info,mask,owned)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then if (err_act.eq.psb_act_ret_) then
return return
else else
call psb_error(ictxt) call psb_error(ictxt)

4
base/internals/psi_idx_ins_cnv.f90
Unescape Escape View File

@ -130,7 +130,7 @@ subroutine psi_idx_ins_cnv1(nv,idxin,desc,info,mask)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then if (err_act.eq.psb_act_ret_) then
return return
else else
call psb_error(ictxt) call psb_error(ictxt)
@ -368,7 +368,7 @@ subroutine psi_idx_ins_cnv2(nv,idxin,idxout,desc,info,mask)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then if (err_act.eq.psb_act_ret_) then
return return
else else
call psb_error(ictxt) call psb_error(ictxt)

4
base/internals/psi_iswapdata.f90
Unescape Escape View File

@ -398,7 +398,7 @@ subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act == act_abort) then if (err_act == psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if
@ -793,7 +793,7 @@ subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act == act_abort) then if (err_act == psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if

4
base/internals/psi_iswaptran.f90
Unescape Escape View File

@ -388,7 +388,7 @@ subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act == act_abort) then if (err_act == psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if
@ -791,7 +791,7 @@ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act == act_abort) then if (err_act == psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if

89
base/internals/psi_ldsc_pre_halo.f90
Unescape Escape View File

@ -28,7 +28,7 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
subroutine psi_ldsc_pre_halo(desc,info) subroutine psi_ldsc_pre_halo(desc,ext_hv,info)
use psb_descriptor_type use psb_descriptor_type
use psb_serial_mod use psb_serial_mod
use psb_const_mod use psb_const_mod
@ -38,6 +38,7 @@ subroutine psi_ldsc_pre_halo(desc,info)
use psi_mod, only : psi_fnd_owner use psi_mod, only : psi_fnd_owner
implicit none implicit none
type(psb_desc_type), intent(inout) :: desc type(psb_desc_type), intent(inout) :: desc
logical, intent(in) :: ext_hv
integer, intent(out) :: info integer, intent(out) :: info
integer,allocatable :: helem(:),hproc(:) integer,allocatable :: helem(:),hproc(:)
@ -68,8 +69,9 @@ subroutine psi_ldsc_pre_halo(desc,info)
if (.not.(psb_is_bld_desc(desc).and.psb_is_large_desc(desc))) then if (.not.(psb_is_bld_desc(desc).and.psb_is_large_desc(desc))) then
write(0,*) 'Invalid input descriptor in ldsc_pre_halo' info = 1122
call psb_errpush(info,name)
goto 9999
end if end if
@ -115,56 +117,55 @@ subroutine psi_ldsc_pre_halo(desc,info)
end if end if
end do end do
nh = (n_col-n_row) if (.not.ext_hv) then
if (nh > 0) then nh = (n_col-n_row)
Allocate(helem(nh),stat=info) if (nh > 0) then
if (info /= 0) then Allocate(helem(nh),stat=info)
call psb_errpush(4010,name,a_err='Allocate') if (info /= 0) then
goto 9999 call psb_errpush(4010,name,a_err='Allocate')
end if goto 9999
do i=1, nh
helem(i) = desc%loc_to_glob(n_row+i)
end do
call psi_fnd_owner(nh,helem,hproc,desc,info)
allocate(tmphl((3*((n_col-n_row)+1)+1)),stat=info)
if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate')
goto 9999
end if
j = 1
do i=1,nh
tmphl(j+0) = hproc(i)
if (tmphl(j+0)<0) then
write(0,*) 'Unrecoverable error: missing proc from asb'
end if end if
tmphl(j+1) = 1
tmphl(j+2) = n_row+i
j = j + 3
end do
tmphl(j) = -1
lhalo = j
nhalo = (lhalo-1)/3
else
allocate(tmphl(1),stat=info)
if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate')
goto 9999
end if
tmphl=-1
endif
call psb_transfer(tmphl,desc%halo_index,info) do i=1, nh
helem(i) = desc%loc_to_glob(n_row+i)
end do
call psi_fnd_owner(nh,helem,hproc,desc,info)
allocate(tmphl((3*((n_col-n_row)+1)+1)),stat=info)
if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate')
goto 9999
end if
j = 1
do i=1,nh
tmphl(j+0) = hproc(i)
if (tmphl(j+0)<0) then
write(0,*) 'Unrecoverable error: missing proc from asb'
end if
tmphl(j+1) = 1
tmphl(j+2) = n_row+i
j = j + 3
end do
tmphl(j) = -1
lhalo = j
nhalo = (lhalo-1)/3
else
allocate(tmphl(1),stat=info)
if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate')
goto 9999
end if
tmphl=-1
endif
call psb_transfer(tmphl,desc%halo_index,info)
end if
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then if (err_act.eq.psb_act_ret_) then
return return
else else
call psb_error(ictxt) call psb_error(ictxt)

2
base/internals/psi_sort_dl.f90
Unescape Escape View File

@ -81,7 +81,7 @@ subroutine psi_sort_dl(dep_list,l_dep_list,np,info)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act == act_abort) then if (err_act == psb_act_abort_) then
call psb_error() call psb_error()
return return
end if end if

4
base/internals/psi_zswapdata.f90
Unescape Escape View File

@ -398,7 +398,7 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act == act_abort) then if (err_act == psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if
@ -793,7 +793,7 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act == act_abort) then if (err_act == psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if

4
base/internals/psi_zswaptran.f90
Unescape Escape View File

@ -382,7 +382,7 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act == act_abort) then if (err_act == psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if
@ -782,7 +782,7 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act == act_abort) then if (err_act == psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if

3
base/modules/Makefile
Unescape Escape View File

@ -18,7 +18,7 @@ INCDIRS = -I .
psb_realloc_mod.o : psb_error_mod.o psb_realloc_mod.o : psb_error_mod.o
psb_spmat_type.o : psb_realloc_mod.o psb_const_mod.o psb_string_mod.o psb_spmat_type.o : psb_realloc_mod.o psb_error_mod.o psb_const_mod.o psb_string_mod.o
psb_error_mod.o: psb_const_mod.o psb_error_mod.o: psb_const_mod.o
psb_penv_mod.o: psb_const_mod.o psb_error_mod.o psb_penv_mod.o: psb_const_mod.o psb_error_mod.o
psi_mod.o: psb_penv_mod.o psb_error_mod.o psb_desc_type.o psi_mod.o: psb_penv_mod.o psb_error_mod.o psb_desc_type.o
@ -34,6 +34,7 @@ lib: mpfobjs $(MODULES) $(OBJS)
$(AR) $(LIBDIR)/$(LIBNAME) $(MODULES) $(OBJS) $(MPFOBJS) $(AR) $(LIBDIR)/$(LIBNAME) $(MODULES) $(OBJS) $(MPFOBJS)
$(RANLIB) $(LIBDIR)/$(LIBNAME) $(RANLIB) $(LIBDIR)/$(LIBNAME)
/bin/cp -p $(LIBMOD) ./parts.fh $(LIBDIR) /bin/cp -p $(LIBMOD) ./parts.fh $(LIBDIR)
/bin/cp -p *$(.mod) $(LIBDIR)
mpfobjs: mpfobjs:

6
base/modules/psb_check_mod.f90
Unescape Escape View File

@ -164,7 +164,7 @@ contains
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act == act_abort) then if (err_act == psb_act_abort_) then
call psb_error() call psb_error()
return return
end if end if
@ -284,7 +284,7 @@ contains
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act == act_abort) then if (err_act == psb_act_abort_) then
call psb_error() call psb_error()
return return
end if end if
@ -425,7 +425,7 @@ contains
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act == act_abort) then if (err_act == psb_act_abort_) then
call psb_error() call psb_error()
return return
end if end if

8
base/modules/psb_comm_mod.f90
Unescape Escape View File

@ -66,24 +66,24 @@ module psb_comm_mod
end interface end interface
interface psb_halo interface psb_halo
subroutine psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode) subroutine psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
use psb_descriptor_type use psb_descriptor_type
real(kind(1.d0)), intent(inout) :: x(:,:) real(kind(1.d0)), intent(inout) :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info integer, intent(out) :: info
real(kind(1.d0)), intent(in), optional :: alpha real(kind(1.d0)), intent(in), optional :: alpha
real(kind(1.d0)), target, optional :: work(:) real(kind(1.d0)), target, optional :: work(:)
integer, intent(in), optional :: mode,jx,ik integer, intent(in), optional :: mode,jx,ik,data
character, intent(in), optional :: tran character, intent(in), optional :: tran
end subroutine psb_dhalom end subroutine psb_dhalom
subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode) subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode,data)
use psb_descriptor_type use psb_descriptor_type
real(kind(1.d0)), intent(inout) :: x(:) real(kind(1.d0)), intent(inout) :: x(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info integer, intent(out) :: info
real(kind(1.d0)), intent(in), optional :: alpha real(kind(1.d0)), intent(in), optional :: alpha
real(kind(1.d0)), target, optional :: work(:) real(kind(1.d0)), target, optional :: work(:)
integer, intent(in), optional :: mode integer, intent(in), optional :: mode,data
character, intent(in), optional :: tran character, intent(in), optional :: tran
end subroutine psb_dhalov end subroutine psb_dhalov
subroutine psb_ihalom(x,desc_a,info,alpha,jx,ik,work,tran,mode) subroutine psb_ihalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)

101
base/modules/psb_const_mod.f90
Unescape Escape View File

@ -30,106 +30,6 @@
!!$ !!$
module psb_const_mod module psb_const_mod
!
! Communication, prolongation & restriction
!
integer, parameter :: psb_nohalo_=0, psb_halo_=4
integer, parameter :: psb_none_=0, psb_sum_=1
integer, parameter :: psb_avg_=2, psb_square_root_=3
integer, parameter :: psb_swap_send_=1, psb_swap_recv_=2
integer, parameter :: psb_swap_sync_=4, psb_swap_mpi_=8
!
! Data checks
!
integer, parameter :: psb_deadlock_check_=0
integer, parameter :: psb_local_mtrx_check_=1
integer, parameter :: psb_local_comm_check_=2
integer, parameter :: psb_consistency_check_=3
integer, parameter :: psb_global_check_=4
integer, parameter :: psb_order_communication_=5
integer, parameter :: psb_change_represent_=6
integer, parameter :: psb_loc_to_glob_check_=7
integer, parameter :: psb_convert_halo_=1, psb_convert_ovrlap_=2
integer, parameter :: psb_act_ret_=0, psb_act_abort_=1, no_err_=0
!
! Entries and values in desc%matrix_data
!
integer, parameter :: psb_dec_type_=1, psb_m_=2,psb_n_=3
integer, parameter :: psb_n_row_=4, psb_n_col_=5,psb_ctxt_=6
integer, parameter :: psb_desc_size_=7
integer, parameter :: psb_ovl_state_=8
integer, parameter :: psb_mpi_c_=9
integer, parameter :: psb_thal_xch_=11
integer, parameter :: psb_thal_snd_=12
integer, parameter :: psb_thal_rcv_=13
integer, parameter :: psb_tovr_xch_=14
integer, parameter :: psb_tovr_snd_=15
integer, parameter :: psb_tovr_rcv_=16
integer, parameter :: psb_mdata_size_=20
integer, parameter :: psb_desc_asb_=3099
integer, parameter :: psb_desc_bld_=psb_desc_asb_+1
integer, parameter :: psb_desc_repl_=3199
integer, parameter :: psb_desc_upd_=psb_desc_bld_+1
integer, parameter :: psb_desc_normal_=3299
integer, parameter :: psb_desc_large_=psb_desc_normal_+1
integer, parameter :: psb_cd_ovl_bld_=3399
integer, parameter :: psb_cd_ovl_asb_=psb_cd_ovl_bld_+1
integer, parameter :: nbits=14
integer, parameter :: hashsize=2**nbits, hashmask=hashsize-1
integer, parameter :: psb_default_large_threshold=4*1024*1024 ! to be reviewed
integer, parameter :: psb_hpnt_nentries_=7
!
! Constants for desc_a handling
!
integer, parameter :: psb_upd_glbnum_=998
integer, parameter :: psb_upd_locnum_=997
integer, parameter :: psb_proc_id_=0, psb_n_elem_recv_=1
integer, parameter :: psb_elem_recv_=2, psb_n_elem_send_=2
integer, parameter :: psb_elem_send_=3, psb_n_ovrlp_elem_=1
integer, parameter :: psb_ovrlp_elem_to_=2, psb_ovrlp_elem_=0
integer, parameter :: psb_n_dom_ovr_=1
integer, parameter :: psb_no_comm_=-1
integer, parameter :: psb_comm_halo_=0, psb_comm_ovr_=1
!
! Queries into spmat%info
!
integer, parameter :: psb_nztotreq_=1, psb_nzrowreq_=2
integer, parameter :: psb_nzsizereq_=3
!
! Entries and values for spmat%info
!
integer, parameter :: psb_nnz_=1
integer, parameter :: psb_del_bnd_=7, psb_srtd_=8
integer, parameter :: psb_state_=9
integer, parameter :: psb_upd_pnt_=10
integer, parameter :: psb_dupl_=11, psb_upd_=12
integer, parameter :: psb_ifasize_=16
integer, parameter :: psb_spmat_null_=0, psb_spmat_bld_=1
integer, parameter :: psb_spmat_asb_=2, psb_spmat_upd_=4
integer, parameter :: psb_ireg_flgs_=10, psb_ip2_=0
integer, parameter :: psb_iflag_=2, psb_ichk_=3
integer, parameter :: psb_nnzt_=4, psb_zero_=5,psb_ipc_=6
integer, parameter :: psb_dupl_ovwrt_ = 0
integer, parameter :: psb_dupl_add_ = 1
integer, parameter :: psb_dupl_err_ = 2
integer, parameter :: psb_dupl_def_ = psb_dupl_ovwrt_
integer, parameter :: psb_upd_dflt_ = 0
integer, parameter :: psb_upd_srch_ = 98764
integer, parameter :: psb_upd_perm_ = 98765
integer, parameter :: psb_isrtdcoo_ = 98761
integer, parameter :: psb_maxjdrows_=8, psb_minjdrows_=4
integer, parameter :: psb_dbleint_=2
!
! Error handling
!
integer, parameter :: act_ret=0, act_abort=1, no_err=0
! !
! Handy & miscellaneous constants ! Handy & miscellaneous constants
! !
@ -142,6 +42,5 @@ module psb_const_mod
real(kind(1.d0)), parameter :: epstol=1.d-32 real(kind(1.d0)), parameter :: epstol=1.d-32
character, parameter :: psb_all_='A', psb_topdef_=' ' character, parameter :: psb_all_='A', psb_topdef_=' '
character(len=5) :: psb_fidef_='CSR'
end module psb_const_mod end module psb_const_mod

61
base/modules/psb_desc_type.f90
Unescape Escape View File

@ -38,14 +38,71 @@
module psb_descriptor_type module psb_descriptor_type
use psb_const_mod use psb_const_mod
implicit none implicit none
!
! Communication, prolongation & restriction
!
integer, parameter :: psb_nohalo_=0, psb_halo_=4
integer, parameter :: psb_none_=0, psb_sum_=1
integer, parameter :: psb_avg_=2, psb_square_root_=3
integer, parameter :: psb_swap_send_=1, psb_swap_recv_=2
integer, parameter :: psb_swap_sync_=4, psb_swap_mpi_=8
integer, parameter :: psb_no_comm_=-1
integer, parameter :: psb_comm_halo_=0, psb_comm_ovr_=1, psb_comm_ext_=2
integer, parameter :: psb_ovt_xhal_ = 123, psb_ovt_asov_=psb_ovt_xhal_+1
!
! Entries and values in desc%matrix_data
!
integer, parameter :: psb_dec_type_=1, psb_m_=2,psb_n_=3
integer, parameter :: psb_n_row_=4, psb_n_col_=5,psb_ctxt_=6
integer, parameter :: psb_desc_size_=7
integer, parameter :: psb_mpi_c_=9
integer, parameter :: psb_thal_xch_=11
integer, parameter :: psb_thal_snd_=12
integer, parameter :: psb_thal_rcv_=13
integer, parameter :: psb_tovr_xch_=14
integer, parameter :: psb_tovr_snd_=15
integer, parameter :: psb_tovr_rcv_=16
integer, parameter :: psb_text_xch_=17
integer, parameter :: psb_text_snd_=18
integer, parameter :: psb_text_rcv_=19
integer, parameter :: psb_mdata_size_=20
integer, parameter :: psb_desc_asb_=3099
integer, parameter :: psb_desc_bld_=psb_desc_asb_+1
integer, parameter :: psb_desc_repl_=3199
integer, parameter :: psb_desc_upd_=psb_desc_bld_+1
integer, parameter :: psb_desc_normal_=3299
integer, parameter :: psb_desc_large_=psb_desc_normal_+1
integer, parameter :: psb_cd_ovl_bld_=3399
integer, parameter :: psb_cd_ovl_asb_=psb_cd_ovl_bld_+1
integer, parameter :: nbits=14
integer, parameter :: hashsize=2**nbits, hashmask=hashsize-1
integer, parameter :: psb_default_large_threshold=4*1024*1024 ! to be reviewed
integer, parameter :: psb_hpnt_nentries_=7
!
! Constants for desc_a handling
!
integer, parameter :: psb_upd_glbnum_=998
integer, parameter :: psb_upd_locnum_=997
integer, parameter :: psb_proc_id_=0, psb_n_elem_recv_=1
integer, parameter :: psb_elem_recv_=2, psb_n_elem_send_=2
integer, parameter :: psb_elem_send_=3, psb_n_ovrlp_elem_=1
integer, parameter :: psb_ovrlp_elem_to_=2, psb_ovrlp_elem_=0
integer, parameter :: psb_n_dom_ovr_=1
! desc_type contains data for communications. ! desc_type contains data for communications.
type psb_desc_type type psb_desc_type
! contain decomposition informations ! contain decomposition informations
integer, allocatable :: matrix_data(:) integer, allocatable :: matrix_data(:)
! contain index of halo elements to send/receive ! contain index of halo elements to send/receive
integer, allocatable :: halo_index(:) integer, allocatable :: halo_index(:), ext_index(:)
! contain indices of boundary elements ! contain indices of boundary elements
integer, allocatable :: bnd_elem(:) integer, allocatable :: bnd_elem(:)
! contain index of overlap elements to send/receive ! contain index of overlap elements to send/receive
@ -265,7 +322,7 @@ contains
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act == act_ret) then if (err_act == psb_act_ret_) then
return return
else else
call psb_error(ictxt) call psb_error(ictxt)

6
base/modules/psb_error_mod.f90
Unescape Escape View File

@ -30,7 +30,10 @@
!!$ !!$
module psb_error_mod module psb_error_mod
use psb_const_mod integer, parameter, public :: psb_act_ret_=0, psb_act_abort_=1, psb_no_err_=0
!
! Error handling
!
public psb_errpush, psb_error, psb_get_errstatus,& public psb_errpush, psb_error, psb_get_errstatus,&
& psb_get_errverbosity, psb_set_errverbosity,psb_errcomm, & & psb_get_errverbosity, psb_set_errverbosity,psb_errcomm, &
& psb_erractionsave, psb_erractionrestore, & & psb_erractionsave, psb_erractionrestore, &
@ -41,7 +44,6 @@ module psb_error_mod
module procedure psb_perror module procedure psb_perror
end interface end interface
!!$ integer, parameter :: act_ret=0, act_abort=1, no_err=0
private private

68
base/modules/psb_realloc_mod.F90
Unescape Escape View File

@ -75,7 +75,8 @@ Contains
use psb_error_mod use psb_error_mod
! ...Subroutine Arguments ! ...Subroutine Arguments
Integer,allocatable :: vin(:),vout(:) Integer,allocatable,intent(in) :: vin(:)
Integer,allocatable,intent(out) :: vout(:)
integer :: info integer :: info
! ...Local Variables ! ...Local Variables
@ -107,7 +108,7 @@ Contains
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then if (err_act.eq.psb_act_ret_) then
return return
else else
call psb_error() call psb_error()
@ -153,7 +154,7 @@ Contains
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then if (err_act.eq.psb_act_ret_) then
return return
else else
call psb_error() call psb_error()
@ -198,7 +199,7 @@ Contains
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then if (err_act.eq.psb_act_ret_) then
return return
else else
call psb_error() call psb_error()
@ -244,7 +245,7 @@ Contains
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then if (err_act.eq.psb_act_ret_) then
return return
else else
call psb_error() call psb_error()
@ -289,7 +290,7 @@ Contains
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then if (err_act.eq.psb_act_ret_) then
return return
else else
call psb_error() call psb_error()
@ -335,7 +336,7 @@ Contains
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then if (err_act.eq.psb_act_ret_) then
return return
else else
call psb_error() call psb_error()
@ -464,7 +465,7 @@ Contains
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then if (err_act.eq.psb_act_ret_) then
return return
else else
call psb_error() call psb_error()
@ -514,7 +515,7 @@ Contains
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then if (err_act.eq.psb_act_ret_) then
return return
else else
call psb_error() call psb_error()
@ -564,7 +565,7 @@ Contains
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then if (err_act.eq.psb_act_ret_) then
return return
else else
call psb_error() call psb_error()
@ -586,26 +587,31 @@ Contains
integer, optional, intent(in) :: lb integer, optional, intent(in) :: lb
! ...Local Variables ! ...Local Variables
Integer,allocatable :: tmp(:) Integer,allocatable :: tmp(:)
Integer :: dim, err_act, err,i,lb_ Integer :: dim, err_act, err,i,lb_
character(len=20) :: name character(len=20) :: name
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
name='psb_dreallocate1i' name='psb_dreallocate1i'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if(psb_get_errstatus().ne.0) return
info=0
if (debug) write(0,*) 'reallocate I',len if (debug) write(0,*) 'reallocate I',len
if (psb_get_errstatus().ne.0) return
info=0
if (present(lb)) then if (present(lb)) then
lb_ = lb lb_ = lb
else else
lb_ = 1 lb_ = 1
endif endif
if ((len<0).or.(len>25*1024*1024)) then
err=2025
call psb_errpush(err,name,i_err=(/len,0,0,0,0/))
goto 9999
end if
if (allocated(rrax)) then if (allocated(rrax)) then
dim=size(rrax) dim=size(rrax)
If (dim /= len) Then If (dim /= len) Then
Allocate(tmp(lb_:len),stat=info) Allocate(tmp(len),stat=info)
if (info /= 0) then if (info /= 0) then
err=4000 err=4000
call psb_errpush(err,name) call psb_errpush(err,name)
@ -618,7 +624,7 @@ Contains
end if end if
else else
dim = 0 dim = 0
allocate(rrax(lb_:len),stat=info) allocate(rrax(len),stat=info)
if (info /= 0) then if (info /= 0) then
err=4000 err=4000
call psb_errpush(err,name) call psb_errpush(err,name)
@ -635,7 +641,7 @@ Contains
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then if (err_act.eq.psb_act_ret_) then
return return
else else
call psb_error() call psb_error()
@ -672,6 +678,12 @@ Contains
else else
lb_ = 1 lb_ = 1
endif endif
if ((len<0).or.(len>25*1024*1024)) then
err=2025
call psb_errpush(err,name,i_err=(/len,0,0,0,0/))
goto 9999
end if
if (allocated(rrax)) then if (allocated(rrax)) then
dim=size(rrax) dim=size(rrax)
@ -707,7 +719,7 @@ Contains
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then if (err_act.eq.psb_act_ret_) then
return return
else else
call psb_error() call psb_error()
@ -736,6 +748,12 @@ Contains
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = 0 info = 0
if (debug) write(0,*) 'reallocate Z',len if (debug) write(0,*) 'reallocate Z',len
if ((len<0).or.(len>25*1024*1024)) then
err=2025
call psb_errpush(err,name,i_err=(/len,0,0,0,0/))
goto 9999
end if
if (allocated(rrax)) then if (allocated(rrax)) then
dim=size(rrax) dim=size(rrax)
@ -771,7 +789,7 @@ Contains
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then if (err_act.eq.psb_act_ret_) then
return return
else else
call psb_error() call psb_error()
@ -837,7 +855,7 @@ Contains
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then if (err_act.eq.psb_act_ret_) then
return return
else else
call psb_error() call psb_error()
@ -902,7 +920,7 @@ Contains
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then if (err_act.eq.psb_act_ret_) then
return return
else else
call psb_error() call psb_error()
@ -966,7 +984,7 @@ Contains
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then if (err_act.eq.psb_act_ret_) then
return return
else else
call psb_error() call psb_error()
@ -1009,7 +1027,7 @@ Contains
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then if (err_act.eq.psb_act_ret_) then
return return
else else
call psb_error() call psb_error()
@ -1060,7 +1078,7 @@ Contains
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then if (err_act.eq.psb_act_ret_) then
return return
else else
call psb_error() call psb_error()
@ -1109,7 +1127,7 @@ Contains
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then if (err_act.eq.psb_act_ret_) then
return return
else else
call psb_error() call psb_error()

52
base/modules/psb_spmat_type.f90
Unescape Escape View File

@ -32,13 +32,48 @@
!! Module to define D_SPMAT, structure !! !! Module to define D_SPMAT, structure !!
!! for sparse matrix. !! !! for sparse matrix. !!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
module psb_spmat_type module psb_spmat_type
use psb_error_mod use psb_error_mod
use psb_realloc_mod use psb_realloc_mod
use psb_const_mod use psb_const_mod
implicit none
! Typedef: psb_dspmat_type ! Typedef: psb_dspmat_type
! Contains a sparse matrix ! Contains a sparse matrix
!
! Queries into spmat%info
!
integer, parameter :: psb_nztotreq_=1, psb_nzrowreq_=2
integer, parameter :: psb_nzsizereq_=3
!
! Entries and values for spmat%info
!
integer, parameter :: psb_nnz_=1
integer, parameter :: psb_del_bnd_=7, psb_srtd_=8
integer, parameter :: psb_state_=9
integer, parameter :: psb_upd_pnt_=10
integer, parameter :: psb_dupl_=11, psb_upd_=12
integer, parameter :: psb_ifasize_=16
integer, parameter :: psb_spmat_null_=0, psb_spmat_bld_=1
integer, parameter :: psb_spmat_asb_=2, psb_spmat_upd_=4
integer, parameter :: psb_ireg_flgs_=10, psb_ip2_=0
integer, parameter :: psb_iflag_=2, psb_ichk_=3
integer, parameter :: psb_nnzt_=4, psb_zero_=5,psb_ipc_=6
integer, parameter :: psb_dupl_ovwrt_ = 0
integer, parameter :: psb_dupl_add_ = 1
integer, parameter :: psb_dupl_err_ = 2
integer, parameter :: psb_dupl_def_ = psb_dupl_ovwrt_
integer, parameter :: psb_upd_dflt_ = 0
integer, parameter :: psb_upd_srch_ = 98764
integer, parameter :: psb_upd_perm_ = 98765
integer, parameter :: psb_isrtdcoo_ = 98761
integer, parameter :: psb_maxjdrows_=8, psb_minjdrows_=4
integer, parameter :: psb_dbleint_=2
character(len=5) :: psb_fidef_='CSR'
type psb_dspmat_type type psb_dspmat_type
! Rows & columns ! Rows & columns
integer :: m, k integer :: m, k
@ -499,16 +534,25 @@ contains
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
info = 0 info = 0
if (debug) write(0,*) 'Before realloc',nd,size(a%aspk) if (debug) write(0,*) 'Before realloc',nd,size(a%aspk),ni1,ni2
call psb_realloc(nd,a%aspk,info) call psb_realloc(nd,a%aspk,info)
if (debug) write(0,*) 'After realloc',nd,size(a%aspk),info if (debug) write(0,*) 'After realloc',nd,size(a%aspk),info
!!$ call flush(0)
if (info /= 0) return if (info /= 0) return
if (debug) write(0,*) 'Before realloc2',ni2,allocated(a%ia2),size(a%ia2)
!!$ call flush(0)
call psb_realloc(ni2,a%ia2,info) call psb_realloc(ni2,a%ia2,info)
if (info /= 0) return if (info /= 0) return
if (debug) write(0,*) 'Before realloc3',ni1,allocated(a%ia1),size(a%ia1)
!!$ call flush(0)
call psb_realloc(ni1,a%ia1,info) call psb_realloc(ni1,a%ia1,info)
if (info /= 0) return if (info /= 0) return
if (debug) write(0,*) 'Before realloc4',max(1,a%m),allocated(a%pl),size(a%pl)
!!$ call flush(0)
call psb_realloc(max(1,a%m),a%pl,info) call psb_realloc(max(1,a%m),a%pl,info)
if (info /= 0) return if (info /= 0) return
if (debug) write(0,*) 'Before realloc5',max(1,a%k),allocated(a%pr),size(a%pr)
!!$ call flush(0)
call psb_realloc(max(1,a%k),a%pr,info) call psb_realloc(max(1,a%k),a%pr,info)
if (info /= 0) return if (info /= 0) return
@ -1398,7 +1442,7 @@ contains
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error() call psb_error()
return return
end if end if
@ -1553,7 +1597,7 @@ contains
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error() call psb_error()
return return
end if end if

968
base/modules/psb_tools_mod.f90
View File

File diff suppressed because it is too large Load Diff

25
base/modules/psi_mod.f90
Unescape Escape View File

@ -278,9 +278,10 @@ module psi_mod
end interface end interface
interface psi_ldsc_pre_halo interface psi_ldsc_pre_halo
subroutine psi_ldsc_pre_halo(desc,info) subroutine psi_ldsc_pre_halo(desc,ext_hv,info)
use psb_descriptor_type use psb_descriptor_type
type(psb_desc_type), intent(inout) :: desc type(psb_desc_type), intent(inout) :: desc
logical, intent(in) :: ext_hv
integer, intent(out) :: info integer, intent(out) :: info
end subroutine psi_ldsc_pre_halo end subroutine psi_ldsc_pre_halo
end interface end interface
@ -344,7 +345,7 @@ module psi_mod
contains contains
subroutine psi_cnv_dsc(halo_in,ovrlap_in,cdesc, info) subroutine psi_cnv_dsc(halo_in,ovrlap_in,ext_in,cdesc, info)
use psb_const_mod use psb_const_mod
use psb_error_mod use psb_error_mod
@ -354,7 +355,7 @@ contains
implicit none implicit none
! ....scalars parameters.... ! ....scalars parameters....
integer, intent(in) :: halo_in(:), ovrlap_in(:) integer, intent(in) :: halo_in(:), ovrlap_in(:),ext_in(:)
type(psb_desc_type), intent(inout) :: cdesc type(psb_desc_type), intent(inout) :: cdesc
integer, intent(out) :: info integer, intent(out) :: info
@ -396,6 +397,22 @@ contains
cdesc%matrix_data(psb_thal_rcv_) = nrcv cdesc%matrix_data(psb_thal_rcv_) = nrcv
if (debug) write(0,*) me,'Done crea_index on halo' if (debug) write(0,*) me,'Done crea_index on halo'
if (debug) write(0,*) me,'Calling crea_index on ext'
! then ext index
if (debug) write(0,*) me,'Calling crea_index on ext'
call psi_crea_index(cdesc,ext_in, idx_out,.false.,nxch,nsnd,nrcv,info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='psi_crea_index')
goto 9999
end if
call psb_transfer(idx_out,cdesc%ext_index,info)
cdesc%matrix_data(psb_text_xch_) = nxch
cdesc%matrix_data(psb_text_snd_) = nsnd
cdesc%matrix_data(psb_text_rcv_) = nrcv
if (debug) write(0,*) me,'Done crea_index on ext'
if (debug) write(0,*) me,'Calling crea_index on ovrlap' if (debug) write(0,*) me,'Calling crea_index on ovrlap'
! then the overlap index ! then the overlap index
@ -439,7 +456,7 @@ contains
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act == act_abort) then if (err_act == psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if

8
base/psblas/psb_damax.f90
Unescape Escape View File

@ -119,7 +119,7 @@ function psb_damax (x,desc_a, info, jx)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if
@ -240,7 +240,7 @@ function psb_damaxv (x,desc_a, info)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if
@ -363,7 +363,7 @@ subroutine psb_damaxvs (res,x,desc_a, info)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if
@ -490,7 +490,7 @@ subroutine psb_dmamaxs (res,x,desc_a, info,jx)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if

6
base/psblas/psb_dasum.f90
Unescape Escape View File

@ -139,7 +139,7 @@ function psb_dasum (x,desc_a, info, jx)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if
@ -276,7 +276,7 @@ function psb_dasumv (x,desc_a, info)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if
@ -415,7 +415,7 @@ subroutine psb_dasumvs (res,x,desc_a, info)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if

4
base/psblas/psb_daxpby.f90
Unescape Escape View File

@ -148,7 +148,7 @@ subroutine psb_daxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if
@ -275,7 +275,7 @@ subroutine psb_daxpbyv(alpha, x, beta,y,desc_a,info)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if

10
base/psblas/psb_ddot.f90
Unescape Escape View File

@ -151,7 +151,7 @@ function psb_ddot(x, y,desc_a, info, jx, jy)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if
@ -289,7 +289,7 @@ function psb_ddotv(x, y,desc_a, info)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if
@ -425,7 +425,7 @@ subroutine psb_ddotvs(res, x, y,desc_a, info)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if
@ -577,7 +577,7 @@ subroutine psb_dmdots(res, x, y, desc_a, info)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if
@ -676,7 +676,7 @@ subroutine psb_ddot2v(res, x, y,w,z,desc_a, info)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if

6
base/psblas/psb_dnrm2.f90
Unescape Escape View File

@ -132,7 +132,7 @@ function psb_dnrm2(x, desc_a, info, jx)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if
@ -265,7 +265,7 @@ function psb_dnrm2v(x, desc_a, info)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if
@ -399,7 +399,7 @@ subroutine psb_dnrm2vs(res, x, desc_a, info)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if

2
base/psblas/psb_dnrmi.f90
Unescape Escape View File

@ -120,7 +120,7 @@ function psb_dnrmi(a,desc_a,info)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if

4
base/psblas/psb_dspmm.f90
Unescape Escape View File

@ -352,7 +352,7 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act == act_abort) then if (err_act == psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if
@ -667,7 +667,7 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,&
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act == act_abort) then if (err_act == psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if

4
base/psblas/psb_dspsm.f90
Unescape Escape View File

@ -309,7 +309,7 @@ subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,&
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if
@ -602,7 +602,7 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,&
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if

8
base/psblas/psb_zamax.f90
Unescape Escape View File

@ -122,7 +122,7 @@ function psb_zamax (x,desc_a, info, jx)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if
@ -248,7 +248,7 @@ function psb_zamaxv (x,desc_a, info)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if
@ -375,7 +375,7 @@ subroutine psb_zamaxvs (res,x,desc_a, info)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if
@ -507,7 +507,7 @@ subroutine psb_zmamaxs (res,x,desc_a, info,jx)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if

6
base/psblas/psb_zasum.f90
Unescape Escape View File

@ -144,7 +144,7 @@ function psb_zasum (x,desc_a, info, jx)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if
@ -287,7 +287,7 @@ function psb_zasumv (x,desc_a, info)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if
@ -431,7 +431,7 @@ subroutine psb_zasumvs (res,x,desc_a, info)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if

4
base/psblas/psb_zaxpby.f90
Unescape Escape View File

@ -146,7 +146,7 @@ subroutine psb_zaxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if
@ -273,7 +273,7 @@ subroutine psb_zaxpbyv(alpha, x, beta,y,desc_a,info)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if

8
base/psblas/psb_zdot.f90
Unescape Escape View File

@ -150,7 +150,7 @@ function psb_zdot(x, y,desc_a, info, jx, jy)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if
@ -288,7 +288,7 @@ function psb_zdotv(x, y,desc_a, info)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if
@ -423,7 +423,7 @@ subroutine psb_zdotvs(res, x, y,desc_a, info)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if
@ -576,7 +576,7 @@ subroutine psb_zmdots(res, x, y, desc_a, info)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if

6
base/psblas/psb_znrm2.f90
Unescape Escape View File

@ -131,7 +131,7 @@ function psb_znrm2(x, desc_a, info, jx)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if
@ -264,7 +264,7 @@ function psb_znrm2v(x, desc_a, info)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if
@ -396,7 +396,7 @@ subroutine psb_znrm2vs(res, x, desc_a, info)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if

2
base/psblas/psb_znrmi.f90
Unescape Escape View File

@ -120,7 +120,7 @@ function psb_znrmi(a,desc_a,info)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if

4
base/psblas/psb_zspmm.f90
Unescape Escape View File

@ -346,7 +346,7 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act == act_abort) then if (err_act == psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if
@ -644,7 +644,7 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,&
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act == act_abort) then if (err_act == psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if

4
base/psblas/psb_zspsm.f90
Unescape Escape View File

@ -312,7 +312,7 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,&
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if
@ -600,7 +600,7 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if

1
base/serial/dp/dcoco.f
Unescape Escape View File

@ -35,6 +35,7 @@ c
* lia2n,aux,laux,ierror) * lia2n,aux,laux,ierror)
use psb_const_mod use psb_const_mod
use psb_spmat_type
implicit none implicit none
c .. scalar arguments .. c .. scalar arguments ..

1
base/serial/dp/dcocr.f
Unescape Escape View File

@ -36,6 +36,7 @@ C
* LIAN2,AUX,LAUX,IERROR) * LIAN2,AUX,LAUX,IERROR)
use psb_const_mod use psb_const_mod
use psb_spmat_type
IMPLICIT NONE IMPLICIT NONE
C C

1
base/serial/dp/dcrco.f
Unescape Escape View File

@ -33,6 +33,7 @@ C
* LIAN2,AUX,LAUX,IERROR) * LIAN2,AUX,LAUX,IERROR)
use psb_const_mod use psb_const_mod
use psb_spmat_type
IMPLICIT NONE IMPLICIT NONE
C C

1
base/serial/dp/dcrjd.f
Unescape Escape View File

@ -60,6 +60,7 @@ C ARN,IAN1
C IAN2,INFON, IP1, IP2 C IAN2,INFON, IP1, IP2
C C
use psb_const_mod use psb_const_mod
use psb_spmat_type
IMPLICIT NONE IMPLICIT NONE
C C

1
base/serial/dp/dcsrp1.f
Unescape Escape View File

@ -117,6 +117,7 @@ C
SUBROUTINE DCSRP1(TRANS,M,N,DESCRA,JA,IA, SUBROUTINE DCSRP1(TRANS,M,N,DESCRA,JA,IA,
+ P,WORK,IWORK,LWORK,IERROR) + P,WORK,IWORK,LWORK,IERROR)
use psb_const_mod use psb_const_mod
use psb_spmat_type
IMPLICIT NONE IMPLICIT NONE
C .. Scalar Arguments .. C .. Scalar Arguments ..
INTEGER LWORK,M, N, IERROR INTEGER LWORK,M, N, IERROR

1
base/serial/dp/dgindex.f
Unescape Escape View File

@ -32,6 +32,7 @@ C
+ LARN,LKA,LJA,IPERM,WORK, LWORK, SIZE_REQ, IERROR) + LARN,LKA,LJA,IPERM,WORK, LWORK, SIZE_REQ, IERROR)
use psb_const_mod use psb_const_mod
use psb_spmat_type
IMPLICIT NONE IMPLICIT NONE
C ... Scalar arguments ... C ... Scalar arguments ...

1
base/serial/dp/gen_block.f
Unescape Escape View File

@ -30,6 +30,7 @@ C
C C
SUBROUTINE GEN_BLOCK(M,NG,IA,AUX) SUBROUTINE GEN_BLOCK(M,NG,IA,AUX)
use psb_const_mod use psb_const_mod
use psb_spmat_type
IMPLICIT NONE IMPLICIT NONE
INTEGER M, NG INTEGER M, NG

1
base/serial/dp/partition.f
Unescape Escape View File

@ -30,6 +30,7 @@ C
C C
SUBROUTINE PARTITION(M, WORK, IA, N_BLOCK) SUBROUTINE PARTITION(M, WORK, IA, N_BLOCK)
use psb_const_mod use psb_const_mod
use psb_spmat_type
IMPLICIT NONE IMPLICIT NONE

1
base/serial/dp/zcoco.f
Unescape Escape View File

@ -35,6 +35,7 @@ c
* lia2n,aux,laux,ierror) * lia2n,aux,laux,ierror)
use psb_const_mod use psb_const_mod
use psb_spmat_type
implicit none implicit none
c .. scalar arguments .. c .. scalar arguments ..

1
base/serial/dp/zcocr.f
Unescape Escape View File

@ -36,6 +36,7 @@ C
* LIAN2,AUX,LAUX,IERROR) * LIAN2,AUX,LAUX,IERROR)
use psb_const_mod use psb_const_mod
use psb_spmat_type
IMPLICIT NONE IMPLICIT NONE
C C

1
base/serial/dp/zcrco.f
Unescape Escape View File

@ -33,6 +33,7 @@ C
* LIAN2,AUX,LAUX,IERROR) * LIAN2,AUX,LAUX,IERROR)
use psb_const_mod use psb_const_mod
use psb_spmat_type
IMPLICIT NONE IMPLICIT NONE
C C

1
base/serial/dp/zcrjd.f
Unescape Escape View File

@ -60,6 +60,7 @@ C ARN,IAN1
C IAN2,INFON, IP1, IP2 C IAN2,INFON, IP1, IP2
C C
use psb_const_mod use psb_const_mod
use psb_spmat_type
IMPLICIT NONE IMPLICIT NONE
C C

1
base/serial/dp/zgindex.f
Unescape Escape View File

@ -32,6 +32,7 @@ C
+ LARN,LKA,LJA,IPERM,WORK, LWORK, SIZE_REQ, IERROR) + LARN,LKA,LJA,IPERM,WORK, LWORK, SIZE_REQ, IERROR)
use psb_const_mod use psb_const_mod
use psb_spmat_type
IMPLICIT NONE IMPLICIT NONE
C ... Scalar arguments ... C ... Scalar arguments ...

1
base/serial/jad/djadnr.f
Unescape Escape View File

@ -32,6 +32,7 @@ C ... Compute infinity norma for sparse matrix in CSR Format ...
DOUBLE PRECISION FUNCTION DJADNR(TRANS,M,N,NG,A,KA,JA,IA, DOUBLE PRECISION FUNCTION DJADNR(TRANS,M,N,NG,A,KA,JA,IA,
+ INFOA,IERROR) + INFOA,IERROR)
use psb_const_mod use psb_const_mod
use psb_spmat_type
IMPLICIT NONE IMPLICIT NONE
C .. Scalar Arguments .. C .. Scalar Arguments ..
INTEGER M,N, IERROR, NG INTEGER M,N, IERROR, NG

1
base/serial/psb_cest.f90
Unescape Escape View File

@ -33,6 +33,7 @@ subroutine psb_cest(afmt, m,n,nnz, lia1, lia2, lar, iup, info)
use psb_error_mod use psb_error_mod
use psb_const_mod use psb_const_mod
use psb_string_mod use psb_string_mod
use psb_spmat_type
implicit none implicit none
! .. scalar arguments .. ! .. scalar arguments ..

2
base/serial/psb_dcoins.f90
Unescape Escape View File

@ -436,7 +436,7 @@ subroutine psb_dcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error() call psb_error()
return return
end if end if

6
base/serial/psb_dcsdp.f90
Unescape Escape View File

@ -179,7 +179,7 @@ subroutine psb_dcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
call psb_cest(b%fida, n_row,n_col,size_req,& call psb_cest(b%fida, n_row,n_col,size_req,&
& ia1_size, ia2_size, aspk_size, upd_,info) & ia1_size, ia2_size, aspk_size, upd_,info)
if (info /= no_err) then if (info /= psb_no_err_) then
info=4010 info=4010
ch_err='psb_cest' ch_err='psb_cest'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
@ -199,7 +199,7 @@ subroutine psb_dcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
call psb_sp_reall(b,ia1_size,ia2_size,aspk_size,info) call psb_sp_reall(b,ia1_size,ia2_size,aspk_size,info)
endif endif
if (info /= no_err) then if (info /= psb_no_err_) then
info=4010 info=4010
ch_err='psb_sp_reall' ch_err='psb_sp_reall'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
@ -516,7 +516,7 @@ subroutine psb_dcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error() call psb_error()
return return
end if end if

2
base/serial/psb_dcsmm.f90
Unescape Escape View File

@ -104,7 +104,7 @@ subroutine psb_dcsmm(alpha,a,b,beta,c,info,trans)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act == act_abort) then if (err_act == psb_act_abort_) then
call psb_error() call psb_error()
return return
end if end if

2
base/serial/psb_dcsmv.f90
Unescape Escape View File

@ -77,7 +77,7 @@ subroutine psb_dcsmv(alpha,a,b,beta,c,info,trans)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if(info.ne.0) then if(info.ne.0) then
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error() call psb_error()
return return
end if end if

2
base/serial/psb_dcsnmi.f90
Unescape Escape View File

@ -81,7 +81,7 @@ real(kind(1.d0)) function psb_dcsnmi(a,info,trans)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error() call psb_error()
return return
end if end if

2
base/serial/psb_dcsrws.f90
Unescape Escape View File

@ -94,7 +94,7 @@ subroutine psb_dcsrws(rw,a,info,trans)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error() call psb_error()
return return
end if end if

2
base/serial/psb_dcssm.f90
Unescape Escape View File

@ -88,7 +88,7 @@ subroutine psb_dcssm(alpha,t,b,beta,c,info,trans,unitd,d)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if(info.ne.0) then if(info.ne.0) then
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error() call psb_error()
return return
end if end if

2
base/serial/psb_dcssv.f90
Unescape Escape View File

@ -88,7 +88,7 @@ subroutine psb_dcssv(alpha,t,b,beta,c,info,trans,unitd,d)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if(info.ne.0) then if(info.ne.0) then
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error() call psb_error()
return return
end if end if

2
base/serial/psb_dipcoo2csc.f90
Unescape Escape View File

@ -186,7 +186,7 @@ subroutine psb_dipcoo2csc(a,info,clshr)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error() call psb_error()
return return
end if end if

2
base/serial/psb_dipcoo2csr.f90
Unescape Escape View File

@ -189,7 +189,7 @@ subroutine psb_dipcoo2csr(a,info,rwshr)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error() call psb_error()
return return
end if end if

2
base/serial/psb_dipcsr2coo.f90
Unescape Escape View File

@ -91,7 +91,7 @@ Subroutine psb_dipcsr2coo(a,info)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error() call psb_error()
return return
end if end if

2
base/serial/psb_dneigh.f90
Unescape Escape View File

@ -91,7 +91,7 @@ subroutine psb_dneigh(a,idx,neigh,n,info,lev)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error() call psb_error()
return return
end if end if

2
base/serial/psb_drwextd.f90
Unescape Escape View File

@ -105,7 +105,7 @@ subroutine psb_drwextd(nr,a,info,b)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error() call psb_error()
return return
end if end if

2
base/serial/psb_dspgetrow.f90
Unescape Escape View File

@ -151,7 +151,7 @@ subroutine psb_dspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error() call psb_error()
return return
end if end if

2
base/serial/psb_dspgtblk.f90
Unescape Escape View File

@ -116,7 +116,7 @@ subroutine psb_dspgtblk(irw,a,b,info,append,iren,lrw)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error() call psb_error()
return return
end if end if

2
base/serial/psb_dspgtdiag.f90
Unescape Escape View File

@ -127,7 +127,7 @@ subroutine psb_dspgtdiag(a,d,info)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error() call psb_error()
return return
end if end if

2
base/serial/psb_dspscal.f90
Unescape Escape View File

@ -88,7 +88,7 @@ subroutine psb_dspscal(a,d,info)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error() call psb_error()
return return
end if end if

2
base/serial/psb_dsymbmm.f90
Unescape Escape View File

@ -125,7 +125,7 @@ subroutine psb_dsymbmm(a,b,c,info)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error() call psb_error()
return return
end if end if

2
base/serial/psb_zcoins.f90
Unescape Escape View File

@ -436,7 +436,7 @@ subroutine psb_zcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error() call psb_error()
return return
end if end if

6
base/serial/psb_zcsdp.f90
Unescape Escape View File

@ -179,7 +179,7 @@ subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
call psb_cest(b%fida, n_row,n_col,size_req,& call psb_cest(b%fida, n_row,n_col,size_req,&
& ia1_size, ia2_size, aspk_size, upd_,info) & ia1_size, ia2_size, aspk_size, upd_,info)
if (info /= no_err) then if (info /= psb_no_err_) then
info=4010 info=4010
ch_err='psb_cest' ch_err='psb_cest'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
@ -199,7 +199,7 @@ subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
call psb_sp_reall(b,ia1_size,ia2_size,aspk_size,info) call psb_sp_reall(b,ia1_size,ia2_size,aspk_size,info)
endif endif
if (info /= no_err) then if (info /= psb_no_err_) then
info=4010 info=4010
ch_err='psb_sp_reall' ch_err='psb_sp_reall'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
@ -516,7 +516,7 @@ subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error() call psb_error()
return return
end if end if

2
base/serial/psb_zcsmm.f90
Unescape Escape View File

@ -77,7 +77,7 @@ subroutine psb_zcsmm(alpha,a,b,beta,c,info,trans)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if(info.ne.0) then if(info.ne.0) then
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error() call psb_error()
return return
end if end if

2
base/serial/psb_zcsmv.f90
Unescape Escape View File

@ -77,7 +77,7 @@ subroutine psb_zcsmv(alpha,a,b,beta,c,info,trans)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if(info.ne.0) then if(info.ne.0) then
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error() call psb_error()
return return
end if end if

2
base/serial/psb_zcsnmi.f90
Unescape Escape View File

@ -81,7 +81,7 @@ real(kind(1.d0)) function psb_zcsnmi(a,info,trans)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error() call psb_error()
return return
end if end if

2
base/serial/psb_zcsrws.f90
Unescape Escape View File

@ -94,7 +94,7 @@ subroutine psb_zcsrws(rw,a,info,trans)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error() call psb_error()
return return
end if end if

2
base/serial/psb_zcssm.f90
Unescape Escape View File

@ -88,7 +88,7 @@ subroutine psb_zcssm(alpha,t,b,beta,c,info,trans,unitd,d)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if(info.ne.0) then if(info.ne.0) then
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error() call psb_error()
return return
end if end if

2
base/serial/psb_zcssv.f90
Unescape Escape View File

@ -88,7 +88,7 @@ subroutine psb_zcssv(alpha,t,b,beta,c,info,trans,unitd,d)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if(info.ne.0) then if(info.ne.0) then
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error() call psb_error()
return return
end if end if

2
base/serial/psb_zipcoo2csc.f90
Unescape Escape View File

@ -187,7 +187,7 @@ subroutine psb_zipcoo2csc(a,info,clshr)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error() call psb_error()
return return
end if end if

2
base/serial/psb_zipcoo2csr.f90
Unescape Escape View File

@ -189,7 +189,7 @@ subroutine psb_zipcoo2csr(a,info,rwshr)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error() call psb_error()
return return
end if end if

2
base/serial/psb_zipcsr2coo.f90
Unescape Escape View File

@ -91,7 +91,7 @@ Subroutine psb_zipcsr2coo(a,info)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.psb_act_abort_) then
call psb_error() call psb_error()
return return
end if end if

Some files were not shown because too many files have changed in this diff Show More

Write Preview
Loading…
Cancel
Save