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

Fixed distribution bug when using parts subroutine.

Browse Source
This commit is contained in:
Salvatore Filippone
2017-07-20 11:52:46 +01:00
parent 98200cf9c2
commit 49ff9472ac
4 changed files with 20 additions and 24 deletions
Download Patch File Download Diff File Expand all files Collapse all files
util/psb_c_mat_dist_impl.f90
+5 -6
View File
@@ -91,7 +91,7 @@ subroutine psb_cmatdist(a_glob, a, ictxt, desc_a,&
integer(psb_ipk_) :: i_count, j_count,&
& k_count, root, liwork, nrow, ncol, nnzero, nrhs,&
& i, ll, nz, isize, iproc, nnr, err, err_act, int_err(5)
integer(psb_ipk_), allocatable :: iwork(:)
integer(psb_ipk_), allocatable :: iwork(:), iwrk2(:)
integer(psb_ipk_), allocatable :: irow(:),icol(:)
complex(psb_spk_), allocatable :: val(:)
integer(psb_ipk_), parameter :: nb=30
@@ -137,7 +137,7 @@ subroutine psb_cmatdist(a_glob, a, ictxt, desc_a,&
call psb_bcast(ictxt,nnzero, root)
call psb_bcast(ictxt,nrhs, root)
liwork = max(np, nrow + ncol)
allocate(iwork(liwork), stat = info)
allocate(iwork(liwork), iwrk2(np),stat = info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
int_err(1)=liwork
@@ -198,9 +198,9 @@ subroutine psb_cmatdist(a_glob, a, ictxt, desc_a,&
j_count = j_count + 1
if (j_count-i_count >= nb) exit
if (j_count > nrow) exit
call parts(j_count,nrow,np,iwork, np_sharing)
call parts(j_count,nrow,np,iwrk2, np_sharing)
if (np_sharing /= 1 ) exit
if (iwork(1) /= iproc ) exit
if (iwrk2(1) /= iproc ) exit
end do
end if
else
@@ -321,7 +321,7 @@ subroutine psb_cmatdist(a_glob, a, ictxt, desc_a,&
deallocate(val,irow,icol,stat=info)
deallocate(val,irow,icol,iwork,iwrk2,stat=info)
if(info /= psb_success_)then
info=psb_err_from_subroutine_
ch_err='deallocate'
@@ -329,7 +329,6 @@ subroutine psb_cmatdist(a_glob, a, ictxt, desc_a,&
goto 9999
end if
deallocate(iwork)
if (iam == root) write (*, fmt = *) 'end matdist'
call psb_erractionrestore(err_act)
util/psb_d_mat_dist_impl.f90
+5 -6
View File
@@ -91,7 +91,7 @@ subroutine psb_dmatdist(a_glob, a, ictxt, desc_a,&
integer(psb_ipk_) :: i_count, j_count,&
& k_count, root, liwork, nrow, ncol, nnzero, nrhs,&
& i, ll, nz, isize, iproc, nnr, err, err_act, int_err(5)
integer(psb_ipk_), allocatable :: iwork(:)
integer(psb_ipk_), allocatable :: iwork(:), iwrk2(:)
integer(psb_ipk_), allocatable :: irow(:),icol(:)
real(psb_dpk_), allocatable :: val(:)
integer(psb_ipk_), parameter :: nb=30
@@ -137,7 +137,7 @@ subroutine psb_dmatdist(a_glob, a, ictxt, desc_a,&
call psb_bcast(ictxt,nnzero, root)
call psb_bcast(ictxt,nrhs, root)
liwork = max(np, nrow + ncol)
allocate(iwork(liwork), stat = info)
allocate(iwork(liwork), iwrk2(np),stat = info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
int_err(1)=liwork
@@ -198,9 +198,9 @@ subroutine psb_dmatdist(a_glob, a, ictxt, desc_a,&
j_count = j_count + 1
if (j_count-i_count >= nb) exit
if (j_count > nrow) exit
call parts(j_count,nrow,np,iwork, np_sharing)
call parts(j_count,nrow,np,iwrk2, np_sharing)
if (np_sharing /= 1 ) exit
if (iwork(1) /= iproc ) exit
if (iwrk2(1) /= iproc ) exit
end do
end if
else
@@ -321,7 +321,7 @@ subroutine psb_dmatdist(a_glob, a, ictxt, desc_a,&
deallocate(val,irow,icol,stat=info)
deallocate(val,irow,icol,iwork,iwrk2,stat=info)
if(info /= psb_success_)then
info=psb_err_from_subroutine_
ch_err='deallocate'
@@ -329,7 +329,6 @@ subroutine psb_dmatdist(a_glob, a, ictxt, desc_a,&
goto 9999
end if
deallocate(iwork)
if (iam == root) write (*, fmt = *) 'end matdist'
call psb_erractionrestore(err_act)
util/psb_s_mat_dist_impl.f90
+5 -6
View File
@@ -91,7 +91,7 @@ subroutine psb_smatdist(a_glob, a, ictxt, desc_a,&
integer(psb_ipk_) :: i_count, j_count,&
& k_count, root, liwork, nrow, ncol, nnzero, nrhs,&
& i, ll, nz, isize, iproc, nnr, err, err_act, int_err(5)
integer(psb_ipk_), allocatable :: iwork(:)
integer(psb_ipk_), allocatable :: iwork(:), iwrk2(:)
integer(psb_ipk_), allocatable :: irow(:),icol(:)
real(psb_spk_), allocatable :: val(:)
integer(psb_ipk_), parameter :: nb=30
@@ -137,7 +137,7 @@ subroutine psb_smatdist(a_glob, a, ictxt, desc_a,&
call psb_bcast(ictxt,nnzero, root)
call psb_bcast(ictxt,nrhs, root)
liwork = max(np, nrow + ncol)
allocate(iwork(liwork), stat = info)
allocate(iwork(liwork), iwrk2(np),stat = info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
int_err(1)=liwork
@@ -198,9 +198,9 @@ subroutine psb_smatdist(a_glob, a, ictxt, desc_a,&
j_count = j_count + 1
if (j_count-i_count >= nb) exit
if (j_count > nrow) exit
call parts(j_count,nrow,np,iwork, np_sharing)
call parts(j_count,nrow,np,iwrk2, np_sharing)
if (np_sharing /= 1 ) exit
if (iwork(1) /= iproc ) exit
if (iwrk2(1) /= iproc ) exit
end do
end if
else
@@ -321,7 +321,7 @@ subroutine psb_smatdist(a_glob, a, ictxt, desc_a,&
deallocate(val,irow,icol,stat=info)
deallocate(val,irow,icol,iwork,iwrk2,stat=info)
if(info /= psb_success_)then
info=psb_err_from_subroutine_
ch_err='deallocate'
@@ -329,7 +329,6 @@ subroutine psb_smatdist(a_glob, a, ictxt, desc_a,&
goto 9999
end if
deallocate(iwork)
if (iam == root) write (*, fmt = *) 'end matdist'
call psb_erractionrestore(err_act)
util/psb_z_mat_dist_impl.f90
+5 -6
View File
@@ -91,7 +91,7 @@ subroutine psb_zmatdist(a_glob, a, ictxt, desc_a,&
integer(psb_ipk_) :: i_count, j_count,&
& k_count, root, liwork, nrow, ncol, nnzero, nrhs,&
& i, ll, nz, isize, iproc, nnr, err, err_act, int_err(5)
integer(psb_ipk_), allocatable :: iwork(:)
integer(psb_ipk_), allocatable :: iwork(:), iwrk2(:)
integer(psb_ipk_), allocatable :: irow(:),icol(:)
complex(psb_dpk_), allocatable :: val(:)
integer(psb_ipk_), parameter :: nb=30
@@ -137,7 +137,7 @@ subroutine psb_zmatdist(a_glob, a, ictxt, desc_a,&
call psb_bcast(ictxt,nnzero, root)
call psb_bcast(ictxt,nrhs, root)
liwork = max(np, nrow + ncol)
allocate(iwork(liwork), stat = info)
allocate(iwork(liwork), iwrk2(np),stat = info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
int_err(1)=liwork
@@ -198,9 +198,9 @@ subroutine psb_zmatdist(a_glob, a, ictxt, desc_a,&
j_count = j_count + 1
if (j_count-i_count >= nb) exit
if (j_count > nrow) exit
call parts(j_count,nrow,np,iwork, np_sharing)
call parts(j_count,nrow,np,iwrk2, np_sharing)
if (np_sharing /= 1 ) exit
if (iwork(1) /= iproc ) exit
if (iwrk2(1) /= iproc ) exit
end do
end if
else
@@ -321,7 +321,7 @@ subroutine psb_zmatdist(a_glob, a, ictxt, desc_a,&
deallocate(val,irow,icol,stat=info)
deallocate(val,irow,icol,iwork,iwrk2,stat=info)
if(info /= psb_success_)then
info=psb_err_from_subroutine_
ch_err='deallocate'
@@ -329,7 +329,6 @@ subroutine psb_zmatdist(a_glob, a, ictxt, desc_a,&
goto 9999
end if
deallocate(iwork)
if (iam == root) write (*, fmt = *) 'end matdist'
call psb_erractionrestore(err_act)