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

fix bug due missed deallocation in psi_swap

Browse Source
psblas3-type-indexed
Alfredo Buttari 19 years ago
parent b76b6bb0e0
commit c3b199021d
4 changed files with 96 additions and 8 deletions
Show Stats Download Patch File Download Diff File

26
src/internals/psi_dswapdata.f90
Unescape Escape View File

@ -23,7 +23,7 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
integer, pointer, dimension(:) :: bsdidx, brvidx,& integer, pointer, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, ptp, rvhd, d_idx & sdsz, rvsz, prcid, ptp, rvhd, d_idx
integer :: int_err(5) 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 real(kind(1.d0)), pointer, dimension(:) :: sndbuf, rcvbuf
character(len=20) :: name, ch_err 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 if((idxr+idxs).lt.size(work)) then
sndbuf => work(1:idxs) sndbuf => work(1:idxs)
rcvbuf => work(idxs+1:idxs+idxr) rcvbuf => work(idxs+1:idxs+idxr)
all=.false.
else else
allocate(sndbuf(idxs),rcvbuf(idxr), stat=info) allocate(sndbuf(idxs),rcvbuf(idxr), stat=info)
if(info.ne.0) then if(info.ne.0) then
call psb_errpush(4000,name) call psb_errpush(4000,name)
goto 9999 goto 9999
end if end if
all=.true.
end if end if
! Case SWAP_MPI ! Case SWAP_MPI
@ -437,6 +439,15 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
end if 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) call psb_erractionrestore(err_act)
return return
@ -476,7 +487,7 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
& sdsz, rvsz, prcid, ptp, rvhd, d_idx & sdsz, rvsz, prcid, ptp, rvhd, d_idx
integer :: blacs_pnum, krecvid, ksendid integer :: blacs_pnum, krecvid, ksendid
integer :: int_err(5) 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 real(kind(1.d0)), pointer, dimension(:) :: sndbuf, rcvbuf
character(len=20) :: name, ch_err 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 if((idxr+idxs).lt.size(work)) then
sndbuf => work(1:idxs) sndbuf => work(1:idxs)
rcvbuf => work(idxs+1:idxs+idxr) rcvbuf => work(idxs+1:idxs+idxr)
all=.false.
else else
allocate(sndbuf(idxs),rcvbuf(idxr), stat=info) allocate(sndbuf(idxs),rcvbuf(idxr), stat=info)
if(info.ne.0) then if(info.ne.0) then
call psb_errpush(4000,name) call psb_errpush(4000,name)
goto 9999 goto 9999
end if end if
all=.true.
end if end if
! Case SWAP_MPI ! Case SWAP_MPI
@ -891,6 +904,15 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
end if 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) call psb_erractionrestore(err_act)
return return

26
src/internals/psi_dswaptran.f90
Unescape Escape 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 & sdsz, rvsz, prcid, ptp, rvhd, d_idx
integer :: int_err(5) integer :: int_err(5)
integer :: blacs_pnum, krecvid, ksendid 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 integer, pointer, dimension(:) :: sndbuf, rcvbuf
character(len=20) :: name, ch_err 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 if((idxr+idxs).lt.size(work)) then
sndbuf => work(1:idxs) sndbuf => work(1:idxs)
rcvbuf => work(idxs+1:idxs+idxr) rcvbuf => work(idxs+1:idxs+idxr)
all=.false.
else else
allocate(sndbuf(idxs),rcvbuf(idxr), stat=info) allocate(sndbuf(idxs),rcvbuf(idxr), stat=info)
if(info.ne.0) then if(info.ne.0) then
call psb_errpush(4000,name) call psb_errpush(4000,name)
goto 9999 goto 9999
end if end if
all=.true.
end if end if
! Case SWAP_MPI ! Case SWAP_MPI
@ -437,6 +439,15 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
end if 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) call psb_erractionrestore(err_act)
return return
@ -481,7 +492,7 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
& sdsz, rvsz, prcid, ptp, rvhd, d_idx & sdsz, rvsz, prcid, ptp, rvhd, d_idx
integer :: int_err(5) integer :: int_err(5)
integer :: blacs_pnum, krecvid, ksendid 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 integer, pointer, dimension(:) :: sndbuf, rcvbuf
character(len=20) :: name, ch_err 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 if((idxr+idxs).lt.size(work)) then
sndbuf => work(1:idxs) sndbuf => work(1:idxs)
rcvbuf => work(idxs+1:idxs+idxr) rcvbuf => work(idxs+1:idxs+idxr)
all=.false.
else else
allocate(sndbuf(idxs),rcvbuf(idxr), stat=info) allocate(sndbuf(idxs),rcvbuf(idxr), stat=info)
if(info.ne.0) then if(info.ne.0) then
call psb_errpush(4000,name) call psb_errpush(4000,name)
goto 9999 goto 9999
end if end if
all=.true.
end if end if
! Case SWAP_MPI ! Case SWAP_MPI
@ -895,6 +908,15 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
end if 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) call psb_erractionrestore(err_act)
return return

26
src/internals/psi_iswapdata.f90
Unescape Escape View File

@ -23,7 +23,7 @@ subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data)
integer, pointer, dimension(:) :: bsdidx, brvidx,& integer, pointer, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, ptp, rvhd, d_idx & sdsz, rvsz, prcid, ptp, rvhd, d_idx
integer :: int_err(5) 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 integer, pointer, dimension(:) :: sndbuf, rcvbuf
character(len=20) :: name, ch_err 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 if((idxr+idxs).lt.size(work)) then
sndbuf => work(1:idxs) sndbuf => work(1:idxs)
rcvbuf => work(idxs+1:idxs+idxr) rcvbuf => work(idxs+1:idxs+idxr)
all=.false.
else else
allocate(sndbuf(idxs),rcvbuf(idxr), stat=info) allocate(sndbuf(idxs),rcvbuf(idxr), stat=info)
if(info.ne.0) then if(info.ne.0) then
call psb_errpush(4000,name) call psb_errpush(4000,name)
goto 9999 goto 9999
end if end if
all=.true.
end if end if
! Case SWAP_MPI ! Case SWAP_MPI
@ -437,6 +439,15 @@ subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data)
end if 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) call psb_erractionrestore(err_act)
return return
@ -476,7 +487,7 @@ subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data)
& sdsz, rvsz, prcid, ptp, rvhd, d_idx & sdsz, rvsz, prcid, ptp, rvhd, d_idx
integer :: blacs_pnum, krecvid, ksendid integer :: blacs_pnum, krecvid, ksendid
integer :: int_err(5) 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 integer, pointer, dimension(:) :: sndbuf, rcvbuf
character(len=20) :: name, ch_err 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 if((idxr+idxs).lt.size(work)) then
sndbuf => work(1:idxs) sndbuf => work(1:idxs)
rcvbuf => work(idxs+1:idxs+idxr) rcvbuf => work(idxs+1:idxs+idxr)
all=.false.
else else
allocate(sndbuf(idxs),rcvbuf(idxr), stat=info) allocate(sndbuf(idxs),rcvbuf(idxr), stat=info)
if(info.ne.0) then if(info.ne.0) then
call psb_errpush(4000,name) call psb_errpush(4000,name)
goto 9999 goto 9999
end if end if
all=.true.
end if end if
! Case SWAP_MPI ! Case SWAP_MPI
@ -891,6 +904,15 @@ subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data)
end if 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) call psb_erractionrestore(err_act)
return return

26
src/internals/psi_iswaptran.f90
Unescape Escape 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 & sdsz, rvsz, prcid, ptp, rvhd, d_idx
integer :: int_err(5) integer :: int_err(5)
integer :: blacs_pnum, krecvid, ksendid 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 integer, pointer, dimension(:) :: sndbuf, rcvbuf
character(len=20) :: name, ch_err 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 if((idxr+idxs).lt.size(work)) then
sndbuf => work(1:idxs) sndbuf => work(1:idxs)
rcvbuf => work(idxs+1:idxs+idxr) rcvbuf => work(idxs+1:idxs+idxr)
all=.false.
else else
allocate(sndbuf(idxs),rcvbuf(idxr), stat=info) allocate(sndbuf(idxs),rcvbuf(idxr), stat=info)
if(info.ne.0) then if(info.ne.0) then
call psb_errpush(4000,name) call psb_errpush(4000,name)
goto 9999 goto 9999
end if end if
all=.true.
end if end if
! Case SWAP_MPI ! Case SWAP_MPI
@ -437,6 +439,15 @@ subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data)
end if 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) call psb_erractionrestore(err_act)
return return
@ -481,7 +492,7 @@ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data)
& sdsz, rvsz, prcid, ptp, rvhd, d_idx & sdsz, rvsz, prcid, ptp, rvhd, d_idx
integer :: int_err(5) integer :: int_err(5)
integer :: blacs_pnum, krecvid, ksendid 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 integer, pointer, dimension(:) :: sndbuf, rcvbuf
character(len=20) :: name, ch_err 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 if((idxr+idxs).lt.size(work)) then
sndbuf => work(1:idxs) sndbuf => work(1:idxs)
rcvbuf => work(idxs+1:idxs+idxr) rcvbuf => work(idxs+1:idxs+idxr)
all=.false.
else else
allocate(sndbuf(idxs),rcvbuf(idxr), stat=info) allocate(sndbuf(idxs),rcvbuf(idxr), stat=info)
if(info.ne.0) then if(info.ne.0) then
call psb_errpush(4000,name) call psb_errpush(4000,name)
goto 9999 goto 9999
end if end if
all=.true.
end if end if
! Case SWAP_MPI ! Case SWAP_MPI
@ -895,6 +908,15 @@ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data)
end if 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) call psb_erractionrestore(err_act)
return return

Write Preview
Loading…
Cancel
Save