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

Added new getter routines for CD and SP. Moved some code (spinfo) from

Browse Source 
serial dir to module file.
psblas3-type-indexed
Salvatore Filippone 18 years ago
parent 8baf079deb
commit 88060f4a61
112 changed files with 1245 additions and 1389 deletions
Show Stats Download Patch File Download Diff File

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

@ -77,7 +77,7 @@ subroutine psb_dgatherm(globx, locx, desc_a, info, iroot,&
info=0 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) 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_globx = size(globx,1)
lda_locx = size(locx, 1) lda_locx = size(locx, 1)
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a) n = psb_cd_get_global_cols(desc_a)
lock=size(locx,2)-jlocx+1 lock=size(locx,2)-jlocx+1
globk=size(globx,2)-jglobx+1 globk=size(globx,2)-jglobx+1
@ -170,7 +170,7 @@ subroutine psb_dgatherm(globx, locx, desc_a, info, iroot,&
globx(:,:)=0.d0 globx(:,:)=0.d0
do j=1,k do j=1,k
do i=1,psb_get_local_rows(desc_a) do i=1,psb_cd_get_local_rows(desc_a)
idx = desc_a%loc_to_glob(i) idx = desc_a%loc_to_glob(i)
globx(idx,jglobx+j-1) = locx(i,jlx+j-1) globx(idx,jglobx+j-1) = locx(i,jlx+j-1)
end do end do
@ -280,7 +280,7 @@ subroutine psb_dgatherv(globx, locx, desc_a, info, iroot,&
info=0 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
@ -319,8 +319,8 @@ subroutine psb_dgatherv(globx, locx, desc_a, info, iroot,&
lda_globx = size(globx) lda_globx = size(globx)
lda_locx = size(locx) lda_locx = size(locx)
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a) n = psb_cd_get_global_cols(desc_a)
k = 1 k = 1
@ -344,7 +344,7 @@ subroutine psb_dgatherv(globx, locx, desc_a, info, iroot,&
globx(:)=0.d0 globx(:)=0.d0
do i=1,psb_get_local_rows(desc_a) do i=1,psb_cd_get_local_rows(desc_a)
idx = desc_a%loc_to_glob(i) idx = desc_a%loc_to_glob(i)
globx(idx) = locx(i) globx(idx) = locx(i)
end do end do

16
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 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) 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 ijx = 1
endif endif
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a) n = psb_cd_get_global_cols(desc_a)
nrow = psb_get_local_rows(desc_a) nrow = psb_cd_get_local_rows(desc_a)
maxk=size(x,2)-ijx+1 maxk=size(x,2)-ijx+1
@ -289,7 +289,7 @@ subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode)
info=0 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
@ -302,9 +302,9 @@ subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode)
ix = 1 ix = 1
ijx = 1 ijx = 1
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a) n = psb_cd_get_global_cols(desc_a)
nrow = psb_get_local_rows(desc_a) nrow = psb_cd_get_local_rows(desc_a)
if (present(tran)) then if (present(tran)) then
ltran = tran ltran = tran

20
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 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
@ -90,10 +90,10 @@ subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,update)
ijx = 1 ijx = 1
endif endif
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a) n = psb_cd_get_global_cols(desc_a)
nrow = psb_get_local_rows(desc_a) nrow = psb_cd_get_local_rows(desc_a)
ncol = psb_get_local_cols(desc_a) ncol = psb_cd_get_local_cols(desc_a)
maxk=size(x,2)-ijx+1 maxk=size(x,2)-ijx+1
@ -291,7 +291,7 @@ subroutine psb_dovrlv(x,desc_a,info,work,update)
info=0 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
@ -304,10 +304,10 @@ subroutine psb_dovrlv(x,desc_a,info,work,update)
ix = 1 ix = 1
ijx = 1 ijx = 1
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a) n = psb_cd_get_global_cols(desc_a)
nrow = psb_get_local_rows(desc_a) nrow = psb_cd_get_local_rows(desc_a)
ncol = psb_get_local_cols(desc_a) ncol = psb_cd_get_local_cols(desc_a)
k = 1 k = 1

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

@ -79,7 +79,7 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, iroot,&
info=0 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) 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_globx = size(globx,1)
lda_locx = size(locx, 1) lda_locx = size(locx, 1)
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a) n = psb_cd_get_global_cols(desc_a)
lock=size(locx,2)-jlocx+1 lock=size(locx,2)-jlocx+1
globk=size(globx,2)-jglobx+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_globx = size(globx)
lda_locx = size(locx) lda_locx = size(locx)
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a) n = psb_cd_get_global_cols(desc_a)
if (me == iiroot) then if (me == iiroot) then
call igebs2d(ictxt, 'all', ' ', 1, 1, k, 1) call igebs2d(ictxt, 'all', ' ', 1, 1, k, 1)
@ -181,7 +181,7 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, iroot,&
goto 9999 goto 9999
end if end if
nrow=psb_get_local_rows(desc_a) nrow=psb_cd_get_local_rows(desc_a)
if(root == -1) then if(root == -1) then
! extract my chunk ! extract my chunk
@ -336,7 +336,7 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, iroot)
info=0 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
@ -364,8 +364,8 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, iroot)
lda_globx = size(globx) lda_globx = size(globx)
lda_locx = size(locx) lda_locx = size(locx)
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a) n = psb_cd_get_global_cols(desc_a)
k = 1 k = 1
@ -393,7 +393,7 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, iroot)
goto 9999 goto 9999
end if end if
nrow=psb_get_local_rows(desc_a) nrow=psb_cd_get_local_rows(desc_a)
if(root == -1) then if(root == -1) then
! extract my chunk ! extract my chunk

18
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 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) 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 ijx = 1
endif endif
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a) n = psb_cd_get_global_cols(desc_a)
nrow = psb_get_local_rows(desc_a) nrow = psb_cd_get_local_rows(desc_a)
maxk=size(x,2)-ijx+1 maxk=size(x,2)-ijx+1
@ -285,7 +285,7 @@ subroutine psb_ihalov(x,desc_a,info,alpha,work,tran,mode)
info=0 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
@ -298,10 +298,10 @@ subroutine psb_ihalov(x,desc_a,info,alpha,work,tran,mode)
ix = 1 ix = 1
ijx = 1 ijx = 1
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a) n = psb_cd_get_global_cols(desc_a)
nrow = psb_get_local_rows(desc_a) nrow = psb_cd_get_local_rows(desc_a)
! ncol = psb_get_local_cols(desc_a) ! ncol = psb_cd_get_local_cols(desc_a)
if (present(tran)) then if (present(tran)) then

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

@ -78,7 +78,7 @@ subroutine psb_zgatherm(globx, locx, desc_a, info, iroot,&
info=0 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) 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_globx = size(globx,1)
lda_locx = size(locx, 1) lda_locx = size(locx, 1)
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a) n = psb_cd_get_global_cols(desc_a)
lock=size(locx,2)-jlocx+1 lock=size(locx,2)-jlocx+1
globk=size(globx,2)-jglobx+1 globk=size(globx,2)-jglobx+1
@ -172,7 +172,7 @@ subroutine psb_zgatherm(globx, locx, desc_a, info, iroot,&
globx(:,:)=0.d0 globx(:,:)=0.d0
do j=1,k do j=1,k
do i=1,psb_get_local_rows(desc_a) do i=1,psb_cd_get_local_rows(desc_a)
idx = desc_a%loc_to_glob(i) idx = desc_a%loc_to_glob(i)
globx(idx,jglobx+j-1) = locx(i,jlx+j-1) globx(idx,jglobx+j-1) = locx(i,jlx+j-1)
end do end do
@ -282,7 +282,7 @@ subroutine psb_zgatherv(globx, locx, desc_a, info, iroot,&
info=0 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
@ -321,8 +321,8 @@ subroutine psb_zgatherv(globx, locx, desc_a, info, iroot,&
lda_globx = size(globx) lda_globx = size(globx)
lda_locx = size(locx) lda_locx = size(locx)
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a) n = psb_cd_get_global_cols(desc_a)
k = 1 k = 1
@ -347,7 +347,7 @@ subroutine psb_zgatherv(globx, locx, desc_a, info, iroot,&
globx(:)=0.d0 globx(:)=0.d0
do i=1,psb_get_local_rows(desc_a) do i=1,psb_cd_get_local_rows(desc_a)
idx = desc_a%loc_to_glob(i) idx = desc_a%loc_to_glob(i)
globx(idx) = locx(i) globx(idx) = locx(i)
end do end do

16
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 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) 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 ijx = 1
endif endif
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a) n = psb_cd_get_global_cols(desc_a)
nrow = psb_get_local_rows(desc_a) nrow = psb_cd_get_local_rows(desc_a)
maxk=size(x,2)-ijx+1 maxk=size(x,2)-ijx+1
@ -283,7 +283,7 @@ subroutine psb_zhalov(x,desc_a,info,alpha,work,tran,mode)
info=0 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
@ -296,9 +296,9 @@ subroutine psb_zhalov(x,desc_a,info,alpha,work,tran,mode)
ix = 1 ix = 1
ijx = 1 ijx = 1
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a) n = psb_cd_get_global_cols(desc_a)
nrow = psb_get_local_rows(desc_a) nrow = psb_cd_get_local_rows(desc_a)
if (present(tran)) then if (present(tran)) then
ltran = tran ltran = tran

20
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 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
@ -90,10 +90,10 @@ subroutine psb_zovrlm(x,desc_a,info,jx,ik,work,update)
ijx = 1 ijx = 1
endif endif
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a) n = psb_cd_get_global_cols(desc_a)
nrow = psb_get_local_rows(desc_a) nrow = psb_cd_get_local_rows(desc_a)
ncol = psb_get_local_cols(desc_a) ncol = psb_cd_get_local_cols(desc_a)
maxk=size(x,2)-ijx+1 maxk=size(x,2)-ijx+1
@ -291,7 +291,7 @@ subroutine psb_zovrlv(x,desc_a,info,work,update)
info=0 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
@ -304,10 +304,10 @@ subroutine psb_zovrlv(x,desc_a,info,work,update)
ix = 1 ix = 1
ijx = 1 ijx = 1
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a) n = psb_cd_get_global_cols(desc_a)
nrow = psb_get_local_rows(desc_a) nrow = psb_cd_get_local_rows(desc_a)
ncol = psb_get_local_cols(desc_a) ncol = psb_cd_get_local_cols(desc_a)
k = 1 k = 1

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

@ -79,7 +79,7 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, iroot,&
info=0 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) 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_globx = size(globx,1)
lda_locx = size(locx, 1) lda_locx = size(locx, 1)
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a) n = psb_cd_get_global_cols(desc_a)
lock=size(locx,2)-jlocx+1 lock=size(locx,2)-jlocx+1
globk=size(globx,2)-jglobx+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_globx = size(globx)
lda_locx = size(locx) lda_locx = size(locx)
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a) n = psb_cd_get_global_cols(desc_a)
if (me == iiroot) then if (me == iiroot) then
call igebs2d(ictxt, 'all', ' ', 1, 1, k, 1) call igebs2d(ictxt, 'all', ' ', 1, 1, k, 1)
@ -181,7 +181,7 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, iroot,&
goto 9999 goto 9999
end if end if
nrow=psb_get_local_rows(desc_a) nrow=psb_cd_get_local_rows(desc_a)
if(root == -1) then if(root == -1) then
! extract my chunk ! extract my chunk
@ -336,7 +336,7 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, iroot)
info=0 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
@ -364,8 +364,8 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, iroot)
lda_globx = size(globx) lda_globx = size(globx)
lda_locx = size(locx) lda_locx = size(locx)
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a) n = psb_cd_get_global_cols(desc_a)
k = 1 k = 1
@ -393,7 +393,7 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, iroot)
goto 9999 goto 9999
end if end if
nrow=psb_get_local_rows(desc_a) nrow=psb_cd_get_local_rows(desc_a)
if(root == -1) then if(root == -1) then
! extract my chunk ! 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' name='psi_crea_index'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = psb_get_context(desc_a) ictxt = psb_cd_get_context(desc_a)
call psb_info(ictxt,me,np) call psb_info(ictxt,me,np)
if (np == -1) then if (np == -1) then
info = 2010 info = 2010

4
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' name='psi_swap_data'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt,me,np) call psb_info(ictxt,me,np)
if (np == -1) then if (np == -1) then
info = 2010 info = 2010
@ -474,7 +474,7 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
name='psi_swap_datav' name='psi_swap_datav'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt,me,np) call psb_info(ictxt,me,np)
if (np == -1) then if (np == -1) then
info = 2010 info = 2010

4
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' name='psi_swap_tran'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt,me,np) call psb_info(ictxt,me,np)
if (np == -1) then if (np == -1) then
info = 2010 info = 2010
@ -466,7 +466,7 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
name='psi_swap_tranv' name='psi_swap_tranv'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt,me,np) call psb_info(ictxt,me,np)
if (np == -1) then if (np == -1) then
info = 2010 info = 2010

4
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' name='psi_swap_data'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt,me,np) call psb_info(ictxt,me,np)
if (np == -1) then if (np == -1) then
info = 2010 info = 2010
@ -474,7 +474,7 @@ subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data)
name='psi_swap_datav' name='psi_swap_datav'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt,me,np) call psb_info(ictxt,me,np)
if (np == -1) then if (np == -1) then
info = 2010 info = 2010

4
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' name='psi_swap_tran'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt,me,np) call psb_info(ictxt,me,np)
if (np == -1) then if (np == -1) then
info = 2010 info = 2010
@ -466,7 +466,7 @@ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data)
name='psi_swap_tranv' name='psi_swap_tranv'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt,me,np) call psb_info(ictxt,me,np)
if (np == -1) then if (np == -1) then
info = 2010 info = 2010

4
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' name='psi_swap_data'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt,me,np) call psb_info(ictxt,me,np)
if (np == -1) then if (np == -1) then
info = 2010 info = 2010
@ -474,7 +474,7 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data)
name='psi_swap_datav' name='psi_swap_datav'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt,me,np) call psb_info(ictxt,me,np)
if (np == -1) then if (np == -1) then
info = 2010 info = 2010

4
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' name='psi_swap_tran'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt,me,np) call psb_info(ictxt,me,np)
if (np == -1) then if (np == -1) then
info = 2010 info = 2010
@ -463,7 +463,7 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data)
name='psi_swap_tranv' name='psi_swap_tranv'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt,me,np) call psb_info(ictxt,me,np)
if (np == -1) then if (np == -1) then
info = 2010 info = 2010

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) call psb_erractionsave(err_act)
if (debug) write(*,*) 'entering psb_dbicg' if (debug) write(*,*) 'entering psb_dbicg'
ictxt = psb_get_context(desc_a) ictxt = psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (debug) write(*,*) 'psb_dbicg: from gridinfo',np,me if (debug) write(*,*) 'psb_dbicg: from gridinfo',np,me
mglob = psb_get_global_rows(desc_a) mglob = psb_cd_get_global_rows(desc_a)
n_row = psb_get_local_rows(desc_a) n_row = psb_cd_get_local_rows(desc_a)
n_col = psb_get_local_cols(desc_a) n_col = psb_cd_get_local_cols(desc_a)
! Ensure global coherence for convergence checks. ! Ensure global coherence for convergence checks.
call psb_set_coher(ictxt,isvch) 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) call psb_erractionsave(err_act)
ictxt = psb_get_context(desc_a) ictxt = psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
mglob = psb_get_global_rows(desc_a) mglob = psb_cd_get_global_rows(desc_a)
n_row = psb_get_local_rows(desc_a) n_row = psb_cd_get_local_rows(desc_a)
n_col = psb_get_local_cols(desc_a) n_col = psb_cd_get_local_cols(desc_a)
if (present(istop)) then 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) call psb_erractionsave(err_act)
If (debug) Write(*,*) 'entering psb_dcgs' If (debug) Write(*,*) 'entering psb_dcgs'
ictxt = psb_get_context(desc_a) ictxt = psb_cd_get_context(desc_a)
Call psb_info(ictxt, me, np) Call psb_info(ictxt, me, np)
If (debug) Write(*,*) 'psb_dcgs: from gridinfo',np,me If (debug) Write(*,*) 'psb_dcgs: from gridinfo',np,me
mglob = psb_get_global_rows(desc_a) mglob = psb_cd_get_global_rows(desc_a)
n_row = psb_get_local_rows(desc_a) n_row = psb_cd_get_local_rows(desc_a)
n_col = psb_get_local_cols(desc_a) n_col = psb_cd_get_local_cols(desc_a)
If (Present(istop)) Then If (Present(istop)) Then
istop_ = istop 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) call psb_erractionsave(err_act)
If (debug) Write(*,*) 'Entering PSB_DCGSTAB',present(istop) If (debug) Write(*,*) 'Entering PSB_DCGSTAB',present(istop)
ictxt = psb_get_context(desc_a) ictxt = psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (debug) write(*,*) 'PSB_DCGSTAB: From GRIDINFO',np,me if (debug) write(*,*) 'PSB_DCGSTAB: From GRIDINFO',np,me
mglob = psb_get_global_rows(desc_a) mglob = psb_cd_get_global_rows(desc_a)
n_row = psb_get_local_rows(desc_a) n_row = psb_cd_get_local_rows(desc_a)
n_col = psb_get_local_cols(desc_a) n_col = psb_cd_get_local_cols(desc_a)
If (Present(istop)) Then If (Present(istop)) Then
istop_ = istop 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) call psb_erractionsave(err_act)
If (debug) Write(0,*) 'entering psb_dbicgstabl' If (debug) Write(0,*) 'entering psb_dbicgstabl'
ictxt = psb_get_context(desc_a) ictxt = psb_cd_get_context(desc_a)
Call psb_info(ictxt, me, np) Call psb_info(ictxt, me, np)
If (debug) Write(0,*) 'psb_dbicgstabl: from gridinfo',np,me If (debug) Write(0,*) 'psb_dbicgstabl: from gridinfo',np,me
mglob = psb_get_global_rows(desc_a) mglob = psb_cd_get_global_rows(desc_a)
n_row = psb_get_local_rows(desc_a) n_row = psb_cd_get_local_rows(desc_a)
n_col = psb_get_local_cols(desc_a) n_col = psb_cd_get_local_cols(desc_a)
if (present(istop)) then if (present(istop)) then
istop_ = istop 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) call psb_erractionsave(err_act)
If (debug) Write(0,*) 'entering psb_dgmres' If (debug) Write(0,*) 'entering psb_dgmres'
ictxt = psb_get_context(desc_a) ictxt = psb_cd_get_context(desc_a)
Call psb_info(ictxt, me, np) Call psb_info(ictxt, me, np)
If (debug) Write(0,*) 'psb_dgmres: from gridinfo',np,me If (debug) Write(0,*) 'psb_dgmres: from gridinfo',np,me
mglob = psb_get_global_rows(desc_a) mglob = psb_cd_get_global_rows(desc_a)
n_row = psb_get_local_rows(desc_a) n_row = psb_cd_get_local_rows(desc_a)
n_col = psb_get_local_cols(desc_a) n_col = psb_cd_get_local_cols(desc_a)
if (present(istop)) then if (present(istop)) then
istop_ = istop 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) call psb_erractionsave(err_act)
If (debug) Write(*,*) 'entering psb_zcgs' If (debug) Write(*,*) 'entering psb_zcgs'
ictxt = psb_get_context(desc_a) ictxt = psb_cd_get_context(desc_a)
Call psb_info(ictxt, me, np) Call psb_info(ictxt, me, np)
If (debug) Write(*,*) 'psb_zcgs: from gridinfo',np,me If (debug) Write(*,*) 'psb_zcgs: from gridinfo',np,me
mglob = psb_get_global_rows(desc_a) mglob = psb_cd_get_global_rows(desc_a)
n_row = psb_get_local_rows(desc_a) n_row = psb_cd_get_local_rows(desc_a)
n_col = psb_get_local_cols(desc_a) n_col = psb_cd_get_local_cols(desc_a)
If (Present(istop)) Then If (Present(istop)) Then
istop_ = istop 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) call psb_erractionsave(err_act)
If (debug) Write(*,*) 'Entering PSB_ZCGSTAB',present(istop) If (debug) Write(*,*) 'Entering PSB_ZCGSTAB',present(istop)
ictxt = psb_get_context(desc_a) ictxt = psb_cd_get_context(desc_a)
CALL psb_info(ictxt, me, np) CALL psb_info(ictxt, me, np)
if (debug) write(*,*) 'PSB_ZCGSTAB: From GRIDINFO',np,me if (debug) write(*,*) 'PSB_ZCGSTAB: From GRIDINFO',np,me
mglob = psb_get_global_rows(desc_a) mglob = psb_cd_get_global_rows(desc_a)
n_row = psb_get_local_rows(desc_a) n_row = psb_cd_get_local_rows(desc_a)
n_col = psb_get_local_cols(desc_a) n_col = psb_cd_get_local_cols(desc_a)
If (Present(istop)) Then If (Present(istop)) Then
istop_ = istop istop_ = istop

2
src/modules/Makefile
Unescape Escape View File

@ -17,7 +17,7 @@ INCDIRS = -I ../../lib
LIBDIR = ../../lib LIBDIR = ../../lib
psb_realloc_mod.o : psb_error_mod.o psb_realloc_mod.o : psb_error_mod.o
psb_spmat_type.o : psb_realloc_mod.o psb_const_mod.o psb_spmat_type.o : psb_realloc_mod.o psb_const_mod.o psb_string_mod.o
psb_error_mod.o: psb_const_mod.o psb_error_mod.o: psb_const_mod.o
psb_penv_mod.o: psb_const_mod.o psb_error_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 psi_mod.o: psb_penv_mod.o psb_error_mod.o psb_desc_type.o

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

@ -102,45 +102,45 @@ contains
info=20 info=20
int_err(1) = 5 int_err(1) = 5
int_err(2) = jx int_err(2) = jx
else if (psb_get_local_cols(desc_dec) < 0) then else if (psb_cd_get_local_cols(desc_dec) < 0) then
info=40 info=40
int_err(1) = 6 int_err(1) = 6
int_err(2) = psb_n_col_ int_err(2) = psb_n_col_
int_err(3) = psb_get_local_cols(desc_dec) int_err(3) = psb_cd_get_local_cols(desc_dec)
else if (psb_get_local_rows(desc_dec) < 0) then else if (psb_cd_get_local_rows(desc_dec) < 0) then
info=40 info=40
int_err(1) = 6 int_err(1) = 6
int_err(2) = psb_n_row_ int_err(2) = psb_n_row_
int_err(3) = psb_get_local_cols(desc_dec) int_err(3) = psb_cd_get_local_cols(desc_dec)
else if (lldx < psb_get_local_cols(desc_dec)) then else if (lldx < psb_cd_get_local_cols(desc_dec)) then
info=50 info=50
int_err(1) = 3 int_err(1) = 3
int_err(2) = lldx int_err(2) = lldx
int_err(3) = 6 int_err(3) = 6
int_err(4) = psb_n_col_ int_err(4) = psb_n_col_
int_err(5) = psb_get_local_cols(desc_dec) int_err(5) = psb_cd_get_local_cols(desc_dec)
else if (psb_get_global_cols(desc_dec) < m) then else if (psb_cd_get_global_cols(desc_dec) < m) then
info=60 info=60
int_err(1) = 1 int_err(1) = 1
int_err(2) = m int_err(2) = m
int_err(3) = 6 int_err(3) = 6
int_err(4) = psb_n_ int_err(4) = psb_n_
int_err(5) = psb_get_global_cols(desc_dec) int_err(5) = psb_cd_get_global_cols(desc_dec)
else if (psb_get_global_cols(desc_dec) < ix) then else if (psb_cd_get_global_cols(desc_dec) < ix) then
info=60 info=60
int_err(1) = 4 int_err(1) = 4
int_err(2) = ix int_err(2) = ix
int_err(3) = 6 int_err(3) = 6
int_err(4) = psb_n_ int_err(4) = psb_n_
int_err(5) = psb_get_global_cols(desc_dec) int_err(5) = psb_cd_get_global_cols(desc_dec)
else if (psb_get_global_rows(desc_dec) < jx) then else if (psb_cd_get_global_rows(desc_dec) < jx) then
info=60 info=60
int_err(1) = 5 int_err(1) = 5
int_err(2) = jx int_err(2) = jx
int_err(3) = 6 int_err(3) = 6
int_err(4) = psb_m_ int_err(4) = psb_m_
int_err(5) = psb_get_global_rows(desc_dec) int_err(5) = psb_cd_get_global_rows(desc_dec)
else if (psb_get_global_cols(desc_dec) < (ix+m-1)) then else if (psb_cd_get_global_cols(desc_dec) < (ix+m-1)) then
info=80 info=80
int_err(1) = 1 int_err(1) = 1
int_err(2) = m int_err(2) = m
@ -227,45 +227,45 @@ contains
info=20 info=20
int_err(1) = 5 int_err(1) = 5
int_err(2) = jx int_err(2) = jx
else if (psb_get_local_cols(desc_dec) < 0) then else if (psb_cd_get_local_cols(desc_dec) < 0) then
info=40 info=40
int_err(1) = 6 int_err(1) = 6
int_err(2) = psb_n_col_ int_err(2) = psb_n_col_
int_err(3) = psb_get_local_cols(desc_dec) int_err(3) = psb_cd_get_local_cols(desc_dec)
else if (psb_get_local_rows(desc_dec) < 0) then else if (psb_cd_get_local_rows(desc_dec) < 0) then
info=40 info=40
int_err(1) = 6 int_err(1) = 6
int_err(2) = psb_n_row_ int_err(2) = psb_n_row_
int_err(3) = psb_get_local_rows(desc_dec) int_err(3) = psb_cd_get_local_rows(desc_dec)
else if (lldx < psb_get_global_rows(desc_dec)) then else if (lldx < psb_cd_get_global_rows(desc_dec)) then
info=50 info=50
int_err(1) = 3 int_err(1) = 3
int_err(2) = lldx int_err(2) = lldx
int_err(3) = 6 int_err(3) = 6
int_err(4) = psb_n_col_ int_err(4) = psb_n_col_
int_err(5) = psb_get_local_cols(desc_dec) int_err(5) = psb_cd_get_local_cols(desc_dec)
else if (psb_get_global_cols(desc_dec) < m) then else if (psb_cd_get_global_cols(desc_dec) < m) then
info=60 info=60
int_err(1) = 1 int_err(1) = 1
int_err(2) = m int_err(2) = m
int_err(3) = 6 int_err(3) = 6
int_err(4) = psb_n_ int_err(4) = psb_n_
int_err(5) = psb_get_global_cols(desc_dec) int_err(5) = psb_cd_get_global_cols(desc_dec)
else if (psb_get_global_cols(desc_dec) < ix) then else if (psb_cd_get_global_cols(desc_dec) < ix) then
info=60 info=60
int_err(1) = 4 int_err(1) = 4
int_err(2) = ix int_err(2) = ix
int_err(3) = 6 int_err(3) = 6
int_err(4) = psb_n_ int_err(4) = psb_n_
int_err(5) = psb_get_global_cols(desc_dec) int_err(5) = psb_cd_get_global_cols(desc_dec)
else if (psb_get_global_rows(desc_dec) < jx) then else if (psb_cd_get_global_rows(desc_dec) < jx) then
info=60 info=60
int_err(1) = 5 int_err(1) = 5
int_err(2) = jx int_err(2) = jx
int_err(3) = 6 int_err(3) = 6
int_err(4) = psb_m_ int_err(4) = psb_m_
int_err(5) = psb_get_global_rows(desc_dec) int_err(5) = psb_cd_get_global_rows(desc_dec)
else if (psb_get_global_cols(desc_dec) < (ix+m-1)) then else if (psb_cd_get_global_cols(desc_dec) < (ix+m-1)) then
info=80 info=80
int_err(1) = 1 int_err(1) = 1
int_err(2) = m int_err(2) = m
@ -350,51 +350,51 @@ contains
info=20 info=20
int_err(1) = 5 int_err(1) = 5
int_err(2) = ja int_err(2) = ja
else if (psb_get_local_cols(desc_dec) < 0) then else if (psb_cd_get_local_cols(desc_dec) < 0) then
info=40 info=40
int_err(1) = 6 int_err(1) = 6
int_err(2) = psb_n_col_ int_err(2) = psb_n_col_
int_err(3) = psb_get_local_cols(desc_dec) int_err(3) = psb_cd_get_local_cols(desc_dec)
else if (psb_get_local_rows(desc_dec) < 0) then else if (psb_cd_get_local_rows(desc_dec) < 0) then
info=40 info=40
int_err(1) = 6 int_err(1) = 6
int_err(2) = psb_n_row_ int_err(2) = psb_n_row_
int_err(3) = psb_get_local_rows(desc_dec) int_err(3) = psb_cd_get_local_rows(desc_dec)
else if (psb_get_global_rows(desc_dec) < m) then else if (psb_cd_get_global_rows(desc_dec) < m) then
info=60 info=60
int_err(1) = 1 int_err(1) = 1
int_err(2) = m int_err(2) = m
int_err(3) = 5 int_err(3) = 5
int_err(4) = psb_m_ int_err(4) = psb_m_
int_err(5) = psb_get_global_rows(desc_dec) int_err(5) = psb_cd_get_global_rows(desc_dec)
else if (psb_get_global_rows(desc_dec) < m) then else if (psb_cd_get_global_rows(desc_dec) < m) then
info=60 info=60
int_err(1) = 2 int_err(1) = 2
int_err(2) = n int_err(2) = n
int_err(3) = 5 int_err(3) = 5
int_err(4) = psb_m_ int_err(4) = psb_m_
int_err(5) = psb_get_global_rows(desc_dec) int_err(5) = psb_cd_get_global_rows(desc_dec)
else if (psb_get_global_rows(desc_dec) < ia) then else if (psb_cd_get_global_rows(desc_dec) < ia) then
info=60 info=60
int_err(1) = 3 int_err(1) = 3
int_err(2) = ia int_err(2) = ia
int_err(3) = 5 int_err(3) = 5
int_err(4) = psb_m_ int_err(4) = psb_m_
int_err(5) = psb_get_global_rows(desc_dec) int_err(5) = psb_cd_get_global_rows(desc_dec)
else if (psb_get_global_cols(desc_dec) < ja) then else if (psb_cd_get_global_cols(desc_dec) < ja) then
info=60 info=60
int_err(1) = 4 int_err(1) = 4
int_err(2) = ja int_err(2) = ja
int_err(3) = 5 int_err(3) = 5
int_err(4) = psb_n_ int_err(4) = psb_n_
int_err(5) = psb_get_global_cols(desc_dec) int_err(5) = psb_cd_get_global_cols(desc_dec)
else if (psb_get_global_rows(desc_dec) < (ia+m-1)) then else if (psb_cd_get_global_rows(desc_dec) < (ia+m-1)) then
info=80 info=80
int_err(1) = 1 int_err(1) = 1
int_err(2) = m int_err(2) = m
int_err(3) = 3 int_err(3) = 3
int_err(4) = ia int_err(4) = ia
else if (psb_get_global_cols(desc_dec) < (ja+n-1)) then else if (psb_cd_get_global_cols(desc_dec) < (ja+n-1)) then
info=80 info=80
int_err(1) = 2 int_err(1) = 2
int_err(2) = n int_err(2) = n
@ -410,12 +410,12 @@ contains
! Compute local indices for submatrix starting ! Compute local indices for submatrix starting
! at global indices ix and jx ! at global indices ix and jx
if(present(iia).and.present(jja)) then if(present(iia).and.present(jja)) then
if (psb_get_local_rows(desc_dec) > 0) then if (psb_cd_get_local_rows(desc_dec) > 0) then
iia=1 iia=1
jja=1 jja=1
else else
iia=psb_get_local_rows(desc_dec)+1 iia=psb_cd_get_local_rows(desc_dec)+1
jja=psb_get_local_cols(desc_dec)+1 jja=psb_cd_get_local_cols(desc_dec)+1
end if end if
end if end if

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

@ -78,35 +78,35 @@ contains
logical function psb_is_ok_desc(desc) logical function psb_is_ok_desc(desc)
type(psb_desc_type), intent(in) :: desc type(psb_desc_type), intent(in) :: desc
psb_is_ok_desc = psb_is_ok_dec(psb_get_dectype(desc)) psb_is_ok_desc = psb_is_ok_dec(psb_cd_get_dectype(desc))
end function psb_is_ok_desc end function psb_is_ok_desc
logical function psb_is_bld_desc(desc) logical function psb_is_bld_desc(desc)
type(psb_desc_type), intent(in) :: desc type(psb_desc_type), intent(in) :: desc
psb_is_bld_desc = psb_is_bld_dec(psb_get_dectype(desc)) psb_is_bld_desc = psb_is_bld_dec(psb_cd_get_dectype(desc))
end function psb_is_bld_desc end function psb_is_bld_desc
logical function psb_is_upd_desc(desc) logical function psb_is_upd_desc(desc)
type(psb_desc_type), intent(in) :: desc type(psb_desc_type), intent(in) :: desc
psb_is_upd_desc = psb_is_upd_dec(psb_get_dectype(desc)) psb_is_upd_desc = psb_is_upd_dec(psb_cd_get_dectype(desc))
end function psb_is_upd_desc end function psb_is_upd_desc
logical function psb_is_asb_upd_desc(desc) logical function psb_is_asb_upd_desc(desc)
type(psb_desc_type), intent(in) :: desc type(psb_desc_type), intent(in) :: desc
psb_is_asb_upd_desc = psb_is_asb_upd_dec(psb_get_dectype(desc)) psb_is_asb_upd_desc = psb_is_asb_upd_dec(psb_cd_get_dectype(desc))
end function psb_is_asb_upd_desc end function psb_is_asb_upd_desc
logical function psb_is_asb_desc(desc) logical function psb_is_asb_desc(desc)
type(psb_desc_type), intent(in) :: desc type(psb_desc_type), intent(in) :: desc
psb_is_asb_desc = psb_is_asb_dec(psb_get_dectype(desc)) psb_is_asb_desc = psb_is_asb_dec(psb_cd_get_dectype(desc))
end function psb_is_asb_desc end function psb_is_asb_desc
@ -150,40 +150,40 @@ contains
integer function psb_get_local_rows(desc) integer function psb_cd_get_local_rows(desc)
type(psb_desc_type), intent(in) :: desc type(psb_desc_type), intent(in) :: desc
psb_get_local_rows = desc%matrix_data(psb_n_row_) psb_cd_get_local_rows = desc%matrix_data(psb_n_row_)
end function psb_get_local_rows end function psb_cd_get_local_rows
integer function psb_get_local_cols(desc) integer function psb_cd_get_local_cols(desc)
type(psb_desc_type), intent(in) :: desc type(psb_desc_type), intent(in) :: desc
psb_get_local_cols = desc%matrix_data(psb_n_col_) psb_cd_get_local_cols = desc%matrix_data(psb_n_col_)
end function psb_get_local_cols end function psb_cd_get_local_cols
integer function psb_get_global_rows(desc) integer function psb_cd_get_global_rows(desc)
type(psb_desc_type), intent(in) :: desc type(psb_desc_type), intent(in) :: desc
psb_get_global_rows = desc%matrix_data(psb_m_) psb_cd_get_global_rows = desc%matrix_data(psb_m_)
end function psb_get_global_rows end function psb_cd_get_global_rows
integer function psb_get_global_cols(desc) integer function psb_cd_get_global_cols(desc)
type(psb_desc_type), intent(in) :: desc type(psb_desc_type), intent(in) :: desc
psb_get_global_cols = desc%matrix_data(psb_n_) psb_cd_get_global_cols = desc%matrix_data(psb_n_)
end function psb_get_global_cols end function psb_cd_get_global_cols
integer function psb_get_context(desc) integer function psb_cd_get_context(desc)
type(psb_desc_type), intent(in) :: desc type(psb_desc_type), intent(in) :: desc
psb_get_context = desc%matrix_data(psb_ctxt_) psb_cd_get_context = desc%matrix_data(psb_ctxt_)
end function psb_get_context end function psb_cd_get_context
integer function psb_get_dectype(desc) integer function psb_cd_get_dectype(desc)
type(psb_desc_type), intent(in) :: desc type(psb_desc_type), intent(in) :: desc
psb_get_dectype = desc%matrix_data(psb_dec_type_) psb_cd_get_dectype = desc%matrix_data(psb_dec_type_)
end function psb_get_dectype end function psb_cd_get_dectype
end module psb_descriptor_type end module psb_descriptor_type

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

@ -215,104 +215,6 @@ module psb_serial_mod
end subroutine psb_zcsprt end subroutine psb_zcsprt
end interface end interface
interface psb_sp_getdiag
subroutine psb_dspgtdiag(a,d,info)
use psb_spmat_type
type(psb_dspmat_type), intent(in) :: a
real(kind(1.d0)), intent(inout) :: d(:)
integer, intent(out) :: info
end subroutine psb_dspgtdiag
subroutine psb_zspgtdiag(a,d,info)
use psb_spmat_type
type(psb_zspmat_type), intent(in) :: a
complex(kind(1.d0)), intent(inout) :: d(:)
integer, intent(out) :: info
end subroutine psb_zspgtdiag
end interface
interface psb_spscal
subroutine psb_dspscal(a,d,info)
use psb_spmat_type
type(psb_dspmat_type), intent(inout) :: a
real(kind(1.d0)), intent(in) :: d(:)
integer, intent(out) :: info
end subroutine psb_dspscal
subroutine psb_zspscal(a,d,info)
use psb_spmat_type
type(psb_zspmat_type), intent(inout) :: a
complex(kind(1.d0)), intent(in) :: d(:)
integer, intent(out) :: info
end subroutine psb_zspscal
end interface
interface psb_spinfo
subroutine psb_dspinfo(ireq,a,ires,info,iaux)
use psb_spmat_type
type(psb_dspmat_type), intent(in),target :: a
integer, intent(in) :: ireq
integer, intent(out) :: ires
integer, intent(out) :: info
integer, intent(in), optional :: iaux
end subroutine psb_dspinfo
subroutine psb_zspinfo(ireq,a,ires,info,iaux)
use psb_spmat_type
type(psb_zspmat_type), intent(in),target :: a
integer, intent(in) :: ireq
integer, intent(out) :: ires
integer, intent(out) :: info
integer, intent(in), optional :: iaux
end subroutine psb_zspinfo
end interface
interface psb_spgtblk
subroutine psb_dspgtblk(irw,a,b,info,append,iren,lrw)
use psb_spmat_type
type(psb_dspmat_type), intent(in) :: a
integer, intent(in) :: irw
type(psb_dspmat_type), intent(inout) :: b
logical, intent(in), optional :: append
integer, intent(in), target, optional :: iren(:)
integer, intent(in), optional :: lrw
integer, intent(out) :: info
end subroutine psb_dspgtblk
subroutine psb_zspgtblk(irw,a,b,info,append,iren,lrw)
use psb_spmat_type
type(psb_zspmat_type), intent(in) :: a
integer, intent(in) :: irw
type(psb_zspmat_type), intent(inout) :: b
logical, intent(in), optional :: append
integer, intent(in), target, optional :: iren(:)
integer, intent(in), optional :: lrw
integer, intent(out) :: info
end subroutine psb_zspgtblk
end interface
interface psb_sp_getrow
subroutine psb_dspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw)
use psb_spmat_type
type(psb_dspmat_type), intent(in) :: a
integer, intent(in) :: irw
integer, intent(out) :: nz
integer, intent(inout) :: ia(:), ja(:)
real(kind(1.d0)), intent(inout) :: val(:)
integer, intent(in), target, optional :: iren(:)
integer, intent(in), optional :: lrw
integer, intent(out) :: info
end subroutine psb_dspgetrow
subroutine psb_zspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw)
use psb_spmat_type
type(psb_zspmat_type), intent(in) :: a
integer, intent(in) :: irw
integer, intent(out) :: nz
integer, intent(inout) :: ia(:), ja(:)
complex(kind(1.d0)), intent(inout) :: val(:)
integer, intent(in), target, optional :: iren(:)
integer, intent(in), optional :: lrw
integer, intent(out) :: info
end subroutine psb_zspgetrow
end interface
interface psb_neigh interface psb_neigh
subroutine psb_dneigh(a,idx,neigh,n,info,lev) subroutine psb_dneigh(a,idx,neigh,n,info,lev)
use psb_spmat_type use psb_spmat_type
@ -439,112 +341,86 @@ module psb_serial_mod
end interface end interface
interface psb_get_nrows interface psb_sp_getdiag
module procedure psb_get_dsp_nrows, psb_get_zsp_nrows subroutine psb_dspgtdiag(a,d,info)
use psb_spmat_type
type(psb_dspmat_type), intent(in) :: a
real(kind(1.d0)), intent(inout) :: d(:)
integer, intent(out) :: info
end subroutine psb_dspgtdiag
subroutine psb_zspgtdiag(a,d,info)
use psb_spmat_type
type(psb_zspmat_type), intent(in) :: a
complex(kind(1.d0)), intent(inout) :: d(:)
integer, intent(out) :: info
end subroutine psb_zspgtdiag
end interface end interface
interface psb_get_ncols interface psb_sp_scal
module procedure psb_get_dsp_ncols, psb_get_zsp_ncols subroutine psb_dspscal(a,d,info)
use psb_spmat_type
type(psb_dspmat_type), intent(inout) :: a
real(kind(1.d0)), intent(in) :: d(:)
integer, intent(out) :: info
end subroutine psb_dspscal
subroutine psb_zspscal(a,d,info)
use psb_spmat_type
type(psb_zspmat_type), intent(inout) :: a
complex(kind(1.d0)), intent(in) :: d(:)
integer, intent(out) :: info
end subroutine psb_zspscal
end interface end interface
interface psb_get_nnzeros interface psb_sp_getblk
module procedure psb_get_dsp_nnzeros, psb_get_zsp_nnzeros subroutine psb_dspgtblk(irw,a,b,info,append,iren,lrw)
use psb_spmat_type
type(psb_dspmat_type), intent(in) :: a
integer, intent(in) :: irw
type(psb_dspmat_type), intent(inout) :: b
logical, intent(in), optional :: append
integer, intent(in), target, optional :: iren(:)
integer, intent(in), optional :: lrw
integer, intent(out) :: info
end subroutine psb_dspgtblk
subroutine psb_zspgtblk(irw,a,b,info,append,iren,lrw)
use psb_spmat_type
type(psb_zspmat_type), intent(in) :: a
integer, intent(in) :: irw
type(psb_zspmat_type), intent(inout) :: b
logical, intent(in), optional :: append
integer, intent(in), target, optional :: iren(:)
integer, intent(in), optional :: lrw
integer, intent(out) :: info
end subroutine psb_zspgtblk
end interface end interface
interface psb_get_nnz_row interface psb_sp_getrow
module procedure psb_get_dsp_nnz_row, psb_get_zsp_nnz_row subroutine psb_dspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw)
use psb_spmat_type
type(psb_dspmat_type), intent(in) :: a
integer, intent(in) :: irw
integer, intent(out) :: nz
integer, intent(inout) :: ia(:), ja(:)
real(kind(1.d0)), intent(inout) :: val(:)
integer, intent(in), target, optional :: iren(:)
integer, intent(in), optional :: lrw
integer, intent(out) :: info
end subroutine psb_dspgetrow
subroutine psb_zspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw)
use psb_spmat_type
type(psb_zspmat_type), intent(in) :: a
integer, intent(in) :: irw
integer, intent(out) :: nz
integer, intent(inout) :: ia(:), ja(:)
complex(kind(1.d0)), intent(inout) :: val(:)
integer, intent(in), target, optional :: iren(:)
integer, intent(in), optional :: lrw
integer, intent(out) :: info
end subroutine psb_zspgetrow
end interface 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 end module psb_serial_mod

442
src/modules/psb_spmat_type.f90
Unescape Escape View File

@ -118,7 +118,138 @@ module psb_spmat_type
module procedure psb_dspsizeof, psb_zspsizeof module procedure psb_dspsizeof, psb_zspsizeof
end interface end interface
contains interface psb_sp_get_nrows
module procedure psb_get_dsp_nrows, psb_get_zsp_nrows
end interface
interface psb_sp_get_ncols
module procedure psb_get_dsp_ncols, psb_get_zsp_ncols
end interface
interface psb_sp_get_nnzeros
module procedure psb_get_dsp_nnzeros, psb_get_zsp_nnzeros
end interface
interface psb_sp_get_nzsize
module procedure psb_get_dsp_nzsize, psb_get_zsp_nzsize
end interface
interface psb_sp_get_nnz_row
module procedure psb_get_dsp_nnz_row, psb_get_zsp_nnz_row
end interface
interface psb_sp_info
module procedure psb_dspinfo, psb_zspinfo
end interface
contains
integer function psb_get_dsp_nrows(a)
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)
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)
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)
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)
type(psb_dspmat_type), intent(in) :: a
integer :: ires,info
call psb_sp_info(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)
type(psb_zspmat_type), intent(in) :: a
integer :: ires,info
call psb_sp_info(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_nzsize(a)
type(psb_dspmat_type), intent(in) :: a
integer :: ires,info
call psb_sp_info(psb_nzsizereq_,a,ires,info)
if (info == 0) then
psb_get_dsp_nzsize = ires
else
psb_get_dsp_nzsize = 0
end if
end function psb_get_dsp_nzsize
integer function psb_get_zsp_nzsize(a)
type(psb_zspmat_type), intent(in) :: a
integer :: ires,info
call psb_sp_info(psb_nzsizereq_,a,ires,info)
if (info == 0) then
psb_get_zsp_nzsize = ires
else
psb_get_zsp_nzsize = 0
end if
end function psb_get_zsp_nzsize
integer function psb_get_dsp_nnz_row(ir,a)
integer, intent(in) :: ir
type(psb_dspmat_type), intent(in) :: a
integer :: ires,info
call psb_sp_info(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)
integer, intent(in) :: ir
type(psb_zspmat_type), intent(in) :: a
integer :: ires,info
call psb_sp_info(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
subroutine psb_nullify_dsp(mat) subroutine psb_nullify_dsp(mat)
implicit none implicit none
@ -1116,6 +1247,315 @@ contains
Return Return
End Subroutine psb_zsp_free End Subroutine psb_zsp_free
subroutine psb_dspinfo(ireq,a,ires,info,iaux)
use psb_const_mod
use psb_error_mod
use psb_string_mod
implicit none
type(psb_dspmat_type), intent(in), target :: a
integer, intent(in) :: ireq
integer, intent(out) :: ires, info
integer, intent(in), optional :: iaux
integer :: i,j,k,ip,jp,nr,irw,nz, err_act, row, ipx, pia, pja, rb,idx, nc
integer, pointer :: ia1(:), ia2(:), ia3(:), ja(:)
character(len=20) :: name, ch_err
name='psb_dspinfo'
info = 0
call psb_erractionsave(err_act)
if (ireq == psb_nztotreq_) then
! The number of nonzeroes
if (toupper(a%fida) == 'CSR') then
nr = a%m
ires = a%ia2(nr+1)-1
else if ((toupper(a%fida) == 'COO').or.(toupper(a%fida) == 'COI')) then
ires = a%infoa(psb_nnz_)
else if (toupper(a%fida) == 'JAD') then
ires = a%infoa(psb_nnz_)
else if (toupper(a%fida) == 'CSC') then
nc = a%k
ires = a%ia2(nc+1)-1
else
ires=-1
info=136
ch_err=a%fida(1:3)
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
else if (ireq == psb_nzrowreq_) then
! The number of nonzeroes in row iaux
if (.not.present(iaux)) then
write(0,*) 'Need IAUX when ireq=nzrowreq'
ires=-1
return
endif
irw = iaux
if (toupper(a%fida) == 'CSR') then
ires = a%ia2(irw+1)-a%ia2(irw)
else if ((toupper(a%fida) == 'COO').or.(toupper(a%fida) == 'COI')) then
if (a%infoa(psb_srtd_) == psb_isrtdcoo_) then
! In this case we can do a binary search.
nz = a%infoa(psb_nnz_)
call ibsrch(ip,irw,nz,a%ia1)
jp = ip
! expand [ip,jp] to contain all row entries.
do
if (ip < 2) exit
if (a%ia1(ip-1) == irw) then
ip = ip -1
else
exit
end if
end do
do
if (jp > nz) exit
if (a%ia1(jp) == irw) then
jp =jp + 1
else
exit
endif
end do
ires = jp-ip
else
ires = count(a%ia1(1:a%infoa(psb_nnz_))==irw)
endif
!!$ ires = 0
!!$ do i=1, a%infoa(psb_nnz_)
!!$ if (a%ia1(i) == irw) ires = ires + 1
!!$ enddo
else if (toupper(a%fida) == 'JAD') then
pia = a%ia2(2) ! points to the beginning of ia(3,png)
pja = a%ia2(3) ! points to the beginning of ja(:)
ja => a%ia2(pja:) ! the array containing the pointers to ka and aspk
ia1 => a%ia2(pia:pja-1:3) ! the array containing the first row index of each block
ia2 => a%ia2(pia+1:pja-1:3) ! the array containing a pointer to the pos. in ja to the first jad column
ia3 => a%ia2(pia+2:pja-1:3) ! the array containing a pointer to the pos. in ja to the first csr column
idx=a%pl(irw)
j=0
nz=0
blkfnd: do
j=j+1
if(ia1(j).eq.idx) then
nz=nz+ia3(j)-ia2(j)
ipx = ia1(j) ! the first row index of the block
rb = idx-ipx ! the row offset within the block
row = ia3(j)+rb
nz = nz+ja(row+1)-ja(row)
exit blkfnd
else if(ia1(j).gt.idx) then
nz=nz+ia3(j-1)-ia2(j-1)
ipx = ia1(j-1) ! the first row index of the block
rb = idx-ipx ! the row offset within the block
row = ia3(j-1)+rb
nz = nz+ja(row+1)-ja(row)
exit blkfnd
end if
end do blkfnd
ires=nz
else
ires=-1
info=136
ch_err=a%fida(1:3)
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
else if (ireq == psb_nzsizereq_) then
if (toupper(a%fida) == 'CSR') then
ires = size(a%aspk)
else if ((toupper(a%fida) == 'COO').or.(toupper(a%fida) == 'COI')) then
ires = size(a%aspk)
else if (toupper(a%fida) == 'JAD') then
ires = a%infoa(psb_nnz_)
else
ires=-1
info=136
ch_err=a%fida(1:3)
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
else
write(0,*) 'Unknown request into SPINFO'
ires=-1
endif
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_dspinfo
subroutine psb_zspinfo(ireq,a,ires,info,iaux)
use psb_const_mod
use psb_error_mod
use psb_string_mod
implicit none
type(psb_zspmat_type), intent(in), target :: a
integer, intent(in) :: ireq
integer, intent(out) :: ires, info
integer, intent(in), optional :: iaux
integer :: i,j,k,ip,jp,nr,irw,nz, err_act, row, ipx, pia, pja, rb,idx, nc
integer, pointer :: ia1(:), ia2(:), ia3(:), ja(:)
character(len=20) :: name, ch_err
name='psb_zspinfo'
info = 0
call psb_erractionsave(err_act)
if (ireq == psb_nztotreq_) then
! The number of nonzeroes
if (toupper(a%fida) == 'CSR') then
nr = a%m
ires = a%ia2(nr+1)-1
else if ((toupper(a%fida) == 'COO').or.(toupper(a%fida) == 'COI')) then
ires = a%infoa(psb_nnz_)
else if (toupper(a%fida) == 'JAD') then
ires = a%infoa(psb_nnz_)
else if (toupper(a%fida) == 'CSC') then
nc = a%k
ires = a%ia2(nc+1)-1
else
ires=-1
info=136
ch_err=a%fida(1:3)
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
else if (ireq == psb_nzrowreq_) then
! The number of nonzeroes in row iaux
if (.not.present(iaux)) then
write(0,*) 'Need IAUX when ireq=nzrowreq'
ires=-1
return
endif
irw = iaux
if (toupper(a%fida) == 'CSR') then
ires = a%ia2(irw+1)-a%ia2(irw)
else if ((toupper(a%fida) == 'COO').or.(toupper(a%fida) == 'COI')) then
if (a%infoa(psb_srtd_) == psb_isrtdcoo_) then
! In this case we can do a binary search.
nz = a%infoa(psb_nnz_)
call ibsrch(ip,irw,nz,a%ia1)
jp = ip
! expand [ip,jp] to contain all row entries.
do
if (ip < 2) exit
if (a%ia1(ip-1) == irw) then
ip = ip -1
else
exit
end if
end do
do
if (jp > nz) exit
if (a%ia1(jp) == irw) then
jp =jp + 1
else
exit
endif
end do
ires = jp-ip
else
ires = count(a%ia1(1:a%infoa(psb_nnz_))==irw)
endif
!!$ ires = 0
!!$ do i=1, a%infoa(psb_nnz_)
!!$ if (a%ia1(i) == irw) ires = ires + 1
!!$ enddo
else if (toupper(a%fida) == 'JAD') then
pia = a%ia2(2) ! points to the beginning of ia(3,png)
pja = a%ia2(3) ! points to the beginning of ja(:)
ja => a%ia2(pja:) ! the array containing the pointers to ka and aspk
ia1 => a%ia2(pia:pja-1:3) ! the array containing the first row index of each block
ia2 => a%ia2(pia+1:pja-1:3) ! the array containing a pointer to the pos. in ja to the first jad column
ia3 => a%ia2(pia+2:pja-1:3) ! the array containing a pointer to the pos. in ja to the first csr column
idx=a%pl(irw)
j=0
nz=0
blkfnd: do
j=j+1
if(ia1(j).eq.idx) then
nz=nz+ia3(j)-ia2(j)
ipx = ia1(j) ! the first row index of the block
rb = idx-ipx ! the row offset within the block
row = ia3(j)+rb
nz = nz+ja(row+1)-ja(row)
exit blkfnd
else if(ia1(j).gt.idx) then
nz=nz+ia3(j-1)-ia2(j-1)
ipx = ia1(j-1) ! the first row index of the block
rb = idx-ipx ! the row offset within the block
row = ia3(j-1)+rb
nz = nz+ja(row+1)-ja(row)
exit blkfnd
end if
end do blkfnd
ires=nz
else
ires=-1
info=136
ch_err=a%fida(1:3)
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
else if (ireq == psb_nzsizereq_) then
if (toupper(a%fida) == 'CSR') then
ires = size(a%aspk)
else if ((toupper(a%fida) == 'COO').or.(toupper(a%fida) == 'COI')) then
ires = size(a%aspk)
else if (toupper(a%fida) == 'JAD') then
ires = a%infoa(psb_nnz_)
else
ires=-1
info=136
ch_err=a%fida(1:3)
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
else
write(0,*) 'Unknown request into SPINFO'
ires=-1
endif
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_zspinfo
end module psb_spmat_type end module psb_spmat_type

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' if (debug) write(0,*) 'Entering baseprc_bld'
info = 0 info = 0
int_err(1) = 0 int_err(1) = 0
ictxt = psb_get_context(desc_a) ictxt = psb_cd_get_context(desc_a)
n_row = psb_get_local_rows(desc_a) n_row = psb_cd_get_local_rows(desc_a)
n_col = psb_get_local_cols(desc_a) n_col = psb_cd_get_local_cols(desc_a)
mglob = psb_get_global_rows(desc_a) mglob = psb_cd_get_global_rows(desc_a)
if (debug) write(0,*) 'Preconditioner Blacs_gridinfo' if (debug) write(0,*) 'Preconditioner Blacs_gridinfo'
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)

28
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 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
select case (p%iprcparm(smth_kind_)) select case (p%iprcparm(smth_kind_))
@ -125,11 +125,11 @@ contains
call psb_nullify_sp(b) call psb_nullify_sp(b)
ictxt = psb_get_context(desc_a) ictxt = psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
nglob = psb_get_global_rows(desc_a) nglob = psb_cd_get_global_rows(desc_a)
nrow = psb_get_local_rows(desc_a) nrow = psb_cd_get_local_rows(desc_a)
ncol = psb_get_local_cols(desc_a) ncol = psb_cd_get_local_cols(desc_a)
naggr = p%nlaggr(me+1) naggr = p%nlaggr(me+1)
ntaggr = sum(p%nlaggr) ntaggr = sum(p%nlaggr)
@ -155,7 +155,7 @@ contains
end if end if
nzt = psb_get_nnzeros(a) nzt = psb_sp_get_nnzeros(a)
call psb_sp_all(b,nzt,info) call psb_sp_all(b,nzt,info)
if(info /= 0) then if(info /= 0) then
call psb_errpush(4010,name,a_err='spall') call psb_errpush(4010,name,a_err='spall')
@ -176,7 +176,7 @@ contains
goto 9999 goto 9999
end if end if
nzt = psb_get_nnzeros(b) nzt = psb_sp_get_nnzeros(b)
do i=1, nzt do i=1, nzt
b%ia1(i) = p%mlia(b%ia1(i)) b%ia1(i) = p%mlia(b%ia1(i))
b%ia2(i) = p%mlia(b%ia2(i)) b%ia2(i) = p%mlia(b%ia2(i))
@ -223,7 +223,7 @@ contains
goto 9999 goto 9999
end if end if
irs = psb_get_nnzeros(b) irs = psb_sp_get_nnzeros(b)
call psb_sp_reall(b,irs,info) call psb_sp_reall(b,irs,info)
if(info /= 0) then if(info /= 0) then
call psb_errpush(4010,name,a_err='spreall') call psb_errpush(4010,name,a_err='spreall')
@ -402,7 +402,7 @@ contains
info=0 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = psb_get_context(desc_a) ictxt = psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
call psb_nullify_sp(b) call psb_nullify_sp(b)
@ -412,9 +412,9 @@ contains
am2 => p%av(sm_pr_t_) am2 => p%av(sm_pr_t_)
am1 => p%av(sm_pr_) am1 => p%av(sm_pr_)
nglob = psb_get_global_rows(desc_a) nglob = psb_cd_get_global_rows(desc_a)
nrow = psb_get_local_rows(desc_a) nrow = psb_cd_get_local_rows(desc_a)
ncol = psb_get_local_cols(desc_a) ncol = psb_cd_get_local_cols(desc_a)
naggr = p%nlaggr(me+1) naggr = p%nlaggr(me+1)
ntaggr = sum(p%nlaggr) ntaggr = sum(p%nlaggr)
@ -535,7 +535,7 @@ contains
! its diagonal elements stored explicitly!!! ! its diagonal elements stored explicitly!!!
! Should we switch to something safer? ! Should we switch to something safer?
! !
call psb_spscal(am3,p%dorig,info) call psb_sp_scal(am3,p%dorig,info)
if(info /= 0) goto 9999 if(info /= 0) goto 9999
if (p%iprcparm(om_choice_) == lib_choice_) then if (p%iprcparm(om_choice_) == lib_choice_) then
@ -881,7 +881,7 @@ contains
if (np>1) then if (np>1) then
nzl = psb_get_nnzeros(am1) nzl = psb_sp_get_nnzeros(am1)
call psb_glob_to_loc(am1%ia1(1:nzl),desc_ac,info,'I') call psb_glob_to_loc(am1%ia1(1:nzl),desc_ac,info,'I')
if(info /= 0) then if(info /= 0) then
call psb_errpush(4010,name,a_err='psb_glob_to_loc') 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' if (debug) write(0,*) 'Entering diagsc_bld'
info = 0 info = 0
int_err(1) = 0 int_err(1) = 0
ictxt = psb_get_context(desc_a) ictxt = psb_cd_get_context(desc_a)
n_row = psb_get_local_rows(desc_a) n_row = psb_cd_get_local_rows(desc_a)
n_col = psb_get_local_cols(desc_a) n_col = psb_cd_get_local_cols(desc_a)
mglob = psb_get_global_rows(desc_a) mglob = psb_cd_get_global_rows(desc_a)
if (debug) write(0,*) 'Preconditioner Blacs_gridinfo' if (debug) write(0,*) 'Preconditioner Blacs_gridinfo'
call psb_info(ictxt, me, np) 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 ! so that we only have local decoupled aggregation. This might
! change in the future. ! change in the future.
! !
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt,me,np) call psb_info(ictxt,me,np)
nrow = psb_get_local_rows(desc_a) nrow = psb_cd_get_local_rows(desc_a)
ncol = psb_get_local_cols(desc_a) ncol = psb_cd_get_local_cols(desc_a)
nr = a%m nr = a%m

14
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' name='psb_ilu_bld'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
m = a%m m = a%m
@ -182,13 +182,13 @@ subroutine psb_dilu_bld(a,desc_a,p,upd,info)
endif endif
!!$ call psb_csprt(50+me,a,head='% (A)') !!$ call psb_csprt(50+me,a,head='% (A)')
nrow_a = psb_get_local_rows(desc_a) nrow_a = psb_cd_get_local_rows(desc_a)
nztota = psb_get_nnzeros(a) nztota = psb_sp_get_nnzeros(a)
nztotb = psb_get_nnzeros(blck) nztotb = psb_sp_get_nnzeros(blck)
if (debug) write(0,*)me,': out get_nnzeros',nztota if (debug) write(0,*)me,': out get_nnzeros',nztota
if (debug) call psb_barrier(ictxt) if (debug) call psb_barrier(ictxt)
n_col = psb_get_local_cols(desc_a) n_col = psb_cd_get_local_cols(desc_a)
nhalo = n_col-nrow_a nhalo = n_col-nrow_a
n_row = p%desc_data%matrix_data(psb_n_row_) n_row = p%desc_data%matrix_data(psb_n_row_)
p%av(l_pr_)%m = n_row p%av(l_pr_)%m = n_row
@ -231,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 ! Here we allocate a full copy to hold local A and received BLK
! !
nztota = psb_get_nnzeros(a) nztota = psb_sp_get_nnzeros(a)
nztotb = psb_get_nnzeros(blck) nztotb = psb_sp_get_nnzeros(blck)
call psb_sp_all(atmp,nztota+nztotb,info) call psb_sp_all(atmp,nztota+nztotb,info)
if(info/=0) then if(info/=0) then
info=4011 info=4011

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

@ -202,10 +202,10 @@ contains
if ((mod(i,nrb) == 1).or.(nrb==1)) then if ((mod(i,nrb) == 1).or.(nrb==1)) then
irb = min(ma-i+1,nrb) irb = min(ma-i+1,nrb)
call psb_spgtblk(i,a,trw,info,lrw=i+irb-1) call psb_sp_getblk(i,a,trw,info,lrw=i+irb-1)
if(info.ne.0) then if(info.ne.0) then
info=4010 info=4010
ch_err='psb_spgtblk' ch_err='psb_sp_getblk'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
@ -344,10 +344,10 @@ contains
if ((mod((i-ma),nrb) == 1).or.(nrb==1)) then if ((mod((i-ma),nrb) == 1).or.(nrb==1)) then
irb = min(m-i+1,nrb) irb = min(m-i+1,nrb)
call psb_spgtblk(i-ma,b,trw,info,lrw=i-ma+irb-1) call psb_sp_getblk(i-ma,b,trw,info,lrw=i-ma+irb-1)
if(info.ne.0) then if(info.ne.0) then
info=4010 info=4010
ch_err='psb_spgtblk' ch_err='psb_sp_getblk'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if

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(:) if (debug) write(0,*) 'Entering precbld',P%prec,desc_a%matrix_data(:)
info = 0 info = 0
int_err(1) = 0 int_err(1) = 0
ictxt = psb_get_context(desc_a) ictxt = psb_cd_get_context(desc_a)
if (debug) write(0,*) 'Preconditioner psb_info' if (debug) write(0,*) 'Preconditioner psb_info'
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)

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

@ -165,7 +165,7 @@ subroutine psb_dslu_bld(a,desc_a,p,info)
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
nzt = psb_get_nnzeros(atmp) nzt = psb_sp_get_nnzeros(atmp)
if (Debug) then if (Debug) then
write(0,*) me,'Calling psb_slu_factor ',nzt,atmp%m,& write(0,*) me,'Calling psb_slu_factor ',nzt,atmp%m,&
& atmp%k,p%desc_data%matrix_data(psb_n_row_) & 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' name='apply_renum'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
!!!!!!!!!!!!!!!! CHANGE FOR NON-CSR A !!!!!!!!!!!!!!!! CHANGE FOR NON-CSR A
@ -84,7 +84,7 @@ subroutine psb_dsp_renum(a,desc_a,blck,p,atmp,info)
atmp%descra = 'GUN' atmp%descra = 'GUN'
! This is the renumbering coherent with global indices.. ! This is the renumbering coherent with global indices..
mglob = psb_get_global_rows(desc_a) mglob = psb_cd_get_global_rows(desc_a)
! !
! Remember: we have switched IA1=COLS and IA2=ROWS ! Remember: we have switched IA1=COLS and IA2=ROWS
! Now identify the set of distinct local column indices ! Now identify the set of distinct local column indices

8
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) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
nza = psb_get_nnzeros(atmp) nza = psb_sp_get_nnzeros(atmp)
nzb = psb_get_nnzeros(a) nzb = psb_sp_get_nnzeros(a)
if (Debug) then if (Debug) then
write(0,*) me, 'UMFBLD: Done csdp',info,nza,atmp%m,atmp%k,nzb write(0,*) me, 'UMFBLD: Done csdp',info,nza,atmp%m,atmp%k,nzb
call psb_barrier(ictxt) call psb_barrier(ictxt)
@ -112,7 +112,7 @@ subroutine psb_dumf_bld(a,desc_a,p,info)
goto 9999 goto 9999
end if end if
nzb = psb_get_nnzeros(blck) nzb = psb_sp_get_nnzeros(blck)
if (Debug) then if (Debug) then
write(0,*) me, 'UMFBLD: Done asmatbld',info,nzb,blck%fida write(0,*) me, 'UMFBLD: Done asmatbld',info,nzb,blck%fida
call psb_barrier(ictxt) call psb_barrier(ictxt)
@ -165,7 +165,7 @@ subroutine psb_dumf_bld(a,desc_a,p,info)
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
nzt = psb_get_nnzeros(atmp) nzt = psb_sp_get_nnzeros(atmp)
if (Debug) then if (Debug) then
write(0,*) me,'Calling psb_umf_factor ',nzt,atmp%m,& write(0,*) me,'Calling psb_umf_factor ',nzt,atmp%m,&
& atmp%k,p%desc_data%matrix_data(psb_n_row_) & 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' if (debug) write(0,*) 'Entering baseprc_bld'
info = 0 info = 0
int_err(1) = 0 int_err(1) = 0
ictxt = psb_get_context(desc_a) ictxt = psb_cd_get_context(desc_a)
n_row = psb_get_local_rows(desc_a) n_row = psb_cd_get_local_rows(desc_a)
n_col = psb_get_local_cols(desc_a) n_col = psb_cd_get_local_cols(desc_a)
mglob = psb_get_global_rows(desc_a) mglob = psb_cd_get_global_rows(desc_a)
if (debug) write(0,*) 'Preconditioner Blacs_gridinfo' if (debug) write(0,*) 'Preconditioner Blacs_gridinfo'
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)

28
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 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
select case (p%iprcparm(smth_kind_)) select case (p%iprcparm(smth_kind_))
@ -124,11 +124,11 @@ contains
call psb_nullify_sp(b) call psb_nullify_sp(b)
ictxt = psb_get_context(desc_a) ictxt = psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
nglob = psb_get_global_rows(desc_a) nglob = psb_cd_get_global_rows(desc_a)
nrow = psb_get_local_rows(desc_a) nrow = psb_cd_get_local_rows(desc_a)
ncol = psb_get_local_cols(desc_a) ncol = psb_cd_get_local_cols(desc_a)
naggr = p%nlaggr(me+1) naggr = p%nlaggr(me+1)
ntaggr = sum(p%nlaggr) ntaggr = sum(p%nlaggr)
@ -154,7 +154,7 @@ contains
end if end if
nzt = psb_get_nnzeros(a) nzt = psb_sp_get_nnzeros(a)
call psb_sp_all(b,nzt,info) call psb_sp_all(b,nzt,info)
if(info /= 0) then if(info /= 0) then
call psb_errpush(4010,name,a_err='spall') call psb_errpush(4010,name,a_err='spall')
@ -175,7 +175,7 @@ contains
goto 9999 goto 9999
end if end if
nzt = psb_get_nnzeros(b) nzt = psb_sp_get_nnzeros(b)
do i=1, nzt do i=1, nzt
b%ia1(i) = p%mlia(b%ia1(i)) b%ia1(i) = p%mlia(b%ia1(i))
b%ia2(i) = p%mlia(b%ia2(i)) b%ia2(i) = p%mlia(b%ia2(i))
@ -222,7 +222,7 @@ contains
goto 9999 goto 9999
end if end if
irs = psb_get_nnzeros(b) irs = psb_sp_get_nnzeros(b)
call psb_sp_reall(b,irs,info) call psb_sp_reall(b,irs,info)
if(info /= 0) then if(info /= 0) then
call psb_errpush(4010,name,a_err='spreall') call psb_errpush(4010,name,a_err='spreall')
@ -401,7 +401,7 @@ contains
info=0 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = psb_get_context(desc_a) ictxt = psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
call psb_nullify_sp(b) call psb_nullify_sp(b)
@ -411,9 +411,9 @@ contains
am2 => p%av(sm_pr_t_) am2 => p%av(sm_pr_t_)
am1 => p%av(sm_pr_) am1 => p%av(sm_pr_)
nglob = psb_get_global_rows(desc_a) nglob = psb_cd_get_global_rows(desc_a)
nrow = psb_get_local_rows(desc_a) nrow = psb_cd_get_local_rows(desc_a)
ncol = psb_get_local_cols(desc_a) ncol = psb_cd_get_local_cols(desc_a)
naggr = p%nlaggr(me+1) naggr = p%nlaggr(me+1)
ntaggr = sum(p%nlaggr) ntaggr = sum(p%nlaggr)
@ -534,7 +534,7 @@ contains
! its diagonal elements stored explicitly!!! ! its diagonal elements stored explicitly!!!
! Should we switch to something safer? ! Should we switch to something safer?
! !
call psb_spscal(am3,p%dorig,info) call psb_sp_scal(am3,p%dorig,info)
if(info /= 0) goto 9999 if(info /= 0) goto 9999
if (p%iprcparm(om_choice_) == lib_choice_) then if (p%iprcparm(om_choice_) == lib_choice_) then
@ -880,7 +880,7 @@ contains
if (np>1) then if (np>1) then
nzl = psb_get_nnzeros(am1) nzl = psb_sp_get_nnzeros(am1)
call psb_glob_to_loc(am1%ia1(1:nzl),desc_ac,info,'I') call psb_glob_to_loc(am1%ia1(1:nzl),desc_ac,info,'I')
if(info /= 0) then if(info /= 0) then
call psb_errpush(4010,name,a_err='psb_glob_to_loc') 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' if (debug) write(0,*) 'Entering diagsc_bld'
info = 0 info = 0
int_err(1) = 0 int_err(1) = 0
ictxt = psb_get_context(desc_a) ictxt = psb_cd_get_context(desc_a)
n_row = psb_get_local_rows(desc_a) n_row = psb_cd_get_local_rows(desc_a)
n_col = psb_get_local_cols(desc_a) n_col = psb_cd_get_local_cols(desc_a)
mglob = psb_get_global_rows(desc_a) mglob = psb_cd_get_global_rows(desc_a)
if (debug) write(0,*) 'Preconditioner Blacs_gridinfo' if (debug) write(0,*) 'Preconditioner Blacs_gridinfo'
call psb_info(ictxt, me, np) 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 ! so that we only have local decoupled aggregation. This might
! change in the future. ! change in the future.
! !
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt,me,np) call psb_info(ictxt,me,np)
nrow = psb_get_local_rows(desc_a) nrow = psb_cd_get_local_rows(desc_a)
ncol = psb_get_local_cols(desc_a) ncol = psb_cd_get_local_cols(desc_a)
nr = a%m nr = a%m

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

@ -131,7 +131,7 @@ subroutine psb_zilu_bld(a,desc_a,p,upd,info)
name='psb_ilu_bld' name='psb_ilu_bld'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
m = a%m m = a%m
@ -181,13 +181,13 @@ subroutine psb_zilu_bld(a,desc_a,p,upd,info)
goto 9999 goto 9999
endif endif
nrow_a = psb_get_local_rows(desc_a) nrow_a = psb_cd_get_local_rows(desc_a)
nztota = psb_get_nnzeros(a) nztota = psb_sp_get_nnzeros(a)
nztotb = psb_get_nnzeros(blck) nztotb = psb_sp_get_nnzeros(blck)
if (debug) write(0,*)me,': out get_nnzeros',nztota if (debug) write(0,*)me,': out get_nnzeros',nztota
if (debug) call psb_barrier(ictxt) if (debug) call psb_barrier(ictxt)
n_col = psb_get_local_cols(desc_a) n_col = psb_cd_get_local_cols(desc_a)
nhalo = n_col-nrow_a nhalo = n_col-nrow_a
n_row = p%desc_data%matrix_data(psb_n_row_) n_row = p%desc_data%matrix_data(psb_n_row_)
p%av(l_pr_)%m = n_row p%av(l_pr_)%m = n_row
@ -230,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 ! Here we allocate a full copy to hold local A and received BLK
! !
nztota = psb_get_nnzeros(a) nztota = psb_sp_get_nnzeros(a)
nztotb = psb_get_nnzeros(blck) nztotb = psb_sp_get_nnzeros(blck)
call psb_sp_all(atmp,nztota+nztotb,info) call psb_sp_all(atmp,nztota+nztotb,info)
if(info/=0) then if(info/=0) then
info=4011 info=4011

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

@ -199,10 +199,10 @@ contains
if ((mod(i,nrb) == 1).or.(nrb==1)) then if ((mod(i,nrb) == 1).or.(nrb==1)) then
irb = min(ma-i+1,nrb) irb = min(ma-i+1,nrb)
call psb_spgtblk(i,a,trw,info,lrw=i+irb-1) call psb_sp_getblk(i,a,trw,info,lrw=i+irb-1)
if(info.ne.0) then if(info.ne.0) then
info=4010 info=4010
ch_err='psb_spgtblk' ch_err='psb_sp_getblk'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
@ -341,10 +341,10 @@ contains
if ((mod((i-ma),nrb) == 1).or.(nrb==1)) then if ((mod((i-ma),nrb) == 1).or.(nrb==1)) then
irb = min(m-i+1,nrb) irb = min(m-i+1,nrb)
call psb_spgtblk(i-ma,b,trw,info,lrw=i-ma+irb-1) call psb_sp_getblk(i-ma,b,trw,info,lrw=i-ma+irb-1)
if(info.ne.0) then if(info.ne.0) then
info=4010 info=4010
ch_err='psb_spgtblk' ch_err='psb_sp_getblk'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if

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(:) if (debug) write(0,*) 'Entering precbld',P%prec,desc_a%matrix_data(:)
info = 0 info = 0
int_err(1) = 0 int_err(1) = 0
ictxt = psb_get_context(desc_a) ictxt = psb_cd_get_context(desc_a)
if (debug) write(0,*) 'Preconditioner psb_info' if (debug) write(0,*) 'Preconditioner psb_info'
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)

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

@ -165,7 +165,7 @@ subroutine psb_zslu_bld(a,desc_a,p,info)
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
nzt = psb_get_nnzeros(atmp) nzt = psb_sp_get_nnzeros(atmp)
if (Debug) then if (Debug) then
write(0,*) me,'Calling psb_slu_factor ',nzt,atmp%m,& write(0,*) me,'Calling psb_slu_factor ',nzt,atmp%m,&
& atmp%k,p%desc_data%matrix_data(psb_n_row_) & 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' name='apply_renum'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
!!!!!!!!!!!!!!!! CHANGE FOR NON-CSR A !!!!!!!!!!!!!!!! CHANGE FOR NON-CSR A
@ -84,7 +84,7 @@ subroutine psb_zsp_renum(a,desc_a,blck,p,atmp,info)
atmp%descra = 'GUN' atmp%descra = 'GUN'
! This is the renumbering coherent with global indices.. ! This is the renumbering coherent with global indices..
mglob = psb_get_global_rows(desc_a) mglob = psb_cd_get_global_rows(desc_a)
! !
! Remember: we have switched IA1=COLS and IA2=ROWS ! Remember: we have switched IA1=COLS and IA2=ROWS
! Now identify the set of distinct local column indices ! Now identify the set of distinct local column indices

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

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

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

@ -70,7 +70,7 @@ function psb_damax (x,desc_a, info, jx)
amax=0.d0 amax=0.d0
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (np == -1) then if (np == -1) then
@ -86,7 +86,7 @@ function psb_damax (x,desc_a, info, jx)
ijx = 1 ijx = 1
endif endif
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx) call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx)
if(info.ne.0) then if(info.ne.0) then
@ -103,8 +103,8 @@ function psb_damax (x,desc_a, info, jx)
end if end if
! compute local max ! compute local max
if ((psb_get_local_rows(desc_a).gt.0).and.(m.ne.0)) then if ((psb_cd_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) imax=idamax(psb_cd_get_local_rows(desc_a)-iix+1,x(iix,jjx),1)
amax=abs(x(iix+imax-1,jjx)) amax=abs(x(iix+imax-1,jjx))
end if end if
@ -195,7 +195,7 @@ function psb_damaxv (x,desc_a, info)
amax=0.d0 amax=0.d0
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (np == -1) then if (np == -1) then
@ -207,7 +207,7 @@ function psb_damaxv (x,desc_a, info)
ix = 1 ix = 1
jx = 1 jx = 1
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
call psb_chkvect(m,1,size(x,1),ix,jx,desc_a,info,iix,jjx) call psb_chkvect(m,1,size(x,1),ix,jx,desc_a,info,iix,jjx)
if(info.ne.0) then if(info.ne.0) then
@ -224,8 +224,8 @@ function psb_damaxv (x,desc_a, info)
end if end if
! compute local max ! compute local max
if ((psb_get_local_rows(desc_a).gt.0).and.(m.ne.0)) then if ((psb_cd_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) imax=idamax(psb_cd_get_local_rows(desc_a)-iix+1,x(iix),1)
amax=abs(x(iix+imax-1)) amax=abs(x(iix+imax-1))
end if end if
@ -318,7 +318,7 @@ subroutine psb_damaxvs (res,x,desc_a, info)
amax=0.d0 amax=0.d0
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (np == -1) then if (np == -1) then
@ -330,7 +330,7 @@ subroutine psb_damaxvs (res,x,desc_a, info)
ix = 1 ix = 1
ijx=1 ijx=1
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx) call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx)
if(info.ne.0) then if(info.ne.0) then
@ -347,8 +347,8 @@ subroutine psb_damaxvs (res,x,desc_a, info)
end if end if
! compute local max ! compute local max
if ((psb_get_local_rows(desc_a).gt.0).and.(m.ne.0)) then if ((psb_cd_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) imax=idamax(psb_cd_get_local_rows(desc_a)-iix+1,x(iix),1)
amax=abs(x(iix+imax-1)) amax=abs(x(iix+imax-1))
end if end if
@ -440,7 +440,7 @@ subroutine psb_dmamaxs (res,x,desc_a, info,jx)
amax=0.d0 amax=0.d0
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (np == -1) then if (np == -1) then
@ -456,7 +456,7 @@ subroutine psb_dmamaxs (res,x,desc_a, info,jx)
ijx = 1 ijx = 1
endif endif
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
k = min(size(x,2),size(res,1)) k = min(size(x,2),size(res,1))
call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx) call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx)
@ -474,9 +474,9 @@ subroutine psb_dmamaxs (res,x,desc_a, info,jx)
end if end if
! compute local max ! compute local max
if ((psb_get_local_rows(desc_a).gt.0).and.(m.ne.0)) then if ((psb_cd_get_local_rows(desc_a).gt.0).and.(m.ne.0)) then
do i=1,k do i=1,k
imax=idamax(psb_get_local_rows(desc_a)-iix+1,x(iix,jjx+i-1),1) imax=idamax(psb_cd_get_local_rows(desc_a)-iix+1,x(iix,jjx+i-1),1)
res(i)=abs(x(iix+imax-1,jjx+i-1)) res(i)=abs(x(iix+imax-1,jjx+i-1))
end do end do
end if end if

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

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

16
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 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (np == -ione) then if (np == -ione) then
@ -115,7 +115,7 @@ subroutine psb_daxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
goto 9999 goto 9999
end if end if
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
! check vector correctness ! check vector correctness
call psb_chkvect(m,ione,size(x,1),ix,ijx,desc_a,info,iix,jjx) call psb_chkvect(m,ione,size(x,1),ix,ijx,desc_a,info,iix,jjx)
@ -135,8 +135,8 @@ subroutine psb_daxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
end if end if
if ((in.ne.0)) then if ((in.ne.0)) then
if(psb_get_local_rows(desc_a).gt.0) then if(psb_cd_get_local_rows(desc_a).gt.0) then
call daxpby(psb_get_local_rows(desc_a),in,& call daxpby(psb_cd_get_local_rows(desc_a),in,&
& alpha,x(iix,jjx),size(x,1),beta,& & alpha,x(iix,jjx),size(x,1),beta,&
& y(iiy,jjy),size(y,1),info) & y(iiy,jjy),size(y,1),info)
end if end if
@ -228,7 +228,7 @@ subroutine psb_daxpbyv(alpha, x, beta,y,desc_a,info)
info=0 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (np == -ione) then if (np == -ione) then
@ -240,7 +240,7 @@ subroutine psb_daxpbyv(alpha, x, beta,y,desc_a,info)
ix = ione ix = ione
iy = ione iy = ione
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
! check vector correctness ! check vector correctness
call psb_chkvect(m,ione,size(x),ix,ione,desc_a,info,iix,jjx) call psb_chkvect(m,ione,size(x),ix,ione,desc_a,info,iix,jjx)
@ -263,8 +263,8 @@ subroutine psb_daxpbyv(alpha, x, beta,y,desc_a,info)
call psb_errpush(info,name) call psb_errpush(info,name)
end if end if
if(psb_get_local_rows(desc_a).gt.0) then if(psb_cd_get_local_rows(desc_a).gt.0) then
call daxpby(psb_get_local_rows(desc_a),ione,& call daxpby(psb_cd_get_local_rows(desc_a),ione,&
& alpha,x,size(x),beta,& & alpha,x,size(x),beta,&
& y,size(y),info) & y,size(y),info)
end if end if

42
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 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (np == -ione) then if (np == -ione) then
@ -101,7 +101,7 @@ function psb_ddot(x, y,desc_a, info, jx, jy)
goto 9999 goto 9999
end if end if
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
! check vector correctness ! check vector correctness
call psb_chkvect(m,ione,size(x,1),ix,ijx,desc_a,info,iix,jjx) call psb_chkvect(m,ione,size(x,1),ix,ijx,desc_a,info,iix,jjx)
@ -121,8 +121,8 @@ function psb_ddot(x, y,desc_a, info, jx, jy)
end if end if
if(m.ne.0) then if(m.ne.0) then
if(psb_get_local_rows(desc_a).gt.0) then if(psb_cd_get_local_rows(desc_a).gt.0) then
dot_local = ddot(psb_get_local_rows(desc_a),& dot_local = ddot(psb_cd_get_local_rows(desc_a),&
& x(iix,jjx),ione,y(iiy,jjy),ione) & x(iix,jjx),ione,y(iiy,jjy),ione)
! adjust dot_local because overlapped elements are computed more than once ! adjust dot_local because overlapped elements are computed more than once
i=1 i=1
@ -226,7 +226,7 @@ function psb_ddotv(x, y,desc_a, info)
info=0 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (np == -ione) then if (np == -ione) then
@ -239,7 +239,7 @@ function psb_ddotv(x, y,desc_a, info)
iy = ione iy = ione
jx = ione jx = ione
jy = ione jy = ione
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
! check vector correctness ! check vector correctness
call psb_chkvect(m,ione,size(x,1),ix,jx,desc_a,info,iix,jjx) call psb_chkvect(m,ione,size(x,1),ix,jx,desc_a,info,iix,jjx)
@ -259,8 +259,8 @@ function psb_ddotv(x, y,desc_a, info)
end if end if
if(m.ne.0) then if(m.ne.0) then
if(psb_get_local_rows(desc_a).gt.0) then if(psb_cd_get_local_rows(desc_a).gt.0) then
dot_local = ddot(psb_get_local_rows(desc_a),& dot_local = ddot(psb_cd_get_local_rows(desc_a),&
& x,ione,y,ione) & x,ione,y,ione)
! adjust dot_local because overlapped elements are computed more than once ! adjust dot_local because overlapped elements are computed more than once
i=1 i=1
@ -364,7 +364,7 @@ subroutine psb_ddotvs(res, x, y,desc_a, info)
info=0 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (np == -ione) then if (np == -ione) then
@ -375,7 +375,7 @@ subroutine psb_ddotvs(res, x, y,desc_a, info)
ix = ione ix = ione
iy = ione iy = ione
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
! check vector correctness ! check vector correctness
call psb_chkvect(m,ione,size(x,1),ix,ix,desc_a,info,iix,jjx) call psb_chkvect(m,ione,size(x,1),ix,ix,desc_a,info,iix,jjx)
@ -395,8 +395,8 @@ subroutine psb_ddotvs(res, x, y,desc_a, info)
end if end if
if(m.ne.0) then if(m.ne.0) then
if(psb_get_local_rows(desc_a).gt.0) then if(psb_cd_get_local_rows(desc_a).gt.0) then
dot_local = ddot(psb_get_local_rows(desc_a),& dot_local = ddot(psb_cd_get_local_rows(desc_a),&
& x,ione,y,ione) & x,ione,y,ione)
! adjust dot_local because overlapped elements are computed more than once ! adjust dot_local because overlapped elements are computed more than once
i=1 i=1
@ -505,7 +505,7 @@ subroutine psb_dmdots(res, x, y, desc_a, info)
info=0 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (np == -ione) then if (np == -ione) then
@ -517,7 +517,7 @@ subroutine psb_dmdots(res, x, y, desc_a, info)
ix = ione ix = ione
iy = ione iy = ione
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
! check vector correctness ! check vector correctness
call psb_chkvect(m,ione,size(x,1),ix,ix,desc_a,info,iix,jjx) call psb_chkvect(m,ione,size(x,1),ix,ix,desc_a,info,iix,jjx)
@ -545,9 +545,9 @@ subroutine psb_dmdots(res, x, y, desc_a, info)
allocate(dot_local(k)) allocate(dot_local(k))
if(m.ne.0) then if(m.ne.0) then
if(psb_get_local_rows(desc_a).gt.0) then if(psb_cd_get_local_rows(desc_a).gt.0) then
do j=1,k do j=1,k
dot_local(j) = ddot(psb_get_local_rows(desc_a),& dot_local(j) = ddot(psb_cd_get_local_rows(desc_a),&
& x(1,j),ione,y(1,j),ione) & x(1,j),ione,y(1,j),ione)
! adjust dot_local because overlapped elements are computed more than once ! adjust dot_local because overlapped elements are computed more than once
i=1 i=1
@ -611,7 +611,7 @@ subroutine psb_ddot2v(res, x, y,w,z,desc_a, info)
info=0 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (np == -ione) then if (np == -ione) then
@ -622,7 +622,7 @@ subroutine psb_ddot2v(res, x, y,w,z,desc_a, info)
ix = ione ix = ione
iy = ione iy = ione
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
! check vector correctness ! check vector correctness
call psb_chkvect(m,ione,size(x,1),ix,ix,desc_a,info,iix,jjx) call psb_chkvect(m,ione,size(x,1),ix,ix,desc_a,info,iix,jjx)
@ -642,10 +642,10 @@ subroutine psb_ddot2v(res, x, y,w,z,desc_a, info)
end if end if
if(m.ne.0) then if(m.ne.0) then
if(psb_get_local_rows(desc_a).gt.0) then if(psb_cd_get_local_rows(desc_a).gt.0) then
dot_local(1) = ddot(psb_get_local_rows(desc_a),& dot_local(1) = ddot(psb_cd_get_local_rows(desc_a),&
& x,ione,y,ione) & x,ione,y,ione)
dot_local(2) = ddot(psb_get_local_rows(desc_a),& dot_local(2) = ddot(psb_cd_get_local_rows(desc_a),&
& w,ione,z,ione) & w,ione,z,ione)
! adjust dot_local because overlapped elements are computed more than once ! adjust dot_local because overlapped elements are computed more than once
i=1 i=1

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

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

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

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

20
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 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (np == -1) then if (np == -1) then
@ -172,10 +172,10 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
itrans = 'N' itrans = 'N'
endif endif
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a) n = psb_cd_get_global_cols(desc_a)
nrow = psb_get_local_rows(desc_a) nrow = psb_cd_get_local_rows(desc_a)
ncol = psb_get_local_cols(desc_a) ncol = psb_cd_get_local_cols(desc_a)
lldx = size(x,1) lldx = size(x,1)
lldy = size(y,1) lldy = size(y,1)
@ -455,7 +455,7 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,&
info=0 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (np == -1) then if (np == -1) then
@ -495,10 +495,10 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,&
itrans = 'N' itrans = 'N'
endif endif
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a) n = psb_cd_get_global_cols(desc_a)
nrow = psb_get_local_rows(desc_a) nrow = psb_cd_get_local_rows(desc_a)
ncol = psb_get_local_cols(desc_a) ncol = psb_cd_get_local_cols(desc_a)
lldx = size(x) lldx = size(x)
lldy = size(y) lldy = size(y)

16
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 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (np == -1) then if (np == -1) then
@ -174,9 +174,9 @@ subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,&
itrans = 'N' itrans = 'N'
endif endif
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
nrow = psb_get_local_rows(desc_a) nrow = psb_cd_get_local_rows(desc_a)
ncol = psb_get_local_cols(desc_a) ncol = psb_cd_get_local_cols(desc_a)
lldx = size(x,1) lldx = size(x,1)
lldy = size(y,1) lldy = size(y,1)
@ -419,7 +419,7 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,&
info=0 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (np == -1) then if (np == -1) then
@ -466,9 +466,9 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,&
itrans = 'N' itrans = 'N'
endif endif
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
nrow = psb_get_local_rows(desc_a) nrow = psb_cd_get_local_rows(desc_a)
ncol = psb_get_local_cols(desc_a) ncol = psb_cd_get_local_cols(desc_a)
lldx = size(x) lldx = size(x)
lldy = size(y) lldy = size(y)

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

@ -73,7 +73,7 @@ function psb_zamax (x,desc_a, info, jx)
amax=0.d0 amax=0.d0
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (np == -1) then if (np == -1) then
@ -89,7 +89,7 @@ function psb_zamax (x,desc_a, info, jx)
ijx = 1 ijx = 1
endif endif
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx) call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx)
if(info.ne.0) then if(info.ne.0) then
@ -106,8 +106,8 @@ function psb_zamax (x,desc_a, info, jx)
end if end if
! compute local max ! compute local max
if ((psb_get_local_rows(desc_a).gt.0).and.(m.ne.0)) then if ((psb_cd_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) imax=izamax(psb_cd_get_local_rows(desc_a)-iix+1,x(iix,jjx),1)
amax=cabs1(x(iix+imax-1,jjx)) amax=cabs1(x(iix+imax-1,jjx))
end if end if
@ -202,7 +202,7 @@ function psb_zamaxv (x,desc_a, info)
amax=0.d0 amax=0.d0
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (np == -1) then if (np == -1) then
@ -214,7 +214,7 @@ function psb_zamaxv (x,desc_a, info)
ix = 1 ix = 1
jx = 1 jx = 1
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
call psb_chkvect(m,1,size(x,1),ix,jx,desc_a,info,iix,jjx) call psb_chkvect(m,1,size(x,1),ix,jx,desc_a,info,iix,jjx)
if(info.ne.0) then if(info.ne.0) then
@ -231,8 +231,8 @@ function psb_zamaxv (x,desc_a, info)
end if end if
! compute local max ! compute local max
if ((psb_get_local_rows(desc_a).gt.0).and.(m.ne.0)) then if ((psb_cd_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) imax=izamax(psb_cd_get_local_rows(desc_a)-iix+1,x(iix),1)
cmax=(x(iix+imax-1)) cmax=(x(iix+imax-1))
amax=cabs1(cmax) amax=cabs1(cmax)
end if end if
@ -330,7 +330,7 @@ subroutine psb_zamaxvs (res,x,desc_a, info)
amax=0.d0 amax=0.d0
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (np == -1) then if (np == -1) then
@ -342,7 +342,7 @@ subroutine psb_zamaxvs (res,x,desc_a, info)
ix = 1 ix = 1
ijx=1 ijx=1
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx) call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx)
if(info.ne.0) then if(info.ne.0) then
@ -359,8 +359,8 @@ subroutine psb_zamaxvs (res,x,desc_a, info)
end if end if
! compute local max ! compute local max
if ((psb_get_local_rows(desc_a).gt.0).and.(m.ne.0)) then if ((psb_cd_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) imax=izamax(psb_cd_get_local_rows(desc_a)-iix+1,x(iix),1)
cmax=(x(iix+imax-1)) cmax=(x(iix+imax-1))
amax=cabs1(cmax) amax=cabs1(cmax)
end if end if
@ -457,7 +457,7 @@ subroutine psb_zmamaxs (res,x,desc_a, info,jx)
amax=0.d0 amax=0.d0
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (np == -1) then if (np == -1) then
@ -473,7 +473,7 @@ subroutine psb_zmamaxs (res,x,desc_a, info,jx)
ijx = 1 ijx = 1
endif endif
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
k = min(size(x,2),size(res,1)) k = min(size(x,2),size(res,1))
call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx) call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx)
@ -491,9 +491,9 @@ subroutine psb_zmamaxs (res,x,desc_a, info,jx)
end if end if
! compute local max ! compute local max
if ((psb_get_local_rows(desc_a).gt.0).and.(m.ne.0)) then if ((psb_cd_get_local_rows(desc_a).gt.0).and.(m.ne.0)) then
do i=1,k do i=1,k
imax=izamax(psb_get_local_rows(desc_a)-iix+1,x(iix,jjx+i-1),1) imax=izamax(psb_cd_get_local_rows(desc_a)-iix+1,x(iix,jjx+i-1),1)
cmax=(x(iix+imax-1,jjx+i-1)) cmax=(x(iix+imax-1,jjx+i-1))
res(i)=cabs1(cmax) res(i)=cabs1(cmax)
end do end do

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

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

16
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 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (np == -ione) then if (np == -ione) then
@ -114,7 +114,7 @@ subroutine psb_zaxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
goto 9999 goto 9999
end if end if
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
! check vector correctness ! check vector correctness
call psb_chkvect(m,ione,size(x,1),ix,ijx,desc_a,info,iix,jjx) call psb_chkvect(m,ione,size(x,1),ix,ijx,desc_a,info,iix,jjx)
@ -134,8 +134,8 @@ subroutine psb_zaxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
end if end if
if ((in.ne.0)) then if ((in.ne.0)) then
if(psb_get_local_rows(desc_a).gt.0) then if(psb_cd_get_local_rows(desc_a).gt.0) then
call zaxpby(psb_get_local_cols(desc_a),in,& call zaxpby(psb_cd_get_local_cols(desc_a),in,&
& alpha,x(iix,jjx),size(x,1),beta,& & alpha,x(iix,jjx),size(x,1),beta,&
& y(iiy,jjy),size(y,1),info) & y(iiy,jjy),size(y,1),info)
end if end if
@ -227,7 +227,7 @@ subroutine psb_zaxpbyv(alpha, x, beta,y,desc_a,info)
info=0 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (np == -ione) then if (np == -ione) then
@ -239,7 +239,7 @@ subroutine psb_zaxpbyv(alpha, x, beta,y,desc_a,info)
ix = ione ix = ione
iy = ione iy = ione
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
! check vector correctness ! check vector correctness
call psb_chkvect(m,ione,size(x),ix,ione,desc_a,info,iix,jjx) call psb_chkvect(m,ione,size(x),ix,ione,desc_a,info,iix,jjx)
@ -262,8 +262,8 @@ subroutine psb_zaxpbyv(alpha, x, beta,y,desc_a,info)
call psb_errpush(info,name) call psb_errpush(info,name)
end if end if
if(psb_get_local_rows(desc_a).gt.0) then if(psb_cd_get_local_rows(desc_a).gt.0) then
call zaxpby(psb_get_local_cols(desc_a),ione,& call zaxpby(psb_cd_get_local_cols(desc_a),ione,&
& alpha,x,size(x),beta,& & alpha,x,size(x),beta,&
& y,size(y),info) & y,size(y),info)
end if end if

32
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 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (np == -ione) then if (np == -ione) then
@ -101,7 +101,7 @@ function psb_zdot(x, y,desc_a, info, jx, jy)
goto 9999 goto 9999
end if end if
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
! check vector correctness ! check vector correctness
call psb_chkvect(m,ione,size(x,1),ix,ijx,desc_a,info,iix,jjx) call psb_chkvect(m,ione,size(x,1),ix,ijx,desc_a,info,iix,jjx)
@ -121,8 +121,8 @@ function psb_zdot(x, y,desc_a, info, jx, jy)
end if end if
if(m.ne.0) then if(m.ne.0) then
if(psb_get_local_rows(desc_a).gt.0) then if(psb_cd_get_local_rows(desc_a).gt.0) then
dot_local = zdotc(psb_get_local_rows(desc_a),& dot_local = zdotc(psb_cd_get_local_rows(desc_a),&
& x(iix,jjx),ione,y(iiy,jjy),ione) & x(iix,jjx),ione,y(iiy,jjy),ione)
! adjust dot_local because overlapped elements are computed more than once ! adjust dot_local because overlapped elements are computed more than once
i=1 i=1
@ -226,7 +226,7 @@ function psb_zdotv(x, y,desc_a, info)
info=0 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (np == -ione) then if (np == -ione) then
@ -239,7 +239,7 @@ function psb_zdotv(x, y,desc_a, info)
iy = ione iy = ione
jx = ione jx = ione
jy = ione jy = ione
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
! check vector correctness ! check vector correctness
call psb_chkvect(m,ione,size(x,1),ix,jx,desc_a,info,iix,jjx) call psb_chkvect(m,ione,size(x,1),ix,jx,desc_a,info,iix,jjx)
@ -259,8 +259,8 @@ function psb_zdotv(x, y,desc_a, info)
end if end if
if(m.ne.0) then if(m.ne.0) then
if(psb_get_local_rows(desc_a).gt.0) then if(psb_cd_get_local_rows(desc_a).gt.0) then
dot_local = zdotc(psb_get_local_rows(desc_a),& dot_local = zdotc(psb_cd_get_local_rows(desc_a),&
& x,ione,y,ione) & x,ione,y,ione)
! adjust dot_local because overlapped elements are computed more than once ! adjust dot_local because overlapped elements are computed more than once
i=1 i=1
@ -364,7 +364,7 @@ subroutine psb_zdotvs(res, x, y,desc_a, info)
info=0 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (np == -ione) then if (np == -ione) then
@ -375,7 +375,7 @@ subroutine psb_zdotvs(res, x, y,desc_a, info)
ix = ione ix = ione
iy = ione iy = ione
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
! check vector correctness ! check vector correctness
call psb_chkvect(m,ione,size(x,1),ix,ix,desc_a,info,iix,jjx) call psb_chkvect(m,ione,size(x,1),ix,ix,desc_a,info,iix,jjx)
@ -395,8 +395,8 @@ subroutine psb_zdotvs(res, x, y,desc_a, info)
end if end if
if(m.ne.0) then if(m.ne.0) then
if(psb_get_local_rows(desc_a).gt.0) then if(psb_cd_get_local_rows(desc_a).gt.0) then
dot_local = zdotc(psb_get_local_rows(desc_a),& dot_local = zdotc(psb_cd_get_local_rows(desc_a),&
& x,ione,y,ione) & x,ione,y,ione)
! adjust dot_local because overlapped elements are computed more than once ! adjust dot_local because overlapped elements are computed more than once
i=1 i=1
@ -505,7 +505,7 @@ subroutine psb_zmdots(res, x, y, desc_a, info)
info=0 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (np == -ione) then if (np == -ione) then
@ -517,7 +517,7 @@ subroutine psb_zmdots(res, x, y, desc_a, info)
ix = ione ix = ione
iy = ione iy = ione
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
! check vector correctness ! check vector correctness
call psb_chkvect(m,ione,size(x,1),ix,ix,desc_a,info,iix,jjx) call psb_chkvect(m,ione,size(x,1),ix,ix,desc_a,info,iix,jjx)
@ -545,9 +545,9 @@ subroutine psb_zmdots(res, x, y, desc_a, info)
allocate(dot_local(k)) allocate(dot_local(k))
if(m.ne.0) then if(m.ne.0) then
if(psb_get_local_rows(desc_a).gt.0) then if(psb_cd_get_local_rows(desc_a).gt.0) then
do j=1,k do j=1,k
dot_local(j) = zdotc(psb_get_local_rows(desc_a),& dot_local(j) = zdotc(psb_cd_get_local_rows(desc_a),&
& x(1,j),ione,y(1,j),ione) & x(1,j),ione,y(1,j),ione)
! adjust dot_local because overlapped elements are computed more than once ! adjust dot_local because overlapped elements are computed more than once
i=1 i=1

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

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

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

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

20
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 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (np == -1) then if (np == -1) then
@ -168,10 +168,10 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
itrans = 'N' itrans = 'N'
endif endif
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a) n = psb_cd_get_global_cols(desc_a)
nrow = psb_get_local_rows(desc_a) nrow = psb_cd_get_local_rows(desc_a)
ncol = psb_get_local_cols(desc_a) ncol = psb_cd_get_local_cols(desc_a)
lldx = size(x,1) lldx = size(x,1)
lldy = size(y,1) lldy = size(y,1)
@ -450,7 +450,7 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,&
info=0 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (np == -1) then if (np == -1) then
@ -486,10 +486,10 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,&
itrans = 'N' itrans = 'N'
endif endif
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a) n = psb_cd_get_global_cols(desc_a)
nrow = psb_get_local_rows(desc_a) nrow = psb_cd_get_local_rows(desc_a)
ncol = psb_get_local_cols(desc_a) ncol = psb_cd_get_local_cols(desc_a)
lldx = size(x) lldx = size(x)
lldy = size(y) lldy = size(y)

16
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 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (np == -1) then if (np == -1) then
@ -178,9 +178,9 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,&
itrans = 'N' itrans = 'N'
endif endif
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
nrow = psb_get_local_rows(desc_a) nrow = psb_cd_get_local_rows(desc_a)
ncol = psb_get_local_cols(desc_a) ncol = psb_cd_get_local_cols(desc_a)
lldx = size(x,1) lldx = size(x,1)
lldy = size(y,1) lldy = size(y,1)
@ -423,7 +423,7 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
info=0 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (np == -1) then if (np == -1) then
@ -466,9 +466,9 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
itrans = 'N' itrans = 'N'
endif endif
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
nrow = psb_get_local_rows(desc_a) nrow = psb_cd_get_local_rows(desc_a)
ncol = psb_get_local_cols(desc_a) ncol = psb_cd_get_local_cols(desc_a)
lldx = size(x) lldx = size(x)
lldy = size(y) lldy = size(y)

4
src/serial/Makefile
Unescape Escape View File

@ -5,13 +5,13 @@ FOBJS = psb_cest.o psb_dcoins.o psb_dcsdp.o psb_dcsmm.o psb_dcsmv.o \
psb_dcsnmi.o psb_dcsprt.o psb_dcsrws.o psb_dcssm.o psb_dcssv.o \ psb_dcsnmi.o psb_dcsprt.o psb_dcsrws.o psb_dcssm.o psb_dcssv.o \
psb_dfixcoo.o psb_dipcoo2csr.o psb_dipcsr2coo.o psb_dneigh.o \ psb_dfixcoo.o psb_dipcoo2csr.o psb_dipcsr2coo.o psb_dneigh.o \
psb_dnumbmm.o psb_drwextd.o psb_dspgtdiag.o psb_dspgtblk.o \ psb_dnumbmm.o psb_drwextd.o psb_dspgtdiag.o psb_dspgtblk.o \
psb_dspinfo.o psb_dspscal.o psb_dsymbmm.o psb_dtransp.o \ psb_dspscal.o psb_dsymbmm.o psb_dtransp.o \
psb_dipcoo2csc.o psb_dspgetrow.o lsame.o psb_zspgetrow.o\ psb_dipcoo2csc.o psb_dspgetrow.o lsame.o psb_zspgetrow.o\
psb_zcsmm.o psb_zcsmv.o psb_zspgtdiag.o psb_zspgtblk.o\ psb_zcsmm.o psb_zcsmv.o psb_zspgtdiag.o psb_zspgtblk.o\
psb_zcsnmi.o psb_zcsrws.o psb_zcssm.o psb_zcssv.o psb_zcsdp.o\ psb_zcsnmi.o psb_zcsrws.o psb_zcssm.o psb_zcssv.o psb_zcsdp.o\
psb_zfixcoo.o psb_zipcoo2csr.o psb_zipcsr2coo.o psb_zipcoo2csc.o \ psb_zfixcoo.o psb_zipcoo2csr.o psb_zipcsr2coo.o psb_zipcoo2csc.o \
psb_zcoins.o psb_zcsprt.o psb_zneigh.o psb_ztransp.o psb_ztransc.o\ psb_zcoins.o psb_zcsprt.o psb_zneigh.o psb_ztransp.o psb_ztransc.o\
psb_zrwextd.o psb_zsymbmm.o psb_znumbmm.o psb_zspinfo.o psb_zspscal.o\ psb_zrwextd.o psb_zsymbmm.o psb_znumbmm.o psb_zspscal.o\
psb_getifield.o psb_setifield.o psb_update_mod.o psb_getifield.o psb_setifield.o psb_update_mod.o
INCDIRS = -I ../../lib -I . INCDIRS = -I ../../lib -I .

18
src/serial/psb_dcoins.f90
Unescape Escape View File

@ -38,7 +38,7 @@ subroutine psb_dcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
use psb_realloc_mod use psb_realloc_mod
use psb_string_mod use psb_string_mod
use psb_error_mod use psb_error_mod
use psb_serial_mod, only : psb_spinfo, psb_csdp use psb_serial_mod, only : psb_csdp
use psb_update_mod use psb_update_mod
implicit none implicit none
@ -110,8 +110,8 @@ subroutine psb_dcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
call psb_spinfo(psb_nztotreq_,a,nza,info) call psb_sp_info(psb_nztotreq_,a,nza,info)
call psb_spinfo(psb_nzsizereq_,a,isza,info) call psb_sp_info(psb_nzsizereq_,a,isza,info)
if(info /= izero) then if(info /= izero) then
info=4010 info=4010
ch_err='psb_spinfo' ch_err='psb_spinfo'
@ -206,8 +206,8 @@ subroutine psb_dcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
endif endif
call psb_spinfo(psb_nztotreq_,a,nza,info) call psb_sp_info(psb_nztotreq_,a,nza,info)
call psb_spinfo(psb_nzsizereq_,a,isza,info) call psb_sp_info(psb_nzsizereq_,a,isza,info)
if(info /= izero) then if(info /= izero) then
info=4010 info=4010
ch_err='psb_spinfo' ch_err='psb_spinfo'
@ -282,8 +282,8 @@ subroutine psb_dcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
call psb_spinfo(psb_nztotreq_,a,nza,info) call psb_sp_info(psb_nztotreq_,a,nza,info)
call psb_spinfo(psb_nzsizereq_,a,isza,info) call psb_sp_info(psb_nzsizereq_,a,isza,info)
if(info /= izero) then if(info /= izero) then
info=4010 info=4010
ch_err='psb_spinfo' ch_err='psb_spinfo'
@ -367,8 +367,8 @@ subroutine psb_dcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
write(0,*) 'COINS Rebuild: size',tmp%infoa(psb_nnz_) ,irst write(0,*) 'COINS Rebuild: size',tmp%infoa(psb_nnz_) ,irst
endif endif
call psb_sp_transfer(tmp,a,info) call psb_sp_transfer(tmp,a,info)
call psb_spinfo(psb_nztotreq_,a,nza,info) call psb_sp_info(psb_nztotreq_,a,nza,info)
call psb_spinfo(psb_nzsizereq_,a,isza,info) call psb_sp_info(psb_nzsizereq_,a,isza,info)
if(info /= izero) then if(info /= izero) then
info=4010 info=4010
ch_err='psb_spinfo' ch_err='psb_spinfo'

14
src/serial/psb_dcsdp.f90
Unescape Escape View File

@ -78,17 +78,7 @@ subroutine psb_dcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
end subroutine psb_cest end subroutine psb_cest
end interface end interface
interface psb_spinfo name='psb_csdp'
subroutine psb_dspinfo(ireq,a,ires,info,iaux)
use psb_spmat_type
type(psb_dspmat_type), intent(in) :: a
integer, intent(in) :: ireq
integer, intent(out) :: ires, info
integer, intent(in), optional :: iaux
end subroutine psb_dspinfo
end interface
name='psb_dcsdp'
info = 0 info = 0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -180,7 +170,7 @@ subroutine psb_dcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
! ...matrix conversion... ! ...matrix conversion...
b%m=a%m b%m=a%m
b%k=a%k b%k=a%k
call psb_spinfo(psb_nztotreq_,a,size_req,info) size_req = psb_sp_get_nnzeros(a)
if (debug) write(0,*) 'DCSDP : size_req 1:',size_req if (debug) write(0,*) 'DCSDP : size_req 1:',size_req
! !

195
src/serial/psb_dspinfo.f90
Unescape Escape View File

@ -1,195 +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_dspinfo.f90
! Subroutine:
! Parameters:
!*****************************************************************************
!* *
!* Extract info from sparse matrix A. The required info is always a single *
!* integer. Input FIDA might be anything, once *
!* we get to actually write the code..... *
!* *
!*****************************************************************************
subroutine psb_dspinfo(ireq,a,ires,info,iaux)
use psb_spmat_type
use psb_const_mod
use psb_error_mod
use psb_string_mod
implicit none
type(psb_dspmat_type), intent(in), target :: a
integer, intent(in) :: ireq
integer, intent(out) :: ires, info
integer, intent(in), optional :: iaux
integer :: i,j,k,ip,jp,nr,irw,nz, err_act, row, ipx, pia, pja, rb,idx, nc
integer, pointer :: ia1(:), ia2(:), ia3(:), ja(:)
character(len=20) :: name, ch_err
name='psb_dspinfo'
info = 0
call psb_erractionsave(err_act)
if (ireq == psb_nztotreq_) then
! The number of nonzeroes
if (toupper(a%fida) == 'CSR') then
nr = a%m
ires = a%ia2(nr+1)-1
else if ((toupper(a%fida) == 'COO').or.(toupper(a%fida) == 'COI')) then
ires = a%infoa(psb_nnz_)
else if (toupper(a%fida) == 'JAD') then
ires = a%infoa(psb_nnz_)
else if (toupper(a%fida) == 'CSC') then
nc = a%k
ires = a%ia2(nc+1)-1
else
ires=-1
info=136
ch_err=a%fida(1:3)
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
else if (ireq == psb_nzrowreq_) then
! The number of nonzeroes in row iaux
if (.not.present(iaux)) then
write(0,*) 'Need IAUX when ireq=nzrowreq'
ires=-1
return
endif
irw = iaux
if (toupper(a%fida) == 'CSR') then
ires = a%ia2(irw+1)-a%ia2(irw)
else if ((toupper(a%fida) == 'COO').or.(toupper(a%fida) == 'COI')) then
if (a%infoa(psb_srtd_) == psb_isrtdcoo_) then
! In this case we can do a binary search.
nz = a%infoa(psb_nnz_)
call ibsrch(ip,irw,nz,a%ia1)
jp = ip
! expand [ip,jp] to contain all row entries.
do
if (ip < 2) exit
if (a%ia1(ip-1) == irw) then
ip = ip -1
else
exit
end if
end do
do
if (jp > nz) exit
if (a%ia1(jp) == irw) then
jp =jp + 1
else
exit
endif
end do
ires = jp-ip
else
ires = count(a%ia1(1:a%infoa(psb_nnz_))==irw)
endif
!!$ ires = 0
!!$ do i=1, a%infoa(psb_nnz_)
!!$ if (a%ia1(i) == irw) ires = ires + 1
!!$ enddo
else if (toupper(a%fida) == 'JAD') then
pia = a%ia2(2) ! points to the beginning of ia(3,png)
pja = a%ia2(3) ! points to the beginning of ja(:)
ja => a%ia2(pja:) ! the array containing the pointers to ka and aspk
ia1 => a%ia2(pia:pja-1:3) ! the array containing the first row index of each block
ia2 => a%ia2(pia+1:pja-1:3) ! the array containing a pointer to the pos. in ja to the first jad column
ia3 => a%ia2(pia+2:pja-1:3) ! the array containing a pointer to the pos. in ja to the first csr column
idx=a%pl(irw)
j=0
nz=0
blkfnd: do
j=j+1
if(ia1(j).eq.idx) then
nz=nz+ia3(j)-ia2(j)
ipx = ia1(j) ! the first row index of the block
rb = idx-ipx ! the row offset within the block
row = ia3(j)+rb
nz = nz+ja(row+1)-ja(row)
exit blkfnd
else if(ia1(j).gt.idx) then
nz=nz+ia3(j-1)-ia2(j-1)
ipx = ia1(j-1) ! the first row index of the block
rb = idx-ipx ! the row offset within the block
row = ia3(j-1)+rb
nz = nz+ja(row+1)-ja(row)
exit blkfnd
end if
end do blkfnd
ires=nz
else
ires=-1
info=136
ch_err=a%fida(1:3)
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
else if (ireq == psb_nzsizereq_) then
if (toupper(a%fida) == 'CSR') then
ires = size(a%aspk)
else if ((toupper(a%fida) == 'COO').or.(toupper(a%fida) == 'COI')) then
ires = size(a%aspk)
else if (toupper(a%fida) == 'JAD') then
ires = a%infoa(psb_nnz_)
else
ires=-1
info=136
ch_err=a%fida(1:3)
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
else
write(0,*) 'Unknown request into SPINFO'
ires=-1
endif
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_dspinfo

18
src/serial/psb_zcoins.f90
Unescape Escape View File

@ -38,7 +38,7 @@ subroutine psb_zcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
use psb_realloc_mod use psb_realloc_mod
use psb_string_mod use psb_string_mod
use psb_error_mod use psb_error_mod
use psb_serial_mod, only : psb_spinfo, psb_csdp use psb_serial_mod, only : psb_sp_info, psb_csdp
use psb_update_mod use psb_update_mod
implicit none implicit none
@ -110,8 +110,8 @@ subroutine psb_zcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
call psb_spinfo(psb_nztotreq_,a,nza,info) call psb_sp_info(psb_nztotreq_,a,nza,info)
call psb_spinfo(psb_nzsizereq_,a,isza,info) call psb_sp_info(psb_nzsizereq_,a,isza,info)
if(info /= izero) then if(info /= izero) then
info=4010 info=4010
ch_err='psb_spinfo' ch_err='psb_spinfo'
@ -206,8 +206,8 @@ subroutine psb_zcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
endif endif
call psb_spinfo(psb_nztotreq_,a,nza,info) call psb_sp_info(psb_nztotreq_,a,nza,info)
call psb_spinfo(psb_nzsizereq_,a,isza,info) call psb_sp_info(psb_nzsizereq_,a,isza,info)
if(info /= izero) then if(info /= izero) then
info=4010 info=4010
ch_err='psb_spinfo' ch_err='psb_spinfo'
@ -282,8 +282,8 @@ subroutine psb_zcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
call psb_spinfo(psb_nztotreq_,a,nza,info) call psb_sp_info(psb_nztotreq_,a,nza,info)
call psb_spinfo(psb_nzsizereq_,a,isza,info) call psb_sp_info(psb_nzsizereq_,a,isza,info)
if(info /= izero) then if(info /= izero) then
info=4010 info=4010
ch_err='psb_spinfo' ch_err='psb_spinfo'
@ -367,8 +367,8 @@ subroutine psb_zcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
write(0,*) 'COINS Rebuild: size',tmp%infoa(psb_nnz_) ,irst write(0,*) 'COINS Rebuild: size',tmp%infoa(psb_nnz_) ,irst
endif endif
call psb_sp_transfer(tmp,a,info) call psb_sp_transfer(tmp,a,info)
call psb_spinfo(psb_nztotreq_,a,nza,info) call psb_sp_info(psb_nztotreq_,a,nza,info)
call psb_spinfo(psb_nzsizereq_,a,isza,info) call psb_sp_info(psb_nzsizereq_,a,isza,info)
if(info /= izero) then if(info /= izero) then
info=4010 info=4010
ch_err='psb_spinfo' ch_err='psb_spinfo'

16
src/serial/psb_zcsdp.f90
Unescape Escape View File

@ -78,17 +78,7 @@ subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
end subroutine psb_cest end subroutine psb_cest
end interface end interface
interface psb_spinfo name='psb_csdp'
subroutine psb_zspinfo(ireq,a,ires,info,iaux)
use psb_spmat_type
type(psb_zspmat_type), intent(in) :: a
integer, intent(in) :: ireq
integer, intent(out) :: ires, info
integer, intent(in), optional :: iaux
end subroutine psb_zspinfo
end interface
name='psb_zcsdp'
info = 0 info = 0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -180,8 +170,8 @@ subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
! ...matrix conversion... ! ...matrix conversion...
b%m=a%m b%m=a%m
b%k=a%k b%k=a%k
call psb_spinfo(psb_nztotreq_,a,size_req,info) size_req = psb_sp_get_nnzeros(a)
if (debug) write(0,*) 'DCSDP : size_req 1:',size_req,a%m,a%k if (debug) write(0,*) 'DCSDP : size_req 1:',size_req
! !
n_row=b%m n_row=b%m

195
src/serial/psb_zspinfo.f90
Unescape Escape View File

@ -1,195 +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_zspinfo.f90
! Subroutine:
! Parameters:
!*****************************************************************************
!* *
!* Extract info from sparse matrix A. The required info is always a single *
!* integer. Input FIDA might be anything, once *
!* we get to actually write the code..... *
!* *
!*****************************************************************************
subroutine psb_zspinfo(ireq,a,ires,info,iaux)
use psb_spmat_type
use psb_const_mod
use psb_error_mod
use psb_string_mod
implicit none
type(psb_zspmat_type), intent(in), target :: a
integer, intent(in) :: ireq
integer, intent(out) :: ires, info
integer, intent(in), optional :: iaux
integer :: i,j,k,ip,jp,nr,irw,nz, err_act, row, ipx, pia, pja, rb,idx, nc
integer, pointer :: ia1(:), ia2(:), ia3(:), ja(:)
character(len=20) :: name, ch_err
name='psb_zspinfo'
info = 0
call psb_erractionsave(err_act)
if (ireq == psb_nztotreq_) then
! The number of nonzeroes
if (toupper(a%fida) == 'CSR') then
nr = a%m
ires = a%ia2(nr+1)-1
else if ((toupper(a%fida) == 'COO').or.(toupper(a%fida) == 'COI')) then
ires = a%infoa(psb_nnz_)
else if (toupper(a%fida) == 'JAD') then
ires = a%infoa(psb_nnz_)
else if (toupper(a%fida) == 'CSC') then
nc = a%k
ires = a%ia2(nc+1)-1
else
ires=-1
info=136
ch_err=a%fida(1:3)
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
else if (ireq == psb_nzrowreq_) then
! The number of nonzeroes in row iaux
if (.not.present(iaux)) then
write(0,*) 'Need IAUX when ireq=nzrowreq'
ires=-1
return
endif
irw = iaux
if (toupper(a%fida) == 'CSR') then
ires = a%ia2(irw+1)-a%ia2(irw)
else if ((toupper(a%fida) == 'COO').or.(toupper(a%fida) == 'COI')) then
if (a%infoa(psb_srtd_) == psb_isrtdcoo_) then
! In this case we can do a binary search.
nz = a%infoa(psb_nnz_)
call ibsrch(ip,irw,nz,a%ia1)
jp = ip
! expand [ip,jp] to contain all row entries.
do
if (ip < 2) exit
if (a%ia1(ip-1) == irw) then
ip = ip -1
else
exit
end if
end do
do
if (jp > nz) exit
if (a%ia1(jp) == irw) then
jp =jp + 1
else
exit
endif
end do
ires = jp-ip
else
ires = count(a%ia1(1:a%infoa(psb_nnz_))==irw)
endif
!!$ ires = 0
!!$ do i=1, a%infoa(psb_nnz_)
!!$ if (a%ia1(i) == irw) ires = ires + 1
!!$ enddo
else if (toupper(a%fida) == 'JAD') then
pia = a%ia2(2) ! points to the beginning of ia(3,png)
pja = a%ia2(3) ! points to the beginning of ja(:)
ja => a%ia2(pja:) ! the array containing the pointers to ka and aspk
ia1 => a%ia2(pia:pja-1:3) ! the array containing the first row index of each block
ia2 => a%ia2(pia+1:pja-1:3) ! the array containing a pointer to the pos. in ja to the first jad column
ia3 => a%ia2(pia+2:pja-1:3) ! the array containing a pointer to the pos. in ja to the first csr column
idx=a%pl(irw)
j=0
nz=0
blkfnd: do
j=j+1
if(ia1(j).eq.idx) then
nz=nz+ia3(j)-ia2(j)
ipx = ia1(j) ! the first row index of the block
rb = idx-ipx ! the row offset within the block
row = ia3(j)+rb
nz = nz+ja(row+1)-ja(row)
exit blkfnd
else if(ia1(j).gt.idx) then
nz=nz+ia3(j-1)-ia2(j-1)
ipx = ia1(j-1) ! the first row index of the block
rb = idx-ipx ! the row offset within the block
row = ia3(j-1)+rb
nz = nz+ja(row+1)-ja(row)
exit blkfnd
end if
end do blkfnd
ires=nz
else
ires=-1
info=136
ch_err=a%fida(1:3)
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
else if (ireq == psb_nzsizereq_) then
if (toupper(a%fida) == 'CSR') then
ires = size(a%aspk)
else if ((toupper(a%fida) == 'COO').or.(toupper(a%fida) == 'COI')) then
ires = size(a%aspk)
else if (toupper(a%fida) == 'JAD') then
ires = a%infoa(psb_nnz_)
else
ires=-1
info=136
ch_err=a%fida(1:3)
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
else
write(0,*) 'Unknown request into SPINFO'
ires=-1
endif
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_zspinfo

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

@ -66,10 +66,10 @@ subroutine psb_cdasb(desc_a,info)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = psb_get_context(desc_a) ictxt = psb_cd_get_context(desc_a)
dectype = psb_get_dectype(desc_a) dectype = psb_cd_get_dectype(desc_a)
n_row = psb_get_local_rows(desc_a) n_row = psb_cd_get_local_rows(desc_a)
n_col = psb_get_local_cols(desc_a) n_col = psb_cd_get_local_cols(desc_a)
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
@ -91,7 +91,7 @@ subroutine psb_cdasb(desc_a,info)
if (psb_is_bld_desc(desc_a)) then if (psb_is_bld_desc(desc_a)) then
if (debug) write(0,*) 'psb_cdasb: Checking rows insertion' if (debug) write(0,*) 'psb_cdasb: Checking rows insertion'
! check if all local row are inserted ! check if all local row are inserted
do i=1,psb_get_local_cols(desc_a) do i=1,psb_cd_get_local_cols(desc_a)
if (desc_a%loc_to_glob(i) < 0) then if (desc_a%loc_to_glob(i) < 0) then
info=3100 info=3100
exit exit
@ -102,7 +102,7 @@ subroutine psb_cdasb(desc_a,info)
call psb_errpush(info,name,i_err=int_err) call psb_errpush(info,name,i_err=int_err)
goto 9999 goto 9999
endif endif
call psb_realloc(psb_get_local_cols(desc_a),desc_a%loc_to_glob,info) call psb_realloc(psb_cd_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%ovrlap_index,ovrlap_index,info)
call psb_transfer(desc_a%halo_index,halo_index,info) call psb_transfer(desc_a%halo_index,halo_index,info)

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

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

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

@ -66,12 +66,12 @@ subroutine psb_cdins(nz,ia,ja,desc_a,info)
name = 'psb_cdins' name = 'psb_cdins'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = psb_get_context(desc_a) ictxt = psb_cd_get_context(desc_a)
dectype = psb_get_dectype(desc_a) dectype = psb_cd_get_dectype(desc_a)
mglob = psb_get_global_rows(desc_a) mglob = psb_cd_get_global_rows(desc_a)
nglob = psb_get_global_cols(desc_a) nglob = psb_cd_get_global_cols(desc_a)
nrow = psb_get_local_rows(desc_a) nrow = psb_cd_get_local_rows(desc_a)
ncol = psb_get_local_cols(desc_a) ncol = psb_cd_get_local_cols(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)

10
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() time(1) = mpi_wtime()
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
dectype=psb_get_dectype(desc_a) dectype=psb_cd_get_dectype(desc_a)
n_row = psb_get_local_rows(desc_a) n_row = psb_cd_get_local_rows(desc_a)
n_col = psb_get_local_cols(desc_a) n_col = psb_cd_get_local_cols(desc_a)
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
@ -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 desc_a%glob_to_loc(desc_a%loc_to_glob(desc_a%lprm(i))) = i
enddo enddo
if (debug) write(0,*) 'spasb: renumbering loc_to_glob' if (debug) write(0,*) 'spasb: renumbering loc_to_glob'
do i=1,psb_get_global_rows(desc_a) do i=1,psb_cd_get_global_rows(desc_a)
j = desc_a%glob_to_loc(i) j = desc_a%glob_to_loc(i)
if (j>0) then if (j>0) then
desc_a%loc_to_glob(j) = i desc_a%loc_to_glob(j) = i

16
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 int_err(1)=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (np == -1) then if (np == -1) then
@ -77,7 +77,7 @@ subroutine psb_dalloc(x, desc_a, info, n)
goto 9999 goto 9999
endif endif
dectype=psb_get_dectype(desc_a) dectype=psb_cd_get_dectype(desc_a)
!... check m and n parameters.... !... check m and n parameters....
if (.not.psb_is_ok_desc(desc_a)) then if (.not.psb_is_ok_desc(desc_a)) then
info = 3110 info = 3110
@ -106,7 +106,7 @@ subroutine psb_dalloc(x, desc_a, info, n)
!....allocate x ..... !....allocate x .....
if (psb_is_asb_desc(desc_a).or.psb_is_upd_desc(desc_a)) then 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)) n_col = max(1,psb_cd_get_local_cols(desc_a))
allocate(x(n_col,n_),stat=info) allocate(x(n_col,n_),stat=info)
if (info /= 0) then if (info /= 0) then
info=4010 info=4010
@ -120,7 +120,7 @@ subroutine psb_dalloc(x, desc_a, info, n)
end do end do
end do end do
else if (psb_is_bld_desc(desc_a)) then else if (psb_is_bld_desc(desc_a)) then
n_row = max(1,psb_get_local_rows(desc_a)) n_row = max(1,psb_cd_get_local_rows(desc_a))
allocate(x(n_row,n_),stat=info) allocate(x(n_row,n_),stat=info)
if (info /= 0) then if (info /= 0) then
info=4010 info=4010
@ -213,7 +213,7 @@ subroutine psb_dallocv(x, desc_a,info,n)
name='psb_dallcv' name='psb_dallcv'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
! ....verify blacs grid correctness.. ! ....verify blacs grid correctness..
@ -223,7 +223,7 @@ subroutine psb_dallocv(x, desc_a,info,n)
goto 9999 goto 9999
endif endif
dectype=psb_get_dectype(desc_a) dectype=psb_cd_get_dectype(desc_a)
if (debug) write(0,*) 'dall: dectype',dectype if (debug) write(0,*) 'dall: dectype',dectype
if (debug) write(0,*) 'dall: is_ok? dectype',psb_is_ok_desc(desc_a) if (debug) write(0,*) 'dall: is_ok? dectype',psb_is_ok_desc(desc_a)
!... check m and n parameters.... !... check m and n parameters....
@ -237,7 +237,7 @@ subroutine psb_dallocv(x, desc_a,info,n)
!....allocate x ..... !....allocate x .....
if (psb_is_asb_desc(desc_a).or.psb_is_upd_desc(desc_a)) then 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)) n_col = max(1,psb_cd_get_local_cols(desc_a))
call psb_realloc(n_col,x,info) call psb_realloc(n_col,x,info)
if (info /= 0) then if (info /= 0) then
info=4010 info=4010
@ -250,7 +250,7 @@ subroutine psb_dallocv(x, desc_a,info,n)
end do end do
else if (psb_is_bld_desc(desc_a)) then else if (psb_is_bld_desc(desc_a)) then
n_row = max(1,psb_get_local_rows(desc_a)) n_row = max(1,psb_cd_get_local_rows(desc_a))
call psb_realloc(n_row,x,info) call psb_realloc(n_row,x,info)
if (info /= 0) then if (info /= 0) then
info=4010 info=4010

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

@ -69,14 +69,14 @@ subroutine psb_dasb(x, desc_a, info)
goto 9999 goto 9999
endif endif
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
dectype=psb_get_dectype(desc_a) dectype=psb_cd_get_dectype(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (debug) write(*,*) 'asb start: ',np,me,& if (debug) write(*,*) 'asb start: ',np,me,&
&psb_get_dectype(desc_a) &psb_cd_get_dectype(desc_a)
! ....verify blacs grid correctness.. ! ....verify blacs grid correctness..
if (np == -1) then if (np == -1) then
info = 2010 info = 2010
@ -91,9 +91,9 @@ subroutine psb_dasb(x, desc_a, info)
endif endif
! check size ! check size
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
nrow=psb_get_local_rows(desc_a) nrow=psb_cd_get_local_rows(desc_a)
ncol=psb_get_local_cols(desc_a) ncol=psb_cd_get_local_cols(desc_a)
i1sz = size(x,dim=1) i1sz = size(x,dim=1)
i2sz = size(x,dim=2) i2sz = size(x,dim=2)
if (debug) write(*,*) 'asb: ',i1sz,i2sz,nrow,ncol if (debug) write(*,*) 'asb: ',i1sz,i2sz,nrow,ncol
@ -193,8 +193,8 @@ subroutine psb_dasbv(x, desc_a, info)
int_err(1) = 0 int_err(1) = 0
name = 'psb_dasbv' name = 'psb_dasbv'
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
dectype=psb_get_dectype(desc_a) dectype=psb_cd_get_dectype(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
@ -209,8 +209,8 @@ subroutine psb_dasbv(x, desc_a, info)
goto 9999 goto 9999
endif endif
nrow=psb_get_local_rows(desc_a) nrow=psb_cd_get_local_rows(desc_a)
ncol=psb_get_local_cols(desc_a) ncol=psb_cd_get_local_cols(desc_a)
if (debug) write(*,*) name,' sizes: ',nrow,ncol if (debug) write(*,*) name,' sizes: ',nrow,ncol
i1sz = size(x) i1sz = size(x)
if (debug) write(*,*) 'dasb: sizes ',i1sz,ncol if (debug) write(*,*) 'dasb: sizes ',i1sz,ncol

14
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 info = 0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
Call psb_info(ictxt, me, np) Call psb_info(ictxt, me, np)
If(debug) Write(0,*)'in psb_cdovr',novr If(debug) Write(0,*)'in psb_cdovr',novr
m=psb_get_local_rows(desc_a) m=psb_cd_get_local_rows(desc_a)
nnzero=Size(a%aspk) nnzero=Size(a%aspk)
n_col=psb_get_local_cols(desc_a) n_col=psb_cd_get_local_cols(desc_a)
nhalo = n_col-m nhalo = n_col-m
If(debug) Write(0,*)'IN CDOVR1',novr ,m,nnzero,n_col If(debug) Write(0,*)'IN CDOVR1',novr ,m,nnzero,n_col
if (novr<0) then if (novr<0) then
@ -150,13 +150,7 @@ Subroutine psb_dcdovr(a,desc_a,novr,desc_ov,info)
! LOVR= (NNZ/NROW)*N_HALO*N_OVR This assumes that the local average ! LOVR= (NNZ/NROW)*N_HALO*N_OVR This assumes that the local average
! nonzeros per row is the same as the global. ! nonzeros per row is the same as the global.
! !
call psb_spinfo(psb_nztotreq_,a,nztot,info) nztot = psb_sp_get_nnzeros(a)
if (info /= 0) then
info=4010
ch_err='psb_spinfo'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if (nztot>0) then if (nztot>0) then
lovr = ((nztot+m-1)/m)*nhalo*novr lovr = ((nztot+m-1)/m)*nhalo*novr
lworks = ((nztot+m-1)/m)*nhalo lworks = ((nztot+m-1)/m)*nhalo

26
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) call psb_erractionsave(err_act)
If(debug) Write(0,*)'cdovrbld begin' If(debug) Write(0,*)'cdovrbld begin'
ictxt = psb_get_context(desc_a) ictxt = psb_cd_get_context(desc_a)
Call psb_info(ictxt,me,np) Call psb_info(ictxt,me,np)
@ -108,10 +108,10 @@ Subroutine psb_dcdovrbld(n_ovr,desc_p,desc_a,a,&
t4 = 0.0 t4 = 0.0
call psb_get_mpicomm(ictxt,icomm ) call psb_get_mpicomm(ictxt,icomm )
mglob = psb_get_global_rows(desc_a) mglob = psb_cd_get_global_rows(desc_a)
m = psb_get_local_rows(desc_a) m = psb_cd_get_local_rows(desc_a)
n_row = psb_get_local_rows(desc_a) n_row = psb_cd_get_local_rows(desc_a)
n_col = psb_get_local_cols(desc_a) n_col = psb_cd_get_local_cols(desc_a)
if (debug) write(0,*) me,' On entry to CDOVRBLD n_col:',n_col if (debug) write(0,*) me,' On entry to CDOVRBLD n_col:',n_col
dl_lda=np*5 dl_lda=np*5
@ -306,13 +306,7 @@ Subroutine psb_dcdovrbld(n_ovr,desc_p,desc_a,a,&
! Prepare to exchange the halo rows with the other proc. ! Prepare to exchange the halo rows with the other proc.
! !
If (i_ovr < (n_ovr)) Then If (i_ovr < (n_ovr)) Then
call psb_spinfo(psb_nzrowreq_,a,n_elem,info,iaux=idx) n_elem = psb_sp_get_nnz_row(idx,a)
if (info /= 0) then
info=4010
ch_err='psb_spinfo'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
If((idxs+tot_elem+n_elem) > lworks) Then If((idxs+tot_elem+n_elem) > lworks) Then
isz = max((3*lworks)/2,(idxs+tot_elem+n_elem)) isz = max((3*lworks)/2,(idxs+tot_elem+n_elem))
@ -339,10 +333,10 @@ Subroutine psb_dcdovrbld(n_ovr,desc_p,desc_a,a,&
end if end if
End If End If
call psb_spgtblk(idx,a,blk,info) call psb_sp_getblk(idx,a,blk,info)
if (info /= 0) then if (info /= 0) then
info=4010 info=4010
ch_err='psb_spgtblk' ch_err='psb_sp_getblk'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
@ -537,8 +531,8 @@ Subroutine psb_dcdovrbld(n_ovr,desc_p,desc_a,a,&
End Do End Do
t1 = mpi_wtime() t1 = mpi_wtime()
desc_p%matrix_data(psb_m_)=psb_get_global_rows(desc_a) desc_p%matrix_data(psb_m_)=psb_cd_get_global_rows(desc_a)
desc_p%matrix_data(psb_n_)=psb_get_global_cols(desc_a) desc_p%matrix_data(psb_n_)=psb_cd_get_global_cols(desc_a)
tmp_halo(counter_h)=-1 tmp_halo(counter_h)=-1
tmp_ovr_idx(counter_o)=-1 tmp_ovr_idx(counter_o)=-1

8
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() time(1) = mpi_wtime()
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
dectype=psb_get_dectype(desc_a) dectype=psb_cd_get_dectype(desc_a)
n_row = psb_get_local_rows(desc_a) n_row = psb_cd_get_local_rows(desc_a)
n_col = psb_get_local_cols(desc_a) n_col = psb_cd_get_local_cols(desc_a)
if(psb_get_errstatus() /= 0) return if(psb_get_errstatus() /= 0) return
info=0 info=0

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

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

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

@ -85,17 +85,17 @@ subroutine psb_dgelp(trans,iperm,x,desc_a,info)
info=0 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
dectype=psb_get_dectype(desc_a) dectype=psb_cd_get_dectype(desc_a)
nrow = psb_get_local_rows(desc_a) nrow = psb_cd_get_local_rows(desc_a)
ncol = psb_get_local_cols(desc_a) ncol = psb_cd_get_local_cols(desc_a)
i1sz = size(x,dim=1) i1sz = size(x,dim=1)
i2sz = size(x,dim=2) i2sz = size(x,dim=2)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (debug) write(*,*) 'asb start: ',np,me,& if (debug) write(*,*) 'asb start: ',np,me,&
&psb_get_dectype(desc_a) &psb_cd_get_dectype(desc_a)
! ....verify blacs grid correctness.. ! ....verify blacs grid correctness..
if (np == -1) then if (np == -1) then
info = 2010 info = 2010
@ -231,10 +231,10 @@ subroutine psb_dgelpv(trans,iperm,x,desc_a,info)
i1sz = size(x) i1sz = size(x)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
dectype=psb_get_dectype(desc_a) dectype=psb_cd_get_dectype(desc_a)
nrow=psb_get_local_rows(desc_a) nrow=psb_cd_get_local_rows(desc_a)
ncol=psb_get_local_cols(desc_a) ncol=psb_cd_get_local_cols(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)

24
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 return
end if end if
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (np == -1) then if (np == -1) then
@ -100,10 +100,10 @@ subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl)
goto 9999 goto 9999
else if (.not.psb_is_ok_desc(desc_a)) then else if (.not.psb_is_ok_desc(desc_a)) then
info = 3110 info = 3110
int_err(1) = psb_get_dectype(desc_a) int_err(1) = psb_cd_get_dectype(desc_a)
call psb_errpush(info,name,int_err) call psb_errpush(info,name,int_err)
goto 9999 goto 9999
else if (size(x, dim=1) < psb_get_local_rows(desc_a)) then else if (size(x, dim=1) < psb_cd_get_local_rows(desc_a)) then
info = 310 info = 310
int_err(1) = 5 int_err(1) = 5
int_err(2) = 4 int_err(2) = 4
@ -111,9 +111,9 @@ subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl)
goto 9999 goto 9999
endif endif
loc_rows=psb_get_local_rows(desc_a) loc_rows=psb_cd_get_local_rows(desc_a)
loc_cols=psb_get_local_cols(desc_a) loc_cols=psb_cd_get_local_cols(desc_a)
mglob = psb_get_global_rows(desc_a) mglob = psb_cd_get_global_rows(desc_a)
if (present(dupl)) then if (present(dupl)) then
dupl_ = dupl dupl_ = dupl
@ -265,7 +265,7 @@ subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl)
return return
end if end if
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (np == -1) then if (np == -1) then
@ -283,10 +283,10 @@ subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl)
goto 9999 goto 9999
else if (.not.psb_is_ok_desc(desc_a)) then else if (.not.psb_is_ok_desc(desc_a)) then
info = 3110 info = 3110
int_err(1) = psb_get_dectype(desc_a) int_err(1) = psb_cd_get_dectype(desc_a)
call psb_errpush(info,name,int_err) call psb_errpush(info,name,int_err)
goto 9999 goto 9999
else if (size(x, dim=1) < psb_get_local_rows(desc_a)) then else if (size(x, dim=1) < psb_cd_get_local_rows(desc_a)) then
info = 310 info = 310
int_err(1) = 5 int_err(1) = 5
int_err(2) = 4 int_err(2) = 4
@ -294,9 +294,9 @@ subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl)
goto 9999 goto 9999
endif endif
loc_rows=psb_get_local_rows(desc_a) loc_rows=psb_cd_get_local_rows(desc_a)
loc_cols=psb_get_local_cols(desc_a) loc_cols=psb_cd_get_local_cols(desc_a)
mglob = psb_get_global_rows(desc_a) mglob = psb_cd_get_global_rows(desc_a)
n = min(size(val,2),size(x,2)) 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) call psb_erractionsave(err_act)
name = 'psb_dspalloc' name = 'psb_dspalloc'
ictxt = psb_get_context(desc_a) ictxt = psb_cd_get_context(desc_a)
dectype = psb_get_dectype(desc_a) dectype = psb_cd_get_dectype(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
! ....verify blacs grid correctness.. ! ....verify blacs grid correctness..
if (np == -1) then 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 ! check if psdalloc is already called for this matrix
! set fields in desc_a%matrix_data.... ! set fields in desc_a%matrix_data....
loc_row = psb_get_local_rows(desc_a) loc_row = psb_cd_get_local_rows(desc_a)
m = psb_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
n = psb_get_global_cols(desc_a) n = psb_cd_get_global_cols(desc_a)
!...allocate matrix data... !...allocate matrix data...
if (present(nnz))then if (present(nnz))then
@ -127,7 +127,7 @@ subroutine psb_dspalloc(a, desc_a, info, nnz)
a%infoa(psb_state_) = psb_spmat_bld_ a%infoa(psb_state_) = psb_spmat_bld_
if (debug) write(0,*) 'spall: ', & if (debug) write(0,*) 'spall: ', &
&psb_get_dectype(desc_a),psb_desc_bld_ &psb_cd_get_dectype(desc_a),psb_desc_bld_
return 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' name = 'psb_spasb'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = psb_get_context(desc_a) ictxt = psb_cd_get_context(desc_a)
dscstate = psb_get_dectype(desc_a) dscstate = psb_cd_get_dectype(desc_a)
n_row = psb_get_local_rows(desc_a) n_row = psb_cd_get_local_rows(desc_a)
n_col = psb_get_local_cols(desc_a) n_col = psb_cd_get_local_cols(desc_a)
! check on BLACS grid ! check on BLACS grid
call psb_info(ictxt, me, np) 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. ! First case: we come from a fresh build.
! !
n_row = psb_get_local_rows(desc_a) n_row = psb_cd_get_local_rows(desc_a)
n_col = psb_get_local_cols(desc_a) n_col = psb_cd_get_local_cols(desc_a)
! !
! Second step: handle the local matrix part. ! 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() time(1) = mpi_wtime()
ictxt = psb_get_context(desc_a) ictxt = psb_cd_get_context(desc_a)
dectype = psb_get_dectype(desc_a) dectype = psb_cd_get_dectype(desc_a)
n_row = psb_get_local_rows(desc_a) n_row = psb_cd_get_local_rows(desc_a)
n_col = psb_get_local_cols(desc_a) n_col = psb_cd_get_local_cols(desc_a)
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) 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) call psb_errpush(info,name)
return return
else else
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
end if end if
!...deallocate a.... !...deallocate a....

25
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' outfmt_ = 'CSR'
endif endif
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
Call psb_info(ictxt, me, np) Call psb_info(ictxt, me, np)
t1 = mpi_wtime() t1 = mpi_wtime()
@ -139,14 +139,7 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rwcnv,clcnv,outfmt)
tot_elem = 0 tot_elem = 0
Do j=0,n_el_send-1 Do j=0,n_el_send-1
idx = desc_a%halo_index(counter+psb_elem_send_+j) idx = desc_a%halo_index(counter+psb_elem_send_+j)
call psb_spinfo(psb_nzrowreq_,a,n_elem,info,iaux=idx) n_elem = psb_sp_get_nnz_row(idx,a)
if (info /= 0) then
info=4010
ch_err='psb_spinfo'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
tot_elem = tot_elem+n_elem tot_elem = tot_elem+n_elem
Enddo Enddo
sdsz(proc+1) = tot_elem sdsz(proc+1) = tot_elem
@ -215,18 +208,12 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rwcnv,clcnv,outfmt)
Do j=0,n_el_send-1 Do j=0,n_el_send-1
idx = desc_a%halo_index(counter+psb_elem_send_+j) idx = desc_a%halo_index(counter+psb_elem_send_+j)
call psb_spinfo(psb_nzrowreq_,a,n_elem,info,iaux=idx) n_elem = psb_sp_get_nnz_row(idx,a)
if (info /= 0) then
info=4010 call psb_sp_getblk(idx,a,tmp,info,append=.true.)
ch_err='spinfo'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
!!$ write(0,*) me,'Getting row ',idx,n_elem
call psb_spgtblk(idx,a,tmp,info,append=.true.)
if (info /= 0) then if (info /= 0) then
info=4010 info=4010
ch_err='psb_spgtblk' ch_err='psb_sp_getblk'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if

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

@ -86,9 +86,9 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = psb_get_context(desc_a) ictxt = psb_cd_get_context(desc_a)
dectype = psb_get_dectype(desc_a) dectype = psb_cd_get_dectype(desc_a)
mglob = psb_get_global_rows(desc_a) mglob = psb_cd_get_global_rows(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
@ -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) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
nrow = psb_get_local_rows(desc_a) nrow = psb_cd_get_local_rows(desc_a)
ncol = psb_get_local_cols(desc_a) ncol = psb_cd_get_local_cols(desc_a)
if (spstate == psb_spmat_bld_) then 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) call psb_coins(nz,ia,ja,val,a,1,nrow,1,ncol,info,gtl=desc_a%glob_to_loc)
@ -152,8 +152,8 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild)
goto 9999 goto 9999
end if end if
else if (psb_is_asb_desc(desc_a)) then else if (psb_is_asb_desc(desc_a)) then
nrow = psb_get_local_rows(desc_a) nrow = psb_cd_get_local_rows(desc_a)
ncol = psb_get_local_cols(desc_a) ncol = psb_cd_get_local_cols(desc_a)
call psb_coins(nz,ia,ja,val,a,1,nrow,1,ncol,& call psb_coins(nz,ia,ja,val,a,1,nrow,1,ncol,&
& info,gtl=desc_a%glob_to_loc,rebuild=rebuild_) & info,gtl=desc_a%glob_to_loc,rebuild=rebuild_)
if (info /= 0) then if (info /= 0) then

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

@ -69,7 +69,7 @@ Subroutine psb_dsprn(a, desc_a,info,clear)
name = 'psb_dsprn' name = 'psb_dsprn'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = psb_get_context(desc_a) ictxt = psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (debug) & if (debug) &
&write(*,*) 'starting spalloc ',ictxt,np,me &write(*,*) 'starting spalloc ',ictxt,np,me

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) n=size(x)
do i=1,n do i=1,n
if ((x(i).gt.psb_get_global_rows(desc_a)).or.& if ((x(i).gt.psb_cd_get_global_rows(desc_a)).or.&
& (x(i).le.zero)) then & (x(i).le.zero)) then
if (act == 'I') then if (act == 'I') then
y(i)=-3*psb_get_global_rows(desc_a) y(i)=-3*psb_cd_get_global_rows(desc_a)
else else
info=140 info=140
int_err(1)=x(i) int_err(1)=x(i)
int_err(2)=psb_get_global_rows(desc_a) int_err(2)=psb_cd_get_global_rows(desc_a)
exit exit
end if end if
else else
tmp=desc_a%glob_to_loc(x(i)) tmp=desc_a%glob_to_loc(x(i))
if((tmp.gt.zero).or.(tmp.le.psb_get_local_cols(desc_a))) then if((tmp.gt.zero).or.(tmp.le.psb_cd_get_local_cols(desc_a))) then
y(i)=tmp y(i)=tmp
else if (tmp.le.zero) then else if (tmp.le.zero) then
info = 150 info = 150
int_err(1)=tmp int_err(1)=tmp
exit exit
else if (tmp.gt.psb_get_local_cols(desc_a)) then else if (tmp.gt.psb_cd_get_local_cols(desc_a)) then
info = 140 info = 140
int_err(1)=tmp int_err(1)=tmp
int_err(2)=psb_get_local_cols(desc_a) int_err(2)=psb_cd_get_local_cols(desc_a)
exit exit
end if end if
end if end if
@ -213,28 +213,28 @@ subroutine psb_glob_to_loc(x,desc_a,info,iact)
real_val = 0.d0 real_val = 0.d0
n=size(x) n=size(x)
do i=1,n do i=1,n
if ((x(i).gt.psb_get_global_rows(desc_a)).or.& if ((x(i).gt.psb_cd_get_global_rows(desc_a)).or.&
& (x(i).le.zero)) then & (x(i).le.zero)) then
if(act == 'I') then if(act == 'I') then
x(i)=-3*psb_get_global_rows(desc_a) x(i)=-3*psb_cd_get_global_rows(desc_a)
else else
info=140 info=140
int_err(1)=x(i) int_err(1)=x(i)
int_err(2)=psb_get_global_rows(desc_a) int_err(2)=psb_cd_get_global_rows(desc_a)
exit exit
end if end if
else else
tmp=desc_a%glob_to_loc(x(i)) tmp=desc_a%glob_to_loc(x(i))
if((tmp.gt.zero).or.(tmp.le.psb_get_local_cols(desc_a))) then if((tmp.gt.zero).or.(tmp.le.psb_cd_get_local_cols(desc_a))) then
x(i)=tmp x(i)=tmp
else if (tmp.le.zero) then else if (tmp.le.zero) then
info = 150 info = 150
int_err(1)=tmp int_err(1)=tmp
exit exit
else if (tmp.ge.psb_get_local_cols(desc_a)) then else if (tmp.ge.psb_cd_get_local_cols(desc_a)) then
info = 140 info = 140
int_err(1)=tmp int_err(1)=tmp
int_err(2)=psb_get_local_cols(desc_a) int_err(2)=psb_cd_get_local_cols(desc_a)
exit exit
end if end if
end if end if

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

@ -65,7 +65,7 @@ subroutine psb_ialloc(x, desc_a, info, n)
name='psb_ialloc' name='psb_ialloc'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (np == -1) then if (np == -1) then
@ -74,7 +74,7 @@ subroutine psb_ialloc(x, desc_a, info, n)
goto 9999 goto 9999
endif endif
dectype=psb_get_dectype(desc_a) dectype=psb_cd_get_dectype(desc_a)
!... check m and n parameters.... !... check m and n parameters....
if (.not.psb_is_ok_desc(desc_a)) then if (.not.psb_is_ok_desc(desc_a)) then
info = 3110 info = 3110
@ -103,7 +103,7 @@ subroutine psb_ialloc(x, desc_a, info, n)
!....allocate x ..... !....allocate x .....
if (psb_is_asb_desc(desc_a).or.psb_is_upd_desc(desc_a)) then 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)) n_col = max(1,psb_cd_get_local_cols(desc_a))
allocate(x(n_col,n_),stat=info) allocate(x(n_col,n_),stat=info)
if (info /= 0) then if (info /= 0) then
info=4010 info=4010
@ -117,7 +117,7 @@ subroutine psb_ialloc(x, desc_a, info, n)
end do end do
end do end do
else if (psb_is_bld_desc(desc_a)) then else if (psb_is_bld_desc(desc_a)) then
n_row = max(1,psb_get_local_rows(desc_a)) n_row = max(1,psb_cd_get_local_rows(desc_a))
allocate(x(n_row,n_),stat=info) allocate(x(n_row,n_),stat=info)
if (info /= 0) then if (info /= 0) then
info=4010 info=4010
@ -213,7 +213,7 @@ subroutine psb_iallocv(x, desc_a, info,n)
name='psb_iallocv' name='psb_iallocv'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
! ....verify blacs grid correctness.. ! ....verify blacs grid correctness..
@ -223,7 +223,7 @@ subroutine psb_iallocv(x, desc_a, info,n)
goto 9999 goto 9999
endif endif
dectype=psb_get_dectype(desc_a) dectype=psb_cd_get_dectype(desc_a)
if (debug) write(0,*) 'dall: dectype',dectype if (debug) write(0,*) 'dall: dectype',dectype
if (debug) write(0,*) 'dall: is_ok? dectype',psb_is_ok_desc(desc_a) if (debug) write(0,*) 'dall: is_ok? dectype',psb_is_ok_desc(desc_a)
!... check m and n parameters.... !... check m and n parameters....
@ -237,7 +237,7 @@ subroutine psb_iallocv(x, desc_a, info,n)
!....allocate x ..... !....allocate x .....
if (psb_is_asb_desc(desc_a).or.psb_is_upd_desc(desc_a)) then 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)) n_col = max(1,psb_cd_get_local_cols(desc_a))
allocate(x(n_col),stat=info) allocate(x(n_col),stat=info)
if (info.ne.0) then if (info.ne.0) then
info=2025 info=2025
@ -246,7 +246,7 @@ subroutine psb_iallocv(x, desc_a, info,n)
goto 9999 goto 9999
endif endif
else if (psb_is_bld_desc(desc_a)) then else if (psb_is_bld_desc(desc_a)) then
n_row = max(1,psb_get_local_rows(desc_a)) n_row = max(1,psb_cd_get_local_rows(desc_a))
allocate(x(n_row),stat=info) allocate(x(n_row),stat=info)
if (info.ne.0) then if (info.ne.0) then
info=2025 info=2025

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

@ -68,14 +68,14 @@ subroutine psb_iasb(x, desc_a, info)
return return
endif endif
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
dectype=psb_get_dectype(desc_a) dectype=psb_cd_get_dectype(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (debug) write(*,*) 'asb start: ',np,me,& if (debug) write(*,*) 'asb start: ',np,me,&
&psb_get_dectype(desc_a) &psb_cd_get_dectype(desc_a)
! ....verify blacs grid correctness.. ! ....verify blacs grid correctness..
if (np == -1) then if (np == -1) then
info = 2010 info = 2010
@ -90,9 +90,9 @@ subroutine psb_iasb(x, desc_a, info)
endif endif
! check size ! check size
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
nrow=psb_get_local_rows(desc_a) nrow=psb_cd_get_local_rows(desc_a)
ncol=psb_get_local_cols(desc_a) ncol=psb_cd_get_local_cols(desc_a)
i1sz = size(x,dim=1) i1sz = size(x,dim=1)
i2sz = size(x,dim=2) i2sz = size(x,dim=2)
if (debug) write(*,*) 'asb: ',i1sz,i2sz,nrow,ncol if (debug) write(*,*) 'asb: ',i1sz,i2sz,nrow,ncol
@ -187,8 +187,8 @@ subroutine psb_iasbv(x, desc_a, info)
name = 'psb_iasbv' name = 'psb_iasbv'
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
dectype=psb_get_dectype(desc_a) dectype=psb_cd_get_dectype(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
@ -203,8 +203,8 @@ subroutine psb_iasbv(x, desc_a, info)
goto 9999 goto 9999
endif endif
nrow=psb_get_local_rows(desc_a) nrow=psb_cd_get_local_rows(desc_a)
ncol=psb_get_local_cols(desc_a) ncol=psb_cd_get_local_cols(desc_a)
if (debug) write(*,*) name,' sizes: ',nrow,ncol if (debug) write(*,*) name,' sizes: ',nrow,ncol
i1sz = size(x) i1sz = size(x)
if (debug) write(*,*) 'dasb: sizes ',i1sz,ncol 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 return
end if end if
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
! ....verify blacs grid correctness.. ! ....verify blacs grid correctness..
@ -170,7 +170,7 @@ subroutine psb_ifreev(x, desc_a,info)
call psb_errpush(info,name) call psb_errpush(info,name)
return return
end if end if
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
! ....verify blacs grid correctness.. ! ....verify blacs grid correctness..

24
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 return
end if end if
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (np == -1) then if (np == -1) then
@ -100,10 +100,10 @@ subroutine psb_iinsvi(m, irw, val, x, desc_a, info, dupl)
goto 9999 goto 9999
else if (.not.psb_is_ok_desc(desc_a)) then else if (.not.psb_is_ok_desc(desc_a)) then
info = 3110 info = 3110
int_err(1) = psb_get_dectype(desc_a) int_err(1) = psb_cd_get_dectype(desc_a)
call psb_errpush(info,name,int_err) call psb_errpush(info,name,int_err)
goto 9999 goto 9999
else if (size(x, dim=1) < psb_get_local_rows(desc_a)) then else if (size(x, dim=1) < psb_cd_get_local_rows(desc_a)) then
info = 310 info = 310
int_err(1) = 5 int_err(1) = 5
int_err(2) = 4 int_err(2) = 4
@ -111,9 +111,9 @@ subroutine psb_iinsvi(m, irw, val, x, desc_a, info, dupl)
goto 9999 goto 9999
endif endif
loc_rows=psb_get_local_rows(desc_a) loc_rows=psb_cd_get_local_rows(desc_a)
loc_cols=psb_get_local_cols(desc_a) loc_cols=psb_cd_get_local_cols(desc_a)
mglob = psb_get_global_rows(desc_a) mglob = psb_cd_get_global_rows(desc_a)
if (present(dupl)) then if (present(dupl)) then
dupl_ = dupl dupl_ = dupl
@ -263,7 +263,7 @@ subroutine psb_iinsi(m,irw, val, x, desc_a, info, dupl)
return return
end if end if
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (np == -1) then if (np == -1) then
@ -281,10 +281,10 @@ subroutine psb_iinsi(m,irw, val, x, desc_a, info, dupl)
goto 9999 goto 9999
else if (.not.psb_is_ok_desc(desc_a)) then else if (.not.psb_is_ok_desc(desc_a)) then
info = 3110 info = 3110
int_err(1) = psb_get_dectype(desc_a) int_err(1) = psb_cd_get_dectype(desc_a)
call psb_errpush(info,name,int_err) call psb_errpush(info,name,int_err)
goto 9999 goto 9999
else if (size(x, dim=1) < psb_get_local_rows(desc_a)) then else if (size(x, dim=1) < psb_cd_get_local_rows(desc_a)) then
info = 310 info = 310
int_err(1) = 5 int_err(1) = 5
int_err(2) = 4 int_err(2) = 4
@ -292,9 +292,9 @@ subroutine psb_iinsi(m,irw, val, x, desc_a, info, dupl)
goto 9999 goto 9999
endif endif
loc_rows=psb_get_local_rows(desc_a) loc_rows=psb_cd_get_local_rows(desc_a)
loc_cols=psb_get_local_cols(desc_a) loc_cols=psb_cd_get_local_cols(desc_a)
mglob = psb_get_global_rows(desc_a) mglob = psb_cd_get_global_rows(desc_a)
n = min(size(val,2),size(x,2)) 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) n=size(x)
do i=1,n do i=1,n
if ((x(i).gt.psb_get_local_cols(desc_a)).or.& if ((x(i).gt.psb_cd_get_local_cols(desc_a)).or.&
& (x(i).le.zero)) then & (x(i).le.zero)) then
info=140 info=140
int_err(1)=tmp int_err(1)=tmp
int_err(2)=psb_get_local_cols(desc_a) int_err(2)=psb_cd_get_local_cols(desc_a)
exit exit
else else
tmp=desc_a%loc_to_glob(x(i)) tmp=desc_a%loc_to_glob(x(i))
if((tmp.gt.zero).or.(tmp.le.psb_get_global_rows(desc_a))) then if((tmp.gt.zero).or.(tmp.le.psb_cd_get_global_rows(desc_a))) then
y(i)=tmp y(i)=tmp
else else
info = 140 info = 140
int_err(1)=tmp int_err(1)=tmp
int_err(2)=psb_get_local_cols(desc_a) int_err(2)=psb_cd_get_local_cols(desc_a)
exit exit
end if end if
end if end if
@ -204,15 +204,15 @@ subroutine psb_loc_to_glob(x,desc_a,info,iact)
n=size(x) n=size(x)
do i=1,n do i=1,n
if ((x(i).gt.psb_get_local_cols(desc_a)).or.& if ((x(i).gt.psb_cd_get_local_cols(desc_a)).or.&
& (x(i).le.zero)) then & (x(i).le.zero)) then
info=140 info=140
int_err(1)=x(i) int_err(1)=x(i)
int_err(2)=psb_get_local_cols(desc_a) int_err(2)=psb_cd_get_local_cols(desc_a)
exit exit
else else
tmp=desc_a%loc_to_glob(x(i)) tmp=desc_a%loc_to_glob(x(i))
if((tmp.gt.zero).or.(tmp.le.psb_get_global_rows(desc_a))) then if((tmp.gt.zero).or.(tmp.le.psb_cd_get_global_rows(desc_a))) then
x(i)=tmp x(i)=tmp
else else
info = 140 info = 140

16
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 int_err(1)=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (np == -1) then if (np == -1) then
@ -76,7 +76,7 @@ subroutine psb_zalloc(x, desc_a, info, n)
goto 9999 goto 9999
endif endif
dectype=psb_get_dectype(desc_a) dectype=psb_cd_get_dectype(desc_a)
!... check m and n parameters.... !... check m and n parameters....
if (.not.psb_is_ok_desc(desc_a)) then if (.not.psb_is_ok_desc(desc_a)) then
info = 3110 info = 3110
@ -105,7 +105,7 @@ subroutine psb_zalloc(x, desc_a, info, n)
!....allocate x ..... !....allocate x .....
if (psb_is_asb_desc(desc_a).or.psb_is_upd_desc(desc_a)) then 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)) n_col = max(1,psb_cd_get_local_cols(desc_a))
allocate(x(n_col,n_),stat=info) allocate(x(n_col,n_),stat=info)
if (info /= 0) then if (info /= 0) then
info=4010 info=4010
@ -119,7 +119,7 @@ subroutine psb_zalloc(x, desc_a, info, n)
end do end do
end do end do
else if (psb_is_bld_desc(desc_a)) then else if (psb_is_bld_desc(desc_a)) then
n_row = max(1,psb_get_local_rows(desc_a)) n_row = max(1,psb_cd_get_local_rows(desc_a))
allocate(x(n_row,n_),stat=info) allocate(x(n_row,n_),stat=info)
if (info /= 0) then if (info /= 0) then
info=4010 info=4010
@ -212,7 +212,7 @@ subroutine psb_zallocv(x, desc_a,info,n)
name='psb_zallcv' name='psb_zallcv'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
! ....verify blacs grid correctness.. ! ....verify blacs grid correctness..
@ -222,7 +222,7 @@ subroutine psb_zallocv(x, desc_a,info,n)
goto 9999 goto 9999
endif endif
dectype=psb_get_dectype(desc_a) dectype=psb_cd_get_dectype(desc_a)
if (debug) write(0,*) 'dall: dectype',dectype if (debug) write(0,*) 'dall: dectype',dectype
if (debug) write(0,*) 'dall: is_ok? dectype',psb_is_ok_desc(desc_a) if (debug) write(0,*) 'dall: is_ok? dectype',psb_is_ok_desc(desc_a)
!... check m and n parameters.... !... check m and n parameters....
@ -236,7 +236,7 @@ subroutine psb_zallocv(x, desc_a,info,n)
!....allocate x ..... !....allocate x .....
if (psb_is_asb_desc(desc_a).or.psb_is_upd_desc(desc_a)) then 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)) n_col = max(1,psb_cd_get_local_cols(desc_a))
call psb_realloc(n_col,x,info) call psb_realloc(n_col,x,info)
if (info /= 0) then if (info /= 0) then
info=4010 info=4010
@ -249,7 +249,7 @@ subroutine psb_zallocv(x, desc_a,info,n)
end do end do
else if (psb_is_bld_desc(desc_a)) then else if (psb_is_bld_desc(desc_a)) then
n_row = max(1,psb_get_local_rows(desc_a)) n_row = max(1,psb_cd_get_local_rows(desc_a))
call psb_realloc(n_row,x,info) call psb_realloc(n_row,x,info)
if (info /= 0) then if (info /= 0) then
info=4010 info=4010

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

@ -68,14 +68,14 @@ subroutine psb_zasb(x, desc_a, info)
goto 9999 goto 9999
endif endif
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
dectype=psb_get_dectype(desc_a) dectype=psb_cd_get_dectype(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (debug) write(*,*) 'asb start: ',np,me,& if (debug) write(*,*) 'asb start: ',np,me,&
&psb_get_dectype(desc_a) &psb_cd_get_dectype(desc_a)
! ....verify blacs grid correctness.. ! ....verify blacs grid correctness..
if (np == -1) then if (np == -1) then
info = 2010 info = 2010
@ -90,9 +90,9 @@ subroutine psb_zasb(x, desc_a, info)
endif endif
! check size ! check size
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
nrow=psb_get_local_rows(desc_a) nrow=psb_cd_get_local_rows(desc_a)
ncol=psb_get_local_cols(desc_a) ncol=psb_cd_get_local_cols(desc_a)
i1sz = size(x,dim=1) i1sz = size(x,dim=1)
i2sz = size(x,dim=2) i2sz = size(x,dim=2)
if (debug) write(*,*) 'asb: ',i1sz,i2sz,nrow,ncol if (debug) write(*,*) 'asb: ',i1sz,i2sz,nrow,ncol
@ -191,8 +191,8 @@ subroutine psb_zasbv(x, desc_a, info)
int_err(1) = 0 int_err(1) = 0
name = 'psb_zasbv' name = 'psb_zasbv'
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
dectype=psb_get_dectype(desc_a) dectype=psb_cd_get_dectype(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
@ -207,8 +207,8 @@ subroutine psb_zasbv(x, desc_a, info)
goto 9999 goto 9999
endif endif
nrow=psb_get_local_rows(desc_a) nrow=psb_cd_get_local_rows(desc_a)
ncol=psb_get_local_cols(desc_a) ncol=psb_cd_get_local_cols(desc_a)
if (debug) write(*,*) name,' sizes: ',nrow,ncol if (debug) write(*,*) name,' sizes: ',nrow,ncol
i1sz = size(x) i1sz = size(x)
if (debug) write(*,*) 'dasb: sizes ',i1sz,ncol if (debug) write(*,*) 'dasb: sizes ',i1sz,ncol

14
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 info = 0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
Call psb_info(ictxt, me, np) Call psb_info(ictxt, me, np)
If(debug) Write(0,*)'in psb_cdovr',novr If(debug) Write(0,*)'in psb_cdovr',novr
m=psb_get_local_rows(desc_a) m=psb_cd_get_local_rows(desc_a)
nnzero=Size(a%aspk) nnzero=Size(a%aspk)
n_col=psb_get_local_cols(desc_a) n_col=psb_cd_get_local_cols(desc_a)
nhalo = n_col-m nhalo = n_col-m
If(debug) Write(0,*)'IN CDOVR1',novr ,m,nnzero,n_col If(debug) Write(0,*)'IN CDOVR1',novr ,m,nnzero,n_col
if (novr<0) then if (novr<0) then
@ -150,13 +150,7 @@ Subroutine psb_zcdovr(a,desc_a,novr,desc_ov,info)
! LOVR= (NNZ/NROW)*N_HALO*N_OVR This assumes that the local average ! LOVR= (NNZ/NROW)*N_HALO*N_OVR This assumes that the local average
! nonzeros per row is the same as the global. ! nonzeros per row is the same as the global.
! !
call psb_spinfo(psb_nztotreq_,a,nztot,info) nztot = psb_sp_get_nnzeros(a)
if (info /= 0) then
info=4010
ch_err='psb_spinfo'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if (nztot>0) then if (nztot>0) then
lovr = ((nztot+m-1)/m)*nhalo*novr lovr = ((nztot+m-1)/m)*nhalo*novr
lworks = ((nztot+m-1)/m)*nhalo lworks = ((nztot+m-1)/m)*nhalo

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

Write Preview
Loading…
Cancel
Save