fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
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.
psblas3-pattern
Salvatore Filippone 9 years ago
parent 4aa07deff5
commit 285d5ff296
5 changed files with 35 additions and 30 deletions
Show Stats Download Patch File Download Diff File

13
base/comm/psb_cscatter.F90
Unescape Escape 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'

13
base/comm/psb_dscatter.F90
Unescape Escape 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'

13
base/comm/psb_iscatter.F90
Unescape Escape 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'

13
base/comm/psb_sscatter.F90
Unescape Escape 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'

13
base/comm/psb_zscatter.F90
Unescape Escape 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'

Write Preview
Loading…
Cancel
Save