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

fix bug due missed deallocation in psi_swap

Browse Source
This commit is contained in:
Alfredo Buttari
2005-12-06 14:15:32 +00:00
parent b76b6bb0e0
commit c3b199021d
4 changed files with 96 additions and 8 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/internals/psi_dswapdata.f90
+24 -2
View File
@@ -23,7 +23,7 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
integer, pointer, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, ptp, rvhd, d_idx
integer :: int_err(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv
logical :: swap_mpi, swap_sync, swap_send, swap_recv, all
real(kind(1.d0)), pointer, dimension(:) :: sndbuf, rcvbuf
character(len=20) :: name, ch_err
@@ -140,12 +140,14 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
if((idxr+idxs).lt.size(work)) then
sndbuf => work(1:idxs)
rcvbuf => work(idxs+1:idxs+idxr)
all=.false.
else
allocate(sndbuf(idxs),rcvbuf(idxr), stat=info)
if(info.ne.0) then
call psb_errpush(4000,name)
goto 9999
end if
all=.true.
end if
! Case SWAP_MPI
@@ -437,6 +439,15 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
end if
deallocate(sdsz,rvsz,bsdidx,&
& brvidx,rvhd,prcid,&
& ptp,stat=info)
if(all) deallocate(sndbuf,rcvbuf,stat=info)
if(info.ne.0) then
call psb_errpush(4000,name)
goto 9999
end if
call psb_erractionrestore(err_act)
return
@@ -476,7 +487,7 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
& sdsz, rvsz, prcid, ptp, rvhd, d_idx
integer :: blacs_pnum, krecvid, ksendid
integer :: int_err(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv
logical :: swap_mpi, swap_sync, swap_send, swap_recv,all
real(kind(1.d0)), pointer, dimension(:) :: sndbuf, rcvbuf
character(len=20) :: name, ch_err
@@ -595,12 +606,14 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
if((idxr+idxs).lt.size(work)) then
sndbuf => work(1:idxs)
rcvbuf => work(idxs+1:idxs+idxr)
all=.false.
else
allocate(sndbuf(idxs),rcvbuf(idxr), stat=info)
if(info.ne.0) then
call psb_errpush(4000,name)
goto 9999
end if
all=.true.
end if
! Case SWAP_MPI
@@ -891,6 +904,15 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
end if
deallocate(sdsz,rvsz,bsdidx,&
& brvidx,rvhd,prcid,&
& ptp,stat=info)
if(all) deallocate(sndbuf,rcvbuf,stat=info)
if(info.ne.0) then
call psb_errpush(4000,name)
goto 9999
end if
call psb_erractionrestore(err_act)
return
src/internals/psi_dswaptran.f90
+24 -2
View File
@@ -24,7 +24,7 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
& sdsz, rvsz, prcid, ptp, rvhd, d_idx
integer :: int_err(5)
integer :: blacs_pnum, krecvid, ksendid
logical :: swap_mpi, swap_sync, swap_send, swap_recv
logical :: swap_mpi, swap_sync, swap_send, swap_recv, all
integer, pointer, dimension(:) :: sndbuf, rcvbuf
character(len=20) :: name, ch_err
@@ -141,12 +141,14 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
if((idxr+idxs).lt.size(work)) then
sndbuf => work(1:idxs)
rcvbuf => work(idxs+1:idxs+idxr)
all=.false.
else
allocate(sndbuf(idxs),rcvbuf(idxr), stat=info)
if(info.ne.0) then
call psb_errpush(4000,name)
goto 9999
end if
all=.true.
end if
! Case SWAP_MPI
@@ -437,6 +439,15 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
end if
deallocate(sdsz,rvsz,bsdidx,&
& brvidx,rvhd,prcid,&
& ptp,stat=info)
if(all) deallocate(sndbuf,rcvbuf,stat=info)
if(info.ne.0) then
call psb_errpush(4000,name)
goto 9999
end if
call psb_erractionrestore(err_act)
return
@@ -481,7 +492,7 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
& sdsz, rvsz, prcid, ptp, rvhd, d_idx
integer :: int_err(5)
integer :: blacs_pnum, krecvid, ksendid
logical :: swap_mpi, swap_sync, swap_send, swap_recv
logical :: swap_mpi, swap_sync, swap_send, swap_recv, all
integer, pointer, dimension(:) :: sndbuf, rcvbuf
character(len=20) :: name, ch_err
@@ -599,12 +610,14 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
if((idxr+idxs).lt.size(work)) then
sndbuf => work(1:idxs)
rcvbuf => work(idxs+1:idxs+idxr)
all=.false.
else
allocate(sndbuf(idxs),rcvbuf(idxr), stat=info)
if(info.ne.0) then
call psb_errpush(4000,name)
goto 9999
end if
all=.true.
end if
! Case SWAP_MPI
@@ -895,6 +908,15 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
end if
deallocate(sdsz,rvsz,bsdidx,&
& brvidx,rvhd,prcid,&
& ptp,stat=info)
if(all) deallocate(sndbuf,rcvbuf,stat=info)
if(info.ne.0) then
call psb_errpush(4000,name)
goto 9999
end if
call psb_erractionrestore(err_act)
return
src/internals/psi_iswapdata.f90
+24 -2
View File
@@ -23,7 +23,7 @@ subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data)
integer, pointer, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, ptp, rvhd, d_idx
integer :: int_err(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv
logical :: swap_mpi, swap_sync, swap_send, swap_recv, all
integer, pointer, dimension(:) :: sndbuf, rcvbuf
character(len=20) :: name, ch_err
@@ -140,12 +140,14 @@ subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data)
if((idxr+idxs).lt.size(work)) then
sndbuf => work(1:idxs)
rcvbuf => work(idxs+1:idxs+idxr)
all=.false.
else
allocate(sndbuf(idxs),rcvbuf(idxr), stat=info)
if(info.ne.0) then
call psb_errpush(4000,name)
goto 9999
end if
all=.true.
end if
! Case SWAP_MPI
@@ -437,6 +439,15 @@ subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data)
end if
deallocate(sdsz,rvsz,bsdidx,&
& brvidx,rvhd,prcid,&
& ptp,stat=info)
if(all) deallocate(sndbuf,rcvbuf,stat=info)
if(info.ne.0) then
call psb_errpush(4000,name)
goto 9999
end if
call psb_erractionrestore(err_act)
return
@@ -476,7 +487,7 @@ subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data)
& sdsz, rvsz, prcid, ptp, rvhd, d_idx
integer :: blacs_pnum, krecvid, ksendid
integer :: int_err(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv
logical :: swap_mpi, swap_sync, swap_send, swap_recv, all
integer, pointer, dimension(:) :: sndbuf, rcvbuf
character(len=20) :: name, ch_err
@@ -595,12 +606,14 @@ subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data)
if((idxr+idxs).lt.size(work)) then
sndbuf => work(1:idxs)
rcvbuf => work(idxs+1:idxs+idxr)
all=.false.
else
allocate(sndbuf(idxs),rcvbuf(idxr), stat=info)
if(info.ne.0) then
call psb_errpush(4000,name)
goto 9999
end if
all=.true.
end if
! Case SWAP_MPI
@@ -891,6 +904,15 @@ subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data)
end if
deallocate(sdsz,rvsz,bsdidx,&
& brvidx,rvhd,prcid,&
& ptp,stat=info)
if(all) deallocate(sndbuf,rcvbuf,stat=info)
if(info.ne.0) then
call psb_errpush(4000,name)
goto 9999
end if
call psb_erractionrestore(err_act)
return
src/internals/psi_iswaptran.f90
+24 -2
View File
@@ -24,7 +24,7 @@ subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data)
& sdsz, rvsz, prcid, ptp, rvhd, d_idx
integer :: int_err(5)
integer :: blacs_pnum, krecvid, ksendid
logical :: swap_mpi, swap_sync, swap_send, swap_recv
logical :: swap_mpi, swap_sync, swap_send, swap_recv, all
integer, pointer, dimension(:) :: sndbuf, rcvbuf
character(len=20) :: name, ch_err
@@ -141,12 +141,14 @@ subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data)
if((idxr+idxs).lt.size(work)) then
sndbuf => work(1:idxs)
rcvbuf => work(idxs+1:idxs+idxr)
all=.false.
else
allocate(sndbuf(idxs),rcvbuf(idxr), stat=info)
if(info.ne.0) then
call psb_errpush(4000,name)
goto 9999
end if
all=.true.
end if
! Case SWAP_MPI
@@ -437,6 +439,15 @@ subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data)
end if
deallocate(sdsz,rvsz,bsdidx,&
& brvidx,rvhd,prcid,&
& ptp,stat=info)
if(all) deallocate(sndbuf,rcvbuf,stat=info)
if(info.ne.0) then
call psb_errpush(4000,name)
goto 9999
end if
call psb_erractionrestore(err_act)
return
@@ -481,7 +492,7 @@ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data)
& sdsz, rvsz, prcid, ptp, rvhd, d_idx
integer :: int_err(5)
integer :: blacs_pnum, krecvid, ksendid
logical :: swap_mpi, swap_sync, swap_send, swap_recv
logical :: swap_mpi, swap_sync, swap_send, swap_recv, all
integer, pointer, dimension(:) :: sndbuf, rcvbuf
character(len=20) :: name, ch_err
@@ -599,12 +610,14 @@ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data)
if((idxr+idxs).lt.size(work)) then
sndbuf => work(1:idxs)
rcvbuf => work(idxs+1:idxs+idxr)
all=.false.
else
allocate(sndbuf(idxs),rcvbuf(idxr), stat=info)
if(info.ne.0) then
call psb_errpush(4000,name)
goto 9999
end if
all=.true.
end if
! Case SWAP_MPI
@@ -895,6 +908,15 @@ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data)
end if
deallocate(sdsz,rvsz,bsdidx,&
& brvidx,rvhd,prcid,&
& ptp,stat=info)
if(all) deallocate(sndbuf,rcvbuf,stat=info)
if(info.ne.0) then
call psb_errpush(4000,name)
goto 9999
end if
call psb_erractionrestore(err_act)
return