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

psblas2-dev:

Browse Source 
base/internals/psi_dswapdata.F90
 base/psblas/psb_dspmm.f90
 base/psblas/psb_zspmm.f90
 base/tools/psb_cd_inloc.f90
 base/tools/psb_cdals.f90
 base/tools/psb_cdalv.f90


Merged fixes from ulbe testing.
This commit is contained in:
Salvatore Filippone
2008-04-01 08:35:24 +00:00
parent 75ab90328d
commit 405ba72bdb
6 changed files with 38 additions and 12 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/internals/psi_dswapdata.F90
+11 -6
View File
@@ -187,6 +187,7 @@ 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
@@ -267,7 +268,10 @@ subroutine psi_dswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
rcvbuf => work(totsnd_+1:totsnd_+totrcv_)
albf=.false.
else
allocate(sndbuf(totsnd_),rcvbuf(totrcv_), stat=info)
allocate(buffer(totsnd_+totrcv_), stat=info)
sndbuf => buffer(1:totsnd_)
rcvbuf => buffer(totsnd_+1:totsnd_+totrcv_)
if(info /= 0) then
call psb_errpush(4000,name)
goto 9999
@@ -503,11 +507,12 @@ 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
base/psblas/psb_dspmm.f90
+11 -3
View File
@@ -94,7 +94,7 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
& i, ib, ib1, ip, idx
integer, parameter :: nb=4
real(psb_dpk_), pointer :: xp(:,:), yp(:,:), iwork(:)
real(psb_dpk_), allocatable :: xvsave(:,:)
real(psb_dpk_), allocatable :: xvsave(:,:)
character :: trans_
character(len=20) :: name, ch_err
logical :: aliw, doswap_
@@ -256,7 +256,7 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
if(info /= 0) exit blk
if((ib1 > 0).and.(doswap_))&
& call psi_swapdata(psb_swap_send_,ib1,&
& call psi_swapdata(psb_swap_recv_,ib1,&
& dzero,xp,desc_a,iwork,info)
if(info /= 0) exit blk
@@ -339,7 +339,15 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
end if
if (aliw) deallocate(iwork)
if (aliw) deallocate(iwork,stat=info)
if (debug_level >= psb_debug_comp_) &
& write(debug_unit,*) me,' ',trim(name),' deallocat ',aliw, info
if(info /= 0) then
info = 4010
ch_err='Deallocate iwork'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
nullify(iwork)
call psb_erractionrestore(err_act)
base/psblas/psb_zspmm.f90
+10 -2
View File
@@ -256,7 +256,7 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
if(info /= 0) exit blk
if((ib1 > 0).and.(doswap_))&
& call psi_swapdata(psb_swap_send_,ib1,&
& call psi_swapdata(psb_swap_recv_,ib1,&
& zzero,xp,desc_a,iwork,info)
if(info /= 0) exit blk
@@ -340,7 +340,15 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
end if
if (aliw) deallocate(iwork)
if (aliw) deallocate(iwork,stat=info)
if (debug_level >= psb_debug_comp_) &
& write(debug_unit,*) me,' ',trim(name),' deallocat ',aliw, info
if(info /= 0) then
info = 4010
ch_err='Deallocate iwork'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
nullify(iwork)
call psb_erractionrestore(err_act)
base/tools/psb_cd_inloc.f90
+2
View File
@@ -170,10 +170,12 @@ subroutine psb_cd_inloc(v, ictxt, desc, info)
if (psb_cd_choose_large_state(ictxt,m)) then
allocate(desc%matrix_data(psb_mdata_size_),&
&temp_ovrlap(m),stat=info)
desc%matrix_data(:) = 0
desc%matrix_data(psb_desc_size_) = psb_desc_large_
else
allocate(desc%glob_to_loc(m),desc%matrix_data(psb_mdata_size_),&
&temp_ovrlap(m),stat=info)
desc%matrix_data(:) = 0
desc%matrix_data(psb_desc_size_) = psb_desc_normal_
end if
if (info /= 0) then
base/tools/psb_cdals.f90
+2
View File
@@ -130,10 +130,12 @@ subroutine psb_cdals(m, n, parts, ictxt, desc, info)
if (psb_cd_choose_large_state(ictxt,m)) then
allocate(desc%matrix_data(psb_mdata_size_),&
& temp_ovrlap(m),prc_v(np),stat=info)
desc%matrix_data(:) = 0
desc%matrix_data(psb_desc_size_) = psb_desc_large_
else
allocate(desc%glob_to_loc(m),desc%matrix_data(psb_mdata_size_),&
& temp_ovrlap(m),prc_v(np),stat=info)
desc%matrix_data(:) = 0
desc%matrix_data(psb_desc_size_) = psb_desc_normal_
end if
if (info /= 0) then
base/tools/psb_cdalv.f90
+2 -1
View File
@@ -141,10 +141,12 @@ subroutine psb_cdalv(v, ictxt, desc, info, flag)
if (psb_cd_choose_large_state(ictxt,m)) then
allocate(desc%matrix_data(psb_mdata_size_),&
&temp_ovrlap(m),stat=info)
desc%matrix_data(:) = 0
desc%matrix_data(psb_desc_size_) = psb_desc_large_
else
allocate(desc%glob_to_loc(m),desc%matrix_data(psb_mdata_size_),&
&temp_ovrlap(m),stat=info)
desc%matrix_data(:) = 0
desc%matrix_data(psb_desc_size_) = psb_desc_normal_
end if
if (info /= 0) then
@@ -153,7 +155,6 @@ subroutine psb_cdalv(v, ictxt, desc, info, flag)
call psb_errpush(info,name,i_err=int_err,a_err='integer')
goto 9999
endif
desc%matrix_data(psb_m_) = m
desc%matrix_data(psb_n_) = n
! This has to be set BEFORE any call to SET_BLD