diff --git a/src/comm/psb_dgather.f90 b/src/comm/psb_dgather.f90 index 47d1d89c..20828a4d 100644 --- a/src/comm/psb_dgather.f90 +++ b/src/comm/psb_dgather.f90 @@ -77,7 +77,7 @@ subroutine psb_dgatherm(globx, locx, desc_a, info, iroot,& info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) ! check on blacs grid call psb_info(ictxt, me, np) @@ -131,8 +131,8 @@ subroutine psb_dgatherm(globx, locx, desc_a, info, iroot,& lda_globx = size(globx,1) lda_locx = size(locx, 1) - m = psb_get_global_rows(desc_a) - n = psb_get_global_cols(desc_a) + m = psb_cd_get_global_rows(desc_a) + n = psb_cd_get_global_cols(desc_a) lock=size(locx,2)-jlocx+1 globk=size(globx,2)-jglobx+1 @@ -170,7 +170,7 @@ subroutine psb_dgatherm(globx, locx, desc_a, info, iroot,& globx(:,:)=0.d0 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) globx(idx,jglobx+j-1) = locx(i,jlx+j-1) end do @@ -280,7 +280,7 @@ subroutine psb_dgatherv(globx, locx, desc_a, info, iroot,& info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) ! check on blacs grid call psb_info(ictxt, me, np) @@ -319,8 +319,8 @@ subroutine psb_dgatherv(globx, locx, desc_a, info, iroot,& lda_globx = size(globx) lda_locx = size(locx) - m = psb_get_global_rows(desc_a) - n = psb_get_global_cols(desc_a) + m = psb_cd_get_global_rows(desc_a) + n = psb_cd_get_global_cols(desc_a) k = 1 @@ -344,7 +344,7 @@ subroutine psb_dgatherv(globx, locx, desc_a, info, iroot,& 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) globx(idx) = locx(i) end do diff --git a/src/comm/psb_dhalo.f90 b/src/comm/psb_dhalo.f90 index 1d0f19d2..e0b3a9d4 100644 --- a/src/comm/psb_dhalo.f90 +++ b/src/comm/psb_dhalo.f90 @@ -77,7 +77,7 @@ subroutine psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode) info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) ! check on blacs grid call psb_info(ictxt, me, np) @@ -94,9 +94,9 @@ subroutine psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode) ijx = 1 endif - m = psb_get_global_rows(desc_a) - n = psb_get_global_cols(desc_a) - nrow = psb_get_local_rows(desc_a) + m = psb_cd_get_global_rows(desc_a) + n = psb_cd_get_global_cols(desc_a) + nrow = psb_cd_get_local_rows(desc_a) maxk=size(x,2)-ijx+1 @@ -289,7 +289,7 @@ subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode) info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) ! check on blacs grid call psb_info(ictxt, me, np) @@ -302,9 +302,9 @@ subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode) ix = 1 ijx = 1 - m = psb_get_global_rows(desc_a) - n = psb_get_global_cols(desc_a) - nrow = psb_get_local_rows(desc_a) + m = psb_cd_get_global_rows(desc_a) + n = psb_cd_get_global_cols(desc_a) + nrow = psb_cd_get_local_rows(desc_a) if (present(tran)) then ltran = tran diff --git a/src/comm/psb_dovrl.f90 b/src/comm/psb_dovrl.f90 index 75529396..a225481f 100644 --- a/src/comm/psb_dovrl.f90 +++ b/src/comm/psb_dovrl.f90 @@ -73,7 +73,7 @@ subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,update) info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) ! check on blacs grid call psb_info(ictxt, me, np) @@ -90,10 +90,10 @@ subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,update) ijx = 1 endif - m = psb_get_global_rows(desc_a) - n = psb_get_global_cols(desc_a) - nrow = psb_get_local_rows(desc_a) - ncol = psb_get_local_cols(desc_a) + m = psb_cd_get_global_rows(desc_a) + n = psb_cd_get_global_cols(desc_a) + nrow = psb_cd_get_local_rows(desc_a) + ncol = psb_cd_get_local_cols(desc_a) maxk=size(x,2)-ijx+1 @@ -291,7 +291,7 @@ subroutine psb_dovrlv(x,desc_a,info,work,update) info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) ! check on blacs grid call psb_info(ictxt, me, np) @@ -304,10 +304,10 @@ subroutine psb_dovrlv(x,desc_a,info,work,update) ix = 1 ijx = 1 - m = psb_get_global_rows(desc_a) - n = psb_get_global_cols(desc_a) - nrow = psb_get_local_rows(desc_a) - ncol = psb_get_local_cols(desc_a) + m = psb_cd_get_global_rows(desc_a) + n = psb_cd_get_global_cols(desc_a) + nrow = psb_cd_get_local_rows(desc_a) + ncol = psb_cd_get_local_cols(desc_a) k = 1 diff --git a/src/comm/psb_dscatter.f90 b/src/comm/psb_dscatter.f90 index 8938f12a..b128634a 100644 --- a/src/comm/psb_dscatter.f90 +++ b/src/comm/psb_dscatter.f90 @@ -79,7 +79,7 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, iroot,& info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) ! check on blacs grid call psb_info(ictxt, me, np) @@ -131,8 +131,8 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, iroot,& lda_globx = size(globx,1) lda_locx = size(locx, 1) - m = psb_get_global_rows(desc_a) - n = psb_get_global_cols(desc_a) + m = psb_cd_get_global_rows(desc_a) + n = psb_cd_get_global_cols(desc_a) lock=size(locx,2)-jlocx+1 globk=size(globx,2)-jglobx+1 @@ -155,8 +155,8 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, iroot,& lda_globx = size(globx) lda_locx = size(locx) - m = psb_get_global_rows(desc_a) - n = psb_get_global_cols(desc_a) + m = psb_cd_get_global_rows(desc_a) + n = psb_cd_get_global_cols(desc_a) if (me == iiroot) then call igebs2d(ictxt, 'all', ' ', 1, 1, k, 1) @@ -181,7 +181,7 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, iroot,& goto 9999 end if - nrow=psb_get_local_rows(desc_a) + nrow=psb_cd_get_local_rows(desc_a) if(root == -1) then ! extract my chunk @@ -336,7 +336,7 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, iroot) info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) ! check on blacs grid call psb_info(ictxt, me, np) @@ -364,8 +364,8 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, iroot) lda_globx = size(globx) lda_locx = size(locx) - m = psb_get_global_rows(desc_a) - n = psb_get_global_cols(desc_a) + m = psb_cd_get_global_rows(desc_a) + n = psb_cd_get_global_cols(desc_a) k = 1 @@ -393,7 +393,7 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, iroot) goto 9999 end if - nrow=psb_get_local_rows(desc_a) + nrow=psb_cd_get_local_rows(desc_a) if(root == -1) then ! extract my chunk diff --git a/src/comm/psb_ihalo.f90 b/src/comm/psb_ihalo.f90 index 98cdb9d5..55d51a66 100644 --- a/src/comm/psb_ihalo.f90 +++ b/src/comm/psb_ihalo.f90 @@ -78,7 +78,7 @@ subroutine psb_ihalom(x,desc_a,info,alpha,jx,ik,work,tran,mode) info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) ! check on blacs grid call psb_info(ictxt, me, np) @@ -95,9 +95,9 @@ subroutine psb_ihalom(x,desc_a,info,alpha,jx,ik,work,tran,mode) ijx = 1 endif - m = psb_get_global_rows(desc_a) - n = psb_get_global_cols(desc_a) - nrow = psb_get_local_rows(desc_a) + m = psb_cd_get_global_rows(desc_a) + n = psb_cd_get_global_cols(desc_a) + nrow = psb_cd_get_local_rows(desc_a) maxk=size(x,2)-ijx+1 @@ -285,7 +285,7 @@ subroutine psb_ihalov(x,desc_a,info,alpha,work,tran,mode) info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) ! check on blacs grid call psb_info(ictxt, me, np) @@ -298,10 +298,10 @@ subroutine psb_ihalov(x,desc_a,info,alpha,work,tran,mode) ix = 1 ijx = 1 - m = psb_get_global_rows(desc_a) - n = psb_get_global_cols(desc_a) - nrow = psb_get_local_rows(desc_a) - ! ncol = psb_get_local_cols(desc_a) + m = psb_cd_get_global_rows(desc_a) + n = psb_cd_get_global_cols(desc_a) + nrow = psb_cd_get_local_rows(desc_a) + ! ncol = psb_cd_get_local_cols(desc_a) if (present(tran)) then diff --git a/src/comm/psb_zgather.f90 b/src/comm/psb_zgather.f90 index 2a001d76..7ac60061 100644 --- a/src/comm/psb_zgather.f90 +++ b/src/comm/psb_zgather.f90 @@ -78,7 +78,7 @@ subroutine psb_zgatherm(globx, locx, desc_a, info, iroot,& info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) ! check on blacs grid call psb_info(ictxt, me, np) @@ -132,8 +132,8 @@ subroutine psb_zgatherm(globx, locx, desc_a, info, iroot,& lda_globx = size(globx,1) lda_locx = size(locx, 1) - m = psb_get_global_rows(desc_a) - n = psb_get_global_cols(desc_a) + m = psb_cd_get_global_rows(desc_a) + n = psb_cd_get_global_cols(desc_a) lock=size(locx,2)-jlocx+1 globk=size(globx,2)-jglobx+1 @@ -172,7 +172,7 @@ subroutine psb_zgatherm(globx, locx, desc_a, info, iroot,& globx(:,:)=0.d0 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) globx(idx,jglobx+j-1) = locx(i,jlx+j-1) end do @@ -282,7 +282,7 @@ subroutine psb_zgatherv(globx, locx, desc_a, info, iroot,& info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) ! check on blacs grid call psb_info(ictxt, me, np) @@ -321,8 +321,8 @@ subroutine psb_zgatherv(globx, locx, desc_a, info, iroot,& lda_globx = size(globx) lda_locx = size(locx) - m = psb_get_global_rows(desc_a) - n = psb_get_global_cols(desc_a) + m = psb_cd_get_global_rows(desc_a) + n = psb_cd_get_global_cols(desc_a) k = 1 @@ -347,7 +347,7 @@ subroutine psb_zgatherv(globx, locx, desc_a, info, iroot,& 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) globx(idx) = locx(i) end do diff --git a/src/comm/psb_zhalo.f90 b/src/comm/psb_zhalo.f90 index 25748267..5d4ba301 100644 --- a/src/comm/psb_zhalo.f90 +++ b/src/comm/psb_zhalo.f90 @@ -77,7 +77,7 @@ subroutine psb_zhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode) info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) ! check on blacs grid call psb_info(ictxt, me, np) @@ -94,9 +94,9 @@ subroutine psb_zhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode) ijx = 1 endif - m = psb_get_global_rows(desc_a) - n = psb_get_global_cols(desc_a) - nrow = psb_get_local_rows(desc_a) + m = psb_cd_get_global_rows(desc_a) + n = psb_cd_get_global_cols(desc_a) + nrow = psb_cd_get_local_rows(desc_a) maxk=size(x,2)-ijx+1 @@ -283,7 +283,7 @@ subroutine psb_zhalov(x,desc_a,info,alpha,work,tran,mode) info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) ! check on blacs grid call psb_info(ictxt, me, np) @@ -296,9 +296,9 @@ subroutine psb_zhalov(x,desc_a,info,alpha,work,tran,mode) ix = 1 ijx = 1 - m = psb_get_global_rows(desc_a) - n = psb_get_global_cols(desc_a) - nrow = psb_get_local_rows(desc_a) + m = psb_cd_get_global_rows(desc_a) + n = psb_cd_get_global_cols(desc_a) + nrow = psb_cd_get_local_rows(desc_a) if (present(tran)) then ltran = tran diff --git a/src/comm/psb_zovrl.f90 b/src/comm/psb_zovrl.f90 index 6b441625..3249e1ff 100644 --- a/src/comm/psb_zovrl.f90 +++ b/src/comm/psb_zovrl.f90 @@ -73,7 +73,7 @@ subroutine psb_zovrlm(x,desc_a,info,jx,ik,work,update) info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) ! check on blacs grid call psb_info(ictxt, me, np) @@ -90,10 +90,10 @@ subroutine psb_zovrlm(x,desc_a,info,jx,ik,work,update) ijx = 1 endif - m = psb_get_global_rows(desc_a) - n = psb_get_global_cols(desc_a) - nrow = psb_get_local_rows(desc_a) - ncol = psb_get_local_cols(desc_a) + m = psb_cd_get_global_rows(desc_a) + n = psb_cd_get_global_cols(desc_a) + nrow = psb_cd_get_local_rows(desc_a) + ncol = psb_cd_get_local_cols(desc_a) maxk=size(x,2)-ijx+1 @@ -291,7 +291,7 @@ subroutine psb_zovrlv(x,desc_a,info,work,update) info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) ! check on blacs grid call psb_info(ictxt, me, np) @@ -304,10 +304,10 @@ subroutine psb_zovrlv(x,desc_a,info,work,update) ix = 1 ijx = 1 - m = psb_get_global_rows(desc_a) - n = psb_get_global_cols(desc_a) - nrow = psb_get_local_rows(desc_a) - ncol = psb_get_local_cols(desc_a) + m = psb_cd_get_global_rows(desc_a) + n = psb_cd_get_global_cols(desc_a) + nrow = psb_cd_get_local_rows(desc_a) + ncol = psb_cd_get_local_cols(desc_a) k = 1 diff --git a/src/comm/psb_zscatter.f90 b/src/comm/psb_zscatter.f90 index f656a81c..8adbe953 100644 --- a/src/comm/psb_zscatter.f90 +++ b/src/comm/psb_zscatter.f90 @@ -79,7 +79,7 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, iroot,& info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) ! check on blacs grid call psb_info(ictxt, me, np) @@ -131,8 +131,8 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, iroot,& lda_globx = size(globx,1) lda_locx = size(locx, 1) - m = psb_get_global_rows(desc_a) - n = psb_get_global_cols(desc_a) + m = psb_cd_get_global_rows(desc_a) + n = psb_cd_get_global_cols(desc_a) lock=size(locx,2)-jlocx+1 globk=size(globx,2)-jglobx+1 @@ -154,8 +154,8 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, iroot,& lda_globx = size(globx) lda_locx = size(locx) - m = psb_get_global_rows(desc_a) - n = psb_get_global_cols(desc_a) + m = psb_cd_get_global_rows(desc_a) + n = psb_cd_get_global_cols(desc_a) if (me == iiroot) then call igebs2d(ictxt, 'all', ' ', 1, 1, k, 1) @@ -181,7 +181,7 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, iroot,& goto 9999 end if - nrow=psb_get_local_rows(desc_a) + nrow=psb_cd_get_local_rows(desc_a) if(root == -1) then ! extract my chunk @@ -336,7 +336,7 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, iroot) info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) ! check on blacs grid call psb_info(ictxt, me, np) @@ -364,8 +364,8 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, iroot) lda_globx = size(globx) lda_locx = size(locx) - m = psb_get_global_rows(desc_a) - n = psb_get_global_cols(desc_a) + m = psb_cd_get_global_rows(desc_a) + n = psb_cd_get_global_cols(desc_a) k = 1 @@ -393,7 +393,7 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, iroot) goto 9999 end if - nrow=psb_get_local_rows(desc_a) + nrow=psb_cd_get_local_rows(desc_a) if(root == -1) then ! extract my chunk diff --git a/src/internals/psi_crea_index.f90 b/src/internals/psi_crea_index.f90 index 25a7e8d6..1c4eed83 100644 --- a/src/internals/psi_crea_index.f90 +++ b/src/internals/psi_crea_index.f90 @@ -80,7 +80,7 @@ subroutine psi_crea_index(desc_a,index_in,index_out,glob_idx,nxch,nsnd,nrcv,info name='psi_crea_index' call psb_erractionsave(err_act) - ictxt = psb_get_context(desc_a) + ictxt = psb_cd_get_context(desc_a) call psb_info(ictxt,me,np) if (np == -1) then info = 2010 diff --git a/src/internals/psi_dswapdata.f90 b/src/internals/psi_dswapdata.f90 index d183db33..bd9096eb 100644 --- a/src/internals/psi_dswapdata.f90 +++ b/src/internals/psi_dswapdata.f90 @@ -65,7 +65,7 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data) name='psi_swap_data' call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt,me,np) if (np == -1) then info = 2010 @@ -474,7 +474,7 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data) name='psi_swap_datav' call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt,me,np) if (np == -1) then info = 2010 diff --git a/src/internals/psi_dswaptran.f90 b/src/internals/psi_dswaptran.f90 index 8f7e5597..9519dda7 100644 --- a/src/internals/psi_dswaptran.f90 +++ b/src/internals/psi_dswaptran.f90 @@ -65,7 +65,7 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data) name='psi_swap_tran' call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt,me,np) if (np == -1) then info = 2010 @@ -466,7 +466,7 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data) name='psi_swap_tranv' call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt,me,np) if (np == -1) then info = 2010 diff --git a/src/internals/psi_iswapdata.f90 b/src/internals/psi_iswapdata.f90 index 94e7c145..6336c51c 100644 --- a/src/internals/psi_iswapdata.f90 +++ b/src/internals/psi_iswapdata.f90 @@ -65,7 +65,7 @@ subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data) name='psi_swap_data' call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt,me,np) if (np == -1) then info = 2010 @@ -474,7 +474,7 @@ subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data) name='psi_swap_datav' call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt,me,np) if (np == -1) then info = 2010 diff --git a/src/internals/psi_iswaptran.f90 b/src/internals/psi_iswaptran.f90 index 5e27d7e1..6dec2017 100644 --- a/src/internals/psi_iswaptran.f90 +++ b/src/internals/psi_iswaptran.f90 @@ -65,7 +65,7 @@ subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data) name='psi_swap_tran' call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt,me,np) if (np == -1) then info = 2010 @@ -466,7 +466,7 @@ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data) name='psi_swap_tranv' call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt,me,np) if (np == -1) then info = 2010 diff --git a/src/internals/psi_zswapdata.f90 b/src/internals/psi_zswapdata.f90 index fa93ecf2..ca2271e1 100644 --- a/src/internals/psi_zswapdata.f90 +++ b/src/internals/psi_zswapdata.f90 @@ -65,7 +65,7 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data) name='psi_swap_data' call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt,me,np) if (np == -1) then info = 2010 @@ -474,7 +474,7 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data) name='psi_swap_datav' call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt,me,np) if (np == -1) then info = 2010 diff --git a/src/internals/psi_zswaptran.f90 b/src/internals/psi_zswaptran.f90 index 4c71c536..2edf6629 100644 --- a/src/internals/psi_zswaptran.f90 +++ b/src/internals/psi_zswaptran.f90 @@ -65,7 +65,7 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data) name='psi_swap_tran' call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt,me,np) if (np == -1) then info = 2010 @@ -463,7 +463,7 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data) name='psi_swap_tranv' call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt,me,np) if (np == -1) then info = 2010 diff --git a/src/methd/psb_dbicg.f90 b/src/methd/psb_dbicg.f90 index ae7e6ec5..a56580fe 100644 --- a/src/methd/psb_dbicg.f90 +++ b/src/methd/psb_dbicg.f90 @@ -119,13 +119,13 @@ subroutine psb_dbicg(a,prec,b,x,eps,desc_a,info,& call psb_erractionsave(err_act) if (debug) write(*,*) 'entering psb_dbicg' - ictxt = psb_get_context(desc_a) + ictxt = psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (debug) write(*,*) 'psb_dbicg: from gridinfo',np,me - mglob = psb_get_global_rows(desc_a) - n_row = psb_get_local_rows(desc_a) - n_col = psb_get_local_cols(desc_a) + mglob = psb_cd_get_global_rows(desc_a) + n_row = psb_cd_get_local_rows(desc_a) + n_col = psb_cd_get_local_cols(desc_a) ! Ensure global coherence for convergence checks. call psb_set_coher(ictxt,isvch) diff --git a/src/methd/psb_dcg.f90 b/src/methd/psb_dcg.f90 index 651d7bae..f83ca4ea 100644 --- a/src/methd/psb_dcg.f90 +++ b/src/methd/psb_dcg.f90 @@ -114,12 +114,12 @@ Subroutine psb_dcg(a,prec,b,x,eps,desc_a,info,& call psb_erractionsave(err_act) - ictxt = psb_get_context(desc_a) + ictxt = psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) - mglob = psb_get_global_rows(desc_a) - n_row = psb_get_local_rows(desc_a) - n_col = psb_get_local_cols(desc_a) + mglob = psb_cd_get_global_rows(desc_a) + n_row = psb_cd_get_local_rows(desc_a) + n_col = psb_cd_get_local_cols(desc_a) if (present(istop)) then diff --git a/src/methd/psb_dcgs.f90 b/src/methd/psb_dcgs.f90 index 4576c81b..7d2996bd 100644 --- a/src/methd/psb_dcgs.f90 +++ b/src/methd/psb_dcgs.f90 @@ -116,13 +116,13 @@ Subroutine psb_dcgs(a,prec,b,x,eps,desc_a,info,& call psb_erractionsave(err_act) If (debug) Write(*,*) 'entering psb_dcgs' - ictxt = psb_get_context(desc_a) + ictxt = psb_cd_get_context(desc_a) Call psb_info(ictxt, me, np) If (debug) Write(*,*) 'psb_dcgs: from gridinfo',np,me - mglob = psb_get_global_rows(desc_a) - n_row = psb_get_local_rows(desc_a) - n_col = psb_get_local_cols(desc_a) + mglob = psb_cd_get_global_rows(desc_a) + n_row = psb_cd_get_local_rows(desc_a) + n_col = psb_cd_get_local_cols(desc_a) If (Present(istop)) Then istop_ = istop diff --git a/src/methd/psb_dcgstab.f90 b/src/methd/psb_dcgstab.f90 index 9e9c2557..14ec828d 100644 --- a/src/methd/psb_dcgstab.f90 +++ b/src/methd/psb_dcgstab.f90 @@ -119,13 +119,13 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,& call psb_erractionsave(err_act) If (debug) Write(*,*) 'Entering PSB_DCGSTAB',present(istop) - ictxt = psb_get_context(desc_a) + ictxt = psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (debug) write(*,*) 'PSB_DCGSTAB: From GRIDINFO',np,me - mglob = psb_get_global_rows(desc_a) - n_row = psb_get_local_rows(desc_a) - n_col = psb_get_local_cols(desc_a) + mglob = psb_cd_get_global_rows(desc_a) + n_row = psb_cd_get_local_rows(desc_a) + n_col = psb_cd_get_local_cols(desc_a) If (Present(istop)) Then istop_ = istop diff --git a/src/methd/psb_dcgstabl.f90 b/src/methd/psb_dcgstabl.f90 index c1907010..a41f739d 100644 --- a/src/methd/psb_dcgstabl.f90 +++ b/src/methd/psb_dcgstabl.f90 @@ -124,14 +124,14 @@ Subroutine psb_dcgstabl(a,prec,b,x,eps,desc_a,info,& call psb_erractionsave(err_act) If (debug) Write(0,*) 'entering psb_dbicgstabl' - ictxt = psb_get_context(desc_a) + ictxt = psb_cd_get_context(desc_a) Call psb_info(ictxt, me, np) If (debug) Write(0,*) 'psb_dbicgstabl: from gridinfo',np,me - mglob = psb_get_global_rows(desc_a) - n_row = psb_get_local_rows(desc_a) - n_col = psb_get_local_cols(desc_a) + mglob = psb_cd_get_global_rows(desc_a) + n_row = psb_cd_get_local_rows(desc_a) + n_col = psb_cd_get_local_cols(desc_a) if (present(istop)) then istop_ = istop diff --git a/src/methd/psb_dgmresr.f90 b/src/methd/psb_dgmresr.f90 index 66417055..201ddfb5 100644 --- a/src/methd/psb_dgmresr.f90 +++ b/src/methd/psb_dgmresr.f90 @@ -124,14 +124,14 @@ Subroutine psb_dgmresr(a,prec,b,x,eps,desc_a,info,& call psb_erractionsave(err_act) If (debug) Write(0,*) 'entering psb_dgmres' - ictxt = psb_get_context(desc_a) + ictxt = psb_cd_get_context(desc_a) Call psb_info(ictxt, me, np) If (debug) Write(0,*) 'psb_dgmres: from gridinfo',np,me - mglob = psb_get_global_rows(desc_a) - n_row = psb_get_local_rows(desc_a) - n_col = psb_get_local_cols(desc_a) + mglob = psb_cd_get_global_rows(desc_a) + n_row = psb_cd_get_local_rows(desc_a) + n_col = psb_cd_get_local_cols(desc_a) if (present(istop)) then istop_ = istop diff --git a/src/methd/psb_zcgs.f90 b/src/methd/psb_zcgs.f90 index e0ebb6a7..514ec929 100644 --- a/src/methd/psb_zcgs.f90 +++ b/src/methd/psb_zcgs.f90 @@ -117,13 +117,13 @@ Subroutine psb_zcgs(a,prec,b,x,eps,desc_a,info,& call psb_erractionsave(err_act) If (debug) Write(*,*) 'entering psb_zcgs' - ictxt = psb_get_context(desc_a) + ictxt = psb_cd_get_context(desc_a) Call psb_info(ictxt, me, np) If (debug) Write(*,*) 'psb_zcgs: from gridinfo',np,me - mglob = psb_get_global_rows(desc_a) - n_row = psb_get_local_rows(desc_a) - n_col = psb_get_local_cols(desc_a) + mglob = psb_cd_get_global_rows(desc_a) + n_row = psb_cd_get_local_rows(desc_a) + n_col = psb_cd_get_local_cols(desc_a) If (Present(istop)) Then istop_ = istop diff --git a/src/methd/psb_zcgstab.f90 b/src/methd/psb_zcgstab.f90 index e24fbc32..c024710f 100644 --- a/src/methd/psb_zcgstab.f90 +++ b/src/methd/psb_zcgstab.f90 @@ -119,13 +119,13 @@ Subroutine psb_zcgstab(a,prec,b,x,eps,desc_a,info,& call psb_erractionsave(err_act) If (debug) Write(*,*) 'Entering PSB_ZCGSTAB',present(istop) - ictxt = psb_get_context(desc_a) + ictxt = psb_cd_get_context(desc_a) CALL psb_info(ictxt, me, np) if (debug) write(*,*) 'PSB_ZCGSTAB: From GRIDINFO',np,me - mglob = psb_get_global_rows(desc_a) - n_row = psb_get_local_rows(desc_a) - n_col = psb_get_local_cols(desc_a) + mglob = psb_cd_get_global_rows(desc_a) + n_row = psb_cd_get_local_rows(desc_a) + n_col = psb_cd_get_local_cols(desc_a) If (Present(istop)) Then istop_ = istop diff --git a/src/modules/Makefile b/src/modules/Makefile index 81260b5d..a9374eb0 100644 --- a/src/modules/Makefile +++ b/src/modules/Makefile @@ -17,7 +17,7 @@ INCDIRS = -I ../../lib LIBDIR = ../../lib 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_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 diff --git a/src/modules/psb_check_mod.f90 b/src/modules/psb_check_mod.f90 index ea5a1e67..2e98e5ad 100644 --- a/src/modules/psb_check_mod.f90 +++ b/src/modules/psb_check_mod.f90 @@ -102,45 +102,45 @@ contains info=20 int_err(1) = 5 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 int_err(1) = 6 int_err(2) = psb_n_col_ - int_err(3) = psb_get_local_cols(desc_dec) - else if (psb_get_local_rows(desc_dec) < 0) then + int_err(3) = psb_cd_get_local_cols(desc_dec) + else if (psb_cd_get_local_rows(desc_dec) < 0) then info=40 int_err(1) = 6 int_err(2) = psb_n_row_ - int_err(3) = psb_get_local_cols(desc_dec) - else if (lldx < psb_get_local_cols(desc_dec)) then + int_err(3) = psb_cd_get_local_cols(desc_dec) + else if (lldx < psb_cd_get_local_cols(desc_dec)) then info=50 int_err(1) = 3 int_err(2) = lldx int_err(3) = 6 int_err(4) = psb_n_col_ - int_err(5) = psb_get_local_cols(desc_dec) - else if (psb_get_global_cols(desc_dec) < m) then + int_err(5) = psb_cd_get_local_cols(desc_dec) + else if (psb_cd_get_global_cols(desc_dec) < m) then info=60 int_err(1) = 1 int_err(2) = m int_err(3) = 6 int_err(4) = psb_n_ - int_err(5) = psb_get_global_cols(desc_dec) - else if (psb_get_global_cols(desc_dec) < ix) then + int_err(5) = psb_cd_get_global_cols(desc_dec) + else if (psb_cd_get_global_cols(desc_dec) < ix) then info=60 int_err(1) = 4 int_err(2) = ix int_err(3) = 6 int_err(4) = psb_n_ - int_err(5) = psb_get_global_cols(desc_dec) - else if (psb_get_global_rows(desc_dec) < jx) then + int_err(5) = psb_cd_get_global_cols(desc_dec) + else if (psb_cd_get_global_rows(desc_dec) < jx) then info=60 int_err(1) = 5 int_err(2) = jx int_err(3) = 6 int_err(4) = psb_m_ - int_err(5) = psb_get_global_rows(desc_dec) - else if (psb_get_global_cols(desc_dec) < (ix+m-1)) then + int_err(5) = psb_cd_get_global_rows(desc_dec) + else if (psb_cd_get_global_cols(desc_dec) < (ix+m-1)) then info=80 int_err(1) = 1 int_err(2) = m @@ -227,45 +227,45 @@ contains info=20 int_err(1) = 5 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 int_err(1) = 6 int_err(2) = psb_n_col_ - int_err(3) = psb_get_local_cols(desc_dec) - else if (psb_get_local_rows(desc_dec) < 0) then + int_err(3) = psb_cd_get_local_cols(desc_dec) + else if (psb_cd_get_local_rows(desc_dec) < 0) then info=40 int_err(1) = 6 int_err(2) = psb_n_row_ - int_err(3) = psb_get_local_rows(desc_dec) - else if (lldx < psb_get_global_rows(desc_dec)) then + int_err(3) = psb_cd_get_local_rows(desc_dec) + else if (lldx < psb_cd_get_global_rows(desc_dec)) then info=50 int_err(1) = 3 int_err(2) = lldx int_err(3) = 6 int_err(4) = psb_n_col_ - int_err(5) = psb_get_local_cols(desc_dec) - else if (psb_get_global_cols(desc_dec) < m) then + int_err(5) = psb_cd_get_local_cols(desc_dec) + else if (psb_cd_get_global_cols(desc_dec) < m) then info=60 int_err(1) = 1 int_err(2) = m int_err(3) = 6 int_err(4) = psb_n_ - int_err(5) = psb_get_global_cols(desc_dec) - else if (psb_get_global_cols(desc_dec) < ix) then + int_err(5) = psb_cd_get_global_cols(desc_dec) + else if (psb_cd_get_global_cols(desc_dec) < ix) then info=60 int_err(1) = 4 int_err(2) = ix int_err(3) = 6 int_err(4) = psb_n_ - int_err(5) = psb_get_global_cols(desc_dec) - else if (psb_get_global_rows(desc_dec) < jx) then + int_err(5) = psb_cd_get_global_cols(desc_dec) + else if (psb_cd_get_global_rows(desc_dec) < jx) then info=60 int_err(1) = 5 int_err(2) = jx int_err(3) = 6 int_err(4) = psb_m_ - int_err(5) = psb_get_global_rows(desc_dec) - else if (psb_get_global_cols(desc_dec) < (ix+m-1)) then + int_err(5) = psb_cd_get_global_rows(desc_dec) + else if (psb_cd_get_global_cols(desc_dec) < (ix+m-1)) then info=80 int_err(1) = 1 int_err(2) = m @@ -350,51 +350,51 @@ contains info=20 int_err(1) = 5 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 int_err(1) = 6 int_err(2) = psb_n_col_ - int_err(3) = psb_get_local_cols(desc_dec) - else if (psb_get_local_rows(desc_dec) < 0) then + int_err(3) = psb_cd_get_local_cols(desc_dec) + else if (psb_cd_get_local_rows(desc_dec) < 0) then info=40 int_err(1) = 6 int_err(2) = psb_n_row_ - int_err(3) = psb_get_local_rows(desc_dec) - else if (psb_get_global_rows(desc_dec) < m) then + int_err(3) = psb_cd_get_local_rows(desc_dec) + else if (psb_cd_get_global_rows(desc_dec) < m) then info=60 int_err(1) = 1 int_err(2) = m int_err(3) = 5 int_err(4) = psb_m_ - int_err(5) = psb_get_global_rows(desc_dec) - else if (psb_get_global_rows(desc_dec) < m) then + int_err(5) = psb_cd_get_global_rows(desc_dec) + else if (psb_cd_get_global_rows(desc_dec) < m) then info=60 int_err(1) = 2 int_err(2) = n int_err(3) = 5 int_err(4) = psb_m_ - int_err(5) = psb_get_global_rows(desc_dec) - else if (psb_get_global_rows(desc_dec) < ia) then + int_err(5) = psb_cd_get_global_rows(desc_dec) + else if (psb_cd_get_global_rows(desc_dec) < ia) then info=60 int_err(1) = 3 int_err(2) = ia int_err(3) = 5 int_err(4) = psb_m_ - int_err(5) = psb_get_global_rows(desc_dec) - else if (psb_get_global_cols(desc_dec) < ja) then + int_err(5) = psb_cd_get_global_rows(desc_dec) + else if (psb_cd_get_global_cols(desc_dec) < ja) then info=60 int_err(1) = 4 int_err(2) = ja int_err(3) = 5 int_err(4) = psb_n_ - int_err(5) = psb_get_global_cols(desc_dec) - else if (psb_get_global_rows(desc_dec) < (ia+m-1)) then + int_err(5) = psb_cd_get_global_cols(desc_dec) + else if (psb_cd_get_global_rows(desc_dec) < (ia+m-1)) then info=80 int_err(1) = 1 int_err(2) = m int_err(3) = 3 int_err(4) = ia - else if (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 int_err(1) = 2 int_err(2) = n @@ -410,12 +410,12 @@ contains ! Compute local indices for submatrix starting ! at global indices ix and jx 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 jja=1 else - iia=psb_get_local_rows(desc_dec)+1 - jja=psb_get_local_cols(desc_dec)+1 + iia=psb_cd_get_local_rows(desc_dec)+1 + jja=psb_cd_get_local_cols(desc_dec)+1 end if end if diff --git a/src/modules/psb_desc_type.f90 b/src/modules/psb_desc_type.f90 index 5f1841a9..b5dee2af 100644 --- a/src/modules/psb_desc_type.f90 +++ b/src/modules/psb_desc_type.f90 @@ -78,35 +78,35 @@ contains logical function psb_is_ok_desc(desc) type(psb_desc_type), intent(in) :: desc - psb_is_ok_desc = psb_is_ok_dec(psb_get_dectype(desc)) + psb_is_ok_desc = psb_is_ok_dec(psb_cd_get_dectype(desc)) end function psb_is_ok_desc logical function psb_is_bld_desc(desc) type(psb_desc_type), intent(in) :: desc - psb_is_bld_desc = psb_is_bld_dec(psb_get_dectype(desc)) + psb_is_bld_desc = psb_is_bld_dec(psb_cd_get_dectype(desc)) end function psb_is_bld_desc logical function psb_is_upd_desc(desc) type(psb_desc_type), intent(in) :: desc - psb_is_upd_desc = psb_is_upd_dec(psb_get_dectype(desc)) + psb_is_upd_desc = psb_is_upd_dec(psb_cd_get_dectype(desc)) end function psb_is_upd_desc logical function psb_is_asb_upd_desc(desc) type(psb_desc_type), intent(in) :: desc - psb_is_asb_upd_desc = psb_is_asb_upd_dec(psb_get_dectype(desc)) + psb_is_asb_upd_desc = psb_is_asb_upd_dec(psb_cd_get_dectype(desc)) end function psb_is_asb_upd_desc logical function psb_is_asb_desc(desc) type(psb_desc_type), intent(in) :: desc - psb_is_asb_desc = psb_is_asb_dec(psb_get_dectype(desc)) + psb_is_asb_desc = psb_is_asb_dec(psb_cd_get_dectype(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 - psb_get_local_rows = desc%matrix_data(psb_n_row_) - end function psb_get_local_rows + psb_cd_get_local_rows = desc%matrix_data(psb_n_row_) + 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 - psb_get_local_cols = desc%matrix_data(psb_n_col_) - end function psb_get_local_cols + psb_cd_get_local_cols = desc%matrix_data(psb_n_col_) + 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 - psb_get_global_rows = desc%matrix_data(psb_m_) - end function psb_get_global_rows + psb_cd_get_global_rows = desc%matrix_data(psb_m_) + 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 - psb_get_global_cols = desc%matrix_data(psb_n_) - end function psb_get_global_cols + psb_cd_get_global_cols = desc%matrix_data(psb_n_) + 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 - psb_get_context = desc%matrix_data(psb_ctxt_) - end function psb_get_context + psb_cd_get_context = desc%matrix_data(psb_ctxt_) + 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 - psb_get_dectype = desc%matrix_data(psb_dec_type_) - end function psb_get_dectype + psb_cd_get_dectype = desc%matrix_data(psb_dec_type_) + end function psb_cd_get_dectype end module psb_descriptor_type diff --git a/src/modules/psb_serial_mod.f90 b/src/modules/psb_serial_mod.f90 index 049672ac..6218e35d 100644 --- a/src/modules/psb_serial_mod.f90 +++ b/src/modules/psb_serial_mod.f90 @@ -215,104 +215,6 @@ module psb_serial_mod end subroutine psb_zcsprt 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 subroutine psb_dneigh(a,idx,neigh,n,info,lev) use psb_spmat_type @@ -439,112 +341,86 @@ module psb_serial_mod end interface - interface psb_get_nrows - module procedure psb_get_dsp_nrows, psb_get_zsp_nrows + 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_get_ncols - module procedure psb_get_dsp_ncols, psb_get_zsp_ncols + interface psb_sp_scal + 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_get_nnzeros - module procedure psb_get_dsp_nnzeros, psb_get_zsp_nnzeros + interface psb_sp_getblk + 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_get_nnz_row - module procedure psb_get_dsp_nnz_row, psb_get_zsp_nnz_row + 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 -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 diff --git a/src/modules/psb_spmat_type.f90 b/src/modules/psb_spmat_type.f90 index 949312f9..300a761b 100644 --- a/src/modules/psb_spmat_type.f90 +++ b/src/modules/psb_spmat_type.f90 @@ -118,7 +118,138 @@ module psb_spmat_type module procedure psb_dspsizeof, psb_zspsizeof 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) implicit none @@ -1116,6 +1247,315 @@ contains Return 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 diff --git a/src/prec/psb_dbaseprc_bld.f90 b/src/prec/psb_dbaseprc_bld.f90 index d6dbbd4d..70924164 100644 --- a/src/prec/psb_dbaseprc_bld.f90 +++ b/src/prec/psb_dbaseprc_bld.f90 @@ -131,10 +131,10 @@ subroutine psb_dbaseprc_bld(a,desc_a,p,info,upd) if (debug) write(0,*) 'Entering baseprc_bld' info = 0 int_err(1) = 0 - ictxt = psb_get_context(desc_a) - n_row = psb_get_local_rows(desc_a) - n_col = psb_get_local_cols(desc_a) - mglob = psb_get_global_rows(desc_a) + ictxt = psb_cd_get_context(desc_a) + n_row = psb_cd_get_local_rows(desc_a) + n_col = psb_cd_get_local_cols(desc_a) + mglob = psb_cd_get_global_rows(desc_a) if (debug) write(0,*) 'Preconditioner Blacs_gridinfo' call psb_info(ictxt, me, np) diff --git a/src/prec/psb_dbldaggrmat.f90 b/src/prec/psb_dbldaggrmat.f90 index c6b7e9f6..cd367bef 100644 --- a/src/prec/psb_dbldaggrmat.f90 +++ b/src/prec/psb_dbldaggrmat.f90 @@ -60,7 +60,7 @@ subroutine psb_dbldaggrmat(a,desc_a,ac,desc_ac,p,info) info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) select case (p%iprcparm(smth_kind_)) @@ -125,11 +125,11 @@ contains call psb_nullify_sp(b) - ictxt = psb_get_context(desc_a) + ictxt = psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) - nglob = psb_get_global_rows(desc_a) - nrow = psb_get_local_rows(desc_a) - ncol = psb_get_local_cols(desc_a) + nglob = psb_cd_get_global_rows(desc_a) + nrow = psb_cd_get_local_rows(desc_a) + ncol = psb_cd_get_local_cols(desc_a) naggr = p%nlaggr(me+1) ntaggr = sum(p%nlaggr) @@ -155,7 +155,7 @@ contains end if - nzt = psb_get_nnzeros(a) + nzt = psb_sp_get_nnzeros(a) call psb_sp_all(b,nzt,info) if(info /= 0) then call psb_errpush(4010,name,a_err='spall') @@ -176,7 +176,7 @@ contains goto 9999 end if - nzt = psb_get_nnzeros(b) + nzt = psb_sp_get_nnzeros(b) do i=1, nzt b%ia1(i) = p%mlia(b%ia1(i)) b%ia2(i) = p%mlia(b%ia2(i)) @@ -223,7 +223,7 @@ contains goto 9999 end if - irs = psb_get_nnzeros(b) + irs = psb_sp_get_nnzeros(b) call psb_sp_reall(b,irs,info) if(info /= 0) then call psb_errpush(4010,name,a_err='spreall') @@ -402,7 +402,7 @@ contains info=0 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_nullify_sp(b) @@ -412,9 +412,9 @@ contains am2 => p%av(sm_pr_t_) am1 => p%av(sm_pr_) - nglob = psb_get_global_rows(desc_a) - nrow = psb_get_local_rows(desc_a) - ncol = psb_get_local_cols(desc_a) + nglob = psb_cd_get_global_rows(desc_a) + nrow = psb_cd_get_local_rows(desc_a) + ncol = psb_cd_get_local_cols(desc_a) naggr = p%nlaggr(me+1) ntaggr = sum(p%nlaggr) @@ -535,7 +535,7 @@ contains ! its diagonal elements stored explicitly!!! ! 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 (p%iprcparm(om_choice_) == lib_choice_) then @@ -881,7 +881,7 @@ contains 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') if(info /= 0) then call psb_errpush(4010,name,a_err='psb_glob_to_loc') diff --git a/src/prec/psb_ddiagsc_bld.f90 b/src/prec/psb_ddiagsc_bld.f90 index 7707443a..723b4242 100644 --- a/src/prec/psb_ddiagsc_bld.f90 +++ b/src/prec/psb_ddiagsc_bld.f90 @@ -75,10 +75,10 @@ subroutine psb_ddiagsc_bld(a,desc_a,p,upd,info) if (debug) write(0,*) 'Entering diagsc_bld' info = 0 int_err(1) = 0 - ictxt = psb_get_context(desc_a) - n_row = psb_get_local_rows(desc_a) - n_col = psb_get_local_cols(desc_a) - mglob = psb_get_global_rows(desc_a) + ictxt = psb_cd_get_context(desc_a) + n_row = psb_cd_get_local_rows(desc_a) + n_col = psb_cd_get_local_cols(desc_a) + mglob = psb_cd_get_global_rows(desc_a) if (debug) write(0,*) 'Preconditioner Blacs_gridinfo' call psb_info(ictxt, me, np) diff --git a/src/prec/psb_dgenaggrmap.f90 b/src/prec/psb_dgenaggrmap.f90 index bc8ddeaf..e10b64a8 100644 --- a/src/prec/psb_dgenaggrmap.f90 +++ b/src/prec/psb_dgenaggrmap.f90 @@ -66,10 +66,10 @@ subroutine psb_dgenaggrmap(aggr_type,a,desc_a,nlaggr,ilaggr,info) ! so that we only have local decoupled aggregation. This might ! change in the future. ! - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt,me,np) - nrow = psb_get_local_rows(desc_a) - ncol = psb_get_local_cols(desc_a) + nrow = psb_cd_get_local_rows(desc_a) + ncol = psb_cd_get_local_cols(desc_a) nr = a%m diff --git a/src/prec/psb_dilu_bld.f90 b/src/prec/psb_dilu_bld.f90 index 8e9f63e7..822323b9 100644 --- a/src/prec/psb_dilu_bld.f90 +++ b/src/prec/psb_dilu_bld.f90 @@ -131,7 +131,7 @@ subroutine psb_dilu_bld(a,desc_a,p,upd,info) name='psb_ilu_bld' call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) m = a%m @@ -182,13 +182,13 @@ subroutine psb_dilu_bld(a,desc_a,p,upd,info) endif !!$ call psb_csprt(50+me,a,head='% (A)') - nrow_a = psb_get_local_rows(desc_a) - nztota = psb_get_nnzeros(a) - nztotb = psb_get_nnzeros(blck) + nrow_a = psb_cd_get_local_rows(desc_a) + nztota = psb_sp_get_nnzeros(a) + nztotb = psb_sp_get_nnzeros(blck) if (debug) write(0,*)me,': out get_nnzeros',nztota 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 n_row = p%desc_data%matrix_data(psb_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 ! - nztota = psb_get_nnzeros(a) - nztotb = psb_get_nnzeros(blck) + nztota = psb_sp_get_nnzeros(a) + nztotb = psb_sp_get_nnzeros(blck) call psb_sp_all(atmp,nztota+nztotb,info) if(info/=0) then info=4011 diff --git a/src/prec/psb_dilu_fct.f90 b/src/prec/psb_dilu_fct.f90 index 1619b687..7216d41e 100644 --- a/src/prec/psb_dilu_fct.f90 +++ b/src/prec/psb_dilu_fct.f90 @@ -202,10 +202,10 @@ contains if ((mod(i,nrb) == 1).or.(nrb==1)) then 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 info=4010 - ch_err='psb_spgtblk' + ch_err='psb_sp_getblk' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if @@ -344,10 +344,10 @@ contains if ((mod((i-ma),nrb) == 1).or.(nrb==1)) then 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 info=4010 - ch_err='psb_spgtblk' + ch_err='psb_sp_getblk' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if diff --git a/src/prec/psb_dprecbld.f90 b/src/prec/psb_dprecbld.f90 index a0d0af84..f3634030 100644 --- a/src/prec/psb_dprecbld.f90 +++ b/src/prec/psb_dprecbld.f90 @@ -100,7 +100,7 @@ subroutine psb_dprecbld(a,desc_a,p,info,upd) if (debug) write(0,*) 'Entering precbld',P%prec,desc_a%matrix_data(:) info = 0 int_err(1) = 0 - ictxt = psb_get_context(desc_a) + ictxt = psb_cd_get_context(desc_a) if (debug) write(0,*) 'Preconditioner psb_info' call psb_info(ictxt, me, np) diff --git a/src/prec/psb_dslu_bld.f90 b/src/prec/psb_dslu_bld.f90 index 4da81eb2..86f473ad 100644 --- a/src/prec/psb_dslu_bld.f90 +++ b/src/prec/psb_dslu_bld.f90 @@ -165,7 +165,7 @@ subroutine psb_dslu_bld(a,desc_a,p,info) call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - nzt = psb_get_nnzeros(atmp) + nzt = psb_sp_get_nnzeros(atmp) if (Debug) then write(0,*) me,'Calling psb_slu_factor ',nzt,atmp%m,& & atmp%k,p%desc_data%matrix_data(psb_n_row_) diff --git a/src/prec/psb_dsp_renum.f90 b/src/prec/psb_dsp_renum.f90 index 79cea844..b10eda80 100644 --- a/src/prec/psb_dsp_renum.f90 +++ b/src/prec/psb_dsp_renum.f90 @@ -68,7 +68,7 @@ subroutine psb_dsp_renum(a,desc_a,blck,p,atmp,info) name='apply_renum' call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) !!!!!!!!!!!!!!!! CHANGE FOR NON-CSR A @@ -84,7 +84,7 @@ subroutine psb_dsp_renum(a,desc_a,blck,p,atmp,info) atmp%descra = 'GUN' ! This is the renumbering coherent with global indices.. - mglob = psb_get_global_rows(desc_a) + mglob = psb_cd_get_global_rows(desc_a) ! ! Remember: we have switched IA1=COLS and IA2=ROWS ! Now identify the set of distinct local column indices diff --git a/src/prec/psb_dumf_bld.f90 b/src/prec/psb_dumf_bld.f90 index fe902bc7..e45160d9 100644 --- a/src/prec/psb_dumf_bld.f90 +++ b/src/prec/psb_dumf_bld.f90 @@ -97,8 +97,8 @@ subroutine psb_dumf_bld(a,desc_a,p,info) call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - nza = psb_get_nnzeros(atmp) - nzb = psb_get_nnzeros(a) + nza = psb_sp_get_nnzeros(atmp) + nzb = psb_sp_get_nnzeros(a) if (Debug) then write(0,*) me, 'UMFBLD: Done csdp',info,nza,atmp%m,atmp%k,nzb call psb_barrier(ictxt) @@ -112,7 +112,7 @@ subroutine psb_dumf_bld(a,desc_a,p,info) goto 9999 end if - nzb = psb_get_nnzeros(blck) + nzb = psb_sp_get_nnzeros(blck) if (Debug) then write(0,*) me, 'UMFBLD: Done asmatbld',info,nzb,blck%fida 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) goto 9999 end if - nzt = psb_get_nnzeros(atmp) + nzt = psb_sp_get_nnzeros(atmp) if (Debug) then write(0,*) me,'Calling psb_umf_factor ',nzt,atmp%m,& & atmp%k,p%desc_data%matrix_data(psb_n_row_) diff --git a/src/prec/psb_zbaseprc_bld.f90 b/src/prec/psb_zbaseprc_bld.f90 index 7a0ac640..f9b2dfd7 100644 --- a/src/prec/psb_zbaseprc_bld.f90 +++ b/src/prec/psb_zbaseprc_bld.f90 @@ -131,10 +131,10 @@ subroutine psb_zbaseprc_bld(a,desc_a,p,info,upd) if (debug) write(0,*) 'Entering baseprc_bld' info = 0 int_err(1) = 0 - ictxt = psb_get_context(desc_a) - n_row = psb_get_local_rows(desc_a) - n_col = psb_get_local_cols(desc_a) - mglob = psb_get_global_rows(desc_a) + ictxt = psb_cd_get_context(desc_a) + n_row = psb_cd_get_local_rows(desc_a) + n_col = psb_cd_get_local_cols(desc_a) + mglob = psb_cd_get_global_rows(desc_a) if (debug) write(0,*) 'Preconditioner Blacs_gridinfo' call psb_info(ictxt, me, np) diff --git a/src/prec/psb_zbldaggrmat.f90 b/src/prec/psb_zbldaggrmat.f90 index 05ad72ea..892a3e24 100644 --- a/src/prec/psb_zbldaggrmat.f90 +++ b/src/prec/psb_zbldaggrmat.f90 @@ -60,7 +60,7 @@ subroutine psb_zbldaggrmat(a,desc_a,ac,desc_ac,p,info) info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) select case (p%iprcparm(smth_kind_)) @@ -124,11 +124,11 @@ contains call psb_nullify_sp(b) - ictxt = psb_get_context(desc_a) + ictxt = psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) - nglob = psb_get_global_rows(desc_a) - nrow = psb_get_local_rows(desc_a) - ncol = psb_get_local_cols(desc_a) + nglob = psb_cd_get_global_rows(desc_a) + nrow = psb_cd_get_local_rows(desc_a) + ncol = psb_cd_get_local_cols(desc_a) naggr = p%nlaggr(me+1) ntaggr = sum(p%nlaggr) @@ -154,7 +154,7 @@ contains end if - nzt = psb_get_nnzeros(a) + nzt = psb_sp_get_nnzeros(a) call psb_sp_all(b,nzt,info) if(info /= 0) then call psb_errpush(4010,name,a_err='spall') @@ -175,7 +175,7 @@ contains goto 9999 end if - nzt = psb_get_nnzeros(b) + nzt = psb_sp_get_nnzeros(b) do i=1, nzt b%ia1(i) = p%mlia(b%ia1(i)) b%ia2(i) = p%mlia(b%ia2(i)) @@ -222,7 +222,7 @@ contains goto 9999 end if - irs = psb_get_nnzeros(b) + irs = psb_sp_get_nnzeros(b) call psb_sp_reall(b,irs,info) if(info /= 0) then call psb_errpush(4010,name,a_err='spreall') @@ -401,7 +401,7 @@ contains info=0 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_nullify_sp(b) @@ -411,9 +411,9 @@ contains am2 => p%av(sm_pr_t_) am1 => p%av(sm_pr_) - nglob = psb_get_global_rows(desc_a) - nrow = psb_get_local_rows(desc_a) - ncol = psb_get_local_cols(desc_a) + nglob = psb_cd_get_global_rows(desc_a) + nrow = psb_cd_get_local_rows(desc_a) + ncol = psb_cd_get_local_cols(desc_a) naggr = p%nlaggr(me+1) ntaggr = sum(p%nlaggr) @@ -534,7 +534,7 @@ contains ! its diagonal elements stored explicitly!!! ! 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 (p%iprcparm(om_choice_) == lib_choice_) then @@ -880,7 +880,7 @@ contains 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') if(info /= 0) then call psb_errpush(4010,name,a_err='psb_glob_to_loc') diff --git a/src/prec/psb_zdiagsc_bld.f90 b/src/prec/psb_zdiagsc_bld.f90 index 567b8a87..cb7a64d8 100644 --- a/src/prec/psb_zdiagsc_bld.f90 +++ b/src/prec/psb_zdiagsc_bld.f90 @@ -75,10 +75,10 @@ subroutine psb_zdiagsc_bld(a,desc_a,p,upd,info) if (debug) write(0,*) 'Entering diagsc_bld' info = 0 int_err(1) = 0 - ictxt = psb_get_context(desc_a) - n_row = psb_get_local_rows(desc_a) - n_col = psb_get_local_cols(desc_a) - mglob = psb_get_global_rows(desc_a) + ictxt = psb_cd_get_context(desc_a) + n_row = psb_cd_get_local_rows(desc_a) + n_col = psb_cd_get_local_cols(desc_a) + mglob = psb_cd_get_global_rows(desc_a) if (debug) write(0,*) 'Preconditioner Blacs_gridinfo' call psb_info(ictxt, me, np) diff --git a/src/prec/psb_zgenaggrmap.f90 b/src/prec/psb_zgenaggrmap.f90 index cf8905e1..d7ecf4a8 100644 --- a/src/prec/psb_zgenaggrmap.f90 +++ b/src/prec/psb_zgenaggrmap.f90 @@ -66,10 +66,10 @@ subroutine psb_zgenaggrmap(aggr_type,a,desc_a,nlaggr,ilaggr,info) ! so that we only have local decoupled aggregation. This might ! change in the future. ! - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt,me,np) - nrow = psb_get_local_rows(desc_a) - ncol = psb_get_local_cols(desc_a) + nrow = psb_cd_get_local_rows(desc_a) + ncol = psb_cd_get_local_cols(desc_a) nr = a%m diff --git a/src/prec/psb_zilu_bld.f90 b/src/prec/psb_zilu_bld.f90 index 4043a4c8..09e9f0b3 100644 --- a/src/prec/psb_zilu_bld.f90 +++ b/src/prec/psb_zilu_bld.f90 @@ -131,7 +131,7 @@ subroutine psb_zilu_bld(a,desc_a,p,upd,info) name='psb_ilu_bld' call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) m = a%m @@ -181,13 +181,13 @@ subroutine psb_zilu_bld(a,desc_a,p,upd,info) goto 9999 endif - nrow_a = psb_get_local_rows(desc_a) - nztota = psb_get_nnzeros(a) - nztotb = psb_get_nnzeros(blck) + nrow_a = psb_cd_get_local_rows(desc_a) + nztota = psb_sp_get_nnzeros(a) + nztotb = psb_sp_get_nnzeros(blck) if (debug) write(0,*)me,': out get_nnzeros',nztota 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 n_row = p%desc_data%matrix_data(psb_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 ! - nztota = psb_get_nnzeros(a) - nztotb = psb_get_nnzeros(blck) + nztota = psb_sp_get_nnzeros(a) + nztotb = psb_sp_get_nnzeros(blck) call psb_sp_all(atmp,nztota+nztotb,info) if(info/=0) then info=4011 diff --git a/src/prec/psb_zilu_fct.f90 b/src/prec/psb_zilu_fct.f90 index 95ff5e83..54b7a48a 100644 --- a/src/prec/psb_zilu_fct.f90 +++ b/src/prec/psb_zilu_fct.f90 @@ -199,10 +199,10 @@ contains if ((mod(i,nrb) == 1).or.(nrb==1)) then 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 info=4010 - ch_err='psb_spgtblk' + ch_err='psb_sp_getblk' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if @@ -341,10 +341,10 @@ contains if ((mod((i-ma),nrb) == 1).or.(nrb==1)) then 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 info=4010 - ch_err='psb_spgtblk' + ch_err='psb_sp_getblk' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if diff --git a/src/prec/psb_zprecbld.f90 b/src/prec/psb_zprecbld.f90 index c1a79406..faae92aa 100644 --- a/src/prec/psb_zprecbld.f90 +++ b/src/prec/psb_zprecbld.f90 @@ -100,7 +100,7 @@ subroutine psb_zprecbld(a,desc_a,p,info,upd) if (debug) write(0,*) 'Entering precbld',P%prec,desc_a%matrix_data(:) info = 0 int_err(1) = 0 - ictxt = psb_get_context(desc_a) + ictxt = psb_cd_get_context(desc_a) if (debug) write(0,*) 'Preconditioner psb_info' call psb_info(ictxt, me, np) diff --git a/src/prec/psb_zslu_bld.f90 b/src/prec/psb_zslu_bld.f90 index 43c308ed..35645d53 100644 --- a/src/prec/psb_zslu_bld.f90 +++ b/src/prec/psb_zslu_bld.f90 @@ -165,7 +165,7 @@ subroutine psb_zslu_bld(a,desc_a,p,info) call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - nzt = psb_get_nnzeros(atmp) + nzt = psb_sp_get_nnzeros(atmp) if (Debug) then write(0,*) me,'Calling psb_slu_factor ',nzt,atmp%m,& & atmp%k,p%desc_data%matrix_data(psb_n_row_) diff --git a/src/prec/psb_zsp_renum.f90 b/src/prec/psb_zsp_renum.f90 index 75506bfd..4679d071 100644 --- a/src/prec/psb_zsp_renum.f90 +++ b/src/prec/psb_zsp_renum.f90 @@ -68,7 +68,7 @@ subroutine psb_zsp_renum(a,desc_a,blck,p,atmp,info) name='apply_renum' call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) !!!!!!!!!!!!!!!! CHANGE FOR NON-CSR A @@ -84,7 +84,7 @@ subroutine psb_zsp_renum(a,desc_a,blck,p,atmp,info) atmp%descra = 'GUN' ! This is the renumbering coherent with global indices.. - mglob = psb_get_global_rows(desc_a) + mglob = psb_cd_get_global_rows(desc_a) ! ! Remember: we have switched IA1=COLS and IA2=ROWS ! Now identify the set of distinct local column indices diff --git a/src/prec/psb_zumf_bld.f90 b/src/prec/psb_zumf_bld.f90 index 25686d2e..f4b6ede3 100644 --- a/src/prec/psb_zumf_bld.f90 +++ b/src/prec/psb_zumf_bld.f90 @@ -97,8 +97,8 @@ subroutine psb_zumf_bld(a,desc_a,p,info) call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - nza = psb_get_nnzeros(atmp) - nzb = psb_get_nnzeros(a) + nza = psb_sp_get_nnzeros(atmp) + nzb = psb_sp_get_nnzeros(a) if (Debug) then write(0,*) me, 'UMFBLD: Done csdp',info,nza,atmp%m,atmp%k,nzb call psb_barrier(ictxt) @@ -112,7 +112,7 @@ subroutine psb_zumf_bld(a,desc_a,p,info) goto 9999 end if - nzb = psb_get_nnzeros(blck) + nzb = psb_sp_get_nnzeros(blck) if (Debug) then write(0,*) me, 'UMFBLD: Done asmatbld',info,nzb,blck%fida 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) goto 9999 end if - nzt = psb_get_nnzeros(atmp) + nzt = psb_sp_get_nnzeros(atmp) if (Debug) then write(0,*) me,'Calling psb_umf_factor ',nzt,atmp%m,& & atmp%k,p%desc_data%matrix_data(psb_n_row_) diff --git a/src/psblas/psb_damax.f90 b/src/psblas/psb_damax.f90 index 5ba35918..19d1fcf9 100644 --- a/src/psblas/psb_damax.f90 +++ b/src/psblas/psb_damax.f90 @@ -70,7 +70,7 @@ function psb_damax (x,desc_a, info, jx) amax=0.d0 - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -86,7 +86,7 @@ function psb_damax (x,desc_a, info, jx) ijx = 1 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) if(info.ne.0) then @@ -103,8 +103,8 @@ function psb_damax (x,desc_a, info, jx) end if ! compute local max - if ((psb_get_local_rows(desc_a).gt.0).and.(m.ne.0)) then - imax=idamax(psb_get_local_rows(desc_a)-iix+1,x(iix,jjx),1) + if ((psb_cd_get_local_rows(desc_a).gt.0).and.(m.ne.0)) then + imax=idamax(psb_cd_get_local_rows(desc_a)-iix+1,x(iix,jjx),1) amax=abs(x(iix+imax-1,jjx)) end if @@ -195,7 +195,7 @@ function psb_damaxv (x,desc_a, info) amax=0.d0 - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -207,7 +207,7 @@ function psb_damaxv (x,desc_a, info) ix = 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) if(info.ne.0) then @@ -224,8 +224,8 @@ function psb_damaxv (x,desc_a, info) end if ! compute local max - if ((psb_get_local_rows(desc_a).gt.0).and.(m.ne.0)) then - imax=idamax(psb_get_local_rows(desc_a)-iix+1,x(iix),1) + if ((psb_cd_get_local_rows(desc_a).gt.0).and.(m.ne.0)) then + imax=idamax(psb_cd_get_local_rows(desc_a)-iix+1,x(iix),1) amax=abs(x(iix+imax-1)) end if @@ -318,7 +318,7 @@ subroutine psb_damaxvs (res,x,desc_a, info) amax=0.d0 - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -330,7 +330,7 @@ subroutine psb_damaxvs (res,x,desc_a, info) ix = 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) if(info.ne.0) then @@ -347,8 +347,8 @@ subroutine psb_damaxvs (res,x,desc_a, info) end if ! compute local max - if ((psb_get_local_rows(desc_a).gt.0).and.(m.ne.0)) then - imax=idamax(psb_get_local_rows(desc_a)-iix+1,x(iix),1) + if ((psb_cd_get_local_rows(desc_a).gt.0).and.(m.ne.0)) then + imax=idamax(psb_cd_get_local_rows(desc_a)-iix+1,x(iix),1) amax=abs(x(iix+imax-1)) end if @@ -440,7 +440,7 @@ subroutine psb_dmamaxs (res,x,desc_a, info,jx) amax=0.d0 - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -456,7 +456,7 @@ subroutine psb_dmamaxs (res,x,desc_a, info,jx) ijx = 1 endif - m = psb_get_global_rows(desc_a) + m = psb_cd_get_global_rows(desc_a) k = min(size(x,2),size(res,1)) call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx) @@ -474,9 +474,9 @@ subroutine psb_dmamaxs (res,x,desc_a, info,jx) end if ! 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 - 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)) end do end if diff --git a/src/psblas/psb_dasum.f90 b/src/psblas/psb_dasum.f90 index 5d8efe7f..6268fb69 100644 --- a/src/psblas/psb_dasum.f90 +++ b/src/psblas/psb_dasum.f90 @@ -71,7 +71,7 @@ function psb_dasum (x,desc_a, info, jx) asum=0.d0 - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -87,7 +87,7 @@ function psb_dasum (x,desc_a, info, jx) ijx = 1 endif - m = psb_get_global_rows(desc_a) + m = psb_cd_get_global_rows(desc_a) ! check vector correctness 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 if ((m.ne.0)) then - if(psb_get_local_rows(desc_a).gt.0) then - asum=dasum(psb_get_local_rows(desc_a)-iix+1,x(iix,jjx),ione) + if(psb_cd_get_local_rows(desc_a).gt.0) then + 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 i=1 @@ -213,7 +213,7 @@ function psb_dasumv (x,desc_a, info) asum=0.d0 - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -225,7 +225,7 @@ function psb_dasumv (x,desc_a, info) ix = 1 jx=1 - m = psb_get_global_rows(desc_a) + m = psb_cd_get_global_rows(desc_a) ! check vector correctness 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 if ((m.ne.0)) then - if(psb_get_local_rows(desc_a).gt.0) then - asum=dasum(psb_get_local_rows(desc_a),x,ione) + if(psb_cd_get_local_rows(desc_a).gt.0) then + asum=dasum(psb_cd_get_local_rows(desc_a),x,ione) ! adjust asum because overlapped elements are computed more than once i=1 @@ -351,7 +351,7 @@ subroutine psb_dasumvs (res,x,desc_a, info) asum=0.d0 - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -363,7 +363,7 @@ subroutine psb_dasumvs (res,x,desc_a, info) ix = 1 jx = 1 - m = psb_get_global_rows(desc_a) + m = psb_cd_get_global_rows(desc_a) ! check vector correctness 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 if ((m.ne.0)) then - if(psb_get_local_rows(desc_a).gt.0) then - asum=dasum(psb_get_local_rows(desc_a),x,ione) + if(psb_cd_get_local_rows(desc_a).gt.0) then + asum=dasum(psb_cd_get_local_rows(desc_a),x,ione) ! adjust asum because overlapped elements are computed more than once i=1 diff --git a/src/psblas/psb_daxpby.f90 b/src/psblas/psb_daxpby.f90 index e55d16c6..84a39c5b 100644 --- a/src/psblas/psb_daxpby.f90 +++ b/src/psblas/psb_daxpby.f90 @@ -75,7 +75,7 @@ subroutine psb_daxpby(alpha, x, beta,y,desc_a,info, n, jx, jy) info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -ione) then @@ -115,7 +115,7 @@ subroutine psb_daxpby(alpha, x, beta,y,desc_a,info, n, jx, jy) goto 9999 end if - m = psb_get_global_rows(desc_a) + m = psb_cd_get_global_rows(desc_a) ! check vector correctness 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 if ((in.ne.0)) then - if(psb_get_local_rows(desc_a).gt.0) then - call daxpby(psb_get_local_rows(desc_a),in,& + if(psb_cd_get_local_rows(desc_a).gt.0) then + call daxpby(psb_cd_get_local_rows(desc_a),in,& & alpha,x(iix,jjx),size(x,1),beta,& & y(iiy,jjy),size(y,1),info) end if @@ -228,7 +228,7 @@ subroutine psb_daxpbyv(alpha, x, beta,y,desc_a,info) info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -ione) then @@ -240,7 +240,7 @@ subroutine psb_daxpbyv(alpha, x, beta,y,desc_a,info) ix = ione iy = ione - m = psb_get_global_rows(desc_a) + m = psb_cd_get_global_rows(desc_a) ! check vector correctness 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) end if - if(psb_get_local_rows(desc_a).gt.0) then - call daxpby(psb_get_local_rows(desc_a),ione,& + if(psb_cd_get_local_rows(desc_a).gt.0) then + call daxpby(psb_cd_get_local_rows(desc_a),ione,& & alpha,x,size(x),beta,& & y,size(y),info) end if diff --git a/src/psblas/psb_ddot.f90 b/src/psblas/psb_ddot.f90 index 38521e26..6d322263 100644 --- a/src/psblas/psb_ddot.f90 +++ b/src/psblas/psb_ddot.f90 @@ -72,7 +72,7 @@ function psb_ddot(x, y,desc_a, info, jx, jy) info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -ione) then @@ -101,7 +101,7 @@ function psb_ddot(x, y,desc_a, info, jx, jy) goto 9999 end if - m = psb_get_global_rows(desc_a) + m = psb_cd_get_global_rows(desc_a) ! check vector correctness 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 if(m.ne.0) then - if(psb_get_local_rows(desc_a).gt.0) then - dot_local = ddot(psb_get_local_rows(desc_a),& + if(psb_cd_get_local_rows(desc_a).gt.0) then + dot_local = ddot(psb_cd_get_local_rows(desc_a),& & x(iix,jjx),ione,y(iiy,jjy),ione) ! adjust dot_local because overlapped elements are computed more than once i=1 @@ -226,7 +226,7 @@ function psb_ddotv(x, y,desc_a, info) info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -ione) then @@ -239,7 +239,7 @@ function psb_ddotv(x, y,desc_a, info) iy = ione jx = ione jy = ione - m = psb_get_global_rows(desc_a) + m = psb_cd_get_global_rows(desc_a) ! check vector correctness 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 if(m.ne.0) then - if(psb_get_local_rows(desc_a).gt.0) then - dot_local = ddot(psb_get_local_rows(desc_a),& + if(psb_cd_get_local_rows(desc_a).gt.0) then + dot_local = ddot(psb_cd_get_local_rows(desc_a),& & x,ione,y,ione) ! adjust dot_local because overlapped elements are computed more than once i=1 @@ -364,7 +364,7 @@ subroutine psb_ddotvs(res, x, y,desc_a, info) info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -ione) then @@ -375,7 +375,7 @@ subroutine psb_ddotvs(res, x, y,desc_a, info) ix = ione iy = ione - m = psb_get_global_rows(desc_a) + m = psb_cd_get_global_rows(desc_a) ! check vector correctness 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 if(m.ne.0) then - if(psb_get_local_rows(desc_a).gt.0) then - dot_local = ddot(psb_get_local_rows(desc_a),& + if(psb_cd_get_local_rows(desc_a).gt.0) then + dot_local = ddot(psb_cd_get_local_rows(desc_a),& & x,ione,y,ione) ! adjust dot_local because overlapped elements are computed more than once i=1 @@ -505,7 +505,7 @@ subroutine psb_dmdots(res, x, y, desc_a, info) info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -ione) then @@ -517,7 +517,7 @@ subroutine psb_dmdots(res, x, y, desc_a, info) ix = ione iy = ione - m = psb_get_global_rows(desc_a) + m = psb_cd_get_global_rows(desc_a) ! check vector correctness 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)) 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 - 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) ! adjust dot_local because overlapped elements are computed more than once i=1 @@ -611,7 +611,7 @@ subroutine psb_ddot2v(res, x, y,w,z,desc_a, info) info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -ione) then @@ -622,7 +622,7 @@ subroutine psb_ddot2v(res, x, y,w,z,desc_a, info) ix = ione iy = ione - m = psb_get_global_rows(desc_a) + m = psb_cd_get_global_rows(desc_a) ! check vector correctness 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 if(m.ne.0) then - if(psb_get_local_rows(desc_a).gt.0) then - dot_local(1) = ddot(psb_get_local_rows(desc_a),& + if(psb_cd_get_local_rows(desc_a).gt.0) then + dot_local(1) = ddot(psb_cd_get_local_rows(desc_a),& & 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) ! adjust dot_local because overlapped elements are computed more than once i=1 diff --git a/src/psblas/psb_dnrm2.f90 b/src/psblas/psb_dnrm2.f90 index 69a94274..9097e932 100644 --- a/src/psblas/psb_dnrm2.f90 +++ b/src/psblas/psb_dnrm2.f90 @@ -68,7 +68,7 @@ function psb_dnrm2(x, desc_a, info, jx) info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -84,7 +84,7 @@ function psb_dnrm2(x, desc_a, info, jx) ijx = 1 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) if(info.ne.0) then @@ -100,8 +100,8 @@ function psb_dnrm2(x, desc_a, info, jx) end if if(m.ne.0) then - if (psb_get_local_rows(desc_a) .gt. 0) then - ndim = psb_get_local_rows(desc_a) + if (psb_cd_get_local_rows(desc_a) .gt. 0) then + ndim = psb_cd_get_local_rows(desc_a) nrm2 = dnrm2( ndim, x(iix,jjx), ione ) i=1 do while (desc_a%ovrlap_elem(i) .ne. -1) @@ -205,7 +205,7 @@ function psb_dnrm2v(x, desc_a, info) info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -217,7 +217,7 @@ function psb_dnrm2v(x, desc_a, info) ix = 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) @@ -234,8 +234,8 @@ function psb_dnrm2v(x, desc_a, info) end if if(m.ne.0) then - if (psb_get_local_rows(desc_a) .gt. 0) then - ndim = psb_get_local_rows(desc_a) + if (psb_cd_get_local_rows(desc_a) .gt. 0) then + ndim = psb_cd_get_local_rows(desc_a) nrm2 = dnrm2( ndim, x, ione ) i=1 do while (desc_a%ovrlap_elem(i) .ne. -1) @@ -341,7 +341,7 @@ subroutine psb_dnrm2vs(res, x, desc_a, info) info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -352,7 +352,7 @@ subroutine psb_dnrm2vs(res, x, desc_a, info) ix = 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) if(info.ne.0) then @@ -368,8 +368,8 @@ subroutine psb_dnrm2vs(res, x, desc_a, info) end if if(m.ne.0) then - if (psb_get_local_rows(desc_a) .gt. 0) then - ndim = psb_get_local_rows(desc_a) + if (psb_cd_get_local_rows(desc_a) .gt. 0) then + ndim = psb_cd_get_local_rows(desc_a) nrm2 = dnrm2( ndim, x, ione ) i=1 do while (desc_a%ovrlap_elem(i) .ne. -1) diff --git a/src/psblas/psb_dnrmi.f90 b/src/psblas/psb_dnrmi.f90 index 07c3cdb5..66754f98 100644 --- a/src/psblas/psb_dnrmi.f90 +++ b/src/psblas/psb_dnrmi.f90 @@ -64,7 +64,7 @@ function psb_dnrmi(a,desc_a,info) info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -75,8 +75,8 @@ function psb_dnrmi(a,desc_a,info) ia = 1 ja = 1 - m = psb_get_global_rows(desc_a) - n = psb_get_global_cols(desc_a) + m = psb_cd_get_global_rows(desc_a) + n = psb_cd_get_global_cols(desc_a) call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja) if(info.ne.0) then @@ -93,8 +93,8 @@ function psb_dnrmi(a,desc_a,info) end if if ((m.ne.0).and.(n.ne.0)) then - mdim = psb_get_local_rows(desc_a) - ndim = psb_get_local_cols(desc_a) + mdim = psb_cd_get_local_rows(desc_a) + ndim = psb_cd_get_local_cols(desc_a) nrmi = dcsnmi('N',mdim,ndim,a%fida,& & a%descra,a%aspk,a%ia1,a%ia2,& & a%infoa,info) diff --git a/src/psblas/psb_dspmm.f90 b/src/psblas/psb_dspmm.f90 index 6343e6da..0853ecbb 100644 --- a/src/psblas/psb_dspmm.f90 +++ b/src/psblas/psb_dspmm.f90 @@ -117,7 +117,7 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,& info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -172,10 +172,10 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,& itrans = 'N' endif - m = psb_get_global_rows(desc_a) - n = psb_get_global_cols(desc_a) - nrow = psb_get_local_rows(desc_a) - ncol = psb_get_local_cols(desc_a) + m = psb_cd_get_global_rows(desc_a) + n = psb_cd_get_global_cols(desc_a) + nrow = psb_cd_get_local_rows(desc_a) + ncol = psb_cd_get_local_cols(desc_a) lldx = size(x,1) lldy = size(y,1) @@ -455,7 +455,7 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,& info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -495,10 +495,10 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,& itrans = 'N' endif - m = psb_get_global_rows(desc_a) - n = psb_get_global_cols(desc_a) - nrow = psb_get_local_rows(desc_a) - ncol = psb_get_local_cols(desc_a) + m = psb_cd_get_global_rows(desc_a) + n = psb_cd_get_global_cols(desc_a) + nrow = psb_cd_get_local_rows(desc_a) + ncol = psb_cd_get_local_cols(desc_a) lldx = size(x) lldy = size(y) diff --git a/src/psblas/psb_dspsm.f90 b/src/psblas/psb_dspsm.f90 index 40650a0b..e83b9cae 100644 --- a/src/psblas/psb_dspsm.f90 +++ b/src/psblas/psb_dspsm.f90 @@ -115,7 +115,7 @@ subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,& info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -174,9 +174,9 @@ subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,& itrans = 'N' endif - m = psb_get_global_rows(desc_a) - nrow = psb_get_local_rows(desc_a) - ncol = psb_get_local_cols(desc_a) + m = psb_cd_get_global_rows(desc_a) + nrow = psb_cd_get_local_rows(desc_a) + ncol = psb_cd_get_local_cols(desc_a) lldx = size(x,1) lldy = size(y,1) @@ -419,7 +419,7 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,& info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -466,9 +466,9 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,& itrans = 'N' endif - m = psb_get_global_rows(desc_a) - nrow = psb_get_local_rows(desc_a) - ncol = psb_get_local_cols(desc_a) + m = psb_cd_get_global_rows(desc_a) + nrow = psb_cd_get_local_rows(desc_a) + ncol = psb_cd_get_local_cols(desc_a) lldx = size(x) lldy = size(y) diff --git a/src/psblas/psb_zamax.f90 b/src/psblas/psb_zamax.f90 index 1e5d6ed5..1491ce8c 100644 --- a/src/psblas/psb_zamax.f90 +++ b/src/psblas/psb_zamax.f90 @@ -73,7 +73,7 @@ function psb_zamax (x,desc_a, info, jx) amax=0.d0 - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -89,7 +89,7 @@ function psb_zamax (x,desc_a, info, jx) ijx = 1 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) if(info.ne.0) then @@ -106,8 +106,8 @@ function psb_zamax (x,desc_a, info, jx) end if ! compute local max - if ((psb_get_local_rows(desc_a).gt.0).and.(m.ne.0)) then - imax=izamax(psb_get_local_rows(desc_a)-iix+1,x(iix,jjx),1) + if ((psb_cd_get_local_rows(desc_a).gt.0).and.(m.ne.0)) then + imax=izamax(psb_cd_get_local_rows(desc_a)-iix+1,x(iix,jjx),1) amax=cabs1(x(iix+imax-1,jjx)) end if @@ -202,7 +202,7 @@ function psb_zamaxv (x,desc_a, info) amax=0.d0 - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -214,7 +214,7 @@ function psb_zamaxv (x,desc_a, info) ix = 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) if(info.ne.0) then @@ -231,8 +231,8 @@ function psb_zamaxv (x,desc_a, info) end if ! compute local max - if ((psb_get_local_rows(desc_a).gt.0).and.(m.ne.0)) then - imax=izamax(psb_get_local_rows(desc_a)-iix+1,x(iix),1) + if ((psb_cd_get_local_rows(desc_a).gt.0).and.(m.ne.0)) then + imax=izamax(psb_cd_get_local_rows(desc_a)-iix+1,x(iix),1) cmax=(x(iix+imax-1)) amax=cabs1(cmax) end if @@ -330,7 +330,7 @@ subroutine psb_zamaxvs (res,x,desc_a, info) amax=0.d0 - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -342,7 +342,7 @@ subroutine psb_zamaxvs (res,x,desc_a, info) ix = 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) if(info.ne.0) then @@ -359,8 +359,8 @@ subroutine psb_zamaxvs (res,x,desc_a, info) end if ! compute local max - if ((psb_get_local_rows(desc_a).gt.0).and.(m.ne.0)) then - imax=izamax(psb_get_local_rows(desc_a)-iix+1,x(iix),1) + if ((psb_cd_get_local_rows(desc_a).gt.0).and.(m.ne.0)) then + imax=izamax(psb_cd_get_local_rows(desc_a)-iix+1,x(iix),1) cmax=(x(iix+imax-1)) amax=cabs1(cmax) end if @@ -457,7 +457,7 @@ subroutine psb_zmamaxs (res,x,desc_a, info,jx) amax=0.d0 - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -473,7 +473,7 @@ subroutine psb_zmamaxs (res,x,desc_a, info,jx) ijx = 1 endif - m = psb_get_global_rows(desc_a) + m = psb_cd_get_global_rows(desc_a) k = min(size(x,2),size(res,1)) call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx) @@ -491,9 +491,9 @@ subroutine psb_zmamaxs (res,x,desc_a, info,jx) end if ! 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 - 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)) res(i)=cabs1(cmax) end do diff --git a/src/psblas/psb_zasum.f90 b/src/psblas/psb_zasum.f90 index b3c1da5a..ae84f1d6 100644 --- a/src/psblas/psb_zasum.f90 +++ b/src/psblas/psb_zasum.f90 @@ -75,7 +75,7 @@ function psb_zasum (x,desc_a, info, jx) asum=0.d0 - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -91,7 +91,7 @@ function psb_zasum (x,desc_a, info, jx) ijx = 1 endif - m = psb_get_global_rows(desc_a) + m = psb_cd_get_global_rows(desc_a) ! check vector correctness 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 if ((m.ne.0)) then - if(psb_get_local_rows(desc_a).gt.0) then - asum=dzasum(psb_get_local_rows(desc_a)-iix+1,x(iix,jjx),ione) + if(psb_cd_get_local_rows(desc_a).gt.0) then + 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 i=1 @@ -223,7 +223,7 @@ function psb_zasumv (x,desc_a, info) asum=0.d0 - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -235,7 +235,7 @@ function psb_zasumv (x,desc_a, info) ix = 1 jx=1 - m = psb_get_global_rows(desc_a) + m = psb_cd_get_global_rows(desc_a) ! check vector correctness 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 if ((m.ne.0)) then - if(psb_get_local_rows(desc_a).gt.0) then - asum=dzasum(psb_get_local_rows(desc_a),x,ione) + if(psb_cd_get_local_rows(desc_a).gt.0) then + asum=dzasum(psb_cd_get_local_rows(desc_a),x,ione) ! adjust asum because overlapped elements are computed more than once i=1 @@ -367,7 +367,7 @@ subroutine psb_zasumvs (res,x,desc_a, info) asum=0.d0 - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -379,7 +379,7 @@ subroutine psb_zasumvs (res,x,desc_a, info) ix = 1 jx = 1 - m = psb_get_global_rows(desc_a) + m = psb_cd_get_global_rows(desc_a) ! check vector correctness 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 if ((m.ne.0)) then - if(psb_get_local_rows(desc_a).gt.0) then - asum=dzasum(psb_get_local_rows(desc_a),x,ione) + if(psb_cd_get_local_rows(desc_a).gt.0) then + asum=dzasum(psb_cd_get_local_rows(desc_a),x,ione) ! adjust asum because overlapped elements are computed more than once i=1 diff --git a/src/psblas/psb_zaxpby.f90 b/src/psblas/psb_zaxpby.f90 index 689a20af..e2cc7708 100644 --- a/src/psblas/psb_zaxpby.f90 +++ b/src/psblas/psb_zaxpby.f90 @@ -74,7 +74,7 @@ subroutine psb_zaxpby(alpha, x, beta,y,desc_a,info, n, jx, jy) info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -ione) then @@ -114,7 +114,7 @@ subroutine psb_zaxpby(alpha, x, beta,y,desc_a,info, n, jx, jy) goto 9999 end if - m = psb_get_global_rows(desc_a) + m = psb_cd_get_global_rows(desc_a) ! check vector correctness 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 if ((in.ne.0)) then - if(psb_get_local_rows(desc_a).gt.0) then - call zaxpby(psb_get_local_cols(desc_a),in,& + if(psb_cd_get_local_rows(desc_a).gt.0) then + call zaxpby(psb_cd_get_local_cols(desc_a),in,& & alpha,x(iix,jjx),size(x,1),beta,& & y(iiy,jjy),size(y,1),info) end if @@ -227,7 +227,7 @@ subroutine psb_zaxpbyv(alpha, x, beta,y,desc_a,info) info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -ione) then @@ -239,7 +239,7 @@ subroutine psb_zaxpbyv(alpha, x, beta,y,desc_a,info) ix = ione iy = ione - m = psb_get_global_rows(desc_a) + m = psb_cd_get_global_rows(desc_a) ! check vector correctness 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) end if - if(psb_get_local_rows(desc_a).gt.0) then - call zaxpby(psb_get_local_cols(desc_a),ione,& + if(psb_cd_get_local_rows(desc_a).gt.0) then + call zaxpby(psb_cd_get_local_cols(desc_a),ione,& & alpha,x,size(x),beta,& & y,size(y),info) end if diff --git a/src/psblas/psb_zdot.f90 b/src/psblas/psb_zdot.f90 index 5ffcad40..3143385c 100644 --- a/src/psblas/psb_zdot.f90 +++ b/src/psblas/psb_zdot.f90 @@ -72,7 +72,7 @@ function psb_zdot(x, y,desc_a, info, jx, jy) info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -ione) then @@ -101,7 +101,7 @@ function psb_zdot(x, y,desc_a, info, jx, jy) goto 9999 end if - m = psb_get_global_rows(desc_a) + m = psb_cd_get_global_rows(desc_a) ! check vector correctness 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 if(m.ne.0) then - if(psb_get_local_rows(desc_a).gt.0) then - dot_local = zdotc(psb_get_local_rows(desc_a),& + if(psb_cd_get_local_rows(desc_a).gt.0) then + dot_local = zdotc(psb_cd_get_local_rows(desc_a),& & x(iix,jjx),ione,y(iiy,jjy),ione) ! adjust dot_local because overlapped elements are computed more than once i=1 @@ -226,7 +226,7 @@ function psb_zdotv(x, y,desc_a, info) info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -ione) then @@ -239,7 +239,7 @@ function psb_zdotv(x, y,desc_a, info) iy = ione jx = ione jy = ione - m = psb_get_global_rows(desc_a) + m = psb_cd_get_global_rows(desc_a) ! check vector correctness 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 if(m.ne.0) then - if(psb_get_local_rows(desc_a).gt.0) then - dot_local = zdotc(psb_get_local_rows(desc_a),& + if(psb_cd_get_local_rows(desc_a).gt.0) then + dot_local = zdotc(psb_cd_get_local_rows(desc_a),& & x,ione,y,ione) ! adjust dot_local because overlapped elements are computed more than once i=1 @@ -364,7 +364,7 @@ subroutine psb_zdotvs(res, x, y,desc_a, info) info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -ione) then @@ -375,7 +375,7 @@ subroutine psb_zdotvs(res, x, y,desc_a, info) ix = ione iy = ione - m = psb_get_global_rows(desc_a) + m = psb_cd_get_global_rows(desc_a) ! check vector correctness 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 if(m.ne.0) then - if(psb_get_local_rows(desc_a).gt.0) then - dot_local = zdotc(psb_get_local_rows(desc_a),& + if(psb_cd_get_local_rows(desc_a).gt.0) then + dot_local = zdotc(psb_cd_get_local_rows(desc_a),& & x,ione,y,ione) ! adjust dot_local because overlapped elements are computed more than once i=1 @@ -505,7 +505,7 @@ subroutine psb_zmdots(res, x, y, desc_a, info) info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -ione) then @@ -517,7 +517,7 @@ subroutine psb_zmdots(res, x, y, desc_a, info) ix = ione iy = ione - m = psb_get_global_rows(desc_a) + m = psb_cd_get_global_rows(desc_a) ! check vector correctness 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)) 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 - 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) ! adjust dot_local because overlapped elements are computed more than once i=1 diff --git a/src/psblas/psb_znrm2.f90 b/src/psblas/psb_znrm2.f90 index c886f22a..cba43e8a 100644 --- a/src/psblas/psb_znrm2.f90 +++ b/src/psblas/psb_znrm2.f90 @@ -69,7 +69,7 @@ function psb_znrm2(x, desc_a, info, jx) info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -85,7 +85,7 @@ function psb_znrm2(x, desc_a, info, jx) ijx = 1 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) if(info.ne.0) then @@ -101,8 +101,8 @@ function psb_znrm2(x, desc_a, info, jx) end if if(m.ne.0) then - if (psb_get_local_rows(desc_a) .gt. 0) then - ndim = psb_get_local_rows(desc_a) + if (psb_cd_get_local_rows(desc_a) .gt. 0) then + ndim = psb_cd_get_local_rows(desc_a) nrm2 = dznrm2( ndim, x(iix,jjx), ione ) i=1 do while (desc_a%ovrlap_elem(i) .ne. -1) @@ -206,7 +206,7 @@ function psb_znrm2v(x, desc_a, info) info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -218,7 +218,7 @@ function psb_znrm2v(x, desc_a, info) ix = 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) @@ -235,8 +235,8 @@ function psb_znrm2v(x, desc_a, info) end if if(m.ne.0) then - if (psb_get_local_rows(desc_a) .gt. 0) then - ndim = psb_get_local_rows(desc_a) + if (psb_cd_get_local_rows(desc_a) .gt. 0) then + ndim = psb_cd_get_local_rows(desc_a) nrm2 = dznrm2( ndim, x, ione ) i=1 do while (desc_a%ovrlap_elem(i) .ne. -1) @@ -342,7 +342,7 @@ subroutine psb_znrm2vs(res, x, desc_a, info) info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -353,7 +353,7 @@ subroutine psb_znrm2vs(res, x, desc_a, info) ix = 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) if(info.ne.0) then @@ -369,8 +369,8 @@ subroutine psb_znrm2vs(res, x, desc_a, info) end if if(m.ne.0) then - if (psb_get_local_rows(desc_a) .gt. 0) then - ndim = psb_get_local_rows(desc_a) + if (psb_cd_get_local_rows(desc_a) .gt. 0) then + ndim = psb_cd_get_local_rows(desc_a) nrm2 = dznrm2( ndim, x, ione ) i=1 do while (desc_a%ovrlap_elem(i) .ne. -1) diff --git a/src/psblas/psb_znrmi.f90 b/src/psblas/psb_znrmi.f90 index ad789284..8477a415 100644 --- a/src/psblas/psb_znrmi.f90 +++ b/src/psblas/psb_znrmi.f90 @@ -64,7 +64,7 @@ function psb_znrmi(a,desc_a,info) info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -75,8 +75,8 @@ function psb_znrmi(a,desc_a,info) ia = 1 ja = 1 - m = psb_get_global_rows(desc_a) - n = psb_get_global_cols(desc_a) + m = psb_cd_get_global_rows(desc_a) + n = psb_cd_get_global_cols(desc_a) call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja) if(info.ne.0) then @@ -93,8 +93,8 @@ function psb_znrmi(a,desc_a,info) end if if ((m.ne.0).and.(n.ne.0)) then - mdim = psb_get_local_rows(desc_a) - ndim = psb_get_local_cols(desc_a) + mdim = psb_cd_get_local_rows(desc_a) + ndim = psb_cd_get_local_cols(desc_a) nrmi = zcsnmi('N',mdim,ndim,a%fida,& & a%descra,a%aspk,a%ia1,a%ia2,& & a%infoa,info) diff --git a/src/psblas/psb_zspmm.f90 b/src/psblas/psb_zspmm.f90 index d02e2cdb..11fec125 100644 --- a/src/psblas/psb_zspmm.f90 +++ b/src/psblas/psb_zspmm.f90 @@ -117,7 +117,7 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,& info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -168,10 +168,10 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,& itrans = 'N' endif - m = psb_get_global_rows(desc_a) - n = psb_get_global_cols(desc_a) - nrow = psb_get_local_rows(desc_a) - ncol = psb_get_local_cols(desc_a) + m = psb_cd_get_global_rows(desc_a) + n = psb_cd_get_global_cols(desc_a) + nrow = psb_cd_get_local_rows(desc_a) + ncol = psb_cd_get_local_cols(desc_a) lldx = size(x,1) lldy = size(y,1) @@ -450,7 +450,7 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,& info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -486,10 +486,10 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,& itrans = 'N' endif - m = psb_get_global_rows(desc_a) - n = psb_get_global_cols(desc_a) - nrow = psb_get_local_rows(desc_a) - ncol = psb_get_local_cols(desc_a) + m = psb_cd_get_global_rows(desc_a) + n = psb_cd_get_global_cols(desc_a) + nrow = psb_cd_get_local_rows(desc_a) + ncol = psb_cd_get_local_cols(desc_a) lldx = size(x) lldy = size(y) diff --git a/src/psblas/psb_zspsm.f90 b/src/psblas/psb_zspsm.f90 index 13f5dba0..e242c42d 100644 --- a/src/psblas/psb_zspsm.f90 +++ b/src/psblas/psb_zspsm.f90 @@ -115,7 +115,7 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,& info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -178,9 +178,9 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,& itrans = 'N' endif - m = psb_get_global_rows(desc_a) - nrow = psb_get_local_rows(desc_a) - ncol = psb_get_local_cols(desc_a) + m = psb_cd_get_global_rows(desc_a) + nrow = psb_cd_get_local_rows(desc_a) + ncol = psb_cd_get_local_cols(desc_a) lldx = size(x,1) lldy = size(y,1) @@ -423,7 +423,7 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,& info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -466,9 +466,9 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,& itrans = 'N' endif - m = psb_get_global_rows(desc_a) - nrow = psb_get_local_rows(desc_a) - ncol = psb_get_local_cols(desc_a) + m = psb_cd_get_global_rows(desc_a) + nrow = psb_cd_get_local_rows(desc_a) + ncol = psb_cd_get_local_cols(desc_a) lldx = size(x) lldy = size(y) diff --git a/src/serial/Makefile b/src/serial/Makefile index b4f178ae..05e935b7 100644 --- a/src/serial/Makefile +++ b/src/serial/Makefile @@ -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_dfixcoo.o psb_dipcoo2csr.o psb_dipcsr2coo.o psb_dneigh.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_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_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_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 INCDIRS = -I ../../lib -I . diff --git a/src/serial/psb_dcoins.f90 b/src/serial/psb_dcoins.f90 index 1ba559dc..8c176489 100644 --- a/src/serial/psb_dcoins.f90 +++ b/src/serial/psb_dcoins.f90 @@ -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_string_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 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) goto 9999 end if - call psb_spinfo(psb_nztotreq_,a,nza,info) - call psb_spinfo(psb_nzsizereq_,a,isza,info) + call psb_sp_info(psb_nztotreq_,a,nza,info) + call psb_sp_info(psb_nzsizereq_,a,isza,info) if(info /= izero) then info=4010 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) goto 9999 endif - call psb_spinfo(psb_nztotreq_,a,nza,info) - call psb_spinfo(psb_nzsizereq_,a,isza,info) + call psb_sp_info(psb_nztotreq_,a,nza,info) + call psb_sp_info(psb_nzsizereq_,a,isza,info) if(info /= izero) then info=4010 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) goto 9999 end if - call psb_spinfo(psb_nztotreq_,a,nza,info) - call psb_spinfo(psb_nzsizereq_,a,isza,info) + call psb_sp_info(psb_nztotreq_,a,nza,info) + call psb_sp_info(psb_nzsizereq_,a,isza,info) if(info /= izero) then info=4010 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 endif call psb_sp_transfer(tmp,a,info) - call psb_spinfo(psb_nztotreq_,a,nza,info) - call psb_spinfo(psb_nzsizereq_,a,isza,info) + call psb_sp_info(psb_nztotreq_,a,nza,info) + call psb_sp_info(psb_nzsizereq_,a,isza,info) if(info /= izero) then info=4010 ch_err='psb_spinfo' diff --git a/src/serial/psb_dcsdp.f90 b/src/serial/psb_dcsdp.f90 index ed88634a..89d1cf76 100644 --- a/src/serial/psb_dcsdp.f90 +++ b/src/serial/psb_dcsdp.f90 @@ -78,17 +78,7 @@ subroutine psb_dcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl) end subroutine psb_cest end interface - interface psb_spinfo - 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' + name='psb_csdp' info = 0 call psb_erractionsave(err_act) @@ -180,7 +170,7 @@ subroutine psb_dcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl) ! ...matrix conversion... b%m=a%m 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 ! diff --git a/src/serial/psb_dspinfo.f90 b/src/serial/psb_dspinfo.f90 deleted file mode 100644 index 97b6be7c..00000000 --- a/src/serial/psb_dspinfo.f90 +++ /dev/null @@ -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 diff --git a/src/serial/psb_zcoins.f90 b/src/serial/psb_zcoins.f90 index f887dd80..ae756aaa 100644 --- a/src/serial/psb_zcoins.f90 +++ b/src/serial/psb_zcoins.f90 @@ -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_string_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 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) goto 9999 end if - call psb_spinfo(psb_nztotreq_,a,nza,info) - call psb_spinfo(psb_nzsizereq_,a,isza,info) + call psb_sp_info(psb_nztotreq_,a,nza,info) + call psb_sp_info(psb_nzsizereq_,a,isza,info) if(info /= izero) then info=4010 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) goto 9999 endif - call psb_spinfo(psb_nztotreq_,a,nza,info) - call psb_spinfo(psb_nzsizereq_,a,isza,info) + call psb_sp_info(psb_nztotreq_,a,nza,info) + call psb_sp_info(psb_nzsizereq_,a,isza,info) if(info /= izero) then info=4010 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) goto 9999 end if - call psb_spinfo(psb_nztotreq_,a,nza,info) - call psb_spinfo(psb_nzsizereq_,a,isza,info) + call psb_sp_info(psb_nztotreq_,a,nza,info) + call psb_sp_info(psb_nzsizereq_,a,isza,info) if(info /= izero) then info=4010 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 endif call psb_sp_transfer(tmp,a,info) - call psb_spinfo(psb_nztotreq_,a,nza,info) - call psb_spinfo(psb_nzsizereq_,a,isza,info) + call psb_sp_info(psb_nztotreq_,a,nza,info) + call psb_sp_info(psb_nzsizereq_,a,isza,info) if(info /= izero) then info=4010 ch_err='psb_spinfo' diff --git a/src/serial/psb_zcsdp.f90 b/src/serial/psb_zcsdp.f90 index 4baa20d6..b558945b 100644 --- a/src/serial/psb_zcsdp.f90 +++ b/src/serial/psb_zcsdp.f90 @@ -78,17 +78,7 @@ subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl) end subroutine psb_cest end interface - interface psb_spinfo - 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' + name='psb_csdp' info = 0 call psb_erractionsave(err_act) @@ -180,8 +170,8 @@ subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl) ! ...matrix conversion... b%m=a%m b%k=a%k - call psb_spinfo(psb_nztotreq_,a,size_req,info) - if (debug) write(0,*) 'DCSDP : size_req 1:',size_req,a%m,a%k + size_req = psb_sp_get_nnzeros(a) + if (debug) write(0,*) 'DCSDP : size_req 1:',size_req ! n_row=b%m diff --git a/src/serial/psb_zspinfo.f90 b/src/serial/psb_zspinfo.f90 deleted file mode 100644 index 8738c45b..00000000 --- a/src/serial/psb_zspinfo.f90 +++ /dev/null @@ -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 diff --git a/src/tools/psb_cdasb.f90 b/src/tools/psb_cdasb.f90 index 1d6d6e7e..f93b03c7 100644 --- a/src/tools/psb_cdasb.f90 +++ b/src/tools/psb_cdasb.f90 @@ -66,10 +66,10 @@ subroutine psb_cdasb(desc_a,info) call psb_erractionsave(err_act) - ictxt = psb_get_context(desc_a) - dectype = psb_get_dectype(desc_a) - n_row = psb_get_local_rows(desc_a) - n_col = psb_get_local_cols(desc_a) + ictxt = psb_cd_get_context(desc_a) + dectype = psb_cd_get_dectype(desc_a) + n_row = psb_cd_get_local_rows(desc_a) + n_col = psb_cd_get_local_cols(desc_a) ! check on blacs grid 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 (debug) write(0,*) 'psb_cdasb: Checking rows insertion' ! 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 info=3100 exit @@ -102,7 +102,7 @@ subroutine psb_cdasb(desc_a,info) call psb_errpush(info,name,i_err=int_err) goto 9999 endif - call psb_realloc(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%halo_index,halo_index,info) diff --git a/src/tools/psb_cdfree.f90 b/src/tools/psb_cdfree.f90 index 95373f46..113d6383 100644 --- a/src/tools/psb_cdfree.f90 +++ b/src/tools/psb_cdfree.f90 @@ -62,7 +62,7 @@ subroutine psb_cdfree(desc_a,info) return end if - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) deallocate(desc_a%matrix_data) call psb_info(ictxt, me, np) ! ....verify blacs grid correctness.. diff --git a/src/tools/psb_cdins.f90 b/src/tools/psb_cdins.f90 index a1ea21ce..5585c8cd 100644 --- a/src/tools/psb_cdins.f90 +++ b/src/tools/psb_cdins.f90 @@ -66,12 +66,12 @@ subroutine psb_cdins(nz,ia,ja,desc_a,info) name = 'psb_cdins' call psb_erractionsave(err_act) - ictxt = psb_get_context(desc_a) - dectype = psb_get_dectype(desc_a) - mglob = psb_get_global_rows(desc_a) - nglob = psb_get_global_cols(desc_a) - nrow = psb_get_local_rows(desc_a) - ncol = psb_get_local_cols(desc_a) + ictxt = psb_cd_get_context(desc_a) + dectype = psb_cd_get_dectype(desc_a) + mglob = psb_cd_get_global_rows(desc_a) + nglob = psb_cd_get_global_cols(desc_a) + nrow = psb_cd_get_local_rows(desc_a) + ncol = psb_cd_get_local_cols(desc_a) call psb_info(ictxt, me, np) diff --git a/src/tools/psb_cdren.f90 b/src/tools/psb_cdren.f90 index 7b8c936d..6a5af445 100644 --- a/src/tools/psb_cdren.f90 +++ b/src/tools/psb_cdren.f90 @@ -75,10 +75,10 @@ subroutine psb_cdren(trans,iperm,desc_a,info) time(1) = mpi_wtime() - ictxt=psb_get_context(desc_a) - dectype=psb_get_dectype(desc_a) - n_row = psb_get_local_rows(desc_a) - n_col = psb_get_local_cols(desc_a) + ictxt=psb_cd_get_context(desc_a) + dectype=psb_cd_get_dectype(desc_a) + n_row = psb_cd_get_local_rows(desc_a) + n_col = psb_cd_get_local_cols(desc_a) ! check on blacs grid 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 enddo 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) if (j>0) then desc_a%loc_to_glob(j) = i diff --git a/src/tools/psb_dallc.f90 b/src/tools/psb_dallc.f90 index fffd7de3..77f9519c 100644 --- a/src/tools/psb_dallc.f90 +++ b/src/tools/psb_dallc.f90 @@ -68,7 +68,7 @@ subroutine psb_dalloc(x, desc_a, info, n) int_err(1)=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -77,7 +77,7 @@ subroutine psb_dalloc(x, desc_a, info, n) goto 9999 endif - dectype=psb_get_dectype(desc_a) + dectype=psb_cd_get_dectype(desc_a) !... check m and n parameters.... if (.not.psb_is_ok_desc(desc_a)) then info = 3110 @@ -106,7 +106,7 @@ subroutine psb_dalloc(x, desc_a, info, n) !....allocate x ..... 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) if (info /= 0) then info=4010 @@ -120,7 +120,7 @@ subroutine psb_dalloc(x, desc_a, info, n) end do end do 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) if (info /= 0) then info=4010 @@ -213,7 +213,7 @@ subroutine psb_dallocv(x, desc_a,info,n) name='psb_dallcv' call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) ! ....verify blacs grid correctness.. @@ -223,7 +223,7 @@ subroutine psb_dallocv(x, desc_a,info,n) goto 9999 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: is_ok? dectype',psb_is_ok_desc(desc_a) !... check m and n parameters.... @@ -237,7 +237,7 @@ subroutine psb_dallocv(x, desc_a,info,n) !....allocate x ..... 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) if (info /= 0) then info=4010 @@ -250,7 +250,7 @@ subroutine psb_dallocv(x, desc_a,info,n) end do 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) if (info /= 0) then info=4010 diff --git a/src/tools/psb_dasb.f90 b/src/tools/psb_dasb.f90 index 25d3d47a..54728287 100644 --- a/src/tools/psb_dasb.f90 +++ b/src/tools/psb_dasb.f90 @@ -69,14 +69,14 @@ subroutine psb_dasb(x, desc_a, info) goto 9999 endif - ictxt=psb_get_context(desc_a) - dectype=psb_get_dectype(desc_a) + ictxt=psb_cd_get_context(desc_a) + dectype=psb_cd_get_dectype(desc_a) call psb_info(ictxt, me, np) if (debug) write(*,*) 'asb start: ',np,me,& - &psb_get_dectype(desc_a) + &psb_cd_get_dectype(desc_a) ! ....verify blacs grid correctness.. if (np == -1) then info = 2010 @@ -91,9 +91,9 @@ subroutine psb_dasb(x, desc_a, info) endif ! check size - ictxt=psb_get_context(desc_a) - nrow=psb_get_local_rows(desc_a) - ncol=psb_get_local_cols(desc_a) + ictxt=psb_cd_get_context(desc_a) + nrow=psb_cd_get_local_rows(desc_a) + ncol=psb_cd_get_local_cols(desc_a) i1sz = size(x,dim=1) i2sz = size(x,dim=2) if (debug) write(*,*) 'asb: ',i1sz,i2sz,nrow,ncol @@ -193,8 +193,8 @@ subroutine psb_dasbv(x, desc_a, info) int_err(1) = 0 name = 'psb_dasbv' - ictxt=psb_get_context(desc_a) - dectype=psb_get_dectype(desc_a) + ictxt=psb_cd_get_context(desc_a) + dectype=psb_cd_get_dectype(desc_a) call psb_info(ictxt, me, np) @@ -209,8 +209,8 @@ subroutine psb_dasbv(x, desc_a, info) goto 9999 endif - nrow=psb_get_local_rows(desc_a) - ncol=psb_get_local_cols(desc_a) + nrow=psb_cd_get_local_rows(desc_a) + ncol=psb_cd_get_local_cols(desc_a) if (debug) write(*,*) name,' sizes: ',nrow,ncol i1sz = size(x) if (debug) write(*,*) 'dasb: sizes ',i1sz,ncol diff --git a/src/tools/psb_dcdovr.f90 b/src/tools/psb_dcdovr.f90 index bcd67b54..cef4a852 100644 --- a/src/tools/psb_dcdovr.f90 +++ b/src/tools/psb_dcdovr.f90 @@ -101,15 +101,15 @@ Subroutine psb_dcdovr(a,desc_a,novr,desc_ov,info) info = 0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) Call psb_info(ictxt, me, np) 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) - n_col=psb_get_local_cols(desc_a) + n_col=psb_cd_get_local_cols(desc_a) nhalo = n_col-m If(debug) Write(0,*)'IN CDOVR1',novr ,m,nnzero,n_col 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 ! nonzeros per row is the same as the global. ! - call psb_spinfo(psb_nztotreq_,a,nztot,info) - if (info /= 0) then - info=4010 - ch_err='psb_spinfo' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if + nztot = psb_sp_get_nnzeros(a) if (nztot>0) then lovr = ((nztot+m-1)/m)*nhalo*novr lworks = ((nztot+m-1)/m)*nhalo diff --git a/src/tools/psb_dcdovrbld.f90 b/src/tools/psb_dcdovrbld.f90 index 748d4424..83777090 100644 --- a/src/tools/psb_dcdovrbld.f90 +++ b/src/tools/psb_dcdovrbld.f90 @@ -94,7 +94,7 @@ Subroutine psb_dcdovrbld(n_ovr,desc_p,desc_a,a,& call psb_erractionsave(err_act) If(debug) Write(0,*)'cdovrbld begin' - ictxt = psb_get_context(desc_a) + ictxt = psb_cd_get_context(desc_a) Call psb_info(ictxt,me,np) @@ -108,10 +108,10 @@ Subroutine psb_dcdovrbld(n_ovr,desc_p,desc_a,a,& t4 = 0.0 call psb_get_mpicomm(ictxt,icomm ) - mglob = psb_get_global_rows(desc_a) - m = psb_get_local_rows(desc_a) - n_row = psb_get_local_rows(desc_a) - n_col = psb_get_local_cols(desc_a) + mglob = psb_cd_get_global_rows(desc_a) + m = psb_cd_get_local_rows(desc_a) + n_row = psb_cd_get_local_rows(desc_a) + n_col = psb_cd_get_local_cols(desc_a) if (debug) write(0,*) me,' On entry to CDOVRBLD n_col:',n_col 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. ! If (i_ovr < (n_ovr)) Then - call psb_spinfo(psb_nzrowreq_,a,n_elem,info,iaux=idx) - if (info /= 0) then - info=4010 - ch_err='psb_spinfo' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if + n_elem = psb_sp_get_nnz_row(idx,a) If((idxs+tot_elem+n_elem) > lworks) Then 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 - call psb_spgtblk(idx,a,blk,info) + call psb_sp_getblk(idx,a,blk,info) if (info /= 0) then info=4010 - ch_err='psb_spgtblk' + ch_err='psb_sp_getblk' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if @@ -537,8 +531,8 @@ Subroutine psb_dcdovrbld(n_ovr,desc_p,desc_a,a,& End Do t1 = mpi_wtime() - desc_p%matrix_data(psb_m_)=psb_get_global_rows(desc_a) - desc_p%matrix_data(psb_n_)=psb_get_global_cols(desc_a) + desc_p%matrix_data(psb_m_)=psb_cd_get_global_rows(desc_a) + desc_p%matrix_data(psb_n_)=psb_cd_get_global_cols(desc_a) tmp_halo(counter_h)=-1 tmp_ovr_idx(counter_o)=-1 diff --git a/src/tools/psb_dcsrp.f90 b/src/tools/psb_dcsrp.f90 index 721b1f54..7000171a 100644 --- a/src/tools/psb_dcsrp.f90 +++ b/src/tools/psb_dcsrp.f90 @@ -89,10 +89,10 @@ subroutine psb_dcsrp(trans,iperm,a, desc_a, info) time(1) = mpi_wtime() - ictxt=psb_get_context(desc_a) - dectype=psb_get_dectype(desc_a) - n_row = psb_get_local_rows(desc_a) - n_col = psb_get_local_cols(desc_a) + ictxt=psb_cd_get_context(desc_a) + dectype=psb_cd_get_dectype(desc_a) + n_row = psb_cd_get_local_rows(desc_a) + n_col = psb_cd_get_local_cols(desc_a) if(psb_get_errstatus() /= 0) return info=0 diff --git a/src/tools/psb_dfree.f90 b/src/tools/psb_dfree.f90 index 4f54fd81..a056f123 100644 --- a/src/tools/psb_dfree.f90 +++ b/src/tools/psb_dfree.f90 @@ -65,7 +65,7 @@ subroutine psb_dfree(x, desc_a, info) goto 9999 end if - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) ! ....verify blacs grid correctness.. @@ -139,7 +139,7 @@ subroutine psb_dfreev(x, desc_a, info) call psb_errpush(info,name) return end if - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then diff --git a/src/tools/psb_dgelp.f90 b/src/tools/psb_dgelp.f90 index 4f04a7c5..077550c9 100644 --- a/src/tools/psb_dgelp.f90 +++ b/src/tools/psb_dgelp.f90 @@ -85,17 +85,17 @@ subroutine psb_dgelp(trans,iperm,x,desc_a,info) info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) - dectype=psb_get_dectype(desc_a) - nrow = psb_get_local_rows(desc_a) - ncol = psb_get_local_cols(desc_a) + ictxt=psb_cd_get_context(desc_a) + dectype=psb_cd_get_dectype(desc_a) + nrow = psb_cd_get_local_rows(desc_a) + ncol = psb_cd_get_local_cols(desc_a) i1sz = size(x,dim=1) i2sz = size(x,dim=2) call psb_info(ictxt, me, np) if (debug) write(*,*) 'asb start: ',np,me,& - &psb_get_dectype(desc_a) + &psb_cd_get_dectype(desc_a) ! ....verify blacs grid correctness.. if (np == -1) then info = 2010 @@ -231,10 +231,10 @@ subroutine psb_dgelpv(trans,iperm,x,desc_a,info) i1sz = size(x) - ictxt=psb_get_context(desc_a) - dectype=psb_get_dectype(desc_a) - nrow=psb_get_local_rows(desc_a) - ncol=psb_get_local_cols(desc_a) + ictxt=psb_cd_get_context(desc_a) + dectype=psb_cd_get_dectype(desc_a) + nrow=psb_cd_get_local_rows(desc_a) + ncol=psb_cd_get_local_cols(desc_a) call psb_info(ictxt, me, np) diff --git a/src/tools/psb_dins.f90 b/src/tools/psb_dins.f90 index c6e7f3ff..8c4334f7 100644 --- a/src/tools/psb_dins.f90 +++ b/src/tools/psb_dins.f90 @@ -82,7 +82,7 @@ subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl) return end if - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -100,10 +100,10 @@ subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl) goto 9999 else if (.not.psb_is_ok_desc(desc_a)) then 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) 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 int_err(1) = 5 int_err(2) = 4 @@ -111,9 +111,9 @@ subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl) goto 9999 endif - loc_rows=psb_get_local_rows(desc_a) - loc_cols=psb_get_local_cols(desc_a) - mglob = psb_get_global_rows(desc_a) + loc_rows=psb_cd_get_local_rows(desc_a) + loc_cols=psb_cd_get_local_cols(desc_a) + mglob = psb_cd_get_global_rows(desc_a) if (present(dupl)) then dupl_ = dupl @@ -265,7 +265,7 @@ subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl) return end if - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -283,10 +283,10 @@ subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl) goto 9999 else if (.not.psb_is_ok_desc(desc_a)) then 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) 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 int_err(1) = 5 int_err(2) = 4 @@ -294,9 +294,9 @@ subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl) goto 9999 endif - loc_rows=psb_get_local_rows(desc_a) - loc_cols=psb_get_local_cols(desc_a) - mglob = psb_get_global_rows(desc_a) + loc_rows=psb_cd_get_local_rows(desc_a) + loc_cols=psb_cd_get_local_cols(desc_a) + mglob = psb_cd_get_global_rows(desc_a) n = min(size(val,2),size(x,2)) diff --git a/src/tools/psb_dspalloc.f90 b/src/tools/psb_dspalloc.f90 index 125b80be..7d2ab7ba 100644 --- a/src/tools/psb_dspalloc.f90 +++ b/src/tools/psb_dspalloc.f90 @@ -68,8 +68,8 @@ subroutine psb_dspalloc(a, desc_a, info, nnz) call psb_erractionsave(err_act) name = 'psb_dspalloc' - ictxt = psb_get_context(desc_a) - dectype = psb_get_dectype(desc_a) + ictxt = psb_cd_get_context(desc_a) + dectype = psb_cd_get_dectype(desc_a) call psb_info(ictxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then @@ -85,9 +85,9 @@ subroutine psb_dspalloc(a, desc_a, info, nnz) ! check if psdalloc is already called for this matrix ! set fields in desc_a%matrix_data.... - loc_row = psb_get_local_rows(desc_a) - m = psb_get_global_rows(desc_a) - n = psb_get_global_cols(desc_a) + loc_row = psb_cd_get_local_rows(desc_a) + m = psb_cd_get_global_rows(desc_a) + n = psb_cd_get_global_cols(desc_a) !...allocate matrix data... if (present(nnz))then @@ -127,7 +127,7 @@ subroutine psb_dspalloc(a, desc_a, info, nnz) a%infoa(psb_state_) = psb_spmat_bld_ if (debug) write(0,*) 'spall: ', & - &psb_get_dectype(desc_a),psb_desc_bld_ + &psb_cd_get_dectype(desc_a),psb_desc_bld_ return diff --git a/src/tools/psb_dspasb.f90 b/src/tools/psb_dspasb.f90 index 8a9de62f..17a9fd80 100644 --- a/src/tools/psb_dspasb.f90 +++ b/src/tools/psb_dspasb.f90 @@ -76,10 +76,10 @@ subroutine psb_dspasb(a,desc_a, info, afmt, upd, dupl) name = 'psb_spasb' call psb_erractionsave(err_act) - ictxt = psb_get_context(desc_a) - dscstate = psb_get_dectype(desc_a) - n_row = psb_get_local_rows(desc_a) - n_col = psb_get_local_cols(desc_a) + ictxt = psb_cd_get_context(desc_a) + dscstate = psb_cd_get_dectype(desc_a) + n_row = psb_cd_get_local_rows(desc_a) + n_col = psb_cd_get_local_cols(desc_a) ! check on BLACS grid call psb_info(ictxt, me, np) @@ -106,8 +106,8 @@ subroutine psb_dspasb(a,desc_a, info, afmt, upd, dupl) ! First case: we come from a fresh build. ! - n_row = psb_get_local_rows(desc_a) - n_col = psb_get_local_cols(desc_a) + n_row = psb_cd_get_local_rows(desc_a) + n_col = psb_cd_get_local_cols(desc_a) ! ! Second step: handle the local matrix part. diff --git a/src/tools/psb_dspcnv.f90 b/src/tools/psb_dspcnv.f90 index 30919e8e..7d578f90 100644 --- a/src/tools/psb_dspcnv.f90 +++ b/src/tools/psb_dspcnv.f90 @@ -122,10 +122,10 @@ subroutine psb_dspcnv(a,b,desc_a,info) time(1) = mpi_wtime() - ictxt = psb_get_context(desc_a) - dectype = psb_get_dectype(desc_a) - n_row = psb_get_local_rows(desc_a) - n_col = psb_get_local_cols(desc_a) + ictxt = psb_cd_get_context(desc_a) + dectype = psb_cd_get_dectype(desc_a) + n_row = psb_cd_get_local_rows(desc_a) + n_col = psb_cd_get_local_cols(desc_a) ! check on blacs grid call psb_info(ictxt, me, np) diff --git a/src/tools/psb_dspfree.f90 b/src/tools/psb_dspfree.f90 index f06f13e4..978a025c 100644 --- a/src/tools/psb_dspfree.f90 +++ b/src/tools/psb_dspfree.f90 @@ -65,7 +65,7 @@ subroutine psb_dspfree(a, desc_a,info) call psb_errpush(info,name) return else - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) end if !...deallocate a.... diff --git a/src/tools/psb_dsphalo.f90 b/src/tools/psb_dsphalo.f90 index 30737cfc..0fd34575 100644 --- a/src/tools/psb_dsphalo.f90 +++ b/src/tools/psb_dsphalo.f90 @@ -100,7 +100,7 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rwcnv,clcnv,outfmt) outfmt_ = 'CSR' endif - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) Call psb_info(ictxt, me, np) t1 = mpi_wtime() @@ -139,14 +139,7 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rwcnv,clcnv,outfmt) tot_elem = 0 Do j=0,n_el_send-1 idx = desc_a%halo_index(counter+psb_elem_send_+j) - call psb_spinfo(psb_nzrowreq_,a,n_elem,info,iaux=idx) - if (info /= 0) then - info=4010 - ch_err='psb_spinfo' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - + n_elem = psb_sp_get_nnz_row(idx,a) tot_elem = tot_elem+n_elem Enddo 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 idx = desc_a%halo_index(counter+psb_elem_send_+j) - call psb_spinfo(psb_nzrowreq_,a,n_elem,info,iaux=idx) - if (info /= 0) then - info=4010 - 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.) + n_elem = psb_sp_get_nnz_row(idx,a) + + call psb_sp_getblk(idx,a,tmp,info,append=.true.) if (info /= 0) then info=4010 - ch_err='psb_spgtblk' + ch_err='psb_sp_getblk' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if diff --git a/src/tools/psb_dspins.f90 b/src/tools/psb_dspins.f90 index 4b8c3bcd..03619411 100644 --- a/src/tools/psb_dspins.f90 +++ b/src/tools/psb_dspins.f90 @@ -86,9 +86,9 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild) call psb_erractionsave(err_act) - ictxt = psb_get_context(desc_a) - dectype = psb_get_dectype(desc_a) - mglob = psb_get_global_rows(desc_a) + ictxt = psb_cd_get_context(desc_a) + dectype = psb_cd_get_dectype(desc_a) + mglob = psb_cd_get_global_rows(desc_a) 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) goto 9999 end if - nrow = psb_get_local_rows(desc_a) - ncol = psb_get_local_cols(desc_a) + nrow = psb_cd_get_local_rows(desc_a) + ncol = psb_cd_get_local_cols(desc_a) if (spstate == psb_spmat_bld_) then call psb_coins(nz,ia,ja,val,a,1,nrow,1,ncol,info,gtl=desc_a%glob_to_loc) @@ -152,8 +152,8 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild) goto 9999 end if else if (psb_is_asb_desc(desc_a)) then - nrow = psb_get_local_rows(desc_a) - ncol = psb_get_local_cols(desc_a) + nrow = psb_cd_get_local_rows(desc_a) + ncol = psb_cd_get_local_cols(desc_a) call psb_coins(nz,ia,ja,val,a,1,nrow,1,ncol,& & info,gtl=desc_a%glob_to_loc,rebuild=rebuild_) if (info /= 0) then diff --git a/src/tools/psb_dsprn.f90 b/src/tools/psb_dsprn.f90 index cb4cdcdf..53dc0a66 100644 --- a/src/tools/psb_dsprn.f90 +++ b/src/tools/psb_dsprn.f90 @@ -69,7 +69,7 @@ Subroutine psb_dsprn(a, desc_a,info,clear) name = 'psb_dsprn' call psb_erractionsave(err_act) - ictxt = psb_get_context(desc_a) + ictxt = psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (debug) & &write(*,*) 'starting spalloc ',ictxt,np,me diff --git a/src/tools/psb_glob_to_loc.f90 b/src/tools/psb_glob_to_loc.f90 index 0227edaa..4fa6c273 100644 --- a/src/tools/psb_glob_to_loc.f90 +++ b/src/tools/psb_glob_to_loc.f90 @@ -79,28 +79,28 @@ subroutine psb_glob_to_loc2(x,y,desc_a,info,iact) n=size(x) do i=1,n - if ((x(i).gt.psb_get_global_rows(desc_a)).or.& + if ((x(i).gt.psb_cd_get_global_rows(desc_a)).or.& & (x(i).le.zero)) 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 info=140 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 end if else 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 else if (tmp.le.zero) then info = 150 int_err(1)=tmp 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 int_err(1)=tmp - int_err(2)=psb_get_local_cols(desc_a) + int_err(2)=psb_cd_get_local_cols(desc_a) exit end if end if @@ -213,28 +213,28 @@ subroutine psb_glob_to_loc(x,desc_a,info,iact) real_val = 0.d0 n=size(x) do i=1,n - if ((x(i).gt.psb_get_global_rows(desc_a)).or.& + if ((x(i).gt.psb_cd_get_global_rows(desc_a)).or.& & (x(i).le.zero)) 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 info=140 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 end if else 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 else if (tmp.le.zero) then info = 150 int_err(1)=tmp 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 int_err(1)=tmp - int_err(2)=psb_get_local_cols(desc_a) + int_err(2)=psb_cd_get_local_cols(desc_a) exit end if end if diff --git a/src/tools/psb_ialloc.f90 b/src/tools/psb_ialloc.f90 index d3347f2c..669117bc 100644 --- a/src/tools/psb_ialloc.f90 +++ b/src/tools/psb_ialloc.f90 @@ -65,7 +65,7 @@ subroutine psb_ialloc(x, desc_a, info, n) name='psb_ialloc' call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -74,7 +74,7 @@ subroutine psb_ialloc(x, desc_a, info, n) goto 9999 endif - dectype=psb_get_dectype(desc_a) + dectype=psb_cd_get_dectype(desc_a) !... check m and n parameters.... if (.not.psb_is_ok_desc(desc_a)) then info = 3110 @@ -103,7 +103,7 @@ subroutine psb_ialloc(x, desc_a, info, n) !....allocate x ..... 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) if (info /= 0) then info=4010 @@ -117,7 +117,7 @@ subroutine psb_ialloc(x, desc_a, info, n) end do end do 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) if (info /= 0) then info=4010 @@ -213,7 +213,7 @@ subroutine psb_iallocv(x, desc_a, info,n) name='psb_iallocv' call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) ! ....verify blacs grid correctness.. @@ -223,7 +223,7 @@ subroutine psb_iallocv(x, desc_a, info,n) goto 9999 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: is_ok? dectype',psb_is_ok_desc(desc_a) !... check m and n parameters.... @@ -237,7 +237,7 @@ subroutine psb_iallocv(x, desc_a, info,n) !....allocate x ..... 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) if (info.ne.0) then info=2025 @@ -246,7 +246,7 @@ subroutine psb_iallocv(x, desc_a, info,n) goto 9999 endif 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) if (info.ne.0) then info=2025 diff --git a/src/tools/psb_iasb.f90 b/src/tools/psb_iasb.f90 index 6df35b7b..018fdba4 100644 --- a/src/tools/psb_iasb.f90 +++ b/src/tools/psb_iasb.f90 @@ -68,14 +68,14 @@ subroutine psb_iasb(x, desc_a, info) return endif - ictxt=psb_get_context(desc_a) - dectype=psb_get_dectype(desc_a) + ictxt=psb_cd_get_context(desc_a) + dectype=psb_cd_get_dectype(desc_a) call psb_info(ictxt, me, np) if (debug) write(*,*) 'asb start: ',np,me,& - &psb_get_dectype(desc_a) + &psb_cd_get_dectype(desc_a) ! ....verify blacs grid correctness.. if (np == -1) then info = 2010 @@ -90,9 +90,9 @@ subroutine psb_iasb(x, desc_a, info) endif ! check size - ictxt=psb_get_context(desc_a) - nrow=psb_get_local_rows(desc_a) - ncol=psb_get_local_cols(desc_a) + ictxt=psb_cd_get_context(desc_a) + nrow=psb_cd_get_local_rows(desc_a) + ncol=psb_cd_get_local_cols(desc_a) i1sz = size(x,dim=1) i2sz = size(x,dim=2) if (debug) write(*,*) 'asb: ',i1sz,i2sz,nrow,ncol @@ -187,8 +187,8 @@ subroutine psb_iasbv(x, desc_a, info) name = 'psb_iasbv' - ictxt=psb_get_context(desc_a) - dectype=psb_get_dectype(desc_a) + ictxt=psb_cd_get_context(desc_a) + dectype=psb_cd_get_dectype(desc_a) call psb_info(ictxt, me, np) @@ -203,8 +203,8 @@ subroutine psb_iasbv(x, desc_a, info) goto 9999 endif - nrow=psb_get_local_rows(desc_a) - ncol=psb_get_local_cols(desc_a) + nrow=psb_cd_get_local_rows(desc_a) + ncol=psb_cd_get_local_cols(desc_a) if (debug) write(*,*) name,' sizes: ',nrow,ncol i1sz = size(x) if (debug) write(*,*) 'dasb: sizes ',i1sz,ncol diff --git a/src/tools/psb_ifree.f90 b/src/tools/psb_ifree.f90 index e6995cf3..ffa0ec55 100644 --- a/src/tools/psb_ifree.f90 +++ b/src/tools/psb_ifree.f90 @@ -66,7 +66,7 @@ subroutine psb_ifree(x, desc_a, info) return end if - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) ! ....verify blacs grid correctness.. @@ -170,7 +170,7 @@ subroutine psb_ifreev(x, desc_a,info) call psb_errpush(info,name) return end if - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) ! ....verify blacs grid correctness.. diff --git a/src/tools/psb_iins.f90 b/src/tools/psb_iins.f90 index b03dd75a..55cfc063 100644 --- a/src/tools/psb_iins.f90 +++ b/src/tools/psb_iins.f90 @@ -82,7 +82,7 @@ subroutine psb_iinsvi(m, irw, val, x, desc_a, info, dupl) return end if - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -100,10 +100,10 @@ subroutine psb_iinsvi(m, irw, val, x, desc_a, info, dupl) goto 9999 else if (.not.psb_is_ok_desc(desc_a)) then 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) 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 int_err(1) = 5 int_err(2) = 4 @@ -111,9 +111,9 @@ subroutine psb_iinsvi(m, irw, val, x, desc_a, info, dupl) goto 9999 endif - loc_rows=psb_get_local_rows(desc_a) - loc_cols=psb_get_local_cols(desc_a) - mglob = psb_get_global_rows(desc_a) + loc_rows=psb_cd_get_local_rows(desc_a) + loc_cols=psb_cd_get_local_cols(desc_a) + mglob = psb_cd_get_global_rows(desc_a) if (present(dupl)) then dupl_ = dupl @@ -263,7 +263,7 @@ subroutine psb_iinsi(m,irw, val, x, desc_a, info, dupl) return end if - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -281,10 +281,10 @@ subroutine psb_iinsi(m,irw, val, x, desc_a, info, dupl) goto 9999 else if (.not.psb_is_ok_desc(desc_a)) then 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) 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 int_err(1) = 5 int_err(2) = 4 @@ -292,9 +292,9 @@ subroutine psb_iinsi(m,irw, val, x, desc_a, info, dupl) goto 9999 endif - loc_rows=psb_get_local_rows(desc_a) - loc_cols=psb_get_local_cols(desc_a) - mglob = psb_get_global_rows(desc_a) + loc_rows=psb_cd_get_local_rows(desc_a) + loc_cols=psb_cd_get_local_cols(desc_a) + mglob = psb_cd_get_global_rows(desc_a) n = min(size(val,2),size(x,2)) diff --git a/src/tools/psb_loc_to_glob.f90 b/src/tools/psb_loc_to_glob.f90 index daa7a946..5da2598d 100644 --- a/src/tools/psb_loc_to_glob.f90 +++ b/src/tools/psb_loc_to_glob.f90 @@ -79,20 +79,20 @@ subroutine psb_loc_to_glob2(x,y,desc_a,info,iact) n=size(x) do i=1,n - if ((x(i).gt.psb_get_local_cols(desc_a)).or.& + if ((x(i).gt.psb_cd_get_local_cols(desc_a)).or.& & (x(i).le.zero)) then info=140 int_err(1)=tmp - int_err(2)=psb_get_local_cols(desc_a) + int_err(2)=psb_cd_get_local_cols(desc_a) exit else 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 else info = 140 int_err(1)=tmp - int_err(2)=psb_get_local_cols(desc_a) + int_err(2)=psb_cd_get_local_cols(desc_a) exit end if end if @@ -204,15 +204,15 @@ subroutine psb_loc_to_glob(x,desc_a,info,iact) n=size(x) do i=1,n - if ((x(i).gt.psb_get_local_cols(desc_a)).or.& + if ((x(i).gt.psb_cd_get_local_cols(desc_a)).or.& & (x(i).le.zero)) then info=140 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 else 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 else info = 140 diff --git a/src/tools/psb_zallc.f90 b/src/tools/psb_zallc.f90 index 358b816a..96faa1e3 100644 --- a/src/tools/psb_zallc.f90 +++ b/src/tools/psb_zallc.f90 @@ -67,7 +67,7 @@ subroutine psb_zalloc(x, desc_a, info, n) int_err(1)=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -76,7 +76,7 @@ subroutine psb_zalloc(x, desc_a, info, n) goto 9999 endif - dectype=psb_get_dectype(desc_a) + dectype=psb_cd_get_dectype(desc_a) !... check m and n parameters.... if (.not.psb_is_ok_desc(desc_a)) then info = 3110 @@ -105,7 +105,7 @@ subroutine psb_zalloc(x, desc_a, info, n) !....allocate x ..... 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) if (info /= 0) then info=4010 @@ -119,7 +119,7 @@ subroutine psb_zalloc(x, desc_a, info, n) end do end do 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) if (info /= 0) then info=4010 @@ -212,7 +212,7 @@ subroutine psb_zallocv(x, desc_a,info,n) name='psb_zallcv' call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) ! ....verify blacs grid correctness.. @@ -222,7 +222,7 @@ subroutine psb_zallocv(x, desc_a,info,n) goto 9999 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: is_ok? dectype',psb_is_ok_desc(desc_a) !... check m and n parameters.... @@ -236,7 +236,7 @@ subroutine psb_zallocv(x, desc_a,info,n) !....allocate x ..... 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) if (info /= 0) then info=4010 @@ -249,7 +249,7 @@ subroutine psb_zallocv(x, desc_a,info,n) end do 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) if (info /= 0) then info=4010 diff --git a/src/tools/psb_zasb.f90 b/src/tools/psb_zasb.f90 index c9e3b990..c347c78e 100644 --- a/src/tools/psb_zasb.f90 +++ b/src/tools/psb_zasb.f90 @@ -68,14 +68,14 @@ subroutine psb_zasb(x, desc_a, info) goto 9999 endif - ictxt=psb_get_context(desc_a) - dectype=psb_get_dectype(desc_a) + ictxt=psb_cd_get_context(desc_a) + dectype=psb_cd_get_dectype(desc_a) call psb_info(ictxt, me, np) if (debug) write(*,*) 'asb start: ',np,me,& - &psb_get_dectype(desc_a) + &psb_cd_get_dectype(desc_a) ! ....verify blacs grid correctness.. if (np == -1) then info = 2010 @@ -90,9 +90,9 @@ subroutine psb_zasb(x, desc_a, info) endif ! check size - ictxt=psb_get_context(desc_a) - nrow=psb_get_local_rows(desc_a) - ncol=psb_get_local_cols(desc_a) + ictxt=psb_cd_get_context(desc_a) + nrow=psb_cd_get_local_rows(desc_a) + ncol=psb_cd_get_local_cols(desc_a) i1sz = size(x,dim=1) i2sz = size(x,dim=2) if (debug) write(*,*) 'asb: ',i1sz,i2sz,nrow,ncol @@ -191,8 +191,8 @@ subroutine psb_zasbv(x, desc_a, info) int_err(1) = 0 name = 'psb_zasbv' - ictxt=psb_get_context(desc_a) - dectype=psb_get_dectype(desc_a) + ictxt=psb_cd_get_context(desc_a) + dectype=psb_cd_get_dectype(desc_a) call psb_info(ictxt, me, np) @@ -207,8 +207,8 @@ subroutine psb_zasbv(x, desc_a, info) goto 9999 endif - nrow=psb_get_local_rows(desc_a) - ncol=psb_get_local_cols(desc_a) + nrow=psb_cd_get_local_rows(desc_a) + ncol=psb_cd_get_local_cols(desc_a) if (debug) write(*,*) name,' sizes: ',nrow,ncol i1sz = size(x) if (debug) write(*,*) 'dasb: sizes ',i1sz,ncol diff --git a/src/tools/psb_zcdovr.f90 b/src/tools/psb_zcdovr.f90 index 450386e8..35f2c028 100644 --- a/src/tools/psb_zcdovr.f90 +++ b/src/tools/psb_zcdovr.f90 @@ -101,15 +101,15 @@ Subroutine psb_zcdovr(a,desc_a,novr,desc_ov,info) info = 0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) Call psb_info(ictxt, me, np) 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) - n_col=psb_get_local_cols(desc_a) + n_col=psb_cd_get_local_cols(desc_a) nhalo = n_col-m If(debug) Write(0,*)'IN CDOVR1',novr ,m,nnzero,n_col 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 ! nonzeros per row is the same as the global. ! - call psb_spinfo(psb_nztotreq_,a,nztot,info) - if (info /= 0) then - info=4010 - ch_err='psb_spinfo' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if + nztot = psb_sp_get_nnzeros(a) if (nztot>0) then lovr = ((nztot+m-1)/m)*nhalo*novr lworks = ((nztot+m-1)/m)*nhalo diff --git a/src/tools/psb_zcdovrbld.f90 b/src/tools/psb_zcdovrbld.f90 index c5d60070..08ee06bf 100644 --- a/src/tools/psb_zcdovrbld.f90 +++ b/src/tools/psb_zcdovrbld.f90 @@ -94,7 +94,7 @@ Subroutine psb_zcdovrbld(n_ovr,desc_p,desc_a,a,& call psb_erractionsave(err_act) If(debug) Write(0,*)'cdovrbld begin' - ictxt = psb_get_context(desc_a) + ictxt = psb_cd_get_context(desc_a) Call psb_info(ictxt,me,np) @@ -108,10 +108,10 @@ Subroutine psb_zcdovrbld(n_ovr,desc_p,desc_a,a,& t4 = 0.0 call psb_get_mpicomm(ictxt,icomm ) - mglob = psb_get_global_rows(desc_a) - m = psb_get_local_rows(desc_a) - n_row = psb_get_local_rows(desc_a) - n_col = psb_get_local_cols(desc_a) + mglob = psb_cd_get_global_rows(desc_a) + m = psb_cd_get_local_rows(desc_a) + n_row = psb_cd_get_local_rows(desc_a) + n_col = psb_cd_get_local_cols(desc_a) if (debug) write(0,*) me,' On entry to CDOVRBLD n_col:',n_col dl_lda=np*5 @@ -306,13 +306,7 @@ Subroutine psb_zcdovrbld(n_ovr,desc_p,desc_a,a,& ! Prepare to exchange the halo rows with the other proc. ! If (i_ovr < (n_ovr)) Then - call psb_spinfo(psb_nzrowreq_,a,n_elem,info,iaux=idx) - if (info /= 0) then - info=4010 - ch_err='psb_spinfo' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if + n_elem = psb_sp_get_nnz_row(idx,a) If((idxs+tot_elem+n_elem) > lworks) Then isz = max((3*lworks)/2,(idxs+tot_elem+n_elem)) @@ -339,10 +333,10 @@ Subroutine psb_zcdovrbld(n_ovr,desc_p,desc_a,a,& end if End If - call psb_spgtblk(idx,a,blk,info) + call psb_sp_getblk(idx,a,blk,info) if (info /= 0) then info=4010 - ch_err='psb_spgtblk' + ch_err='psb_sp_getblk' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if @@ -537,8 +531,8 @@ Subroutine psb_zcdovrbld(n_ovr,desc_p,desc_a,a,& End Do t1 = mpi_wtime() - desc_p%matrix_data(psb_m_)=psb_get_global_rows(desc_a) - desc_p%matrix_data(psb_n_)=psb_get_global_cols(desc_a) + desc_p%matrix_data(psb_m_)=psb_cd_get_global_rows(desc_a) + desc_p%matrix_data(psb_n_)=psb_cd_get_global_cols(desc_a) tmp_halo(counter_h)=-1 tmp_ovr_idx(counter_o)=-1 diff --git a/src/tools/psb_zcsrp.f90 b/src/tools/psb_zcsrp.f90 index 552b568c..8a39a504 100644 --- a/src/tools/psb_zcsrp.f90 +++ b/src/tools/psb_zcsrp.f90 @@ -88,10 +88,10 @@ subroutine psb_zcsrp(trans,iperm,a, desc_a, info) time(1) = mpi_wtime() - ictxt=psb_get_context(desc_a) - dectype=psb_get_dectype(desc_a) - n_row = psb_get_local_rows(desc_a) - n_col = psb_get_local_cols(desc_a) + ictxt=psb_cd_get_context(desc_a) + dectype=psb_cd_get_dectype(desc_a) + n_row = psb_cd_get_local_rows(desc_a) + n_col = psb_cd_get_local_cols(desc_a) if(psb_get_errstatus() /= 0) return info=0 diff --git a/src/tools/psb_zfree.f90 b/src/tools/psb_zfree.f90 index f106af33..9d4cc817 100644 --- a/src/tools/psb_zfree.f90 +++ b/src/tools/psb_zfree.f90 @@ -65,7 +65,7 @@ subroutine psb_zfree(x, desc_a, info) return end if - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) ! ....verify blacs grid correctness.. @@ -141,7 +141,7 @@ subroutine psb_zfreev(x, desc_a, info) call psb_errpush(info,name) goto 9999 end if - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then diff --git a/src/tools/psb_zgelp.f90 b/src/tools/psb_zgelp.f90 index 7bfbacd9..e99efd9f 100644 --- a/src/tools/psb_zgelp.f90 +++ b/src/tools/psb_zgelp.f90 @@ -86,17 +86,17 @@ subroutine psb_zgelp(trans,iperm,x,desc_a,info) info=0 call psb_erractionsave(err_act) - ictxt=psb_get_context(desc_a) - dectype=psb_get_dectype(desc_a) - nrow = psb_get_local_rows(desc_a) - ncol = psb_get_local_cols(desc_a) + ictxt=psb_cd_get_context(desc_a) + dectype=psb_cd_get_dectype(desc_a) + nrow = psb_cd_get_local_rows(desc_a) + ncol = psb_cd_get_local_cols(desc_a) i1sz = size(x,dim=1) i2sz = size(x,dim=2) call psb_info(ictxt, me, np) if (debug) write(*,*) 'asb start: ',np,me,& - &psb_get_dectype(desc_a) + &psb_cd_get_dectype(desc_a) ! ....verify blacs grid correctness.. if (np == -1) then info = 2010 @@ -232,10 +232,10 @@ subroutine psb_zgelpv(trans,iperm,x,desc_a,info) i1sz = size(x) - ictxt=psb_get_context(desc_a) - dectype=psb_get_dectype(desc_a) - nrow=psb_get_local_rows(desc_a) - ncol=psb_get_local_cols(desc_a) + ictxt=psb_cd_get_context(desc_a) + dectype=psb_cd_get_dectype(desc_a) + nrow=psb_cd_get_local_rows(desc_a) + ncol=psb_cd_get_local_cols(desc_a) call psb_info(ictxt, me, np) diff --git a/src/tools/psb_zins.f90 b/src/tools/psb_zins.f90 index 9c3f8171..555bde5d 100644 --- a/src/tools/psb_zins.f90 +++ b/src/tools/psb_zins.f90 @@ -83,7 +83,7 @@ subroutine psb_zinsvi(m, irw, val, x, desc_a, info, dupl) return end if - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -101,10 +101,10 @@ subroutine psb_zinsvi(m, irw, val, x, desc_a, info, dupl) goto 9999 else if (.not.psb_is_ok_desc(desc_a)) then 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) 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 int_err(1) = 5 int_err(2) = 4 @@ -112,9 +112,9 @@ subroutine psb_zinsvi(m, irw, val, x, desc_a, info, dupl) goto 9999 endif - loc_rows=psb_get_local_rows(desc_a) - loc_cols=psb_get_local_cols(desc_a) - mglob = psb_get_global_rows(desc_a) + loc_rows=psb_cd_get_local_rows(desc_a) + loc_cols=psb_cd_get_local_cols(desc_a) + mglob = psb_cd_get_global_rows(desc_a) if (present(dupl)) then dupl_ = dupl @@ -264,7 +264,7 @@ subroutine psb_zinsi(m,irw, val, x, desc_a, info, dupl) return end if - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -282,10 +282,10 @@ subroutine psb_zinsi(m,irw, val, x, desc_a, info, dupl) goto 9999 else if (.not.psb_is_ok_desc(desc_a)) then 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) 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 int_err(1) = 5 int_err(2) = 4 @@ -293,9 +293,9 @@ subroutine psb_zinsi(m,irw, val, x, desc_a, info, dupl) goto 9999 endif - loc_rows=psb_get_local_rows(desc_a) - loc_cols=psb_get_local_cols(desc_a) - mglob = psb_get_global_rows(desc_a) + loc_rows=psb_cd_get_local_rows(desc_a) + loc_cols=psb_cd_get_local_cols(desc_a) + mglob = psb_cd_get_global_rows(desc_a) n = min(size(val,2),size(x,2)) diff --git a/src/tools/psb_zspalloc.f90 b/src/tools/psb_zspalloc.f90 index 07e348bc..65e0bf15 100644 --- a/src/tools/psb_zspalloc.f90 +++ b/src/tools/psb_zspalloc.f90 @@ -68,8 +68,8 @@ subroutine psb_zspalloc(a, desc_a, info, nnz) call psb_erractionsave(err_act) name = 'psb_zspalloc' - ictxt = psb_get_context(desc_a) - dectype = psb_get_dectype(desc_a) + ictxt = psb_cd_get_context(desc_a) + dectype = psb_cd_get_dectype(desc_a) call psb_info(ictxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then @@ -85,9 +85,9 @@ subroutine psb_zspalloc(a, desc_a, info, nnz) ! check if psdalloc is already called for this matrix ! set fields in desc_a%matrix_data.... - loc_row = psb_get_local_rows(desc_a) - m = psb_get_global_rows(desc_a) - n = psb_get_global_cols(desc_a) + loc_row = psb_cd_get_local_rows(desc_a) + m = psb_cd_get_global_rows(desc_a) + n = psb_cd_get_global_cols(desc_a) !...allocate matrix data... if (present(nnz))then @@ -127,7 +127,7 @@ subroutine psb_zspalloc(a, desc_a, info, nnz) a%infoa(psb_state_) = psb_spmat_bld_ if (debug) write(0,*) 'spall: ', & - &psb_get_dectype(desc_a),psb_desc_bld_ + &psb_cd_get_dectype(desc_a),psb_desc_bld_ return diff --git a/src/tools/psb_zspasb.f90 b/src/tools/psb_zspasb.f90 index 266679c5..33e7324f 100644 --- a/src/tools/psb_zspasb.f90 +++ b/src/tools/psb_zspasb.f90 @@ -76,10 +76,10 @@ subroutine psb_zspasb(a,desc_a, info, afmt, upd, dupl) name = 'psb_spasb' call psb_erractionsave(err_act) - ictxt = psb_get_context(desc_a) - dscstate = psb_get_dectype(desc_a) - n_row = psb_get_local_rows(desc_a) - n_col = psb_get_local_cols(desc_a) + ictxt = psb_cd_get_context(desc_a) + dscstate = psb_cd_get_dectype(desc_a) + n_row = psb_cd_get_local_rows(desc_a) + n_col = psb_cd_get_local_cols(desc_a) ! check on BLACS grid call psb_info(ictxt, me, np) @@ -106,8 +106,8 @@ subroutine psb_zspasb(a,desc_a, info, afmt, upd, dupl) ! First case: we come from a fresh build. ! - n_row = psb_get_local_rows(desc_a) - n_col = psb_get_local_cols(desc_a) + n_row = psb_cd_get_local_rows(desc_a) + n_col = psb_cd_get_local_cols(desc_a) ! ! Second step: handle the local matrix part. diff --git a/src/tools/psb_zspcnv.f90 b/src/tools/psb_zspcnv.f90 index add0b783..4ca55a95 100644 --- a/src/tools/psb_zspcnv.f90 +++ b/src/tools/psb_zspcnv.f90 @@ -123,10 +123,10 @@ subroutine psb_zspcnv(a,b,desc_a,info) time(1) = mpi_wtime() - ictxt = psb_get_context(desc_a) - dectype = psb_get_dectype(desc_a) - n_row = psb_get_local_rows(desc_a) - n_col = psb_get_local_cols(desc_a) + ictxt = psb_cd_get_context(desc_a) + dectype = psb_cd_get_dectype(desc_a) + n_row = psb_cd_get_local_rows(desc_a) + n_col = psb_cd_get_local_cols(desc_a) ! check on blacs grid call psb_info(ictxt, me, np) diff --git a/src/tools/psb_zspfree.f90 b/src/tools/psb_zspfree.f90 index 9ee96709..dd9d0aff 100644 --- a/src/tools/psb_zspfree.f90 +++ b/src/tools/psb_zspfree.f90 @@ -65,7 +65,7 @@ subroutine psb_zspfree(a, desc_a,info) call psb_errpush(info,name) return else - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) end if !...deallocate a.... diff --git a/src/tools/psb_zsphalo.f90 b/src/tools/psb_zsphalo.f90 index 739be6a8..aa7aa483 100644 --- a/src/tools/psb_zsphalo.f90 +++ b/src/tools/psb_zsphalo.f90 @@ -100,7 +100,7 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rwcnv,clcnv,outfmt) outfmt_ = 'CSR' endif - ictxt=psb_get_context(desc_a) + ictxt=psb_cd_get_context(desc_a) Call psb_info(ictxt, me, np) t1 = mpi_wtime() @@ -139,14 +139,7 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rwcnv,clcnv,outfmt) tot_elem = 0 Do j=0,n_el_send-1 idx = desc_a%halo_index(counter+psb_elem_send_+j) - call psb_spinfo(psb_nzrowreq_,a,n_elem,info,iaux=idx) - if (info /= 0) then - info=4010 - ch_err='psb_spinfo' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - + n_elem = psb_sp_get_nnz_row(idx,a) tot_elem = tot_elem+n_elem Enddo sdsz(proc+1) = tot_elem @@ -215,18 +208,12 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rwcnv,clcnv,outfmt) Do j=0,n_el_send-1 idx = desc_a%halo_index(counter+psb_elem_send_+j) - call psb_spinfo(psb_nzrowreq_,a,n_elem,info,iaux=idx) - if (info /= 0) then - info=4010 - 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.) + n_elem = psb_sp_get_nnz_row(idx,a) + + call psb_sp_getblk(idx,a,tmp,info,append=.true.) if (info /= 0) then info=4010 - ch_err='psb_spgtblk' + ch_err='psb_sp_getblk' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if diff --git a/src/tools/psb_zspins.f90 b/src/tools/psb_zspins.f90 index 98f9ecdd..262bd414 100644 --- a/src/tools/psb_zspins.f90 +++ b/src/tools/psb_zspins.f90 @@ -86,9 +86,9 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild) call psb_erractionsave(err_act) - ictxt = psb_get_context(desc_a) - dectype = psb_get_dectype(desc_a) - mglob = psb_get_global_rows(desc_a) + ictxt = psb_cd_get_context(desc_a) + dectype = psb_cd_get_dectype(desc_a) + mglob = psb_cd_get_global_rows(desc_a) call psb_info(ictxt, me, np) @@ -135,8 +135,8 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild) call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - nrow = psb_get_local_rows(desc_a) - ncol = psb_get_local_cols(desc_a) + nrow = psb_cd_get_local_rows(desc_a) + ncol = psb_cd_get_local_cols(desc_a) if (spstate == psb_spmat_bld_) then call psb_coins(nz,ia,ja,val,a,1,nrow,1,ncol,info,gtl=desc_a%glob_to_loc) @@ -152,8 +152,8 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild) goto 9999 end if else if (psb_is_asb_desc(desc_a)) then - nrow = psb_get_local_rows(desc_a) - ncol = psb_get_local_cols(desc_a) + nrow = psb_cd_get_local_rows(desc_a) + ncol = psb_cd_get_local_cols(desc_a) call psb_coins(nz,ia,ja,val,a,1,nrow,1,ncol,& & info,gtl=desc_a%glob_to_loc,rebuild=rebuild_) if (info /= 0) then diff --git a/src/tools/psb_zsprn.f90 b/src/tools/psb_zsprn.f90 index 640a99e0..8b04971b 100644 --- a/src/tools/psb_zsprn.f90 +++ b/src/tools/psb_zsprn.f90 @@ -67,7 +67,7 @@ Subroutine psb_zsprn(a, desc_a,info,clear) name = 'psb_zsprn' call psb_erractionsave(err_act) - ictxt = psb_get_context(desc_a) + ictxt = psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) if (debug) & &write(*,*) 'starting spalloc ',ictxt,np,me