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

psblas3

Browse Source 
base/comm/psb_cscatter.F90
 base/comm/psb_dscatter.F90
 base/comm/psb_iscatter.F90
 base/comm/psb_sscatter.F90
 base/comm/psb_zscatter.F90

Fixed checks.
This commit is contained in:
Salvatore Filippone
2016-05-27 08:38:07 +00:00
parent 4aa07deff5
commit 285d5ff296
5 changed files with 35 additions and 30 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/comm/psb_cscatter.F90
+7 -6
View File
@@ -114,8 +114,6 @@ subroutine psb_cscatterm(globx, locx, desc_a, info, root)
k = size(globx,2)
lda_globx = size(globx, 1)
end if
call psb_bcast(ictxt,k,root=iroot)
call psb_bcast(ictxt,lda_globx,root=iroot)
end if
m = desc_a%get_global_rows()
@@ -123,7 +121,8 @@ subroutine psb_cscatterm(globx, locx, desc_a, info, root)
! there should be a global check on k here!!!
call psb_chkglobvect(m,n,lda_globx,iglobx,jglobx,desc_a,info)
if ((iroot==-1).or.(iam==iroot)) &
& call psb_chkglobvect(m,n,lda_globx,iglobx,jglobx,desc_a,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chk(glob)vect'
@@ -343,16 +342,18 @@ subroutine psb_cscatterv(globx, locx, desc_a, info, root)
jglobx = 1
ilocx = 1
jlocx = 1
lda_globx = size(globx, 1)
if (iroot /= -1) call psb_bcast(ictxt,lda_globx,root=iroot)
if ((iroot==-1).or.(iam==iroot))&
& lda_globx = size(globx, 1)
m = desc_a%get_global_rows()
n = desc_a%get_global_cols()
k = 1
! there should be a global check on k here!!!
if ((iroot==-1).or.(iam==iroot)) &
& call psb_chkglobvect(m,n,lda_globx,iglobx,jglobx,desc_a,info)
call psb_chkglobvect(m,n,lda_globx,iglobx,jglobx,desc_a,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chk(glob)vect'
base/comm/psb_dscatter.F90
+7 -6
View File
@@ -114,8 +114,6 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, root)
k = size(globx,2)
lda_globx = size(globx, 1)
end if
call psb_bcast(ictxt,k,root=iroot)
call psb_bcast(ictxt,lda_globx,root=iroot)
end if
m = desc_a%get_global_rows()
@@ -123,7 +121,8 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, root)
! there should be a global check on k here!!!
call psb_chkglobvect(m,n,lda_globx,iglobx,jglobx,desc_a,info)
if ((iroot==-1).or.(iam==iroot)) &
& call psb_chkglobvect(m,n,lda_globx,iglobx,jglobx,desc_a,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chk(glob)vect'
@@ -343,16 +342,18 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, root)
jglobx = 1
ilocx = 1
jlocx = 1
lda_globx = size(globx, 1)
if (iroot /= -1) call psb_bcast(ictxt,lda_globx,root=iroot)
if ((iroot==-1).or.(iam==iroot))&
& lda_globx = size(globx, 1)
m = desc_a%get_global_rows()
n = desc_a%get_global_cols()
k = 1
! there should be a global check on k here!!!
if ((iroot==-1).or.(iam==iroot)) &
& call psb_chkglobvect(m,n,lda_globx,iglobx,jglobx,desc_a,info)
call psb_chkglobvect(m,n,lda_globx,iglobx,jglobx,desc_a,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chk(glob)vect'
base/comm/psb_iscatter.F90
+7 -6
View File
@@ -114,8 +114,6 @@ subroutine psb_iscatterm(globx, locx, desc_a, info, root)
k = size(globx,2)
lda_globx = size(globx, 1)
end if
call psb_bcast(ictxt,k,root=iroot)
call psb_bcast(ictxt,lda_globx,root=iroot)
end if
m = desc_a%get_global_rows()
@@ -123,7 +121,8 @@ subroutine psb_iscatterm(globx, locx, desc_a, info, root)
! there should be a global check on k here!!!
call psb_chkglobvect(m,n,lda_globx,iglobx,jglobx,desc_a,info)
if ((iroot==-1).or.(iam==iroot)) &
& call psb_chkglobvect(m,n,lda_globx,iglobx,jglobx,desc_a,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chk(glob)vect'
@@ -343,16 +342,18 @@ subroutine psb_iscatterv(globx, locx, desc_a, info, root)
jglobx = 1
ilocx = 1
jlocx = 1
lda_globx = size(globx, 1)
if (iroot /= -1) call psb_bcast(ictxt,lda_globx,root=iroot)
if ((iroot==-1).or.(iam==iroot))&
& lda_globx = size(globx, 1)
m = desc_a%get_global_rows()
n = desc_a%get_global_cols()
k = 1
! there should be a global check on k here!!!
if ((iroot==-1).or.(iam==iroot)) &
& call psb_chkglobvect(m,n,lda_globx,iglobx,jglobx,desc_a,info)
call psb_chkglobvect(m,n,lda_globx,iglobx,jglobx,desc_a,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chk(glob)vect'
base/comm/psb_sscatter.F90
+7 -6
View File
@@ -114,8 +114,6 @@ subroutine psb_sscatterm(globx, locx, desc_a, info, root)
k = size(globx,2)
lda_globx = size(globx, 1)
end if
call psb_bcast(ictxt,k,root=iroot)
call psb_bcast(ictxt,lda_globx,root=iroot)
end if
m = desc_a%get_global_rows()
@@ -123,7 +121,8 @@ subroutine psb_sscatterm(globx, locx, desc_a, info, root)
! there should be a global check on k here!!!
call psb_chkglobvect(m,n,lda_globx,iglobx,jglobx,desc_a,info)
if ((iroot==-1).or.(iam==iroot)) &
& call psb_chkglobvect(m,n,lda_globx,iglobx,jglobx,desc_a,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chk(glob)vect'
@@ -343,16 +342,18 @@ subroutine psb_sscatterv(globx, locx, desc_a, info, root)
jglobx = 1
ilocx = 1
jlocx = 1
lda_globx = size(globx, 1)
if (iroot /= -1) call psb_bcast(ictxt,lda_globx,root=iroot)
if ((iroot==-1).or.(iam==iroot))&
& lda_globx = size(globx, 1)
m = desc_a%get_global_rows()
n = desc_a%get_global_cols()
k = 1
! there should be a global check on k here!!!
if ((iroot==-1).or.(iam==iroot)) &
& call psb_chkglobvect(m,n,lda_globx,iglobx,jglobx,desc_a,info)
call psb_chkglobvect(m,n,lda_globx,iglobx,jglobx,desc_a,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chk(glob)vect'
base/comm/psb_zscatter.F90
+7 -6
View File
@@ -114,8 +114,6 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, root)
k = size(globx,2)
lda_globx = size(globx, 1)
end if
call psb_bcast(ictxt,k,root=iroot)
call psb_bcast(ictxt,lda_globx,root=iroot)
end if
m = desc_a%get_global_rows()
@@ -123,7 +121,8 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, root)
! there should be a global check on k here!!!
call psb_chkglobvect(m,n,lda_globx,iglobx,jglobx,desc_a,info)
if ((iroot==-1).or.(iam==iroot)) &
& call psb_chkglobvect(m,n,lda_globx,iglobx,jglobx,desc_a,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chk(glob)vect'
@@ -343,16 +342,18 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, root)
jglobx = 1
ilocx = 1
jlocx = 1
lda_globx = size(globx, 1)
if (iroot /= -1) call psb_bcast(ictxt,lda_globx,root=iroot)
if ((iroot==-1).or.(iam==iroot))&
& lda_globx = size(globx, 1)
m = desc_a%get_global_rows()
n = desc_a%get_global_cols()
k = 1
! there should be a global check on k here!!!
if ((iroot==-1).or.(iam==iroot)) &
& call psb_chkglobvect(m,n,lda_globx,iglobx,jglobx,desc_a,info)
call psb_chkglobvect(m,n,lda_globx,iglobx,jglobx,desc_a,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chk(glob)vect'