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

psblas2-dev:

Browse Source 
base/internals/psi_dswapdata.F90


Merged fixes from ulbe testing.
This commit is contained in:
Salvatore Filippone
2008-04-01 08:36:46 +00:00
parent 405ba72bdb
commit 76b01051f3
1 changed files with 6 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/internals/psi_dswapdata.F90
+6 -11
View File
@@ -187,7 +187,6 @@ subroutine psi_dswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
& albf,do_send,do_recv
logical, parameter :: usersend=.false.
real(psb_dpk_), allocatable, target :: buffer(:)
real(psb_dpk_), pointer, dimension(:) :: sndbuf, rcvbuf
#ifdef HAVE_VOLATILE
volatile :: sndbuf, rcvbuf
@@ -268,10 +267,7 @@ subroutine psi_dswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
rcvbuf => work(totsnd_+1:totsnd_+totrcv_)
albf=.false.
else
allocate(buffer(totsnd_+totrcv_), stat=info)
sndbuf => buffer(1:totsnd_)
rcvbuf => buffer(totsnd_+1:totsnd_+totrcv_)
allocate(sndbuf(totsnd_),rcvbuf(totrcv_), stat=info)
if(info /= 0) then
call psb_errpush(4000,name)
goto 9999
@@ -507,12 +503,11 @@ subroutine psi_dswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
call psb_errpush(4000,name)
goto 9999
end if
!!$ if(albf) deallocate(sndbuf,rcvbuf,stat=info)
!!$ if(info /= 0) then
!!$ call psb_errpush(4000,name)
!!$ goto 9999
!!$ end if
if(albf) deallocate(sndbuf,rcvbuf,stat=info)
if(info /= 0) then
call psb_errpush(4000,name)
goto 9999
end if
call psb_erractionrestore(err_act)
return