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

Added getters functions for entries in matrix_data and for sparse

Browse Source 
matrix info.
psblas3-type-indexed
Salvatore Filippone 19 years ago
parent 3194d18d83
commit 3093612a31
109 changed files with 1067 additions and 1403 deletions
Show Stats Download Patch File Download Diff File

24
src/comm/psb_dgather.f90
Unescape Escape View File

@ -77,7 +77,7 @@ subroutine psb_dgatherm(globx, locx, desc_a, info, iroot,&
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
! check on blacs grid
call psb_info(ictxt, me, np)
@ -131,8 +131,8 @@ subroutine psb_dgatherm(globx, locx, desc_a, info, iroot,&
lda_globx = size(globx,1)
lda_locx = size(locx, 1)
m = desc_a%matrix_data(psb_m_)
n = desc_a%matrix_data(psb_n_)
m = psb_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a)
lock=size(locx,2)-jlocx+1
globk=size(globx,2)-jglobx+1
@ -152,8 +152,8 @@ subroutine psb_dgatherm(globx, locx, desc_a, info, iroot,&
! there should be a global check on k here!!!
call psb_chkglobvect(m,n,size(globx,1),iglobx,jglobx,desc_a%matrix_data,info)
call psb_chkvect(m,n,size(locx,1),ilocx,jlocx,desc_a%matrix_data,info,ilx,jlx)
call psb_chkglobvect(m,n,size(globx,1),iglobx,jglobx,desc_a,info)
call psb_chkvect(m,n,size(locx,1),ilocx,jlocx,desc_a,info,ilx,jlx)
if(info.ne.0) then
info=4010
ch_err='psb_chk(glob)vect'
@ -170,7 +170,7 @@ subroutine psb_dgatherm(globx, locx, desc_a, info, iroot,&
globx(:,:)=0.d0
do j=1,k
do i=1,desc_a%matrix_data(psb_n_row_)
do i=1,psb_get_local_rows(desc_a)
idx = desc_a%loc_to_glob(i)
globx(idx,jglobx+j-1) = locx(i,jlx+j-1)
end do
@ -280,7 +280,7 @@ subroutine psb_dgatherv(globx, locx, desc_a, info, iroot,&
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
! check on blacs grid
call psb_info(ictxt, me, np)
@ -319,16 +319,16 @@ subroutine psb_dgatherv(globx, locx, desc_a, info, iroot,&
lda_globx = size(globx)
lda_locx = size(locx)
m = desc_a%matrix_data(psb_m_)
n = desc_a%matrix_data(psb_n_)
m = psb_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a)
k = 1
! there should be a global check on k here!!!
call psb_chkglobvect(m,n,size(globx),iglobx,jglobx,desc_a%matrix_data,info)
call psb_chkvect(m,n,size(locx),ilocx,jlocx,desc_a%matrix_data,info,ilx,jlx)
call psb_chkglobvect(m,n,size(globx),iglobx,jglobx,desc_a,info)
call psb_chkvect(m,n,size(locx),ilocx,jlocx,desc_a,info,ilx,jlx)
if(info.ne.0) then
info=4010
ch_err='psb_chk(glob)vect'
@ -344,7 +344,7 @@ subroutine psb_dgatherv(globx, locx, desc_a, info, iroot,&
globx(:)=0.d0
do i=1,desc_a%matrix_data(psb_n_row_)
do i=1,psb_get_local_rows(desc_a)
idx = desc_a%loc_to_glob(i)
globx(idx) = locx(i)
end do

20
src/comm/psb_dhalo.f90
Unescape Escape View File

@ -77,7 +77,7 @@ subroutine psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
! check on blacs grid
call psb_info(ictxt, me, np)
@ -94,9 +94,9 @@ subroutine psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
ijx = 1
endif
m = desc_a%matrix_data(psb_m_)
n = desc_a%matrix_data(psb_n_)
nrow = desc_a%matrix_data(psb_n_row_)
m = psb_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a)
nrow = psb_get_local_rows(desc_a)
maxk=size(x,2)-ijx+1
@ -122,7 +122,7 @@ subroutine psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
endif
! check vector correctness
call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@ -289,7 +289,7 @@ subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode)
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
! check on blacs grid
call psb_info(ictxt, me, np)
@ -302,9 +302,9 @@ subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode)
ix = 1
ijx = 1
m = desc_a%matrix_data(psb_m_)
n = desc_a%matrix_data(psb_n_)
nrow = desc_a%matrix_data(psb_n_row_)
m = psb_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a)
nrow = psb_get_local_rows(desc_a)
if (present(tran)) then
ltran = tran
@ -318,7 +318,7 @@ subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode)
endif
! check vector correctness
call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'

24
src/comm/psb_dovrl.f90
Unescape Escape View File

@ -73,7 +73,7 @@ subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,update)
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
! check on blacs grid
call psb_info(ictxt, me, np)
@ -90,10 +90,10 @@ subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,update)
ijx = 1
endif
m = desc_a%matrix_data(psb_m_)
n = desc_a%matrix_data(psb_n_)
nrow = desc_a%matrix_data(psb_n_row_)
ncol = desc_a%matrix_data(psb_n_col_)
m = psb_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a)
nrow = psb_get_local_rows(desc_a)
ncol = psb_get_local_cols(desc_a)
maxk=size(x,2)-ijx+1
@ -117,7 +117,7 @@ subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,update)
imode = IOR(psb_swap_send_,psb_swap_recv_)
! check vector correctness
call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@ -291,7 +291,7 @@ subroutine psb_dovrlv(x,desc_a,info,work,update)
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
! check on blacs grid
call psb_info(ictxt, me, np)
@ -304,10 +304,10 @@ subroutine psb_dovrlv(x,desc_a,info,work,update)
ix = 1
ijx = 1
m = desc_a%matrix_data(psb_m_)
n = desc_a%matrix_data(psb_n_)
nrow = desc_a%matrix_data(psb_n_row_)
ncol = desc_a%matrix_data(psb_n_col_)
m = psb_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a)
nrow = psb_get_local_rows(desc_a)
ncol = psb_get_local_cols(desc_a)
k = 1
@ -321,7 +321,7 @@ subroutine psb_dovrlv(x,desc_a,info,work,update)
imode = IOR(psb_swap_send_,psb_swap_recv_)
! check vector correctness
call psb_chkvect(m,1,size(x),ix,ijx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,1,size(x),ix,ijx,desc_a,info,iix,jjx)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'

29
src/comm/psb_dscatter.f90
Unescape Escape View File

@ -79,7 +79,7 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, iroot,&
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
! check on blacs grid
call psb_info(ictxt, me, np)
@ -131,8 +131,8 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, iroot,&
lda_globx = size(globx,1)
lda_locx = size(locx, 1)
m = desc_a%matrix_data(psb_m_)
n = desc_a%matrix_data(psb_n_)
m = psb_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a)
lock=size(locx,2)-jlocx+1
globk=size(globx,2)-jglobx+1
@ -155,8 +155,8 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, iroot,&
lda_globx = size(globx)
lda_locx = size(locx)
m = desc_a%matrix_data(psb_m_)
n = desc_a%matrix_data(psb_n_)
m = psb_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a)
if (me == iiroot) then
call igebs2d(ictxt, 'all', ' ', 1, 1, k, 1)
@ -166,8 +166,8 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, iroot,&
! there should be a global check on k here!!!
call psb_chkglobvect(m,n,size(globx),iglobx,jglobx,desc_a%matrix_data,info)
call psb_chkvect(m,n,size(locx),ilocx,jlocx,desc_a%matrix_data,info,ilx,jlx)
call psb_chkglobvect(m,n,size(globx),iglobx,jglobx,desc_a,info)
if (info == 0) call psb_chkvect(m,n,size(locx),ilocx,jlocx,desc_a,info,ilx,jlx)
if(info /= 0) then
info=4010
ch_err='psb_chk(glob)vect'
@ -181,7 +181,7 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, iroot,&
goto 9999
end if
nrow=desc_a%matrix_data(psb_n_row_)
nrow=psb_get_local_rows(desc_a)
if(root == -1) then
! extract my chunk
@ -336,7 +336,7 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, iroot)
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
! check on blacs grid
call psb_info(ictxt, me, np)
@ -364,8 +364,8 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, iroot)
lda_globx = size(globx)
lda_locx = size(locx)
m = desc_a%matrix_data(psb_m_)
n = desc_a%matrix_data(psb_n_)
m = psb_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a)
k = 1
@ -377,8 +377,9 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, iroot)
! there should be a global check on k here!!!
call psb_chkglobvect(m,n,size(globx),iglobx,jglobx,desc_a%matrix_data,info)
call psb_chkvect(m,n,size(locx),ilocx,jlocx,desc_a%matrix_data,info,ilx,jlx)
call psb_chkglobvect(m,n,size(globx),iglobx,jglobx,desc_a,info)
if (info == 0) &
& call psb_chkvect(m,n,size(locx),ilocx,jlocx,desc_a,info,ilx,jlx)
if(info /= 0) then
info=4010
ch_err='psb_chk(glob)vect'
@ -392,7 +393,7 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, iroot)
goto 9999
end if
nrow=desc_a%matrix_data(psb_n_row_)
nrow=psb_get_local_rows(desc_a)
if(root == -1) then
! extract my chunk

22
src/comm/psb_ihalo.f90
Unescape Escape View File

@ -78,7 +78,7 @@ subroutine psb_ihalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
! check on blacs grid
call psb_info(ictxt, me, np)
@ -95,9 +95,9 @@ subroutine psb_ihalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
ijx = 1
endif
m = desc_a%matrix_data(psb_m_)
n = desc_a%matrix_data(psb_n_)
nrow = desc_a%matrix_data(psb_n_row_)
m = psb_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a)
nrow = psb_get_local_rows(desc_a)
maxk=size(x,2)-ijx+1
@ -123,7 +123,7 @@ subroutine psb_ihalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
endif
! check vector correctness
call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@ -285,7 +285,7 @@ subroutine psb_ihalov(x,desc_a,info,alpha,work,tran,mode)
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
! check on blacs grid
call psb_info(ictxt, me, np)
@ -298,10 +298,10 @@ subroutine psb_ihalov(x,desc_a,info,alpha,work,tran,mode)
ix = 1
ijx = 1
m = desc_a%matrix_data(psb_m_)
n = desc_a%matrix_data(psb_n_)
nrow = desc_a%matrix_data(psb_n_row_)
! ncol = desc_a%matrix_data(psb_n_col_)
m = psb_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a)
nrow = psb_get_local_rows(desc_a)
! ncol = psb_get_local_cols(desc_a)
if (present(tran)) then
@ -316,7 +316,7 @@ subroutine psb_ihalov(x,desc_a,info,alpha,work,tran,mode)
endif
! check vector correctness
call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'

26
src/comm/psb_zgather.f90
Unescape Escape View File

@ -78,7 +78,7 @@ subroutine psb_zgatherm(globx, locx, desc_a, info, iroot,&
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
! check on blacs grid
call psb_info(ictxt, me, np)
@ -132,8 +132,8 @@ subroutine psb_zgatherm(globx, locx, desc_a, info, iroot,&
lda_globx = size(globx,1)
lda_locx = size(locx, 1)
m = desc_a%matrix_data(psb_m_)
n = desc_a%matrix_data(psb_n_)
m = psb_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a)
lock=size(locx,2)-jlocx+1
globk=size(globx,2)-jglobx+1
@ -153,8 +153,9 @@ subroutine psb_zgatherm(globx, locx, desc_a, info, iroot,&
! there should be a global check on k here!!!
call psb_chkglobvect(m,n,size(globx,1),iglobx,jglobx,desc_a%matrix_data,info)
call psb_chkvect(m,n,size(locx,1),ilocx,jlocx,desc_a%matrix_data,info,ilx,jlx)
call psb_chkglobvect(m,n,size(globx,1),iglobx,jglobx,desc_a,info)
if (info == 0) &
& call psb_chkvect(m,n,size(locx,1),ilocx,jlocx,desc_a,info,ilx,jlx)
if(info.ne.0) then
info=4010
ch_err='psb_chk(glob)vect'
@ -171,7 +172,7 @@ subroutine psb_zgatherm(globx, locx, desc_a, info, iroot,&
globx(:,:)=0.d0
do j=1,k
do i=1,desc_a%matrix_data(psb_n_row_)
do i=1,psb_get_local_rows(desc_a)
idx = desc_a%loc_to_glob(i)
globx(idx,jglobx+j-1) = locx(i,jlx+j-1)
end do
@ -281,7 +282,7 @@ subroutine psb_zgatherv(globx, locx, desc_a, info, iroot,&
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
! check on blacs grid
call psb_info(ictxt, me, np)
@ -320,16 +321,17 @@ subroutine psb_zgatherv(globx, locx, desc_a, info, iroot,&
lda_globx = size(globx)
lda_locx = size(locx)
m = desc_a%matrix_data(psb_m_)
n = desc_a%matrix_data(psb_n_)
m = psb_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a)
k = 1
! there should be a global check on k here!!!
call psb_chkglobvect(m,n,size(globx),iglobx,jglobx,desc_a%matrix_data,info)
call psb_chkvect(m,n,size(locx),ilocx,jlocx,desc_a%matrix_data,info,ilx,jlx)
call psb_chkglobvect(m,n,size(globx),iglobx,jglobx,desc_a,info)
if (info == 0) &
& call psb_chkvect(m,n,size(locx),ilocx,jlocx,desc_a,info,ilx,jlx)
if(info.ne.0) then
info=4010
ch_err='psb_chk(glob)vect'
@ -345,7 +347,7 @@ subroutine psb_zgatherv(globx, locx, desc_a, info, iroot,&
globx(:)=0.d0
do i=1,desc_a%matrix_data(psb_n_row_)
do i=1,psb_get_local_rows(desc_a)
idx = desc_a%loc_to_glob(i)
globx(idx) = locx(i)
end do

20
src/comm/psb_zhalo.f90
Unescape Escape View File

@ -77,7 +77,7 @@ subroutine psb_zhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
! check on blacs grid
call psb_info(ictxt, me, np)
@ -94,9 +94,9 @@ subroutine psb_zhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
ijx = 1
endif
m = desc_a%matrix_data(psb_m_)
n = desc_a%matrix_data(psb_n_)
nrow = desc_a%matrix_data(psb_n_row_)
m = psb_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a)
nrow = psb_get_local_rows(desc_a)
maxk=size(x,2)-ijx+1
@ -122,7 +122,7 @@ subroutine psb_zhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
endif
! check vector correctness
call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@ -283,7 +283,7 @@ subroutine psb_zhalov(x,desc_a,info,alpha,work,tran,mode)
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
! check on blacs grid
call psb_info(ictxt, me, np)
@ -296,9 +296,9 @@ subroutine psb_zhalov(x,desc_a,info,alpha,work,tran,mode)
ix = 1
ijx = 1
m = desc_a%matrix_data(psb_m_)
n = desc_a%matrix_data(psb_n_)
nrow = desc_a%matrix_data(psb_n_row_)
m = psb_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a)
nrow = psb_get_local_rows(desc_a)
if (present(tran)) then
ltran = tran
@ -312,7 +312,7 @@ subroutine psb_zhalov(x,desc_a,info,alpha,work,tran,mode)
endif
! check vector correctness
call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'

24
src/comm/psb_zovrl.f90
Unescape Escape View File

@ -73,7 +73,7 @@ subroutine psb_zovrlm(x,desc_a,info,jx,ik,work,update)
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
! check on blacs grid
call psb_info(ictxt, me, np)
@ -90,10 +90,10 @@ subroutine psb_zovrlm(x,desc_a,info,jx,ik,work,update)
ijx = 1
endif
m = desc_a%matrix_data(psb_m_)
n = desc_a%matrix_data(psb_n_)
nrow = desc_a%matrix_data(psb_n_row_)
ncol = desc_a%matrix_data(psb_n_col_)
m = psb_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a)
nrow = psb_get_local_rows(desc_a)
ncol = psb_get_local_cols(desc_a)
maxk=size(x,2)-ijx+1
@ -117,7 +117,7 @@ subroutine psb_zovrlm(x,desc_a,info,jx,ik,work,update)
imode = IOR(psb_swap_send_,psb_swap_recv_)
! check vector correctness
call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@ -291,7 +291,7 @@ subroutine psb_zovrlv(x,desc_a,info,work,update)
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
! check on blacs grid
call psb_info(ictxt, me, np)
@ -304,10 +304,10 @@ subroutine psb_zovrlv(x,desc_a,info,work,update)
ix = 1
ijx = 1
m = desc_a%matrix_data(psb_m_)
n = desc_a%matrix_data(psb_n_)
nrow = desc_a%matrix_data(psb_n_row_)
ncol = desc_a%matrix_data(psb_n_col_)
m = psb_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a)
nrow = psb_get_local_rows(desc_a)
ncol = psb_get_local_cols(desc_a)
k = 1
@ -321,7 +321,7 @@ subroutine psb_zovrlv(x,desc_a,info,work,update)
imode = IOR(psb_swap_send_,psb_swap_recv_)
! check vector correctness
call psb_chkvect(m,1,size(x),ix,ijx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,1,size(x),ix,ijx,desc_a,info,iix,jjx)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'

30
src/comm/psb_zscatter.f90
Unescape Escape View File

@ -79,7 +79,7 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, iroot,&
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
! check on blacs grid
call psb_info(ictxt, me, np)
@ -131,8 +131,8 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, iroot,&
lda_globx = size(globx,1)
lda_locx = size(locx, 1)
m = desc_a%matrix_data(psb_m_)
n = desc_a%matrix_data(psb_n_)
m = psb_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a)
lock=size(locx,2)-jlocx+1
globk=size(globx,2)-jglobx+1
@ -154,8 +154,8 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, iroot,&
lda_globx = size(globx)
lda_locx = size(locx)
m = desc_a%matrix_data(psb_m_)
n = desc_a%matrix_data(psb_n_)
m = psb_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a)
if (me == iiroot) then
call igebs2d(ictxt, 'all', ' ', 1, 1, k, 1)
@ -165,8 +165,9 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, iroot,&
! there should be a global check on k here!!!
call psb_chkglobvect(m,n,size(globx),iglobx,jglobx,desc_a%matrix_data,info)
call psb_chkvect(m,n,size(locx),ilocx,jlocx,desc_a%matrix_data,info,ilx,jlx)
call psb_chkglobvect(m,n,size(globx),iglobx,jglobx,desc_a,info)
if (info == 0) &
& call psb_chkvect(m,n,size(locx),ilocx,jlocx,desc_a,info,ilx,jlx)
if(info /= 0) then
info=4010
ch_err='psb_chk(glob)vect'
@ -180,7 +181,7 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, iroot,&
goto 9999
end if
nrow=desc_a%matrix_data(psb_n_row_)
nrow=psb_get_local_rows(desc_a)
if(root == -1) then
! extract my chunk
@ -335,7 +336,7 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, iroot)
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
! check on blacs grid
call psb_info(ictxt, me, np)
@ -363,8 +364,8 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, iroot)
lda_globx = size(globx)
lda_locx = size(locx)
m = desc_a%matrix_data(psb_m_)
n = desc_a%matrix_data(psb_n_)
m = psb_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a)
k = 1
@ -376,8 +377,9 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, iroot)
! there should be a global check on k here!!!
call psb_chkglobvect(m,n,size(globx),iglobx,jglobx,desc_a%matrix_data,info)
call psb_chkvect(m,n,size(locx),ilocx,jlocx,desc_a%matrix_data,info,ilx,jlx)
call psb_chkglobvect(m,n,size(globx),iglobx,jglobx,desc_a,info)
if (info == 0) &
& call psb_chkvect(m,n,size(locx),ilocx,jlocx,desc_a,info,ilx,jlx)
if(info /= 0) then
info=4010
ch_err='psb_chk(glob)vect'
@ -391,7 +393,7 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, iroot)
goto 9999
end if
nrow=desc_a%matrix_data(psb_n_row_)
nrow=psb_get_local_rows(desc_a)
if(root == -1) then
! extract my chunk

2
src/internals/psi_crea_index.f90
Unescape Escape View File

@ -80,7 +80,7 @@ subroutine psi_crea_index(desc_a,index_in,index_out,glob_idx,nxch,nsnd,nrcv,info
name='psi_crea_index'
call psb_erractionsave(err_act)
ictxt = desc_a%matrix_data(psb_ctxt_)
ictxt = psb_get_context(desc_a)
call psb_info(ictxt,me,np)
if (np == -1) then
info = 2010

8
src/internals/psi_dswapdata.f90
Unescape Escape View File

@ -65,7 +65,7 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
name='psi_swap_data'
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt,me,np)
if (np == -1) then
info = 2010
@ -73,7 +73,7 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
goto 9999
endif
if (.not.psb_is_asb_dec(desc_a%matrix_data(psb_dec_type_))) then
if (.not.psb_is_asb_desc(desc_a)) then
info = 1122
call psb_errpush(info,name)
goto 9999
@ -474,7 +474,7 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
name='psi_swap_datav'
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt,me,np)
if (np == -1) then
info = 2010
@ -482,7 +482,7 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
goto 9999
endif
if (.not.psb_is_asb_dec(desc_a%matrix_data(psb_dec_type_))) then
if (.not.psb_is_asb_desc(desc_a)) then
info = 1122
call psb_errpush(info,name)
goto 9999

8
src/internals/psi_dswaptran.f90
Unescape Escape View File

@ -65,7 +65,7 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
name='psi_swap_tran'
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt,me,np)
if (np == -1) then
info = 2010
@ -73,7 +73,7 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
goto 9999
endif
if (.not.psb_is_asb_dec(desc_a%matrix_data(psb_dec_type_))) then
if (.not.psb_is_asb_desc(desc_a)) then
info = 1122
call psb_errpush(info,name)
goto 9999
@ -466,7 +466,7 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
name='psi_swap_tranv'
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt,me,np)
if (np == -1) then
info = 2010
@ -474,7 +474,7 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
goto 9999
endif
if (.not.psb_is_asb_dec(desc_a%matrix_data(psb_dec_type_))) then
if (.not.psb_is_asb_desc(desc_a)) then
info = 1122
call psb_errpush(info,name)
goto 9999

8
src/internals/psi_iswapdata.f90
Unescape Escape View File

@ -65,7 +65,7 @@ subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data)
name='psi_swap_data'
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt,me,np)
if (np == -1) then
info = 2010
@ -73,7 +73,7 @@ subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data)
goto 9999
endif
if (.not.psb_is_asb_dec(desc_a%matrix_data(psb_dec_type_))) then
if (.not.psb_is_asb_desc(desc_a)) then
info = 1122
call psb_errpush(info,name)
goto 9999
@ -474,7 +474,7 @@ subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data)
name='psi_swap_datav'
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt,me,np)
if (np == -1) then
info = 2010
@ -482,7 +482,7 @@ subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data)
goto 9999
endif
if (.not.psb_is_asb_dec(desc_a%matrix_data(psb_dec_type_))) then
if (.not.psb_is_asb_desc(desc_a)) then
info = 1122
call psb_errpush(info,name)
goto 9999

8
src/internals/psi_iswaptran.f90
Unescape Escape View File

@ -65,7 +65,7 @@ subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data)
name='psi_swap_tran'
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt,me,np)
if (np == -1) then
info = 2010
@ -73,7 +73,7 @@ subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data)
goto 9999
endif
if (.not.psb_is_asb_dec(desc_a%matrix_data(psb_dec_type_))) then
if (.not.psb_is_asb_desc(desc_a)) then
info = 1122
call psb_errpush(info,name)
goto 9999
@ -466,7 +466,7 @@ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data)
name='psi_swap_tranv'
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt,me,np)
if (np == -1) then
info = 2010
@ -474,7 +474,7 @@ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data)
goto 9999
endif
if (.not.psb_is_asb_dec(desc_a%matrix_data(psb_dec_type_))) then
if (.not.psb_is_asb_desc(desc_a)) then
info = 1122
call psb_errpush(info,name)
goto 9999

8
src/internals/psi_zswapdata.f90
Unescape Escape View File

@ -65,7 +65,7 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data)
name='psi_swap_data'
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt,me,np)
if (np == -1) then
info = 2010
@ -73,7 +73,7 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data)
goto 9999
endif
if (.not.psb_is_asb_dec(desc_a%matrix_data(psb_dec_type_))) then
if (.not.psb_is_asb_desc(desc_a)) then
info = 1122
call psb_errpush(info,name)
goto 9999
@ -474,7 +474,7 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data)
name='psi_swap_datav'
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt,me,np)
if (np == -1) then
info = 2010
@ -482,7 +482,7 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data)
goto 9999
endif
if (.not.psb_is_asb_dec(desc_a%matrix_data(psb_dec_type_))) then
if (.not.psb_is_asb_desc(desc_a)) then
info = 1122
call psb_errpush(info,name)
goto 9999

8
src/internals/psi_zswaptran.f90
Unescape Escape View File

@ -65,7 +65,7 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
name='psi_swap_tran'
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt,me,np)
if (np == -1) then
info = 2010
@ -73,7 +73,7 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
goto 9999
endif
if (.not.psb_is_asb_dec(desc_a%matrix_data(psb_dec_type_))) then
if (.not.psb_is_asb_desc(desc_a)) then
info = 1122
call psb_errpush(info,name)
goto 9999
@ -463,7 +463,7 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data)
name='psi_swap_tranv'
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt,me,np)
if (np == -1) then
info = 2010
@ -471,7 +471,7 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data)
goto 9999
endif
if (.not.psb_is_asb_dec(desc_a%matrix_data(psb_dec_type_))) then
if (.not.psb_is_asb_desc(desc_a)) then
info = 1122
call psb_errpush(info,name)
goto 9999

8
src/methd/psb_dbicg.f90
Unescape Escape View File

@ -119,13 +119,13 @@ subroutine psb_dbicg(a,prec,b,x,eps,desc_a,info,&
call psb_erractionsave(err_act)
if (debug) write(*,*) 'entering psb_dbicg'
ictxt = desc_a%matrix_data(psb_ctxt_)
ictxt = psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (debug) write(*,*) 'psb_dbicg: from gridinfo',np,me
mglob = desc_a%matrix_data(psb_m_)
n_row = desc_a%matrix_data(psb_n_row_)
n_col = desc_a%matrix_data(psb_n_col_)
mglob = psb_get_global_rows(desc_a)
n_row = psb_get_local_rows(desc_a)
n_col = psb_get_local_cols(desc_a)
! Ensure global coherence for convergence checks.
call psb_set_coher(ictxt,isvch)

8
src/methd/psb_dcg.f90
Unescape Escape View File

@ -114,12 +114,12 @@ Subroutine psb_dcg(a,prec,b,x,eps,desc_a,info,&
call psb_erractionsave(err_act)
ictxt = desc_a%matrix_data(psb_ctxt_)
ictxt = psb_get_context(desc_a)
call psb_info(ictxt, me, np)
mglob = desc_a%matrix_data(psb_m_)
n_row = desc_a%matrix_data(psb_n_row_)
n_col = desc_a%matrix_data(psb_n_col_)
mglob = psb_get_global_rows(desc_a)
n_row = psb_get_local_rows(desc_a)
n_col = psb_get_local_cols(desc_a)
if (present(istop)) then

8
src/methd/psb_dcgs.f90
Unescape Escape View File

@ -116,13 +116,13 @@ Subroutine psb_dcgs(a,prec,b,x,eps,desc_a,info,&
call psb_erractionsave(err_act)
If (debug) Write(*,*) 'entering psb_dcgs'
ictxt = desc_a%matrix_data(psb_ctxt_)
ictxt = psb_get_context(desc_a)
Call psb_info(ictxt, me, np)
If (debug) Write(*,*) 'psb_dcgs: from gridinfo',np,me
mglob = desc_a%matrix_data(psb_m_)
n_row = desc_a%matrix_data(psb_n_row_)
n_col = desc_a%matrix_data(psb_n_col_)
mglob = psb_get_global_rows(desc_a)
n_row = psb_get_local_rows(desc_a)
n_col = psb_get_local_cols(desc_a)
If (Present(istop)) Then
istop_ = istop

8
src/methd/psb_dcgstab.f90
Unescape Escape View File

@ -119,13 +119,13 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,&
call psb_erractionsave(err_act)
If (debug) Write(*,*) 'Entering PSB_DCGSTAB',present(istop)
ictxt = desc_a%matrix_data(psb_ctxt_)
ictxt = psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (debug) write(*,*) 'PSB_DCGSTAB: From GRIDINFO',np,me
mglob = desc_a%matrix_data(psb_m_)
n_row = desc_a%matrix_data(psb_n_row_)
n_col = desc_a%matrix_data(psb_n_col_)
mglob = psb_get_global_rows(desc_a)
n_row = psb_get_local_rows(desc_a)
n_col = psb_get_local_cols(desc_a)
If (Present(istop)) Then
istop_ = istop

8
src/methd/psb_dcgstabl.f90
Unescape Escape View File

@ -124,14 +124,14 @@ Subroutine psb_dcgstabl(a,prec,b,x,eps,desc_a,info,&
call psb_erractionsave(err_act)
If (debug) Write(0,*) 'entering psb_dbicgstabl'
ictxt = desc_a%matrix_data(psb_ctxt_)
ictxt = psb_get_context(desc_a)
Call psb_info(ictxt, me, np)
If (debug) Write(0,*) 'psb_dbicgstabl: from gridinfo',np,me
mglob = desc_a%matrix_data(psb_m_)
n_row = desc_a%matrix_data(psb_n_row_)
n_col = desc_a%matrix_data(psb_n_col_)
mglob = psb_get_global_rows(desc_a)
n_row = psb_get_local_rows(desc_a)
n_col = psb_get_local_cols(desc_a)
if (present(istop)) then
istop_ = istop

8
src/methd/psb_dgmresr.f90
Unescape Escape View File

@ -124,14 +124,14 @@ Subroutine psb_dgmresr(a,prec,b,x,eps,desc_a,info,&
call psb_erractionsave(err_act)
If (debug) Write(0,*) 'entering psb_dgmres'
ictxt = desc_a%matrix_data(psb_ctxt_)
ictxt = psb_get_context(desc_a)
Call psb_info(ictxt, me, np)
If (debug) Write(0,*) 'psb_dgmres: from gridinfo',np,me
mglob = desc_a%matrix_data(psb_m_)
n_row = desc_a%matrix_data(psb_n_row_)
n_col = desc_a%matrix_data(psb_n_col_)
mglob = psb_get_global_rows(desc_a)
n_row = psb_get_local_rows(desc_a)
n_col = psb_get_local_cols(desc_a)
if (present(istop)) then
istop_ = istop

8
src/methd/psb_zcgs.f90
Unescape Escape View File

@ -117,13 +117,13 @@ Subroutine psb_zcgs(a,prec,b,x,eps,desc_a,info,&
call psb_erractionsave(err_act)
If (debug) Write(*,*) 'entering psb_zcgs'
ictxt = desc_a%matrix_data(psb_ctxt_)
ictxt = psb_get_context(desc_a)
Call psb_info(ictxt, me, np)
If (debug) Write(*,*) 'psb_zcgs: from gridinfo',np,me
mglob = desc_a%matrix_data(psb_m_)
n_row = desc_a%matrix_data(psb_n_row_)
n_col = desc_a%matrix_data(psb_n_col_)
mglob = psb_get_global_rows(desc_a)
n_row = psb_get_local_rows(desc_a)
n_col = psb_get_local_cols(desc_a)
If (Present(istop)) Then
istop_ = istop

8
src/methd/psb_zcgstab.f90
Unescape Escape View File

@ -119,13 +119,13 @@ Subroutine psb_zcgstab(a,prec,b,x,eps,desc_a,info,&
call psb_erractionsave(err_act)
If (debug) Write(*,*) 'Entering PSB_ZCGSTAB',present(istop)
ictxt = desc_a%matrix_data(psb_ctxt_)
ictxt = psb_get_context(desc_a)
CALL psb_info(ictxt, me, np)
if (debug) write(*,*) 'PSB_ZCGSTAB: From GRIDINFO',np,me
mglob = desc_a%matrix_data(psb_m_)
n_row = desc_a%matrix_data(psb_n_row_)
n_col = desc_a%matrix_data(psb_n_col_)
mglob = psb_get_global_rows(desc_a)
n_row = psb_get_local_rows(desc_a)
n_col = psb_get_local_cols(desc_a)
If (Present(istop)) Then
istop_ = istop

1
src/modules/Makefile
Unescape Escape View File

@ -22,6 +22,7 @@ psb_error_mod.o: psb_const_mod.o
psb_penv_mod.o: psb_const_mod.o psb_error_mod.o
psi_mod.o: psb_penv_mod.o psb_error_mod.o psb_desc_type.o
psb_desc_type.o: psb_const_mod.o
psb_check_mod.o: psb_desc_type.o
psb_methd_mod.o: psb_serial_mod.o psb_desc_type.o psb_prec_type.o
psb_tools_mod.o: psb_spmat_type.o psb_desc_type.o psi_mod.o
psb_sparse_mod.o: $(MODULES) $(MPFOBJS)

140
src/modules/psb_check_mod.f90
Unescape Escape View File

@ -66,13 +66,13 @@ contains
! iix - integer(optional). The local rows starting index of the submatrix.
! jjx - integer(optional). The local columns starting index of the submatrix.
subroutine psb_chkvect( m, n, lldx, ix, jx, desc_dec, info, iix, jjx)
use psb_descriptor_type
use psb_const_mod
use psb_error_mod
implicit none
integer, intent(in) :: m,n,ix,jx,lldx
integer, intent(in) :: desc_dec(:)
type(psb_desc_type), intent(in) :: desc_dec
integer, intent(out) :: info
integer, optional :: iix, jjx
@ -80,67 +80,67 @@ contains
integer :: err_act, int_err(5)
character(len=20) :: name, ch_err
if(psb_get_errstatus().ne.0) return
if(psb_get_errstatus() /= 0) return
info=0
name='psb_chkvect'
call psb_erractionsave(err_act)
if (m.lt.0) then
if (m < 0) then
info=10
int_err(1) = 1
int_err(2) = m
else if (n.lt.0) then
else if (n < 0) then
info=10
int_err(1) = 3
int_err(2) = n
else if ((ix.lt.1) .and. (m.ne.0)) then
else if ((ix < 1) .and. (m /= 0)) then
info=20
int_err(1) = 4
int_err(2) = ix
else if ((jx.lt.1) .and. (n.ne.0)) then
else if ((jx < 1) .and. (n /= 0)) then
info=20
int_err(1) = 5
int_err(2) = jx
else if (desc_dec(psb_n_col_).lt.0) then
else if (psb_get_local_cols(desc_dec) < 0) then
info=40
int_err(1) = 6
int_err(2) = psb_n_col_
int_err(3) = desc_dec(psb_n_col_)
else if (desc_dec(psb_n_row_).lt.0) then
int_err(3) = psb_get_local_cols(desc_dec)
else if (psb_get_local_rows(desc_dec) < 0) then
info=40
int_err(1) = 6
int_err(2) = psb_n_row_
int_err(3) = desc_dec(psb_n_row_)
else if (lldx.lt.desc_dec(psb_n_col_)) then
int_err(3) = psb_get_local_cols(desc_dec)
else if (lldx < psb_get_local_cols(desc_dec)) then
info=50
int_err(1) = 3
int_err(2) = lldx
int_err(3) = 6
int_err(4) = psb_n_col_
int_err(5) = desc_dec(psb_n_col_)
else if (desc_dec(psb_n_).lt.m) then
int_err(5) = psb_get_local_cols(desc_dec)
else if (psb_get_global_cols(desc_dec) < m) then
info=60
int_err(1) = 1
int_err(2) = m
int_err(3) = 6
int_err(4) = psb_n_
int_err(5) = desc_dec(psb_n_)
else if (desc_dec(psb_n_).lt.ix) then
int_err(5) = psb_get_global_cols(desc_dec)
else if (psb_get_global_cols(desc_dec) < ix) then
info=60
int_err(1) = 4
int_err(2) = ix
int_err(3) = 6
int_err(4) = psb_n_
int_err(5) = desc_dec(psb_n_)
else if (desc_dec(psb_m_).lt.jx) then
int_err(5) = psb_get_global_cols(desc_dec)
else if (psb_get_global_rows(desc_dec) < jx) then
info=60
int_err(1) = 5
int_err(2) = jx
int_err(3) = 6
int_err(4) = psb_m_
int_err(5) = desc_dec(psb_m_)
else if (desc_dec(psb_n_).lt.(ix+m-1)) then
int_err(5) = psb_get_global_rows(desc_dec)
else if (psb_get_global_cols(desc_dec) < (ix+m-1)) then
info=80
int_err(1) = 1
int_err(2) = m
@ -148,7 +148,7 @@ contains
int_err(4) = ix
end if
if (info.ne.0) then
if (info /= 0) then
call psb_errpush(info,name,i_err=int_err)
goto 9999
end if
@ -164,7 +164,7 @@ contains
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act == act_abort) then
call psb_error()
return
end if
@ -192,79 +192,80 @@ contains
!
subroutine psb_chkglobvect( m, n, lldx, ix, jx, desc_dec, info)
use psb_descriptor_type
use psb_const_mod
use psb_error_mod
implicit none
integer, intent(in) :: m,n,ix,jx,lldx
integer, intent(in) :: desc_dec(:)
type(psb_desc_type), intent(in) :: desc_dec
integer, intent(out) :: info
! locals
integer :: err_act, int_err(5)
character(len=20) :: name, ch_err
if(psb_get_errstatus().ne.0) return
if(psb_get_errstatus() /= 0) return
info=0
name='psb_chkglobvect'
call psb_erractionsave(err_act)
if (m.lt.0) then
if (m < 0) then
info=10
int_err(1) = 1
int_err(2) = m
else if (n.lt.0) then
else if (n < 0) then
info=10
int_err(1) = 3
int_err(2) = n
else if ((ix.lt.1) .and. (m.ne.0)) then
else if ((ix < 1) .and. (m /= 0)) then
info=20
int_err(1) = 4
int_err(2) = ix
else if ((jx.lt.1) .and. (n.ne.0)) then
else if ((jx < 1) .and. (n /= 0)) then
info=20
int_err(1) = 5
int_err(2) = jx
else if (desc_dec(psb_n_col_).lt.0) then
else if (psb_get_local_cols(desc_dec) < 0) then
info=40
int_err(1) = 6
int_err(2) = psb_n_col_
int_err(3) = desc_dec(psb_n_col_)
else if (desc_dec(psb_n_row_).lt.0) then
int_err(3) = psb_get_local_cols(desc_dec)
else if (psb_get_local_rows(desc_dec) < 0) then
info=40
int_err(1) = 6
int_err(2) = psb_n_row_
int_err(3) = desc_dec(psb_n_row_)
else if (lldx.lt.desc_dec(psb_m_)) then
int_err(3) = psb_get_local_rows(desc_dec)
else if (lldx < psb_get_global_rows(desc_dec)) then
info=50
int_err(1) = 3
int_err(2) = lldx
int_err(3) = 6
int_err(4) = psb_n_col_
int_err(5) = desc_dec(psb_n_col_)
else if (desc_dec(psb_n_).lt.m) then
int_err(5) = psb_get_local_cols(desc_dec)
else if (psb_get_global_cols(desc_dec) < m) then
info=60
int_err(1) = 1
int_err(2) = m
int_err(3) = 6
int_err(4) = psb_n_
int_err(5) = desc_dec(psb_n_)
else if (desc_dec(psb_n_).lt.ix) then
int_err(5) = psb_get_global_cols(desc_dec)
else if (psb_get_global_cols(desc_dec) < ix) then
info=60
int_err(1) = 4
int_err(2) = ix
int_err(3) = 6
int_err(4) = psb_n_
int_err(5) = desc_dec(psb_n_)
else if (desc_dec(psb_m_).lt.jx) then
int_err(5) = psb_get_global_cols(desc_dec)
else if (psb_get_global_rows(desc_dec) < jx) then
info=60
int_err(1) = 5
int_err(2) = jx
int_err(3) = 6
int_err(4) = psb_m_
int_err(5) = desc_dec(psb_m_)
else if (desc_dec(psb_n_).lt.(ix+m-1)) then
int_err(5) = psb_get_global_rows(desc_dec)
else if (psb_get_global_cols(desc_dec) < (ix+m-1)) then
info=80
int_err(1) = 1
int_err(2) = m
@ -272,7 +273,7 @@ contains
int_err(4) = ix
end if
if (info.ne.0) then
if (info /= 0) then
call psb_errpush(info,name,i_err=int_err)
goto 9999
end if
@ -283,7 +284,7 @@ contains
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act == act_abort) then
call psb_error()
return
end if
@ -314,12 +315,13 @@ contains
!
subroutine psb_chkmat( m, n, ia, ja, desc_dec, info, iia, jja)
use psb_descriptor_type
use psb_const_mod
use psb_error_mod
implicit none
integer, intent(in) :: m,n,ia,ja
integer, intent(in) :: desc_dec(:)
type(psb_desc_type), intent(in) :: desc_dec
integer, intent(out) :: info
integer, optional :: iia, jja
@ -327,72 +329,72 @@ contains
integer :: err_act, int_err(5)
character(len=20) :: name, ch_err
if(psb_get_errstatus().ne.0) return
info=0
if(psb_get_errstatus() /= 0) return
info=0
name='psb_chkmat'
call psb_erractionsave(err_act)
if (m.lt.0) then
if (m < 0) then
info=10
int_err(1) = 1
int_err(2) = m
else if (n.lt.0) then
else if (n < 0) then
info=10
int_err(1) = 3
int_err(2) = n
else if ((ia.lt.1) .and. (m.ne.0)) then
else if ((ia < 1) .and. (m /= 0)) then
info=20
int_err(1) = 4
int_err(2) = ia
else if ((ja.lt.1) .and. (n.ne.0)) then
else if ((ja < 1) .and. (n /= 0)) then
info=20
int_err(1) = 5
int_err(2) = ja
else if (desc_dec(psb_n_col_).lt.0) then
else if (psb_get_local_cols(desc_dec) < 0) then
info=40
int_err(1) = 6
int_err(2) = psb_n_col_
int_err(3) = desc_dec(psb_n_col_)
else if (desc_dec(psb_n_row_).lt.0) then
int_err(3) = psb_get_local_cols(desc_dec)
else if (psb_get_local_rows(desc_dec) < 0) then
info=40
int_err(1) = 6
int_err(2) = psb_n_row_
int_err(3) = desc_dec(psb_n_row_)
else if (desc_dec(psb_m_).lt.m) then
int_err(3) = psb_get_local_rows(desc_dec)
else if (psb_get_global_rows(desc_dec) < m) then
info=60
int_err(1) = 1
int_err(2) = m
int_err(3) = 5
int_err(4) = psb_m_
int_err(5) = desc_dec(psb_m_)
else if (desc_dec(psb_m_).lt.m) then
int_err(5) = psb_get_global_rows(desc_dec)
else if (psb_get_global_rows(desc_dec) < m) then
info=60
int_err(1) = 2
int_err(2) = n
int_err(3) = 5
int_err(4) = psb_m_
int_err(5) = desc_dec(psb_m_)
else if (desc_dec(psb_m_).lt.ia) then
int_err(5) = psb_get_global_rows(desc_dec)
else if (psb_get_global_rows(desc_dec) < ia) then
info=60
int_err(1) = 3
int_err(2) = ia
int_err(3) = 5
int_err(4) = psb_m_
int_err(5) = desc_dec(psb_m_)
else if (desc_dec(psb_n_).lt.ja) then
int_err(5) = psb_get_global_rows(desc_dec)
else if (psb_get_global_cols(desc_dec) < ja) then
info=60
int_err(1) = 4
int_err(2) = ja
int_err(3) = 5
int_err(4) = psb_n_
int_err(5) = desc_dec(psb_n_)
else if (desc_dec(psb_m_).lt.(ia+m-1)) then
int_err(5) = psb_get_global_cols(desc_dec)
else if (psb_get_global_rows(desc_dec) < (ia+m-1)) then
info=80
int_err(1) = 1
int_err(2) = m
int_err(3) = 3
int_err(4) = ia
else if (desc_dec(psb_n_).lt.(ja+n-1)) then
else if (psb_get_global_cols(desc_dec) < (ja+n-1)) then
info=80
int_err(1) = 2
int_err(2) = n
@ -400,7 +402,7 @@ contains
int_err(4) = ja
end if
if (info.ne.0) then
if (info /= 0) then
call psb_errpush(info,name,i_err=int_err)
goto 9999
end if
@ -408,12 +410,12 @@ contains
! Compute local indices for submatrix starting
! at global indices ix and jx
if(present(iia).and.present(jja)) then
if (desc_dec(psb_n_row_).gt.0) then
if (psb_get_local_rows(desc_dec) > 0) then
iia=1
jja=1
else
iia=desc_dec(psb_n_row_)+1
jja=desc_dec(psb_n_col_)+1
iia=psb_get_local_rows(desc_dec)+1
jja=psb_get_local_cols(desc_dec)+1
end if
end if
@ -423,7 +425,7 @@ contains
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act == act_abort) then
call psb_error()
return
end if

44
src/modules/psb_desc_type.f90
Unescape Escape View File

@ -75,6 +75,42 @@ contains
end subroutine psb_nullify_desc
logical function psb_is_ok_desc(desc)
type(psb_desc_type), intent(in) :: desc
psb_is_ok_desc = psb_is_ok_dec(psb_get_dectype(desc))
end function psb_is_ok_desc
logical function psb_is_bld_desc(desc)
type(psb_desc_type), intent(in) :: desc
psb_is_bld_desc = psb_is_bld_dec(psb_get_dectype(desc))
end function psb_is_bld_desc
logical function psb_is_upd_desc(desc)
type(psb_desc_type), intent(in) :: desc
psb_is_upd_desc = psb_is_upd_dec(psb_get_dectype(desc))
end function psb_is_upd_desc
logical function psb_is_asb_upd_desc(desc)
type(psb_desc_type), intent(in) :: desc
psb_is_asb_upd_desc = psb_is_asb_upd_dec(psb_get_dectype(desc))
end function psb_is_asb_upd_desc
logical function psb_is_asb_desc(desc)
type(psb_desc_type), intent(in) :: desc
psb_is_asb_desc = psb_is_asb_dec(psb_get_dectype(desc))
end function psb_is_asb_desc
logical function psb_is_ok_dec(dectype)
integer :: dectype
@ -112,6 +148,8 @@ contains
end function psb_is_asb_dec
integer function psb_get_local_rows(desc)
type(psb_desc_type), intent(in) :: desc
@ -142,4 +180,10 @@ contains
psb_get_context = desc%matrix_data(psb_ctxt_)
end function psb_get_context
integer function psb_get_dectype(desc)
type(psb_desc_type), intent(in) :: desc
psb_get_dectype = desc%matrix_data(psb_dec_type_)
end function psb_get_dectype
end module psb_descriptor_type

108
src/modules/psb_serial_mod.f90
Unescape Escape View File

@ -438,5 +438,113 @@ module psb_serial_mod
end function psb_zcsnmi
end interface
interface psb_get_nrows
module procedure psb_get_dsp_nrows, psb_get_zsp_nrows
end interface
interface psb_get_ncols
module procedure psb_get_dsp_ncols, psb_get_zsp_ncols
end interface
interface psb_get_nnzeros
module procedure psb_get_dsp_nnzeros, psb_get_zsp_nnzeros
end interface
interface psb_get_nnz_row
module procedure psb_get_dsp_nnz_row, psb_get_zsp_nnz_row
end interface
contains
integer function psb_get_dsp_nrows(a)
use psb_spmat_type
type(psb_dspmat_type), intent(in) :: a
psb_get_dsp_nrows = a%m
return
end function psb_get_dsp_nrows
integer function psb_get_dsp_ncols(a)
use psb_spmat_type
type(psb_dspmat_type), intent(in) :: a
psb_get_dsp_ncols = a%k
return
end function psb_get_dsp_ncols
integer function psb_get_zsp_nrows(a)
use psb_spmat_type
type(psb_zspmat_type), intent(in) :: a
psb_get_zsp_nrows = a%m
return
end function psb_get_zsp_nrows
integer function psb_get_zsp_ncols(a)
use psb_spmat_type
type(psb_zspmat_type), intent(in) :: a
psb_get_zsp_ncols = a%k
return
end function psb_get_zsp_ncols
integer function psb_get_dsp_nnzeros(a)
use psb_spmat_type
type(psb_dspmat_type), intent(in) :: a
integer :: ires,info
call psb_spinfo(psb_nztotreq_,a,ires,info)
if (info == 0) then
psb_get_dsp_nnzeros = ires
else
psb_get_dsp_nnzeros = 0
end if
end function psb_get_dsp_nnzeros
integer function psb_get_zsp_nnzeros(a)
use psb_spmat_type
type(psb_zspmat_type), intent(in) :: a
integer :: ires,info
call psb_spinfo(psb_nztotreq_,a,ires,info)
if (info == 0) then
psb_get_zsp_nnzeros = ires
else
psb_get_zsp_nnzeros = 0
end if
end function psb_get_zsp_nnzeros
integer function psb_get_dsp_nnz_row(ir,a)
use psb_spmat_type
integer, intent(in) :: ir
type(psb_dspmat_type), intent(in) :: a
integer :: ires,info
call psb_spinfo(psb_nzrowreq_,a,ires,info,iaux=ir)
if (info == 0) then
psb_get_dsp_nnz_row = ires
else
psb_get_dsp_nnz_row = 0
end if
end function psb_get_dsp_nnz_row
integer function psb_get_zsp_nnz_row(ir,a)
use psb_spmat_type
integer, intent(in) :: ir
type(psb_zspmat_type), intent(in) :: a
integer :: ires,info
call psb_spinfo(psb_nzrowreq_,a,ires,info,iaux=ir)
if (info == 0) then
psb_get_zsp_nnz_row = ires
else
psb_get_zsp_nnz_row = 0
end if
end function psb_get_zsp_nnz_row
end module psb_serial_mod

8
src/prec/psb_dbaseprc_bld.f90
Unescape Escape View File

@ -131,10 +131,10 @@ subroutine psb_dbaseprc_bld(a,desc_a,p,info,upd)
if (debug) write(0,*) 'Entering baseprc_bld'
info = 0
int_err(1) = 0
ictxt = desc_a%matrix_data(psb_ctxt_)
n_row = desc_a%matrix_data(psb_n_row_)
n_col = desc_a%matrix_data(psb_n_col_)
mglob = desc_a%matrix_data(psb_m_)
ictxt = psb_get_context(desc_a)
n_row = psb_get_local_rows(desc_a)
n_col = psb_get_local_cols(desc_a)
mglob = psb_get_global_rows(desc_a)
if (debug) write(0,*) 'Preconditioner Blacs_gridinfo'
call psb_info(ictxt, me, np)

44
src/prec/psb_dbldaggrmat.f90
Unescape Escape View File

@ -60,7 +60,7 @@ subroutine psb_dbldaggrmat(a,desc_a,ac,desc_ac,p,info)
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
select case (p%iprcparm(smth_kind_))
@ -125,11 +125,11 @@ contains
call psb_nullify_sp(b)
ictxt = desc_a%matrix_data(psb_ctxt_)
ictxt = psb_get_context(desc_a)
call psb_info(ictxt, me, np)
nglob = desc_a%matrix_data(psb_m_)
nrow = desc_a%matrix_data(psb_n_row_)
ncol = desc_a%matrix_data(psb_n_col_)
nglob = psb_get_global_rows(desc_a)
nrow = psb_get_local_rows(desc_a)
ncol = psb_get_local_cols(desc_a)
naggr = p%nlaggr(me+1)
ntaggr = sum(p%nlaggr)
@ -155,13 +155,7 @@ contains
end if
call psb_spinfo(psb_nztotreq_,a,nzt,info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='spinfo')
goto 9999
end if
nzt = psb_get_nnzeros(a)
call psb_sp_all(b,nzt,info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='spall')
@ -181,13 +175,8 @@ contains
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_spinfo(psb_nztotreq_,b,nzt,info)
if(info /= 0) then
info=4010
ch_err='psb_spinfo'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
nzt = psb_get_nnzeros(b)
do i=1, nzt
b%ia1(i) = p%mlia(b%ia1(i))
b%ia2(i) = p%mlia(b%ia2(i))
@ -228,8 +217,13 @@ contains
!!$ enddo
end if
call psb_fixcoo(b,info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='fixcoo')
goto 9999
end if
irs = b%infoa(psb_nnz_)
irs = psb_get_nnzeros(b)
call psb_sp_reall(b,irs,info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='spreall')
@ -408,7 +402,7 @@ contains
info=0
call psb_erractionsave(err_act)
ictxt = desc_a%matrix_data(psb_ctxt_)
ictxt = psb_get_context(desc_a)
call psb_info(ictxt, me, np)
call psb_nullify_sp(b)
@ -418,9 +412,9 @@ contains
am2 => p%av(sm_pr_t_)
am1 => p%av(sm_pr_)
nglob = desc_a%matrix_data(psb_m_)
nrow = desc_a%matrix_data(psb_n_row_)
ncol = desc_a%matrix_data(psb_n_col_)
nglob = psb_get_global_rows(desc_a)
nrow = psb_get_local_rows(desc_a)
ncol = psb_get_local_cols(desc_a)
naggr = p%nlaggr(me+1)
ntaggr = sum(p%nlaggr)
@ -887,7 +881,7 @@ contains
if (np>1) then
call psb_spinfo(psb_nztotreq_,am1,nzl,info)
nzl = psb_get_nnzeros(am1)
call psb_glob_to_loc(am1%ia1(1:nzl),desc_ac,info,'I')
if(info /= 0) then
call psb_errpush(4010,name,a_err='psb_glob_to_loc')

8
src/prec/psb_ddiagsc_bld.f90
Unescape Escape View File

@ -75,10 +75,10 @@ subroutine psb_ddiagsc_bld(a,desc_a,p,upd,info)
if (debug) write(0,*) 'Entering diagsc_bld'
info = 0
int_err(1) = 0
ictxt = desc_a%matrix_data(psb_ctxt_)
n_row = desc_a%matrix_data(psb_n_row_)
n_col = desc_a%matrix_data(psb_n_col_)
mglob = desc_a%matrix_data(psb_m_)
ictxt = psb_get_context(desc_a)
n_row = psb_get_local_rows(desc_a)
n_col = psb_get_local_cols(desc_a)
mglob = psb_get_global_rows(desc_a)
if (debug) write(0,*) 'Preconditioner Blacs_gridinfo'
call psb_info(ictxt, me, np)

6
src/prec/psb_dgenaggrmap.f90
Unescape Escape View File

@ -66,10 +66,10 @@ subroutine psb_dgenaggrmap(aggr_type,a,desc_a,nlaggr,ilaggr,info)
! so that we only have local decoupled aggregation. This might
! change in the future.
!
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt,me,np)
nrow = desc_a%matrix_data(psb_n_row_)
ncol = desc_a%matrix_data(psb_n_col_)
nrow = psb_get_local_rows(desc_a)
ncol = psb_get_local_cols(desc_a)
nr = a%m

22
src/prec/psb_dilu_bld.f90
Unescape Escape View File

@ -131,7 +131,7 @@ subroutine psb_dilu_bld(a,desc_a,p,upd,info)
name='psb_ilu_bld'
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
m = a%m
@ -182,19 +182,13 @@ subroutine psb_dilu_bld(a,desc_a,p,upd,info)
endif
!!$ call psb_csprt(50+me,a,head='% (A)')
nrow_a = desc_a%matrix_data(psb_n_row_)
call psb_spinfo(psb_nztotreq_,a,nztota,info)
if (info == 0) call psb_spinfo(psb_nztotreq_,blck,nztotb,info)
if(info/=0) then
info=4010
ch_err='psb_spinfo'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if (debug) write(0,*)me,': out spinfo',nztota
nrow_a = psb_get_local_rows(desc_a)
nztota = psb_get_nnzeros(a)
nztotb = psb_get_nnzeros(blck)
if (debug) write(0,*)me,': out get_nnzeros',nztota
if (debug) call psb_barrier(ictxt)
n_col = desc_a%matrix_data(psb_n_col_)
n_col = psb_get_local_cols(desc_a)
nhalo = n_col-nrow_a
n_row = p%desc_data%matrix_data(psb_n_row_)
p%av(l_pr_)%m = n_row
@ -237,8 +231,8 @@ subroutine psb_dilu_bld(a,desc_a,p,upd,info)
! Here we allocate a full copy to hold local A and received BLK
!
call psb_spinfo(psb_nztotreq_,a,nztota,info)
call psb_spinfo(psb_nztotreq_,blck,nztotb,info)
nztota = psb_get_nnzeros(a)
nztotb = psb_get_nnzeros(blck)
call psb_sp_all(atmp,nztota+nztotb,info)
if(info/=0) then
info=4011

2
src/prec/psb_dprecbld.f90
Unescape Escape View File

@ -100,7 +100,7 @@ subroutine psb_dprecbld(a,desc_a,p,info,upd)
if (debug) write(0,*) 'Entering precbld',P%prec,desc_a%matrix_data(:)
info = 0
int_err(1) = 0
ictxt = desc_a%matrix_data(psb_ctxt_)
ictxt = psb_get_context(desc_a)
if (debug) write(0,*) 'Preconditioner psb_info'
call psb_info(ictxt, me, np)

14
src/prec/psb_dprecset.f90
Unescape Escape View File

@ -80,11 +80,15 @@ subroutine psb_dprecset(p,ptype,info,iv,rs,rv,ilev,nlev)
return
endif
call psb_realloc(ifpsz,p%baseprecv(ilev_)%iprcparm,info)
if (info == 0) call psb_realloc(dfpsz,p%baseprecv(ilev_)%dprcparm,info)
if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
call psb_realloc(ifpsz,p%baseprecv(ilev_)%iprcparm,info)
if (info == 0) call psb_realloc(dfpsz,p%baseprecv(ilev_)%dprcparm,info)
if (info /= 0) then
write(0,*) 'Info from realloc ',info
return
end if
p%baseprecv(ilev_)%iprcparm(:) = 0
end if
select case(toupper(ptype(1:len_trim(ptype))))
case ('NONE','NOPREC')

10
src/prec/psb_dslu_bld.f90
Unescape Escape View File

@ -94,7 +94,7 @@ subroutine psb_dslu_bld(a,desc_a,p,info)
call psb_csdp(a,atmp,info)
if(info /= 0) then
info=4010
ch_err='psb_dcsdp'
ch_err='psb_csdp'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
@ -165,13 +165,7 @@ subroutine psb_dslu_bld(a,desc_a,p,info)
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_spinfo(psb_nztotreq_,atmp,nzt,info)
if(info /= 0) then
info=4010
ch_err='psb_spinfo'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
nzt = psb_get_nnzeros(atmp)
if (Debug) then
write(0,*) me,'Calling psb_slu_factor ',nzt,atmp%m,&
& atmp%k,p%desc_data%matrix_data(psb_n_row_)

4
src/prec/psb_dsp_renum.f90
Unescape Escape View File

@ -68,7 +68,7 @@ subroutine psb_dsp_renum(a,desc_a,blck,p,atmp,info)
name='apply_renum'
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
!!!!!!!!!!!!!!!! CHANGE FOR NON-CSR A
@ -84,7 +84,7 @@ subroutine psb_dsp_renum(a,desc_a,blck,p,atmp,info)
atmp%descra = 'GUN'
! This is the renumbering coherent with global indices..
mglob = desc_a%matrix_data(psb_m_)
mglob = psb_get_global_rows(desc_a)
!
! Remember: we have switched IA1=COLS and IA2=ROWS
! Now identify the set of distinct local column indices

14
src/prec/psb_dumf_bld.f90
Unescape Escape View File

@ -97,8 +97,8 @@ subroutine psb_dumf_bld(a,desc_a,p,info)
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_spinfo(psb_nztotreq_,atmp,nza,info)
call psb_spinfo(psb_nztotreq_,a,nzb,info)
nza = psb_get_nnzeros(atmp)
nzb = psb_get_nnzeros(a)
if (Debug) then
write(0,*) me, 'UMFBLD: Done csdp',info,nza,atmp%m,atmp%k,nzb
call psb_barrier(ictxt)
@ -112,7 +112,7 @@ subroutine psb_dumf_bld(a,desc_a,p,info)
goto 9999
end if
call psb_spinfo(psb_nztotreq_,blck,nzb,info)
nzb = psb_get_nnzeros(blck)
if (Debug) then
write(0,*) me, 'UMFBLD: Done asmatbld',info,nzb,blck%fida
call psb_barrier(ictxt)
@ -165,13 +165,7 @@ subroutine psb_dumf_bld(a,desc_a,p,info)
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_spinfo(psb_nztotreq_,atmp,nzt,info)
if(info /= 0) then
info=4010
ch_err='psb_spinfo'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
nzt = psb_get_nnzeros(atmp)
if (Debug) then
write(0,*) me,'Calling psb_umf_factor ',nzt,atmp%m,&
& atmp%k,p%desc_data%matrix_data(psb_n_row_)

8
src/prec/psb_zbaseprc_bld.f90
Unescape Escape View File

@ -131,10 +131,10 @@ subroutine psb_zbaseprc_bld(a,desc_a,p,info,upd)
if (debug) write(0,*) 'Entering baseprc_bld'
info = 0
int_err(1) = 0
ictxt = desc_a%matrix_data(psb_ctxt_)
n_row = desc_a%matrix_data(psb_n_row_)
n_col = desc_a%matrix_data(psb_n_col_)
mglob = desc_a%matrix_data(psb_m_)
ictxt = psb_get_context(desc_a)
n_row = psb_get_local_rows(desc_a)
n_col = psb_get_local_cols(desc_a)
mglob = psb_get_global_rows(desc_a)
if (debug) write(0,*) 'Preconditioner Blacs_gridinfo'
call psb_info(ictxt, me, np)

40
src/prec/psb_zbldaggrmat.f90
Unescape Escape View File

@ -60,7 +60,7 @@ subroutine psb_zbldaggrmat(a,desc_a,ac,desc_ac,p,info)
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
select case (p%iprcparm(smth_kind_))
@ -124,11 +124,11 @@ contains
call psb_nullify_sp(b)
ictxt = desc_a%matrix_data(psb_ctxt_)
ictxt = psb_get_context(desc_a)
call psb_info(ictxt, me, np)
nglob = desc_a%matrix_data(psb_m_)
nrow = desc_a%matrix_data(psb_n_row_)
ncol = desc_a%matrix_data(psb_n_col_)
nglob = psb_get_global_rows(desc_a)
nrow = psb_get_local_rows(desc_a)
ncol = psb_get_local_cols(desc_a)
naggr = p%nlaggr(me+1)
ntaggr = sum(p%nlaggr)
@ -154,13 +154,7 @@ contains
end if
call psb_spinfo(psb_nztotreq_,a,nzt,info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='spinfo')
goto 9999
end if
nzt = psb_get_nnzeros(a)
call psb_sp_all(b,nzt,info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='spall')
@ -180,13 +174,8 @@ contains
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_spinfo(psb_nztotreq_,b,nzt,info)
if(info /= 0) then
info=4010
ch_err='psb_spinfo'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
nzt = psb_get_nnzeros(b)
do i=1, nzt
b%ia1(i) = p%mlia(b%ia1(i))
b%ia2(i) = p%mlia(b%ia2(i))
@ -233,7 +222,7 @@ contains
goto 9999
end if
irs = b%infoa(psb_nnz_)
irs = psb_get_nnzeros(b)
call psb_sp_reall(b,irs,info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='spreall')
@ -296,6 +285,7 @@ contains
call psb_errpush(4010,name,a_err='psb_cddec')
goto 9999
end if
call psb_sp_clone(b,ac,info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='spclone')
@ -411,7 +401,7 @@ contains
info=0
call psb_erractionsave(err_act)
ictxt = desc_a%matrix_data(psb_ctxt_)
ictxt = psb_get_context(desc_a)
call psb_info(ictxt, me, np)
call psb_nullify_sp(b)
@ -421,9 +411,9 @@ contains
am2 => p%av(sm_pr_t_)
am1 => p%av(sm_pr_)
nglob = desc_a%matrix_data(psb_m_)
nrow = desc_a%matrix_data(psb_n_row_)
ncol = desc_a%matrix_data(psb_n_col_)
nglob = psb_get_global_rows(desc_a)
nrow = psb_get_local_rows(desc_a)
ncol = psb_get_local_cols(desc_a)
naggr = p%nlaggr(me+1)
ntaggr = sum(p%nlaggr)
@ -890,7 +880,7 @@ contains
if (np>1) then
call psb_spinfo(psb_nztotreq_,am1,nzl,info)
nzl = psb_get_nnzeros(am1)
call psb_glob_to_loc(am1%ia1(1:nzl),desc_ac,info,'I')
if(info /= 0) then
call psb_errpush(4010,name,a_err='psb_glob_to_loc')

8
src/prec/psb_zdiagsc_bld.f90
Unescape Escape View File

@ -75,10 +75,10 @@ subroutine psb_zdiagsc_bld(a,desc_a,p,upd,info)
if (debug) write(0,*) 'Entering diagsc_bld'
info = 0
int_err(1) = 0
ictxt = desc_a%matrix_data(psb_ctxt_)
n_row = desc_a%matrix_data(psb_n_row_)
n_col = desc_a%matrix_data(psb_n_col_)
mglob = desc_a%matrix_data(psb_m_)
ictxt = psb_get_context(desc_a)
n_row = psb_get_local_rows(desc_a)
n_col = psb_get_local_cols(desc_a)
mglob = psb_get_global_rows(desc_a)
if (debug) write(0,*) 'Preconditioner Blacs_gridinfo'
call psb_info(ictxt, me, np)

6
src/prec/psb_zgenaggrmap.f90
Unescape Escape View File

@ -66,10 +66,10 @@ subroutine psb_zgenaggrmap(aggr_type,a,desc_a,nlaggr,ilaggr,info)
! so that we only have local decoupled aggregation. This might
! change in the future.
!
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt,me,np)
nrow = desc_a%matrix_data(psb_n_row_)
ncol = desc_a%matrix_data(psb_n_col_)
nrow = psb_get_local_rows(desc_a)
ncol = psb_get_local_cols(desc_a)
nr = a%m

30
src/prec/psb_zilu_bld.f90
Unescape Escape View File

@ -71,7 +71,7 @@ subroutine psb_zilu_bld(a,desc_a,p,upd,info)
character, intent(in) :: upd
! .. Local Scalars ..
integer :: i, j, jj, k, kk, m, i1, i2, ia
integer :: i, j, jj, k, kk, m
integer :: int_err(5)
character :: trans, unitd
type(psb_zspmat_type) :: blck, atmp
@ -79,7 +79,7 @@ subroutine psb_zilu_bld(a,desc_a,p,upd,info)
external mpi_wtime
logical, parameter :: debugprt=.false., debug=.false., aggr_dump=.false.
integer nztota, nztotb, nztmp, nzl, nnr, ir, err_act,&
& n_row, nrow_a,n_col, nhalo, ind, iind
& n_row, nrow_a,n_col, nhalo, ind, iind, i1,i2,ia
integer :: ictxt,np,me
character(len=20) :: name, ch_err
@ -131,7 +131,7 @@ subroutine psb_zilu_bld(a,desc_a,p,upd,info)
name='psb_ilu_bld'
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
m = a%m
@ -152,10 +152,6 @@ subroutine psb_zilu_bld(a,desc_a,p,upd,info)
goto 9999
endif
! call psb_info(ictxt, me, np)
ictxt=desc_a%matrix_data(psb_ctxt_)
call psb_nullify_sp(blck)
call psb_nullify_sp(atmp)
@ -185,19 +181,13 @@ subroutine psb_zilu_bld(a,desc_a,p,upd,info)
goto 9999
endif
nrow_a = desc_a%matrix_data(psb_n_row_)
call psb_spinfo(psb_nztotreq_,a,nztota,info)
if (info == 0) call psb_spinfo(psb_nztotreq_,blck,nztotb,info)
if(info/=0) then
info=4010
ch_err='psb_spinfo'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if (debug) write(0,*)me,': out spinfo',nztota
nrow_a = psb_get_local_rows(desc_a)
nztota = psb_get_nnzeros(a)
nztotb = psb_get_nnzeros(blck)
if (debug) write(0,*)me,': out get_nnzeros',nztota
if (debug) call psb_barrier(ictxt)
n_col = desc_a%matrix_data(psb_n_col_)
n_col = psb_get_local_cols(desc_a)
nhalo = n_col-nrow_a
n_row = p%desc_data%matrix_data(psb_n_row_)
p%av(l_pr_)%m = n_row
@ -240,8 +230,8 @@ subroutine psb_zilu_bld(a,desc_a,p,upd,info)
! Here we allocate a full copy to hold local A and received BLK
!
call psb_spinfo(psb_nztotreq_,a,nztota,info)
call psb_spinfo(psb_nztotreq_,blck,nztotb,info)
nztota = psb_get_nnzeros(a)
nztotb = psb_get_nnzeros(blck)
call psb_sp_all(atmp,nztota+nztotb,info)
if(info/=0) then
info=4011

2
src/prec/psb_zprecbld.f90
Unescape Escape View File

@ -100,7 +100,7 @@ subroutine psb_zprecbld(a,desc_a,p,info,upd)
if (debug) write(0,*) 'Entering precbld',P%prec,desc_a%matrix_data(:)
info = 0
int_err(1) = 0
ictxt = desc_a%matrix_data(psb_ctxt_)
ictxt = psb_get_context(desc_a)
if (debug) write(0,*) 'Preconditioner psb_info'
call psb_info(ictxt, me, np)

8
src/prec/psb_zslu_bld.f90
Unescape Escape View File

@ -165,13 +165,7 @@ subroutine psb_zslu_bld(a,desc_a,p,info)
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_spinfo(psb_nztotreq_,atmp,nzt,info)
if(info /= 0) then
info=4010
ch_err='psb_spinfo'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
nzt = psb_get_nnzeros(atmp)
if (Debug) then
write(0,*) me,'Calling psb_slu_factor ',nzt,atmp%m,&
& atmp%k,p%desc_data%matrix_data(psb_n_row_)

4
src/prec/psb_zsp_renum.f90
Unescape Escape View File

@ -68,7 +68,7 @@ subroutine psb_zsp_renum(a,desc_a,blck,p,atmp,info)
name='apply_renum'
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
!!!!!!!!!!!!!!!! CHANGE FOR NON-CSR A
@ -84,7 +84,7 @@ subroutine psb_zsp_renum(a,desc_a,blck,p,atmp,info)
atmp%descra = 'GUN'
! This is the renumbering coherent with global indices..
mglob = desc_a%matrix_data(psb_m_)
mglob = psb_get_global_rows(desc_a)
!
! Remember: we have switched IA1=COLS and IA2=ROWS
! Now identify the set of distinct local column indices

13
src/prec/psb_zumf_bld.f90
Unescape Escape View File

@ -97,7 +97,8 @@ subroutine psb_zumf_bld(a,desc_a,p,info)
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_spinfo(psb_nztotreq_,atmp,nza,info)
nza = psb_get_nnzeros(atmp)
nzb = psb_get_nnzeros(a)
if (Debug) then
write(0,*) me, 'UMFBLD: Done csdp',info,nza,atmp%m,atmp%k,nzb
call psb_barrier(ictxt)
@ -111,7 +112,7 @@ subroutine psb_zumf_bld(a,desc_a,p,info)
goto 9999
end if
call psb_spinfo(psb_nztotreq_,blck,nzb,info)
nzb = psb_get_nnzeros(blck)
if (Debug) then
write(0,*) me, 'UMFBLD: Done asmatbld',info,nzb,blck%fida
call psb_barrier(ictxt)
@ -164,13 +165,7 @@ subroutine psb_zumf_bld(a,desc_a,p,info)
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_spinfo(psb_nztotreq_,atmp,nzt,info)
if(info /= 0) then
info=4010
ch_err='psb_spinfo'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
nzt = psb_get_nnzeros(atmp)
if (Debug) then
write(0,*) me,'Calling psb_umf_factor ',nzt,atmp%m,&
& atmp%k,p%desc_data%matrix_data(psb_n_row_)

148
src/psblas/psb_chkglobvect.f90
Unescape Escape View File

@ -1,148 +0,0 @@
!!$
!!$ Parallel Sparse BLAS v2.0
!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari University of Rome Tor Vergata
!!$
!!$ Redistribution and use in source and binary forms, with or without
!!$ modification, are permitted provided that the following conditions
!!$ are met:
!!$ 1. Redistributions of source code must retain the above copyright
!!$ notice, this list of conditions and the following disclaimer.
!!$ 2. Redistributions in binary form must reproduce the above copyright
!!$ notice, this list of conditions, and the following disclaimer in the
!!$ documentation and/or other materials provided with the distribution.
!!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission.
!!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
! File: psb_chkglobvect.f90
!
! Subroutine: psb_chkglobvect
! psb_chkglobvect checks the validity of a descriptor vector desc_dec, the
! related global indexes ix, jx and the leading dimension lldx.
! If an inconsistency is found among its parameters ix, jx,
! descdec and lldx, the routine returns an error code in info.
!
! Parameters:
! m - integer. The number of rows of the dense matrix X being operated on.
! n - integer. The number of columns of the dense matrix X being operated on.
! lldx - integer. The leading dimension of the local dense matrix X.
! ix - integer. X's global row index, which points to the beginning
! of the dense submatrix which is to be operated on.
! jx - integer. X's global column index, which points to the beginning
! of the dense submatrix which is to be operated on.
! desc_dec - integer,dimension(:). Is the matrix_data array.
! info - integer. Eventually returns an error code.
!
subroutine psb_chkglobvect( m, n, lldx, ix, jx, desc_dec, info)
use psb_error_mod
implicit none
integer, intent(in) :: m,n,ix,jx,lldx
integer, intent(in) :: desc_dec(:)
integer, intent(out) :: info
! locals
integer :: err_act, int_err(5)
character(len=20) :: name, ch_err
if(psb_get_errstatus().ne.0) return
info=0
name='psb_chkglobvect'
call psb_erractionsave(err_act)
if (m.lt.0) then
info=10
int_err(1) = 1
int_err(2) = m
else if (n.lt.0) then
info=10
int_err(1) = 3
int_err(2) = n
else if ((ix.lt.1) .and. (m.ne.0)) then
info=20
int_err(1) = 4
int_err(2) = ix
else if ((jx.lt.1) .and. (n.ne.0)) then
info=20
int_err(1) = 5
int_err(2) = jx
else if (desc_dec(psb_n_col_).lt.0) then
info=40
int_err(1) = 6
int_err(2) = psb_n_col_
int_err(3) = desc_dec(psb_n_col_)
else if (desc_dec(psb_n_row_).lt.0) then
info=40
int_err(1) = 6
int_err(2) = psb_n_row_
int_err(3) = desc_dec(psb_n_row_)
else if (lldx.lt.desc_dec(m_)) then
info=50
int_err(1) = 3
int_err(2) = lldx
int_err(3) = 6
int_err(4) = psb_n_col_
int_err(5) = desc_dec(psb_n_col_)
else if (desc_dec(psb_n_).lt.m) then
info=60
int_err(1) = 1
int_err(2) = m
int_err(3) = 6
int_err(4) = psb_n_
int_err(5) = desc_dec(psb_n_)
else if (desc_dec(psb_n_).lt.ix) then
info=60
int_err(1) = 4
int_err(2) = ix
int_err(3) = 6
int_err(4) = psb_n_
int_err(5) = desc_dec(psb_n_)
else if (desc_dec(psb_m_).lt.jx) then
info=60
int_err(1) = 5
int_err(2) = jx
int_err(3) = 6
int_err(4) = psb_m_
int_err(5) = desc_dec(psb_m_)
else if (desc_dec(psb_n_).lt.(ix+m-1)) then
info=80
int_err(1) = 1
int_err(2) = m
int_err(3) = 4
int_err(4) = ix
end if
if (info.ne.0) then
call psb_errpush(info,name,i_err=int_err)
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error()
return
end if
return
end subroutine psb_chkglobvect

169
src/psblas/psb_chkmat.f90
Unescape Escape View File

@ -1,169 +0,0 @@
!!$
!!$ Parallel Sparse BLAS v2.0
!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari University of Rome Tor Vergata
!!$
!!$ Redistribution and use in source and binary forms, with or without
!!$ modification, are permitted provided that the following conditions
!!$ are met:
!!$ 1. Redistributions of source code must retain the above copyright
!!$ notice, this list of conditions and the following disclaimer.
!!$ 2. Redistributions in binary form must reproduce the above copyright
!!$ notice, this list of conditions, and the following disclaimer in the
!!$ documentation and/or other materials provided with the distribution.
!!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission.
!!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
! File: psb_chkmat.f90
! File: psb_chkmat.f90
!
! Subroutine: psb_chkmat
! pbmatvect checks the validity of a descriptor vector DESCDEC, the
! related global indexes IA, JA. It also computes the starting local
! indexes (IIA,JJA) corresponding to the submatrix starting globally at
! the entry pointed by (IA,JA). Finally, if an inconsitency is found among
! its parameters ia, ja and desc_A, the routine returns an error code in
! info.
!
! Parameters:
! m - integer. The number of rows of the matrix being operated on.
! n - integer. The number of columns of the matrix being operated on.
! ia - integer. a's global row index, which points to the beginning
! of the submatrix which is to be operated on.
! ja - integer. a's global column index, which points to the beginning
! of the submatrix which is to be operated on.
! desc_dec - integer,dimension(:). Is the matrix_data array.
! info - integer. Eventually returns an error code.
! iia - integer(optional). The local rows starting index of the submatrix.
! jja - integer(optional). The local columns starting index of the submatrix.
!
subroutine psb_chkmat( m, n, ia, ja, desc_dec, info, iia, jja)
use psb_error_mod
implicit none
integer, intent(in) :: m,n,ia,ja
integer, intent(in) :: desc_dec(:)
integer, intent(out) :: info
integer, optional :: iia, jja
! locals
integer :: err_act, int_err(5)
character(len=20) :: name, ch_err
if(psb_get_errstatus().ne.0) return
info=0
name='psb_chkmat'
call psb_erractionsave(err_act)
if (m.lt.0) then
info=10
int_err(1) = 1
int_err(2) = m
else if (n.lt.0) then
info=10
int_err(1) = 3
int_err(2) = n
else if ((ix.lt.1) .and. (m.ne.0)) then
info=20
int_err(1) = 4
int_err(2) = ix
else if ((jx.lt.1) .and. (n.ne.0)) then
info=20
int_err(1) = 5
int_err(2) = jx
else if (desc_dec(psb_n_col_).lt.0) then
info=40
int_err(1) = 6
int_err(2) = psb_n_col_
int_err(3) = desc_dec(psb_n_col_)
else if (desc_dec(psb_n_row_).lt.0) then
info=40
int_err(1) = 6
int_err(2) = psb_n_row_
int_err(3) = desc_dec(psb_n_row_)
else if (desc_dec(psb_m_).lt.m) then
info=60
int_err(1) = 1
int_err(2) = m
int_err(3) = 5
int_err(4) = psb_m_
int_err(5) = desc_dec(psb_m_)
else if (desc_dec(psb_n_).lt.m) then
info=60
int_err(1) = 2
int_err(2) = n
int_err(3) = 5
int_err(4) = psb_n_
int_err(5) = desc_dec(psb_n_)
else if (desc_dec(psb_m_).lt.ia) then
info=60
int_err(1) = 3
int_err(2) = ia
int_err(3) = 5
int_err(4) = psb_m_
int_err(5) = desc_dec(psb_m_)
else if (desc_dec(psb_n_).lt.ja) then
info=60
int_err(1) = 4
int_err(2) = ja
int_err(3) = 5
int_err(4) = psb_n_
int_err(5) = desc_dec(psb_n_)
else if (desc_dec(psb_m_).lt.(ia+m-1)) then
info=80
int_err(1) = 1
int_err(2) = m
int_err(3) = 3
int_err(4) = ia
else if (desc_dec(psb_n_).lt.(ja+n-1)) then
info=80
int_err(1) = 2
int_err(2) = n
int_err(3) = 4
int_err(4) = ja
end if
if (info.ne.0) then
call psb_errpush(info,name,i_err=int_err)
goto 9999
end if
! Compute local indices for submatrix starting
! at global indices ix and jx
if(present(iia).and.present(jja)) then
if (desc_dec(psb_n_row_).gt.0) then
iia=1
jja=1
else
iia=desc_dec(psb_n_row_)+1
jja=desc_dec(psb_n_col_)+1
end if
end if
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error()
return
end if
return
end subroutine psb_chkmat

157
src/psblas/psb_chkvect.f90
Unescape Escape View File

@ -1,157 +0,0 @@
!!$
!!$ Parallel Sparse BLAS v2.0
!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari University of Rome Tor Vergata
!!$
!!$ Redistribution and use in source and binary forms, with or without
!!$ modification, are permitted provided that the following conditions
!!$ are met:
!!$ 1. Redistributions of source code must retain the above copyright
!!$ notice, this list of conditions and the following disclaimer.
!!$ 2. Redistributions in binary form must reproduce the above copyright
!!$ notice, this list of conditions, and the following disclaimer in the
!!$ documentation and/or other materials provided with the distribution.
!!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission.
!!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
! File: psb_chkvect.f90
!
! Subroutine: psb_chkvect
! psb_chkvect checks the validity of a descriptor vector desc_dec, the
! related global indexes ix, jx and the leading dimension lldx. It also
! eventually computes the starting local indexes (iix,jjx) corresponding
! to the submatrix starting globally at the entry pointed by (ix,jx).
! Finally, if an inconsistency is found among its parameters ix, jx,
! descdec and lldx, the routine returns an error code in info.
!
! Parameters:
! m - integer. The number of rows of the dense matrix X being operated on.
! n - integer. The number of columns of the dense matrix X being operated on.
! lldx - integer. The leading dimension of the local dense matrix X.
! ix - integer. X's global row index, which points to the beginning
! of the dense submatrix which is to be operated on.
! jx - integer. X's global column index, which points to the beginning
! of the dense submatrix which is to be operated on.
! desc_dec - integer,dimension(:). Is the matrix_data array.
! info - integer. Eventually returns an error code.
! iix - integer(optional). The local rows starting index of the submatrix.
! jjx - integer(optional). The local columns starting index of the submatrix.
subroutine psb_chkvect( m, n, lldx, ix, jx, desc_dec, info, iix, jjx)
use psb_error_mod
implicit none
integer, intent(in) :: m,n,ix,jx,lldx
integer, intent(in) :: desc_dec(:)
integer, intent(out) :: info
integer, optional :: iix, jjx
! locals
integer :: err_act, int_err(5)
character(len=20) :: name, ch_err
if(psb_get_errstatus().ne.0) return
info=0
name='psb_chkvect'
call psb_erractionsave(err_act)
if (m.lt.0) then
info=10
int_err(1) = 1
int_err(2) = m
else if (n.lt.0) then
info=10
int_err(1) = 3
int_err(2) = n
else if ((ix.lt.1) .and. (m.ne.0)) then
info=20
int_err(1) = 4
int_err(2) = ix
else if ((jx.lt.1) .and. (n.ne.0)) then
info=20
int_err(1) = 5
int_err(2) = jx
else if (desc_dec(psb_n_col_).lt.0) then
info=40
int_err(1) = 6
int_err(2) = psb_n_col_
int_err(3) = desc_dec(psb_n_col_)
else if (desc_dec(psb_n_row_).lt.0) then
info=40
int_err(1) = 6
int_err(2) = psb_n_row_
int_err(3) = desc_dec(psb_n_row_)
else if (lldx.lt.desc_dec(psb_n_col_)) then
info=50
int_err(1) = 3
int_err(2) = lldx
int_err(3) = 6
int_err(4) = psb_n_col_
int_err(5) = desc_dec(psb_n_col_)
else if (desc_dec(psb_n_).lt.m) then
info=60
int_err(1) = 1
int_err(2) = m
int_err(3) = 6
int_err(4) = psb_n_
int_err(5) = desc_dec(psb_n_)
else if (desc_dec(psb_n_).lt.ix) then
info=60
int_err(1) = 4
int_err(2) = ix
int_err(3) = 6
int_err(4) = psb_n_
int_err(5) = desc_dec(psb_n_)
else if (desc_dec(psb_m_).lt.jx) then
info=60
int_err(1) = 5
int_err(2) = jx
int_err(3) = 6
int_err(4) = psb_m_
int_err(5) = desc_dec(psb_m_)
else if (desc_dec(psb_n_).lt.(ix+m-1)) then
info=80
int_err(1) = 1
int_err(2) = m
int_err(3) = 4
int_err(4) = ix
end if
if (info.ne.0) then
call psb_errpush(info,name,i_err=int_err)
goto 9999
end if
! Compute local indices for submatrix starting
! at global indices ix and jx
if(present(iix)) iix=ix ! (for our applications iix=ix))
if(present(jjx)) jjx=jx ! (for our applications jjx=jx))
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error()
return
end if
return
end subroutine psb_chkvect

40
src/psblas/psb_damax.f90
Unescape Escape View File

@ -70,7 +70,7 @@ function psb_damax (x,desc_a, info, jx)
amax=0.d0
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -1) then
@ -86,9 +86,9 @@ function psb_damax (x,desc_a, info, jx)
ijx = 1
endif
m = desc_a%matrix_data(psb_m_)
m = psb_get_global_rows(desc_a)
call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@ -103,8 +103,8 @@ function psb_damax (x,desc_a, info, jx)
end if
! compute local max
if ((desc_a%matrix_data(psb_n_row_).gt.0).and.(m.ne.0)) then
imax=idamax(desc_a%matrix_data(psb_n_row_)-iix+1,x(iix,jjx),1)
if ((psb_get_local_rows(desc_a).gt.0).and.(m.ne.0)) then
imax=idamax(psb_get_local_rows(desc_a)-iix+1,x(iix,jjx),1)
amax=abs(x(iix+imax-1,jjx))
end if
@ -195,7 +195,7 @@ function psb_damaxv (x,desc_a, info)
amax=0.d0
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -1) then
@ -207,9 +207,9 @@ function psb_damaxv (x,desc_a, info)
ix = 1
jx = 1
m = desc_a%matrix_data(psb_m_)
m = psb_get_global_rows(desc_a)
call psb_chkvect(m,1,size(x,1),ix,jx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,1,size(x,1),ix,jx,desc_a,info,iix,jjx)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@ -224,8 +224,8 @@ function psb_damaxv (x,desc_a, info)
end if
! compute local max
if ((desc_a%matrix_data(psb_n_row_).gt.0).and.(m.ne.0)) then
imax=idamax(desc_a%matrix_data(psb_n_row_)-iix+1,x(iix),1)
if ((psb_get_local_rows(desc_a).gt.0).and.(m.ne.0)) then
imax=idamax(psb_get_local_rows(desc_a)-iix+1,x(iix),1)
amax=abs(x(iix+imax-1))
end if
@ -318,7 +318,7 @@ subroutine psb_damaxvs (res,x,desc_a, info)
amax=0.d0
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -1) then
@ -330,9 +330,9 @@ subroutine psb_damaxvs (res,x,desc_a, info)
ix = 1
ijx=1
m = desc_a%matrix_data(psb_m_)
m = psb_get_global_rows(desc_a)
call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@ -347,8 +347,8 @@ subroutine psb_damaxvs (res,x,desc_a, info)
end if
! compute local max
if ((desc_a%matrix_data(psb_n_row_).gt.0).and.(m.ne.0)) then
imax=idamax(desc_a%matrix_data(psb_n_row_)-iix+1,x(iix),1)
if ((psb_get_local_rows(desc_a).gt.0).and.(m.ne.0)) then
imax=idamax(psb_get_local_rows(desc_a)-iix+1,x(iix),1)
amax=abs(x(iix+imax-1))
end if
@ -440,7 +440,7 @@ subroutine psb_dmamaxs (res,x,desc_a, info,jx)
amax=0.d0
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -1) then
@ -456,10 +456,10 @@ subroutine psb_dmamaxs (res,x,desc_a, info,jx)
ijx = 1
endif
m = desc_a%matrix_data(psb_m_)
m = psb_get_global_rows(desc_a)
k = min(size(x,2),size(res,1))
call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@ -474,9 +474,9 @@ subroutine psb_dmamaxs (res,x,desc_a, info,jx)
end if
! compute local max
if ((desc_a%matrix_data(psb_n_row_).gt.0).and.(m.ne.0)) then
if ((psb_get_local_rows(desc_a).gt.0).and.(m.ne.0)) then
do i=1,k
imax=idamax(desc_a%matrix_data(psb_n_row_)-iix+1,x(iix,jjx+i-1),1)
imax=idamax(psb_get_local_rows(desc_a)-iix+1,x(iix,jjx+i-1),1)
res(i)=abs(x(iix+imax-1,jjx+i-1))
end do
end if

30
src/psblas/psb_dasum.f90
Unescape Escape View File

@ -71,7 +71,7 @@ function psb_dasum (x,desc_a, info, jx)
asum=0.d0
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -1) then
@ -87,10 +87,10 @@ function psb_dasum (x,desc_a, info, jx)
ijx = 1
endif
m = desc_a%matrix_data(psb_m_)
m = psb_get_global_rows(desc_a)
! check vector correctness
call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@ -106,8 +106,8 @@ function psb_dasum (x,desc_a, info, jx)
! compute local max
if ((m.ne.0)) then
if(desc_a%matrix_data(psb_n_row_).gt.0) then
asum=dasum(desc_a%matrix_data(psb_n_row_)-iix+1,x(iix,jjx),ione)
if(psb_get_local_rows(desc_a).gt.0) then
asum=dasum(psb_get_local_rows(desc_a)-iix+1,x(iix,jjx),ione)
! adjust asum because overlapped elements are computed more than once
i=1
@ -213,7 +213,7 @@ function psb_dasumv (x,desc_a, info)
asum=0.d0
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -1) then
@ -225,10 +225,10 @@ function psb_dasumv (x,desc_a, info)
ix = 1
jx=1
m = desc_a%matrix_data(psb_m_)
m = psb_get_global_rows(desc_a)
! check vector correctness
call psb_chkvect(m,1,size(x),ix,jx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,1,size(x),ix,jx,desc_a,info,iix,jjx)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@ -244,8 +244,8 @@ function psb_dasumv (x,desc_a, info)
! compute local max
if ((m.ne.0)) then
if(desc_a%matrix_data(psb_n_row_).gt.0) then
asum=dasum(desc_a%matrix_data(psb_n_row_),x,ione)
if(psb_get_local_rows(desc_a).gt.0) then
asum=dasum(psb_get_local_rows(desc_a),x,ione)
! adjust asum because overlapped elements are computed more than once
i=1
@ -351,7 +351,7 @@ subroutine psb_dasumvs (res,x,desc_a, info)
asum=0.d0
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -1) then
@ -363,10 +363,10 @@ subroutine psb_dasumvs (res,x,desc_a, info)
ix = 1
jx = 1
m = desc_a%matrix_data(psb_m_)
m = psb_get_global_rows(desc_a)
! check vector correctness
call psb_chkvect(m,1,size(x),ix,jx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,1,size(x),ix,jx,desc_a,info,iix,jjx)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@ -382,8 +382,8 @@ subroutine psb_dasumvs (res,x,desc_a, info)
! compute local max
if ((m.ne.0)) then
if(desc_a%matrix_data(psb_n_row_).gt.0) then
asum=dasum(desc_a%matrix_data(psb_n_row_),x,ione)
if(psb_get_local_rows(desc_a).gt.0) then
asum=dasum(psb_get_local_rows(desc_a),x,ione)
! adjust asum because overlapped elements are computed more than once
i=1

25
src/psblas/psb_daxpby.f90
Unescape Escape View File

@ -75,7 +75,7 @@ subroutine psb_daxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -ione) then
@ -115,11 +115,12 @@ subroutine psb_daxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
goto 9999
end if
m = desc_a%matrix_data(psb_m_)
m = psb_get_global_rows(desc_a)
! check vector correctness
call psb_chkvect(m,ione,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,ione,size(y,1),iy,ijy,desc_a%matrix_data,info,iiy,jjy)
call psb_chkvect(m,ione,size(x,1),ix,ijx,desc_a,info,iix,jjx)
if (info == 0) &
& call psb_chkvect(m,ione,size(y,1),iy,ijy,desc_a,info,iiy,jjy)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@ -134,8 +135,8 @@ subroutine psb_daxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
end if
if ((in.ne.0)) then
if(desc_a%matrix_data(psb_n_row_).gt.0) then
call daxpby(desc_a%matrix_data(psb_n_row_),in,&
if(psb_get_local_rows(desc_a).gt.0) then
call daxpby(psb_get_local_rows(desc_a),in,&
& alpha,x(iix,jjx),size(x,1),beta,&
& y(iiy,jjy),size(y,1),info)
end if
@ -227,7 +228,7 @@ subroutine psb_daxpbyv(alpha, x, beta,y,desc_a,info)
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -ione) then
@ -239,17 +240,17 @@ subroutine psb_daxpbyv(alpha, x, beta,y,desc_a,info)
ix = ione
iy = ione
m = desc_a%matrix_data(psb_m_)
m = psb_get_global_rows(desc_a)
! check vector correctness
call psb_chkvect(m,ione,size(x),ix,ione,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,ione,size(x),ix,ione,desc_a,info,iix,jjx)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect 1'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_chkvect(m,ione,size(y),iy,ione,desc_a%matrix_data,info,iiy,jjy)
call psb_chkvect(m,ione,size(y),iy,ione,desc_a,info,iiy,jjy)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect 2'
@ -262,8 +263,8 @@ subroutine psb_daxpbyv(alpha, x, beta,y,desc_a,info)
call psb_errpush(info,name)
end if
if(desc_a%matrix_data(psb_n_row_).gt.0) then
call daxpby(desc_a%matrix_data(psb_n_row_),ione,&
if(psb_get_local_rows(desc_a).gt.0) then
call daxpby(psb_get_local_rows(desc_a),ione,&
& alpha,x,size(x),beta,&
& y,size(y),info)
end if

66
src/psblas/psb_ddot.f90
Unescape Escape View File

@ -72,7 +72,7 @@ function psb_ddot(x, y,desc_a, info, jx, jy)
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -ione) then
@ -101,11 +101,12 @@ function psb_ddot(x, y,desc_a, info, jx, jy)
goto 9999
end if
m = desc_a%matrix_data(psb_m_)
m = psb_get_global_rows(desc_a)
! check vector correctness
call psb_chkvect(m,ione,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,ione,size(y,1),iy,ijy,desc_a%matrix_data,info,iiy,jjy)
call psb_chkvect(m,ione,size(x,1),ix,ijx,desc_a,info,iix,jjx)
if (info == 0) &
& call psb_chkvect(m,ione,size(y,1),iy,ijy,desc_a,info,iiy,jjy)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@ -120,8 +121,8 @@ function psb_ddot(x, y,desc_a, info, jx, jy)
end if
if(m.ne.0) then
if(desc_a%matrix_data(psb_n_row_).gt.0) then
dot_local = ddot(desc_a%matrix_data(psb_n_row_),&
if(psb_get_local_rows(desc_a).gt.0) then
dot_local = ddot(psb_get_local_rows(desc_a),&
& x(iix,jjx),ione,y(iiy,jjy),ione)
! adjust dot_local because overlapped elements are computed more than once
i=1
@ -225,7 +226,7 @@ function psb_ddotv(x, y,desc_a, info)
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -ione) then
@ -238,11 +239,12 @@ function psb_ddotv(x, y,desc_a, info)
iy = ione
jx = ione
jy = ione
m = desc_a%matrix_data(psb_m_)
m = psb_get_global_rows(desc_a)
! check vector correctness
call psb_chkvect(m,ione,size(x,1),ix,jx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,ione,size(y,1),iy,jy,desc_a%matrix_data,info,iiy,jjy)
call psb_chkvect(m,ione,size(x,1),ix,jx,desc_a,info,iix,jjx)
if (info == 0) &
& call psb_chkvect(m,ione,size(y,1),iy,jy,desc_a,info,iiy,jjy)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@ -257,8 +259,8 @@ function psb_ddotv(x, y,desc_a, info)
end if
if(m.ne.0) then
if(desc_a%matrix_data(psb_n_row_).gt.0) then
dot_local = ddot(desc_a%matrix_data(psb_n_row_),&
if(psb_get_local_rows(desc_a).gt.0) then
dot_local = ddot(psb_get_local_rows(desc_a),&
& x,ione,y,ione)
! adjust dot_local because overlapped elements are computed more than once
i=1
@ -362,7 +364,7 @@ subroutine psb_ddotvs(res, x, y,desc_a, info)
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -ione) then
@ -373,11 +375,12 @@ subroutine psb_ddotvs(res, x, y,desc_a, info)
ix = ione
iy = ione
m = desc_a%matrix_data(psb_m_)
m = psb_get_global_rows(desc_a)
! check vector correctness
call psb_chkvect(m,ione,size(x,1),ix,ix,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,ione,size(y,1),iy,iy,desc_a%matrix_data,info,iiy,jjy)
call psb_chkvect(m,ione,size(x,1),ix,ix,desc_a,info,iix,jjx)
if (info == 0) &
& call psb_chkvect(m,ione,size(y,1),iy,iy,desc_a,info,iiy,jjy)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@ -392,8 +395,8 @@ subroutine psb_ddotvs(res, x, y,desc_a, info)
end if
if(m.ne.0) then
if(desc_a%matrix_data(psb_n_row_).gt.0) then
dot_local = ddot(desc_a%matrix_data(psb_n_row_),&
if(psb_get_local_rows(desc_a).gt.0) then
dot_local = ddot(psb_get_local_rows(desc_a),&
& x,ione,y,ione)
! adjust dot_local because overlapped elements are computed more than once
i=1
@ -502,7 +505,7 @@ subroutine psb_dmdots(res, x, y, desc_a, info)
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -ione) then
@ -514,17 +517,17 @@ subroutine psb_dmdots(res, x, y, desc_a, info)
ix = ione
iy = ione
m = desc_a%matrix_data(psb_m_)
m = psb_get_global_rows(desc_a)
! check vector correctness
call psb_chkvect(m,ione,size(x,1),ix,ix,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,ione,size(x,1),ix,ix,desc_a,info,iix,jjx)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_chkvect(m,ione,size(y,1),iy,iy,desc_a%matrix_data,info,iiy,jjy)
call psb_chkvect(m,ione,size(y,1),iy,iy,desc_a,info,iiy,jjy)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@ -542,9 +545,9 @@ subroutine psb_dmdots(res, x, y, desc_a, info)
allocate(dot_local(k))
if(m.ne.0) then
if(desc_a%matrix_data(psb_n_row_).gt.0) then
if(psb_get_local_rows(desc_a).gt.0) then
do j=1,k
dot_local(j) = ddot(desc_a%matrix_data(psb_n_row_),&
dot_local(j) = ddot(psb_get_local_rows(desc_a),&
& x(1,j),ione,y(1,j),ione)
! adjust dot_local because overlapped elements are computed more than once
i=1
@ -608,7 +611,7 @@ subroutine psb_ddot2v(res, x, y,w,z,desc_a, info)
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -ione) then
@ -619,11 +622,12 @@ subroutine psb_ddot2v(res, x, y,w,z,desc_a, info)
ix = ione
iy = ione
m = desc_a%matrix_data(psb_m_)
m = psb_get_global_rows(desc_a)
! check vector correctness
call psb_chkvect(m,ione,size(x,1),ix,ix,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,ione,size(y,1),iy,iy,desc_a%matrix_data,info,iiy,jjy)
call psb_chkvect(m,ione,size(x,1),ix,ix,desc_a,info,iix,jjx)
if (info == 0) &
& call psb_chkvect(m,ione,size(y,1),iy,iy,desc_a,info,iiy,jjy)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@ -638,10 +642,10 @@ subroutine psb_ddot2v(res, x, y,w,z,desc_a, info)
end if
if(m.ne.0) then
if(desc_a%matrix_data(psb_n_row_).gt.0) then
dot_local(1) = ddot(desc_a%matrix_data(psb_n_row_),&
if(psb_get_local_rows(desc_a).gt.0) then
dot_local(1) = ddot(psb_get_local_rows(desc_a),&
& x,ione,y,ione)
dot_local(2) = ddot(desc_a%matrix_data(psb_n_row_),&
dot_local(2) = ddot(psb_get_local_rows(desc_a),&
& w,ione,z,ione)
! adjust dot_local because overlapped elements are computed more than once
i=1

30
src/psblas/psb_dnrm2.f90
Unescape Escape View File

@ -68,7 +68,7 @@ function psb_dnrm2(x, desc_a, info, jx)
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -1) then
@ -84,9 +84,9 @@ function psb_dnrm2(x, desc_a, info, jx)
ijx = 1
endif
m = desc_a%matrix_data(psb_m_)
m = psb_get_global_rows(desc_a)
call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@ -100,8 +100,8 @@ function psb_dnrm2(x, desc_a, info, jx)
end if
if(m.ne.0) then
if (desc_a%matrix_data(psb_n_row_) .gt. 0) then
ndim = desc_a%matrix_data(psb_n_row_)
if (psb_get_local_rows(desc_a) .gt. 0) then
ndim = psb_get_local_rows(desc_a)
nrm2 = dnrm2( ndim, x(iix,jjx), ione )
i=1
do while (desc_a%ovrlap_elem(i) .ne. -1)
@ -205,7 +205,7 @@ function psb_dnrm2v(x, desc_a, info)
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -1) then
@ -217,10 +217,10 @@ function psb_dnrm2v(x, desc_a, info)
ix = 1
jx=1
m = desc_a%matrix_data(psb_m_)
m = psb_get_global_rows(desc_a)
call psb_chkvect(m,1,size(x),ix,jx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,1,size(x),ix,jx,desc_a,info,iix,jjx)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@ -234,8 +234,8 @@ function psb_dnrm2v(x, desc_a, info)
end if
if(m.ne.0) then
if (desc_a%matrix_data(psb_n_row_) .gt. 0) then
ndim = desc_a%matrix_data(psb_n_row_)
if (psb_get_local_rows(desc_a) .gt. 0) then
ndim = psb_get_local_rows(desc_a)
nrm2 = dnrm2( ndim, x, ione )
i=1
do while (desc_a%ovrlap_elem(i) .ne. -1)
@ -341,7 +341,7 @@ subroutine psb_dnrm2vs(res, x, desc_a, info)
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -1) then
@ -352,9 +352,9 @@ subroutine psb_dnrm2vs(res, x, desc_a, info)
ix = 1
jx = 1
m = desc_a%matrix_data(psb_m_)
m = psb_get_global_rows(desc_a)
call psb_chkvect(m,1,size(x),ix,jx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,1,size(x),ix,jx,desc_a,info,iix,jjx)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@ -368,8 +368,8 @@ subroutine psb_dnrm2vs(res, x, desc_a, info)
end if
if(m.ne.0) then
if (desc_a%matrix_data(psb_n_row_) .gt. 0) then
ndim = desc_a%matrix_data(psb_n_row_)
if (psb_get_local_rows(desc_a) .gt. 0) then
ndim = psb_get_local_rows(desc_a)
nrm2 = dnrm2( ndim, x, ione )
i=1
do while (desc_a%ovrlap_elem(i) .ne. -1)

12
src/psblas/psb_dnrmi.f90
Unescape Escape View File

@ -64,7 +64,7 @@ function psb_dnrmi(a,desc_a,info)
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -1) then
@ -75,10 +75,10 @@ function psb_dnrmi(a,desc_a,info)
ia = 1
ja = 1
m = desc_a%matrix_data(psb_m_)
n = desc_a%matrix_data(psb_n_)
m = psb_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a)
call psb_chkmat(m,n,ia,ja,desc_a%matrix_data,info,iia,jja)
call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja)
if(info.ne.0) then
info=4010
ch_err='psb_chkmat'
@ -93,8 +93,8 @@ function psb_dnrmi(a,desc_a,info)
end if
if ((m.ne.0).and.(n.ne.0)) then
mdim = desc_a%matrix_data(psb_n_row_)
ndim = desc_a%matrix_data(psb_n_col_)
mdim = psb_get_local_rows(desc_a)
ndim = psb_get_local_cols(desc_a)
nrmi = dcsnmi('N',mdim,ndim,a%fida,&
& a%descra,a%aspk,a%ia1,a%ia2,&
& a%infoa,info)

44
src/psblas/psb_dspmm.f90
Unescape Escape View File

@ -117,7 +117,7 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -1) then
@ -172,10 +172,10 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
itrans = 'N'
endif
m = desc_a%matrix_data(psb_m_)
n = desc_a%matrix_data(psb_n_)
nrow = desc_a%matrix_data(psb_n_row_)
ncol = desc_a%matrix_data(psb_n_col_)
m = psb_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a)
nrow = psb_get_local_rows(desc_a)
ncol = psb_get_local_cols(desc_a)
lldx = size(x,1)
lldy = size(y,1)
@ -208,7 +208,7 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
iwork(1)=dzero
! checking for matrix correctness
call psb_chkmat(m,n,ia,ja,desc_a%matrix_data,info,iia,jja)
call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja)
if(info /= 0) then
info=4010
ch_err='psb_chkmat'
@ -227,8 +227,9 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
end if
! checking for vectors correctness
call psb_chkvect(n,ik,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,ik,size(y,1),iy,ijy,desc_a%matrix_data,info,iiy,jjy)
call psb_chkvect(n,ik,size(x,1),ix,ijx,desc_a,info,iix,jjx)
if (info == 0) &
& call psb_chkvect(m,ik,size(y,1),iy,ijy,desc_a,info,iiy,jjy)
if(info /= 0) then
info=4010
ch_err='psb_chkvect'
@ -296,8 +297,9 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
end if
! checking for vectors correctness
call psb_chkvect(m,ik,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(n,ik,size(y,1),iy,ijy,desc_a%matrix_data,info,iiy,jjy)
call psb_chkvect(m,ik,size(x,1),ix,ijx,desc_a,info,iix,jjx)
if (info == 0) &
& call psb_chkvect(n,ik,size(y,1),iy,ijy,desc_a,info,iiy,jjy)
if(info /= 0) then
info=4010
ch_err='psb_chkvect'
@ -453,7 +455,7 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,&
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -1) then
@ -493,10 +495,10 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,&
itrans = 'N'
endif
m = desc_a%matrix_data(psb_m_)
n = desc_a%matrix_data(psb_n_)
nrow = desc_a%matrix_data(psb_n_row_)
ncol = desc_a%matrix_data(psb_n_col_)
m = psb_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a)
nrow = psb_get_local_rows(desc_a)
ncol = psb_get_local_cols(desc_a)
lldx = size(x)
lldy = size(y)
@ -531,7 +533,7 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,&
if (debug) write(0,*) me,name,' Allocated work ', info
! checking for matrix correctness
call psb_chkmat(m,n,ia,ja,desc_a%matrix_data,info,iia,jja)
call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja)
if(info /= 0) then
info=4010
ch_err='psb_chkmat'
@ -550,8 +552,9 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,&
end if
! checking for vectors correctness
call psb_chkvect(n,ik,size(x),ix,jx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,ik,size(y),iy,jy,desc_a%matrix_data,info,iiy,jjy)
call psb_chkvect(n,ik,size(x),ix,jx,desc_a,info,iix,jjx)
if (info == 0) &
& call psb_chkvect(m,ik,size(y),iy,jy,desc_a,info,iiy,jjy)
if(info /= 0) then
info=4010
ch_err='psb_chkvect'
@ -598,8 +601,9 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,&
end if
! checking for vectors correctness
call psb_chkvect(m,ik,size(x),ix,jx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(n,ik,size(y),iy,jy,desc_a%matrix_data,info,iiy,jjy)
call psb_chkvect(m,ik,size(x),ix,jx,desc_a,info,iix,jjx)
if (info == 0)&
& call psb_chkvect(n,ik,size(y),iy,jy,desc_a,info,iiy,jjy)
if(info /= 0) then
info=4010
ch_err='psb_chkvect'

32
src/psblas/psb_dspsm.f90
Unescape Escape View File

@ -115,7 +115,7 @@ subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,&
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -1) then
@ -174,9 +174,9 @@ subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,&
itrans = 'N'
endif
m = desc_a%matrix_data(psb_m_)
nrow = desc_a%matrix_data(psb_n_row_)
ncol = desc_a%matrix_data(psb_n_col_)
m = psb_get_global_rows(desc_a)
nrow = psb_get_local_rows(desc_a)
ncol = psb_get_local_cols(desc_a)
lldx = size(x,1)
lldy = size(y,1)
@ -225,10 +225,12 @@ subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,&
end if
! checking for matrix correctness
call psb_chkmat(m,m,ia,ja,desc_a%matrix_data,info,iia,jja)
call psb_chkmat(m,m,ia,ja,desc_a,info,iia,jja)
! checking for vectors correctness
call psb_chkvect(m,ik,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,ik,size(y,1),iy,ijy,desc_a%matrix_data,info,iiy,jjy)
if (info == 0) &
& call psb_chkvect(m,ik,size(x,1),ix,ijx,desc_a,info,iix,jjx)
if (info == 0) &
& call psb_chkvect(m,ik,size(y,1),iy,ijy,desc_a,info,iiy,jjy)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect/mat'
@ -417,7 +419,7 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,&
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -1) then
@ -464,9 +466,9 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,&
itrans = 'N'
endif
m = desc_a%matrix_data(psb_m_)
nrow = desc_a%matrix_data(psb_n_row_)
ncol = desc_a%matrix_data(psb_n_col_)
m = psb_get_global_rows(desc_a)
nrow = psb_get_local_rows(desc_a)
ncol = psb_get_local_cols(desc_a)
lldx = size(x)
lldy = size(y)
@ -516,10 +518,12 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,&
end if
! checking for matrix correctness
call psb_chkmat(m,m,ia,ja,desc_a%matrix_data,info,iia,jja)
call psb_chkmat(m,m,ia,ja,desc_a,info,iia,jja)
! checking for vectors correctness
call psb_chkvect(m,ik,size(x),ix,jx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,ik,size(y),iy,jy,desc_a%matrix_data,info,iiy,jjy)
if (info == 0) &
& call psb_chkvect(m,ik,size(x),ix,jx,desc_a,info,iix,jjx)
if (info == 0)&
& call psb_chkvect(m,ik,size(y),iy,jy,desc_a,info,iiy,jjy)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect/mat'

40
src/psblas/psb_zamax.f90
Unescape Escape View File

@ -73,7 +73,7 @@ function psb_zamax (x,desc_a, info, jx)
amax=0.d0
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -1) then
@ -89,9 +89,9 @@ function psb_zamax (x,desc_a, info, jx)
ijx = 1
endif
m = desc_a%matrix_data(psb_m_)
m = psb_get_global_rows(desc_a)
call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@ -106,8 +106,8 @@ function psb_zamax (x,desc_a, info, jx)
end if
! compute local max
if ((desc_a%matrix_data(psb_n_row_).gt.0).and.(m.ne.0)) then
imax=izamax(desc_a%matrix_data(psb_n_row_)-iix+1,x(iix,jjx),1)
if ((psb_get_local_rows(desc_a).gt.0).and.(m.ne.0)) then
imax=izamax(psb_get_local_rows(desc_a)-iix+1,x(iix,jjx),1)
amax=cabs1(x(iix+imax-1,jjx))
end if
@ -202,7 +202,7 @@ function psb_zamaxv (x,desc_a, info)
amax=0.d0
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -1) then
@ -214,9 +214,9 @@ function psb_zamaxv (x,desc_a, info)
ix = 1
jx = 1
m = desc_a%matrix_data(psb_m_)
m = psb_get_global_rows(desc_a)
call psb_chkvect(m,1,size(x,1),ix,jx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,1,size(x,1),ix,jx,desc_a,info,iix,jjx)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@ -231,8 +231,8 @@ function psb_zamaxv (x,desc_a, info)
end if
! compute local max
if ((desc_a%matrix_data(psb_n_row_).gt.0).and.(m.ne.0)) then
imax=izamax(desc_a%matrix_data(psb_n_row_)-iix+1,x(iix),1)
if ((psb_get_local_rows(desc_a).gt.0).and.(m.ne.0)) then
imax=izamax(psb_get_local_rows(desc_a)-iix+1,x(iix),1)
cmax=(x(iix+imax-1))
amax=cabs1(cmax)
end if
@ -330,7 +330,7 @@ subroutine psb_zamaxvs (res,x,desc_a, info)
amax=0.d0
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -1) then
@ -342,9 +342,9 @@ subroutine psb_zamaxvs (res,x,desc_a, info)
ix = 1
ijx=1
m = desc_a%matrix_data(psb_m_)
m = psb_get_global_rows(desc_a)
call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@ -359,8 +359,8 @@ subroutine psb_zamaxvs (res,x,desc_a, info)
end if
! compute local max
if ((desc_a%matrix_data(psb_n_row_).gt.0).and.(m.ne.0)) then
imax=izamax(desc_a%matrix_data(psb_n_row_)-iix+1,x(iix),1)
if ((psb_get_local_rows(desc_a).gt.0).and.(m.ne.0)) then
imax=izamax(psb_get_local_rows(desc_a)-iix+1,x(iix),1)
cmax=(x(iix+imax-1))
amax=cabs1(cmax)
end if
@ -457,7 +457,7 @@ subroutine psb_zmamaxs (res,x,desc_a, info,jx)
amax=0.d0
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -1) then
@ -473,10 +473,10 @@ subroutine psb_zmamaxs (res,x,desc_a, info,jx)
ijx = 1
endif
m = desc_a%matrix_data(psb_m_)
m = psb_get_global_rows(desc_a)
k = min(size(x,2),size(res,1))
call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@ -491,9 +491,9 @@ subroutine psb_zmamaxs (res,x,desc_a, info,jx)
end if
! compute local max
if ((desc_a%matrix_data(psb_n_row_).gt.0).and.(m.ne.0)) then
if ((psb_get_local_rows(desc_a).gt.0).and.(m.ne.0)) then
do i=1,k
imax=izamax(desc_a%matrix_data(psb_n_row_)-iix+1,x(iix,jjx+i-1),1)
imax=izamax(psb_get_local_rows(desc_a)-iix+1,x(iix,jjx+i-1),1)
cmax=(x(iix+imax-1,jjx+i-1))
res(i)=cabs1(cmax)
end do

30
src/psblas/psb_zasum.f90
Unescape Escape View File

@ -75,7 +75,7 @@ function psb_zasum (x,desc_a, info, jx)
asum=0.d0
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -1) then
@ -91,10 +91,10 @@ function psb_zasum (x,desc_a, info, jx)
ijx = 1
endif
m = desc_a%matrix_data(psb_m_)
m = psb_get_global_rows(desc_a)
! check vector correctness
call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@ -110,8 +110,8 @@ function psb_zasum (x,desc_a, info, jx)
! compute local max
if ((m.ne.0)) then
if(desc_a%matrix_data(psb_n_row_).gt.0) then
asum=dzasum(desc_a%matrix_data(psb_n_row_)-iix+1,x(iix,jjx),ione)
if(psb_get_local_rows(desc_a).gt.0) then
asum=dzasum(psb_get_local_rows(desc_a)-iix+1,x(iix,jjx),ione)
! adjust asum because overlapped elements are computed more than once
i=1
@ -223,7 +223,7 @@ function psb_zasumv (x,desc_a, info)
asum=0.d0
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -1) then
@ -235,10 +235,10 @@ function psb_zasumv (x,desc_a, info)
ix = 1
jx=1
m = desc_a%matrix_data(psb_m_)
m = psb_get_global_rows(desc_a)
! check vector correctness
call psb_chkvect(m,1,size(x),ix,jx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,1,size(x),ix,jx,desc_a,info,iix,jjx)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@ -254,8 +254,8 @@ function psb_zasumv (x,desc_a, info)
! compute local max
if ((m.ne.0)) then
if(desc_a%matrix_data(psb_n_row_).gt.0) then
asum=dzasum(desc_a%matrix_data(psb_n_row_),x,ione)
if(psb_get_local_rows(desc_a).gt.0) then
asum=dzasum(psb_get_local_rows(desc_a),x,ione)
! adjust asum because overlapped elements are computed more than once
i=1
@ -367,7 +367,7 @@ subroutine psb_zasumvs (res,x,desc_a, info)
asum=0.d0
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -1) then
@ -379,10 +379,10 @@ subroutine psb_zasumvs (res,x,desc_a, info)
ix = 1
jx = 1
m = desc_a%matrix_data(psb_m_)
m = psb_get_global_rows(desc_a)
! check vector correctness
call psb_chkvect(m,1,size(x),ix,jx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,1,size(x),ix,jx,desc_a,info,iix,jjx)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@ -398,8 +398,8 @@ subroutine psb_zasumvs (res,x,desc_a, info)
! compute local max
if ((m.ne.0)) then
if(desc_a%matrix_data(psb_n_row_).gt.0) then
asum=dzasum(desc_a%matrix_data(psb_n_row_),x,ione)
if(psb_get_local_rows(desc_a).gt.0) then
asum=dzasum(psb_get_local_rows(desc_a),x,ione)
! adjust asum because overlapped elements are computed more than once
i=1

25
src/psblas/psb_zaxpby.f90
Unescape Escape View File

@ -74,7 +74,7 @@ subroutine psb_zaxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -ione) then
@ -114,11 +114,12 @@ subroutine psb_zaxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
goto 9999
end if
m = desc_a%matrix_data(psb_m_)
m = psb_get_global_rows(desc_a)
! check vector correctness
call psb_chkvect(m,ione,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,ione,size(y,1),iy,ijy,desc_a%matrix_data,info,iiy,jjy)
call psb_chkvect(m,ione,size(x,1),ix,ijx,desc_a,info,iix,jjx)
if (info == 0) &
& call psb_chkvect(m,ione,size(y,1),iy,ijy,desc_a,info,iiy,jjy)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@ -133,8 +134,8 @@ subroutine psb_zaxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
end if
if ((in.ne.0)) then
if(desc_a%matrix_data(psb_n_row_).gt.0) then
call zaxpby(desc_a%matrix_data(psb_n_col_),in,&
if(psb_get_local_rows(desc_a).gt.0) then
call zaxpby(psb_get_local_cols(desc_a),in,&
& alpha,x(iix,jjx),size(x,1),beta,&
& y(iiy,jjy),size(y,1),info)
end if
@ -226,7 +227,7 @@ subroutine psb_zaxpbyv(alpha, x, beta,y,desc_a,info)
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -ione) then
@ -238,17 +239,17 @@ subroutine psb_zaxpbyv(alpha, x, beta,y,desc_a,info)
ix = ione
iy = ione
m = desc_a%matrix_data(psb_m_)
m = psb_get_global_rows(desc_a)
! check vector correctness
call psb_chkvect(m,ione,size(x),ix,ione,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,ione,size(x),ix,ione,desc_a,info,iix,jjx)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect 1'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_chkvect(m,ione,size(y),iy,ione,desc_a%matrix_data,info,iiy,jjy)
call psb_chkvect(m,ione,size(y),iy,ione,desc_a,info,iiy,jjy)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect 2'
@ -261,8 +262,8 @@ subroutine psb_zaxpbyv(alpha, x, beta,y,desc_a,info)
call psb_errpush(info,name)
end if
if(desc_a%matrix_data(psb_n_row_).gt.0) then
call zaxpby(desc_a%matrix_data(psb_n_col_),ione,&
if(psb_get_local_rows(desc_a).gt.0) then
call zaxpby(psb_get_local_cols(desc_a),ione,&
& alpha,x,size(x),beta,&
& y,size(y),info)
end if

51
src/psblas/psb_zdot.f90
Unescape Escape View File

@ -72,7 +72,7 @@ function psb_zdot(x, y,desc_a, info, jx, jy)
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -ione) then
@ -101,11 +101,12 @@ function psb_zdot(x, y,desc_a, info, jx, jy)
goto 9999
end if
m = desc_a%matrix_data(psb_m_)
m = psb_get_global_rows(desc_a)
! check vector correctness
call psb_chkvect(m,ione,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,ione,size(y,1),iy,ijy,desc_a%matrix_data,info,iiy,jjy)
call psb_chkvect(m,ione,size(x,1),ix,ijx,desc_a,info,iix,jjx)
if (info == 0) &
& call psb_chkvect(m,ione,size(y,1),iy,ijy,desc_a,info,iiy,jjy)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@ -120,8 +121,8 @@ function psb_zdot(x, y,desc_a, info, jx, jy)
end if
if(m.ne.0) then
if(desc_a%matrix_data(psb_n_row_).gt.0) then
dot_local = zdotc(desc_a%matrix_data(psb_n_row_),&
if(psb_get_local_rows(desc_a).gt.0) then
dot_local = zdotc(psb_get_local_rows(desc_a),&
& x(iix,jjx),ione,y(iiy,jjy),ione)
! adjust dot_local because overlapped elements are computed more than once
i=1
@ -225,7 +226,7 @@ function psb_zdotv(x, y,desc_a, info)
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -ione) then
@ -238,11 +239,12 @@ function psb_zdotv(x, y,desc_a, info)
iy = ione
jx = ione
jy = ione
m = desc_a%matrix_data(psb_m_)
m = psb_get_global_rows(desc_a)
! check vector correctness
call psb_chkvect(m,ione,size(x,1),ix,jx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,ione,size(y,1),iy,jy,desc_a%matrix_data,info,iiy,jjy)
call psb_chkvect(m,ione,size(x,1),ix,jx,desc_a,info,iix,jjx)
if (info == 0)&
& call psb_chkvect(m,ione,size(y,1),iy,jy,desc_a,info,iiy,jjy)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@ -257,8 +259,8 @@ function psb_zdotv(x, y,desc_a, info)
end if
if(m.ne.0) then
if(desc_a%matrix_data(psb_n_row_).gt.0) then
dot_local = zdotc(desc_a%matrix_data(psb_n_row_),&
if(psb_get_local_rows(desc_a).gt.0) then
dot_local = zdotc(psb_get_local_rows(desc_a),&
& x,ione,y,ione)
! adjust dot_local because overlapped elements are computed more than once
i=1
@ -362,7 +364,7 @@ subroutine psb_zdotvs(res, x, y,desc_a, info)
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -ione) then
@ -373,11 +375,12 @@ subroutine psb_zdotvs(res, x, y,desc_a, info)
ix = ione
iy = ione
m = desc_a%matrix_data(psb_m_)
m = psb_get_global_rows(desc_a)
! check vector correctness
call psb_chkvect(m,ione,size(x,1),ix,ix,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,ione,size(y,1),iy,iy,desc_a%matrix_data,info,iiy,jjy)
call psb_chkvect(m,ione,size(x,1),ix,ix,desc_a,info,iix,jjx)
if (info == 0) &
& call psb_chkvect(m,ione,size(y,1),iy,iy,desc_a,info,iiy,jjy)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@ -392,8 +395,8 @@ subroutine psb_zdotvs(res, x, y,desc_a, info)
end if
if(m.ne.0) then
if(desc_a%matrix_data(psb_n_row_).gt.0) then
dot_local = zdotc(desc_a%matrix_data(psb_n_row_),&
if(psb_get_local_rows(desc_a).gt.0) then
dot_local = zdotc(psb_get_local_rows(desc_a),&
& x,ione,y,ione)
! adjust dot_local because overlapped elements are computed more than once
i=1
@ -502,7 +505,7 @@ subroutine psb_zmdots(res, x, y, desc_a, info)
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -ione) then
@ -514,17 +517,17 @@ subroutine psb_zmdots(res, x, y, desc_a, info)
ix = ione
iy = ione
m = desc_a%matrix_data(psb_m_)
m = psb_get_global_rows(desc_a)
! check vector correctness
call psb_chkvect(m,ione,size(x,1),ix,ix,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,ione,size(x,1),ix,ix,desc_a,info,iix,jjx)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_chkvect(m,ione,size(y,1),iy,iy,desc_a%matrix_data,info,iiy,jjy)
call psb_chkvect(m,ione,size(y,1),iy,iy,desc_a,info,iiy,jjy)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@ -542,9 +545,9 @@ subroutine psb_zmdots(res, x, y, desc_a, info)
allocate(dot_local(k))
if(m.ne.0) then
if(desc_a%matrix_data(psb_n_row_).gt.0) then
if(psb_get_local_rows(desc_a).gt.0) then
do j=1,k
dot_local(j) = zdotc(desc_a%matrix_data(psb_n_row_),&
dot_local(j) = zdotc(psb_get_local_rows(desc_a),&
& x(1,j),ione,y(1,j),ione)
! adjust dot_local because overlapped elements are computed more than once
i=1

30
src/psblas/psb_znrm2.f90
Unescape Escape View File

@ -69,7 +69,7 @@ function psb_znrm2(x, desc_a, info, jx)
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -1) then
@ -85,9 +85,9 @@ function psb_znrm2(x, desc_a, info, jx)
ijx = 1
endif
m = desc_a%matrix_data(psb_m_)
m = psb_get_global_rows(desc_a)
call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@ -101,8 +101,8 @@ function psb_znrm2(x, desc_a, info, jx)
end if
if(m.ne.0) then
if (desc_a%matrix_data(psb_n_row_) .gt. 0) then
ndim = desc_a%matrix_data(psb_n_row_)
if (psb_get_local_rows(desc_a) .gt. 0) then
ndim = psb_get_local_rows(desc_a)
nrm2 = dznrm2( ndim, x(iix,jjx), ione )
i=1
do while (desc_a%ovrlap_elem(i) .ne. -1)
@ -206,7 +206,7 @@ function psb_znrm2v(x, desc_a, info)
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -1) then
@ -218,10 +218,10 @@ function psb_znrm2v(x, desc_a, info)
ix = 1
jx=1
m = desc_a%matrix_data(psb_m_)
m = psb_get_global_rows(desc_a)
call psb_chkvect(m,1,size(x),ix,jx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,1,size(x),ix,jx,desc_a,info,iix,jjx)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@ -235,8 +235,8 @@ function psb_znrm2v(x, desc_a, info)
end if
if(m.ne.0) then
if (desc_a%matrix_data(psb_n_row_) .gt. 0) then
ndim = desc_a%matrix_data(psb_n_row_)
if (psb_get_local_rows(desc_a) .gt. 0) then
ndim = psb_get_local_rows(desc_a)
nrm2 = dznrm2( ndim, x, ione )
i=1
do while (desc_a%ovrlap_elem(i) .ne. -1)
@ -342,7 +342,7 @@ subroutine psb_znrm2vs(res, x, desc_a, info)
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -1) then
@ -353,9 +353,9 @@ subroutine psb_znrm2vs(res, x, desc_a, info)
ix = 1
jx = 1
m = desc_a%matrix_data(psb_m_)
m = psb_get_global_rows(desc_a)
call psb_chkvect(m,1,size(x),ix,jx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,1,size(x),ix,jx,desc_a,info,iix,jjx)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@ -369,8 +369,8 @@ subroutine psb_znrm2vs(res, x, desc_a, info)
end if
if(m.ne.0) then
if (desc_a%matrix_data(psb_n_row_) .gt. 0) then
ndim = desc_a%matrix_data(psb_n_row_)
if (psb_get_local_rows(desc_a) .gt. 0) then
ndim = psb_get_local_rows(desc_a)
nrm2 = dznrm2( ndim, x, ione )
i=1
do while (desc_a%ovrlap_elem(i) .ne. -1)

12
src/psblas/psb_znrmi.f90
Unescape Escape View File

@ -64,7 +64,7 @@ function psb_znrmi(a,desc_a,info)
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -1) then
@ -75,10 +75,10 @@ function psb_znrmi(a,desc_a,info)
ia = 1
ja = 1
m = desc_a%matrix_data(psb_m_)
n = desc_a%matrix_data(psb_n_)
m = psb_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a)
call psb_chkmat(m,n,ia,ja,desc_a%matrix_data,info,iia,jja)
call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja)
if(info.ne.0) then
info=4010
ch_err='psb_chkmat'
@ -93,8 +93,8 @@ function psb_znrmi(a,desc_a,info)
end if
if ((m.ne.0).and.(n.ne.0)) then
mdim = desc_a%matrix_data(psb_n_row_)
ndim = desc_a%matrix_data(psb_n_col_)
mdim = psb_get_local_rows(desc_a)
ndim = psb_get_local_cols(desc_a)
nrmi = zcsnmi('N',mdim,ndim,a%fida,&
& a%descra,a%aspk,a%ia1,a%ia2,&
& a%infoa,info)

44
src/psblas/psb_zspmm.f90
Unescape Escape View File

@ -117,7 +117,7 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -1) then
@ -168,10 +168,10 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
itrans = 'N'
endif
m = desc_a%matrix_data(psb_m_)
n = desc_a%matrix_data(psb_n_)
nrow = desc_a%matrix_data(psb_n_row_)
ncol = desc_a%matrix_data(psb_n_col_)
m = psb_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a)
nrow = psb_get_local_rows(desc_a)
ncol = psb_get_local_cols(desc_a)
lldx = size(x,1)
lldy = size(y,1)
@ -204,7 +204,7 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
iwork(1)=zzero
! checking for matrix correctness
call psb_chkmat(m,n,ia,ja,desc_a%matrix_data,info,iia,jja)
call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja)
if(info /= 0) then
info=4010
ch_err='psb_chkmat'
@ -223,8 +223,9 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
end if
! checking for vectors correctness
call psb_chkvect(n,ik,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,ik,size(y,1),iy,ijy,desc_a%matrix_data,info,iiy,jjy)
call psb_chkvect(n,ik,size(x,1),ix,ijx,desc_a,info,iix,jjx)
if (info == 0)&
& call psb_chkvect(m,ik,size(y,1),iy,ijy,desc_a,info,iiy,jjy)
if(info /= 0) then
info=4010
ch_err='psb_chkvect'
@ -292,8 +293,9 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
end if
! checking for vectors correctness
call psb_chkvect(m,ik,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(n,ik,size(y,1),iy,ijy,desc_a%matrix_data,info,iiy,jjy)
call psb_chkvect(m,ik,size(x,1),ix,ijx,desc_a,info,iix,jjx)
if (info == 0) &
& call psb_chkvect(n,ik,size(y,1),iy,ijy,desc_a,info,iiy,jjy)
if(info /= 0) then
info=4010
ch_err='psb_chkvect'
@ -448,7 +450,7 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,&
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -1) then
@ -484,10 +486,10 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,&
itrans = 'N'
endif
m = desc_a%matrix_data(psb_m_)
n = desc_a%matrix_data(psb_n_)
nrow = desc_a%matrix_data(psb_n_row_)
ncol = desc_a%matrix_data(psb_n_col_)
m = psb_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a)
nrow = psb_get_local_rows(desc_a)
ncol = psb_get_local_cols(desc_a)
lldx = size(x)
lldy = size(y)
@ -522,7 +524,7 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,&
! checking for matrix correctness
call psb_chkmat(m,n,ia,ja,desc_a%matrix_data,info,iia,jja)
call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja)
if(info /= 0) then
info=4010
ch_err='psb_chkmat'
@ -541,8 +543,9 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,&
end if
! checking for vectors correctness
call psb_chkvect(n,ik,size(x),ix,jx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,ik,size(y),iy,jy,desc_a%matrix_data,info,iiy,jjy)
call psb_chkvect(n,ik,size(x),ix,jx,desc_a,info,iix,jjx)
if (info == 0) &
& call psb_chkvect(m,ik,size(y),iy,jy,desc_a,info,iiy,jjy)
if(info /= 0) then
info=4010
ch_err='psb_chkvect'
@ -589,8 +592,9 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,&
end if
! checking for vectors correctness
call psb_chkvect(m,ik,size(x),ix,jx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(n,ik,size(y),iy,jy,desc_a%matrix_data,info,iiy,jjy)
call psb_chkvect(m,ik,size(x),ix,jx,desc_a,info,iix,jjx)
if (info == 0)&
& call psb_chkvect(n,ik,size(y),iy,jy,desc_a,info,iiy,jjy)
if(info /= 0) then
info=4010
ch_err='psb_chkvect'

32
src/psblas/psb_zspsm.f90
Unescape Escape View File

@ -115,7 +115,7 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,&
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -1) then
@ -178,9 +178,9 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,&
itrans = 'N'
endif
m = desc_a%matrix_data(psb_m_)
nrow = desc_a%matrix_data(psb_n_row_)
ncol = desc_a%matrix_data(psb_n_col_)
m = psb_get_global_rows(desc_a)
nrow = psb_get_local_rows(desc_a)
ncol = psb_get_local_cols(desc_a)
lldx = size(x,1)
lldy = size(y,1)
@ -229,10 +229,12 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,&
end if
! checking for matrix correctness
call psb_chkmat(m,m,ia,ja,desc_a%matrix_data,info,iia,jja)
call psb_chkmat(m,m,ia,ja,desc_a,info,iia,jja)
! checking for vectors correctness
call psb_chkvect(m,ik,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,ik,size(y,1),iy,ijy,desc_a%matrix_data,info,iiy,jjy)
if (info == 0) &
& call psb_chkvect(m,ik,size(x,1),ix,ijx,desc_a,info,iix,jjx)
if (info == 0) &
& call psb_chkvect(m,ik,size(y,1),iy,ijy,desc_a,info,iiy,jjy)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect/mat'
@ -421,7 +423,7 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -1) then
@ -464,9 +466,9 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
itrans = 'N'
endif
m = desc_a%matrix_data(psb_m_)
nrow = desc_a%matrix_data(psb_n_row_)
ncol = desc_a%matrix_data(psb_n_col_)
m = psb_get_global_rows(desc_a)
nrow = psb_get_local_rows(desc_a)
ncol = psb_get_local_cols(desc_a)
lldx = size(x)
lldy = size(y)
@ -516,10 +518,12 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
end if
! checking for matrix correctness
call psb_chkmat(m,m,ia,ja,desc_a%matrix_data,info,iia,jja)
call psb_chkmat(m,m,ia,ja,desc_a,info,iia,jja)
! checking for vectors correctness
call psb_chkvect(m,ik,size(x),ix,jx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,ik,size(y),iy,jy,desc_a%matrix_data,info,iiy,jjy)
if (info == 0) &
& call psb_chkvect(m,ik,size(x),ix,jx,desc_a,info,iix,jjx)
if (info == 0) &
& call psb_chkvect(m,ik,size(y),iy,jy,desc_a,info,iiy,jjy)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect/mat'

1
src/tools/psb_cdalv.f90
Unescape Escape View File

@ -269,6 +269,7 @@ subroutine psb_cdalv(m, v, ictxt, desc_a, info, flag)
desc_a%halo_index(:) = -1
desc_a%matrix_data(psb_m_) = m
desc_a%matrix_data(psb_n_) = n
desc_a%matrix_data(psb_dec_type_) = psb_desc_bld_

16
src/tools/psb_cdasb.f90
Unescape Escape View File

@ -66,10 +66,10 @@ subroutine psb_cdasb(desc_a,info)
call psb_erractionsave(err_act)
ictxt = desc_a%matrix_data(psb_ctxt_)
dectype = desc_a%matrix_data(psb_dec_type_)
n_row = desc_a%matrix_data(psb_n_row_)
n_col = desc_a%matrix_data(psb_n_col_)
ictxt = psb_get_context(desc_a)
dectype = psb_get_dectype(desc_a)
n_row = psb_get_local_rows(desc_a)
n_col = psb_get_local_cols(desc_a)
! check on blacs grid
call psb_info(ictxt, me, np)
@ -79,7 +79,7 @@ subroutine psb_cdasb(desc_a,info)
goto 9999
endif
if (.not.psb_is_ok_dec(dectype)) then
if (.not.psb_is_ok_desc(desc_a)) then
info = 600
int_err(1) = dectype
call psb_errpush(info,name)
@ -88,10 +88,10 @@ subroutine psb_cdasb(desc_a,info)
if (debug) write (0, *) ' Begin matrix assembly...'
if (psb_is_bld_dec(dectype)) then
if (psb_is_bld_desc(desc_a)) then
if (debug) write(0,*) 'psb_cdasb: Checking rows insertion'
! check if all local row are inserted
do i=1,desc_a%matrix_data(psb_n_col_)
do i=1,psb_get_local_cols(desc_a)
if (desc_a%loc_to_glob(i) < 0) then
info=3100
exit
@ -102,7 +102,7 @@ subroutine psb_cdasb(desc_a,info)
call psb_errpush(info,name,i_err=int_err)
goto 9999
endif
call psb_realloc(desc_a%matrix_data(psb_n_col_),desc_a%loc_to_glob,info)
call psb_realloc(psb_get_local_cols(desc_a),desc_a%loc_to_glob,info)
call psb_transfer(desc_a%ovrlap_index,ovrlap_index,info)
call psb_transfer(desc_a%halo_index,halo_index,info)

6
src/tools/psb_cddec.f90
Unescape Escape View File

@ -178,10 +178,11 @@ subroutine psb_cddec(nloc, ictxt, desc_a, info)
goto 9999
endif
desc_a%matrix_data(psb_m_) = m
desc_a%matrix_data(psb_n_) = m
desc_a%matrix_data(psb_n_row_) = nloc
desc_a%matrix_data(psb_n_col_) = nloc
desc_a%matrix_data(psb_m_) = m
desc_a%matrix_data(psb_n_) = m
desc_a%matrix_data(psb_dec_type_) = psb_desc_bld_
desc_a%matrix_data(psb_ctxt_) = ictxt
call psb_get_mpicomm(ictxt,desc_a%matrix_data(psb_mpi_c_))
@ -214,6 +215,7 @@ subroutine psb_cddec(nloc, ictxt, desc_a, info)
goto 9999
end if
desc_a%matrix_data(psb_dec_type_) = psb_desc_asb_
call psb_erractionrestore(err_act)

2
src/tools/psb_cdfree.f90
Unescape Escape View File

@ -62,7 +62,7 @@ subroutine psb_cdfree(desc_a,info)
return
end if
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
deallocate(desc_a%matrix_data)
call psb_info(ictxt, me, np)
! ....verify blacs grid correctness..

14
src/tools/psb_cdins.f90
Unescape Escape View File

@ -66,16 +66,16 @@ subroutine psb_cdins(nz,ia,ja,desc_a,info)
name = 'psb_cdins'
call psb_erractionsave(err_act)
ictxt = desc_a%matrix_data(psb_ctxt_)
dectype = desc_a%matrix_data(psb_dec_type_)
mglob = desc_a%matrix_data(psb_m_)
nglob = desc_a%matrix_data(psb_n_)
nrow = desc_a%matrix_data(psb_n_row_)
ncol = desc_a%matrix_data(psb_n_col_)
ictxt = psb_get_context(desc_a)
dectype = psb_get_dectype(desc_a)
mglob = psb_get_global_rows(desc_a)
nglob = psb_get_global_cols(desc_a)
nrow = psb_get_local_rows(desc_a)
ncol = psb_get_local_cols(desc_a)
call psb_info(ictxt, me, np)
if (.not.psb_is_bld_dec(dectype)) then
if (.not.psb_is_bld_desc(desc_a)) then
info = 3110
call psb_errpush(info,name)
goto 9999

12
src/tools/psb_cdren.f90
Unescape Escape View File

@ -75,10 +75,10 @@ subroutine psb_cdren(trans,iperm,desc_a,info)
time(1) = mpi_wtime()
ictxt=desc_a%matrix_data(psb_ctxt_)
dectype=desc_a%matrix_data(psb_dec_type_)
n_row = desc_a%matrix_data(psb_n_row_)
n_col = desc_a%matrix_data(psb_n_col_)
ictxt=psb_get_context(desc_a)
dectype=psb_get_dectype(desc_a)
n_row = psb_get_local_rows(desc_a)
n_col = psb_get_local_cols(desc_a)
! check on blacs grid
call psb_info(ictxt, me, np)
@ -88,7 +88,7 @@ subroutine psb_cdren(trans,iperm,desc_a,info)
goto 9999
endif
if (.not.psb_is_asb_dec(dectype)) then
if (.not.psb_is_asb_desc(desc_a)) then
info = 600
int_err(1) = dectype
call psb_errpush(info,name,int_err)
@ -137,7 +137,7 @@ subroutine psb_cdren(trans,iperm,desc_a,info)
desc_a%glob_to_loc(desc_a%loc_to_glob(desc_a%lprm(i))) = i
enddo
if (debug) write(0,*) 'spasb: renumbering loc_to_glob'
do i=1,desc_a%matrix_data(psb_m_)
do i=1,psb_get_global_rows(desc_a)
j = desc_a%glob_to_loc(i)
if (j>0) then
desc_a%loc_to_glob(j) = i

1
src/tools/psb_cdrep.f90
Unescape Escape View File

@ -186,6 +186,7 @@ subroutine psb_cdrep(m, ictxt, desc_a, info)
endif
desc_a%matrix_data(psb_m_) = m
desc_a%matrix_data(psb_n_) = n
desc_a%matrix_data(psb_n_row_) = m

30
src/tools/psb_dallc.f90
Unescape Escape View File

@ -68,7 +68,7 @@ subroutine psb_dalloc(x, desc_a, info, n)
int_err(1)=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -1) then
@ -77,9 +77,9 @@ subroutine psb_dalloc(x, desc_a, info, n)
goto 9999
endif
dectype=desc_a%matrix_data(psb_dec_type_)
dectype=psb_get_dectype(desc_a)
!... check m and n parameters....
if (.not.psb_is_ok_dec(dectype)) then
if (.not.psb_is_ok_desc(desc_a)) then
info = 3110
call psb_errpush(info,name)
goto 9999
@ -105,8 +105,8 @@ subroutine psb_dalloc(x, desc_a, info, n)
endif
!....allocate x .....
if (psb_is_asb_dec(dectype).or.psb_is_upd_dec(dectype)) then
n_col = max(1,desc_a%matrix_data(psb_n_col_))
if (psb_is_asb_desc(desc_a).or.psb_is_upd_desc(desc_a)) then
n_col = max(1,psb_get_local_cols(desc_a))
allocate(x(n_col,n_),stat=info)
if (info /= 0) then
info=4010
@ -119,8 +119,8 @@ subroutine psb_dalloc(x, desc_a, info, n)
x(i,j) = 0.0d0
end do
end do
else if (psb_is_bld_dec(dectype)) then
n_row = max(1,desc_a%matrix_data(psb_n_row_))
else if (psb_is_bld_desc(desc_a)) then
n_row = max(1,psb_get_local_rows(desc_a))
allocate(x(n_row,n_),stat=info)
if (info /= 0) then
info=4010
@ -213,7 +213,7 @@ subroutine psb_dallocv(x, desc_a,info,n)
name='psb_dallcv'
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
! ....verify blacs grid correctness..
@ -223,11 +223,11 @@ subroutine psb_dallocv(x, desc_a,info,n)
goto 9999
endif
dectype=desc_a%matrix_data(psb_dec_type_)
dectype=psb_get_dectype(desc_a)
if (debug) write(0,*) 'dall: dectype',dectype
if (debug) write(0,*) 'dall: is_ok? dectype',psb_is_ok_dec(dectype)
if (debug) write(0,*) 'dall: is_ok? dectype',psb_is_ok_desc(desc_a)
!... check m and n parameters....
if (.not.psb_is_ok_dec(dectype)) then
if (.not.psb_is_ok_desc(desc_a)) then
info = 3110
call psb_errpush(info,name)
goto 9999
@ -236,8 +236,8 @@ subroutine psb_dallocv(x, desc_a,info,n)
! As this is a rank-1 array, optional parameter N is actually ignored.
!....allocate x .....
if (psb_is_asb_dec(dectype).or.psb_is_upd_dec(dectype)) then
n_col = max(1,desc_a%matrix_data(psb_n_col_))
if (psb_is_asb_desc(desc_a).or.psb_is_upd_desc(desc_a)) then
n_col = max(1,psb_get_local_cols(desc_a))
call psb_realloc(n_col,x,info)
if (info /= 0) then
info=4010
@ -249,8 +249,8 @@ subroutine psb_dallocv(x, desc_a,info,n)
x(i) = 0.0d0
end do
else if (psb_is_bld_dec(dectype)) then
n_row = max(1,desc_a%matrix_data(psb_n_row_))
else if (psb_is_bld_desc(desc_a)) then
n_row = max(1,psb_get_local_rows(desc_a))
call psb_realloc(n_row,x,info)
if (info /= 0) then
info=4010

24
src/tools/psb_dasb.f90
Unescape Escape View File

@ -69,20 +69,20 @@ subroutine psb_dasb(x, desc_a, info)
goto 9999
endif
ictxt=desc_a%matrix_data(psb_ctxt_)
dectype=desc_a%matrix_data(psb_dec_type_)
ictxt=psb_get_context(desc_a)
dectype=psb_get_dectype(desc_a)
call psb_info(ictxt, me, np)
if (debug) write(*,*) 'asb start: ',np,me,&
&desc_a%matrix_data(psb_dec_type_)
&psb_get_dectype(desc_a)
! ....verify blacs grid correctness..
if (np == -1) then
info = 2010
call psb_errpush(info,name)
goto 9999
else if (.not.psb_is_asb_dec(dectype)) then
else if (.not.psb_is_asb_desc(desc_a)) then
if (debug) write(*,*) 'asb error ',&
&dectype
info = 3110
@ -91,9 +91,9 @@ subroutine psb_dasb(x, desc_a, info)
endif
! check size
ictxt=desc_a%matrix_data(psb_ctxt_)
nrow=desc_a%matrix_data(psb_n_row_)
ncol=desc_a%matrix_data(psb_n_col_)
ictxt=psb_get_context(desc_a)
nrow=psb_get_local_rows(desc_a)
ncol=psb_get_local_cols(desc_a)
i1sz = size(x,dim=1)
i2sz = size(x,dim=2)
if (debug) write(*,*) 'asb: ',i1sz,i2sz,nrow,ncol
@ -193,8 +193,8 @@ subroutine psb_dasbv(x, desc_a, info)
int_err(1) = 0
name = 'psb_dasbv'
ictxt=desc_a%matrix_data(psb_ctxt_)
dectype=desc_a%matrix_data(psb_dec_type_)
ictxt=psb_get_context(desc_a)
dectype=psb_get_dectype(desc_a)
call psb_info(ictxt, me, np)
@ -203,14 +203,14 @@ subroutine psb_dasbv(x, desc_a, info)
info = 2010
call psb_errpush(info,name)
goto 9999
else if (.not.psb_is_asb_dec(dectype)) then
else if (.not.psb_is_asb_desc(desc_a)) then
info = 3110
call psb_errpush(info,name)
goto 9999
endif
nrow=desc_a%matrix_data(psb_n_row_)
ncol=desc_a%matrix_data(psb_n_col_)
nrow=psb_get_local_rows(desc_a)
ncol=psb_get_local_cols(desc_a)
if (debug) write(*,*) name,' sizes: ',nrow,ncol
i1sz = size(x)
if (debug) write(*,*) 'dasb: sizes ',i1sz,ncol

6
src/tools/psb_dcdovr.f90
Unescape Escape View File

@ -101,15 +101,15 @@ Subroutine psb_dcdovr(a,desc_a,novr,desc_ov,info)
info = 0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
Call psb_info(ictxt, me, np)
If(debug) Write(0,*)'in psb_cdovr',novr
m=desc_a%matrix_data(psb_n_row_)
m=psb_get_local_rows(desc_a)
nnzero=Size(a%aspk)
n_col=desc_a%matrix_data(psb_n_col_)
n_col=psb_get_local_cols(desc_a)
nhalo = n_col-m
If(debug) Write(0,*)'IN CDOVR1',novr ,m,nnzero,n_col
if (novr<0) then

14
src/tools/psb_dcdovrbld.f90
Unescape Escape View File

@ -94,7 +94,7 @@ Subroutine psb_dcdovrbld(n_ovr,desc_p,desc_a,a,&
call psb_erractionsave(err_act)
If(debug) Write(0,*)'cdovrbld begin'
ictxt = desc_a%matrix_data(psb_ctxt_)
ictxt = psb_get_context(desc_a)
Call psb_info(ictxt,me,np)
@ -108,10 +108,10 @@ Subroutine psb_dcdovrbld(n_ovr,desc_p,desc_a,a,&
t4 = 0.0
call psb_get_mpicomm(ictxt,icomm )
mglob = desc_a%matrix_data(psb_m_)
m = desc_a%matrix_data(psb_n_row_)
n_row = desc_a%matrix_data(psb_n_row_)
n_col = desc_a%matrix_data(psb_n_col_)
mglob = psb_get_global_rows(desc_a)
m = psb_get_local_rows(desc_a)
n_row = psb_get_local_rows(desc_a)
n_col = psb_get_local_cols(desc_a)
if (debug) write(0,*) me,' On entry to CDOVRBLD n_col:',n_col
dl_lda=np*5
@ -537,8 +537,8 @@ Subroutine psb_dcdovrbld(n_ovr,desc_p,desc_a,a,&
End Do
t1 = mpi_wtime()
desc_p%matrix_data(psb_m_)=desc_a%matrix_data(psb_m_)
desc_p%matrix_data(psb_n_)=desc_a%matrix_data(psb_n_)
desc_p%matrix_data(psb_m_)=psb_get_global_rows(desc_a)
desc_p%matrix_data(psb_n_)=psb_get_global_cols(desc_a)
tmp_halo(counter_h)=-1
tmp_ovr_idx(counter_o)=-1

10
src/tools/psb_dcsrp.f90
Unescape Escape View File

@ -89,10 +89,10 @@ subroutine psb_dcsrp(trans,iperm,a, desc_a, info)
time(1) = mpi_wtime()
ictxt=desc_a%matrix_data(psb_ctxt_)
dectype=desc_a%matrix_data(psb_dec_type_)
n_row = desc_a%matrix_data(psb_n_row_)
n_col = desc_a%matrix_data(psb_n_col_)
ictxt=psb_get_context(desc_a)
dectype=psb_get_dectype(desc_a)
n_row = psb_get_local_rows(desc_a)
n_col = psb_get_local_cols(desc_a)
if(psb_get_errstatus() /= 0) return
info=0
@ -108,7 +108,7 @@ subroutine psb_dcsrp(trans,iperm,a, desc_a, info)
endif
if (.not.psb_is_asb_dec(dectype)) then
if (.not.psb_is_asb_desc(desc_a)) then
info = 600
int_err(1) = dectype
call psb_errpush(info,name,int_err)

4
src/tools/psb_dfree.f90
Unescape Escape View File

@ -65,7 +65,7 @@ subroutine psb_dfree(x, desc_a, info)
goto 9999
end if
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
! ....verify blacs grid correctness..
@ -139,7 +139,7 @@ subroutine psb_dfreev(x, desc_a, info)
call psb_errpush(info,name)
return
end if
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -1) then

22
src/tools/psb_dgelp.f90
Unescape Escape View File

@ -85,23 +85,23 @@ subroutine psb_dgelp(trans,iperm,x,desc_a,info)
info=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
dectype=desc_a%matrix_data(psb_dec_type_)
nrow = desc_a%matrix_data(psb_n_row_)
ncol = desc_a%matrix_data(psb_n_col_)
ictxt=psb_get_context(desc_a)
dectype=psb_get_dectype(desc_a)
nrow = psb_get_local_rows(desc_a)
ncol = psb_get_local_cols(desc_a)
i1sz = size(x,dim=1)
i2sz = size(x,dim=2)
call psb_info(ictxt, me, np)
if (debug) write(*,*) 'asb start: ',np,me,&
&desc_a%matrix_data(psb_dec_type_)
&psb_get_dectype(desc_a)
! ....verify blacs grid correctness..
if (np == -1) then
info = 2010
call psb_errpush(info,name)
goto 9999
else if (.not.psb_is_asb_dec(dectype)) then
else if (.not.psb_is_asb_desc(desc_a)) then
info = 3110
call psb_errpush(info,name)
goto 9999
@ -231,10 +231,10 @@ subroutine psb_dgelpv(trans,iperm,x,desc_a,info)
i1sz = size(x)
ictxt=desc_a%matrix_data(psb_ctxt_)
dectype=desc_a%matrix_data(psb_dec_type_)
nrow=desc_a%matrix_data(psb_n_row_)
ncol=desc_a%matrix_data(psb_n_col_)
ictxt=psb_get_context(desc_a)
dectype=psb_get_dectype(desc_a)
nrow=psb_get_local_rows(desc_a)
ncol=psb_get_local_cols(desc_a)
call psb_info(ictxt, me, np)
@ -243,7 +243,7 @@ subroutine psb_dgelpv(trans,iperm,x,desc_a,info)
info = 2010
call psb_errpush(info,name)
goto 9999
else if (.not.psb_is_asb_dec(dectype)) then
else if (.not.psb_is_asb_desc(desc_a)) then
info = 3110
call psb_errpush(info,name)
goto 9999

28
src/tools/psb_dins.f90
Unescape Escape View File

@ -82,7 +82,7 @@ subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl)
return
end if
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -1) then
@ -98,12 +98,12 @@ subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl)
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999
else if (.not.psb_is_ok_dec(desc_a%matrix_data(psb_dec_type_))) then
else if (.not.psb_is_ok_desc(desc_a)) then
info = 3110
int_err(1) = desc_a%matrix_data(psb_dec_type_)
int_err(1) = psb_get_dectype(desc_a)
call psb_errpush(info,name,int_err)
goto 9999
else if (size(x, dim=1) < desc_a%matrix_data(psb_n_row_)) then
else if (size(x, dim=1) < psb_get_local_rows(desc_a)) then
info = 310
int_err(1) = 5
int_err(2) = 4
@ -111,9 +111,9 @@ subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl)
goto 9999
endif
loc_rows=desc_a%matrix_data(psb_n_row_)
loc_cols=desc_a%matrix_data(psb_n_col_)
mglob = desc_a%matrix_data(psb_m_)
loc_rows=psb_get_local_rows(desc_a)
loc_cols=psb_get_local_cols(desc_a)
mglob = psb_get_global_rows(desc_a)
if (present(dupl)) then
dupl_ = dupl
@ -265,7 +265,7 @@ subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl)
return
end if
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -1) then
@ -281,12 +281,12 @@ subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl)
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999
else if (.not.psb_is_ok_dec(desc_a%matrix_data(psb_dec_type_))) then
else if (.not.psb_is_ok_desc(desc_a)) then
info = 3110
int_err(1) = desc_a%matrix_data(psb_dec_type_)
int_err(1) = psb_get_dectype(desc_a)
call psb_errpush(info,name,int_err)
goto 9999
else if (size(x, dim=1) < desc_a%matrix_data(psb_n_row_)) then
else if (size(x, dim=1) < psb_get_local_rows(desc_a)) then
info = 310
int_err(1) = 5
int_err(2) = 4
@ -294,9 +294,9 @@ subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl)
goto 9999
endif
loc_rows=desc_a%matrix_data(psb_n_row_)
loc_cols=desc_a%matrix_data(psb_n_col_)
mglob = desc_a%matrix_data(psb_m_)
loc_rows=psb_get_local_rows(desc_a)
loc_cols=psb_get_local_cols(desc_a)
mglob = psb_get_global_rows(desc_a)
n = min(size(val,2),size(x,2))

12
src/tools/psb_dspalloc.f90
Unescape Escape View File

@ -68,8 +68,8 @@ subroutine psb_dspalloc(a, desc_a, info, nnz)
call psb_erractionsave(err_act)
name = 'psb_dspalloc'
ictxt = desc_a%matrix_data(psb_ctxt_)
dectype = desc_a%matrix_data(psb_dec_type_)
ictxt = psb_get_context(desc_a)
dectype = psb_get_dectype(desc_a)
call psb_info(ictxt, me, np)
! ....verify blacs grid correctness..
if (np == -1) then
@ -85,9 +85,9 @@ subroutine psb_dspalloc(a, desc_a, info, nnz)
! check if psdalloc is already called for this matrix
! set fields in desc_a%matrix_data....
loc_row = desc_a%matrix_data(psb_n_row_)
m = desc_a%matrix_data(psb_m_)
n = desc_a%matrix_data(psb_n_)
loc_row = psb_get_local_rows(desc_a)
m = psb_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a)
!...allocate matrix data...
if (present(nnz))then
@ -127,7 +127,7 @@ subroutine psb_dspalloc(a, desc_a, info, nnz)
a%infoa(psb_state_) = psb_spmat_bld_
if (debug) write(0,*) 'spall: ', &
&desc_a%matrix_data(psb_dec_type_),psb_desc_bld_
&psb_get_dectype(desc_a),psb_desc_bld_
return

12
src/tools/psb_dspasb.f90
Unescape Escape View File

@ -76,10 +76,10 @@ subroutine psb_dspasb(a,desc_a, info, afmt, upd, dupl)
name = 'psb_spasb'
call psb_erractionsave(err_act)
ictxt = desc_a%matrix_data(psb_ctxt_)
dscstate = desc_a%matrix_data(psb_dec_type_)
n_row = desc_a%matrix_data(psb_n_row_)
n_col = desc_a%matrix_data(psb_n_col_)
ictxt = psb_get_context(desc_a)
dscstate = psb_get_dectype(desc_a)
n_row = psb_get_local_rows(desc_a)
n_col = psb_get_local_cols(desc_a)
! check on BLACS grid
call psb_info(ictxt, me, np)
@ -106,8 +106,8 @@ subroutine psb_dspasb(a,desc_a, info, afmt, upd, dupl)
! First case: we come from a fresh build.
!
n_row = desc_a%matrix_data(psb_n_row_)
n_col = desc_a%matrix_data(psb_n_col_)
n_row = psb_get_local_rows(desc_a)
n_col = psb_get_local_cols(desc_a)
!
! Second step: handle the local matrix part.

8
src/tools/psb_dspcnv.f90
Unescape Escape View File

@ -122,10 +122,10 @@ subroutine psb_dspcnv(a,b,desc_a,info)
time(1) = mpi_wtime()
ictxt = desc_a%matrix_data(psb_ctxt_)
dectype = desc_a%matrix_data(psb_dec_type_)
n_row = desc_a%matrix_data(psb_n_row_)
n_col = desc_a%matrix_data(psb_n_col_)
ictxt = psb_get_context(desc_a)
dectype = psb_get_dectype(desc_a)
n_row = psb_get_local_rows(desc_a)
n_col = psb_get_local_cols(desc_a)
! check on blacs grid
call psb_info(ictxt, me, np)

2
src/tools/psb_dspfree.f90
Unescape Escape View File

@ -65,7 +65,7 @@ subroutine psb_dspfree(a, desc_a,info)
call psb_errpush(info,name)
return
else
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
end if
!...deallocate a....

2
src/tools/psb_dsphalo.f90
Unescape Escape View File

@ -100,7 +100,7 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rwcnv,clcnv,outfmt)
outfmt_ = 'CSR'
endif
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
Call psb_info(ictxt, me, np)
t1 = mpi_wtime()

20
src/tools/psb_dspins.f90
Unescape Escape View File

@ -86,13 +86,13 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild)
call psb_erractionsave(err_act)
ictxt = desc_a%matrix_data(psb_ctxt_)
dectype = desc_a%matrix_data(psb_dec_type_)
mglob = desc_a%matrix_data(psb_m_)
ictxt = psb_get_context(desc_a)
dectype = psb_get_dectype(desc_a)
mglob = psb_get_global_rows(desc_a)
call psb_info(ictxt, me, np)
if (.not.psb_is_ok_dec(dectype)) then
if (.not.psb_is_ok_desc(desc_a)) then
info = 3110
call psb_errpush(info,name)
goto 9999
@ -127,7 +127,7 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild)
endif
spstate = a%infoa(psb_state_)
if (psb_is_bld_dec(dectype)) then
if (psb_is_bld_desc(desc_a)) then
call psb_cdins(nz,ia,ja,desc_a,info)
if (info /= 0) then
info=4010
@ -135,8 +135,8 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild)
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
nrow = desc_a%matrix_data(psb_n_row_)
ncol = desc_a%matrix_data(psb_n_col_)
nrow = psb_get_local_rows(desc_a)
ncol = psb_get_local_cols(desc_a)
if (spstate == psb_spmat_bld_) then
call psb_coins(nz,ia,ja,val,a,1,nrow,1,ncol,info,gtl=desc_a%glob_to_loc)
@ -151,9 +151,9 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild)
call psb_errpush(info,name)
goto 9999
end if
else if (psb_is_asb_dec(dectype)) then
nrow = desc_a%matrix_data(psb_n_row_)
ncol = desc_a%matrix_data(psb_n_col_)
else if (psb_is_asb_desc(desc_a)) then
nrow = psb_get_local_rows(desc_a)
ncol = psb_get_local_cols(desc_a)
call psb_coins(nz,ia,ja,val,a,1,nrow,1,ncol,&
& info,gtl=desc_a%glob_to_loc,rebuild=rebuild_)
if (info /= 0) then

6
src/tools/psb_dsprn.f90
Unescape Escape View File

@ -69,16 +69,16 @@ Subroutine psb_dsprn(a, desc_a,info,clear)
name = 'psb_dsprn'
call psb_erractionsave(err_act)
ictxt = desc_a%matrix_data(psb_ctxt_)
ictxt = psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (debug) &
&write(*,*) 'starting spalloc ',ictxt,np,me
if (psb_is_bld_dec(desc_a%matrix_data(psb_dec_type_))) then
if (psb_is_bld_desc(desc_a)) then
! Should do nothing, we are called redundantly
return
endif
if (.not.psb_is_asb_dec(desc_a%matrix_data(psb_dec_type_))) then
if (.not.psb_is_asb_desc(desc_a)) then
info=590
call psb_errpush(info,name)
goto 9999

24
src/tools/psb_glob_to_loc.f90
Unescape Escape View File

@ -79,28 +79,28 @@ subroutine psb_glob_to_loc2(x,y,desc_a,info,iact)
n=size(x)
do i=1,n
if ((x(i).gt.desc_a%matrix_data(psb_m_)).or.&
if ((x(i).gt.psb_get_global_rows(desc_a)).or.&
& (x(i).le.zero)) then
if (act == 'I') then
y(i)=-3*desc_a%matrix_data(psb_m_)
y(i)=-3*psb_get_global_rows(desc_a)
else
info=140
int_err(1)=x(i)
int_err(2)=desc_a%matrix_data(psb_m_)
int_err(2)=psb_get_global_rows(desc_a)
exit
end if
else
tmp=desc_a%glob_to_loc(x(i))
if((tmp.gt.zero).or.(tmp.le.desc_a%matrix_data(psb_n_col_))) then
if((tmp.gt.zero).or.(tmp.le.psb_get_local_cols(desc_a))) then
y(i)=tmp
else if (tmp.le.zero) then
info = 150
int_err(1)=tmp
exit
else if (tmp.gt.desc_a%matrix_data(psb_n_col_)) then
else if (tmp.gt.psb_get_local_cols(desc_a)) then
info = 140
int_err(1)=tmp
int_err(2)=desc_a%matrix_data(psb_n_col_)
int_err(2)=psb_get_local_cols(desc_a)
exit
end if
end if
@ -213,28 +213,28 @@ subroutine psb_glob_to_loc(x,desc_a,info,iact)
real_val = 0.d0
n=size(x)
do i=1,n
if ((x(i).gt.desc_a%matrix_data(psb_m_)).or.&
if ((x(i).gt.psb_get_global_rows(desc_a)).or.&
& (x(i).le.zero)) then
if(act == 'I') then
x(i)=-3*desc_a%matrix_data(psb_m_)
x(i)=-3*psb_get_global_rows(desc_a)
else
info=140
int_err(1)=x(i)
int_err(2)=desc_a%matrix_data(psb_m_)
int_err(2)=psb_get_global_rows(desc_a)
exit
end if
else
tmp=desc_a%glob_to_loc(x(i))
if((tmp.gt.zero).or.(tmp.le.desc_a%matrix_data(psb_n_col_))) then
if((tmp.gt.zero).or.(tmp.le.psb_get_local_cols(desc_a))) then
x(i)=tmp
else if (tmp.le.zero) then
info = 150
int_err(1)=tmp
exit
else if (tmp.ge.desc_a%matrix_data(psb_n_col_)) then
else if (tmp.ge.psb_get_local_cols(desc_a)) then
info = 140
int_err(1)=tmp
int_err(2)=desc_a%matrix_data(psb_n_col_)
int_err(2)=psb_get_local_cols(desc_a)
exit
end if
end if

30
src/tools/psb_ialloc.f90
Unescape Escape View File

@ -65,7 +65,7 @@ subroutine psb_ialloc(x, desc_a, info, n)
name='psb_ialloc'
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -1) then
@ -74,9 +74,9 @@ subroutine psb_ialloc(x, desc_a, info, n)
goto 9999
endif
dectype=desc_a%matrix_data(psb_dec_type_)
dectype=psb_get_dectype(desc_a)
!... check m and n parameters....
if (.not.psb_is_ok_dec(dectype)) then
if (.not.psb_is_ok_desc(desc_a)) then
info = 3110
call psb_errpush(info,name)
goto 9999
@ -102,8 +102,8 @@ subroutine psb_ialloc(x, desc_a, info, n)
endif
!....allocate x .....
if (psb_is_asb_dec(dectype).or.psb_is_upd_dec(dectype)) then
n_col = max(1,desc_a%matrix_data(psb_n_col_))
if (psb_is_asb_desc(desc_a).or.psb_is_upd_desc(desc_a)) then
n_col = max(1,psb_get_local_cols(desc_a))
allocate(x(n_col,n_),stat=info)
if (info /= 0) then
info=4010
@ -116,8 +116,8 @@ subroutine psb_ialloc(x, desc_a, info, n)
x(i,j) = 0
end do
end do
else if (psb_is_bld_dec(dectype)) then
n_row = max(1,desc_a%matrix_data(psb_n_row_))
else if (psb_is_bld_desc(desc_a)) then
n_row = max(1,psb_get_local_rows(desc_a))
allocate(x(n_row,n_),stat=info)
if (info /= 0) then
info=4010
@ -213,7 +213,7 @@ subroutine psb_iallocv(x, desc_a, info,n)
name='psb_iallocv'
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
! ....verify blacs grid correctness..
@ -223,11 +223,11 @@ subroutine psb_iallocv(x, desc_a, info,n)
goto 9999
endif
dectype=desc_a%matrix_data(psb_dec_type_)
dectype=psb_get_dectype(desc_a)
if (debug) write(0,*) 'dall: dectype',dectype
if (debug) write(0,*) 'dall: is_ok? dectype',psb_is_ok_dec(dectype)
if (debug) write(0,*) 'dall: is_ok? dectype',psb_is_ok_desc(desc_a)
!... check m and n parameters....
if (.not.psb_is_ok_dec(dectype)) then
if (.not.psb_is_ok_desc(desc_a)) then
info = 3110
call psb_errpush(info,name)
goto 9999
@ -236,8 +236,8 @@ subroutine psb_iallocv(x, desc_a, info,n)
! As this is a rank-1 array, optional parameter N is actually ignored.
!....allocate x .....
if (psb_is_asb_dec(dectype).or.psb_is_upd_dec(dectype)) then
n_col = max(1,desc_a%matrix_data(psb_n_col_))
if (psb_is_asb_desc(desc_a).or.psb_is_upd_desc(desc_a)) then
n_col = max(1,psb_get_local_cols(desc_a))
allocate(x(n_col),stat=info)
if (info.ne.0) then
info=2025
@ -245,8 +245,8 @@ subroutine psb_iallocv(x, desc_a, info,n)
call psb_errpush(info,name,int_err)
goto 9999
endif
else if (psb_is_bld_dec(dectype)) then
n_row = max(1,desc_a%matrix_data(psb_n_row_))
else if (psb_is_bld_desc(desc_a)) then
n_row = max(1,psb_get_local_rows(desc_a))
allocate(x(n_row),stat=info)
if (info.ne.0) then
info=2025

24
src/tools/psb_iasb.f90
Unescape Escape View File

@ -68,20 +68,20 @@ subroutine psb_iasb(x, desc_a, info)
return
endif
ictxt=desc_a%matrix_data(psb_ctxt_)
dectype=desc_a%matrix_data(psb_dec_type_)
ictxt=psb_get_context(desc_a)
dectype=psb_get_dectype(desc_a)
call psb_info(ictxt, me, np)
if (debug) write(*,*) 'asb start: ',np,me,&
&desc_a%matrix_data(psb_dec_type_)
&psb_get_dectype(desc_a)
! ....verify blacs grid correctness..
if (np == -1) then
info = 2010
call psb_errpush(info,name)
goto 9999
else if (.not.psb_is_asb_dec(dectype)) then
else if (.not.psb_is_asb_desc(desc_a)) then
if (debug) write(*,*) 'asb error ',&
&dectype
info = 3110
@ -90,9 +90,9 @@ subroutine psb_iasb(x, desc_a, info)
endif
! check size
ictxt=desc_a%matrix_data(psb_ctxt_)
nrow=desc_a%matrix_data(psb_n_row_)
ncol=desc_a%matrix_data(psb_n_col_)
ictxt=psb_get_context(desc_a)
nrow=psb_get_local_rows(desc_a)
ncol=psb_get_local_cols(desc_a)
i1sz = size(x,dim=1)
i2sz = size(x,dim=2)
if (debug) write(*,*) 'asb: ',i1sz,i2sz,nrow,ncol
@ -187,8 +187,8 @@ subroutine psb_iasbv(x, desc_a, info)
name = 'psb_iasbv'
ictxt=desc_a%matrix_data(psb_ctxt_)
dectype=desc_a%matrix_data(psb_dec_type_)
ictxt=psb_get_context(desc_a)
dectype=psb_get_dectype(desc_a)
call psb_info(ictxt, me, np)
@ -197,14 +197,14 @@ subroutine psb_iasbv(x, desc_a, info)
info = 2010
call psb_errpush(info,name)
goto 9999
else if (.not.psb_is_asb_dec(dectype)) then
else if (.not.psb_is_asb_desc(desc_a)) then
info = 3110
call psb_errpush(info,name)
goto 9999
endif
nrow=desc_a%matrix_data(psb_n_row_)
ncol=desc_a%matrix_data(psb_n_col_)
nrow=psb_get_local_rows(desc_a)
ncol=psb_get_local_cols(desc_a)
if (debug) write(*,*) name,' sizes: ',nrow,ncol
i1sz = size(x)
if (debug) write(*,*) 'dasb: sizes ',i1sz,ncol

4
src/tools/psb_ifree.f90
Unescape Escape View File

@ -66,7 +66,7 @@ subroutine psb_ifree(x, desc_a, info)
return
end if
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
! ....verify blacs grid correctness..
@ -170,7 +170,7 @@ subroutine psb_ifreev(x, desc_a,info)
call psb_errpush(info,name)
return
end if
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
! ....verify blacs grid correctness..

28
src/tools/psb_iins.f90
Unescape Escape View File

@ -82,7 +82,7 @@ subroutine psb_iinsvi(m, irw, val, x, desc_a, info, dupl)
return
end if
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -1) then
@ -98,12 +98,12 @@ subroutine psb_iinsvi(m, irw, val, x, desc_a, info, dupl)
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999
else if (.not.psb_is_ok_dec(desc_a%matrix_data(psb_dec_type_))) then
else if (.not.psb_is_ok_desc(desc_a)) then
info = 3110
int_err(1) = desc_a%matrix_data(psb_dec_type_)
int_err(1) = psb_get_dectype(desc_a)
call psb_errpush(info,name,int_err)
goto 9999
else if (size(x, dim=1) < desc_a%matrix_data(psb_n_row_)) then
else if (size(x, dim=1) < psb_get_local_rows(desc_a)) then
info = 310
int_err(1) = 5
int_err(2) = 4
@ -111,9 +111,9 @@ subroutine psb_iinsvi(m, irw, val, x, desc_a, info, dupl)
goto 9999
endif
loc_rows=desc_a%matrix_data(psb_n_row_)
loc_cols=desc_a%matrix_data(psb_n_col_)
mglob = desc_a%matrix_data(psb_m_)
loc_rows=psb_get_local_rows(desc_a)
loc_cols=psb_get_local_cols(desc_a)
mglob = psb_get_global_rows(desc_a)
if (present(dupl)) then
dupl_ = dupl
@ -263,7 +263,7 @@ subroutine psb_iinsi(m,irw, val, x, desc_a, info, dupl)
return
end if
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -1) then
@ -279,12 +279,12 @@ subroutine psb_iinsi(m,irw, val, x, desc_a, info, dupl)
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999
else if (.not.psb_is_ok_dec(desc_a%matrix_data(psb_dec_type_))) then
else if (.not.psb_is_ok_desc(desc_a)) then
info = 3110
int_err(1) = desc_a%matrix_data(psb_dec_type_)
int_err(1) = psb_get_dectype(desc_a)
call psb_errpush(info,name,int_err)
goto 9999
else if (size(x, dim=1) < desc_a%matrix_data(psb_n_row_)) then
else if (size(x, dim=1) < psb_get_local_rows(desc_a)) then
info = 310
int_err(1) = 5
int_err(2) = 4
@ -292,9 +292,9 @@ subroutine psb_iinsi(m,irw, val, x, desc_a, info, dupl)
goto 9999
endif
loc_rows=desc_a%matrix_data(psb_n_row_)
loc_cols=desc_a%matrix_data(psb_n_col_)
mglob = desc_a%matrix_data(psb_m_)
loc_rows=psb_get_local_rows(desc_a)
loc_cols=psb_get_local_cols(desc_a)
mglob = psb_get_global_rows(desc_a)
n = min(size(val,2),size(x,2))

14
src/tools/psb_loc_to_glob.f90
Unescape Escape View File

@ -79,20 +79,20 @@ subroutine psb_loc_to_glob2(x,y,desc_a,info,iact)
n=size(x)
do i=1,n
if ((x(i).gt.desc_a%matrix_data(psb_n_col_)).or.&
if ((x(i).gt.psb_get_local_cols(desc_a)).or.&
& (x(i).le.zero)) then
info=140
int_err(1)=tmp
int_err(2)=desc_a%matrix_data(psb_n_col_)
int_err(2)=psb_get_local_cols(desc_a)
exit
else
tmp=desc_a%loc_to_glob(x(i))
if((tmp.gt.zero).or.(tmp.le.desc_a%matrix_data(psb_m_))) then
if((tmp.gt.zero).or.(tmp.le.psb_get_global_rows(desc_a))) then
y(i)=tmp
else
info = 140
int_err(1)=tmp
int_err(2)=desc_a%matrix_data(psb_n_col_)
int_err(2)=psb_get_local_cols(desc_a)
exit
end if
end if
@ -204,15 +204,15 @@ subroutine psb_loc_to_glob(x,desc_a,info,iact)
n=size(x)
do i=1,n
if ((x(i).gt.desc_a%matrix_data(psb_n_col_)).or.&
if ((x(i).gt.psb_get_local_cols(desc_a)).or.&
& (x(i).le.zero)) then
info=140
int_err(1)=x(i)
int_err(2)=desc_a%matrix_data(psb_n_col_)
int_err(2)=psb_get_local_cols(desc_a)
exit
else
tmp=desc_a%loc_to_glob(x(i))
if((tmp.gt.zero).or.(tmp.le.desc_a%matrix_data(psb_m_))) then
if((tmp.gt.zero).or.(tmp.le.psb_get_global_rows(desc_a))) then
x(i)=tmp
else
info = 140

30
src/tools/psb_zallc.f90
Unescape Escape View File

@ -67,7 +67,7 @@ subroutine psb_zalloc(x, desc_a, info, n)
int_err(1)=0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -1) then
@ -76,9 +76,9 @@ subroutine psb_zalloc(x, desc_a, info, n)
goto 9999
endif
dectype=desc_a%matrix_data(psb_dec_type_)
dectype=psb_get_dectype(desc_a)
!... check m and n parameters....
if (.not.psb_is_ok_dec(dectype)) then
if (.not.psb_is_ok_desc(desc_a)) then
info = 3110
call psb_errpush(info,name)
goto 9999
@ -104,8 +104,8 @@ subroutine psb_zalloc(x, desc_a, info, n)
endif
!....allocate x .....
if (psb_is_asb_dec(dectype).or.psb_is_upd_dec(dectype)) then
n_col = max(1,desc_a%matrix_data(psb_n_col_))
if (psb_is_asb_desc(desc_a).or.psb_is_upd_desc(desc_a)) then
n_col = max(1,psb_get_local_cols(desc_a))
allocate(x(n_col,n_),stat=info)
if (info /= 0) then
info=4010
@ -118,8 +118,8 @@ subroutine psb_zalloc(x, desc_a, info, n)
x(i,j) = 0.0d0
end do
end do
else if (psb_is_bld_dec(dectype)) then
n_row = max(1,desc_a%matrix_data(psb_n_row_))
else if (psb_is_bld_desc(desc_a)) then
n_row = max(1,psb_get_local_rows(desc_a))
allocate(x(n_row,n_),stat=info)
if (info /= 0) then
info=4010
@ -212,7 +212,7 @@ subroutine psb_zallocv(x, desc_a,info,n)
name='psb_zallcv'
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
! ....verify blacs grid correctness..
@ -222,11 +222,11 @@ subroutine psb_zallocv(x, desc_a,info,n)
goto 9999
endif
dectype=desc_a%matrix_data(psb_dec_type_)
dectype=psb_get_dectype(desc_a)
if (debug) write(0,*) 'dall: dectype',dectype
if (debug) write(0,*) 'dall: is_ok? dectype',psb_is_ok_dec(dectype)
if (debug) write(0,*) 'dall: is_ok? dectype',psb_is_ok_desc(desc_a)
!... check m and n parameters....
if (.not.psb_is_ok_dec(dectype)) then
if (.not.psb_is_ok_desc(desc_a)) then
info = 3110
call psb_errpush(info,name)
goto 9999
@ -235,8 +235,8 @@ subroutine psb_zallocv(x, desc_a,info,n)
! As this is a rank-1 array, optional parameter N is actually ignored.
!....allocate x .....
if (psb_is_asb_dec(dectype).or.psb_is_upd_dec(dectype)) then
n_col = max(1,desc_a%matrix_data(psb_n_col_))
if (psb_is_asb_desc(desc_a).or.psb_is_upd_desc(desc_a)) then
n_col = max(1,psb_get_local_cols(desc_a))
call psb_realloc(n_col,x,info)
if (info /= 0) then
info=4010
@ -248,8 +248,8 @@ subroutine psb_zallocv(x, desc_a,info,n)
x(i) = 0.0d0
end do
else if (psb_is_bld_dec(dectype)) then
n_row = max(1,desc_a%matrix_data(psb_n_row_))
else if (psb_is_bld_desc(desc_a)) then
n_row = max(1,psb_get_local_rows(desc_a))
call psb_realloc(n_row,x,info)
if (info /= 0) then
info=4010

24
src/tools/psb_zasb.f90
Unescape Escape View File

@ -68,20 +68,20 @@ subroutine psb_zasb(x, desc_a, info)
goto 9999
endif
ictxt=desc_a%matrix_data(psb_ctxt_)
dectype=desc_a%matrix_data(psb_dec_type_)
ictxt=psb_get_context(desc_a)
dectype=psb_get_dectype(desc_a)
call psb_info(ictxt, me, np)
if (debug) write(*,*) 'asb start: ',np,me,&
&desc_a%matrix_data(psb_dec_type_)
&psb_get_dectype(desc_a)
! ....verify blacs grid correctness..
if (np == -1) then
info = 2010
call psb_errpush(info,name)
goto 9999
else if (.not.psb_is_asb_dec(dectype)) then
else if (.not.psb_is_asb_desc(desc_a)) then
if (debug) write(*,*) 'asb error ',&
&dectype
info = 3110
@ -90,9 +90,9 @@ subroutine psb_zasb(x, desc_a, info)
endif
! check size
ictxt=desc_a%matrix_data(psb_ctxt_)
nrow=desc_a%matrix_data(psb_n_row_)
ncol=desc_a%matrix_data(psb_n_col_)
ictxt=psb_get_context(desc_a)
nrow=psb_get_local_rows(desc_a)
ncol=psb_get_local_cols(desc_a)
i1sz = size(x,dim=1)
i2sz = size(x,dim=2)
if (debug) write(*,*) 'asb: ',i1sz,i2sz,nrow,ncol
@ -191,8 +191,8 @@ subroutine psb_zasbv(x, desc_a, info)
int_err(1) = 0
name = 'psb_zasbv'
ictxt=desc_a%matrix_data(psb_ctxt_)
dectype=desc_a%matrix_data(psb_dec_type_)
ictxt=psb_get_context(desc_a)
dectype=psb_get_dectype(desc_a)
call psb_info(ictxt, me, np)
@ -201,14 +201,14 @@ subroutine psb_zasbv(x, desc_a, info)
info = 2010
call psb_errpush(info,name)
goto 9999
else if (.not.psb_is_asb_dec(dectype)) then
else if (.not.psb_is_asb_desc(desc_a)) then
info = 3110
call psb_errpush(info,name)
goto 9999
endif
nrow=desc_a%matrix_data(psb_n_row_)
ncol=desc_a%matrix_data(psb_n_col_)
nrow=psb_get_local_rows(desc_a)
ncol=psb_get_local_cols(desc_a)
if (debug) write(*,*) name,' sizes: ',nrow,ncol
i1sz = size(x)
if (debug) write(*,*) 'dasb: sizes ',i1sz,ncol

6
src/tools/psb_zcdovr.f90
Unescape Escape View File

@ -101,15 +101,15 @@ Subroutine psb_zcdovr(a,desc_a,novr,desc_ov,info)
info = 0
call psb_erractionsave(err_act)
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
Call psb_info(ictxt, me, np)
If(debug) Write(0,*)'in psb_cdovr',novr
m=desc_a%matrix_data(psb_n_row_)
m=psb_get_local_rows(desc_a)
nnzero=Size(a%aspk)
n_col=desc_a%matrix_data(psb_n_col_)
n_col=psb_get_local_cols(desc_a)
nhalo = n_col-m
If(debug) Write(0,*)'IN CDOVR1',novr ,m,nnzero,n_col
if (novr<0) then

14
src/tools/psb_zcdovrbld.f90
Unescape Escape View File

@ -94,7 +94,7 @@ Subroutine psb_zcdovrbld(n_ovr,desc_p,desc_a,a,&
call psb_erractionsave(err_act)
If(debug) Write(0,*)'cdovrbld begin'
ictxt = desc_a%matrix_data(psb_ctxt_)
ictxt = psb_get_context(desc_a)
Call psb_info(ictxt,me,np)
@ -108,10 +108,10 @@ Subroutine psb_zcdovrbld(n_ovr,desc_p,desc_a,a,&
t4 = 0.0
call psb_get_mpicomm(ictxt,icomm )
mglob = desc_a%matrix_data(psb_m_)
m = desc_a%matrix_data(psb_n_row_)
n_row = desc_a%matrix_data(psb_n_row_)
n_col = desc_a%matrix_data(psb_n_col_)
mglob = psb_get_global_rows(desc_a)
m = psb_get_local_rows(desc_a)
n_row = psb_get_local_rows(desc_a)
n_col = psb_get_local_cols(desc_a)
if (debug) write(0,*) me,' On entry to CDOVRBLD n_col:',n_col
dl_lda=np*5
@ -537,8 +537,8 @@ Subroutine psb_zcdovrbld(n_ovr,desc_p,desc_a,a,&
End Do
t1 = mpi_wtime()
desc_p%matrix_data(psb_m_)=desc_a%matrix_data(psb_m_)
desc_p%matrix_data(psb_n_)=desc_a%matrix_data(psb_n_)
desc_p%matrix_data(psb_m_)=psb_get_global_rows(desc_a)
desc_p%matrix_data(psb_n_)=psb_get_global_cols(desc_a)
tmp_halo(counter_h)=-1
tmp_ovr_idx(counter_o)=-1

10
src/tools/psb_zcsrp.f90
Unescape Escape View File

@ -88,10 +88,10 @@ subroutine psb_zcsrp(trans,iperm,a, desc_a, info)
time(1) = mpi_wtime()
ictxt=desc_a%matrix_data(psb_ctxt_)
dectype=desc_a%matrix_data(psb_dec_type_)
n_row = desc_a%matrix_data(psb_n_row_)
n_col = desc_a%matrix_data(psb_n_col_)
ictxt=psb_get_context(desc_a)
dectype=psb_get_dectype(desc_a)
n_row = psb_get_local_rows(desc_a)
n_col = psb_get_local_cols(desc_a)
if(psb_get_errstatus() /= 0) return
info=0
@ -107,7 +107,7 @@ subroutine psb_zcsrp(trans,iperm,a, desc_a, info)
endif
if (.not.psb_is_asb_dec(dectype)) then
if (.not.psb_is_asb_desc(desc_a)) then
info = 600
int_err(1) = dectype
call psb_errpush(info,name,int_err)

4
src/tools/psb_zfree.f90
Unescape Escape View File

@ -65,7 +65,7 @@ subroutine psb_zfree(x, desc_a, info)
return
end if
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
! ....verify blacs grid correctness..
@ -141,7 +141,7 @@ subroutine psb_zfreev(x, desc_a, info)
call psb_errpush(info,name)
goto 9999
end if
ictxt=desc_a%matrix_data(psb_ctxt_)
ictxt=psb_get_context(desc_a)
call psb_info(ictxt, me, np)
if (np == -1) then

Some files were not shown because too many files have changed in this diff Show More

Write Preview
Loading…
Cancel
Save