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

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.
This commit is contained in:
Salvatore Filippone
2007-01-23 10:06:41 +00:00
parent 6296068177
commit 22686aefa0
188 changed files with 1571 additions and 1183 deletions
Download Patch File Download Diff File Expand all files Collapse all files
LICENSE.MD2P4
-33
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.
README
+1 -1
View File
@@ -1,6 +1,6 @@
This directory contains the PSBLAS library, version 2.1.0
Version 1.0 of the library was described in:
S. Filippone, M. Colajanni
PSBLAS: A library for parallel linear algebra computation on sparse matrices
base/Makefile
+1 -1
View File
@@ -12,7 +12,7 @@ lib:
(cd serial; make lib LIBNAME=$(BASELIBNAME))
(cd psblas; make lib LIBNAME=$(BASELIBNAME))
/bin/cp -p $(HERE)/$(LIBNAME) $(LIBDIR)
/bin/cp -p $(LIBMOD) $(LIBDIR)
/bin/cp -p $(LIBMOD) *$(.mod) $(LIBDIR)
clean:
(cd modules; make clean)
base/comm/psb_dgather.f90
+2 -2
View File
@@ -193,7 +193,7 @@ subroutine psb_dgatherm(globx, locx, desc_a, info, iroot,&
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
@@ -365,7 +365,7 @@ subroutine psb_dgatherv(globx, locx, desc_a, info, iroot,&
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
base/comm/psb_dhalo.f90
+23 -16
View File
@@ -45,7 +45,7 @@
! tran - character(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_const_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
real(kind(1.d0)), intent(in), optional :: alpha
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
! locals
integer :: ictxt, np, me,&
& 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(:,:)
character :: ltran
character(len=20) :: name, ch_err
@@ -115,6 +115,14 @@ subroutine psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
else
ltran = 'N'
endif
if (present(data)) then
data_ = data
else
data_ = psb_comm_halo_
endif
if (present(mode)) then
imode = mode
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)
if(ltran.eq.'N') then
call psi_swapdata(imode,k,0.d0,xp,&
& desc_a,iwork,info,data=psb_comm_halo_)
!!$ call PSI_dSwapData(imode,k,0.d0,x(1,jjx),&
!!$ & size(x,1),desc_a%matrix_data,&
!!$ & desc_a%halo_index,iwork,liwork,info)
& desc_a,iwork,info,data=data_)
else if((ltran.eq.'T').or.(ltran.eq.'H')) then
call psi_swaptran(imode,k,1.d0,xp,&
&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
if(info.ne.0) then
@@ -203,7 +205,7 @@ subroutine psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
@@ -257,7 +259,7 @@ end subroutine psb_dhalom
! tran - character(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_const_mod
use psi_mod
@@ -272,13 +274,13 @@ subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode)
integer, intent(out) :: info
real(kind(1.d0)), intent(in), optional :: alpha
real(kind(1.d0)), target, optional :: work(:)
integer, intent(in), optional :: mode
integer, intent(in), optional :: mode,data
character, intent(in), optional :: tran
! locals
integer :: ictxt, np, me,&
& err_act, m, n, iix, jjx, ix, ijx, nrow, imode, i,&
& err, liwork
& err, liwork,data_
real(kind(1.d0)),pointer :: iwork(:)
character :: ltran
character(len=20) :: name, ch_err
@@ -311,6 +313,11 @@ subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode)
else
ltran = 'N'
endif
if (present(data)) then
data_ = data
else
data_ = psb_comm_halo_
endif
if (present(mode)) then
imode = mode
else
@@ -368,7 +375,7 @@ subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode)
! exchange halo elements
if(ltran.eq.'N') then
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
call psi_swaptran(imode,1.d0,x(iix:size(x)),&
& desc_a,iwork,info)
@@ -388,7 +395,7 @@ subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
base/comm/psb_dovrl.f90
+2 -2
View File
@@ -208,7 +208,7 @@ subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,update)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
@@ -411,7 +411,7 @@ subroutine psb_dovrlv(x,desc_a,info,work,update)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
base/comm/psb_dscatter.f90
+2 -2
View File
@@ -253,7 +253,7 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, iroot,&
9999 continue
call psb_erractionrestore(err_act)
if (err_act == act_abort) then
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
@@ -445,7 +445,7 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, iroot)
9999 continue
call psb_erractionrestore(err_act)
if (err_act == act_abort) then
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
base/comm/psb_ihalo.f90
+2 -2
View File
@@ -199,7 +199,7 @@ subroutine psb_ihalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
@@ -387,7 +387,7 @@ subroutine psb_ihalov(x,desc_a,info,alpha,work,tran,mode)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
base/comm/psb_zgather.f90
+2 -2
View File
@@ -195,7 +195,7 @@ subroutine psb_zgatherm(globx, locx, desc_a, info, iroot,&
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
@@ -368,7 +368,7 @@ subroutine psb_zgatherv(globx, locx, desc_a, info, iroot,&
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
base/comm/psb_zhalo.f90
+2 -2
View File
@@ -198,7 +198,7 @@ subroutine psb_zhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
@@ -384,7 +384,7 @@ subroutine psb_zhalov(x,desc_a,info,alpha,work,tran,mode)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
base/comm/psb_zovrl.f90
+2 -2
View File
@@ -208,7 +208,7 @@ subroutine psb_zovrlm(x,desc_a,info,jx,ik,work,update)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
@@ -412,7 +412,7 @@ subroutine psb_zovrlv(x,desc_a,info,work,update)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
base/comm/psb_zscatter.f90
+2 -2
View File
@@ -253,7 +253,7 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, iroot,&
9999 continue
call psb_erractionrestore(err_act)
if (err_act == act_abort) then
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
@@ -445,7 +445,7 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, iroot)
9999 continue
call psb_erractionrestore(err_act)
if (err_act == act_abort) then
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
base/internals/psi_compute_size.f90
+2 -1
View File
@@ -31,6 +31,7 @@
subroutine psi_compute_size(desc_data, index_in, dl_lda, info)
use psb_const_mod
use psb_descriptor_type
use psb_error_mod
use psb_penv_mod
implicit none
@@ -117,7 +118,7 @@ subroutine psi_compute_size(desc_data, index_in, dl_lda, info)
9999 continue
call psb_erractionrestore(err_act)
if (err_act == act_abort) then
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
base/internals/psi_crea_bnd_elem.f90
+1 -1
View File
@@ -111,7 +111,7 @@ subroutine psi_crea_bnd_elem(bndel,desc_a,info)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
base/internals/psi_crea_index.f90
+1 -1
View File
@@ -150,7 +150,7 @@ subroutine psi_crea_index(desc_a,index_in,index_out,glob_idx,nxch,nsnd,nrcv,info
9999 continue
call psb_erractionrestore(err_act)
if (err_act == act_abort) then
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
base/internals/psi_crea_ovr_elem.f90
+1 -1
View File
@@ -190,7 +190,7 @@ subroutine psi_crea_ovr_elem(desc_overlap,ovr_elem,info)
9999 continue
call psb_erractionrestore(err_act)
if (err_act == act_abort) then
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
base/internals/psi_desc_index.f90
+1 -1
View File
@@ -257,7 +257,7 @@ subroutine psi_desc_index(desc,index_in,dep_list,&
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
base/internals/psi_dl_check.f90
+1
View File
@@ -31,6 +31,7 @@
subroutine psi_dl_check(dep_list,dl_lda,np,length_dl)
use psb_const_mod
use psb_descriptor_type
implicit none
integer :: np,dl_lda,length_dl(0:np)
base/internals/psi_dswapdata.f90
+57 -49
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,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& 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, allocatable, dimension(:) :: bsdidx, brvidx,&
& 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
if(present(data)) then
if(data == psb_comm_halo_) then
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
data_ = data
else
data_ = psb_comm_halo_
end if
select case(data_)
case(psb_comm_halo_)
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
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
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
sdsz(proc_to_comm) = n*nesd
rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd
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_)
nerv = d_idx(pnti+psb_n_elem_recv_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
if (proc_to_comm < me) then
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)
@@ -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_snd(ictxt,sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
end if
rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd
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
! First I post all the non blocking receives
pnti = 1
snd_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,&
& mpi_double_precision,prcid(i),&
& p2ptag, icomm,rvhd(i),iret)
rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd
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)
goto 9999
end if
rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd
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_)
p2ptag = krecvid(ictxt,proc_to_comm,me)
if (proc_to_comm /= me) then
call mpi_wait(rvhd(i),p2pstat,iret)
if(iret /= mpi_success) then
@@ -316,7 +320,7 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
end if
pnti = pnti + nerv + nesd + 3
end do
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_)
nesd = d_idx(pnti+nerv+psb_n_elem_send_)
call psb_snd(ictxt,sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd
pnti = pnti + nerv + nesd + 3
@@ -398,7 +402,7 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
9999 continue
call psb_erractionrestore(err_act)
if (err_act == act_abort) then
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
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,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& 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,&
& 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
if(present(data)) then
if(data == psb_comm_halo_) then
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
data_ = data
else
data_ = psb_comm_halo_
end if
select case(data_)
case(psb_comm_halo_)
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
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
idxs = idxs * n
@@ -793,7 +801,7 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
9999 continue
call psb_erractionrestore(err_act)
if (err_act == act_abort) then
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
base/internals/psi_dswaptran.f90
+2 -2
View File
@@ -387,7 +387,7 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
9999 continue
call psb_erractionrestore(err_act)
if (err_act == act_abort) then
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
@@ -791,7 +791,7 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
9999 continue
call psb_erractionrestore(err_act)
if (err_act == act_abort) then
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
base/internals/psi_extrct_dl.f
+15 -5
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
use psb_penv_mod
use psb_const_mod
use psb_error_mod
use psb_descriptor_type
implicit none
include 'mpif.h'
@@ -141,7 +142,8 @@ c .....local scalars...
parameter (debug=.false.)
character name*20
name='psi_extrct_dl'
call fcpsb_get_erraction(err_act)
call psb_erractionsave(err_act)
info = 0
ictxt = desc_data(psb_ctxt_)
@@ -168,7 +170,9 @@ c ..if number of element to be exchanged !=0
proc=desc_str(i)
if ((proc.lt.0).or.(proc.ge.nprow)) then
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
endif
! 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)
deallocate(itmp)
call psb_erractionrestore(err_act)
return
9999 continue
call fcpsb_errpush(info,name,int_err)
if(err_act.eq.act_abort) then
call fcpsb_perror(ictxt)
call psb_errpush(info,name,i_err=int_err)
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_ret_) then
return
else
call psb_error()
endif
return
base/internals/psi_fnd_owner.f90
+1 -1
View File
@@ -133,7 +133,7 @@ subroutine psi_fnd_owner(nv,idx,iprc,desc,info)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then
if (err_act.eq.psb_act_ret_) then
return
else
call psb_error(ictxt)
base/internals/psi_idx_cnv.f90
+2 -2
View File
@@ -139,7 +139,7 @@ subroutine psi_idx_cnv1(nv,idxin,desc,info,mask,owned)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then
if (err_act.eq.psb_act_ret_) then
return
else
call psb_error(ictxt)
@@ -326,7 +326,7 @@ subroutine psi_idx_cnv2(nv,idxin,idxout,desc,info,mask,owned)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then
if (err_act.eq.psb_act_ret_) then
return
else
call psb_error(ictxt)
base/internals/psi_idx_ins_cnv.f90
+2 -2
View File
@@ -130,7 +130,7 @@ subroutine psi_idx_ins_cnv1(nv,idxin,desc,info,mask)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then
if (err_act.eq.psb_act_ret_) then
return
else
call psb_error(ictxt)
@@ -368,7 +368,7 @@ subroutine psi_idx_ins_cnv2(nv,idxin,idxout,desc,info,mask)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then
if (err_act.eq.psb_act_ret_) then
return
else
call psb_error(ictxt)
base/internals/psi_iswapdata.f90
+2 -2
View File
@@ -398,7 +398,7 @@ subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data)
9999 continue
call psb_erractionrestore(err_act)
if (err_act == act_abort) then
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
@@ -793,7 +793,7 @@ subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data)
9999 continue
call psb_erractionrestore(err_act)
if (err_act == act_abort) then
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
base/internals/psi_iswaptran.f90
+2 -2
View File
@@ -388,7 +388,7 @@ subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data)
9999 continue
call psb_erractionrestore(err_act)
if (err_act == act_abort) then
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
@@ -791,7 +791,7 @@ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data)
9999 continue
call psb_erractionrestore(err_act)
if (err_act == act_abort) then
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
base/internals/psi_ldsc_pre_halo.f90
+45 -44
View File
@@ -28,7 +28,7 @@
!!$ 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_serial_mod
use psb_const_mod
@@ -38,6 +38,7 @@ subroutine psi_ldsc_pre_halo(desc,info)
use psi_mod, only : psi_fnd_owner
implicit none
type(psb_desc_type), intent(inout) :: desc
logical, intent(in) :: ext_hv
integer, intent(out) :: info
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
write(0,*) 'Invalid input descriptor in ldsc_pre_halo'
info = 1122
call psb_errpush(info,name)
goto 9999
end if
@@ -115,56 +117,55 @@ subroutine psi_ldsc_pre_halo(desc,info)
end if
end do
nh = (n_col-n_row)
if (nh > 0) then
Allocate(helem(nh),stat=info)
if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate')
goto 9999
end if
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'
if (.not.ext_hv) then
nh = (n_col-n_row)
if (nh > 0) then
Allocate(helem(nh),stat=info)
if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate')
goto 9999
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
do i=1, nh
helem(i) = desc%loc_to_glob(n_row+i)
end do
call psb_transfer(tmphl,desc%halo_index,info)
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)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then
if (err_act.eq.psb_act_ret_) then
return
else
call psb_error(ictxt)
base/internals/psi_sort_dl.f90
+1 -1
View File
@@ -81,7 +81,7 @@ subroutine psi_sort_dl(dep_list,l_dep_list,np,info)
9999 continue
call psb_erractionrestore(err_act)
if (err_act == act_abort) then
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
base/internals/psi_zswapdata.f90
+2 -2
View File
@@ -398,7 +398,7 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data)
9999 continue
call psb_erractionrestore(err_act)
if (err_act == act_abort) then
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
@@ -793,7 +793,7 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data)
9999 continue
call psb_erractionrestore(err_act)
if (err_act == act_abort) then
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
base/internals/psi_zswaptran.f90
+2 -2
View File
@@ -382,7 +382,7 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
9999 continue
call psb_erractionrestore(err_act)
if (err_act == act_abort) then
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
@@ -782,7 +782,7 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data)
9999 continue
call psb_erractionrestore(err_act)
if (err_act == act_abort) then
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
base/modules/Makefile
+2 -1
View File
@@ -18,7 +18,7 @@ INCDIRS = -I .
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_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
@@ -34,6 +34,7 @@ lib: mpfobjs $(MODULES) $(OBJS)
$(AR) $(LIBDIR)/$(LIBNAME) $(MODULES) $(OBJS) $(MPFOBJS)
$(RANLIB) $(LIBDIR)/$(LIBNAME)
/bin/cp -p $(LIBMOD) ./parts.fh $(LIBDIR)
/bin/cp -p *$(.mod) $(LIBDIR)
mpfobjs:
base/modules/psb_check_mod.f90
+3 -3
View File
@@ -164,7 +164,7 @@ contains
9999 continue
call psb_erractionrestore(err_act)
if (err_act == act_abort) then
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
@@ -284,7 +284,7 @@ contains
9999 continue
call psb_erractionrestore(err_act)
if (err_act == act_abort) then
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
@@ -425,7 +425,7 @@ contains
9999 continue
call psb_erractionrestore(err_act)
if (err_act == act_abort) then
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
base/modules/psb_comm_mod.f90
+4 -4
View File
@@ -66,24 +66,24 @@ module psb_comm_mod
end interface
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
real(kind(1.d0)), intent(inout) :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
real(kind(1.d0)), intent(in), optional :: alpha
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
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
real(kind(1.d0)), intent(inout) :: x(:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
real(kind(1.d0)), intent(in), optional :: alpha
real(kind(1.d0)), target, optional :: work(:)
integer, intent(in), optional :: mode
integer, intent(in), optional :: mode,data
character, intent(in), optional :: tran
end subroutine psb_dhalov
subroutine psb_ihalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
base/modules/psb_const_mod.f90
-101
View File
@@ -30,106 +30,6 @@
!!$
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
!
@@ -142,6 +42,5 @@ module psb_const_mod
real(kind(1.d0)), parameter :: epstol=1.d-32
character, parameter :: psb_all_='A', psb_topdef_=' '
character(len=5) :: psb_fidef_='CSR'
end module psb_const_mod
base/modules/psb_desc_type.f90
+59 -2
View File
@@ -38,14 +38,71 @@
module psb_descriptor_type
use psb_const_mod
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.
type psb_desc_type
! contain decomposition informations
integer, allocatable :: matrix_data(:)
! contain index of halo elements to send/receive
integer, allocatable :: halo_index(:)
integer, allocatable :: halo_index(:), ext_index(:)
! contain indices of boundary elements
integer, allocatable :: bnd_elem(:)
! contain index of overlap elements to send/receive
@@ -265,7 +322,7 @@ contains
9999 continue
call psb_erractionrestore(err_act)
if (err_act == act_ret) then
if (err_act == psb_act_ret_) then
return
else
call psb_error(ictxt)
base/modules/psb_error_mod.f90
+4 -2
View File
@@ -30,7 +30,10 @@
!!$
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,&
& psb_get_errverbosity, psb_set_errverbosity,psb_errcomm, &
& psb_erractionsave, psb_erractionrestore, &
@@ -41,7 +44,6 @@ module psb_error_mod
module procedure psb_perror
end interface
!!$ integer, parameter :: act_ret=0, act_abort=1, no_err=0
private
base/modules/psb_realloc_mod.F90
+43 -25
View File
@@ -75,7 +75,8 @@ Contains
use psb_error_mod
! ...Subroutine Arguments
Integer,allocatable :: vin(:),vout(:)
Integer,allocatable,intent(in) :: vin(:)
Integer,allocatable,intent(out) :: vout(:)
integer :: info
! ...Local Variables
@@ -107,7 +108,7 @@ Contains
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then
if (err_act.eq.psb_act_ret_) then
return
else
call psb_error()
@@ -153,7 +154,7 @@ Contains
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then
if (err_act.eq.psb_act_ret_) then
return
else
call psb_error()
@@ -198,7 +199,7 @@ Contains
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then
if (err_act.eq.psb_act_ret_) then
return
else
call psb_error()
@@ -244,7 +245,7 @@ Contains
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then
if (err_act.eq.psb_act_ret_) then
return
else
call psb_error()
@@ -289,7 +290,7 @@ Contains
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then
if (err_act.eq.psb_act_ret_) then
return
else
call psb_error()
@@ -335,7 +336,7 @@ Contains
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then
if (err_act.eq.psb_act_ret_) then
return
else
call psb_error()
@@ -464,7 +465,7 @@ Contains
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then
if (err_act.eq.psb_act_ret_) then
return
else
call psb_error()
@@ -514,7 +515,7 @@ Contains
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then
if (err_act.eq.psb_act_ret_) then
return
else
call psb_error()
@@ -564,7 +565,7 @@ Contains
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then
if (err_act.eq.psb_act_ret_) then
return
else
call psb_error()
@@ -586,26 +587,31 @@ Contains
integer, optional, intent(in) :: lb
! ...Local Variables
Integer,allocatable :: tmp(:)
Integer :: dim, err_act, err,i,lb_
Integer :: dim, err_act, err,i,lb_
character(len=20) :: name
logical, parameter :: debug=.false.
name='psb_dreallocate1i'
name='psb_dreallocate1i'
call psb_erractionsave(err_act)
if(psb_get_errstatus().ne.0) return
info=0
if (debug) write(0,*) 'reallocate I',len
if (psb_get_errstatus().ne.0) return
info=0
if (present(lb)) then
lb_ = lb
else
lb_ = 1
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
dim=size(rrax)
If (dim /= len) Then
Allocate(tmp(lb_:len),stat=info)
Allocate(tmp(len),stat=info)
if (info /= 0) then
err=4000
call psb_errpush(err,name)
@@ -618,7 +624,7 @@ Contains
end if
else
dim = 0
allocate(rrax(lb_:len),stat=info)
allocate(rrax(len),stat=info)
if (info /= 0) then
err=4000
call psb_errpush(err,name)
@@ -635,7 +641,7 @@ Contains
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then
if (err_act.eq.psb_act_ret_) then
return
else
call psb_error()
@@ -672,6 +678,12 @@ Contains
else
lb_ = 1
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
dim=size(rrax)
@@ -707,7 +719,7 @@ Contains
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then
if (err_act.eq.psb_act_ret_) then
return
else
call psb_error()
@@ -736,6 +748,12 @@ Contains
call psb_erractionsave(err_act)
info = 0
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
dim=size(rrax)
@@ -771,7 +789,7 @@ Contains
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then
if (err_act.eq.psb_act_ret_) then
return
else
call psb_error()
@@ -837,7 +855,7 @@ Contains
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then
if (err_act.eq.psb_act_ret_) then
return
else
call psb_error()
@@ -902,7 +920,7 @@ Contains
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then
if (err_act.eq.psb_act_ret_) then
return
else
call psb_error()
@@ -966,7 +984,7 @@ Contains
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then
if (err_act.eq.psb_act_ret_) then
return
else
call psb_error()
@@ -1009,7 +1027,7 @@ Contains
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then
if (err_act.eq.psb_act_ret_) then
return
else
call psb_error()
@@ -1060,7 +1078,7 @@ Contains
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then
if (err_act.eq.psb_act_ret_) then
return
else
call psb_error()
@@ -1109,7 +1127,7 @@ Contains
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then
if (err_act.eq.psb_act_ret_) then
return
else
call psb_error()
base/modules/psb_spmat_type.f90
+48 -4
View File
@@ -32,13 +32,48 @@
!! Module to define D_SPMAT, structure !!
!! for sparse matrix. !!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
module psb_spmat_type
use psb_error_mod
use psb_realloc_mod
use psb_const_mod
implicit none
! Typedef: psb_dspmat_type
! 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
! Rows & columns
integer :: m, k
@@ -499,16 +534,25 @@ contains
logical, parameter :: debug=.false.
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)
if (debug) write(0,*) 'After realloc',nd,size(a%aspk),info
!!$ call flush(0)
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)
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)
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)
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)
if (info /= 0) return
@@ -1398,7 +1442,7 @@ contains
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
@@ -1553,7 +1597,7 @@ contains
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
base/modules/psb_tools_mod.f90
+491 -477
View File
File diff suppressed because it is too large Load Diff
base/modules/psi_mod.f90
+21 -4
View File
@@ -278,9 +278,10 @@ module psi_mod
end interface
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
type(psb_desc_type), intent(inout) :: desc
logical, intent(in) :: ext_hv
integer, intent(out) :: info
end subroutine psi_ldsc_pre_halo
end interface
@@ -344,7 +345,7 @@ module psi_mod
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_error_mod
@@ -354,7 +355,7 @@ contains
implicit none
! ....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
integer, intent(out) :: info
@@ -396,6 +397,22 @@ contains
cdesc%matrix_data(psb_thal_rcv_) = nrcv
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'
! then the overlap index
@@ -439,7 +456,7 @@ contains
9999 continue
call psb_erractionrestore(err_act)
if (err_act == act_abort) then
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
base/psblas/psb_damax.f90
+4 -4
View File
@@ -119,7 +119,7 @@ function psb_damax (x,desc_a, info, jx)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
@@ -240,7 +240,7 @@ function psb_damaxv (x,desc_a, info)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
@@ -363,7 +363,7 @@ subroutine psb_damaxvs (res,x,desc_a, info)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
@@ -490,7 +490,7 @@ subroutine psb_dmamaxs (res,x,desc_a, info,jx)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
base/psblas/psb_dasum.f90
+3 -3
View File
@@ -139,7 +139,7 @@ function psb_dasum (x,desc_a, info, jx)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
@@ -276,7 +276,7 @@ function psb_dasumv (x,desc_a, info)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
@@ -415,7 +415,7 @@ subroutine psb_dasumvs (res,x,desc_a, info)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
base/psblas/psb_daxpby.f90
+2 -2
View File
@@ -148,7 +148,7 @@ subroutine psb_daxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
@@ -275,7 +275,7 @@ subroutine psb_daxpbyv(alpha, x, beta,y,desc_a,info)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
base/psblas/psb_ddot.f90
+5 -5
View File
@@ -151,7 +151,7 @@ function psb_ddot(x, y,desc_a, info, jx, jy)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
@@ -289,7 +289,7 @@ function psb_ddotv(x, y,desc_a, info)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
@@ -425,7 +425,7 @@ subroutine psb_ddotvs(res, x, y,desc_a, info)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
@@ -577,7 +577,7 @@ subroutine psb_dmdots(res, x, y, desc_a, info)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
@@ -676,7 +676,7 @@ subroutine psb_ddot2v(res, x, y,w,z,desc_a, info)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
base/psblas/psb_dnrm2.f90
+3 -3
View File
@@ -132,7 +132,7 @@ function psb_dnrm2(x, desc_a, info, jx)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
@@ -265,7 +265,7 @@ function psb_dnrm2v(x, desc_a, info)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
@@ -399,7 +399,7 @@ subroutine psb_dnrm2vs(res, x, desc_a, info)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
base/psblas/psb_dnrmi.f90
+1 -1
View File
@@ -120,7 +120,7 @@ function psb_dnrmi(a,desc_a,info)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
base/psblas/psb_dspmm.f90
+2 -2
View File
@@ -352,7 +352,7 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
9999 continue
call psb_erractionrestore(err_act)
if (err_act == act_abort) then
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
@@ -667,7 +667,7 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,&
9999 continue
call psb_erractionrestore(err_act)
if (err_act == act_abort) then
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
base/psblas/psb_dspsm.f90
+2 -2
View File
@@ -309,7 +309,7 @@ subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,&
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
@@ -602,7 +602,7 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,&
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
base/psblas/psb_zamax.f90
+4 -4
View File
@@ -122,7 +122,7 @@ function psb_zamax (x,desc_a, info, jx)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
@@ -248,7 +248,7 @@ function psb_zamaxv (x,desc_a, info)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
@@ -375,7 +375,7 @@ subroutine psb_zamaxvs (res,x,desc_a, info)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
@@ -507,7 +507,7 @@ subroutine psb_zmamaxs (res,x,desc_a, info,jx)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
base/psblas/psb_zasum.f90
+3 -3
View File
@@ -144,7 +144,7 @@ function psb_zasum (x,desc_a, info, jx)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
@@ -287,7 +287,7 @@ function psb_zasumv (x,desc_a, info)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
@@ -431,7 +431,7 @@ subroutine psb_zasumvs (res,x,desc_a, info)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
base/psblas/psb_zaxpby.f90
+2 -2
View File
@@ -146,7 +146,7 @@ subroutine psb_zaxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
@@ -273,7 +273,7 @@ subroutine psb_zaxpbyv(alpha, x, beta,y,desc_a,info)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
base/psblas/psb_zdot.f90
+4 -4
View File
@@ -150,7 +150,7 @@ function psb_zdot(x, y,desc_a, info, jx, jy)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
@@ -288,7 +288,7 @@ function psb_zdotv(x, y,desc_a, info)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
@@ -423,7 +423,7 @@ subroutine psb_zdotvs(res, x, y,desc_a, info)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
@@ -576,7 +576,7 @@ subroutine psb_zmdots(res, x, y, desc_a, info)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
base/psblas/psb_znrm2.f90
+3 -3
View File
@@ -131,7 +131,7 @@ function psb_znrm2(x, desc_a, info, jx)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
@@ -264,7 +264,7 @@ function psb_znrm2v(x, desc_a, info)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
@@ -396,7 +396,7 @@ subroutine psb_znrm2vs(res, x, desc_a, info)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
base/psblas/psb_znrmi.f90
+1 -1
View File
@@ -120,7 +120,7 @@ function psb_znrmi(a,desc_a,info)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
base/psblas/psb_zspmm.f90
+2 -2
View File
@@ -346,7 +346,7 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
9999 continue
call psb_erractionrestore(err_act)
if (err_act == act_abort) then
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
@@ -644,7 +644,7 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,&
9999 continue
call psb_erractionrestore(err_act)
if (err_act == act_abort) then
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
base/psblas/psb_zspsm.f90
+2 -2
View File
@@ -312,7 +312,7 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,&
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
@@ -600,7 +600,7 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
base/serial/dp/dcoco.f
+1
View File
@@ -35,6 +35,7 @@ c
* lia2n,aux,laux,ierror)
use psb_const_mod
use psb_spmat_type
implicit none
c .. scalar arguments ..
base/serial/dp/dcocr.f
+1
View File
@@ -36,6 +36,7 @@ C
* LIAN2,AUX,LAUX,IERROR)
use psb_const_mod
use psb_spmat_type
IMPLICIT NONE
C
base/serial/dp/dcrco.f
+1
View File
@@ -33,6 +33,7 @@ C
* LIAN2,AUX,LAUX,IERROR)
use psb_const_mod
use psb_spmat_type
IMPLICIT NONE
C
base/serial/dp/dcrjd.f
+1
View File
@@ -60,6 +60,7 @@ C ARN,IAN1
C IAN2,INFON, IP1, IP2
C
use psb_const_mod
use psb_spmat_type
IMPLICIT NONE
C
base/serial/dp/dcsrp1.f
+1
View File
@@ -117,6 +117,7 @@ C
SUBROUTINE DCSRP1(TRANS,M,N,DESCRA,JA,IA,
+ P,WORK,IWORK,LWORK,IERROR)
use psb_const_mod
use psb_spmat_type
IMPLICIT NONE
C .. Scalar Arguments ..
INTEGER LWORK,M, N, IERROR
base/serial/dp/dgindex.f
+1
View File
@@ -32,6 +32,7 @@ C
+ LARN,LKA,LJA,IPERM,WORK, LWORK, SIZE_REQ, IERROR)
use psb_const_mod
use psb_spmat_type
IMPLICIT NONE
C ... Scalar arguments ...
base/serial/dp/gen_block.f
+1
View File
@@ -30,6 +30,7 @@ C
C
SUBROUTINE GEN_BLOCK(M,NG,IA,AUX)
use psb_const_mod
use psb_spmat_type
IMPLICIT NONE
INTEGER M, NG
base/serial/dp/partition.f
+1
View File
@@ -30,6 +30,7 @@ C
C
SUBROUTINE PARTITION(M, WORK, IA, N_BLOCK)
use psb_const_mod
use psb_spmat_type
IMPLICIT NONE
base/serial/dp/zcoco.f
+1
View File
@@ -35,6 +35,7 @@ c
* lia2n,aux,laux,ierror)
use psb_const_mod
use psb_spmat_type
implicit none
c .. scalar arguments ..
base/serial/dp/zcocr.f
+1
View File
@@ -36,6 +36,7 @@ C
* LIAN2,AUX,LAUX,IERROR)
use psb_const_mod
use psb_spmat_type
IMPLICIT NONE
C
base/serial/dp/zcrco.f
+1
View File
@@ -33,6 +33,7 @@ C
* LIAN2,AUX,LAUX,IERROR)
use psb_const_mod
use psb_spmat_type
IMPLICIT NONE
C
base/serial/dp/zcrjd.f
+1
View File
@@ -60,6 +60,7 @@ C ARN,IAN1
C IAN2,INFON, IP1, IP2
C
use psb_const_mod
use psb_spmat_type
IMPLICIT NONE
C
base/serial/dp/zgindex.f
+1
View File
@@ -32,6 +32,7 @@ C
+ LARN,LKA,LJA,IPERM,WORK, LWORK, SIZE_REQ, IERROR)
use psb_const_mod
use psb_spmat_type
IMPLICIT NONE
C ... Scalar arguments ...
base/serial/jad/djadnr.f
+1
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,
+ INFOA,IERROR)
use psb_const_mod
use psb_spmat_type
IMPLICIT NONE
C .. Scalar Arguments ..
INTEGER M,N, IERROR, NG
base/serial/psb_cest.f90
+1
View File
@@ -33,6 +33,7 @@ subroutine psb_cest(afmt, m,n,nnz, lia1, lia2, lar, iup, info)
use psb_error_mod
use psb_const_mod
use psb_string_mod
use psb_spmat_type
implicit none
! .. scalar arguments ..
base/serial/psb_dcoins.f90
+1 -1
View File
@@ -436,7 +436,7 @@ subroutine psb_dcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
base/serial/psb_dcsdp.f90
+3 -3
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,&
& ia1_size, ia2_size, aspk_size, upd_,info)
if (info /= no_err) then
if (info /= psb_no_err_) then
info=4010
ch_err='psb_cest'
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)
endif
if (info /= no_err) then
if (info /= psb_no_err_) then
info=4010
ch_err='psb_sp_reall'
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
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
base/serial/psb_dcsmm.f90
+1 -1
View File
@@ -104,7 +104,7 @@ subroutine psb_dcsmm(alpha,a,b,beta,c,info,trans)
9999 continue
call psb_erractionrestore(err_act)
if (err_act == act_abort) then
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
base/serial/psb_dcsmv.f90
+1 -1
View File
@@ -77,7 +77,7 @@ subroutine psb_dcsmv(alpha,a,b,beta,c,info,trans)
call psb_erractionrestore(err_act)
if(info.ne.0) then
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
base/serial/psb_dcsnmi.f90
+1 -1
View File
@@ -81,7 +81,7 @@ real(kind(1.d0)) function psb_dcsnmi(a,info,trans)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
base/serial/psb_dcsrws.f90
+1 -1
View File
@@ -94,7 +94,7 @@ subroutine psb_dcsrws(rw,a,info,trans)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
base/serial/psb_dcssm.f90
+1 -1
View File
@@ -88,7 +88,7 @@ subroutine psb_dcssm(alpha,t,b,beta,c,info,trans,unitd,d)
call psb_erractionrestore(err_act)
if(info.ne.0) then
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
base/serial/psb_dcssv.f90
+1 -1
View File
@@ -88,7 +88,7 @@ subroutine psb_dcssv(alpha,t,b,beta,c,info,trans,unitd,d)
call psb_erractionrestore(err_act)
if(info.ne.0) then
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
base/serial/psb_dipcoo2csc.f90
+1 -1
View File
@@ -186,7 +186,7 @@ subroutine psb_dipcoo2csc(a,info,clshr)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
base/serial/psb_dipcoo2csr.f90
+1 -1
View File
@@ -189,7 +189,7 @@ subroutine psb_dipcoo2csr(a,info,rwshr)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
base/serial/psb_dipcsr2coo.f90
+1 -1
View File
@@ -91,7 +91,7 @@ Subroutine psb_dipcsr2coo(a,info)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
base/serial/psb_dneigh.f90
+1 -1
View File
@@ -91,7 +91,7 @@ subroutine psb_dneigh(a,idx,neigh,n,info,lev)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
base/serial/psb_drwextd.f90
+1 -1
View File
@@ -105,7 +105,7 @@ subroutine psb_drwextd(nr,a,info,b)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
base/serial/psb_dspgetrow.f90
+1 -1
View File
@@ -151,7 +151,7 @@ subroutine psb_dspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
base/serial/psb_dspgtblk.f90
+1 -1
View File
@@ -116,7 +116,7 @@ subroutine psb_dspgtblk(irw,a,b,info,append,iren,lrw)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
base/serial/psb_dspgtdiag.f90
+1 -1
View File
@@ -127,7 +127,7 @@ subroutine psb_dspgtdiag(a,d,info)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
base/serial/psb_dspscal.f90
+1 -1
View File
@@ -88,7 +88,7 @@ subroutine psb_dspscal(a,d,info)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
base/serial/psb_dsymbmm.f90
+1 -1
View File
@@ -125,7 +125,7 @@ subroutine psb_dsymbmm(a,b,c,info)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
base/serial/psb_zcoins.f90
+1 -1
View File
@@ -436,7 +436,7 @@ subroutine psb_zcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
base/serial/psb_zcsdp.f90
+3 -3
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,&
& ia1_size, ia2_size, aspk_size, upd_,info)
if (info /= no_err) then
if (info /= psb_no_err_) then
info=4010
ch_err='psb_cest'
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)
endif
if (info /= no_err) then
if (info /= psb_no_err_) then
info=4010
ch_err='psb_sp_reall'
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
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
base/serial/psb_zcsmm.f90
+1 -1
View File
@@ -77,7 +77,7 @@ subroutine psb_zcsmm(alpha,a,b,beta,c,info,trans)
call psb_erractionrestore(err_act)
if(info.ne.0) then
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
base/serial/psb_zcsmv.f90
+1 -1
View File
@@ -77,7 +77,7 @@ subroutine psb_zcsmv(alpha,a,b,beta,c,info,trans)
call psb_erractionrestore(err_act)
if(info.ne.0) then
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
base/serial/psb_zcsnmi.f90
+1 -1
View File
@@ -81,7 +81,7 @@ real(kind(1.d0)) function psb_zcsnmi(a,info,trans)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
base/serial/psb_zcsrws.f90
+1 -1
View File
@@ -94,7 +94,7 @@ subroutine psb_zcsrws(rw,a,info,trans)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
base/serial/psb_zcssm.f90
+1 -1
View File
@@ -88,7 +88,7 @@ subroutine psb_zcssm(alpha,t,b,beta,c,info,trans,unitd,d)
call psb_erractionrestore(err_act)
if(info.ne.0) then
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
base/serial/psb_zcssv.f90
+1 -1
View File
@@ -88,7 +88,7 @@ subroutine psb_zcssv(alpha,t,b,beta,c,info,trans,unitd,d)
call psb_erractionrestore(err_act)
if(info.ne.0) then
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
base/serial/psb_zipcoo2csc.f90
+1 -1
View File
@@ -187,7 +187,7 @@ subroutine psb_zipcoo2csc(a,info,clshr)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
base/serial/psb_zipcoo2csr.f90
+1 -1
View File
@@ -189,7 +189,7 @@ subroutine psb_zipcoo2csr(a,info,rwshr)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
base/serial/psb_zipcsr2coo.f90
+1 -1
View File
@@ -91,7 +91,7 @@ Subroutine psb_zipcsr2coo(a,info)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if

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