From 3093612a315f533aa48e4d50e2b88832d215ca54 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Tue, 14 Nov 2006 12:26:30 +0000 Subject: [PATCH] Added getters functions for entries in matrix_data and for sparse matrix info. --- src/comm/psb_dgather.f90 | 24 ++--- src/comm/psb_dhalo.f90 | 20 ++-- src/comm/psb_dovrl.f90 | 24 ++--- src/comm/psb_dscatter.f90 | 29 +++--- src/comm/psb_ihalo.f90 | 22 ++-- src/comm/psb_zgather.f90 | 26 ++--- src/comm/psb_zhalo.f90 | 20 ++-- src/comm/psb_zovrl.f90 | 24 ++--- src/comm/psb_zscatter.f90 | 30 +++--- src/internals/psi_crea_index.f90 | 2 +- src/internals/psi_dswapdata.f90 | 8 +- src/internals/psi_dswaptran.f90 | 8 +- src/internals/psi_iswapdata.f90 | 8 +- src/internals/psi_iswaptran.f90 | 8 +- src/internals/psi_zswapdata.f90 | 8 +- src/internals/psi_zswaptran.f90 | 8 +- src/methd/psb_dbicg.f90 | 8 +- src/methd/psb_dcg.f90 | 8 +- src/methd/psb_dcgs.f90 | 8 +- src/methd/psb_dcgstab.f90 | 8 +- src/methd/psb_dcgstabl.f90 | 8 +- src/methd/psb_dgmresr.f90 | 8 +- src/methd/psb_zcgs.f90 | 8 +- src/methd/psb_zcgstab.f90 | 8 +- src/modules/Makefile | 1 + src/modules/psb_check_mod.f90 | 140 ++++++++++++------------- src/modules/psb_desc_type.f90 | 44 ++++++++ src/modules/psb_serial_mod.f90 | 108 ++++++++++++++++++++ src/prec/psb_dbaseprc_bld.f90 | 8 +- src/prec/psb_dbldaggrmat.f90 | 44 ++++---- src/prec/psb_ddiagsc_bld.f90 | 8 +- src/prec/psb_dgenaggrmap.f90 | 6 +- src/prec/psb_dilu_bld.f90 | 22 ++-- src/prec/psb_dprecbld.f90 | 2 +- src/prec/psb_dprecset.f90 | 14 ++- src/prec/psb_dslu_bld.f90 | 10 +- src/prec/psb_dsp_renum.f90 | 4 +- src/prec/psb_dumf_bld.f90 | 14 +-- src/prec/psb_zbaseprc_bld.f90 | 8 +- src/prec/psb_zbldaggrmat.f90 | 40 +++----- src/prec/psb_zdiagsc_bld.f90 | 8 +- src/prec/psb_zgenaggrmap.f90 | 6 +- src/prec/psb_zilu_bld.f90 | 30 ++---- src/prec/psb_zprecbld.f90 | 2 +- src/prec/psb_zslu_bld.f90 | 8 +- src/prec/psb_zsp_renum.f90 | 4 +- src/prec/psb_zumf_bld.f90 | 13 +-- src/psblas/psb_chkglobvect.f90 | 148 --------------------------- src/psblas/psb_chkmat.f90 | 169 ------------------------------- src/psblas/psb_chkvect.f90 | 157 ---------------------------- src/psblas/psb_damax.f90 | 40 ++++---- src/psblas/psb_dasum.f90 | 30 +++--- src/psblas/psb_daxpby.f90 | 25 ++--- src/psblas/psb_ddot.f90 | 66 ++++++------ src/psblas/psb_dnrm2.f90 | 30 +++--- src/psblas/psb_dnrmi.f90 | 12 +-- src/psblas/psb_dspmm.f90 | 44 ++++---- src/psblas/psb_dspsm.f90 | 32 +++--- src/psblas/psb_zamax.f90 | 40 ++++---- src/psblas/psb_zasum.f90 | 30 +++--- src/psblas/psb_zaxpby.f90 | 25 ++--- src/psblas/psb_zdot.f90 | 51 +++++----- src/psblas/psb_znrm2.f90 | 30 +++--- src/psblas/psb_znrmi.f90 | 12 +-- src/psblas/psb_zspmm.f90 | 44 ++++---- src/psblas/psb_zspsm.f90 | 32 +++--- src/tools/psb_cdalv.f90 | 1 + src/tools/psb_cdasb.f90 | 16 +-- src/tools/psb_cddec.f90 | 6 +- src/tools/psb_cdfree.f90 | 2 +- src/tools/psb_cdins.f90 | 14 +-- src/tools/psb_cdren.f90 | 12 +-- src/tools/psb_cdrep.f90 | 1 + src/tools/psb_dallc.f90 | 30 +++--- src/tools/psb_dasb.f90 | 24 ++--- src/tools/psb_dcdovr.f90 | 6 +- src/tools/psb_dcdovrbld.f90 | 14 +-- src/tools/psb_dcsrp.f90 | 10 +- src/tools/psb_dfree.f90 | 4 +- src/tools/psb_dgelp.f90 | 22 ++-- src/tools/psb_dins.f90 | 28 ++--- src/tools/psb_dspalloc.f90 | 12 +-- src/tools/psb_dspasb.f90 | 12 +-- src/tools/psb_dspcnv.f90 | 8 +- src/tools/psb_dspfree.f90 | 2 +- src/tools/psb_dsphalo.f90 | 2 +- src/tools/psb_dspins.f90 | 20 ++-- src/tools/psb_dsprn.f90 | 6 +- src/tools/psb_glob_to_loc.f90 | 24 ++--- src/tools/psb_ialloc.f90 | 30 +++--- src/tools/psb_iasb.f90 | 24 ++--- src/tools/psb_ifree.f90 | 4 +- src/tools/psb_iins.f90 | 28 ++--- src/tools/psb_loc_to_glob.f90 | 14 +-- src/tools/psb_zallc.f90 | 30 +++--- src/tools/psb_zasb.f90 | 24 ++--- src/tools/psb_zcdovr.f90 | 6 +- src/tools/psb_zcdovrbld.f90 | 14 +-- src/tools/psb_zcsrp.f90 | 10 +- src/tools/psb_zfree.f90 | 4 +- src/tools/psb_zgelp.f90 | 22 ++-- src/tools/psb_zins.f90 | 28 ++--- src/tools/psb_zspalloc.f90 | 12 +-- src/tools/psb_zspasb.f90 | 12 +-- src/tools/psb_zspcnv.f90 | 8 +- src/tools/psb_zspfree.f90 | 2 +- src/tools/psb_zsphalo.f90 | 2 +- src/tools/psb_zspins.f90 | 20 ++-- src/tools/psb_zsprn.f90 | 6 +- 109 files changed, 1067 insertions(+), 1403 deletions(-) delete mode 100644 src/psblas/psb_chkglobvect.f90 delete mode 100644 src/psblas/psb_chkmat.f90 delete mode 100644 src/psblas/psb_chkvect.f90 diff --git a/src/comm/psb_dgather.f90 b/src/comm/psb_dgather.f90 index b5b70ee9..47d1d89c 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) ! check on blacs grid call psb_info(ictxt, me, np) @@ -131,8 +131,8 @@ subroutine psb_dgatherm(globx, locx, desc_a, info, iroot,& lda_globx = size(globx,1) lda_locx = size(locx, 1) - m = desc_a%matrix_data(psb_m_) - n = desc_a%matrix_data(psb_n_) + m = psb_get_global_rows(desc_a) + n = psb_get_global_cols(desc_a) lock=size(locx,2)-jlocx+1 globk=size(globx,2)-jglobx+1 @@ -152,8 +152,8 @@ subroutine psb_dgatherm(globx, locx, desc_a, info, iroot,& ! there should be a global check on k here!!! - call psb_chkglobvect(m,n,size(globx,1),iglobx,jglobx,desc_a%matrix_data,info) - call psb_chkvect(m,n,size(locx,1),ilocx,jlocx,desc_a%matrix_data,info,ilx,jlx) + call psb_chkglobvect(m,n,size(globx,1),iglobx,jglobx,desc_a,info) + call psb_chkvect(m,n,size(locx,1),ilocx,jlocx,desc_a,info,ilx,jlx) if(info.ne.0) then info=4010 ch_err='psb_chk(glob)vect' @@ -170,7 +170,7 @@ subroutine psb_dgatherm(globx, locx, desc_a, info, iroot,& globx(:,:)=0.d0 do j=1,k - do i=1,desc_a%matrix_data(psb_n_row_) + do i=1,psb_get_local_rows(desc_a) idx = desc_a%loc_to_glob(i) globx(idx,jglobx+j-1) = locx(i,jlx+j-1) end do @@ -280,7 +280,7 @@ subroutine psb_dgatherv(globx, locx, desc_a, info, iroot,& info=0 call psb_erractionsave(err_act) - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) ! check on blacs grid call psb_info(ictxt, me, np) @@ -319,16 +319,16 @@ subroutine psb_dgatherv(globx, locx, desc_a, info, iroot,& lda_globx = size(globx) lda_locx = size(locx) - m = desc_a%matrix_data(psb_m_) - n = desc_a%matrix_data(psb_n_) + m = psb_get_global_rows(desc_a) + n = psb_get_global_cols(desc_a) k = 1 ! there should be a global check on k here!!! - call psb_chkglobvect(m,n,size(globx),iglobx,jglobx,desc_a%matrix_data,info) - call psb_chkvect(m,n,size(locx),ilocx,jlocx,desc_a%matrix_data,info,ilx,jlx) + call psb_chkglobvect(m,n,size(globx),iglobx,jglobx,desc_a,info) + call psb_chkvect(m,n,size(locx),ilocx,jlocx,desc_a,info,ilx,jlx) if(info.ne.0) then info=4010 ch_err='psb_chk(glob)vect' @@ -344,7 +344,7 @@ subroutine psb_dgatherv(globx, locx, desc_a, info, iroot,& globx(:)=0.d0 - do i=1,desc_a%matrix_data(psb_n_row_) + do i=1,psb_get_local_rows(desc_a) idx = desc_a%loc_to_glob(i) globx(idx) = locx(i) end do diff --git a/src/comm/psb_dhalo.f90 b/src/comm/psb_dhalo.f90 index 997f259f..1d0f19d2 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) ! check on blacs grid call psb_info(ictxt, me, np) @@ -94,9 +94,9 @@ subroutine psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode) ijx = 1 endif - m = desc_a%matrix_data(psb_m_) - n = desc_a%matrix_data(psb_n_) - nrow = desc_a%matrix_data(psb_n_row_) + m = psb_get_global_rows(desc_a) + n = psb_get_global_cols(desc_a) + nrow = psb_get_local_rows(desc_a) maxk=size(x,2)-ijx+1 @@ -122,7 +122,7 @@ subroutine psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode) endif ! check vector correctness - call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx) + call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx) if(info.ne.0) then info=4010 ch_err='psb_chkvect' @@ -289,7 +289,7 @@ subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode) info=0 call psb_erractionsave(err_act) - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) ! check on blacs grid call psb_info(ictxt, me, np) @@ -302,9 +302,9 @@ subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode) ix = 1 ijx = 1 - m = desc_a%matrix_data(psb_m_) - n = desc_a%matrix_data(psb_n_) - nrow = desc_a%matrix_data(psb_n_row_) + m = psb_get_global_rows(desc_a) + n = psb_get_global_cols(desc_a) + nrow = psb_get_local_rows(desc_a) if (present(tran)) then ltran = tran @@ -318,7 +318,7 @@ subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode) endif ! check vector correctness - call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx) + call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx) if(info.ne.0) then info=4010 ch_err='psb_chkvect' diff --git a/src/comm/psb_dovrl.f90 b/src/comm/psb_dovrl.f90 index 3737f229..75529396 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) ! check on blacs grid call psb_info(ictxt, me, np) @@ -90,10 +90,10 @@ subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,update) ijx = 1 endif - m = desc_a%matrix_data(psb_m_) - n = desc_a%matrix_data(psb_n_) - nrow = desc_a%matrix_data(psb_n_row_) - ncol = desc_a%matrix_data(psb_n_col_) + m = psb_get_global_rows(desc_a) + n = psb_get_global_cols(desc_a) + nrow = psb_get_local_rows(desc_a) + ncol = psb_get_local_cols(desc_a) maxk=size(x,2)-ijx+1 @@ -117,7 +117,7 @@ subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,update) imode = IOR(psb_swap_send_,psb_swap_recv_) ! check vector correctness - call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx) + call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx) if(info.ne.0) then info=4010 ch_err='psb_chkvect' @@ -291,7 +291,7 @@ subroutine psb_dovrlv(x,desc_a,info,work,update) info=0 call psb_erractionsave(err_act) - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) ! check on blacs grid call psb_info(ictxt, me, np) @@ -304,10 +304,10 @@ subroutine psb_dovrlv(x,desc_a,info,work,update) ix = 1 ijx = 1 - m = desc_a%matrix_data(psb_m_) - n = desc_a%matrix_data(psb_n_) - nrow = desc_a%matrix_data(psb_n_row_) - ncol = desc_a%matrix_data(psb_n_col_) + m = psb_get_global_rows(desc_a) + n = psb_get_global_cols(desc_a) + nrow = psb_get_local_rows(desc_a) + ncol = psb_get_local_cols(desc_a) k = 1 @@ -321,7 +321,7 @@ subroutine psb_dovrlv(x,desc_a,info,work,update) imode = IOR(psb_swap_send_,psb_swap_recv_) ! check vector correctness - call psb_chkvect(m,1,size(x),ix,ijx,desc_a%matrix_data,info,iix,jjx) + call psb_chkvect(m,1,size(x),ix,ijx,desc_a,info,iix,jjx) if(info.ne.0) then info=4010 ch_err='psb_chkvect' diff --git a/src/comm/psb_dscatter.f90 b/src/comm/psb_dscatter.f90 index a67940ae..8938f12a 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) ! check on blacs grid call psb_info(ictxt, me, np) @@ -131,8 +131,8 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, iroot,& lda_globx = size(globx,1) lda_locx = size(locx, 1) - m = desc_a%matrix_data(psb_m_) - n = desc_a%matrix_data(psb_n_) + m = psb_get_global_rows(desc_a) + n = psb_get_global_cols(desc_a) lock=size(locx,2)-jlocx+1 globk=size(globx,2)-jglobx+1 @@ -155,8 +155,8 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, iroot,& lda_globx = size(globx) lda_locx = size(locx) - m = desc_a%matrix_data(psb_m_) - n = desc_a%matrix_data(psb_n_) + m = psb_get_global_rows(desc_a) + n = psb_get_global_cols(desc_a) if (me == iiroot) then call igebs2d(ictxt, 'all', ' ', 1, 1, k, 1) @@ -166,8 +166,8 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, iroot,& ! there should be a global check on k here!!! - call psb_chkglobvect(m,n,size(globx),iglobx,jglobx,desc_a%matrix_data,info) - call psb_chkvect(m,n,size(locx),ilocx,jlocx,desc_a%matrix_data,info,ilx,jlx) + call psb_chkglobvect(m,n,size(globx),iglobx,jglobx,desc_a,info) + if (info == 0) call psb_chkvect(m,n,size(locx),ilocx,jlocx,desc_a,info,ilx,jlx) if(info /= 0) then info=4010 ch_err='psb_chk(glob)vect' @@ -181,7 +181,7 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, iroot,& goto 9999 end if - nrow=desc_a%matrix_data(psb_n_row_) + nrow=psb_get_local_rows(desc_a) if(root == -1) then ! extract my chunk @@ -336,7 +336,7 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, iroot) info=0 call psb_erractionsave(err_act) - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) ! check on blacs grid call psb_info(ictxt, me, np) @@ -364,8 +364,8 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, iroot) lda_globx = size(globx) lda_locx = size(locx) - m = desc_a%matrix_data(psb_m_) - n = desc_a%matrix_data(psb_n_) + m = psb_get_global_rows(desc_a) + n = psb_get_global_cols(desc_a) k = 1 @@ -377,8 +377,9 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, iroot) ! there should be a global check on k here!!! - call psb_chkglobvect(m,n,size(globx),iglobx,jglobx,desc_a%matrix_data,info) - call psb_chkvect(m,n,size(locx),ilocx,jlocx,desc_a%matrix_data,info,ilx,jlx) + call psb_chkglobvect(m,n,size(globx),iglobx,jglobx,desc_a,info) + if (info == 0) & + & call psb_chkvect(m,n,size(locx),ilocx,jlocx,desc_a,info,ilx,jlx) if(info /= 0) then info=4010 ch_err='psb_chk(glob)vect' @@ -392,7 +393,7 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, iroot) goto 9999 end if - nrow=desc_a%matrix_data(psb_n_row_) + nrow=psb_get_local_rows(desc_a) if(root == -1) then ! extract my chunk diff --git a/src/comm/psb_ihalo.f90 b/src/comm/psb_ihalo.f90 index 300094c0..98cdb9d5 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) ! check on blacs grid call psb_info(ictxt, me, np) @@ -95,9 +95,9 @@ subroutine psb_ihalom(x,desc_a,info,alpha,jx,ik,work,tran,mode) ijx = 1 endif - m = desc_a%matrix_data(psb_m_) - n = desc_a%matrix_data(psb_n_) - nrow = desc_a%matrix_data(psb_n_row_) + m = psb_get_global_rows(desc_a) + n = psb_get_global_cols(desc_a) + nrow = psb_get_local_rows(desc_a) maxk=size(x,2)-ijx+1 @@ -123,7 +123,7 @@ subroutine psb_ihalom(x,desc_a,info,alpha,jx,ik,work,tran,mode) endif ! check vector correctness - call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx) + call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx) if(info.ne.0) then info=4010 ch_err='psb_chkvect' @@ -285,7 +285,7 @@ subroutine psb_ihalov(x,desc_a,info,alpha,work,tran,mode) info=0 call psb_erractionsave(err_act) - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) ! check on blacs grid call psb_info(ictxt, me, np) @@ -298,10 +298,10 @@ subroutine psb_ihalov(x,desc_a,info,alpha,work,tran,mode) ix = 1 ijx = 1 - m = desc_a%matrix_data(psb_m_) - n = desc_a%matrix_data(psb_n_) - nrow = desc_a%matrix_data(psb_n_row_) - ! ncol = desc_a%matrix_data(psb_n_col_) + m = psb_get_global_rows(desc_a) + n = psb_get_global_cols(desc_a) + nrow = psb_get_local_rows(desc_a) + ! ncol = psb_get_local_cols(desc_a) if (present(tran)) then @@ -316,7 +316,7 @@ subroutine psb_ihalov(x,desc_a,info,alpha,work,tran,mode) endif ! check vector correctness - call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx) + call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx) if(info.ne.0) then info=4010 ch_err='psb_chkvect' diff --git a/src/comm/psb_zgather.f90 b/src/comm/psb_zgather.f90 index c5940166..2a001d76 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) ! check on blacs grid call psb_info(ictxt, me, np) @@ -132,8 +132,8 @@ subroutine psb_zgatherm(globx, locx, desc_a, info, iroot,& lda_globx = size(globx,1) lda_locx = size(locx, 1) - m = desc_a%matrix_data(psb_m_) - n = desc_a%matrix_data(psb_n_) + m = psb_get_global_rows(desc_a) + n = psb_get_global_cols(desc_a) lock=size(locx,2)-jlocx+1 globk=size(globx,2)-jglobx+1 @@ -153,8 +153,9 @@ subroutine psb_zgatherm(globx, locx, desc_a, info, iroot,& ! there should be a global check on k here!!! - call psb_chkglobvect(m,n,size(globx,1),iglobx,jglobx,desc_a%matrix_data,info) - call psb_chkvect(m,n,size(locx,1),ilocx,jlocx,desc_a%matrix_data,info,ilx,jlx) + call psb_chkglobvect(m,n,size(globx,1),iglobx,jglobx,desc_a,info) + if (info == 0) & + & call psb_chkvect(m,n,size(locx,1),ilocx,jlocx,desc_a,info,ilx,jlx) if(info.ne.0) then info=4010 ch_err='psb_chk(glob)vect' @@ -171,7 +172,7 @@ subroutine psb_zgatherm(globx, locx, desc_a, info, iroot,& globx(:,:)=0.d0 do j=1,k - do i=1,desc_a%matrix_data(psb_n_row_) + do i=1,psb_get_local_rows(desc_a) idx = desc_a%loc_to_glob(i) globx(idx,jglobx+j-1) = locx(i,jlx+j-1) end do @@ -281,7 +282,7 @@ subroutine psb_zgatherv(globx, locx, desc_a, info, iroot,& info=0 call psb_erractionsave(err_act) - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) ! check on blacs grid call psb_info(ictxt, me, np) @@ -320,16 +321,17 @@ subroutine psb_zgatherv(globx, locx, desc_a, info, iroot,& lda_globx = size(globx) lda_locx = size(locx) - m = desc_a%matrix_data(psb_m_) - n = desc_a%matrix_data(psb_n_) + m = psb_get_global_rows(desc_a) + n = psb_get_global_cols(desc_a) k = 1 ! there should be a global check on k here!!! - call psb_chkglobvect(m,n,size(globx),iglobx,jglobx,desc_a%matrix_data,info) - call psb_chkvect(m,n,size(locx),ilocx,jlocx,desc_a%matrix_data,info,ilx,jlx) + call psb_chkglobvect(m,n,size(globx),iglobx,jglobx,desc_a,info) + if (info == 0) & + & call psb_chkvect(m,n,size(locx),ilocx,jlocx,desc_a,info,ilx,jlx) if(info.ne.0) then info=4010 ch_err='psb_chk(glob)vect' @@ -345,7 +347,7 @@ subroutine psb_zgatherv(globx, locx, desc_a, info, iroot,& globx(:)=0.d0 - do i=1,desc_a%matrix_data(psb_n_row_) + do i=1,psb_get_local_rows(desc_a) idx = desc_a%loc_to_glob(i) globx(idx) = locx(i) end do diff --git a/src/comm/psb_zhalo.f90 b/src/comm/psb_zhalo.f90 index d7422a86..25748267 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) ! check on blacs grid call psb_info(ictxt, me, np) @@ -94,9 +94,9 @@ subroutine psb_zhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode) ijx = 1 endif - m = desc_a%matrix_data(psb_m_) - n = desc_a%matrix_data(psb_n_) - nrow = desc_a%matrix_data(psb_n_row_) + m = psb_get_global_rows(desc_a) + n = psb_get_global_cols(desc_a) + nrow = psb_get_local_rows(desc_a) maxk=size(x,2)-ijx+1 @@ -122,7 +122,7 @@ subroutine psb_zhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode) endif ! check vector correctness - call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx) + call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx) if(info.ne.0) then info=4010 ch_err='psb_chkvect' @@ -283,7 +283,7 @@ subroutine psb_zhalov(x,desc_a,info,alpha,work,tran,mode) info=0 call psb_erractionsave(err_act) - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) ! check on blacs grid call psb_info(ictxt, me, np) @@ -296,9 +296,9 @@ subroutine psb_zhalov(x,desc_a,info,alpha,work,tran,mode) ix = 1 ijx = 1 - m = desc_a%matrix_data(psb_m_) - n = desc_a%matrix_data(psb_n_) - nrow = desc_a%matrix_data(psb_n_row_) + m = psb_get_global_rows(desc_a) + n = psb_get_global_cols(desc_a) + nrow = psb_get_local_rows(desc_a) if (present(tran)) then ltran = tran @@ -312,7 +312,7 @@ subroutine psb_zhalov(x,desc_a,info,alpha,work,tran,mode) endif ! check vector correctness - call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx) + call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx) if(info.ne.0) then info=4010 ch_err='psb_chkvect' diff --git a/src/comm/psb_zovrl.f90 b/src/comm/psb_zovrl.f90 index 887ee4e5..6b441625 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) ! check on blacs grid call psb_info(ictxt, me, np) @@ -90,10 +90,10 @@ subroutine psb_zovrlm(x,desc_a,info,jx,ik,work,update) ijx = 1 endif - m = desc_a%matrix_data(psb_m_) - n = desc_a%matrix_data(psb_n_) - nrow = desc_a%matrix_data(psb_n_row_) - ncol = desc_a%matrix_data(psb_n_col_) + m = psb_get_global_rows(desc_a) + n = psb_get_global_cols(desc_a) + nrow = psb_get_local_rows(desc_a) + ncol = psb_get_local_cols(desc_a) maxk=size(x,2)-ijx+1 @@ -117,7 +117,7 @@ subroutine psb_zovrlm(x,desc_a,info,jx,ik,work,update) imode = IOR(psb_swap_send_,psb_swap_recv_) ! check vector correctness - call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx) + call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx) if(info.ne.0) then info=4010 ch_err='psb_chkvect' @@ -291,7 +291,7 @@ subroutine psb_zovrlv(x,desc_a,info,work,update) info=0 call psb_erractionsave(err_act) - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) ! check on blacs grid call psb_info(ictxt, me, np) @@ -304,10 +304,10 @@ subroutine psb_zovrlv(x,desc_a,info,work,update) ix = 1 ijx = 1 - m = desc_a%matrix_data(psb_m_) - n = desc_a%matrix_data(psb_n_) - nrow = desc_a%matrix_data(psb_n_row_) - ncol = desc_a%matrix_data(psb_n_col_) + m = psb_get_global_rows(desc_a) + n = psb_get_global_cols(desc_a) + nrow = psb_get_local_rows(desc_a) + ncol = psb_get_local_cols(desc_a) k = 1 @@ -321,7 +321,7 @@ subroutine psb_zovrlv(x,desc_a,info,work,update) imode = IOR(psb_swap_send_,psb_swap_recv_) ! check vector correctness - call psb_chkvect(m,1,size(x),ix,ijx,desc_a%matrix_data,info,iix,jjx) + call psb_chkvect(m,1,size(x),ix,ijx,desc_a,info,iix,jjx) if(info.ne.0) then info=4010 ch_err='psb_chkvect' diff --git a/src/comm/psb_zscatter.f90 b/src/comm/psb_zscatter.f90 index 539e8c89..f656a81c 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) ! check on blacs grid call psb_info(ictxt, me, np) @@ -131,8 +131,8 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, iroot,& lda_globx = size(globx,1) lda_locx = size(locx, 1) - m = desc_a%matrix_data(psb_m_) - n = desc_a%matrix_data(psb_n_) + m = psb_get_global_rows(desc_a) + n = psb_get_global_cols(desc_a) lock=size(locx,2)-jlocx+1 globk=size(globx,2)-jglobx+1 @@ -154,8 +154,8 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, iroot,& lda_globx = size(globx) lda_locx = size(locx) - m = desc_a%matrix_data(psb_m_) - n = desc_a%matrix_data(psb_n_) + m = psb_get_global_rows(desc_a) + n = psb_get_global_cols(desc_a) if (me == iiroot) then call igebs2d(ictxt, 'all', ' ', 1, 1, k, 1) @@ -165,8 +165,9 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, iroot,& ! there should be a global check on k here!!! - call psb_chkglobvect(m,n,size(globx),iglobx,jglobx,desc_a%matrix_data,info) - call psb_chkvect(m,n,size(locx),ilocx,jlocx,desc_a%matrix_data,info,ilx,jlx) + call psb_chkglobvect(m,n,size(globx),iglobx,jglobx,desc_a,info) + if (info == 0) & + & call psb_chkvect(m,n,size(locx),ilocx,jlocx,desc_a,info,ilx,jlx) if(info /= 0) then info=4010 ch_err='psb_chk(glob)vect' @@ -180,7 +181,7 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, iroot,& goto 9999 end if - nrow=desc_a%matrix_data(psb_n_row_) + nrow=psb_get_local_rows(desc_a) if(root == -1) then ! extract my chunk @@ -335,7 +336,7 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, iroot) info=0 call psb_erractionsave(err_act) - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) ! check on blacs grid call psb_info(ictxt, me, np) @@ -363,8 +364,8 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, iroot) lda_globx = size(globx) lda_locx = size(locx) - m = desc_a%matrix_data(psb_m_) - n = desc_a%matrix_data(psb_n_) + m = psb_get_global_rows(desc_a) + n = psb_get_global_cols(desc_a) k = 1 @@ -376,8 +377,9 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, iroot) ! there should be a global check on k here!!! - call psb_chkglobvect(m,n,size(globx),iglobx,jglobx,desc_a%matrix_data,info) - call psb_chkvect(m,n,size(locx),ilocx,jlocx,desc_a%matrix_data,info,ilx,jlx) + call psb_chkglobvect(m,n,size(globx),iglobx,jglobx,desc_a,info) + if (info == 0) & + & call psb_chkvect(m,n,size(locx),ilocx,jlocx,desc_a,info,ilx,jlx) if(info /= 0) then info=4010 ch_err='psb_chk(glob)vect' @@ -391,7 +393,7 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, iroot) goto 9999 end if - nrow=desc_a%matrix_data(psb_n_row_) + nrow=psb_get_local_rows(desc_a) if(root == -1) then ! extract my chunk diff --git a/src/internals/psi_crea_index.f90 b/src/internals/psi_crea_index.f90 index 76eb4af2..25a7e8d6 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 = desc_a%matrix_data(psb_ctxt_) + ictxt = psb_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 7fbcef5b..d183db33 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt,me,np) if (np == -1) then info = 2010 @@ -73,7 +73,7 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data) goto 9999 endif - if (.not.psb_is_asb_dec(desc_a%matrix_data(psb_dec_type_))) then + if (.not.psb_is_asb_desc(desc_a)) then info = 1122 call psb_errpush(info,name) goto 9999 @@ -474,7 +474,7 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data) name='psi_swap_datav' call psb_erractionsave(err_act) - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt,me,np) if (np == -1) then info = 2010 @@ -482,7 +482,7 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data) goto 9999 endif - if (.not.psb_is_asb_dec(desc_a%matrix_data(psb_dec_type_))) then + if (.not.psb_is_asb_desc(desc_a)) then info = 1122 call psb_errpush(info,name) goto 9999 diff --git a/src/internals/psi_dswaptran.f90 b/src/internals/psi_dswaptran.f90 index 3d36cdbb..8f7e5597 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt,me,np) if (np == -1) then info = 2010 @@ -73,7 +73,7 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data) goto 9999 endif - if (.not.psb_is_asb_dec(desc_a%matrix_data(psb_dec_type_))) then + if (.not.psb_is_asb_desc(desc_a)) then info = 1122 call psb_errpush(info,name) goto 9999 @@ -466,7 +466,7 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data) name='psi_swap_tranv' call psb_erractionsave(err_act) - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt,me,np) if (np == -1) then info = 2010 @@ -474,7 +474,7 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data) goto 9999 endif - if (.not.psb_is_asb_dec(desc_a%matrix_data(psb_dec_type_))) then + if (.not.psb_is_asb_desc(desc_a)) then info = 1122 call psb_errpush(info,name) goto 9999 diff --git a/src/internals/psi_iswapdata.f90 b/src/internals/psi_iswapdata.f90 index 2634f9b1..94e7c145 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt,me,np) if (np == -1) then info = 2010 @@ -73,7 +73,7 @@ subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data) goto 9999 endif - if (.not.psb_is_asb_dec(desc_a%matrix_data(psb_dec_type_))) then + if (.not.psb_is_asb_desc(desc_a)) then info = 1122 call psb_errpush(info,name) goto 9999 @@ -474,7 +474,7 @@ subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data) name='psi_swap_datav' call psb_erractionsave(err_act) - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt,me,np) if (np == -1) then info = 2010 @@ -482,7 +482,7 @@ subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data) goto 9999 endif - if (.not.psb_is_asb_dec(desc_a%matrix_data(psb_dec_type_))) then + if (.not.psb_is_asb_desc(desc_a)) then info = 1122 call psb_errpush(info,name) goto 9999 diff --git a/src/internals/psi_iswaptran.f90 b/src/internals/psi_iswaptran.f90 index 9d5d9b1d..5e27d7e1 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt,me,np) if (np == -1) then info = 2010 @@ -73,7 +73,7 @@ subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data) goto 9999 endif - if (.not.psb_is_asb_dec(desc_a%matrix_data(psb_dec_type_))) then + if (.not.psb_is_asb_desc(desc_a)) then info = 1122 call psb_errpush(info,name) goto 9999 @@ -466,7 +466,7 @@ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data) name='psi_swap_tranv' call psb_erractionsave(err_act) - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt,me,np) if (np == -1) then info = 2010 @@ -474,7 +474,7 @@ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data) goto 9999 endif - if (.not.psb_is_asb_dec(desc_a%matrix_data(psb_dec_type_))) then + if (.not.psb_is_asb_desc(desc_a)) then info = 1122 call psb_errpush(info,name) goto 9999 diff --git a/src/internals/psi_zswapdata.f90 b/src/internals/psi_zswapdata.f90 index ba654db2..fa93ecf2 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt,me,np) if (np == -1) then info = 2010 @@ -73,7 +73,7 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data) goto 9999 endif - if (.not.psb_is_asb_dec(desc_a%matrix_data(psb_dec_type_))) then + if (.not.psb_is_asb_desc(desc_a)) then info = 1122 call psb_errpush(info,name) goto 9999 @@ -474,7 +474,7 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data) name='psi_swap_datav' call psb_erractionsave(err_act) - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt,me,np) if (np == -1) then info = 2010 @@ -482,7 +482,7 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data) goto 9999 endif - if (.not.psb_is_asb_dec(desc_a%matrix_data(psb_dec_type_))) then + if (.not.psb_is_asb_desc(desc_a)) then info = 1122 call psb_errpush(info,name) goto 9999 diff --git a/src/internals/psi_zswaptran.f90 b/src/internals/psi_zswaptran.f90 index e7d77d01..4c71c536 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt,me,np) if (np == -1) then info = 2010 @@ -73,7 +73,7 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data) goto 9999 endif - if (.not.psb_is_asb_dec(desc_a%matrix_data(psb_dec_type_))) then + if (.not.psb_is_asb_desc(desc_a)) then info = 1122 call psb_errpush(info,name) goto 9999 @@ -463,7 +463,7 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data) name='psi_swap_tranv' call psb_erractionsave(err_act) - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt,me,np) if (np == -1) then info = 2010 @@ -471,7 +471,7 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data) goto 9999 endif - if (.not.psb_is_asb_dec(desc_a%matrix_data(psb_dec_type_))) then + if (.not.psb_is_asb_desc(desc_a)) then info = 1122 call psb_errpush(info,name) goto 9999 diff --git a/src/methd/psb_dbicg.f90 b/src/methd/psb_dbicg.f90 index 99fc33c1..ae7e6ec5 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 = desc_a%matrix_data(psb_ctxt_) + ictxt = psb_get_context(desc_a) call psb_info(ictxt, me, np) if (debug) write(*,*) 'psb_dbicg: from gridinfo',np,me - mglob = desc_a%matrix_data(psb_m_) - n_row = desc_a%matrix_data(psb_n_row_) - n_col = desc_a%matrix_data(psb_n_col_) + mglob = psb_get_global_rows(desc_a) + n_row = psb_get_local_rows(desc_a) + n_col = psb_get_local_cols(desc_a) ! Ensure global coherence for convergence checks. call psb_set_coher(ictxt,isvch) diff --git a/src/methd/psb_dcg.f90 b/src/methd/psb_dcg.f90 index f73cb5c0..651d7bae 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 = desc_a%matrix_data(psb_ctxt_) + ictxt = psb_get_context(desc_a) call psb_info(ictxt, me, np) - mglob = desc_a%matrix_data(psb_m_) - n_row = desc_a%matrix_data(psb_n_row_) - n_col = desc_a%matrix_data(psb_n_col_) + mglob = psb_get_global_rows(desc_a) + n_row = psb_get_local_rows(desc_a) + n_col = psb_get_local_cols(desc_a) if (present(istop)) then diff --git a/src/methd/psb_dcgs.f90 b/src/methd/psb_dcgs.f90 index d4c64339..4576c81b 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 = desc_a%matrix_data(psb_ctxt_) + ictxt = psb_get_context(desc_a) Call psb_info(ictxt, me, np) If (debug) Write(*,*) 'psb_dcgs: from gridinfo',np,me - mglob = desc_a%matrix_data(psb_m_) - n_row = desc_a%matrix_data(psb_n_row_) - n_col = desc_a%matrix_data(psb_n_col_) + mglob = psb_get_global_rows(desc_a) + n_row = psb_get_local_rows(desc_a) + n_col = psb_get_local_cols(desc_a) If (Present(istop)) Then istop_ = istop diff --git a/src/methd/psb_dcgstab.f90 b/src/methd/psb_dcgstab.f90 index 17642981..9e9c2557 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 = desc_a%matrix_data(psb_ctxt_) + ictxt = psb_get_context(desc_a) call psb_info(ictxt, me, np) if (debug) write(*,*) 'PSB_DCGSTAB: From GRIDINFO',np,me - mglob = desc_a%matrix_data(psb_m_) - n_row = desc_a%matrix_data(psb_n_row_) - n_col = desc_a%matrix_data(psb_n_col_) + mglob = psb_get_global_rows(desc_a) + n_row = psb_get_local_rows(desc_a) + n_col = psb_get_local_cols(desc_a) If (Present(istop)) Then istop_ = istop diff --git a/src/methd/psb_dcgstabl.f90 b/src/methd/psb_dcgstabl.f90 index 70c6e2cd..c1907010 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 = desc_a%matrix_data(psb_ctxt_) + ictxt = psb_get_context(desc_a) Call psb_info(ictxt, me, np) If (debug) Write(0,*) 'psb_dbicgstabl: from gridinfo',np,me - mglob = desc_a%matrix_data(psb_m_) - n_row = desc_a%matrix_data(psb_n_row_) - n_col = desc_a%matrix_data(psb_n_col_) + mglob = psb_get_global_rows(desc_a) + n_row = psb_get_local_rows(desc_a) + n_col = psb_get_local_cols(desc_a) if (present(istop)) then istop_ = istop diff --git a/src/methd/psb_dgmresr.f90 b/src/methd/psb_dgmresr.f90 index 0b32b12a..66417055 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 = desc_a%matrix_data(psb_ctxt_) + ictxt = psb_get_context(desc_a) Call psb_info(ictxt, me, np) If (debug) Write(0,*) 'psb_dgmres: from gridinfo',np,me - mglob = desc_a%matrix_data(psb_m_) - n_row = desc_a%matrix_data(psb_n_row_) - n_col = desc_a%matrix_data(psb_n_col_) + mglob = psb_get_global_rows(desc_a) + n_row = psb_get_local_rows(desc_a) + n_col = psb_get_local_cols(desc_a) if (present(istop)) then istop_ = istop diff --git a/src/methd/psb_zcgs.f90 b/src/methd/psb_zcgs.f90 index f16f8944..e0ebb6a7 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 = desc_a%matrix_data(psb_ctxt_) + ictxt = psb_get_context(desc_a) Call psb_info(ictxt, me, np) If (debug) Write(*,*) 'psb_zcgs: from gridinfo',np,me - mglob = desc_a%matrix_data(psb_m_) - n_row = desc_a%matrix_data(psb_n_row_) - n_col = desc_a%matrix_data(psb_n_col_) + mglob = psb_get_global_rows(desc_a) + n_row = psb_get_local_rows(desc_a) + n_col = psb_get_local_cols(desc_a) If (Present(istop)) Then istop_ = istop diff --git a/src/methd/psb_zcgstab.f90 b/src/methd/psb_zcgstab.f90 index 2a776d84..e24fbc32 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 = desc_a%matrix_data(psb_ctxt_) + ictxt = psb_get_context(desc_a) CALL psb_info(ictxt, me, np) if (debug) write(*,*) 'PSB_ZCGSTAB: From GRIDINFO',np,me - mglob = desc_a%matrix_data(psb_m_) - n_row = desc_a%matrix_data(psb_n_row_) - n_col = desc_a%matrix_data(psb_n_col_) + mglob = psb_get_global_rows(desc_a) + n_row = psb_get_local_rows(desc_a) + n_col = psb_get_local_cols(desc_a) If (Present(istop)) Then istop_ = istop diff --git a/src/modules/Makefile b/src/modules/Makefile index 9de6976e..81260b5d 100644 --- a/src/modules/Makefile +++ b/src/modules/Makefile @@ -22,6 +22,7 @@ psb_error_mod.o: psb_const_mod.o psb_penv_mod.o: psb_const_mod.o psb_error_mod.o psi_mod.o: psb_penv_mod.o psb_error_mod.o psb_desc_type.o psb_desc_type.o: psb_const_mod.o +psb_check_mod.o: psb_desc_type.o psb_methd_mod.o: psb_serial_mod.o psb_desc_type.o psb_prec_type.o psb_tools_mod.o: psb_spmat_type.o psb_desc_type.o psi_mod.o psb_sparse_mod.o: $(MODULES) $(MPFOBJS) diff --git a/src/modules/psb_check_mod.f90 b/src/modules/psb_check_mod.f90 index 02d32aaf..ea5a1e67 100644 --- a/src/modules/psb_check_mod.f90 +++ b/src/modules/psb_check_mod.f90 @@ -66,13 +66,13 @@ contains ! iix - integer(optional). The local rows starting index of the submatrix. ! jjx - integer(optional). The local columns starting index of the submatrix. subroutine psb_chkvect( m, n, lldx, ix, jx, desc_dec, info, iix, jjx) - + use psb_descriptor_type use psb_const_mod use psb_error_mod implicit none integer, intent(in) :: m,n,ix,jx,lldx - integer, intent(in) :: desc_dec(:) + type(psb_desc_type), intent(in) :: desc_dec integer, intent(out) :: info integer, optional :: iix, jjx @@ -80,67 +80,67 @@ contains integer :: err_act, int_err(5) character(len=20) :: name, ch_err - if(psb_get_errstatus().ne.0) return + if(psb_get_errstatus() /= 0) return info=0 name='psb_chkvect' call psb_erractionsave(err_act) - if (m.lt.0) then + if (m < 0) then info=10 int_err(1) = 1 int_err(2) = m - else if (n.lt.0) then + else if (n < 0) then info=10 int_err(1) = 3 int_err(2) = n - else if ((ix.lt.1) .and. (m.ne.0)) then + else if ((ix < 1) .and. (m /= 0)) then info=20 int_err(1) = 4 int_err(2) = ix - else if ((jx.lt.1) .and. (n.ne.0)) then + else if ((jx < 1) .and. (n /= 0)) then info=20 int_err(1) = 5 int_err(2) = jx - else if (desc_dec(psb_n_col_).lt.0) then + else if (psb_get_local_cols(desc_dec) < 0) then info=40 int_err(1) = 6 int_err(2) = psb_n_col_ - int_err(3) = desc_dec(psb_n_col_) - else if (desc_dec(psb_n_row_).lt.0) then + int_err(3) = psb_get_local_cols(desc_dec) + else if (psb_get_local_rows(desc_dec) < 0) then info=40 int_err(1) = 6 int_err(2) = psb_n_row_ - int_err(3) = desc_dec(psb_n_row_) - else if (lldx.lt.desc_dec(psb_n_col_)) then + int_err(3) = psb_get_local_cols(desc_dec) + else if (lldx < psb_get_local_cols(desc_dec)) then info=50 int_err(1) = 3 int_err(2) = lldx int_err(3) = 6 int_err(4) = psb_n_col_ - int_err(5) = desc_dec(psb_n_col_) - else if (desc_dec(psb_n_).lt.m) then + int_err(5) = psb_get_local_cols(desc_dec) + else if (psb_get_global_cols(desc_dec) < m) then info=60 int_err(1) = 1 int_err(2) = m int_err(3) = 6 int_err(4) = psb_n_ - int_err(5) = desc_dec(psb_n_) - else if (desc_dec(psb_n_).lt.ix) then + int_err(5) = psb_get_global_cols(desc_dec) + else if (psb_get_global_cols(desc_dec) < ix) then info=60 int_err(1) = 4 int_err(2) = ix int_err(3) = 6 int_err(4) = psb_n_ - int_err(5) = desc_dec(psb_n_) - else if (desc_dec(psb_m_).lt.jx) then + int_err(5) = psb_get_global_cols(desc_dec) + else if (psb_get_global_rows(desc_dec) < jx) then info=60 int_err(1) = 5 int_err(2) = jx int_err(3) = 6 int_err(4) = psb_m_ - int_err(5) = desc_dec(psb_m_) - else if (desc_dec(psb_n_).lt.(ix+m-1)) then + int_err(5) = psb_get_global_rows(desc_dec) + else if (psb_get_global_cols(desc_dec) < (ix+m-1)) then info=80 int_err(1) = 1 int_err(2) = m @@ -148,7 +148,7 @@ contains int_err(4) = ix end if - if (info.ne.0) then + if (info /= 0) then call psb_errpush(info,name,i_err=int_err) goto 9999 end if @@ -164,7 +164,7 @@ contains 9999 continue call psb_erractionrestore(err_act) - if (err_act.eq.act_abort) then + if (err_act == act_abort) then call psb_error() return end if @@ -192,79 +192,80 @@ contains ! subroutine psb_chkglobvect( m, n, lldx, ix, jx, desc_dec, info) + use psb_descriptor_type use psb_const_mod use psb_error_mod implicit none integer, intent(in) :: m,n,ix,jx,lldx - integer, intent(in) :: desc_dec(:) + type(psb_desc_type), intent(in) :: desc_dec integer, intent(out) :: info ! locals integer :: err_act, int_err(5) character(len=20) :: name, ch_err - if(psb_get_errstatus().ne.0) return + if(psb_get_errstatus() /= 0) return info=0 name='psb_chkglobvect' call psb_erractionsave(err_act) - if (m.lt.0) then + if (m < 0) then info=10 int_err(1) = 1 int_err(2) = m - else if (n.lt.0) then + else if (n < 0) then info=10 int_err(1) = 3 int_err(2) = n - else if ((ix.lt.1) .and. (m.ne.0)) then + else if ((ix < 1) .and. (m /= 0)) then info=20 int_err(1) = 4 int_err(2) = ix - else if ((jx.lt.1) .and. (n.ne.0)) then + else if ((jx < 1) .and. (n /= 0)) then info=20 int_err(1) = 5 int_err(2) = jx - else if (desc_dec(psb_n_col_).lt.0) then + else if (psb_get_local_cols(desc_dec) < 0) then info=40 int_err(1) = 6 int_err(2) = psb_n_col_ - int_err(3) = desc_dec(psb_n_col_) - else if (desc_dec(psb_n_row_).lt.0) then + int_err(3) = psb_get_local_cols(desc_dec) + else if (psb_get_local_rows(desc_dec) < 0) then info=40 int_err(1) = 6 int_err(2) = psb_n_row_ - int_err(3) = desc_dec(psb_n_row_) - else if (lldx.lt.desc_dec(psb_m_)) then + int_err(3) = psb_get_local_rows(desc_dec) + else if (lldx < psb_get_global_rows(desc_dec)) then info=50 int_err(1) = 3 int_err(2) = lldx int_err(3) = 6 int_err(4) = psb_n_col_ - int_err(5) = desc_dec(psb_n_col_) - else if (desc_dec(psb_n_).lt.m) then + int_err(5) = psb_get_local_cols(desc_dec) + else if (psb_get_global_cols(desc_dec) < m) then info=60 int_err(1) = 1 int_err(2) = m int_err(3) = 6 int_err(4) = psb_n_ - int_err(5) = desc_dec(psb_n_) - else if (desc_dec(psb_n_).lt.ix) then + int_err(5) = psb_get_global_cols(desc_dec) + else if (psb_get_global_cols(desc_dec) < ix) then info=60 int_err(1) = 4 int_err(2) = ix int_err(3) = 6 int_err(4) = psb_n_ - int_err(5) = desc_dec(psb_n_) - else if (desc_dec(psb_m_).lt.jx) then + int_err(5) = psb_get_global_cols(desc_dec) + else if (psb_get_global_rows(desc_dec) < jx) then info=60 int_err(1) = 5 int_err(2) = jx int_err(3) = 6 int_err(4) = psb_m_ - int_err(5) = desc_dec(psb_m_) - else if (desc_dec(psb_n_).lt.(ix+m-1)) then + int_err(5) = psb_get_global_rows(desc_dec) + else if (psb_get_global_cols(desc_dec) < (ix+m-1)) then info=80 int_err(1) = 1 int_err(2) = m @@ -272,7 +273,7 @@ contains int_err(4) = ix end if - if (info.ne.0) then + if (info /= 0) then call psb_errpush(info,name,i_err=int_err) goto 9999 end if @@ -283,7 +284,7 @@ contains 9999 continue call psb_erractionrestore(err_act) - if (err_act.eq.act_abort) then + if (err_act == act_abort) then call psb_error() return end if @@ -314,12 +315,13 @@ contains ! subroutine psb_chkmat( m, n, ia, ja, desc_dec, info, iia, jja) + use psb_descriptor_type use psb_const_mod use psb_error_mod implicit none integer, intent(in) :: m,n,ia,ja - integer, intent(in) :: desc_dec(:) + type(psb_desc_type), intent(in) :: desc_dec integer, intent(out) :: info integer, optional :: iia, jja @@ -327,72 +329,72 @@ contains integer :: err_act, int_err(5) character(len=20) :: name, ch_err - if(psb_get_errstatus().ne.0) return - info=0 + if(psb_get_errstatus() /= 0) return + info=0 name='psb_chkmat' call psb_erractionsave(err_act) - if (m.lt.0) then + if (m < 0) then info=10 int_err(1) = 1 int_err(2) = m - else if (n.lt.0) then + else if (n < 0) then info=10 int_err(1) = 3 int_err(2) = n - else if ((ia.lt.1) .and. (m.ne.0)) then + else if ((ia < 1) .and. (m /= 0)) then info=20 int_err(1) = 4 int_err(2) = ia - else if ((ja.lt.1) .and. (n.ne.0)) then + else if ((ja < 1) .and. (n /= 0)) then info=20 int_err(1) = 5 int_err(2) = ja - else if (desc_dec(psb_n_col_).lt.0) then + else if (psb_get_local_cols(desc_dec) < 0) then info=40 int_err(1) = 6 int_err(2) = psb_n_col_ - int_err(3) = desc_dec(psb_n_col_) - else if (desc_dec(psb_n_row_).lt.0) then + int_err(3) = psb_get_local_cols(desc_dec) + else if (psb_get_local_rows(desc_dec) < 0) then info=40 int_err(1) = 6 int_err(2) = psb_n_row_ - int_err(3) = desc_dec(psb_n_row_) - else if (desc_dec(psb_m_).lt.m) then + int_err(3) = psb_get_local_rows(desc_dec) + else if (psb_get_global_rows(desc_dec) < m) then info=60 int_err(1) = 1 int_err(2) = m int_err(3) = 5 int_err(4) = psb_m_ - int_err(5) = desc_dec(psb_m_) - else if (desc_dec(psb_m_).lt.m) then + int_err(5) = psb_get_global_rows(desc_dec) + else if (psb_get_global_rows(desc_dec) < m) then info=60 int_err(1) = 2 int_err(2) = n int_err(3) = 5 int_err(4) = psb_m_ - int_err(5) = desc_dec(psb_m_) - else if (desc_dec(psb_m_).lt.ia) then + int_err(5) = psb_get_global_rows(desc_dec) + else if (psb_get_global_rows(desc_dec) < ia) then info=60 int_err(1) = 3 int_err(2) = ia int_err(3) = 5 int_err(4) = psb_m_ - int_err(5) = desc_dec(psb_m_) - else if (desc_dec(psb_n_).lt.ja) then + int_err(5) = psb_get_global_rows(desc_dec) + else if (psb_get_global_cols(desc_dec) < ja) then info=60 int_err(1) = 4 int_err(2) = ja int_err(3) = 5 int_err(4) = psb_n_ - int_err(5) = desc_dec(psb_n_) - else if (desc_dec(psb_m_).lt.(ia+m-1)) then + int_err(5) = psb_get_global_cols(desc_dec) + else if (psb_get_global_rows(desc_dec) < (ia+m-1)) then info=80 int_err(1) = 1 int_err(2) = m int_err(3) = 3 int_err(4) = ia - else if (desc_dec(psb_n_).lt.(ja+n-1)) then + else if (psb_get_global_cols(desc_dec) < (ja+n-1)) then info=80 int_err(1) = 2 int_err(2) = n @@ -400,7 +402,7 @@ contains int_err(4) = ja end if - if (info.ne.0) then + if (info /= 0) then call psb_errpush(info,name,i_err=int_err) goto 9999 end if @@ -408,12 +410,12 @@ contains ! Compute local indices for submatrix starting ! at global indices ix and jx if(present(iia).and.present(jja)) then - if (desc_dec(psb_n_row_).gt.0) then + if (psb_get_local_rows(desc_dec) > 0) then iia=1 jja=1 else - iia=desc_dec(psb_n_row_)+1 - jja=desc_dec(psb_n_col_)+1 + iia=psb_get_local_rows(desc_dec)+1 + jja=psb_get_local_cols(desc_dec)+1 end if end if @@ -423,7 +425,7 @@ contains 9999 continue call psb_erractionrestore(err_act) - if (err_act.eq.act_abort) then + if (err_act == act_abort) then call psb_error() return end if diff --git a/src/modules/psb_desc_type.f90 b/src/modules/psb_desc_type.f90 index 956c934e..5f1841a9 100644 --- a/src/modules/psb_desc_type.f90 +++ b/src/modules/psb_desc_type.f90 @@ -75,6 +75,42 @@ contains end subroutine psb_nullify_desc + logical function psb_is_ok_desc(desc) + type(psb_desc_type), intent(in) :: desc + + psb_is_ok_desc = psb_is_ok_dec(psb_get_dectype(desc)) + + end function psb_is_ok_desc + + logical function psb_is_bld_desc(desc) + type(psb_desc_type), intent(in) :: desc + + psb_is_bld_desc = psb_is_bld_dec(psb_get_dectype(desc)) + + end function psb_is_bld_desc + + logical function psb_is_upd_desc(desc) + type(psb_desc_type), intent(in) :: desc + + psb_is_upd_desc = psb_is_upd_dec(psb_get_dectype(desc)) + + end function psb_is_upd_desc + + logical function psb_is_asb_upd_desc(desc) + type(psb_desc_type), intent(in) :: desc + + psb_is_asb_upd_desc = psb_is_asb_upd_dec(psb_get_dectype(desc)) + + end function psb_is_asb_upd_desc + + logical function psb_is_asb_desc(desc) + type(psb_desc_type), intent(in) :: desc + + psb_is_asb_desc = psb_is_asb_dec(psb_get_dectype(desc)) + + end function psb_is_asb_desc + + logical function psb_is_ok_dec(dectype) integer :: dectype @@ -112,6 +148,8 @@ contains end function psb_is_asb_dec + + integer function psb_get_local_rows(desc) type(psb_desc_type), intent(in) :: desc @@ -141,5 +179,11 @@ contains psb_get_context = desc%matrix_data(psb_ctxt_) end function psb_get_context + + integer function psb_get_dectype(desc) + type(psb_desc_type), intent(in) :: desc + + psb_get_dectype = desc%matrix_data(psb_dec_type_) + end function psb_get_dectype end module psb_descriptor_type diff --git a/src/modules/psb_serial_mod.f90 b/src/modules/psb_serial_mod.f90 index 181e5629..049672ac 100644 --- a/src/modules/psb_serial_mod.f90 +++ b/src/modules/psb_serial_mod.f90 @@ -438,5 +438,113 @@ module psb_serial_mod end function psb_zcsnmi end interface + + interface psb_get_nrows + module procedure psb_get_dsp_nrows, psb_get_zsp_nrows + end interface + + interface psb_get_ncols + module procedure psb_get_dsp_ncols, psb_get_zsp_ncols + end interface + + interface psb_get_nnzeros + module procedure psb_get_dsp_nnzeros, psb_get_zsp_nnzeros + end interface + + interface psb_get_nnz_row + module procedure psb_get_dsp_nnz_row, psb_get_zsp_nnz_row + end interface + + + +contains + + integer function psb_get_dsp_nrows(a) + use psb_spmat_type + type(psb_dspmat_type), intent(in) :: a + psb_get_dsp_nrows = a%m + + return + end function psb_get_dsp_nrows + + integer function psb_get_dsp_ncols(a) + use psb_spmat_type + type(psb_dspmat_type), intent(in) :: a + psb_get_dsp_ncols = a%k + + return + end function psb_get_dsp_ncols + integer function psb_get_zsp_nrows(a) + use psb_spmat_type + type(psb_zspmat_type), intent(in) :: a + psb_get_zsp_nrows = a%m + + return + end function psb_get_zsp_nrows + + integer function psb_get_zsp_ncols(a) + use psb_spmat_type + type(psb_zspmat_type), intent(in) :: a + psb_get_zsp_ncols = a%k + + return + end function psb_get_zsp_ncols + + + integer function psb_get_dsp_nnzeros(a) + use psb_spmat_type + type(psb_dspmat_type), intent(in) :: a + integer :: ires,info + + call psb_spinfo(psb_nztotreq_,a,ires,info) + if (info == 0) then + psb_get_dsp_nnzeros = ires + else + psb_get_dsp_nnzeros = 0 + end if + end function psb_get_dsp_nnzeros + + integer function psb_get_zsp_nnzeros(a) + use psb_spmat_type + type(psb_zspmat_type), intent(in) :: a + integer :: ires,info + + call psb_spinfo(psb_nztotreq_,a,ires,info) + if (info == 0) then + psb_get_zsp_nnzeros = ires + else + psb_get_zsp_nnzeros = 0 + end if + end function psb_get_zsp_nnzeros + + + integer function psb_get_dsp_nnz_row(ir,a) + use psb_spmat_type + integer, intent(in) :: ir + type(psb_dspmat_type), intent(in) :: a + integer :: ires,info + + call psb_spinfo(psb_nzrowreq_,a,ires,info,iaux=ir) + if (info == 0) then + psb_get_dsp_nnz_row = ires + else + psb_get_dsp_nnz_row = 0 + end if + end function psb_get_dsp_nnz_row + integer function psb_get_zsp_nnz_row(ir,a) + use psb_spmat_type + integer, intent(in) :: ir + type(psb_zspmat_type), intent(in) :: a + integer :: ires,info + + call psb_spinfo(psb_nzrowreq_,a,ires,info,iaux=ir) + if (info == 0) then + psb_get_zsp_nnz_row = ires + else + psb_get_zsp_nnz_row = 0 + end if + end function psb_get_zsp_nnz_row + + end module psb_serial_mod diff --git a/src/prec/psb_dbaseprc_bld.f90 b/src/prec/psb_dbaseprc_bld.f90 index e75870e0..65b45190 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 = desc_a%matrix_data(psb_ctxt_) - n_row = desc_a%matrix_data(psb_n_row_) - n_col = desc_a%matrix_data(psb_n_col_) - mglob = desc_a%matrix_data(psb_m_) + ictxt = psb_get_context(desc_a) + n_row = psb_get_local_rows(desc_a) + n_col = psb_get_local_cols(desc_a) + mglob = psb_get_global_rows(desc_a) if (debug) write(0,*) 'Preconditioner Blacs_gridinfo' call psb_info(ictxt, me, np) diff --git a/src/prec/psb_dbldaggrmat.f90 b/src/prec/psb_dbldaggrmat.f90 index c60eb8b3..9351dd92 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) select case (p%iprcparm(smth_kind_)) @@ -125,11 +125,11 @@ contains call psb_nullify_sp(b) - ictxt = desc_a%matrix_data(psb_ctxt_) + ictxt = psb_get_context(desc_a) call psb_info(ictxt, me, np) - nglob = desc_a%matrix_data(psb_m_) - nrow = desc_a%matrix_data(psb_n_row_) - ncol = desc_a%matrix_data(psb_n_col_) + nglob = psb_get_global_rows(desc_a) + nrow = psb_get_local_rows(desc_a) + ncol = psb_get_local_cols(desc_a) naggr = p%nlaggr(me+1) ntaggr = sum(p%nlaggr) @@ -155,13 +155,7 @@ contains end if - call psb_spinfo(psb_nztotreq_,a,nzt,info) - - if(info /= 0) then - call psb_errpush(4010,name,a_err='spinfo') - goto 9999 - end if - + nzt = psb_get_nnzeros(a) call psb_sp_all(b,nzt,info) if(info /= 0) then call psb_errpush(4010,name,a_err='spall') @@ -181,13 +175,8 @@ contains call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - call psb_spinfo(psb_nztotreq_,b,nzt,info) - if(info /= 0) then - info=4010 - ch_err='psb_spinfo' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if + + nzt = psb_get_nnzeros(b) do i=1, nzt b%ia1(i) = p%mlia(b%ia1(i)) b%ia2(i) = p%mlia(b%ia2(i)) @@ -228,8 +217,13 @@ contains !!$ enddo end if + call psb_fixcoo(b,info) + if(info /= 0) then + call psb_errpush(4010,name,a_err='fixcoo') + goto 9999 + end if - irs = b%infoa(psb_nnz_) + irs = psb_get_nnzeros(b) call psb_sp_reall(b,irs,info) if(info /= 0) then call psb_errpush(4010,name,a_err='spreall') @@ -408,7 +402,7 @@ contains info=0 call psb_erractionsave(err_act) - ictxt = desc_a%matrix_data(psb_ctxt_) + ictxt = psb_get_context(desc_a) call psb_info(ictxt, me, np) call psb_nullify_sp(b) @@ -418,9 +412,9 @@ contains am2 => p%av(sm_pr_t_) am1 => p%av(sm_pr_) - nglob = desc_a%matrix_data(psb_m_) - nrow = desc_a%matrix_data(psb_n_row_) - ncol = desc_a%matrix_data(psb_n_col_) + nglob = psb_get_global_rows(desc_a) + nrow = psb_get_local_rows(desc_a) + ncol = psb_get_local_cols(desc_a) naggr = p%nlaggr(me+1) ntaggr = sum(p%nlaggr) @@ -887,7 +881,7 @@ contains if (np>1) then - call psb_spinfo(psb_nztotreq_,am1,nzl,info) + nzl = psb_get_nnzeros(am1) call psb_glob_to_loc(am1%ia1(1:nzl),desc_ac,info,'I') if(info /= 0) then call psb_errpush(4010,name,a_err='psb_glob_to_loc') diff --git a/src/prec/psb_ddiagsc_bld.f90 b/src/prec/psb_ddiagsc_bld.f90 index 83ab49c4..3b3ff842 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 = desc_a%matrix_data(psb_ctxt_) - n_row = desc_a%matrix_data(psb_n_row_) - n_col = desc_a%matrix_data(psb_n_col_) - mglob = desc_a%matrix_data(psb_m_) + ictxt = psb_get_context(desc_a) + n_row = psb_get_local_rows(desc_a) + n_col = psb_get_local_cols(desc_a) + mglob = psb_get_global_rows(desc_a) if (debug) write(0,*) 'Preconditioner Blacs_gridinfo' call psb_info(ictxt, me, np) diff --git a/src/prec/psb_dgenaggrmap.f90 b/src/prec/psb_dgenaggrmap.f90 index e18ba288..0b100545 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt,me,np) - nrow = desc_a%matrix_data(psb_n_row_) - ncol = desc_a%matrix_data(psb_n_col_) + nrow = psb_get_local_rows(desc_a) + ncol = psb_get_local_cols(desc_a) nr = a%m diff --git a/src/prec/psb_dilu_bld.f90 b/src/prec/psb_dilu_bld.f90 index 73e25734..4ff51a60 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) m = a%m @@ -182,19 +182,13 @@ subroutine psb_dilu_bld(a,desc_a,p,upd,info) endif !!$ call psb_csprt(50+me,a,head='% (A)') - nrow_a = desc_a%matrix_data(psb_n_row_) - call psb_spinfo(psb_nztotreq_,a,nztota,info) - if (info == 0) call psb_spinfo(psb_nztotreq_,blck,nztotb,info) - if(info/=0) then - info=4010 - ch_err='psb_spinfo' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - if (debug) write(0,*)me,': out spinfo',nztota + nrow_a = psb_get_local_rows(desc_a) + nztota = psb_get_nnzeros(a) + nztotb = psb_get_nnzeros(blck) + if (debug) write(0,*)me,': out get_nnzeros',nztota if (debug) call psb_barrier(ictxt) - n_col = desc_a%matrix_data(psb_n_col_) + n_col = psb_get_local_cols(desc_a) nhalo = n_col-nrow_a n_row = p%desc_data%matrix_data(psb_n_row_) p%av(l_pr_)%m = n_row @@ -237,8 +231,8 @@ subroutine psb_dilu_bld(a,desc_a,p,upd,info) ! Here we allocate a full copy to hold local A and received BLK ! - call psb_spinfo(psb_nztotreq_,a,nztota,info) - call psb_spinfo(psb_nztotreq_,blck,nztotb,info) + nztota = psb_get_nnzeros(a) + nztotb = psb_get_nnzeros(blck) call psb_sp_all(atmp,nztota+nztotb,info) if(info/=0) then info=4011 diff --git a/src/prec/psb_dprecbld.f90 b/src/prec/psb_dprecbld.f90 index 7c5f845f..03dc1cbd 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 = desc_a%matrix_data(psb_ctxt_) + ictxt = psb_get_context(desc_a) if (debug) write(0,*) 'Preconditioner psb_info' call psb_info(ictxt, me, np) diff --git a/src/prec/psb_dprecset.f90 b/src/prec/psb_dprecset.f90 index b212ad79..e0f5595d 100644 --- a/src/prec/psb_dprecset.f90 +++ b/src/prec/psb_dprecset.f90 @@ -80,11 +80,15 @@ subroutine psb_dprecset(p,ptype,info,iv,rs,rv,ilev,nlev) return endif - - call psb_realloc(ifpsz,p%baseprecv(ilev_)%iprcparm,info) - if (info == 0) call psb_realloc(dfpsz,p%baseprecv(ilev_)%dprcparm,info) - if (info /= 0) return - p%baseprecv(ilev_)%iprcparm(:) = 0 + if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then + call psb_realloc(ifpsz,p%baseprecv(ilev_)%iprcparm,info) + if (info == 0) call psb_realloc(dfpsz,p%baseprecv(ilev_)%dprcparm,info) + if (info /= 0) then + write(0,*) 'Info from realloc ',info + return + end if + p%baseprecv(ilev_)%iprcparm(:) = 0 + end if select case(toupper(ptype(1:len_trim(ptype)))) case ('NONE','NOPREC') diff --git a/src/prec/psb_dslu_bld.f90 b/src/prec/psb_dslu_bld.f90 index e326e557..b569fc82 100644 --- a/src/prec/psb_dslu_bld.f90 +++ b/src/prec/psb_dslu_bld.f90 @@ -94,7 +94,7 @@ subroutine psb_dslu_bld(a,desc_a,p,info) call psb_csdp(a,atmp,info) if(info /= 0) then info=4010 - ch_err='psb_dcsdp' + ch_err='psb_csdp' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if @@ -165,13 +165,7 @@ subroutine psb_dslu_bld(a,desc_a,p,info) call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - call psb_spinfo(psb_nztotreq_,atmp,nzt,info) - if(info /= 0) then - info=4010 - ch_err='psb_spinfo' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if + nzt = psb_get_nnzeros(atmp) if (Debug) then write(0,*) me,'Calling psb_slu_factor ',nzt,atmp%m,& & atmp%k,p%desc_data%matrix_data(psb_n_row_) diff --git a/src/prec/psb_dsp_renum.f90 b/src/prec/psb_dsp_renum.f90 index 6384cb2a..5282d141 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) !!!!!!!!!!!!!!!! CHANGE FOR NON-CSR A @@ -84,7 +84,7 @@ subroutine psb_dsp_renum(a,desc_a,blck,p,atmp,info) atmp%descra = 'GUN' ! This is the renumbering coherent with global indices.. - mglob = desc_a%matrix_data(psb_m_) + mglob = psb_get_global_rows(desc_a) ! ! Remember: we have switched IA1=COLS and IA2=ROWS ! Now identify the set of distinct local column indices diff --git a/src/prec/psb_dumf_bld.f90 b/src/prec/psb_dumf_bld.f90 index f0bbf341..0bd5e73a 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 - call psb_spinfo(psb_nztotreq_,atmp,nza,info) - call psb_spinfo(psb_nztotreq_,a,nzb,info) + nza = psb_get_nnzeros(atmp) + nzb = psb_get_nnzeros(a) if (Debug) then write(0,*) me, 'UMFBLD: Done csdp',info,nza,atmp%m,atmp%k,nzb call psb_barrier(ictxt) @@ -112,7 +112,7 @@ subroutine psb_dumf_bld(a,desc_a,p,info) goto 9999 end if - call psb_spinfo(psb_nztotreq_,blck,nzb,info) + nzb = psb_get_nnzeros(blck) if (Debug) then write(0,*) me, 'UMFBLD: Done asmatbld',info,nzb,blck%fida call psb_barrier(ictxt) @@ -165,13 +165,7 @@ subroutine psb_dumf_bld(a,desc_a,p,info) call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - call psb_spinfo(psb_nztotreq_,atmp,nzt,info) - if(info /= 0) then - info=4010 - ch_err='psb_spinfo' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if + nzt = psb_get_nnzeros(atmp) if (Debug) then write(0,*) me,'Calling psb_umf_factor ',nzt,atmp%m,& & atmp%k,p%desc_data%matrix_data(psb_n_row_) diff --git a/src/prec/psb_zbaseprc_bld.f90 b/src/prec/psb_zbaseprc_bld.f90 index fbb95584..e95fa173 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 = desc_a%matrix_data(psb_ctxt_) - n_row = desc_a%matrix_data(psb_n_row_) - n_col = desc_a%matrix_data(psb_n_col_) - mglob = desc_a%matrix_data(psb_m_) + ictxt = psb_get_context(desc_a) + n_row = psb_get_local_rows(desc_a) + n_col = psb_get_local_cols(desc_a) + mglob = psb_get_global_rows(desc_a) if (debug) write(0,*) 'Preconditioner Blacs_gridinfo' call psb_info(ictxt, me, np) diff --git a/src/prec/psb_zbldaggrmat.f90 b/src/prec/psb_zbldaggrmat.f90 index 06fa7b3f..069de67f 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) select case (p%iprcparm(smth_kind_)) @@ -124,11 +124,11 @@ contains call psb_nullify_sp(b) - ictxt = desc_a%matrix_data(psb_ctxt_) + ictxt = psb_get_context(desc_a) call psb_info(ictxt, me, np) - nglob = desc_a%matrix_data(psb_m_) - nrow = desc_a%matrix_data(psb_n_row_) - ncol = desc_a%matrix_data(psb_n_col_) + nglob = psb_get_global_rows(desc_a) + nrow = psb_get_local_rows(desc_a) + ncol = psb_get_local_cols(desc_a) naggr = p%nlaggr(me+1) ntaggr = sum(p%nlaggr) @@ -154,13 +154,7 @@ contains end if - call psb_spinfo(psb_nztotreq_,a,nzt,info) - - if(info /= 0) then - call psb_errpush(4010,name,a_err='spinfo') - goto 9999 - end if - + nzt = psb_get_nnzeros(a) call psb_sp_all(b,nzt,info) if(info /= 0) then call psb_errpush(4010,name,a_err='spall') @@ -180,13 +174,8 @@ contains call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - call psb_spinfo(psb_nztotreq_,b,nzt,info) - if(info /= 0) then - info=4010 - ch_err='psb_spinfo' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if + + nzt = psb_get_nnzeros(b) do i=1, nzt b%ia1(i) = p%mlia(b%ia1(i)) b%ia2(i) = p%mlia(b%ia2(i)) @@ -233,7 +222,7 @@ contains goto 9999 end if - irs = b%infoa(psb_nnz_) + irs = psb_get_nnzeros(b) call psb_sp_reall(b,irs,info) if(info /= 0) then call psb_errpush(4010,name,a_err='spreall') @@ -296,6 +285,7 @@ contains call psb_errpush(4010,name,a_err='psb_cddec') goto 9999 end if + call psb_sp_clone(b,ac,info) if(info /= 0) then call psb_errpush(4010,name,a_err='spclone') @@ -411,7 +401,7 @@ contains info=0 call psb_erractionsave(err_act) - ictxt = desc_a%matrix_data(psb_ctxt_) + ictxt = psb_get_context(desc_a) call psb_info(ictxt, me, np) call psb_nullify_sp(b) @@ -421,9 +411,9 @@ contains am2 => p%av(sm_pr_t_) am1 => p%av(sm_pr_) - nglob = desc_a%matrix_data(psb_m_) - nrow = desc_a%matrix_data(psb_n_row_) - ncol = desc_a%matrix_data(psb_n_col_) + nglob = psb_get_global_rows(desc_a) + nrow = psb_get_local_rows(desc_a) + ncol = psb_get_local_cols(desc_a) naggr = p%nlaggr(me+1) ntaggr = sum(p%nlaggr) @@ -890,7 +880,7 @@ contains if (np>1) then - call psb_spinfo(psb_nztotreq_,am1,nzl,info) + nzl = psb_get_nnzeros(am1) call psb_glob_to_loc(am1%ia1(1:nzl),desc_ac,info,'I') if(info /= 0) then call psb_errpush(4010,name,a_err='psb_glob_to_loc') diff --git a/src/prec/psb_zdiagsc_bld.f90 b/src/prec/psb_zdiagsc_bld.f90 index e0febc7f..7dd24efb 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 = desc_a%matrix_data(psb_ctxt_) - n_row = desc_a%matrix_data(psb_n_row_) - n_col = desc_a%matrix_data(psb_n_col_) - mglob = desc_a%matrix_data(psb_m_) + ictxt = psb_get_context(desc_a) + n_row = psb_get_local_rows(desc_a) + n_col = psb_get_local_cols(desc_a) + mglob = psb_get_global_rows(desc_a) if (debug) write(0,*) 'Preconditioner Blacs_gridinfo' call psb_info(ictxt, me, np) diff --git a/src/prec/psb_zgenaggrmap.f90 b/src/prec/psb_zgenaggrmap.f90 index 97c1bd2f..56f826d1 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt,me,np) - nrow = desc_a%matrix_data(psb_n_row_) - ncol = desc_a%matrix_data(psb_n_col_) + nrow = psb_get_local_rows(desc_a) + ncol = psb_get_local_cols(desc_a) nr = a%m diff --git a/src/prec/psb_zilu_bld.f90 b/src/prec/psb_zilu_bld.f90 index f49b6b47..d10336fc 100644 --- a/src/prec/psb_zilu_bld.f90 +++ b/src/prec/psb_zilu_bld.f90 @@ -71,7 +71,7 @@ subroutine psb_zilu_bld(a,desc_a,p,upd,info) character, intent(in) :: upd ! .. Local Scalars .. - integer :: i, j, jj, k, kk, m, i1, i2, ia + integer :: i, j, jj, k, kk, m integer :: int_err(5) character :: trans, unitd type(psb_zspmat_type) :: blck, atmp @@ -79,7 +79,7 @@ subroutine psb_zilu_bld(a,desc_a,p,upd,info) external mpi_wtime logical, parameter :: debugprt=.false., debug=.false., aggr_dump=.false. integer nztota, nztotb, nztmp, nzl, nnr, ir, err_act,& - & n_row, nrow_a,n_col, nhalo, ind, iind + & n_row, nrow_a,n_col, nhalo, ind, iind, i1,i2,ia integer :: ictxt,np,me character(len=20) :: name, ch_err @@ -131,7 +131,7 @@ subroutine psb_zilu_bld(a,desc_a,p,upd,info) name='psb_ilu_bld' call psb_erractionsave(err_act) - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) m = a%m @@ -152,10 +152,6 @@ subroutine psb_zilu_bld(a,desc_a,p,upd,info) goto 9999 endif - ! call psb_info(ictxt, me, np) - - - ictxt=desc_a%matrix_data(psb_ctxt_) call psb_nullify_sp(blck) call psb_nullify_sp(atmp) @@ -185,19 +181,13 @@ subroutine psb_zilu_bld(a,desc_a,p,upd,info) goto 9999 endif - nrow_a = desc_a%matrix_data(psb_n_row_) - call psb_spinfo(psb_nztotreq_,a,nztota,info) - if (info == 0) call psb_spinfo(psb_nztotreq_,blck,nztotb,info) - if(info/=0) then - info=4010 - ch_err='psb_spinfo' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - if (debug) write(0,*)me,': out spinfo',nztota + nrow_a = psb_get_local_rows(desc_a) + nztota = psb_get_nnzeros(a) + nztotb = psb_get_nnzeros(blck) + if (debug) write(0,*)me,': out get_nnzeros',nztota if (debug) call psb_barrier(ictxt) - n_col = desc_a%matrix_data(psb_n_col_) + n_col = psb_get_local_cols(desc_a) nhalo = n_col-nrow_a n_row = p%desc_data%matrix_data(psb_n_row_) p%av(l_pr_)%m = n_row @@ -240,8 +230,8 @@ subroutine psb_zilu_bld(a,desc_a,p,upd,info) ! Here we allocate a full copy to hold local A and received BLK ! - call psb_spinfo(psb_nztotreq_,a,nztota,info) - call psb_spinfo(psb_nztotreq_,blck,nztotb,info) + nztota = psb_get_nnzeros(a) + nztotb = psb_get_nnzeros(blck) call psb_sp_all(atmp,nztota+nztotb,info) if(info/=0) then info=4011 diff --git a/src/prec/psb_zprecbld.f90 b/src/prec/psb_zprecbld.f90 index 03e6b5b1..53b799ba 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 = desc_a%matrix_data(psb_ctxt_) + ictxt = psb_get_context(desc_a) if (debug) write(0,*) 'Preconditioner psb_info' call psb_info(ictxt, me, np) diff --git a/src/prec/psb_zslu_bld.f90 b/src/prec/psb_zslu_bld.f90 index dfc9e42f..eedd15f9 100644 --- a/src/prec/psb_zslu_bld.f90 +++ b/src/prec/psb_zslu_bld.f90 @@ -165,13 +165,7 @@ subroutine psb_zslu_bld(a,desc_a,p,info) call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - call psb_spinfo(psb_nztotreq_,atmp,nzt,info) - if(info /= 0) then - info=4010 - ch_err='psb_spinfo' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if + nzt = psb_get_nnzeros(atmp) if (Debug) then write(0,*) me,'Calling psb_slu_factor ',nzt,atmp%m,& & atmp%k,p%desc_data%matrix_data(psb_n_row_) diff --git a/src/prec/psb_zsp_renum.f90 b/src/prec/psb_zsp_renum.f90 index ceed8505..d7ec8602 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) !!!!!!!!!!!!!!!! CHANGE FOR NON-CSR A @@ -84,7 +84,7 @@ subroutine psb_zsp_renum(a,desc_a,blck,p,atmp,info) atmp%descra = 'GUN' ! This is the renumbering coherent with global indices.. - mglob = desc_a%matrix_data(psb_m_) + mglob = psb_get_global_rows(desc_a) ! ! Remember: we have switched IA1=COLS and IA2=ROWS ! Now identify the set of distinct local column indices diff --git a/src/prec/psb_zumf_bld.f90 b/src/prec/psb_zumf_bld.f90 index f35d1152..94e2183e 100644 --- a/src/prec/psb_zumf_bld.f90 +++ b/src/prec/psb_zumf_bld.f90 @@ -97,7 +97,8 @@ subroutine psb_zumf_bld(a,desc_a,p,info) call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - call psb_spinfo(psb_nztotreq_,atmp,nza,info) + nza = psb_get_nnzeros(atmp) + nzb = psb_get_nnzeros(a) if (Debug) then write(0,*) me, 'UMFBLD: Done csdp',info,nza,atmp%m,atmp%k,nzb call psb_barrier(ictxt) @@ -111,7 +112,7 @@ subroutine psb_zumf_bld(a,desc_a,p,info) goto 9999 end if - call psb_spinfo(psb_nztotreq_,blck,nzb,info) + nzb = psb_get_nnzeros(blck) if (Debug) then write(0,*) me, 'UMFBLD: Done asmatbld',info,nzb,blck%fida call psb_barrier(ictxt) @@ -164,13 +165,7 @@ subroutine psb_zumf_bld(a,desc_a,p,info) call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - call psb_spinfo(psb_nztotreq_,atmp,nzt,info) - if(info /= 0) then - info=4010 - ch_err='psb_spinfo' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if + nzt = psb_get_nnzeros(atmp) if (Debug) then write(0,*) me,'Calling psb_umf_factor ',nzt,atmp%m,& & atmp%k,p%desc_data%matrix_data(psb_n_row_) diff --git a/src/psblas/psb_chkglobvect.f90 b/src/psblas/psb_chkglobvect.f90 deleted file mode 100644 index aa0f4863..00000000 --- a/src/psblas/psb_chkglobvect.f90 +++ /dev/null @@ -1,148 +0,0 @@ -!!$ -!!$ Parallel Sparse BLAS v2.0 -!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata -!!$ Alfredo Buttari University of Rome Tor Vergata -!!$ -!!$ Redistribution and use in source and binary forms, with or without -!!$ modification, are permitted provided that the following conditions -!!$ are met: -!!$ 1. Redistributions of source code must retain the above copyright -!!$ notice, this list of conditions and the following disclaimer. -!!$ 2. Redistributions in binary form must reproduce the above copyright -!!$ notice, this list of conditions, and the following disclaimer in the -!!$ documentation and/or other materials provided with the distribution. -!!$ 3. The name of the PSBLAS group or the names of its contributors may -!!$ not be used to endorse or promote products derived from this -!!$ software without specific written permission. -!!$ -!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS -!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -!!$ POSSIBILITY OF SUCH DAMAGE. -!!$ -!!$ -! File: psb_chkglobvect.f90 -! -! Subroutine: psb_chkglobvect -! psb_chkglobvect checks the validity of a descriptor vector desc_dec, the -! related global indexes ix, jx and the leading dimension lldx. -! If an inconsistency is found among its parameters ix, jx, -! descdec and lldx, the routine returns an error code in info. -! -! Parameters: -! m - integer. The number of rows of the dense matrix X being operated on. -! n - integer. The number of columns of the dense matrix X being operated on. -! lldx - integer. The leading dimension of the local dense matrix X. -! ix - integer. X's global row index, which points to the beginning -! of the dense submatrix which is to be operated on. -! jx - integer. X's global column index, which points to the beginning -! of the dense submatrix which is to be operated on. -! desc_dec - integer,dimension(:). Is the matrix_data array. -! info - integer. Eventually returns an error code. -! -subroutine psb_chkglobvect( m, n, lldx, ix, jx, desc_dec, info) - - use psb_error_mod - implicit none - - integer, intent(in) :: m,n,ix,jx,lldx - integer, intent(in) :: desc_dec(:) - integer, intent(out) :: info - - ! locals - integer :: err_act, int_err(5) - character(len=20) :: name, ch_err - - if(psb_get_errstatus().ne.0) return - info=0 - name='psb_chkglobvect' - call psb_erractionsave(err_act) - - - if (m.lt.0) then - info=10 - int_err(1) = 1 - int_err(2) = m - else if (n.lt.0) then - info=10 - int_err(1) = 3 - int_err(2) = n - else if ((ix.lt.1) .and. (m.ne.0)) then - info=20 - int_err(1) = 4 - int_err(2) = ix - else if ((jx.lt.1) .and. (n.ne.0)) then - info=20 - int_err(1) = 5 - int_err(2) = jx - else if (desc_dec(psb_n_col_).lt.0) then - info=40 - int_err(1) = 6 - int_err(2) = psb_n_col_ - int_err(3) = desc_dec(psb_n_col_) - else if (desc_dec(psb_n_row_).lt.0) then - info=40 - int_err(1) = 6 - int_err(2) = psb_n_row_ - int_err(3) = desc_dec(psb_n_row_) - else if (lldx.lt.desc_dec(m_)) then - info=50 - int_err(1) = 3 - int_err(2) = lldx - int_err(3) = 6 - int_err(4) = psb_n_col_ - int_err(5) = desc_dec(psb_n_col_) - else if (desc_dec(psb_n_).lt.m) then - info=60 - int_err(1) = 1 - int_err(2) = m - int_err(3) = 6 - int_err(4) = psb_n_ - int_err(5) = desc_dec(psb_n_) - else if (desc_dec(psb_n_).lt.ix) then - info=60 - int_err(1) = 4 - int_err(2) = ix - int_err(3) = 6 - int_err(4) = psb_n_ - int_err(5) = desc_dec(psb_n_) - else if (desc_dec(psb_m_).lt.jx) then - info=60 - int_err(1) = 5 - int_err(2) = jx - int_err(3) = 6 - int_err(4) = psb_m_ - int_err(5) = desc_dec(psb_m_) - else if (desc_dec(psb_n_).lt.(ix+m-1)) then - info=80 - int_err(1) = 1 - int_err(2) = m - int_err(3) = 4 - int_err(4) = ix - end if - - if (info.ne.0) then - call psb_errpush(info,name,i_err=int_err) - goto 9999 - end if - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - - if (err_act.eq.act_abort) then - call psb_error() - return - end if - return - -end subroutine psb_chkglobvect diff --git a/src/psblas/psb_chkmat.f90 b/src/psblas/psb_chkmat.f90 deleted file mode 100644 index 92b18030..00000000 --- a/src/psblas/psb_chkmat.f90 +++ /dev/null @@ -1,169 +0,0 @@ -!!$ -!!$ Parallel Sparse BLAS v2.0 -!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata -!!$ Alfredo Buttari University of Rome Tor Vergata -!!$ -!!$ Redistribution and use in source and binary forms, with or without -!!$ modification, are permitted provided that the following conditions -!!$ are met: -!!$ 1. Redistributions of source code must retain the above copyright -!!$ notice, this list of conditions and the following disclaimer. -!!$ 2. Redistributions in binary form must reproduce the above copyright -!!$ notice, this list of conditions, and the following disclaimer in the -!!$ documentation and/or other materials provided with the distribution. -!!$ 3. The name of the PSBLAS group or the names of its contributors may -!!$ not be used to endorse or promote products derived from this -!!$ software without specific written permission. -!!$ -!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS -!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -!!$ POSSIBILITY OF SUCH DAMAGE. -!!$ -!!$ -! File: psb_chkmat.f90 -! File: psb_chkmat.f90 -! -! Subroutine: psb_chkmat -! pbmatvect checks the validity of a descriptor vector DESCDEC, the -! related global indexes IA, JA. It also computes the starting local -! indexes (IIA,JJA) corresponding to the submatrix starting globally at -! the entry pointed by (IA,JA). Finally, if an inconsitency is found among -! its parameters ia, ja and desc_A, the routine returns an error code in -! info. -! -! Parameters: -! m - integer. The number of rows of the matrix being operated on. -! n - integer. The number of columns of the matrix being operated on. -! ia - integer. a's global row index, which points to the beginning -! of the submatrix which is to be operated on. -! ja - integer. a's global column index, which points to the beginning -! of the submatrix which is to be operated on. -! desc_dec - integer,dimension(:). Is the matrix_data array. -! info - integer. Eventually returns an error code. -! iia - integer(optional). The local rows starting index of the submatrix. -! jja - integer(optional). The local columns starting index of the submatrix. -! -subroutine psb_chkmat( m, n, ia, ja, desc_dec, info, iia, jja) - - use psb_error_mod - implicit none - - integer, intent(in) :: m,n,ia,ja - integer, intent(in) :: desc_dec(:) - integer, intent(out) :: info - integer, optional :: iia, jja - - ! locals - integer :: err_act, int_err(5) - character(len=20) :: name, ch_err - - if(psb_get_errstatus().ne.0) return - info=0 - name='psb_chkmat' - call psb_erractionsave(err_act) - - if (m.lt.0) then - info=10 - int_err(1) = 1 - int_err(2) = m - else if (n.lt.0) then - info=10 - int_err(1) = 3 - int_err(2) = n - else if ((ix.lt.1) .and. (m.ne.0)) then - info=20 - int_err(1) = 4 - int_err(2) = ix - else if ((jx.lt.1) .and. (n.ne.0)) then - info=20 - int_err(1) = 5 - int_err(2) = jx - else if (desc_dec(psb_n_col_).lt.0) then - info=40 - int_err(1) = 6 - int_err(2) = psb_n_col_ - int_err(3) = desc_dec(psb_n_col_) - else if (desc_dec(psb_n_row_).lt.0) then - info=40 - int_err(1) = 6 - int_err(2) = psb_n_row_ - int_err(3) = desc_dec(psb_n_row_) - else if (desc_dec(psb_m_).lt.m) then - info=60 - int_err(1) = 1 - int_err(2) = m - int_err(3) = 5 - int_err(4) = psb_m_ - int_err(5) = desc_dec(psb_m_) - else if (desc_dec(psb_n_).lt.m) then - info=60 - int_err(1) = 2 - int_err(2) = n - int_err(3) = 5 - int_err(4) = psb_n_ - int_err(5) = desc_dec(psb_n_) - else if (desc_dec(psb_m_).lt.ia) then - info=60 - int_err(1) = 3 - int_err(2) = ia - int_err(3) = 5 - int_err(4) = psb_m_ - int_err(5) = desc_dec(psb_m_) - else if (desc_dec(psb_n_).lt.ja) then - info=60 - int_err(1) = 4 - int_err(2) = ja - int_err(3) = 5 - int_err(4) = psb_n_ - int_err(5) = desc_dec(psb_n_) - else if (desc_dec(psb_m_).lt.(ia+m-1)) then - info=80 - int_err(1) = 1 - int_err(2) = m - int_err(3) = 3 - int_err(4) = ia - else if (desc_dec(psb_n_).lt.(ja+n-1)) then - info=80 - int_err(1) = 2 - int_err(2) = n - int_err(3) = 4 - int_err(4) = ja - end if - - if (info.ne.0) then - call psb_errpush(info,name,i_err=int_err) - goto 9999 - end if - - ! Compute local indices for submatrix starting - ! at global indices ix and jx - if(present(iia).and.present(jja)) then - if (desc_dec(psb_n_row_).gt.0) then - iia=1 - jja=1 - else - iia=desc_dec(psb_n_row_)+1 - jja=desc_dec(psb_n_col_)+1 - end if - end if - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - - if (err_act.eq.act_abort) then - call psb_error() - return - end if - return -end subroutine psb_chkmat diff --git a/src/psblas/psb_chkvect.f90 b/src/psblas/psb_chkvect.f90 deleted file mode 100644 index 55102411..00000000 --- a/src/psblas/psb_chkvect.f90 +++ /dev/null @@ -1,157 +0,0 @@ -!!$ -!!$ Parallel Sparse BLAS v2.0 -!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata -!!$ Alfredo Buttari University of Rome Tor Vergata -!!$ -!!$ Redistribution and use in source and binary forms, with or without -!!$ modification, are permitted provided that the following conditions -!!$ are met: -!!$ 1. Redistributions of source code must retain the above copyright -!!$ notice, this list of conditions and the following disclaimer. -!!$ 2. Redistributions in binary form must reproduce the above copyright -!!$ notice, this list of conditions, and the following disclaimer in the -!!$ documentation and/or other materials provided with the distribution. -!!$ 3. The name of the PSBLAS group or the names of its contributors may -!!$ not be used to endorse or promote products derived from this -!!$ software without specific written permission. -!!$ -!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS -!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -!!$ POSSIBILITY OF SUCH DAMAGE. -!!$ -!!$ -! File: psb_chkvect.f90 -! -! Subroutine: psb_chkvect -! psb_chkvect checks the validity of a descriptor vector desc_dec, the -! related global indexes ix, jx and the leading dimension lldx. It also -! eventually computes the starting local indexes (iix,jjx) corresponding -! to the submatrix starting globally at the entry pointed by (ix,jx). -! Finally, if an inconsistency is found among its parameters ix, jx, -! descdec and lldx, the routine returns an error code in info. -! -! Parameters: -! m - integer. The number of rows of the dense matrix X being operated on. -! n - integer. The number of columns of the dense matrix X being operated on. -! lldx - integer. The leading dimension of the local dense matrix X. -! ix - integer. X's global row index, which points to the beginning -! of the dense submatrix which is to be operated on. -! jx - integer. X's global column index, which points to the beginning -! of the dense submatrix which is to be operated on. -! desc_dec - integer,dimension(:). Is the matrix_data array. -! info - integer. Eventually returns an error code. -! iix - integer(optional). The local rows starting index of the submatrix. -! jjx - integer(optional). The local columns starting index of the submatrix. -subroutine psb_chkvect( m, n, lldx, ix, jx, desc_dec, info, iix, jjx) - - use psb_error_mod - implicit none - - integer, intent(in) :: m,n,ix,jx,lldx - integer, intent(in) :: desc_dec(:) - integer, intent(out) :: info - integer, optional :: iix, jjx - - ! locals - integer :: err_act, int_err(5) - character(len=20) :: name, ch_err - - if(psb_get_errstatus().ne.0) return - info=0 - name='psb_chkvect' - call psb_erractionsave(err_act) - - - if (m.lt.0) then - info=10 - int_err(1) = 1 - int_err(2) = m - else if (n.lt.0) then - info=10 - int_err(1) = 3 - int_err(2) = n - else if ((ix.lt.1) .and. (m.ne.0)) then - info=20 - int_err(1) = 4 - int_err(2) = ix - else if ((jx.lt.1) .and. (n.ne.0)) then - info=20 - int_err(1) = 5 - int_err(2) = jx - else if (desc_dec(psb_n_col_).lt.0) then - info=40 - int_err(1) = 6 - int_err(2) = psb_n_col_ - int_err(3) = desc_dec(psb_n_col_) - else if (desc_dec(psb_n_row_).lt.0) then - info=40 - int_err(1) = 6 - int_err(2) = psb_n_row_ - int_err(3) = desc_dec(psb_n_row_) - else if (lldx.lt.desc_dec(psb_n_col_)) then - info=50 - int_err(1) = 3 - int_err(2) = lldx - int_err(3) = 6 - int_err(4) = psb_n_col_ - int_err(5) = desc_dec(psb_n_col_) - else if (desc_dec(psb_n_).lt.m) then - info=60 - int_err(1) = 1 - int_err(2) = m - int_err(3) = 6 - int_err(4) = psb_n_ - int_err(5) = desc_dec(psb_n_) - else if (desc_dec(psb_n_).lt.ix) then - info=60 - int_err(1) = 4 - int_err(2) = ix - int_err(3) = 6 - int_err(4) = psb_n_ - int_err(5) = desc_dec(psb_n_) - else if (desc_dec(psb_m_).lt.jx) then - info=60 - int_err(1) = 5 - int_err(2) = jx - int_err(3) = 6 - int_err(4) = psb_m_ - int_err(5) = desc_dec(psb_m_) - else if (desc_dec(psb_n_).lt.(ix+m-1)) then - info=80 - int_err(1) = 1 - int_err(2) = m - int_err(3) = 4 - int_err(4) = ix - end if - - if (info.ne.0) then - call psb_errpush(info,name,i_err=int_err) - goto 9999 - end if - - ! Compute local indices for submatrix starting - ! at global indices ix and jx - if(present(iix)) iix=ix ! (for our applications iix=ix)) - if(present(jjx)) jjx=jx ! (for our applications jjx=jx)) - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - - if (err_act.eq.act_abort) then - call psb_error() - return - end if - return - -end subroutine psb_chkvect diff --git a/src/psblas/psb_damax.f90 b/src/psblas/psb_damax.f90 index 4ba54957..5ba35918 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -86,9 +86,9 @@ function psb_damax (x,desc_a, info, jx) ijx = 1 endif - m = desc_a%matrix_data(psb_m_) + m = psb_get_global_rows(desc_a) - call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx) + call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx) if(info.ne.0) then info=4010 ch_err='psb_chkvect' @@ -103,8 +103,8 @@ function psb_damax (x,desc_a, info, jx) end if ! compute local max - if ((desc_a%matrix_data(psb_n_row_).gt.0).and.(m.ne.0)) then - imax=idamax(desc_a%matrix_data(psb_n_row_)-iix+1,x(iix,jjx),1) + if ((psb_get_local_rows(desc_a).gt.0).and.(m.ne.0)) then + imax=idamax(psb_get_local_rows(desc_a)-iix+1,x(iix,jjx),1) amax=abs(x(iix+imax-1,jjx)) end if @@ -195,7 +195,7 @@ function psb_damaxv (x,desc_a, info) amax=0.d0 - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -207,9 +207,9 @@ function psb_damaxv (x,desc_a, info) ix = 1 jx = 1 - m = desc_a%matrix_data(psb_m_) + m = psb_get_global_rows(desc_a) - call psb_chkvect(m,1,size(x,1),ix,jx,desc_a%matrix_data,info,iix,jjx) + call psb_chkvect(m,1,size(x,1),ix,jx,desc_a,info,iix,jjx) if(info.ne.0) then info=4010 ch_err='psb_chkvect' @@ -224,8 +224,8 @@ function psb_damaxv (x,desc_a, info) end if ! compute local max - if ((desc_a%matrix_data(psb_n_row_).gt.0).and.(m.ne.0)) then - imax=idamax(desc_a%matrix_data(psb_n_row_)-iix+1,x(iix),1) + if ((psb_get_local_rows(desc_a).gt.0).and.(m.ne.0)) then + imax=idamax(psb_get_local_rows(desc_a)-iix+1,x(iix),1) amax=abs(x(iix+imax-1)) end if @@ -318,7 +318,7 @@ subroutine psb_damaxvs (res,x,desc_a, info) amax=0.d0 - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -330,9 +330,9 @@ subroutine psb_damaxvs (res,x,desc_a, info) ix = 1 ijx=1 - m = desc_a%matrix_data(psb_m_) + m = psb_get_global_rows(desc_a) - call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx) + call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx) if(info.ne.0) then info=4010 ch_err='psb_chkvect' @@ -347,8 +347,8 @@ subroutine psb_damaxvs (res,x,desc_a, info) end if ! compute local max - if ((desc_a%matrix_data(psb_n_row_).gt.0).and.(m.ne.0)) then - imax=idamax(desc_a%matrix_data(psb_n_row_)-iix+1,x(iix),1) + if ((psb_get_local_rows(desc_a).gt.0).and.(m.ne.0)) then + imax=idamax(psb_get_local_rows(desc_a)-iix+1,x(iix),1) amax=abs(x(iix+imax-1)) end if @@ -440,7 +440,7 @@ subroutine psb_dmamaxs (res,x,desc_a, info,jx) amax=0.d0 - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -456,10 +456,10 @@ subroutine psb_dmamaxs (res,x,desc_a, info,jx) ijx = 1 endif - m = desc_a%matrix_data(psb_m_) + m = psb_get_global_rows(desc_a) k = min(size(x,2),size(res,1)) - call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx) + call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx) if(info.ne.0) then info=4010 ch_err='psb_chkvect' @@ -474,9 +474,9 @@ subroutine psb_dmamaxs (res,x,desc_a, info,jx) end if ! compute local max - if ((desc_a%matrix_data(psb_n_row_).gt.0).and.(m.ne.0)) then + if ((psb_get_local_rows(desc_a).gt.0).and.(m.ne.0)) then do i=1,k - imax=idamax(desc_a%matrix_data(psb_n_row_)-iix+1,x(iix,jjx+i-1),1) + imax=idamax(psb_get_local_rows(desc_a)-iix+1,x(iix,jjx+i-1),1) res(i)=abs(x(iix+imax-1,jjx+i-1)) end do end if diff --git a/src/psblas/psb_dasum.f90 b/src/psblas/psb_dasum.f90 index 8f90cd37..5d8efe7f 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -87,10 +87,10 @@ function psb_dasum (x,desc_a, info, jx) ijx = 1 endif - m = desc_a%matrix_data(psb_m_) + m = psb_get_global_rows(desc_a) ! check vector correctness - call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx) + call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx) if(info.ne.0) then info=4010 ch_err='psb_chkvect' @@ -106,8 +106,8 @@ function psb_dasum (x,desc_a, info, jx) ! compute local max if ((m.ne.0)) then - if(desc_a%matrix_data(psb_n_row_).gt.0) then - asum=dasum(desc_a%matrix_data(psb_n_row_)-iix+1,x(iix,jjx),ione) + if(psb_get_local_rows(desc_a).gt.0) then + asum=dasum(psb_get_local_rows(desc_a)-iix+1,x(iix,jjx),ione) ! adjust asum because overlapped elements are computed more than once i=1 @@ -213,7 +213,7 @@ function psb_dasumv (x,desc_a, info) asum=0.d0 - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -225,10 +225,10 @@ function psb_dasumv (x,desc_a, info) ix = 1 jx=1 - m = desc_a%matrix_data(psb_m_) + m = psb_get_global_rows(desc_a) ! check vector correctness - call psb_chkvect(m,1,size(x),ix,jx,desc_a%matrix_data,info,iix,jjx) + call psb_chkvect(m,1,size(x),ix,jx,desc_a,info,iix,jjx) if(info.ne.0) then info=4010 ch_err='psb_chkvect' @@ -244,8 +244,8 @@ function psb_dasumv (x,desc_a, info) ! compute local max if ((m.ne.0)) then - if(desc_a%matrix_data(psb_n_row_).gt.0) then - asum=dasum(desc_a%matrix_data(psb_n_row_),x,ione) + if(psb_get_local_rows(desc_a).gt.0) then + asum=dasum(psb_get_local_rows(desc_a),x,ione) ! adjust asum because overlapped elements are computed more than once i=1 @@ -351,7 +351,7 @@ subroutine psb_dasumvs (res,x,desc_a, info) asum=0.d0 - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -363,10 +363,10 @@ subroutine psb_dasumvs (res,x,desc_a, info) ix = 1 jx = 1 - m = desc_a%matrix_data(psb_m_) + m = psb_get_global_rows(desc_a) ! check vector correctness - call psb_chkvect(m,1,size(x),ix,jx,desc_a%matrix_data,info,iix,jjx) + call psb_chkvect(m,1,size(x),ix,jx,desc_a,info,iix,jjx) if(info.ne.0) then info=4010 ch_err='psb_chkvect' @@ -382,8 +382,8 @@ subroutine psb_dasumvs (res,x,desc_a, info) ! compute local max if ((m.ne.0)) then - if(desc_a%matrix_data(psb_n_row_).gt.0) then - asum=dasum(desc_a%matrix_data(psb_n_row_),x,ione) + if(psb_get_local_rows(desc_a).gt.0) then + asum=dasum(psb_get_local_rows(desc_a),x,ione) ! adjust asum because overlapped elements are computed more than once i=1 diff --git a/src/psblas/psb_daxpby.f90 b/src/psblas/psb_daxpby.f90 index 2bf43c64..e55d16c6 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -ione) then @@ -115,11 +115,12 @@ subroutine psb_daxpby(alpha, x, beta,y,desc_a,info, n, jx, jy) goto 9999 end if - m = desc_a%matrix_data(psb_m_) + m = psb_get_global_rows(desc_a) ! check vector correctness - call psb_chkvect(m,ione,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx) - call psb_chkvect(m,ione,size(y,1),iy,ijy,desc_a%matrix_data,info,iiy,jjy) + call psb_chkvect(m,ione,size(x,1),ix,ijx,desc_a,info,iix,jjx) + if (info == 0) & + & call psb_chkvect(m,ione,size(y,1),iy,ijy,desc_a,info,iiy,jjy) if(info.ne.0) then info=4010 ch_err='psb_chkvect' @@ -134,8 +135,8 @@ subroutine psb_daxpby(alpha, x, beta,y,desc_a,info, n, jx, jy) end if if ((in.ne.0)) then - if(desc_a%matrix_data(psb_n_row_).gt.0) then - call daxpby(desc_a%matrix_data(psb_n_row_),in,& + if(psb_get_local_rows(desc_a).gt.0) then + call daxpby(psb_get_local_rows(desc_a),in,& & alpha,x(iix,jjx),size(x,1),beta,& & y(iiy,jjy),size(y,1),info) end if @@ -227,7 +228,7 @@ subroutine psb_daxpbyv(alpha, x, beta,y,desc_a,info) info=0 call psb_erractionsave(err_act) - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -ione) then @@ -239,17 +240,17 @@ subroutine psb_daxpbyv(alpha, x, beta,y,desc_a,info) ix = ione iy = ione - m = desc_a%matrix_data(psb_m_) + m = psb_get_global_rows(desc_a) ! check vector correctness - call psb_chkvect(m,ione,size(x),ix,ione,desc_a%matrix_data,info,iix,jjx) + call psb_chkvect(m,ione,size(x),ix,ione,desc_a,info,iix,jjx) if(info.ne.0) then info=4010 ch_err='psb_chkvect 1' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - call psb_chkvect(m,ione,size(y),iy,ione,desc_a%matrix_data,info,iiy,jjy) + call psb_chkvect(m,ione,size(y),iy,ione,desc_a,info,iiy,jjy) if(info.ne.0) then info=4010 ch_err='psb_chkvect 2' @@ -262,8 +263,8 @@ subroutine psb_daxpbyv(alpha, x, beta,y,desc_a,info) call psb_errpush(info,name) end if - if(desc_a%matrix_data(psb_n_row_).gt.0) then - call daxpby(desc_a%matrix_data(psb_n_row_),ione,& + if(psb_get_local_rows(desc_a).gt.0) then + call daxpby(psb_get_local_rows(desc_a),ione,& & alpha,x,size(x),beta,& & y,size(y),info) end if diff --git a/src/psblas/psb_ddot.f90 b/src/psblas/psb_ddot.f90 index 0b1ba413..38521e26 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -ione) then @@ -101,11 +101,12 @@ function psb_ddot(x, y,desc_a, info, jx, jy) goto 9999 end if - m = desc_a%matrix_data(psb_m_) + m = psb_get_global_rows(desc_a) ! check vector correctness - call psb_chkvect(m,ione,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx) - call psb_chkvect(m,ione,size(y,1),iy,ijy,desc_a%matrix_data,info,iiy,jjy) + call psb_chkvect(m,ione,size(x,1),ix,ijx,desc_a,info,iix,jjx) + if (info == 0) & + & call psb_chkvect(m,ione,size(y,1),iy,ijy,desc_a,info,iiy,jjy) if(info.ne.0) then info=4010 ch_err='psb_chkvect' @@ -120,8 +121,8 @@ function psb_ddot(x, y,desc_a, info, jx, jy) end if if(m.ne.0) then - if(desc_a%matrix_data(psb_n_row_).gt.0) then - dot_local = ddot(desc_a%matrix_data(psb_n_row_),& + if(psb_get_local_rows(desc_a).gt.0) then + dot_local = ddot(psb_get_local_rows(desc_a),& & x(iix,jjx),ione,y(iiy,jjy),ione) ! adjust dot_local because overlapped elements are computed more than once i=1 @@ -225,7 +226,7 @@ function psb_ddotv(x, y,desc_a, info) info=0 call psb_erractionsave(err_act) - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -ione) then @@ -238,11 +239,12 @@ function psb_ddotv(x, y,desc_a, info) iy = ione jx = ione jy = ione - m = desc_a%matrix_data(psb_m_) + m = psb_get_global_rows(desc_a) ! check vector correctness - call psb_chkvect(m,ione,size(x,1),ix,jx,desc_a%matrix_data,info,iix,jjx) - call psb_chkvect(m,ione,size(y,1),iy,jy,desc_a%matrix_data,info,iiy,jjy) + call psb_chkvect(m,ione,size(x,1),ix,jx,desc_a,info,iix,jjx) + if (info == 0) & + & call psb_chkvect(m,ione,size(y,1),iy,jy,desc_a,info,iiy,jjy) if(info.ne.0) then info=4010 ch_err='psb_chkvect' @@ -257,8 +259,8 @@ function psb_ddotv(x, y,desc_a, info) end if if(m.ne.0) then - if(desc_a%matrix_data(psb_n_row_).gt.0) then - dot_local = ddot(desc_a%matrix_data(psb_n_row_),& + if(psb_get_local_rows(desc_a).gt.0) then + dot_local = ddot(psb_get_local_rows(desc_a),& & x,ione,y,ione) ! adjust dot_local because overlapped elements are computed more than once i=1 @@ -362,7 +364,7 @@ subroutine psb_ddotvs(res, x, y,desc_a, info) info=0 call psb_erractionsave(err_act) - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -ione) then @@ -373,11 +375,12 @@ subroutine psb_ddotvs(res, x, y,desc_a, info) ix = ione iy = ione - m = desc_a%matrix_data(psb_m_) + m = psb_get_global_rows(desc_a) ! check vector correctness - call psb_chkvect(m,ione,size(x,1),ix,ix,desc_a%matrix_data,info,iix,jjx) - call psb_chkvect(m,ione,size(y,1),iy,iy,desc_a%matrix_data,info,iiy,jjy) + call psb_chkvect(m,ione,size(x,1),ix,ix,desc_a,info,iix,jjx) + if (info == 0) & + & call psb_chkvect(m,ione,size(y,1),iy,iy,desc_a,info,iiy,jjy) if(info.ne.0) then info=4010 ch_err='psb_chkvect' @@ -392,8 +395,8 @@ subroutine psb_ddotvs(res, x, y,desc_a, info) end if if(m.ne.0) then - if(desc_a%matrix_data(psb_n_row_).gt.0) then - dot_local = ddot(desc_a%matrix_data(psb_n_row_),& + if(psb_get_local_rows(desc_a).gt.0) then + dot_local = ddot(psb_get_local_rows(desc_a),& & x,ione,y,ione) ! adjust dot_local because overlapped elements are computed more than once i=1 @@ -502,7 +505,7 @@ subroutine psb_dmdots(res, x, y, desc_a, info) info=0 call psb_erractionsave(err_act) - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -ione) then @@ -514,17 +517,17 @@ subroutine psb_dmdots(res, x, y, desc_a, info) ix = ione iy = ione - m = desc_a%matrix_data(psb_m_) + m = psb_get_global_rows(desc_a) ! check vector correctness - call psb_chkvect(m,ione,size(x,1),ix,ix,desc_a%matrix_data,info,iix,jjx) + call psb_chkvect(m,ione,size(x,1),ix,ix,desc_a,info,iix,jjx) if(info.ne.0) then info=4010 ch_err='psb_chkvect' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - call psb_chkvect(m,ione,size(y,1),iy,iy,desc_a%matrix_data,info,iiy,jjy) + call psb_chkvect(m,ione,size(y,1),iy,iy,desc_a,info,iiy,jjy) if(info.ne.0) then info=4010 ch_err='psb_chkvect' @@ -542,9 +545,9 @@ subroutine psb_dmdots(res, x, y, desc_a, info) allocate(dot_local(k)) if(m.ne.0) then - if(desc_a%matrix_data(psb_n_row_).gt.0) then + if(psb_get_local_rows(desc_a).gt.0) then do j=1,k - dot_local(j) = ddot(desc_a%matrix_data(psb_n_row_),& + dot_local(j) = ddot(psb_get_local_rows(desc_a),& & x(1,j),ione,y(1,j),ione) ! adjust dot_local because overlapped elements are computed more than once i=1 @@ -608,7 +611,7 @@ subroutine psb_ddot2v(res, x, y,w,z,desc_a, info) info=0 call psb_erractionsave(err_act) - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -ione) then @@ -619,11 +622,12 @@ subroutine psb_ddot2v(res, x, y,w,z,desc_a, info) ix = ione iy = ione - m = desc_a%matrix_data(psb_m_) + m = psb_get_global_rows(desc_a) ! check vector correctness - call psb_chkvect(m,ione,size(x,1),ix,ix,desc_a%matrix_data,info,iix,jjx) - call psb_chkvect(m,ione,size(y,1),iy,iy,desc_a%matrix_data,info,iiy,jjy) + call psb_chkvect(m,ione,size(x,1),ix,ix,desc_a,info,iix,jjx) + if (info == 0) & + & call psb_chkvect(m,ione,size(y,1),iy,iy,desc_a,info,iiy,jjy) if(info.ne.0) then info=4010 ch_err='psb_chkvect' @@ -638,10 +642,10 @@ subroutine psb_ddot2v(res, x, y,w,z,desc_a, info) end if if(m.ne.0) then - if(desc_a%matrix_data(psb_n_row_).gt.0) then - dot_local(1) = ddot(desc_a%matrix_data(psb_n_row_),& + if(psb_get_local_rows(desc_a).gt.0) then + dot_local(1) = ddot(psb_get_local_rows(desc_a),& & x,ione,y,ione) - dot_local(2) = ddot(desc_a%matrix_data(psb_n_row_),& + dot_local(2) = ddot(psb_get_local_rows(desc_a),& & w,ione,z,ione) ! adjust dot_local because overlapped elements are computed more than once i=1 diff --git a/src/psblas/psb_dnrm2.f90 b/src/psblas/psb_dnrm2.f90 index b69dc90d..69a94274 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -84,9 +84,9 @@ function psb_dnrm2(x, desc_a, info, jx) ijx = 1 endif - m = desc_a%matrix_data(psb_m_) + m = psb_get_global_rows(desc_a) - call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx) + call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx) if(info.ne.0) then info=4010 ch_err='psb_chkvect' @@ -100,8 +100,8 @@ function psb_dnrm2(x, desc_a, info, jx) end if if(m.ne.0) then - if (desc_a%matrix_data(psb_n_row_) .gt. 0) then - ndim = desc_a%matrix_data(psb_n_row_) + if (psb_get_local_rows(desc_a) .gt. 0) then + ndim = psb_get_local_rows(desc_a) nrm2 = dnrm2( ndim, x(iix,jjx), ione ) i=1 do while (desc_a%ovrlap_elem(i) .ne. -1) @@ -205,7 +205,7 @@ function psb_dnrm2v(x, desc_a, info) info=0 call psb_erractionsave(err_act) - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -217,10 +217,10 @@ function psb_dnrm2v(x, desc_a, info) ix = 1 jx=1 - m = desc_a%matrix_data(psb_m_) + m = psb_get_global_rows(desc_a) - call psb_chkvect(m,1,size(x),ix,jx,desc_a%matrix_data,info,iix,jjx) + call psb_chkvect(m,1,size(x),ix,jx,desc_a,info,iix,jjx) if(info.ne.0) then info=4010 ch_err='psb_chkvect' @@ -234,8 +234,8 @@ function psb_dnrm2v(x, desc_a, info) end if if(m.ne.0) then - if (desc_a%matrix_data(psb_n_row_) .gt. 0) then - ndim = desc_a%matrix_data(psb_n_row_) + if (psb_get_local_rows(desc_a) .gt. 0) then + ndim = psb_get_local_rows(desc_a) nrm2 = dnrm2( ndim, x, ione ) i=1 do while (desc_a%ovrlap_elem(i) .ne. -1) @@ -341,7 +341,7 @@ subroutine psb_dnrm2vs(res, x, desc_a, info) info=0 call psb_erractionsave(err_act) - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -352,9 +352,9 @@ subroutine psb_dnrm2vs(res, x, desc_a, info) ix = 1 jx = 1 - m = desc_a%matrix_data(psb_m_) + m = psb_get_global_rows(desc_a) - call psb_chkvect(m,1,size(x),ix,jx,desc_a%matrix_data,info,iix,jjx) + call psb_chkvect(m,1,size(x),ix,jx,desc_a,info,iix,jjx) if(info.ne.0) then info=4010 ch_err='psb_chkvect' @@ -368,8 +368,8 @@ subroutine psb_dnrm2vs(res, x, desc_a, info) end if if(m.ne.0) then - if (desc_a%matrix_data(psb_n_row_) .gt. 0) then - ndim = desc_a%matrix_data(psb_n_row_) + if (psb_get_local_rows(desc_a) .gt. 0) then + ndim = psb_get_local_rows(desc_a) nrm2 = dnrm2( ndim, x, ione ) i=1 do while (desc_a%ovrlap_elem(i) .ne. -1) diff --git a/src/psblas/psb_dnrmi.f90 b/src/psblas/psb_dnrmi.f90 index 587fa653..07c3cdb5 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -75,10 +75,10 @@ function psb_dnrmi(a,desc_a,info) ia = 1 ja = 1 - m = desc_a%matrix_data(psb_m_) - n = desc_a%matrix_data(psb_n_) + m = psb_get_global_rows(desc_a) + n = psb_get_global_cols(desc_a) - call psb_chkmat(m,n,ia,ja,desc_a%matrix_data,info,iia,jja) + call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja) if(info.ne.0) then info=4010 ch_err='psb_chkmat' @@ -93,8 +93,8 @@ function psb_dnrmi(a,desc_a,info) end if if ((m.ne.0).and.(n.ne.0)) then - mdim = desc_a%matrix_data(psb_n_row_) - ndim = desc_a%matrix_data(psb_n_col_) + mdim = psb_get_local_rows(desc_a) + ndim = psb_get_local_cols(desc_a) nrmi = dcsnmi('N',mdim,ndim,a%fida,& & a%descra,a%aspk,a%ia1,a%ia2,& & a%infoa,info) diff --git a/src/psblas/psb_dspmm.f90 b/src/psblas/psb_dspmm.f90 index cf477561..6343e6da 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -172,10 +172,10 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,& itrans = 'N' endif - m = desc_a%matrix_data(psb_m_) - n = desc_a%matrix_data(psb_n_) - nrow = desc_a%matrix_data(psb_n_row_) - ncol = desc_a%matrix_data(psb_n_col_) + m = psb_get_global_rows(desc_a) + n = psb_get_global_cols(desc_a) + nrow = psb_get_local_rows(desc_a) + ncol = psb_get_local_cols(desc_a) lldx = size(x,1) lldy = size(y,1) @@ -208,7 +208,7 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,& iwork(1)=dzero ! checking for matrix correctness - call psb_chkmat(m,n,ia,ja,desc_a%matrix_data,info,iia,jja) + call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja) if(info /= 0) then info=4010 ch_err='psb_chkmat' @@ -227,8 +227,9 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,& end if ! checking for vectors correctness - call psb_chkvect(n,ik,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx) - call psb_chkvect(m,ik,size(y,1),iy,ijy,desc_a%matrix_data,info,iiy,jjy) + call psb_chkvect(n,ik,size(x,1),ix,ijx,desc_a,info,iix,jjx) + if (info == 0) & + & call psb_chkvect(m,ik,size(y,1),iy,ijy,desc_a,info,iiy,jjy) if(info /= 0) then info=4010 ch_err='psb_chkvect' @@ -296,8 +297,9 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,& end if ! checking for vectors correctness - call psb_chkvect(m,ik,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx) - call psb_chkvect(n,ik,size(y,1),iy,ijy,desc_a%matrix_data,info,iiy,jjy) + call psb_chkvect(m,ik,size(x,1),ix,ijx,desc_a,info,iix,jjx) + if (info == 0) & + & call psb_chkvect(n,ik,size(y,1),iy,ijy,desc_a,info,iiy,jjy) if(info /= 0) then info=4010 ch_err='psb_chkvect' @@ -453,7 +455,7 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,& info=0 call psb_erractionsave(err_act) - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -493,10 +495,10 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,& itrans = 'N' endif - m = desc_a%matrix_data(psb_m_) - n = desc_a%matrix_data(psb_n_) - nrow = desc_a%matrix_data(psb_n_row_) - ncol = desc_a%matrix_data(psb_n_col_) + m = psb_get_global_rows(desc_a) + n = psb_get_global_cols(desc_a) + nrow = psb_get_local_rows(desc_a) + ncol = psb_get_local_cols(desc_a) lldx = size(x) lldy = size(y) @@ -531,7 +533,7 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,& if (debug) write(0,*) me,name,' Allocated work ', info ! checking for matrix correctness - call psb_chkmat(m,n,ia,ja,desc_a%matrix_data,info,iia,jja) + call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja) if(info /= 0) then info=4010 ch_err='psb_chkmat' @@ -550,8 +552,9 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,& end if ! checking for vectors correctness - call psb_chkvect(n,ik,size(x),ix,jx,desc_a%matrix_data,info,iix,jjx) - call psb_chkvect(m,ik,size(y),iy,jy,desc_a%matrix_data,info,iiy,jjy) + call psb_chkvect(n,ik,size(x),ix,jx,desc_a,info,iix,jjx) + if (info == 0) & + & call psb_chkvect(m,ik,size(y),iy,jy,desc_a,info,iiy,jjy) if(info /= 0) then info=4010 ch_err='psb_chkvect' @@ -598,8 +601,9 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,& end if ! checking for vectors correctness - call psb_chkvect(m,ik,size(x),ix,jx,desc_a%matrix_data,info,iix,jjx) - call psb_chkvect(n,ik,size(y),iy,jy,desc_a%matrix_data,info,iiy,jjy) + call psb_chkvect(m,ik,size(x),ix,jx,desc_a,info,iix,jjx) + if (info == 0)& + & call psb_chkvect(n,ik,size(y),iy,jy,desc_a,info,iiy,jjy) if(info /= 0) then info=4010 ch_err='psb_chkvect' diff --git a/src/psblas/psb_dspsm.f90 b/src/psblas/psb_dspsm.f90 index 6328cb6e..40650a0b 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -174,9 +174,9 @@ subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,& itrans = 'N' endif - m = desc_a%matrix_data(psb_m_) - nrow = desc_a%matrix_data(psb_n_row_) - ncol = desc_a%matrix_data(psb_n_col_) + m = psb_get_global_rows(desc_a) + nrow = psb_get_local_rows(desc_a) + ncol = psb_get_local_cols(desc_a) lldx = size(x,1) lldy = size(y,1) @@ -225,10 +225,12 @@ subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,& end if ! checking for matrix correctness - call psb_chkmat(m,m,ia,ja,desc_a%matrix_data,info,iia,jja) + call psb_chkmat(m,m,ia,ja,desc_a,info,iia,jja) ! checking for vectors correctness - call psb_chkvect(m,ik,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx) - call psb_chkvect(m,ik,size(y,1),iy,ijy,desc_a%matrix_data,info,iiy,jjy) + if (info == 0) & + & call psb_chkvect(m,ik,size(x,1),ix,ijx,desc_a,info,iix,jjx) + if (info == 0) & + & call psb_chkvect(m,ik,size(y,1),iy,ijy,desc_a,info,iiy,jjy) if(info.ne.0) then info=4010 ch_err='psb_chkvect/mat' @@ -417,7 +419,7 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,& info=0 call psb_erractionsave(err_act) - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -464,9 +466,9 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,& itrans = 'N' endif - m = desc_a%matrix_data(psb_m_) - nrow = desc_a%matrix_data(psb_n_row_) - ncol = desc_a%matrix_data(psb_n_col_) + m = psb_get_global_rows(desc_a) + nrow = psb_get_local_rows(desc_a) + ncol = psb_get_local_cols(desc_a) lldx = size(x) lldy = size(y) @@ -516,10 +518,12 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,& end if ! checking for matrix correctness - call psb_chkmat(m,m,ia,ja,desc_a%matrix_data,info,iia,jja) + call psb_chkmat(m,m,ia,ja,desc_a,info,iia,jja) ! checking for vectors correctness - call psb_chkvect(m,ik,size(x),ix,jx,desc_a%matrix_data,info,iix,jjx) - call psb_chkvect(m,ik,size(y),iy,jy,desc_a%matrix_data,info,iiy,jjy) + if (info == 0) & + & call psb_chkvect(m,ik,size(x),ix,jx,desc_a,info,iix,jjx) + if (info == 0)& + & call psb_chkvect(m,ik,size(y),iy,jy,desc_a,info,iiy,jjy) if(info.ne.0) then info=4010 ch_err='psb_chkvect/mat' diff --git a/src/psblas/psb_zamax.f90 b/src/psblas/psb_zamax.f90 index 4bbc63cf..1e5d6ed5 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -89,9 +89,9 @@ function psb_zamax (x,desc_a, info, jx) ijx = 1 endif - m = desc_a%matrix_data(psb_m_) + m = psb_get_global_rows(desc_a) - call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx) + call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx) if(info.ne.0) then info=4010 ch_err='psb_chkvect' @@ -106,8 +106,8 @@ function psb_zamax (x,desc_a, info, jx) end if ! compute local max - if ((desc_a%matrix_data(psb_n_row_).gt.0).and.(m.ne.0)) then - imax=izamax(desc_a%matrix_data(psb_n_row_)-iix+1,x(iix,jjx),1) + if ((psb_get_local_rows(desc_a).gt.0).and.(m.ne.0)) then + imax=izamax(psb_get_local_rows(desc_a)-iix+1,x(iix,jjx),1) amax=cabs1(x(iix+imax-1,jjx)) end if @@ -202,7 +202,7 @@ function psb_zamaxv (x,desc_a, info) amax=0.d0 - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -214,9 +214,9 @@ function psb_zamaxv (x,desc_a, info) ix = 1 jx = 1 - m = desc_a%matrix_data(psb_m_) + m = psb_get_global_rows(desc_a) - call psb_chkvect(m,1,size(x,1),ix,jx,desc_a%matrix_data,info,iix,jjx) + call psb_chkvect(m,1,size(x,1),ix,jx,desc_a,info,iix,jjx) if(info.ne.0) then info=4010 ch_err='psb_chkvect' @@ -231,8 +231,8 @@ function psb_zamaxv (x,desc_a, info) end if ! compute local max - if ((desc_a%matrix_data(psb_n_row_).gt.0).and.(m.ne.0)) then - imax=izamax(desc_a%matrix_data(psb_n_row_)-iix+1,x(iix),1) + if ((psb_get_local_rows(desc_a).gt.0).and.(m.ne.0)) then + imax=izamax(psb_get_local_rows(desc_a)-iix+1,x(iix),1) cmax=(x(iix+imax-1)) amax=cabs1(cmax) end if @@ -330,7 +330,7 @@ subroutine psb_zamaxvs (res,x,desc_a, info) amax=0.d0 - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -342,9 +342,9 @@ subroutine psb_zamaxvs (res,x,desc_a, info) ix = 1 ijx=1 - m = desc_a%matrix_data(psb_m_) + m = psb_get_global_rows(desc_a) - call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx) + call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx) if(info.ne.0) then info=4010 ch_err='psb_chkvect' @@ -359,8 +359,8 @@ subroutine psb_zamaxvs (res,x,desc_a, info) end if ! compute local max - if ((desc_a%matrix_data(psb_n_row_).gt.0).and.(m.ne.0)) then - imax=izamax(desc_a%matrix_data(psb_n_row_)-iix+1,x(iix),1) + if ((psb_get_local_rows(desc_a).gt.0).and.(m.ne.0)) then + imax=izamax(psb_get_local_rows(desc_a)-iix+1,x(iix),1) cmax=(x(iix+imax-1)) amax=cabs1(cmax) end if @@ -457,7 +457,7 @@ subroutine psb_zmamaxs (res,x,desc_a, info,jx) amax=0.d0 - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -473,10 +473,10 @@ subroutine psb_zmamaxs (res,x,desc_a, info,jx) ijx = 1 endif - m = desc_a%matrix_data(psb_m_) + m = psb_get_global_rows(desc_a) k = min(size(x,2),size(res,1)) - call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx) + call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx) if(info.ne.0) then info=4010 ch_err='psb_chkvect' @@ -491,9 +491,9 @@ subroutine psb_zmamaxs (res,x,desc_a, info,jx) end if ! compute local max - if ((desc_a%matrix_data(psb_n_row_).gt.0).and.(m.ne.0)) then + if ((psb_get_local_rows(desc_a).gt.0).and.(m.ne.0)) then do i=1,k - imax=izamax(desc_a%matrix_data(psb_n_row_)-iix+1,x(iix,jjx+i-1),1) + imax=izamax(psb_get_local_rows(desc_a)-iix+1,x(iix,jjx+i-1),1) cmax=(x(iix+imax-1,jjx+i-1)) res(i)=cabs1(cmax) end do diff --git a/src/psblas/psb_zasum.f90 b/src/psblas/psb_zasum.f90 index 5cdde6cb..b3c1da5a 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -91,10 +91,10 @@ function psb_zasum (x,desc_a, info, jx) ijx = 1 endif - m = desc_a%matrix_data(psb_m_) + m = psb_get_global_rows(desc_a) ! check vector correctness - call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx) + call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx) if(info.ne.0) then info=4010 ch_err='psb_chkvect' @@ -110,8 +110,8 @@ function psb_zasum (x,desc_a, info, jx) ! compute local max if ((m.ne.0)) then - if(desc_a%matrix_data(psb_n_row_).gt.0) then - asum=dzasum(desc_a%matrix_data(psb_n_row_)-iix+1,x(iix,jjx),ione) + if(psb_get_local_rows(desc_a).gt.0) then + asum=dzasum(psb_get_local_rows(desc_a)-iix+1,x(iix,jjx),ione) ! adjust asum because overlapped elements are computed more than once i=1 @@ -223,7 +223,7 @@ function psb_zasumv (x,desc_a, info) asum=0.d0 - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -235,10 +235,10 @@ function psb_zasumv (x,desc_a, info) ix = 1 jx=1 - m = desc_a%matrix_data(psb_m_) + m = psb_get_global_rows(desc_a) ! check vector correctness - call psb_chkvect(m,1,size(x),ix,jx,desc_a%matrix_data,info,iix,jjx) + call psb_chkvect(m,1,size(x),ix,jx,desc_a,info,iix,jjx) if(info.ne.0) then info=4010 ch_err='psb_chkvect' @@ -254,8 +254,8 @@ function psb_zasumv (x,desc_a, info) ! compute local max if ((m.ne.0)) then - if(desc_a%matrix_data(psb_n_row_).gt.0) then - asum=dzasum(desc_a%matrix_data(psb_n_row_),x,ione) + if(psb_get_local_rows(desc_a).gt.0) then + asum=dzasum(psb_get_local_rows(desc_a),x,ione) ! adjust asum because overlapped elements are computed more than once i=1 @@ -367,7 +367,7 @@ subroutine psb_zasumvs (res,x,desc_a, info) asum=0.d0 - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -379,10 +379,10 @@ subroutine psb_zasumvs (res,x,desc_a, info) ix = 1 jx = 1 - m = desc_a%matrix_data(psb_m_) + m = psb_get_global_rows(desc_a) ! check vector correctness - call psb_chkvect(m,1,size(x),ix,jx,desc_a%matrix_data,info,iix,jjx) + call psb_chkvect(m,1,size(x),ix,jx,desc_a,info,iix,jjx) if(info.ne.0) then info=4010 ch_err='psb_chkvect' @@ -398,8 +398,8 @@ subroutine psb_zasumvs (res,x,desc_a, info) ! compute local max if ((m.ne.0)) then - if(desc_a%matrix_data(psb_n_row_).gt.0) then - asum=dzasum(desc_a%matrix_data(psb_n_row_),x,ione) + if(psb_get_local_rows(desc_a).gt.0) then + asum=dzasum(psb_get_local_rows(desc_a),x,ione) ! adjust asum because overlapped elements are computed more than once i=1 diff --git a/src/psblas/psb_zaxpby.f90 b/src/psblas/psb_zaxpby.f90 index 070af637..689a20af 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -ione) then @@ -114,11 +114,12 @@ subroutine psb_zaxpby(alpha, x, beta,y,desc_a,info, n, jx, jy) goto 9999 end if - m = desc_a%matrix_data(psb_m_) + m = psb_get_global_rows(desc_a) ! check vector correctness - call psb_chkvect(m,ione,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx) - call psb_chkvect(m,ione,size(y,1),iy,ijy,desc_a%matrix_data,info,iiy,jjy) + call psb_chkvect(m,ione,size(x,1),ix,ijx,desc_a,info,iix,jjx) + if (info == 0) & + & call psb_chkvect(m,ione,size(y,1),iy,ijy,desc_a,info,iiy,jjy) if(info.ne.0) then info=4010 ch_err='psb_chkvect' @@ -133,8 +134,8 @@ subroutine psb_zaxpby(alpha, x, beta,y,desc_a,info, n, jx, jy) end if if ((in.ne.0)) then - if(desc_a%matrix_data(psb_n_row_).gt.0) then - call zaxpby(desc_a%matrix_data(psb_n_col_),in,& + if(psb_get_local_rows(desc_a).gt.0) then + call zaxpby(psb_get_local_cols(desc_a),in,& & alpha,x(iix,jjx),size(x,1),beta,& & y(iiy,jjy),size(y,1),info) end if @@ -226,7 +227,7 @@ subroutine psb_zaxpbyv(alpha, x, beta,y,desc_a,info) info=0 call psb_erractionsave(err_act) - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -ione) then @@ -238,17 +239,17 @@ subroutine psb_zaxpbyv(alpha, x, beta,y,desc_a,info) ix = ione iy = ione - m = desc_a%matrix_data(psb_m_) + m = psb_get_global_rows(desc_a) ! check vector correctness - call psb_chkvect(m,ione,size(x),ix,ione,desc_a%matrix_data,info,iix,jjx) + call psb_chkvect(m,ione,size(x),ix,ione,desc_a,info,iix,jjx) if(info.ne.0) then info=4010 ch_err='psb_chkvect 1' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - call psb_chkvect(m,ione,size(y),iy,ione,desc_a%matrix_data,info,iiy,jjy) + call psb_chkvect(m,ione,size(y),iy,ione,desc_a,info,iiy,jjy) if(info.ne.0) then info=4010 ch_err='psb_chkvect 2' @@ -261,8 +262,8 @@ subroutine psb_zaxpbyv(alpha, x, beta,y,desc_a,info) call psb_errpush(info,name) end if - if(desc_a%matrix_data(psb_n_row_).gt.0) then - call zaxpby(desc_a%matrix_data(psb_n_col_),ione,& + if(psb_get_local_rows(desc_a).gt.0) then + call zaxpby(psb_get_local_cols(desc_a),ione,& & alpha,x,size(x),beta,& & y,size(y),info) end if diff --git a/src/psblas/psb_zdot.f90 b/src/psblas/psb_zdot.f90 index a30e2eaf..5ffcad40 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -ione) then @@ -101,11 +101,12 @@ function psb_zdot(x, y,desc_a, info, jx, jy) goto 9999 end if - m = desc_a%matrix_data(psb_m_) + m = psb_get_global_rows(desc_a) ! check vector correctness - call psb_chkvect(m,ione,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx) - call psb_chkvect(m,ione,size(y,1),iy,ijy,desc_a%matrix_data,info,iiy,jjy) + call psb_chkvect(m,ione,size(x,1),ix,ijx,desc_a,info,iix,jjx) + if (info == 0) & + & call psb_chkvect(m,ione,size(y,1),iy,ijy,desc_a,info,iiy,jjy) if(info.ne.0) then info=4010 ch_err='psb_chkvect' @@ -120,8 +121,8 @@ function psb_zdot(x, y,desc_a, info, jx, jy) end if if(m.ne.0) then - if(desc_a%matrix_data(psb_n_row_).gt.0) then - dot_local = zdotc(desc_a%matrix_data(psb_n_row_),& + if(psb_get_local_rows(desc_a).gt.0) then + dot_local = zdotc(psb_get_local_rows(desc_a),& & x(iix,jjx),ione,y(iiy,jjy),ione) ! adjust dot_local because overlapped elements are computed more than once i=1 @@ -225,7 +226,7 @@ function psb_zdotv(x, y,desc_a, info) info=0 call psb_erractionsave(err_act) - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -ione) then @@ -238,11 +239,12 @@ function psb_zdotv(x, y,desc_a, info) iy = ione jx = ione jy = ione - m = desc_a%matrix_data(psb_m_) + m = psb_get_global_rows(desc_a) ! check vector correctness - call psb_chkvect(m,ione,size(x,1),ix,jx,desc_a%matrix_data,info,iix,jjx) - call psb_chkvect(m,ione,size(y,1),iy,jy,desc_a%matrix_data,info,iiy,jjy) + call psb_chkvect(m,ione,size(x,1),ix,jx,desc_a,info,iix,jjx) + if (info == 0)& + & call psb_chkvect(m,ione,size(y,1),iy,jy,desc_a,info,iiy,jjy) if(info.ne.0) then info=4010 ch_err='psb_chkvect' @@ -257,8 +259,8 @@ function psb_zdotv(x, y,desc_a, info) end if if(m.ne.0) then - if(desc_a%matrix_data(psb_n_row_).gt.0) then - dot_local = zdotc(desc_a%matrix_data(psb_n_row_),& + if(psb_get_local_rows(desc_a).gt.0) then + dot_local = zdotc(psb_get_local_rows(desc_a),& & x,ione,y,ione) ! adjust dot_local because overlapped elements are computed more than once i=1 @@ -362,7 +364,7 @@ subroutine psb_zdotvs(res, x, y,desc_a, info) info=0 call psb_erractionsave(err_act) - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -ione) then @@ -373,11 +375,12 @@ subroutine psb_zdotvs(res, x, y,desc_a, info) ix = ione iy = ione - m = desc_a%matrix_data(psb_m_) + m = psb_get_global_rows(desc_a) ! check vector correctness - call psb_chkvect(m,ione,size(x,1),ix,ix,desc_a%matrix_data,info,iix,jjx) - call psb_chkvect(m,ione,size(y,1),iy,iy,desc_a%matrix_data,info,iiy,jjy) + call psb_chkvect(m,ione,size(x,1),ix,ix,desc_a,info,iix,jjx) + if (info == 0) & + & call psb_chkvect(m,ione,size(y,1),iy,iy,desc_a,info,iiy,jjy) if(info.ne.0) then info=4010 ch_err='psb_chkvect' @@ -392,8 +395,8 @@ subroutine psb_zdotvs(res, x, y,desc_a, info) end if if(m.ne.0) then - if(desc_a%matrix_data(psb_n_row_).gt.0) then - dot_local = zdotc(desc_a%matrix_data(psb_n_row_),& + if(psb_get_local_rows(desc_a).gt.0) then + dot_local = zdotc(psb_get_local_rows(desc_a),& & x,ione,y,ione) ! adjust dot_local because overlapped elements are computed more than once i=1 @@ -502,7 +505,7 @@ subroutine psb_zmdots(res, x, y, desc_a, info) info=0 call psb_erractionsave(err_act) - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -ione) then @@ -514,17 +517,17 @@ subroutine psb_zmdots(res, x, y, desc_a, info) ix = ione iy = ione - m = desc_a%matrix_data(psb_m_) + m = psb_get_global_rows(desc_a) ! check vector correctness - call psb_chkvect(m,ione,size(x,1),ix,ix,desc_a%matrix_data,info,iix,jjx) + call psb_chkvect(m,ione,size(x,1),ix,ix,desc_a,info,iix,jjx) if(info.ne.0) then info=4010 ch_err='psb_chkvect' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - call psb_chkvect(m,ione,size(y,1),iy,iy,desc_a%matrix_data,info,iiy,jjy) + call psb_chkvect(m,ione,size(y,1),iy,iy,desc_a,info,iiy,jjy) if(info.ne.0) then info=4010 ch_err='psb_chkvect' @@ -542,9 +545,9 @@ subroutine psb_zmdots(res, x, y, desc_a, info) allocate(dot_local(k)) if(m.ne.0) then - if(desc_a%matrix_data(psb_n_row_).gt.0) then + if(psb_get_local_rows(desc_a).gt.0) then do j=1,k - dot_local(j) = zdotc(desc_a%matrix_data(psb_n_row_),& + dot_local(j) = zdotc(psb_get_local_rows(desc_a),& & x(1,j),ione,y(1,j),ione) ! adjust dot_local because overlapped elements are computed more than once i=1 diff --git a/src/psblas/psb_znrm2.f90 b/src/psblas/psb_znrm2.f90 index ca9c8d2b..c886f22a 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -85,9 +85,9 @@ function psb_znrm2(x, desc_a, info, jx) ijx = 1 endif - m = desc_a%matrix_data(psb_m_) + m = psb_get_global_rows(desc_a) - call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx) + call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx) if(info.ne.0) then info=4010 ch_err='psb_chkvect' @@ -101,8 +101,8 @@ function psb_znrm2(x, desc_a, info, jx) end if if(m.ne.0) then - if (desc_a%matrix_data(psb_n_row_) .gt. 0) then - ndim = desc_a%matrix_data(psb_n_row_) + if (psb_get_local_rows(desc_a) .gt. 0) then + ndim = psb_get_local_rows(desc_a) nrm2 = dznrm2( ndim, x(iix,jjx), ione ) i=1 do while (desc_a%ovrlap_elem(i) .ne. -1) @@ -206,7 +206,7 @@ function psb_znrm2v(x, desc_a, info) info=0 call psb_erractionsave(err_act) - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -218,10 +218,10 @@ function psb_znrm2v(x, desc_a, info) ix = 1 jx=1 - m = desc_a%matrix_data(psb_m_) + m = psb_get_global_rows(desc_a) - call psb_chkvect(m,1,size(x),ix,jx,desc_a%matrix_data,info,iix,jjx) + call psb_chkvect(m,1,size(x),ix,jx,desc_a,info,iix,jjx) if(info.ne.0) then info=4010 ch_err='psb_chkvect' @@ -235,8 +235,8 @@ function psb_znrm2v(x, desc_a, info) end if if(m.ne.0) then - if (desc_a%matrix_data(psb_n_row_) .gt. 0) then - ndim = desc_a%matrix_data(psb_n_row_) + if (psb_get_local_rows(desc_a) .gt. 0) then + ndim = psb_get_local_rows(desc_a) nrm2 = dznrm2( ndim, x, ione ) i=1 do while (desc_a%ovrlap_elem(i) .ne. -1) @@ -342,7 +342,7 @@ subroutine psb_znrm2vs(res, x, desc_a, info) info=0 call psb_erractionsave(err_act) - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -353,9 +353,9 @@ subroutine psb_znrm2vs(res, x, desc_a, info) ix = 1 jx = 1 - m = desc_a%matrix_data(psb_m_) + m = psb_get_global_rows(desc_a) - call psb_chkvect(m,1,size(x),ix,jx,desc_a%matrix_data,info,iix,jjx) + call psb_chkvect(m,1,size(x),ix,jx,desc_a,info,iix,jjx) if(info.ne.0) then info=4010 ch_err='psb_chkvect' @@ -369,8 +369,8 @@ subroutine psb_znrm2vs(res, x, desc_a, info) end if if(m.ne.0) then - if (desc_a%matrix_data(psb_n_row_) .gt. 0) then - ndim = desc_a%matrix_data(psb_n_row_) + if (psb_get_local_rows(desc_a) .gt. 0) then + ndim = psb_get_local_rows(desc_a) nrm2 = dznrm2( ndim, x, ione ) i=1 do while (desc_a%ovrlap_elem(i) .ne. -1) diff --git a/src/psblas/psb_znrmi.f90 b/src/psblas/psb_znrmi.f90 index ee8a5414..ad789284 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -75,10 +75,10 @@ function psb_znrmi(a,desc_a,info) ia = 1 ja = 1 - m = desc_a%matrix_data(psb_m_) - n = desc_a%matrix_data(psb_n_) + m = psb_get_global_rows(desc_a) + n = psb_get_global_cols(desc_a) - call psb_chkmat(m,n,ia,ja,desc_a%matrix_data,info,iia,jja) + call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja) if(info.ne.0) then info=4010 ch_err='psb_chkmat' @@ -93,8 +93,8 @@ function psb_znrmi(a,desc_a,info) end if if ((m.ne.0).and.(n.ne.0)) then - mdim = desc_a%matrix_data(psb_n_row_) - ndim = desc_a%matrix_data(psb_n_col_) + mdim = psb_get_local_rows(desc_a) + ndim = psb_get_local_cols(desc_a) nrmi = zcsnmi('N',mdim,ndim,a%fida,& & a%descra,a%aspk,a%ia1,a%ia2,& & a%infoa,info) diff --git a/src/psblas/psb_zspmm.f90 b/src/psblas/psb_zspmm.f90 index 7a0e96e3..d02e2cdb 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -168,10 +168,10 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,& itrans = 'N' endif - m = desc_a%matrix_data(psb_m_) - n = desc_a%matrix_data(psb_n_) - nrow = desc_a%matrix_data(psb_n_row_) - ncol = desc_a%matrix_data(psb_n_col_) + m = psb_get_global_rows(desc_a) + n = psb_get_global_cols(desc_a) + nrow = psb_get_local_rows(desc_a) + ncol = psb_get_local_cols(desc_a) lldx = size(x,1) lldy = size(y,1) @@ -204,7 +204,7 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,& iwork(1)=zzero ! checking for matrix correctness - call psb_chkmat(m,n,ia,ja,desc_a%matrix_data,info,iia,jja) + call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja) if(info /= 0) then info=4010 ch_err='psb_chkmat' @@ -223,8 +223,9 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,& end if ! checking for vectors correctness - call psb_chkvect(n,ik,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx) - call psb_chkvect(m,ik,size(y,1),iy,ijy,desc_a%matrix_data,info,iiy,jjy) + call psb_chkvect(n,ik,size(x,1),ix,ijx,desc_a,info,iix,jjx) + if (info == 0)& + & call psb_chkvect(m,ik,size(y,1),iy,ijy,desc_a,info,iiy,jjy) if(info /= 0) then info=4010 ch_err='psb_chkvect' @@ -292,8 +293,9 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,& end if ! checking for vectors correctness - call psb_chkvect(m,ik,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx) - call psb_chkvect(n,ik,size(y,1),iy,ijy,desc_a%matrix_data,info,iiy,jjy) + call psb_chkvect(m,ik,size(x,1),ix,ijx,desc_a,info,iix,jjx) + if (info == 0) & + & call psb_chkvect(n,ik,size(y,1),iy,ijy,desc_a,info,iiy,jjy) if(info /= 0) then info=4010 ch_err='psb_chkvect' @@ -448,7 +450,7 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,& info=0 call psb_erractionsave(err_act) - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -484,10 +486,10 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,& itrans = 'N' endif - m = desc_a%matrix_data(psb_m_) - n = desc_a%matrix_data(psb_n_) - nrow = desc_a%matrix_data(psb_n_row_) - ncol = desc_a%matrix_data(psb_n_col_) + m = psb_get_global_rows(desc_a) + n = psb_get_global_cols(desc_a) + nrow = psb_get_local_rows(desc_a) + ncol = psb_get_local_cols(desc_a) lldx = size(x) lldy = size(y) @@ -522,7 +524,7 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,& ! checking for matrix correctness - call psb_chkmat(m,n,ia,ja,desc_a%matrix_data,info,iia,jja) + call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja) if(info /= 0) then info=4010 ch_err='psb_chkmat' @@ -541,8 +543,9 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,& end if ! checking for vectors correctness - call psb_chkvect(n,ik,size(x),ix,jx,desc_a%matrix_data,info,iix,jjx) - call psb_chkvect(m,ik,size(y),iy,jy,desc_a%matrix_data,info,iiy,jjy) + call psb_chkvect(n,ik,size(x),ix,jx,desc_a,info,iix,jjx) + if (info == 0) & + & call psb_chkvect(m,ik,size(y),iy,jy,desc_a,info,iiy,jjy) if(info /= 0) then info=4010 ch_err='psb_chkvect' @@ -589,8 +592,9 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,& end if ! checking for vectors correctness - call psb_chkvect(m,ik,size(x),ix,jx,desc_a%matrix_data,info,iix,jjx) - call psb_chkvect(n,ik,size(y),iy,jy,desc_a%matrix_data,info,iiy,jjy) + call psb_chkvect(m,ik,size(x),ix,jx,desc_a,info,iix,jjx) + if (info == 0)& + & call psb_chkvect(n,ik,size(y),iy,jy,desc_a,info,iiy,jjy) if(info /= 0) then info=4010 ch_err='psb_chkvect' diff --git a/src/psblas/psb_zspsm.f90 b/src/psblas/psb_zspsm.f90 index 764aad16..13f5dba0 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -178,9 +178,9 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,& itrans = 'N' endif - m = desc_a%matrix_data(psb_m_) - nrow = desc_a%matrix_data(psb_n_row_) - ncol = desc_a%matrix_data(psb_n_col_) + m = psb_get_global_rows(desc_a) + nrow = psb_get_local_rows(desc_a) + ncol = psb_get_local_cols(desc_a) lldx = size(x,1) lldy = size(y,1) @@ -229,10 +229,12 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,& end if ! checking for matrix correctness - call psb_chkmat(m,m,ia,ja,desc_a%matrix_data,info,iia,jja) + call psb_chkmat(m,m,ia,ja,desc_a,info,iia,jja) ! checking for vectors correctness - call psb_chkvect(m,ik,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx) - call psb_chkvect(m,ik,size(y,1),iy,ijy,desc_a%matrix_data,info,iiy,jjy) + if (info == 0) & + & call psb_chkvect(m,ik,size(x,1),ix,ijx,desc_a,info,iix,jjx) + if (info == 0) & + & call psb_chkvect(m,ik,size(y,1),iy,ijy,desc_a,info,iiy,jjy) if(info.ne.0) then info=4010 ch_err='psb_chkvect/mat' @@ -421,7 +423,7 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,& info=0 call psb_erractionsave(err_act) - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -464,9 +466,9 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,& itrans = 'N' endif - m = desc_a%matrix_data(psb_m_) - nrow = desc_a%matrix_data(psb_n_row_) - ncol = desc_a%matrix_data(psb_n_col_) + m = psb_get_global_rows(desc_a) + nrow = psb_get_local_rows(desc_a) + ncol = psb_get_local_cols(desc_a) lldx = size(x) lldy = size(y) @@ -516,10 +518,12 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,& end if ! checking for matrix correctness - call psb_chkmat(m,m,ia,ja,desc_a%matrix_data,info,iia,jja) + call psb_chkmat(m,m,ia,ja,desc_a,info,iia,jja) ! checking for vectors correctness - call psb_chkvect(m,ik,size(x),ix,jx,desc_a%matrix_data,info,iix,jjx) - call psb_chkvect(m,ik,size(y),iy,jy,desc_a%matrix_data,info,iiy,jjy) + if (info == 0) & + & call psb_chkvect(m,ik,size(x),ix,jx,desc_a,info,iix,jjx) + if (info == 0) & + & call psb_chkvect(m,ik,size(y),iy,jy,desc_a,info,iiy,jjy) if(info.ne.0) then info=4010 ch_err='psb_chkvect/mat' diff --git a/src/tools/psb_cdalv.f90 b/src/tools/psb_cdalv.f90 index ff143663..f41113b6 100644 --- a/src/tools/psb_cdalv.f90 +++ b/src/tools/psb_cdalv.f90 @@ -269,6 +269,7 @@ subroutine psb_cdalv(m, v, ictxt, desc_a, info, flag) desc_a%halo_index(:) = -1 + desc_a%matrix_data(psb_m_) = m desc_a%matrix_data(psb_n_) = n desc_a%matrix_data(psb_dec_type_) = psb_desc_bld_ diff --git a/src/tools/psb_cdasb.f90 b/src/tools/psb_cdasb.f90 index 7d870a18..1d6d6e7e 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 = desc_a%matrix_data(psb_ctxt_) - dectype = desc_a%matrix_data(psb_dec_type_) - n_row = desc_a%matrix_data(psb_n_row_) - n_col = desc_a%matrix_data(psb_n_col_) + ictxt = psb_get_context(desc_a) + dectype = psb_get_dectype(desc_a) + n_row = psb_get_local_rows(desc_a) + n_col = psb_get_local_cols(desc_a) ! check on blacs grid call psb_info(ictxt, me, np) @@ -79,7 +79,7 @@ subroutine psb_cdasb(desc_a,info) goto 9999 endif - if (.not.psb_is_ok_dec(dectype)) then + if (.not.psb_is_ok_desc(desc_a)) then info = 600 int_err(1) = dectype call psb_errpush(info,name) @@ -88,10 +88,10 @@ subroutine psb_cdasb(desc_a,info) if (debug) write (0, *) ' Begin matrix assembly...' - if (psb_is_bld_dec(dectype)) then + if (psb_is_bld_desc(desc_a)) then if (debug) write(0,*) 'psb_cdasb: Checking rows insertion' ! check if all local row are inserted - do i=1,desc_a%matrix_data(psb_n_col_) + do i=1,psb_get_local_cols(desc_a) if (desc_a%loc_to_glob(i) < 0) then info=3100 exit @@ -102,7 +102,7 @@ subroutine psb_cdasb(desc_a,info) call psb_errpush(info,name,i_err=int_err) goto 9999 endif - call psb_realloc(desc_a%matrix_data(psb_n_col_),desc_a%loc_to_glob,info) + call psb_realloc(psb_get_local_cols(desc_a),desc_a%loc_to_glob,info) call psb_transfer(desc_a%ovrlap_index,ovrlap_index,info) call psb_transfer(desc_a%halo_index,halo_index,info) diff --git a/src/tools/psb_cddec.f90 b/src/tools/psb_cddec.f90 index fc847773..27ec0622 100644 --- a/src/tools/psb_cddec.f90 +++ b/src/tools/psb_cddec.f90 @@ -178,10 +178,11 @@ subroutine psb_cddec(nloc, ictxt, desc_a, info) goto 9999 endif - desc_a%matrix_data(psb_m_) = m - desc_a%matrix_data(psb_n_) = m + desc_a%matrix_data(psb_n_row_) = nloc desc_a%matrix_data(psb_n_col_) = nloc + desc_a%matrix_data(psb_m_) = m + desc_a%matrix_data(psb_n_) = m desc_a%matrix_data(psb_dec_type_) = psb_desc_bld_ desc_a%matrix_data(psb_ctxt_) = ictxt call psb_get_mpicomm(ictxt,desc_a%matrix_data(psb_mpi_c_)) @@ -214,6 +215,7 @@ subroutine psb_cddec(nloc, ictxt, desc_a, info) goto 9999 end if + desc_a%matrix_data(psb_dec_type_) = psb_desc_asb_ call psb_erractionrestore(err_act) diff --git a/src/tools/psb_cdfree.f90 b/src/tools/psb_cdfree.f90 index 831190fd..95373f46 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) deallocate(desc_a%matrix_data) call psb_info(ictxt, me, np) ! ....verify blacs grid correctness.. diff --git a/src/tools/psb_cdins.f90 b/src/tools/psb_cdins.f90 index 8a2306e9..a1ea21ce 100644 --- a/src/tools/psb_cdins.f90 +++ b/src/tools/psb_cdins.f90 @@ -66,16 +66,16 @@ subroutine psb_cdins(nz,ia,ja,desc_a,info) name = 'psb_cdins' call psb_erractionsave(err_act) - ictxt = desc_a%matrix_data(psb_ctxt_) - dectype = desc_a%matrix_data(psb_dec_type_) - mglob = desc_a%matrix_data(psb_m_) - nglob = desc_a%matrix_data(psb_n_) - nrow = desc_a%matrix_data(psb_n_row_) - ncol = desc_a%matrix_data(psb_n_col_) + ictxt = psb_get_context(desc_a) + dectype = psb_get_dectype(desc_a) + mglob = psb_get_global_rows(desc_a) + nglob = psb_get_global_cols(desc_a) + nrow = psb_get_local_rows(desc_a) + ncol = psb_get_local_cols(desc_a) call psb_info(ictxt, me, np) - if (.not.psb_is_bld_dec(dectype)) then + if (.not.psb_is_bld_desc(desc_a)) then info = 3110 call psb_errpush(info,name) goto 9999 diff --git a/src/tools/psb_cdren.f90 b/src/tools/psb_cdren.f90 index 283ac8e1..7b8c936d 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=desc_a%matrix_data(psb_ctxt_) - dectype=desc_a%matrix_data(psb_dec_type_) - n_row = desc_a%matrix_data(psb_n_row_) - n_col = desc_a%matrix_data(psb_n_col_) + ictxt=psb_get_context(desc_a) + dectype=psb_get_dectype(desc_a) + n_row = psb_get_local_rows(desc_a) + n_col = psb_get_local_cols(desc_a) ! check on blacs grid call psb_info(ictxt, me, np) @@ -88,7 +88,7 @@ subroutine psb_cdren(trans,iperm,desc_a,info) goto 9999 endif - if (.not.psb_is_asb_dec(dectype)) then + if (.not.psb_is_asb_desc(desc_a)) then info = 600 int_err(1) = dectype call psb_errpush(info,name,int_err) @@ -137,7 +137,7 @@ subroutine psb_cdren(trans,iperm,desc_a,info) desc_a%glob_to_loc(desc_a%loc_to_glob(desc_a%lprm(i))) = i enddo if (debug) write(0,*) 'spasb: renumbering loc_to_glob' - do i=1,desc_a%matrix_data(psb_m_) + do i=1,psb_get_global_rows(desc_a) j = desc_a%glob_to_loc(i) if (j>0) then desc_a%loc_to_glob(j) = i diff --git a/src/tools/psb_cdrep.f90 b/src/tools/psb_cdrep.f90 index 65461152..90e2ec06 100644 --- a/src/tools/psb_cdrep.f90 +++ b/src/tools/psb_cdrep.f90 @@ -186,6 +186,7 @@ subroutine psb_cdrep(m, ictxt, desc_a, info) endif + desc_a%matrix_data(psb_m_) = m desc_a%matrix_data(psb_n_) = n desc_a%matrix_data(psb_n_row_) = m diff --git a/src/tools/psb_dallc.f90 b/src/tools/psb_dallc.f90 index ab13031f..fffd7de3 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -77,9 +77,9 @@ subroutine psb_dalloc(x, desc_a, info, n) goto 9999 endif - dectype=desc_a%matrix_data(psb_dec_type_) + dectype=psb_get_dectype(desc_a) !... check m and n parameters.... - if (.not.psb_is_ok_dec(dectype)) then + if (.not.psb_is_ok_desc(desc_a)) then info = 3110 call psb_errpush(info,name) goto 9999 @@ -105,8 +105,8 @@ subroutine psb_dalloc(x, desc_a, info, n) endif !....allocate x ..... - if (psb_is_asb_dec(dectype).or.psb_is_upd_dec(dectype)) then - n_col = max(1,desc_a%matrix_data(psb_n_col_)) + if (psb_is_asb_desc(desc_a).or.psb_is_upd_desc(desc_a)) then + n_col = max(1,psb_get_local_cols(desc_a)) allocate(x(n_col,n_),stat=info) if (info /= 0) then info=4010 @@ -119,8 +119,8 @@ subroutine psb_dalloc(x, desc_a, info, n) x(i,j) = 0.0d0 end do end do - else if (psb_is_bld_dec(dectype)) then - n_row = max(1,desc_a%matrix_data(psb_n_row_)) + else if (psb_is_bld_desc(desc_a)) then + n_row = max(1,psb_get_local_rows(desc_a)) allocate(x(n_row,n_),stat=info) if (info /= 0) then info=4010 @@ -213,7 +213,7 @@ subroutine psb_dallocv(x, desc_a,info,n) name='psb_dallcv' call psb_erractionsave(err_act) - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) ! ....verify blacs grid correctness.. @@ -223,11 +223,11 @@ subroutine psb_dallocv(x, desc_a,info,n) goto 9999 endif - dectype=desc_a%matrix_data(psb_dec_type_) + dectype=psb_get_dectype(desc_a) if (debug) write(0,*) 'dall: dectype',dectype - if (debug) write(0,*) 'dall: is_ok? dectype',psb_is_ok_dec(dectype) + if (debug) write(0,*) 'dall: is_ok? dectype',psb_is_ok_desc(desc_a) !... check m and n parameters.... - if (.not.psb_is_ok_dec(dectype)) then + if (.not.psb_is_ok_desc(desc_a)) then info = 3110 call psb_errpush(info,name) goto 9999 @@ -236,8 +236,8 @@ subroutine psb_dallocv(x, desc_a,info,n) ! As this is a rank-1 array, optional parameter N is actually ignored. !....allocate x ..... - if (psb_is_asb_dec(dectype).or.psb_is_upd_dec(dectype)) then - n_col = max(1,desc_a%matrix_data(psb_n_col_)) + if (psb_is_asb_desc(desc_a).or.psb_is_upd_desc(desc_a)) then + n_col = max(1,psb_get_local_cols(desc_a)) call psb_realloc(n_col,x,info) if (info /= 0) then info=4010 @@ -249,8 +249,8 @@ subroutine psb_dallocv(x, desc_a,info,n) x(i) = 0.0d0 end do - else if (psb_is_bld_dec(dectype)) then - n_row = max(1,desc_a%matrix_data(psb_n_row_)) + else if (psb_is_bld_desc(desc_a)) then + n_row = max(1,psb_get_local_rows(desc_a)) call psb_realloc(n_row,x,info) if (info /= 0) then info=4010 diff --git a/src/tools/psb_dasb.f90 b/src/tools/psb_dasb.f90 index 6a16caa3..25d3d47a 100644 --- a/src/tools/psb_dasb.f90 +++ b/src/tools/psb_dasb.f90 @@ -69,20 +69,20 @@ subroutine psb_dasb(x, desc_a, info) goto 9999 endif - ictxt=desc_a%matrix_data(psb_ctxt_) - dectype=desc_a%matrix_data(psb_dec_type_) + ictxt=psb_get_context(desc_a) + dectype=psb_get_dectype(desc_a) call psb_info(ictxt, me, np) if (debug) write(*,*) 'asb start: ',np,me,& - &desc_a%matrix_data(psb_dec_type_) + &psb_get_dectype(desc_a) ! ....verify blacs grid correctness.. if (np == -1) then info = 2010 call psb_errpush(info,name) goto 9999 - else if (.not.psb_is_asb_dec(dectype)) then + else if (.not.psb_is_asb_desc(desc_a)) then if (debug) write(*,*) 'asb error ',& &dectype info = 3110 @@ -91,9 +91,9 @@ subroutine psb_dasb(x, desc_a, info) endif ! check size - ictxt=desc_a%matrix_data(psb_ctxt_) - nrow=desc_a%matrix_data(psb_n_row_) - ncol=desc_a%matrix_data(psb_n_col_) + ictxt=psb_get_context(desc_a) + nrow=psb_get_local_rows(desc_a) + ncol=psb_get_local_cols(desc_a) i1sz = size(x,dim=1) i2sz = size(x,dim=2) if (debug) write(*,*) 'asb: ',i1sz,i2sz,nrow,ncol @@ -193,8 +193,8 @@ subroutine psb_dasbv(x, desc_a, info) int_err(1) = 0 name = 'psb_dasbv' - ictxt=desc_a%matrix_data(psb_ctxt_) - dectype=desc_a%matrix_data(psb_dec_type_) + ictxt=psb_get_context(desc_a) + dectype=psb_get_dectype(desc_a) call psb_info(ictxt, me, np) @@ -203,14 +203,14 @@ subroutine psb_dasbv(x, desc_a, info) info = 2010 call psb_errpush(info,name) goto 9999 - else if (.not.psb_is_asb_dec(dectype)) then + else if (.not.psb_is_asb_desc(desc_a)) then info = 3110 call psb_errpush(info,name) goto 9999 endif - nrow=desc_a%matrix_data(psb_n_row_) - ncol=desc_a%matrix_data(psb_n_col_) + nrow=psb_get_local_rows(desc_a) + ncol=psb_get_local_cols(desc_a) if (debug) write(*,*) name,' sizes: ',nrow,ncol i1sz = size(x) if (debug) write(*,*) 'dasb: sizes ',i1sz,ncol diff --git a/src/tools/psb_dcdovr.f90 b/src/tools/psb_dcdovr.f90 index d6e9ffd6..bcd67b54 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) Call psb_info(ictxt, me, np) If(debug) Write(0,*)'in psb_cdovr',novr - m=desc_a%matrix_data(psb_n_row_) + m=psb_get_local_rows(desc_a) nnzero=Size(a%aspk) - n_col=desc_a%matrix_data(psb_n_col_) + n_col=psb_get_local_cols(desc_a) nhalo = n_col-m If(debug) Write(0,*)'IN CDOVR1',novr ,m,nnzero,n_col if (novr<0) then diff --git a/src/tools/psb_dcdovrbld.f90 b/src/tools/psb_dcdovrbld.f90 index 8c93c629..748d4424 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 = desc_a%matrix_data(psb_ctxt_) + ictxt = psb_get_context(desc_a) Call psb_info(ictxt,me,np) @@ -108,10 +108,10 @@ Subroutine psb_dcdovrbld(n_ovr,desc_p,desc_a,a,& t4 = 0.0 call psb_get_mpicomm(ictxt,icomm ) - mglob = desc_a%matrix_data(psb_m_) - m = desc_a%matrix_data(psb_n_row_) - n_row = desc_a%matrix_data(psb_n_row_) - n_col = desc_a%matrix_data(psb_n_col_) + mglob = psb_get_global_rows(desc_a) + m = psb_get_local_rows(desc_a) + n_row = psb_get_local_rows(desc_a) + n_col = psb_get_local_cols(desc_a) if (debug) write(0,*) me,' On entry to CDOVRBLD n_col:',n_col dl_lda=np*5 @@ -537,8 +537,8 @@ Subroutine psb_dcdovrbld(n_ovr,desc_p,desc_a,a,& End Do t1 = mpi_wtime() - desc_p%matrix_data(psb_m_)=desc_a%matrix_data(psb_m_) - desc_p%matrix_data(psb_n_)=desc_a%matrix_data(psb_n_) + desc_p%matrix_data(psb_m_)=psb_get_global_rows(desc_a) + desc_p%matrix_data(psb_n_)=psb_get_global_cols(desc_a) tmp_halo(counter_h)=-1 tmp_ovr_idx(counter_o)=-1 diff --git a/src/tools/psb_dcsrp.f90 b/src/tools/psb_dcsrp.f90 index 773a983e..721b1f54 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=desc_a%matrix_data(psb_ctxt_) - dectype=desc_a%matrix_data(psb_dec_type_) - n_row = desc_a%matrix_data(psb_n_row_) - n_col = desc_a%matrix_data(psb_n_col_) + ictxt=psb_get_context(desc_a) + dectype=psb_get_dectype(desc_a) + n_row = psb_get_local_rows(desc_a) + n_col = psb_get_local_cols(desc_a) if(psb_get_errstatus() /= 0) return info=0 @@ -108,7 +108,7 @@ subroutine psb_dcsrp(trans,iperm,a, desc_a, info) endif - if (.not.psb_is_asb_dec(dectype)) then + if (.not.psb_is_asb_desc(desc_a)) then info = 600 int_err(1) = dectype call psb_errpush(info,name,int_err) diff --git a/src/tools/psb_dfree.f90 b/src/tools/psb_dfree.f90 index 5ded4631..4f54fd81 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) ! ....verify blacs grid correctness.. @@ -139,7 +139,7 @@ subroutine psb_dfreev(x, desc_a, info) call psb_errpush(info,name) return end if - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then diff --git a/src/tools/psb_dgelp.f90 b/src/tools/psb_dgelp.f90 index 9b1f75a5..4f04a7c5 100644 --- a/src/tools/psb_dgelp.f90 +++ b/src/tools/psb_dgelp.f90 @@ -85,23 +85,23 @@ subroutine psb_dgelp(trans,iperm,x,desc_a,info) info=0 call psb_erractionsave(err_act) - ictxt=desc_a%matrix_data(psb_ctxt_) - dectype=desc_a%matrix_data(psb_dec_type_) - nrow = desc_a%matrix_data(psb_n_row_) - ncol = desc_a%matrix_data(psb_n_col_) + ictxt=psb_get_context(desc_a) + dectype=psb_get_dectype(desc_a) + nrow = psb_get_local_rows(desc_a) + ncol = psb_get_local_cols(desc_a) i1sz = size(x,dim=1) i2sz = size(x,dim=2) call psb_info(ictxt, me, np) if (debug) write(*,*) 'asb start: ',np,me,& - &desc_a%matrix_data(psb_dec_type_) + &psb_get_dectype(desc_a) ! ....verify blacs grid correctness.. if (np == -1) then info = 2010 call psb_errpush(info,name) goto 9999 - else if (.not.psb_is_asb_dec(dectype)) then + else if (.not.psb_is_asb_desc(desc_a)) then info = 3110 call psb_errpush(info,name) goto 9999 @@ -231,10 +231,10 @@ subroutine psb_dgelpv(trans,iperm,x,desc_a,info) i1sz = size(x) - ictxt=desc_a%matrix_data(psb_ctxt_) - dectype=desc_a%matrix_data(psb_dec_type_) - nrow=desc_a%matrix_data(psb_n_row_) - ncol=desc_a%matrix_data(psb_n_col_) + ictxt=psb_get_context(desc_a) + dectype=psb_get_dectype(desc_a) + nrow=psb_get_local_rows(desc_a) + ncol=psb_get_local_cols(desc_a) call psb_info(ictxt, me, np) @@ -243,7 +243,7 @@ subroutine psb_dgelpv(trans,iperm,x,desc_a,info) info = 2010 call psb_errpush(info,name) goto 9999 - else if (.not.psb_is_asb_dec(dectype)) then + else if (.not.psb_is_asb_desc(desc_a)) then info = 3110 call psb_errpush(info,name) goto 9999 diff --git a/src/tools/psb_dins.f90 b/src/tools/psb_dins.f90 index 180eaab2..c6e7f3ff 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -98,12 +98,12 @@ subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl) int_err(2) = m call psb_errpush(info,name,int_err) goto 9999 - else if (.not.psb_is_ok_dec(desc_a%matrix_data(psb_dec_type_))) then + else if (.not.psb_is_ok_desc(desc_a)) then info = 3110 - int_err(1) = desc_a%matrix_data(psb_dec_type_) + int_err(1) = psb_get_dectype(desc_a) call psb_errpush(info,name,int_err) goto 9999 - else if (size(x, dim=1) < desc_a%matrix_data(psb_n_row_)) then + else if (size(x, dim=1) < psb_get_local_rows(desc_a)) then info = 310 int_err(1) = 5 int_err(2) = 4 @@ -111,9 +111,9 @@ subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl) goto 9999 endif - loc_rows=desc_a%matrix_data(psb_n_row_) - loc_cols=desc_a%matrix_data(psb_n_col_) - mglob = desc_a%matrix_data(psb_m_) + loc_rows=psb_get_local_rows(desc_a) + loc_cols=psb_get_local_cols(desc_a) + mglob = psb_get_global_rows(desc_a) if (present(dupl)) then dupl_ = dupl @@ -265,7 +265,7 @@ subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl) return end if - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -281,12 +281,12 @@ subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl) int_err(2) = m call psb_errpush(info,name,int_err) goto 9999 - else if (.not.psb_is_ok_dec(desc_a%matrix_data(psb_dec_type_))) then + else if (.not.psb_is_ok_desc(desc_a)) then info = 3110 - int_err(1) = desc_a%matrix_data(psb_dec_type_) + int_err(1) = psb_get_dectype(desc_a) call psb_errpush(info,name,int_err) goto 9999 - else if (size(x, dim=1) < desc_a%matrix_data(psb_n_row_)) then + else if (size(x, dim=1) < psb_get_local_rows(desc_a)) then info = 310 int_err(1) = 5 int_err(2) = 4 @@ -294,9 +294,9 @@ subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl) goto 9999 endif - loc_rows=desc_a%matrix_data(psb_n_row_) - loc_cols=desc_a%matrix_data(psb_n_col_) - mglob = desc_a%matrix_data(psb_m_) + loc_rows=psb_get_local_rows(desc_a) + loc_cols=psb_get_local_cols(desc_a) + mglob = psb_get_global_rows(desc_a) n = min(size(val,2),size(x,2)) diff --git a/src/tools/psb_dspalloc.f90 b/src/tools/psb_dspalloc.f90 index 204b30e2..125b80be 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 = desc_a%matrix_data(psb_ctxt_) - dectype = desc_a%matrix_data(psb_dec_type_) + ictxt = psb_get_context(desc_a) + dectype = psb_get_dectype(desc_a) call psb_info(ictxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then @@ -85,9 +85,9 @@ subroutine psb_dspalloc(a, desc_a, info, nnz) ! check if psdalloc is already called for this matrix ! set fields in desc_a%matrix_data.... - loc_row = desc_a%matrix_data(psb_n_row_) - m = desc_a%matrix_data(psb_m_) - n = desc_a%matrix_data(psb_n_) + loc_row = psb_get_local_rows(desc_a) + m = psb_get_global_rows(desc_a) + n = psb_get_global_cols(desc_a) !...allocate matrix data... if (present(nnz))then @@ -127,7 +127,7 @@ subroutine psb_dspalloc(a, desc_a, info, nnz) a%infoa(psb_state_) = psb_spmat_bld_ if (debug) write(0,*) 'spall: ', & - &desc_a%matrix_data(psb_dec_type_),psb_desc_bld_ + &psb_get_dectype(desc_a),psb_desc_bld_ return diff --git a/src/tools/psb_dspasb.f90 b/src/tools/psb_dspasb.f90 index 33ef5fa3..8a9de62f 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 = desc_a%matrix_data(psb_ctxt_) - dscstate = desc_a%matrix_data(psb_dec_type_) - n_row = desc_a%matrix_data(psb_n_row_) - n_col = desc_a%matrix_data(psb_n_col_) + ictxt = psb_get_context(desc_a) + dscstate = psb_get_dectype(desc_a) + n_row = psb_get_local_rows(desc_a) + n_col = psb_get_local_cols(desc_a) ! check on BLACS grid call psb_info(ictxt, me, np) @@ -106,8 +106,8 @@ subroutine psb_dspasb(a,desc_a, info, afmt, upd, dupl) ! First case: we come from a fresh build. ! - n_row = desc_a%matrix_data(psb_n_row_) - n_col = desc_a%matrix_data(psb_n_col_) + n_row = psb_get_local_rows(desc_a) + n_col = psb_get_local_cols(desc_a) ! ! Second step: handle the local matrix part. diff --git a/src/tools/psb_dspcnv.f90 b/src/tools/psb_dspcnv.f90 index 3a32d507..30919e8e 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 = desc_a%matrix_data(psb_ctxt_) - dectype = desc_a%matrix_data(psb_dec_type_) - n_row = desc_a%matrix_data(psb_n_row_) - n_col = desc_a%matrix_data(psb_n_col_) + ictxt = psb_get_context(desc_a) + dectype = psb_get_dectype(desc_a) + n_row = psb_get_local_rows(desc_a) + n_col = psb_get_local_cols(desc_a) ! check on blacs grid call psb_info(ictxt, me, np) diff --git a/src/tools/psb_dspfree.f90 b/src/tools/psb_dspfree.f90 index ccb9d7d8..f06f13e4 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) end if !...deallocate a.... diff --git a/src/tools/psb_dsphalo.f90 b/src/tools/psb_dsphalo.f90 index eb17f63e..30737cfc 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) Call psb_info(ictxt, me, np) t1 = mpi_wtime() diff --git a/src/tools/psb_dspins.f90 b/src/tools/psb_dspins.f90 index aa5a04bd..4b8c3bcd 100644 --- a/src/tools/psb_dspins.f90 +++ b/src/tools/psb_dspins.f90 @@ -86,13 +86,13 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild) call psb_erractionsave(err_act) - ictxt = desc_a%matrix_data(psb_ctxt_) - dectype = desc_a%matrix_data(psb_dec_type_) - mglob = desc_a%matrix_data(psb_m_) + ictxt = psb_get_context(desc_a) + dectype = psb_get_dectype(desc_a) + mglob = psb_get_global_rows(desc_a) call psb_info(ictxt, me, np) - if (.not.psb_is_ok_dec(dectype)) then + if (.not.psb_is_ok_desc(desc_a)) then info = 3110 call psb_errpush(info,name) goto 9999 @@ -127,7 +127,7 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild) endif spstate = a%infoa(psb_state_) - if (psb_is_bld_dec(dectype)) then + if (psb_is_bld_desc(desc_a)) then call psb_cdins(nz,ia,ja,desc_a,info) if (info /= 0) then info=4010 @@ -135,8 +135,8 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild) call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - nrow = desc_a%matrix_data(psb_n_row_) - ncol = desc_a%matrix_data(psb_n_col_) + nrow = psb_get_local_rows(desc_a) + ncol = psb_get_local_cols(desc_a) if (spstate == psb_spmat_bld_) then call psb_coins(nz,ia,ja,val,a,1,nrow,1,ncol,info,gtl=desc_a%glob_to_loc) @@ -151,9 +151,9 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild) call psb_errpush(info,name) goto 9999 end if - else if (psb_is_asb_dec(dectype)) then - nrow = desc_a%matrix_data(psb_n_row_) - ncol = desc_a%matrix_data(psb_n_col_) + else if (psb_is_asb_desc(desc_a)) then + nrow = psb_get_local_rows(desc_a) + ncol = psb_get_local_cols(desc_a) call psb_coins(nz,ia,ja,val,a,1,nrow,1,ncol,& & info,gtl=desc_a%glob_to_loc,rebuild=rebuild_) if (info /= 0) then diff --git a/src/tools/psb_dsprn.f90 b/src/tools/psb_dsprn.f90 index 61b404b4..cb4cdcdf 100644 --- a/src/tools/psb_dsprn.f90 +++ b/src/tools/psb_dsprn.f90 @@ -69,16 +69,16 @@ Subroutine psb_dsprn(a, desc_a,info,clear) name = 'psb_dsprn' call psb_erractionsave(err_act) - ictxt = desc_a%matrix_data(psb_ctxt_) + ictxt = psb_get_context(desc_a) call psb_info(ictxt, me, np) if (debug) & &write(*,*) 'starting spalloc ',ictxt,np,me - if (psb_is_bld_dec(desc_a%matrix_data(psb_dec_type_))) then + if (psb_is_bld_desc(desc_a)) then ! Should do nothing, we are called redundantly return endif - if (.not.psb_is_asb_dec(desc_a%matrix_data(psb_dec_type_))) then + if (.not.psb_is_asb_desc(desc_a)) then info=590 call psb_errpush(info,name) goto 9999 diff --git a/src/tools/psb_glob_to_loc.f90 b/src/tools/psb_glob_to_loc.f90 index f079ad24..0227edaa 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.desc_a%matrix_data(psb_m_)).or.& + if ((x(i).gt.psb_get_global_rows(desc_a)).or.& & (x(i).le.zero)) then if (act == 'I') then - y(i)=-3*desc_a%matrix_data(psb_m_) + y(i)=-3*psb_get_global_rows(desc_a) else info=140 int_err(1)=x(i) - int_err(2)=desc_a%matrix_data(psb_m_) + int_err(2)=psb_get_global_rows(desc_a) exit end if else tmp=desc_a%glob_to_loc(x(i)) - if((tmp.gt.zero).or.(tmp.le.desc_a%matrix_data(psb_n_col_))) then + if((tmp.gt.zero).or.(tmp.le.psb_get_local_cols(desc_a))) then y(i)=tmp else if (tmp.le.zero) then info = 150 int_err(1)=tmp exit - else if (tmp.gt.desc_a%matrix_data(psb_n_col_)) then + else if (tmp.gt.psb_get_local_cols(desc_a)) then info = 140 int_err(1)=tmp - int_err(2)=desc_a%matrix_data(psb_n_col_) + int_err(2)=psb_get_local_cols(desc_a) exit end if end if @@ -213,28 +213,28 @@ subroutine psb_glob_to_loc(x,desc_a,info,iact) real_val = 0.d0 n=size(x) do i=1,n - if ((x(i).gt.desc_a%matrix_data(psb_m_)).or.& + if ((x(i).gt.psb_get_global_rows(desc_a)).or.& & (x(i).le.zero)) then if(act == 'I') then - x(i)=-3*desc_a%matrix_data(psb_m_) + x(i)=-3*psb_get_global_rows(desc_a) else info=140 int_err(1)=x(i) - int_err(2)=desc_a%matrix_data(psb_m_) + int_err(2)=psb_get_global_rows(desc_a) exit end if else tmp=desc_a%glob_to_loc(x(i)) - if((tmp.gt.zero).or.(tmp.le.desc_a%matrix_data(psb_n_col_))) then + if((tmp.gt.zero).or.(tmp.le.psb_get_local_cols(desc_a))) then x(i)=tmp else if (tmp.le.zero) then info = 150 int_err(1)=tmp exit - else if (tmp.ge.desc_a%matrix_data(psb_n_col_)) then + else if (tmp.ge.psb_get_local_cols(desc_a)) then info = 140 int_err(1)=tmp - int_err(2)=desc_a%matrix_data(psb_n_col_) + int_err(2)=psb_get_local_cols(desc_a) exit end if end if diff --git a/src/tools/psb_ialloc.f90 b/src/tools/psb_ialloc.f90 index cf2be243..d3347f2c 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -74,9 +74,9 @@ subroutine psb_ialloc(x, desc_a, info, n) goto 9999 endif - dectype=desc_a%matrix_data(psb_dec_type_) + dectype=psb_get_dectype(desc_a) !... check m and n parameters.... - if (.not.psb_is_ok_dec(dectype)) then + if (.not.psb_is_ok_desc(desc_a)) then info = 3110 call psb_errpush(info,name) goto 9999 @@ -102,8 +102,8 @@ subroutine psb_ialloc(x, desc_a, info, n) endif !....allocate x ..... - if (psb_is_asb_dec(dectype).or.psb_is_upd_dec(dectype)) then - n_col = max(1,desc_a%matrix_data(psb_n_col_)) + if (psb_is_asb_desc(desc_a).or.psb_is_upd_desc(desc_a)) then + n_col = max(1,psb_get_local_cols(desc_a)) allocate(x(n_col,n_),stat=info) if (info /= 0) then info=4010 @@ -116,8 +116,8 @@ subroutine psb_ialloc(x, desc_a, info, n) x(i,j) = 0 end do end do - else if (psb_is_bld_dec(dectype)) then - n_row = max(1,desc_a%matrix_data(psb_n_row_)) + else if (psb_is_bld_desc(desc_a)) then + n_row = max(1,psb_get_local_rows(desc_a)) allocate(x(n_row,n_),stat=info) if (info /= 0) then info=4010 @@ -213,7 +213,7 @@ subroutine psb_iallocv(x, desc_a, info,n) name='psb_iallocv' call psb_erractionsave(err_act) - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) ! ....verify blacs grid correctness.. @@ -223,11 +223,11 @@ subroutine psb_iallocv(x, desc_a, info,n) goto 9999 endif - dectype=desc_a%matrix_data(psb_dec_type_) + dectype=psb_get_dectype(desc_a) if (debug) write(0,*) 'dall: dectype',dectype - if (debug) write(0,*) 'dall: is_ok? dectype',psb_is_ok_dec(dectype) + if (debug) write(0,*) 'dall: is_ok? dectype',psb_is_ok_desc(desc_a) !... check m and n parameters.... - if (.not.psb_is_ok_dec(dectype)) then + if (.not.psb_is_ok_desc(desc_a)) then info = 3110 call psb_errpush(info,name) goto 9999 @@ -236,8 +236,8 @@ subroutine psb_iallocv(x, desc_a, info,n) ! As this is a rank-1 array, optional parameter N is actually ignored. !....allocate x ..... - if (psb_is_asb_dec(dectype).or.psb_is_upd_dec(dectype)) then - n_col = max(1,desc_a%matrix_data(psb_n_col_)) + if (psb_is_asb_desc(desc_a).or.psb_is_upd_desc(desc_a)) then + n_col = max(1,psb_get_local_cols(desc_a)) allocate(x(n_col),stat=info) if (info.ne.0) then info=2025 @@ -245,8 +245,8 @@ subroutine psb_iallocv(x, desc_a, info,n) call psb_errpush(info,name,int_err) goto 9999 endif - else if (psb_is_bld_dec(dectype)) then - n_row = max(1,desc_a%matrix_data(psb_n_row_)) + else if (psb_is_bld_desc(desc_a)) then + n_row = max(1,psb_get_local_rows(desc_a)) allocate(x(n_row),stat=info) if (info.ne.0) then info=2025 diff --git a/src/tools/psb_iasb.f90 b/src/tools/psb_iasb.f90 index f83fba98..6df35b7b 100644 --- a/src/tools/psb_iasb.f90 +++ b/src/tools/psb_iasb.f90 @@ -68,20 +68,20 @@ subroutine psb_iasb(x, desc_a, info) return endif - ictxt=desc_a%matrix_data(psb_ctxt_) - dectype=desc_a%matrix_data(psb_dec_type_) + ictxt=psb_get_context(desc_a) + dectype=psb_get_dectype(desc_a) call psb_info(ictxt, me, np) if (debug) write(*,*) 'asb start: ',np,me,& - &desc_a%matrix_data(psb_dec_type_) + &psb_get_dectype(desc_a) ! ....verify blacs grid correctness.. if (np == -1) then info = 2010 call psb_errpush(info,name) goto 9999 - else if (.not.psb_is_asb_dec(dectype)) then + else if (.not.psb_is_asb_desc(desc_a)) then if (debug) write(*,*) 'asb error ',& &dectype info = 3110 @@ -90,9 +90,9 @@ subroutine psb_iasb(x, desc_a, info) endif ! check size - ictxt=desc_a%matrix_data(psb_ctxt_) - nrow=desc_a%matrix_data(psb_n_row_) - ncol=desc_a%matrix_data(psb_n_col_) + ictxt=psb_get_context(desc_a) + nrow=psb_get_local_rows(desc_a) + ncol=psb_get_local_cols(desc_a) i1sz = size(x,dim=1) i2sz = size(x,dim=2) if (debug) write(*,*) 'asb: ',i1sz,i2sz,nrow,ncol @@ -187,8 +187,8 @@ subroutine psb_iasbv(x, desc_a, info) name = 'psb_iasbv' - ictxt=desc_a%matrix_data(psb_ctxt_) - dectype=desc_a%matrix_data(psb_dec_type_) + ictxt=psb_get_context(desc_a) + dectype=psb_get_dectype(desc_a) call psb_info(ictxt, me, np) @@ -197,14 +197,14 @@ subroutine psb_iasbv(x, desc_a, info) info = 2010 call psb_errpush(info,name) goto 9999 - else if (.not.psb_is_asb_dec(dectype)) then + else if (.not.psb_is_asb_desc(desc_a)) then info = 3110 call psb_errpush(info,name) goto 9999 endif - nrow=desc_a%matrix_data(psb_n_row_) - ncol=desc_a%matrix_data(psb_n_col_) + nrow=psb_get_local_rows(desc_a) + ncol=psb_get_local_cols(desc_a) if (debug) write(*,*) name,' sizes: ',nrow,ncol i1sz = size(x) if (debug) write(*,*) 'dasb: sizes ',i1sz,ncol diff --git a/src/tools/psb_ifree.f90 b/src/tools/psb_ifree.f90 index 56bd0c1f..e6995cf3 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) ! ....verify blacs grid correctness.. @@ -170,7 +170,7 @@ subroutine psb_ifreev(x, desc_a,info) call psb_errpush(info,name) return end if - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) ! ....verify blacs grid correctness.. diff --git a/src/tools/psb_iins.f90 b/src/tools/psb_iins.f90 index 69c8f754..b03dd75a 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -98,12 +98,12 @@ subroutine psb_iinsvi(m, irw, val, x, desc_a, info, dupl) int_err(2) = m call psb_errpush(info,name,int_err) goto 9999 - else if (.not.psb_is_ok_dec(desc_a%matrix_data(psb_dec_type_))) then + else if (.not.psb_is_ok_desc(desc_a)) then info = 3110 - int_err(1) = desc_a%matrix_data(psb_dec_type_) + int_err(1) = psb_get_dectype(desc_a) call psb_errpush(info,name,int_err) goto 9999 - else if (size(x, dim=1) < desc_a%matrix_data(psb_n_row_)) then + else if (size(x, dim=1) < psb_get_local_rows(desc_a)) then info = 310 int_err(1) = 5 int_err(2) = 4 @@ -111,9 +111,9 @@ subroutine psb_iinsvi(m, irw, val, x, desc_a, info, dupl) goto 9999 endif - loc_rows=desc_a%matrix_data(psb_n_row_) - loc_cols=desc_a%matrix_data(psb_n_col_) - mglob = desc_a%matrix_data(psb_m_) + loc_rows=psb_get_local_rows(desc_a) + loc_cols=psb_get_local_cols(desc_a) + mglob = psb_get_global_rows(desc_a) if (present(dupl)) then dupl_ = dupl @@ -263,7 +263,7 @@ subroutine psb_iinsi(m,irw, val, x, desc_a, info, dupl) return end if - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -279,12 +279,12 @@ subroutine psb_iinsi(m,irw, val, x, desc_a, info, dupl) int_err(2) = m call psb_errpush(info,name,int_err) goto 9999 - else if (.not.psb_is_ok_dec(desc_a%matrix_data(psb_dec_type_))) then + else if (.not.psb_is_ok_desc(desc_a)) then info = 3110 - int_err(1) = desc_a%matrix_data(psb_dec_type_) + int_err(1) = psb_get_dectype(desc_a) call psb_errpush(info,name,int_err) goto 9999 - else if (size(x, dim=1) < desc_a%matrix_data(psb_n_row_)) then + else if (size(x, dim=1) < psb_get_local_rows(desc_a)) then info = 310 int_err(1) = 5 int_err(2) = 4 @@ -292,9 +292,9 @@ subroutine psb_iinsi(m,irw, val, x, desc_a, info, dupl) goto 9999 endif - loc_rows=desc_a%matrix_data(psb_n_row_) - loc_cols=desc_a%matrix_data(psb_n_col_) - mglob = desc_a%matrix_data(psb_m_) + loc_rows=psb_get_local_rows(desc_a) + loc_cols=psb_get_local_cols(desc_a) + mglob = psb_get_global_rows(desc_a) n = min(size(val,2),size(x,2)) diff --git a/src/tools/psb_loc_to_glob.f90 b/src/tools/psb_loc_to_glob.f90 index b8c5adb0..daa7a946 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.desc_a%matrix_data(psb_n_col_)).or.& + if ((x(i).gt.psb_get_local_cols(desc_a)).or.& & (x(i).le.zero)) then info=140 int_err(1)=tmp - int_err(2)=desc_a%matrix_data(psb_n_col_) + int_err(2)=psb_get_local_cols(desc_a) exit else tmp=desc_a%loc_to_glob(x(i)) - if((tmp.gt.zero).or.(tmp.le.desc_a%matrix_data(psb_m_))) then + if((tmp.gt.zero).or.(tmp.le.psb_get_global_rows(desc_a))) then y(i)=tmp else info = 140 int_err(1)=tmp - int_err(2)=desc_a%matrix_data(psb_n_col_) + int_err(2)=psb_get_local_cols(desc_a) exit end if end if @@ -204,15 +204,15 @@ subroutine psb_loc_to_glob(x,desc_a,info,iact) n=size(x) do i=1,n - if ((x(i).gt.desc_a%matrix_data(psb_n_col_)).or.& + if ((x(i).gt.psb_get_local_cols(desc_a)).or.& & (x(i).le.zero)) then info=140 int_err(1)=x(i) - int_err(2)=desc_a%matrix_data(psb_n_col_) + int_err(2)=psb_get_local_cols(desc_a) exit else tmp=desc_a%loc_to_glob(x(i)) - if((tmp.gt.zero).or.(tmp.le.desc_a%matrix_data(psb_m_))) then + if((tmp.gt.zero).or.(tmp.le.psb_get_global_rows(desc_a))) then x(i)=tmp else info = 140 diff --git a/src/tools/psb_zallc.f90 b/src/tools/psb_zallc.f90 index 84d31c7c..358b816a 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -76,9 +76,9 @@ subroutine psb_zalloc(x, desc_a, info, n) goto 9999 endif - dectype=desc_a%matrix_data(psb_dec_type_) + dectype=psb_get_dectype(desc_a) !... check m and n parameters.... - if (.not.psb_is_ok_dec(dectype)) then + if (.not.psb_is_ok_desc(desc_a)) then info = 3110 call psb_errpush(info,name) goto 9999 @@ -104,8 +104,8 @@ subroutine psb_zalloc(x, desc_a, info, n) endif !....allocate x ..... - if (psb_is_asb_dec(dectype).or.psb_is_upd_dec(dectype)) then - n_col = max(1,desc_a%matrix_data(psb_n_col_)) + if (psb_is_asb_desc(desc_a).or.psb_is_upd_desc(desc_a)) then + n_col = max(1,psb_get_local_cols(desc_a)) allocate(x(n_col,n_),stat=info) if (info /= 0) then info=4010 @@ -118,8 +118,8 @@ subroutine psb_zalloc(x, desc_a, info, n) x(i,j) = 0.0d0 end do end do - else if (psb_is_bld_dec(dectype)) then - n_row = max(1,desc_a%matrix_data(psb_n_row_)) + else if (psb_is_bld_desc(desc_a)) then + n_row = max(1,psb_get_local_rows(desc_a)) allocate(x(n_row,n_),stat=info) if (info /= 0) then info=4010 @@ -212,7 +212,7 @@ subroutine psb_zallocv(x, desc_a,info,n) name='psb_zallcv' call psb_erractionsave(err_act) - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) ! ....verify blacs grid correctness.. @@ -222,11 +222,11 @@ subroutine psb_zallocv(x, desc_a,info,n) goto 9999 endif - dectype=desc_a%matrix_data(psb_dec_type_) + dectype=psb_get_dectype(desc_a) if (debug) write(0,*) 'dall: dectype',dectype - if (debug) write(0,*) 'dall: is_ok? dectype',psb_is_ok_dec(dectype) + if (debug) write(0,*) 'dall: is_ok? dectype',psb_is_ok_desc(desc_a) !... check m and n parameters.... - if (.not.psb_is_ok_dec(dectype)) then + if (.not.psb_is_ok_desc(desc_a)) then info = 3110 call psb_errpush(info,name) goto 9999 @@ -235,8 +235,8 @@ subroutine psb_zallocv(x, desc_a,info,n) ! As this is a rank-1 array, optional parameter N is actually ignored. !....allocate x ..... - if (psb_is_asb_dec(dectype).or.psb_is_upd_dec(dectype)) then - n_col = max(1,desc_a%matrix_data(psb_n_col_)) + if (psb_is_asb_desc(desc_a).or.psb_is_upd_desc(desc_a)) then + n_col = max(1,psb_get_local_cols(desc_a)) call psb_realloc(n_col,x,info) if (info /= 0) then info=4010 @@ -248,8 +248,8 @@ subroutine psb_zallocv(x, desc_a,info,n) x(i) = 0.0d0 end do - else if (psb_is_bld_dec(dectype)) then - n_row = max(1,desc_a%matrix_data(psb_n_row_)) + else if (psb_is_bld_desc(desc_a)) then + n_row = max(1,psb_get_local_rows(desc_a)) call psb_realloc(n_row,x,info) if (info /= 0) then info=4010 diff --git a/src/tools/psb_zasb.f90 b/src/tools/psb_zasb.f90 index a7a037d8..c9e3b990 100644 --- a/src/tools/psb_zasb.f90 +++ b/src/tools/psb_zasb.f90 @@ -68,20 +68,20 @@ subroutine psb_zasb(x, desc_a, info) goto 9999 endif - ictxt=desc_a%matrix_data(psb_ctxt_) - dectype=desc_a%matrix_data(psb_dec_type_) + ictxt=psb_get_context(desc_a) + dectype=psb_get_dectype(desc_a) call psb_info(ictxt, me, np) if (debug) write(*,*) 'asb start: ',np,me,& - &desc_a%matrix_data(psb_dec_type_) + &psb_get_dectype(desc_a) ! ....verify blacs grid correctness.. if (np == -1) then info = 2010 call psb_errpush(info,name) goto 9999 - else if (.not.psb_is_asb_dec(dectype)) then + else if (.not.psb_is_asb_desc(desc_a)) then if (debug) write(*,*) 'asb error ',& &dectype info = 3110 @@ -90,9 +90,9 @@ subroutine psb_zasb(x, desc_a, info) endif ! check size - ictxt=desc_a%matrix_data(psb_ctxt_) - nrow=desc_a%matrix_data(psb_n_row_) - ncol=desc_a%matrix_data(psb_n_col_) + ictxt=psb_get_context(desc_a) + nrow=psb_get_local_rows(desc_a) + ncol=psb_get_local_cols(desc_a) i1sz = size(x,dim=1) i2sz = size(x,dim=2) if (debug) write(*,*) 'asb: ',i1sz,i2sz,nrow,ncol @@ -191,8 +191,8 @@ subroutine psb_zasbv(x, desc_a, info) int_err(1) = 0 name = 'psb_zasbv' - ictxt=desc_a%matrix_data(psb_ctxt_) - dectype=desc_a%matrix_data(psb_dec_type_) + ictxt=psb_get_context(desc_a) + dectype=psb_get_dectype(desc_a) call psb_info(ictxt, me, np) @@ -201,14 +201,14 @@ subroutine psb_zasbv(x, desc_a, info) info = 2010 call psb_errpush(info,name) goto 9999 - else if (.not.psb_is_asb_dec(dectype)) then + else if (.not.psb_is_asb_desc(desc_a)) then info = 3110 call psb_errpush(info,name) goto 9999 endif - nrow=desc_a%matrix_data(psb_n_row_) - ncol=desc_a%matrix_data(psb_n_col_) + nrow=psb_get_local_rows(desc_a) + ncol=psb_get_local_cols(desc_a) if (debug) write(*,*) name,' sizes: ',nrow,ncol i1sz = size(x) if (debug) write(*,*) 'dasb: sizes ',i1sz,ncol diff --git a/src/tools/psb_zcdovr.f90 b/src/tools/psb_zcdovr.f90 index a51ae09b..450386e8 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) Call psb_info(ictxt, me, np) If(debug) Write(0,*)'in psb_cdovr',novr - m=desc_a%matrix_data(psb_n_row_) + m=psb_get_local_rows(desc_a) nnzero=Size(a%aspk) - n_col=desc_a%matrix_data(psb_n_col_) + n_col=psb_get_local_cols(desc_a) nhalo = n_col-m If(debug) Write(0,*)'IN CDOVR1',novr ,m,nnzero,n_col if (novr<0) then diff --git a/src/tools/psb_zcdovrbld.f90 b/src/tools/psb_zcdovrbld.f90 index 28553f90..c5d60070 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 = desc_a%matrix_data(psb_ctxt_) + ictxt = psb_get_context(desc_a) Call psb_info(ictxt,me,np) @@ -108,10 +108,10 @@ Subroutine psb_zcdovrbld(n_ovr,desc_p,desc_a,a,& t4 = 0.0 call psb_get_mpicomm(ictxt,icomm ) - mglob = desc_a%matrix_data(psb_m_) - m = desc_a%matrix_data(psb_n_row_) - n_row = desc_a%matrix_data(psb_n_row_) - n_col = desc_a%matrix_data(psb_n_col_) + mglob = psb_get_global_rows(desc_a) + m = psb_get_local_rows(desc_a) + n_row = psb_get_local_rows(desc_a) + n_col = psb_get_local_cols(desc_a) if (debug) write(0,*) me,' On entry to CDOVRBLD n_col:',n_col dl_lda=np*5 @@ -537,8 +537,8 @@ Subroutine psb_zcdovrbld(n_ovr,desc_p,desc_a,a,& End Do t1 = mpi_wtime() - desc_p%matrix_data(psb_m_)=desc_a%matrix_data(psb_m_) - desc_p%matrix_data(psb_n_)=desc_a%matrix_data(psb_n_) + desc_p%matrix_data(psb_m_)=psb_get_global_rows(desc_a) + desc_p%matrix_data(psb_n_)=psb_get_global_cols(desc_a) tmp_halo(counter_h)=-1 tmp_ovr_idx(counter_o)=-1 diff --git a/src/tools/psb_zcsrp.f90 b/src/tools/psb_zcsrp.f90 index d99fc614..552b568c 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=desc_a%matrix_data(psb_ctxt_) - dectype=desc_a%matrix_data(psb_dec_type_) - n_row = desc_a%matrix_data(psb_n_row_) - n_col = desc_a%matrix_data(psb_n_col_) + ictxt=psb_get_context(desc_a) + dectype=psb_get_dectype(desc_a) + n_row = psb_get_local_rows(desc_a) + n_col = psb_get_local_cols(desc_a) if(psb_get_errstatus() /= 0) return info=0 @@ -107,7 +107,7 @@ subroutine psb_zcsrp(trans,iperm,a, desc_a, info) endif - if (.not.psb_is_asb_dec(dectype)) then + if (.not.psb_is_asb_desc(desc_a)) then info = 600 int_err(1) = dectype call psb_errpush(info,name,int_err) diff --git a/src/tools/psb_zfree.f90 b/src/tools/psb_zfree.f90 index 521a154f..f106af33 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) ! ....verify blacs grid correctness.. @@ -141,7 +141,7 @@ subroutine psb_zfreev(x, desc_a, info) call psb_errpush(info,name) goto 9999 end if - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then diff --git a/src/tools/psb_zgelp.f90 b/src/tools/psb_zgelp.f90 index d59a768e..7bfbacd9 100644 --- a/src/tools/psb_zgelp.f90 +++ b/src/tools/psb_zgelp.f90 @@ -86,23 +86,23 @@ subroutine psb_zgelp(trans,iperm,x,desc_a,info) info=0 call psb_erractionsave(err_act) - ictxt=desc_a%matrix_data(psb_ctxt_) - dectype=desc_a%matrix_data(psb_dec_type_) - nrow = desc_a%matrix_data(psb_n_row_) - ncol = desc_a%matrix_data(psb_n_col_) + ictxt=psb_get_context(desc_a) + dectype=psb_get_dectype(desc_a) + nrow = psb_get_local_rows(desc_a) + ncol = psb_get_local_cols(desc_a) i1sz = size(x,dim=1) i2sz = size(x,dim=2) call psb_info(ictxt, me, np) if (debug) write(*,*) 'asb start: ',np,me,& - &desc_a%matrix_data(psb_dec_type_) + &psb_get_dectype(desc_a) ! ....verify blacs grid correctness.. if (np == -1) then info = 2010 call psb_errpush(info,name) goto 9999 - else if (.not.psb_is_asb_dec(dectype)) then + else if (.not.psb_is_asb_desc(desc_a)) then info = 3110 call psb_errpush(info,name) goto 9999 @@ -232,10 +232,10 @@ subroutine psb_zgelpv(trans,iperm,x,desc_a,info) i1sz = size(x) - ictxt=desc_a%matrix_data(psb_ctxt_) - dectype=desc_a%matrix_data(psb_dec_type_) - nrow=desc_a%matrix_data(psb_n_row_) - ncol=desc_a%matrix_data(psb_n_col_) + ictxt=psb_get_context(desc_a) + dectype=psb_get_dectype(desc_a) + nrow=psb_get_local_rows(desc_a) + ncol=psb_get_local_cols(desc_a) call psb_info(ictxt, me, np) @@ -244,7 +244,7 @@ subroutine psb_zgelpv(trans,iperm,x,desc_a,info) info = 2010 call psb_errpush(info,name) goto 9999 - else if (.not.psb_is_asb_dec(dectype)) then + else if (.not.psb_is_asb_desc(desc_a)) then info = 3110 call psb_errpush(info,name) goto 9999 diff --git a/src/tools/psb_zins.f90 b/src/tools/psb_zins.f90 index 4815b0e8..9c3f8171 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -99,12 +99,12 @@ subroutine psb_zinsvi(m, irw, val, x, desc_a, info, dupl) int_err(2) = m call psb_errpush(info,name,int_err) goto 9999 - else if (.not.psb_is_ok_dec(desc_a%matrix_data(psb_dec_type_))) then + else if (.not.psb_is_ok_desc(desc_a)) then info = 3110 - int_err(1) = desc_a%matrix_data(psb_dec_type_) + int_err(1) = psb_get_dectype(desc_a) call psb_errpush(info,name,int_err) goto 9999 - else if (size(x, dim=1) < desc_a%matrix_data(psb_n_row_)) then + else if (size(x, dim=1) < psb_get_local_rows(desc_a)) then info = 310 int_err(1) = 5 int_err(2) = 4 @@ -112,9 +112,9 @@ subroutine psb_zinsvi(m, irw, val, x, desc_a, info, dupl) goto 9999 endif - loc_rows=desc_a%matrix_data(psb_n_row_) - loc_cols=desc_a%matrix_data(psb_n_col_) - mglob = desc_a%matrix_data(psb_m_) + loc_rows=psb_get_local_rows(desc_a) + loc_cols=psb_get_local_cols(desc_a) + mglob = psb_get_global_rows(desc_a) if (present(dupl)) then dupl_ = dupl @@ -264,7 +264,7 @@ subroutine psb_zinsi(m,irw, val, x, desc_a, info, dupl) return end if - ictxt=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) call psb_info(ictxt, me, np) if (np == -1) then @@ -280,12 +280,12 @@ subroutine psb_zinsi(m,irw, val, x, desc_a, info, dupl) int_err(2) = m call psb_errpush(info,name,int_err) goto 9999 - else if (.not.psb_is_ok_dec(desc_a%matrix_data(psb_dec_type_))) then + else if (.not.psb_is_ok_desc(desc_a)) then info = 3110 - int_err(1) = desc_a%matrix_data(psb_dec_type_) + int_err(1) = psb_get_dectype(desc_a) call psb_errpush(info,name,int_err) goto 9999 - else if (size(x, dim=1) < desc_a%matrix_data(psb_n_row_)) then + else if (size(x, dim=1) < psb_get_local_rows(desc_a)) then info = 310 int_err(1) = 5 int_err(2) = 4 @@ -293,9 +293,9 @@ subroutine psb_zinsi(m,irw, val, x, desc_a, info, dupl) goto 9999 endif - loc_rows=desc_a%matrix_data(psb_n_row_) - loc_cols=desc_a%matrix_data(psb_n_col_) - mglob = desc_a%matrix_data(psb_m_) + loc_rows=psb_get_local_rows(desc_a) + loc_cols=psb_get_local_cols(desc_a) + mglob = psb_get_global_rows(desc_a) n = min(size(val,2),size(x,2)) diff --git a/src/tools/psb_zspalloc.f90 b/src/tools/psb_zspalloc.f90 index c48297f3..07e348bc 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 = desc_a%matrix_data(psb_ctxt_) - dectype = desc_a%matrix_data(psb_dec_type_) + ictxt = psb_get_context(desc_a) + dectype = psb_get_dectype(desc_a) call psb_info(ictxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then @@ -85,9 +85,9 @@ subroutine psb_zspalloc(a, desc_a, info, nnz) ! check if psdalloc is already called for this matrix ! set fields in desc_a%matrix_data.... - loc_row = desc_a%matrix_data(psb_n_row_) - m = desc_a%matrix_data(psb_m_) - n = desc_a%matrix_data(psb_n_) + loc_row = psb_get_local_rows(desc_a) + m = psb_get_global_rows(desc_a) + n = psb_get_global_cols(desc_a) !...allocate matrix data... if (present(nnz))then @@ -127,7 +127,7 @@ subroutine psb_zspalloc(a, desc_a, info, nnz) a%infoa(psb_state_) = psb_spmat_bld_ if (debug) write(0,*) 'spall: ', & - &desc_a%matrix_data(psb_dec_type_),psb_desc_bld_ + &psb_get_dectype(desc_a),psb_desc_bld_ return diff --git a/src/tools/psb_zspasb.f90 b/src/tools/psb_zspasb.f90 index 8538f19e..266679c5 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 = desc_a%matrix_data(psb_ctxt_) - dscstate = desc_a%matrix_data(psb_dec_type_) - n_row = desc_a%matrix_data(psb_n_row_) - n_col = desc_a%matrix_data(psb_n_col_) + ictxt = psb_get_context(desc_a) + dscstate = psb_get_dectype(desc_a) + n_row = psb_get_local_rows(desc_a) + n_col = psb_get_local_cols(desc_a) ! check on BLACS grid call psb_info(ictxt, me, np) @@ -106,8 +106,8 @@ subroutine psb_zspasb(a,desc_a, info, afmt, upd, dupl) ! First case: we come from a fresh build. ! - n_row = desc_a%matrix_data(psb_n_row_) - n_col = desc_a%matrix_data(psb_n_col_) + n_row = psb_get_local_rows(desc_a) + n_col = psb_get_local_cols(desc_a) ! ! Second step: handle the local matrix part. diff --git a/src/tools/psb_zspcnv.f90 b/src/tools/psb_zspcnv.f90 index ebff1cdd..add0b783 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 = desc_a%matrix_data(psb_ctxt_) - dectype = desc_a%matrix_data(psb_dec_type_) - n_row = desc_a%matrix_data(psb_n_row_) - n_col = desc_a%matrix_data(psb_n_col_) + ictxt = psb_get_context(desc_a) + dectype = psb_get_dectype(desc_a) + n_row = psb_get_local_rows(desc_a) + n_col = psb_get_local_cols(desc_a) ! check on blacs grid call psb_info(ictxt, me, np) diff --git a/src/tools/psb_zspfree.f90 b/src/tools/psb_zspfree.f90 index 7c8d4f27..9ee96709 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) end if !...deallocate a.... diff --git a/src/tools/psb_zsphalo.f90 b/src/tools/psb_zsphalo.f90 index 07dde70f..739be6a8 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=desc_a%matrix_data(psb_ctxt_) + ictxt=psb_get_context(desc_a) Call psb_info(ictxt, me, np) t1 = mpi_wtime() diff --git a/src/tools/psb_zspins.f90 b/src/tools/psb_zspins.f90 index 6d34e1de..98f9ecdd 100644 --- a/src/tools/psb_zspins.f90 +++ b/src/tools/psb_zspins.f90 @@ -86,13 +86,13 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild) call psb_erractionsave(err_act) - ictxt = desc_a%matrix_data(psb_ctxt_) - dectype = desc_a%matrix_data(psb_dec_type_) - mglob = desc_a%matrix_data(psb_m_) + ictxt = psb_get_context(desc_a) + dectype = psb_get_dectype(desc_a) + mglob = psb_get_global_rows(desc_a) call psb_info(ictxt, me, np) - if (.not.psb_is_ok_dec(dectype)) then + if (.not.psb_is_ok_desc(desc_a)) then info = 3110 call psb_errpush(info,name) goto 9999 @@ -127,7 +127,7 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild) endif spstate = a%infoa(psb_state_) - if (psb_is_bld_dec(dectype)) then + if (psb_is_bld_desc(desc_a)) then call psb_cdins(nz,ia,ja,desc_a,info) if (info /= 0) then info=4010 @@ -135,8 +135,8 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild) call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - nrow = desc_a%matrix_data(psb_n_row_) - ncol = desc_a%matrix_data(psb_n_col_) + nrow = psb_get_local_rows(desc_a) + ncol = psb_get_local_cols(desc_a) if (spstate == psb_spmat_bld_) then call psb_coins(nz,ia,ja,val,a,1,nrow,1,ncol,info,gtl=desc_a%glob_to_loc) @@ -151,9 +151,9 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild) call psb_errpush(info,name) goto 9999 end if - else if (psb_is_asb_dec(dectype)) then - nrow = desc_a%matrix_data(psb_n_row_) - ncol = desc_a%matrix_data(psb_n_col_) + else if (psb_is_asb_desc(desc_a)) then + nrow = psb_get_local_rows(desc_a) + ncol = psb_get_local_cols(desc_a) call psb_coins(nz,ia,ja,val,a,1,nrow,1,ncol,& & info,gtl=desc_a%glob_to_loc,rebuild=rebuild_) if (info /= 0) then diff --git a/src/tools/psb_zsprn.f90 b/src/tools/psb_zsprn.f90 index 1e0559a3..640a99e0 100644 --- a/src/tools/psb_zsprn.f90 +++ b/src/tools/psb_zsprn.f90 @@ -67,17 +67,17 @@ Subroutine psb_zsprn(a, desc_a,info,clear) name = 'psb_zsprn' call psb_erractionsave(err_act) - ictxt = desc_a%matrix_data(psb_ctxt_) + ictxt = psb_get_context(desc_a) call psb_info(ictxt, me, np) if (debug) & &write(*,*) 'starting spalloc ',ictxt,np,me - if (psb_is_bld_dec(desc_a%matrix_data(psb_dec_type_))) then + if (psb_is_bld_desc(desc_a)) then ! Should do nothing, we are called redundantly return endif - if (.not.psb_is_asb_dec(desc_a%matrix_data(psb_dec_type_))) then + if (.not.psb_is_asb_desc(desc_a)) then info=590 call psb_errpush(info,name) goto 9999