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

Fixed distribution bug when using parts subroutine.

Browse Source
pull/1/head
Salvatore Filippone 8 years ago
parent 98200cf9c2
commit 49ff9472ac
4 changed files with 20 additions and 24 deletions
Show Stats Download Patch File Download Diff File

11
util/psb_c_mat_dist_impl.f90
Unescape Escape View File

@ -91,7 +91,7 @@ subroutine psb_cmatdist(a_glob, a, ictxt, desc_a,&
integer(psb_ipk_) :: i_count, j_count,& integer(psb_ipk_) :: i_count, j_count,&
& k_count, root, liwork, nrow, ncol, nnzero, nrhs,& & k_count, root, liwork, nrow, ncol, nnzero, nrhs,&
& i, ll, nz, isize, iproc, nnr, err, err_act, int_err(5) & 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(:) integer(psb_ipk_), allocatable :: irow(:),icol(:)
complex(psb_spk_), allocatable :: val(:) complex(psb_spk_), allocatable :: val(:)
integer(psb_ipk_), parameter :: nb=30 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,nnzero, root)
call psb_bcast(ictxt,nrhs, root) call psb_bcast(ictxt,nrhs, root)
liwork = max(np, nrow + ncol) liwork = max(np, nrow + ncol)
allocate(iwork(liwork), stat = info) allocate(iwork(liwork), iwrk2(np),stat = info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
int_err(1)=liwork int_err(1)=liwork
@ -198,9 +198,9 @@ subroutine psb_cmatdist(a_glob, a, ictxt, desc_a,&
j_count = j_count + 1 j_count = j_count + 1
if (j_count-i_count >= nb) exit if (j_count-i_count >= nb) exit
if (j_count > nrow) 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 (np_sharing /= 1 ) exit
if (iwork(1) /= iproc ) exit if (iwrk2(1) /= iproc ) exit
end do end do
end if end if
else 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 if(info /= psb_success_)then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
ch_err='deallocate' ch_err='deallocate'
@ -329,7 +329,6 @@ subroutine psb_cmatdist(a_glob, a, ictxt, desc_a,&
goto 9999 goto 9999
end if end if
deallocate(iwork)
if (iam == root) write (*, fmt = *) 'end matdist' if (iam == root) write (*, fmt = *) 'end matdist'
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)

11
util/psb_d_mat_dist_impl.f90
Unescape Escape View File

@ -91,7 +91,7 @@ subroutine psb_dmatdist(a_glob, a, ictxt, desc_a,&
integer(psb_ipk_) :: i_count, j_count,& integer(psb_ipk_) :: i_count, j_count,&
& k_count, root, liwork, nrow, ncol, nnzero, nrhs,& & k_count, root, liwork, nrow, ncol, nnzero, nrhs,&
& i, ll, nz, isize, iproc, nnr, err, err_act, int_err(5) & 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(:) integer(psb_ipk_), allocatable :: irow(:),icol(:)
real(psb_dpk_), allocatable :: val(:) real(psb_dpk_), allocatable :: val(:)
integer(psb_ipk_), parameter :: nb=30 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,nnzero, root)
call psb_bcast(ictxt,nrhs, root) call psb_bcast(ictxt,nrhs, root)
liwork = max(np, nrow + ncol) liwork = max(np, nrow + ncol)
allocate(iwork(liwork), stat = info) allocate(iwork(liwork), iwrk2(np),stat = info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
int_err(1)=liwork int_err(1)=liwork
@ -198,9 +198,9 @@ subroutine psb_dmatdist(a_glob, a, ictxt, desc_a,&
j_count = j_count + 1 j_count = j_count + 1
if (j_count-i_count >= nb) exit if (j_count-i_count >= nb) exit
if (j_count > nrow) 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 (np_sharing /= 1 ) exit
if (iwork(1) /= iproc ) exit if (iwrk2(1) /= iproc ) exit
end do end do
end if end if
else 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 if(info /= psb_success_)then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
ch_err='deallocate' ch_err='deallocate'
@ -329,7 +329,6 @@ subroutine psb_dmatdist(a_glob, a, ictxt, desc_a,&
goto 9999 goto 9999
end if end if
deallocate(iwork)
if (iam == root) write (*, fmt = *) 'end matdist' if (iam == root) write (*, fmt = *) 'end matdist'
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)

11
util/psb_s_mat_dist_impl.f90
Unescape Escape View File

@ -91,7 +91,7 @@ subroutine psb_smatdist(a_glob, a, ictxt, desc_a,&
integer(psb_ipk_) :: i_count, j_count,& integer(psb_ipk_) :: i_count, j_count,&
& k_count, root, liwork, nrow, ncol, nnzero, nrhs,& & k_count, root, liwork, nrow, ncol, nnzero, nrhs,&
& i, ll, nz, isize, iproc, nnr, err, err_act, int_err(5) & 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(:) integer(psb_ipk_), allocatable :: irow(:),icol(:)
real(psb_spk_), allocatable :: val(:) real(psb_spk_), allocatable :: val(:)
integer(psb_ipk_), parameter :: nb=30 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,nnzero, root)
call psb_bcast(ictxt,nrhs, root) call psb_bcast(ictxt,nrhs, root)
liwork = max(np, nrow + ncol) liwork = max(np, nrow + ncol)
allocate(iwork(liwork), stat = info) allocate(iwork(liwork), iwrk2(np),stat = info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
int_err(1)=liwork int_err(1)=liwork
@ -198,9 +198,9 @@ subroutine psb_smatdist(a_glob, a, ictxt, desc_a,&
j_count = j_count + 1 j_count = j_count + 1
if (j_count-i_count >= nb) exit if (j_count-i_count >= nb) exit
if (j_count > nrow) 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 (np_sharing /= 1 ) exit
if (iwork(1) /= iproc ) exit if (iwrk2(1) /= iproc ) exit
end do end do
end if end if
else 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 if(info /= psb_success_)then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
ch_err='deallocate' ch_err='deallocate'
@ -329,7 +329,6 @@ subroutine psb_smatdist(a_glob, a, ictxt, desc_a,&
goto 9999 goto 9999
end if end if
deallocate(iwork)
if (iam == root) write (*, fmt = *) 'end matdist' if (iam == root) write (*, fmt = *) 'end matdist'
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)

11
util/psb_z_mat_dist_impl.f90
Unescape Escape View File

@ -91,7 +91,7 @@ subroutine psb_zmatdist(a_glob, a, ictxt, desc_a,&
integer(psb_ipk_) :: i_count, j_count,& integer(psb_ipk_) :: i_count, j_count,&
& k_count, root, liwork, nrow, ncol, nnzero, nrhs,& & k_count, root, liwork, nrow, ncol, nnzero, nrhs,&
& i, ll, nz, isize, iproc, nnr, err, err_act, int_err(5) & 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(:) integer(psb_ipk_), allocatable :: irow(:),icol(:)
complex(psb_dpk_), allocatable :: val(:) complex(psb_dpk_), allocatable :: val(:)
integer(psb_ipk_), parameter :: nb=30 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,nnzero, root)
call psb_bcast(ictxt,nrhs, root) call psb_bcast(ictxt,nrhs, root)
liwork = max(np, nrow + ncol) liwork = max(np, nrow + ncol)
allocate(iwork(liwork), stat = info) allocate(iwork(liwork), iwrk2(np),stat = info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
int_err(1)=liwork int_err(1)=liwork
@ -198,9 +198,9 @@ subroutine psb_zmatdist(a_glob, a, ictxt, desc_a,&
j_count = j_count + 1 j_count = j_count + 1
if (j_count-i_count >= nb) exit if (j_count-i_count >= nb) exit
if (j_count > nrow) 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 (np_sharing /= 1 ) exit
if (iwork(1) /= iproc ) exit if (iwrk2(1) /= iproc ) exit
end do end do
end if end if
else 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 if(info /= psb_success_)then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
ch_err='deallocate' ch_err='deallocate'
@ -329,7 +329,6 @@ subroutine psb_zmatdist(a_glob, a, ictxt, desc_a,&
goto 9999 goto 9999
end if end if
deallocate(iwork)
if (iam == root) write (*, fmt = *) 'end matdist' if (iam == root) write (*, fmt = *) 'end matdist'
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)

Write Preview
Loading…
Cancel
Save