From 4398391a5cd2ff2253179f1440eddcff927b75ca Mon Sep 17 00:00:00 2001 From: Alfredo Buttari Date: Fri, 28 Oct 2005 10:32:18 +0000 Subject: [PATCH] added error check on subroutine entry point --- src/internals/psi_desc_index.f90 | 1 - src/internals/psi_sort_dl.f90 | 1 + src/methd/psb_dbicg.f90 | 1 - src/methd/psb_dcg.f90 | 1 - src/methd/psb_dcgs.f90 | 1 - src/methd/psb_dcgstab.f90 | 1 - src/methd/psb_dcgstabl.f90 | 1 - src/methd/psb_dgmresr.f90 | 1 - src/prec/psb_dbldaggrmat.f90 | 7 +- src/prec/psb_dcslu.f90 | 7 +- src/prec/psb_dcsrsetup.f90 | 1 + src/prec/psb_dgenaggrmap.f90 | 1 + src/prec/psb_dprec.f90 | 6 +- src/prec/psb_dprecbld.f90 | 6 ++ src/prec/psb_dprecfree.f90 | 2 +- src/prec/psb_dsplu.f90 | 3 +- src/psblas/psb_chkglobvect.f90 | 1 + src/psblas/psb_chkmat.f90 | 1 + src/psblas/psb_chkvect.f90 | 1 + src/psblas/psb_damax.f90 | 4 + src/psblas/psb_dasum.f90 | 3 + src/psblas/psb_daxpby.f90 | 2 + src/psblas/psb_ddot.f90 | 4 + src/psblas/psb_dnrm2.f90 | 3 + src/psblas/psb_dnrmi.f90 | 1 + src/psblas/psb_dspmm.f90 | 2 + src/psblas/psb_dspsm.f90 | 2 + src/serial/psb_dtransp.f90 | 1 + src/tools/psb_dallc.f90 | 2 + src/tools/psb_dasb.f90 | 3 +- src/tools/psb_dcsrovr.f90 | 3 +- src/tools/psb_dcsrp.f90 | 3 +- src/tools/psb_descasb.f90 | 6 +- src/tools/psb_dfree.f90 | 4 +- src/tools/psb_dgelp.f90 | 4 +- src/tools/psb_dins.f90 | 3 + src/tools/psb_dscall.f90 | 1 + src/tools/psb_dscalv.f90 | 1 + src/tools/psb_dsccpy.f90 | 2 +- src/tools/psb_dscdec.f90 | 2 +- src/tools/psb_dscfree.f90 | 2 +- src/tools/psb_dscren.f90 | 1 + src/tools/psb_dscrep.f90 | 1 + src/tools/psb_dspalloc.f90 | 2 +- src/tools/psb_dspasb.f90 | 15 +++ src/tools/psb_dspcnv.f90 | 2 +- src/tools/psb_dspfree.f90 | 152 +++++++++++++++---------------- src/tools/psb_dspupdate.f90 | 1 + src/tools/psb_glob_to_loc.f90 | 2 + src/tools/psb_ialloc.f90 | 2 + src/tools/psb_iasb.f90 | 10 +- src/tools/psb_ifree.f90 | 4 +- src/tools/psb_iins.f90 | 3 + src/tools/psb_loc_to_glob.f90 | 2 + test/Fileread/RUNS/rtst.inp | 10 +- test/Fileread/df_sample.f90 | 9 +- test/Fileread/getp.f90 | 10 +- 57 files changed, 198 insertions(+), 130 deletions(-) diff --git a/src/internals/psi_desc_index.f90 b/src/internals/psi_desc_index.f90 index 4c28e786..01ef488e 100644 --- a/src/internals/psi_desc_index.f90 +++ b/src/internals/psi_desc_index.f90 @@ -17,7 +17,6 @@ subroutine psi_desc_index(desc_data,index_in,dep_list,& !c ....local scalars... integer :: j,me,np,npcol,mycol,i,proc,dim !c ...parameters... - integer, parameter :: ione=1 integer :: icontxt integer :: no_comm,err parameter (no_comm=-1) diff --git a/src/internals/psi_sort_dl.f90 b/src/internals/psi_sort_dl.f90 index d13d2766..3f814435 100644 --- a/src/internals/psi_sort_dl.f90 +++ b/src/internals/psi_sort_dl.f90 @@ -14,6 +14,7 @@ subroutine psi_sort_dl(dep_list,l_dep_list,np,info) character(len=20) :: name, ch_err name='psi_sort_dl' + if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) diff --git a/src/methd/psb_dbicg.f90 b/src/methd/psb_dbicg.f90 index 2ca7b9f9..eafd06a4 100644 --- a/src/methd/psb_dbicg.f90 +++ b/src/methd/psb_dbicg.f90 @@ -77,7 +77,6 @@ subroutine psb_dbicg(a,prec,b,x,eps,desc_a,info,& character ::diagl, diagu logical, parameter :: debug = .false. logical, parameter :: exchange=.true., noexchange=.false. - integer, parameter :: ione=1 integer, parameter :: irmax = 8 integer :: itx, i, isvch, ich, icontxt logical :: do_renum_left diff --git a/src/methd/psb_dcg.f90 b/src/methd/psb_dcg.f90 index 1f710608..bd04e3e5 100644 --- a/src/methd/psb_dcg.f90 +++ b/src/methd/psb_dcg.f90 @@ -76,7 +76,6 @@ Subroutine psb_dcg(a,prec,b,x,eps,desc_a,info,& & nprows,npcols,me,mecol, n_col, isvch, ich, icontxt, n_row,err_act, int_err(5) character ::diagl, diagu logical, parameter :: exchange=.true., noexchange=.false. - integer, parameter :: ione=1 real(kind(1.d0)), parameter :: one=1.d0, zero=0.d0, epstol=1.d-35 character(len=20) :: name,ch_err diff --git a/src/methd/psb_dcgs.f90 b/src/methd/psb_dcgs.f90 index 97764790..c02fada1 100644 --- a/src/methd/psb_dcgs.f90 +++ b/src/methd/psb_dcgs.f90 @@ -74,7 +74,6 @@ Subroutine psb_dcgs(a,prec,b,x,eps,desc_a,info,& & nprows,npcols,me,mecol, n_row, n_col,listop, err_act Character ::diagl, diagu Logical, Parameter :: exchange=.True., noexchange=.False. - Integer, Parameter :: ione=1 Integer, Parameter :: irmax = 8 Integer :: itx, i, isvch, ich, icontxt Logical :: do_renum_left diff --git a/src/methd/psb_dcgstab.f90 b/src/methd/psb_dcgstab.f90 index 44d274b6..1e501270 100644 --- a/src/methd/psb_dcgstab.f90 +++ b/src/methd/psb_dcgstab.f90 @@ -75,7 +75,6 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,& Character ::diagl, diagu Logical, Parameter :: debug = .false. Logical, Parameter :: exchange=.True., noexchange=.False., debug1 = .False. - Integer, Parameter :: ione=1 Integer, Parameter :: irmax = 8 Integer :: itx, i, isvch, ich, icontxt, err_act, int_err(5),ii Integer :: listop diff --git a/src/methd/psb_dcgstabl.f90 b/src/methd/psb_dcgstabl.f90 index 69e10d25..270c5c1f 100644 --- a/src/methd/psb_dcgstabl.f90 +++ b/src/methd/psb_dcgstabl.f90 @@ -83,7 +83,6 @@ Subroutine psb_dcgstabl(a,prec,b,x,eps,desc_a,info,& & nprows,npcols,me,mecol, n_row, n_col, nl, err_act Character ::diagl, diagu Logical, Parameter :: exchange=.True., noexchange=.False. - Integer, Parameter :: ione=1 Integer, Parameter :: irmax = 8 Integer :: itx, i, isvch, ich, icontxt,listop,j, int_err(5) Logical :: do_renum_left diff --git a/src/methd/psb_dgmresr.f90 b/src/methd/psb_dgmresr.f90 index f20e4223..df3d6adc 100644 --- a/src/methd/psb_dgmresr.f90 +++ b/src/methd/psb_dgmresr.f90 @@ -85,7 +85,6 @@ Subroutine psb_dgmresr(a,prec,b,x,eps,desc_a,info,& & nprows,npcols,me,mecol, n_row, n_col, nl, int_err(5) Character ::diagl, diagu Logical, Parameter :: exchange=.True., noexchange=.False. - Integer, Parameter :: ione=1 Integer, Parameter :: irmax = 8 Integer :: itx, i, isvch, ich, icontxt,listop, err_act Logical :: do_renum_left,inner_stop diff --git a/src/prec/psb_dbldaggrmat.f90 b/src/prec/psb_dbldaggrmat.f90 index 55eb2342..e0ebf493 100644 --- a/src/prec/psb_dbldaggrmat.f90 +++ b/src/prec/psb_dbldaggrmat.f90 @@ -17,6 +17,7 @@ subroutine psb_dbldaggrmat(a,desc_a,p,info) integer ::icontxt,nprow,npcol,me,mycol, err_act character(len=20) :: name, ch_err name='psb_dbldaggrmat' + if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) @@ -77,7 +78,8 @@ contains & naggr, np, myprow, mypcol, nprows, npcols,nzt,irs,jl,nzl,nlr,& & icomm,naggrm1, mtype, i, j, err_act name='raw_aggregate' - info=0 + if(psb_get_errstatus().ne.0) return + info=0 call psb_erractionsave(err_act) bg => p%av(ac_) @@ -314,7 +316,8 @@ contains name='smooth_aggregate' - info=0 + if(psb_get_errstatus().ne.0) return + info=0 call psb_erractionsave(err_act) icontxt = desc_a%matrix_data(psb_ctxt_) diff --git a/src/prec/psb_dcslu.f90 b/src/prec/psb_dcslu.f90 index cf11f20e..fd10579b 100644 --- a/src/prec/psb_dcslu.f90 +++ b/src/prec/psb_dcslu.f90 @@ -76,6 +76,7 @@ subroutine psb_dcslu(a,desc_a,p,upd,info) end Subroutine psb_dcsrsetup end interface + if(psb_get_errstatus().ne.0) return info=0 name='psb_dcslu' call psb_erractionsave(err_act) @@ -317,7 +318,8 @@ contains integer, intent(out) :: info character(len=20) :: name, ch_err - info=0 + if(psb_get_errstatus().ne.0) return + info=0 name='apply_renum' call psb_erractionsave(err_act) @@ -615,7 +617,8 @@ contains character(len=20) :: name, ch_err - info=0 + if(psb_get_errstatus().ne.0) return + info=0 name='gps_reduction' call psb_erractionsave(err_act) diff --git a/src/prec/psb_dcsrsetup.f90 b/src/prec/psb_dcsrsetup.f90 index c8c19a73..f5cdbeae 100644 --- a/src/prec/psb_dcsrsetup.f90 +++ b/src/prec/psb_dcsrsetup.f90 @@ -48,6 +48,7 @@ Subroutine psb_dcsrsetup(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt) Logical,Parameter :: debug=.false., debugprt=.false. character(len=20) :: name, ch_err name='psb_dcsrsetup' + if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) diff --git a/src/prec/psb_dgenaggrmap.f90 b/src/prec/psb_dgenaggrmap.f90 index f9ea91b4..d299698f 100644 --- a/src/prec/psb_dgenaggrmap.f90 +++ b/src/prec/psb_dgenaggrmap.f90 @@ -20,6 +20,7 @@ subroutine psb_dgenaggrmap(aggr_type,a,desc_a,nlaggr,ilaggr,info) integer, parameter :: one=1, two=2 character(len=20) :: name, ch_err + if(psb_get_errstatus().ne.0) return info=0 name = 'psb_bldaggrmat' call psb_erractionsave(err_act) diff --git a/src/prec/psb_dprec.f90 b/src/prec/psb_dprec.f90 index 1ebabdd2..ef7294c3 100644 --- a/src/prec/psb_dprec.f90 +++ b/src/prec/psb_dprec.f90 @@ -255,8 +255,7 @@ subroutine psb_dbaseprcaply(prec,x,beta,y,desc_data,trans,work,info) end if if (prec%iprcparm(iren_)>0) then -!!$ call psb_dgelp('N',n_row,1,prec%perm,tx,isz,ww,isz,info) - info = -1 + call dgelp('N',n_row,1,prec%perm,tx,isz,ww,isz,info) if(info /=0) then info=4010 ch_err='psb_dgelp' @@ -267,8 +266,7 @@ subroutine psb_dbaseprcaply(prec,x,beta,y,desc_data,trans,work,info) call psb_dbjacaply(prec,tx,zero,ty,prec%desc_data,trans,aux,info) if (prec%iprcparm(iren_)>0) then -!!$ call psb_dgelp('N',n_row,1,prec%invperm,ty,isz,ww,isz,info) - info = -1 + call dgelp('N',n_row,1,prec%invperm,ty,isz,ww,isz,info) if(info /=0) then info=4010 ch_err='psb_dgelp' diff --git a/src/prec/psb_dprecbld.f90 b/src/prec/psb_dprecbld.f90 index f085c39e..fb572f4a 100644 --- a/src/prec/psb_dprecbld.f90 +++ b/src/prec/psb_dprecbld.f90 @@ -4,6 +4,7 @@ subroutine psb_dprecbld(a,p,desc_a,info,upd) Use psb_spmat_type use psb_descriptor_type use psb_prec_type + use psb_tools_mod use psb_comm_mod use psb_const_mod use psb_psblas_mod @@ -70,6 +71,7 @@ subroutine psb_dprecbld(a,p,desc_a,info,upd) integer,parameter :: iroot=0,iout=60,ilout=40 character(len=20) :: name, ch_err + if(psb_get_errstatus().ne.0) return info=0 err=0 call psb_erractionsave(err_act) @@ -307,6 +309,7 @@ subroutine psb_splu_bld(a,desc_a,p,info) use psb_serial_mod use psb_descriptor_type use psb_prec_type + use psb_tools_mod use psb_const_mod implicit none @@ -339,6 +342,7 @@ subroutine psb_splu_bld(a,desc_a,p,info) end Subroutine psb_dcsrsetup end interface + if(psb_get_errstatus().ne.0) return info=0 name='psb_splu_bld' call psb_erractionsave(err_act) @@ -663,6 +667,7 @@ end subroutine psb_umf_bld subroutine psb_mlprec_bld(a,desc_a,p,info) use psb_serial_mod + use psb_tools_mod use psb_descriptor_type use psb_prec_type use psb_const_mod @@ -716,6 +721,7 @@ subroutine psb_mlprec_bld(a,desc_a,p,info) integer :: icontxt, nprow, npcol, me, mycol name='psb_mlprec_bld' + if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) diff --git a/src/prec/psb_dprecfree.f90 b/src/prec/psb_dprecfree.f90 index 18d0f27e..572c823e 100644 --- a/src/prec/psb_dprecfree.f90 +++ b/src/prec/psb_dprecfree.f90 @@ -17,9 +17,9 @@ subroutine psb_dprecfree(p,info) integer :: temp(1), me real(kind(1.d0)) :: real_err(5) integer :: icontxt,err_act,i - integer,parameter :: ione=1 character(len=20) :: name, ch_err + if(psb_get_errstatus().ne.0) return info=0 name = 'psdprecfree' call psb_erractionsave(err_act) diff --git a/src/prec/psb_dsplu.f90 b/src/prec/psb_dsplu.f90 index ed84ac66..e2912c85 100644 --- a/src/prec/psb_dsplu.f90 +++ b/src/prec/psb_dsplu.f90 @@ -108,7 +108,8 @@ contains character(len=20) :: name, ch_err name='psb_dspluint' - info=0 + if(psb_get_errstatus().ne.0) return + info=0 call psb_erractionsave(err_act) trw%m=0 diff --git a/src/psblas/psb_chkglobvect.f90 b/src/psblas/psb_chkglobvect.f90 index 74a750a0..f15caae9 100644 --- a/src/psblas/psb_chkglobvect.f90 +++ b/src/psblas/psb_chkglobvect.f90 @@ -30,6 +30,7 @@ subroutine psb_chkglobvect( m, n, lldx, ix, jx, desc_dec, info) 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) diff --git a/src/psblas/psb_chkmat.f90 b/src/psblas/psb_chkmat.f90 index b0a1bb4a..ef0d2279 100644 --- a/src/psblas/psb_chkmat.f90 +++ b/src/psblas/psb_chkmat.f90 @@ -35,6 +35,7 @@ subroutine psb_chkmat( m, n, ia, ja, desc_dec, info, iia, jja) 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) diff --git a/src/psblas/psb_chkvect.f90 b/src/psblas/psb_chkvect.f90 index 8e934bd9..5a1ddea3 100644 --- a/src/psblas/psb_chkvect.f90 +++ b/src/psblas/psb_chkvect.f90 @@ -34,6 +34,7 @@ subroutine psb_chkvect( m, n, lldx, ix, jx, desc_dec, info, iix, jjx) 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) diff --git a/src/psblas/psb_damax.f90 b/src/psblas/psb_damax.f90 index e20e5f97..4aa8f395 100644 --- a/src/psblas/psb_damax.f90 +++ b/src/psblas/psb_damax.f90 @@ -35,6 +35,7 @@ function psb_damax (x,desc_a, info, jx) character(len=20) :: name, ch_err name='psb_damax' + if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) @@ -137,6 +138,7 @@ function psb_damaxv (x,desc_a, info) character(len=20) :: name, ch_err name='psb_damaxv' + if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) @@ -236,6 +238,7 @@ subroutine psb_damaxvs (res,x,desc_a, info) character(len=20) :: name, ch_err name='psb_damaxvs' + if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) @@ -336,6 +339,7 @@ subroutine psb_dmamaxs (res,x,desc_a, info,jx) character(len=20) :: name, ch_err name='psb_dmamaxs' + if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) diff --git a/src/psblas/psb_dasum.f90 b/src/psblas/psb_dasum.f90 index a12b7c29..bde80b96 100644 --- a/src/psblas/psb_dasum.f90 +++ b/src/psblas/psb_dasum.f90 @@ -35,6 +35,7 @@ function psb_dasum (x,desc_a, info, jx) character(len=20) :: name, ch_err name='psb_dasum' + if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) @@ -155,6 +156,7 @@ function psb_dasumv (x,desc_a, info) character(len=20) :: name, ch_err name='psb_dasumv' + if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) @@ -271,6 +273,7 @@ subroutine psb_dasumvs (res,x,desc_a, info) character(len=20) :: name, ch_err name='psb_dasumvs' + if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) diff --git a/src/psblas/psb_daxpby.f90 b/src/psblas/psb_daxpby.f90 index 877ba852..47606000 100644 --- a/src/psblas/psb_daxpby.f90 +++ b/src/psblas/psb_daxpby.f90 @@ -40,6 +40,7 @@ subroutine psb_daxpby(alpha, x, beta,y,desc_a,info, n, jx, jy) character(len=20) :: name, ch_err name='psb_daxpby' + if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) @@ -165,6 +166,7 @@ subroutine psb_daxpbyv(alpha, x, beta,y,desc_a,info) character(len=20) :: name, ch_err name='psb_daxpby' + if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) diff --git a/src/psblas/psb_ddot.f90 b/src/psblas/psb_ddot.f90 index 08ea20f0..b98fce06 100644 --- a/src/psblas/psb_ddot.f90 +++ b/src/psblas/psb_ddot.f90 @@ -38,6 +38,7 @@ function psb_ddot(x, y,desc_a, info, jx, jy) character(len=20) :: name, ch_err name='psb_ddot' + if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) @@ -167,6 +168,7 @@ function psb_ddotv(x, y,desc_a, info) character(len=20) :: name, ch_err name='psb_ddot' + if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) @@ -280,6 +282,7 @@ subroutine psb_ddotvs(res, x, y,desc_a, info) character(len=20) :: name, ch_err name='psb_ddot' + if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) @@ -395,6 +398,7 @@ subroutine psb_dmdots(res, x, y, desc_a, info) character(len=20) :: name, ch_err name='psb_dmdots' + if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) diff --git a/src/psblas/psb_dnrm2.f90 b/src/psblas/psb_dnrm2.f90 index 59124126..5fb77bb9 100644 --- a/src/psblas/psb_dnrm2.f90 +++ b/src/psblas/psb_dnrm2.f90 @@ -34,6 +34,7 @@ function psb_dnrm2(x, desc_a, info, jx) character(len=20) :: name, ch_err name='psb_dnrm2' + if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) @@ -146,6 +147,7 @@ function psb_dnrm2v(x, desc_a, info) character(len=20) :: name, ch_err name='psb_dnrm2v' + if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) @@ -257,6 +259,7 @@ subroutine psb_dnrm2vs(res, x, desc_a, info) character(len=20) :: name, ch_err name='psb_dnrm2' + if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) diff --git a/src/psblas/psb_dnrmi.f90 b/src/psblas/psb_dnrmi.f90 index 4065ceb0..c091de3e 100644 --- a/src/psblas/psb_dnrmi.f90 +++ b/src/psblas/psb_dnrmi.f90 @@ -29,6 +29,7 @@ function psb_dnrmi(a,desc_a,info) character(len=20) :: name, ch_err name='psb_dnrmi' + if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) diff --git a/src/psblas/psb_dspmm.f90 b/src/psblas/psb_dspmm.f90 index 125b26dc..07890ff1 100644 --- a/src/psblas/psb_dspmm.f90 +++ b/src/psblas/psb_dspmm.f90 @@ -80,6 +80,7 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,& character(len=20) :: name, ch_err name='psb_dspmm' + if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) @@ -396,6 +397,7 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,& character(len=20) :: name, ch_err name='psb_dspmv' + if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) diff --git a/src/psblas/psb_dspsm.f90 b/src/psblas/psb_dspsm.f90 index 01823d0c..7adc8dd2 100644 --- a/src/psblas/psb_dspsm.f90 +++ b/src/psblas/psb_dspsm.f90 @@ -78,6 +78,7 @@ subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,& character(len=20) :: name, ch_err name='psb_dspsm' + if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) @@ -353,6 +354,7 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,& character(len=20) :: name, ch_err name='psb_dspsv' + if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) diff --git a/src/serial/psb_dtransp.f90 b/src/serial/psb_dtransp.f90 index fa3d01e6..1de48a9c 100644 --- a/src/serial/psb_dtransp.f90 +++ b/src/serial/psb_dtransp.f90 @@ -4,6 +4,7 @@ subroutine psb_dtransp(a,b,c,fmt) use psb_spmat_type + use psb_tools_mod use psb_serial_mod, only : psb_ipcoo2csr, psb_ipcsr2coo, psb_fixcoo implicit none diff --git a/src/tools/psb_dallc.f90 b/src/tools/psb_dallc.f90 index f65b9e98..d87313ff 100644 --- a/src/tools/psb_dallc.f90 +++ b/src/tools/psb_dallc.f90 @@ -35,6 +35,7 @@ subroutine psb_dalloc(m, n, x, desc_a, info, js) character(len=20) :: name, ch_err name='psb_dallc' + if(psb_get_errstatus().ne.0) return info=0 err=0 int_err(1)=0 @@ -193,6 +194,7 @@ subroutine psb_dallocv(m, x, desc_a,info) logical, parameter :: debug=.false. character(len=20) :: name, ch_err + if(psb_get_errstatus().ne.0) return info=0 name='psb_dallcv' call psb_erractionsave(err_act) diff --git a/src/tools/psb_dasb.f90 b/src/tools/psb_dasb.f90 index 6aa6c69a..389650cb 100644 --- a/src/tools/psb_dasb.f90 +++ b/src/tools/psb_dasb.f90 @@ -24,11 +24,11 @@ subroutine psb_dasb(x, desc_a, info) real(kind(1.d0)),pointer :: dtemp(:,:) integer :: int_err(5), i1sz, i2sz, dectype, i,j double precision :: real_err(5) - integer, parameter :: ione=1 real(kind(1.d0)),parameter :: one=1 logical, parameter :: debug=.false. character(len=20) :: name, ch_err + if(psb_get_errstatus().ne.0) return info=0 name='psb_dasb' call psb_erractionsave(err_act) @@ -140,7 +140,6 @@ subroutine psb_dasbv(x, desc_a, info) integer :: int_err(5), i1sz,nrow,ncol, dectype, i, err_act real(kind(1.d0)),pointer :: dtemp(:) double precision :: real_err(5) - integer, parameter :: ione=1 real(kind(1.d0)),parameter :: one=1 logical, parameter :: debug=.false. character(len=20) :: name,ch_err diff --git a/src/tools/psb_dcsrovr.f90 b/src/tools/psb_dcsrovr.f90 index 4260a9f9..74372c36 100644 --- a/src/tools/psb_dcsrovr.f90 +++ b/src/tools/psb_dcsrovr.f90 @@ -21,7 +21,7 @@ Subroutine psb_dcsrovr(a,desc_a,blk,info,rwcnv,clcnv,outfmt) use psb_descriptor_type Use psb_prec_type use psb_realloc_mod - use psb_tools_mod, only : psb_glob_to_loc, psb_loc_to_glob + use psb_tools_mod, only : psb_glob_to_loc, psb_loc_to_glob, psb_spfree use psb_error_mod Implicit None @@ -48,6 +48,7 @@ Subroutine psb_dcsrovr(a,desc_a,blk,info,rwcnv,clcnv,outfmt) real(kind(1.d0)) :: t1,t2,t3,t4,t5,t6,t7,t8,t9 character(len=20) :: name, ch_err + if(psb_get_errstatus().ne.0) return info=0 name='psb_dcsrovr' call psb_erractionsave(err_act) diff --git a/src/tools/psb_dcsrp.f90 b/src/tools/psb_dcsrp.f90 index 0a806b47..b6c66bb3 100644 --- a/src/tools/psb_dcsrp.f90 +++ b/src/tools/psb_dcsrp.f90 @@ -66,6 +66,7 @@ subroutine psb_dcsrp(trans,iperm,a, desc_a, info) n_row = desc_a%matrix_data(psb_n_row_) n_col = desc_a%matrix_data(psb_n_col_) + if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) name = 'psd_csrp' @@ -84,7 +85,7 @@ subroutine psb_dcsrp(trans,iperm,a, desc_a, info) endif - if (.not.is_asb_dec(dectype)) then + if (.not.psb_is_asb_dec(dectype)) then info = 600 int_err(1) = dectype call psb_errpush(info,name,int_err) diff --git a/src/tools/psb_descasb.f90 b/src/tools/psb_descasb.f90 index 348e5c30..f81cdaab 100644 --- a/src/tools/psb_descasb.f90 +++ b/src/tools/psb_descasb.f90 @@ -22,7 +22,7 @@ Subroutine psb_descasb(n_ovr,desc_p,desc_a,a,& use psb_serial_mod Use psi_mod use psb_realloc_mod - use psb_tools_mod, only : psb_descprt + use psb_tools_mod, only : psb_descprt, psb_spfree use psb_error_mod use psb_const_mod Implicit None @@ -57,6 +57,7 @@ Subroutine psb_descasb(n_ovr,desc_p,desc_a,a,& real(kind(1.d0)) :: t1,t2,t3,t4,t5,t6,t7, tl, tch character(len=20) :: name, ch_err + if(psb_get_errstatus().ne.0) return info=0 name='psb_descasb' call psb_erractionsave(err_act) @@ -622,7 +623,8 @@ Subroutine psb_descasb(n_ovr,desc_p,desc_a,a,& end if ! Ok, register into MATRIX_DATA & free temporary work areas - desc_a%matrix_data(psb_dec_type_) = psb_desc_asb_ + write(0,*)'!!! verify this !!!' + desc_p%matrix_data(psb_dec_type_) = psb_desc_asb_ allocate(desc_p%lprm(1)) desc_p%lprm(1) = 0 diff --git a/src/tools/psb_dfree.f90 b/src/tools/psb_dfree.f90 index 98bc88c2..31d30da7 100644 --- a/src/tools/psb_dfree.f90 +++ b/src/tools/psb_dfree.f90 @@ -22,10 +22,10 @@ subroutine psb_dfree(x, desc_a, info) !...locals.... integer :: int_err(5) integer :: icontxt,nprow,npcol,me,mypcol,err, err_act - integer,parameter :: ione=1 character(len=20) :: name + if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) name='psb_dfree' @@ -107,10 +107,10 @@ subroutine psb_dfreev(x, desc_a, info) !...locals.... integer :: int_err(5) integer :: icontxt,nprow,npcol,me,mypcol,err, err_act - integer,parameter :: ione=1 character(len=20) :: name + if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) name='psb_dfreev' diff --git a/src/tools/psb_dgelp.f90 b/src/tools/psb_dgelp.f90 index 82ea46cd..b8ad54be 100644 --- a/src/tools/psb_dgelp.f90 +++ b/src/tools/psb_dgelp.f90 @@ -28,7 +28,6 @@ subroutine psb_dgelp(trans,iperm,x,desc_a,info) real(kind(1.d0)),pointer :: dtemp(:) integer :: int_err(5), i1sz, i2sz, dectype, i, err_act character(len=20) :: itrans - integer, parameter :: ione=1 real(kind(1.d0)),parameter :: one=1 logical, parameter :: debug=.false. @@ -53,6 +52,7 @@ subroutine psb_dgelp(trans,iperm,x,desc_a,info) character(len=20) :: name, ch_err name = 'psb_dgelp' + if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) @@ -148,7 +148,6 @@ subroutine psb_dgelpv(trans,iperm,x,desc_a,info) real(kind(1.d0)),pointer :: dtemp(:) double precision :: real_err(5) character :: itrans - integer, parameter :: ione=1 real(kind(1.d0)),parameter :: one=1 logical, parameter :: debug=.false. @@ -173,6 +172,7 @@ subroutine psb_dgelpv(trans,iperm,x,desc_a,info) character(len=20) :: name, ch_err name = 'psb_dgelpv' + if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) diff --git a/src/tools/psb_dins.f90 b/src/tools/psb_dins.f90 index 083d2e26..e10a109d 100644 --- a/src/tools/psb_dins.f90 +++ b/src/tools/psb_dins.f90 @@ -40,6 +40,7 @@ subroutine psb_dins(m, n, x, ix, jx, blck, desc_a, info,& character :: temp_descra*11,temp_fida*5 character(len=20) :: name, char_err + if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) name = 'psb_dins' @@ -210,6 +211,7 @@ subroutine psb_dinsvm(m, x, ix, jx, blck, desc_a,info,& integer :: nprow,npcol, me ,mypcol, iblock character(len=20) :: name, char_err + if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) name = 'psb_dinsvm' @@ -365,6 +367,7 @@ subroutine psb_dinsvv(m, x, ix, blck, desc_a, info,& integer :: nprow,npcol, me ,mypcol character(len=20) :: name, char_err + if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) name = 'psb_dinsvv' diff --git a/src/tools/psb_dscall.f90 b/src/tools/psb_dscall.f90 index 6c6cdae5..6f9058ec 100644 --- a/src/tools/psb_dscall.f90 +++ b/src/tools/psb_dscall.f90 @@ -34,6 +34,7 @@ subroutine psb_dscall(m, n, parts, icontxt, desc_a, info) logical, parameter :: debug=.false. character(len=20) :: name, char_err + if(psb_get_errstatus().ne.0) return info=0 err=0 name = 'psb_dscall' diff --git a/src/tools/psb_dscalv.f90 b/src/tools/psb_dscalv.f90 index d394c8d4..c8dd15b3 100644 --- a/src/tools/psb_dscalv.f90 +++ b/src/tools/psb_dscalv.f90 @@ -33,6 +33,7 @@ subroutine psb_dscalv(m, v, icontxt, desc_a, info, flag) logical, parameter :: debug=.false. character(len=20) :: name, ch_err + if(psb_get_errstatus().ne.0) return info=0 err=0 name = 'psb_dscalv' diff --git a/src/tools/psb_dsccpy.f90 b/src/tools/psb_dsccpy.f90 index 9debb2e7..fda56546 100644 --- a/src/tools/psb_dsccpy.f90 +++ b/src/tools/psb_dsccpy.f90 @@ -27,10 +27,10 @@ subroutine psb_dsccpy(desc_out, desc_a, info) & icontxt, isz, dectype, err_act, err integer :: int_err(5),temp(1) real(kind(1.d0)) :: real_err(5) - integer, parameter :: ione=1, itwo=2,root=0 logical, parameter :: debug=.false. character(len=20) :: name, char_err + if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) name = 'psb_dsccpy' diff --git a/src/tools/psb_dscdec.f90 b/src/tools/psb_dscdec.f90 index 17ee7a46..a87bb9ff 100644 --- a/src/tools/psb_dscdec.f90 +++ b/src/tools/psb_dscdec.f90 @@ -95,12 +95,12 @@ subroutine psb_dscdec(nloc, icontxt, desc_a, info) & l_ov_ix,l_ov_el,idx, flag_, err_act,m, ip Integer :: INT_ERR(5),TEMP(1),EXCH(2) Real(Kind(1.d0)) :: REAL_ERR(5) - Integer, Parameter :: IONE=1, ITWO=2,ROOT=0 Integer, Pointer :: temp_ovrlap(:), ov_idx(:), ov_el(:) integer, allocatable :: nlv(:) logical, parameter :: debug=.false. character(len=20) :: name, ch_err + if(psb_get_errstatus().ne.0) return info=0 err=0 name = 'psb_dscdec' diff --git a/src/tools/psb_dscfree.f90 b/src/tools/psb_dscfree.f90 index ce695675..d2e8617d 100644 --- a/src/tools/psb_dscfree.f90 +++ b/src/tools/psb_dscfree.f90 @@ -20,9 +20,9 @@ subroutine psb_dscfree(desc_a,info) integer :: temp(1) real(kind(1.d0)) :: real_err(5) integer :: icontxt,nprow,npcol,me,mypcol, err_act - integer,parameter :: ione=1 character(len=20) :: name, char_err + if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) name = 'psb_dscfree' diff --git a/src/tools/psb_dscren.f90 b/src/tools/psb_dscren.f90 index a9f7e7ca..d654da40 100644 --- a/src/tools/psb_dscren.f90 +++ b/src/tools/psb_dscren.f90 @@ -36,6 +36,7 @@ subroutine psb_dscren(trans,iperm,desc_a,info) logical, parameter :: debug=.false. character(len=20) :: name, char_err + if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) name = 'psb_dcren' diff --git a/src/tools/psb_dscrep.f90 b/src/tools/psb_dscrep.f90 index e83b8608..c226ccbe 100644 --- a/src/tools/psb_dscrep.f90 +++ b/src/tools/psb_dscrep.f90 @@ -99,6 +99,7 @@ subroutine psb_dscrep(m, icontxt, desc_a, info) logical, parameter :: debug=.false. character(len=20) :: name, ch_err + if(psb_get_errstatus().ne.0) return info=0 err=0 name = 'psb_dscrep' diff --git a/src/tools/psb_dspalloc.f90 b/src/tools/psb_dspalloc.f90 index 5e2d226a..7f68afde 100644 --- a/src/tools/psb_dspalloc.f90 +++ b/src/tools/psb_dspalloc.f90 @@ -30,10 +30,10 @@ subroutine psb_dspalloc(a, desc_a, info, nnz) & length_ia1,length_ia2,err,nprocs, err_act,m,n integer :: int_err(5),temp(1) real(kind(1.d0)) :: real_err(5) - integer, parameter :: ione=1, itwo=2,root=0 logical, parameter :: debug=.false. character(len=20) :: name, ch_err + if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) name = 'psb_dspalloc' diff --git a/src/tools/psb_dspasb.f90 b/src/tools/psb_dspasb.f90 index 974c3baa..9ed05594 100644 --- a/src/tools/psb_dspasb.f90 +++ b/src/tools/psb_dspasb.f90 @@ -31,6 +31,21 @@ subroutine psb_dspasb(a,desc_a, info, afmt, up, dup) end subroutine psb_cest end interface + interface psb_spfree + subroutine psb_dspfree(a, desc_a,info) + use psb_descriptor_type + use psb_spmat_type + type(psb_desc_type), intent(in) :: desc_a + type(psb_dspmat_type), intent(inout) ::a + integer, intent(out) :: info + end subroutine psb_dspfree + subroutine psb_dspfrees(a,info) + use psb_spmat_type + type(psb_dspmat_type), intent(inout) ::a + integer, intent(out) :: info + end subroutine psb_dspfrees + end interface + !...Parameters.... type(psb_dspmat_type), intent (inout) :: a type(psb_desc_type), intent(in) :: desc_a diff --git a/src/tools/psb_dspcnv.f90 b/src/tools/psb_dspcnv.f90 index 751609f1..4660a82d 100644 --- a/src/tools/psb_dspcnv.f90 +++ b/src/tools/psb_dspcnv.f90 @@ -77,13 +77,13 @@ subroutine psb_dspcnv(a,b,desc_a,info) integer :: lwork_dcsdp,dectype integer :: icontxt,temp(1),n_row character :: check*1, trans*1, unitd*1 - integer, parameter :: ione=1 real(kind(1.d0)) :: time(10), mpi_wtime external mpi_wtime logical, parameter :: debug=.false. character(len=20) :: name, ch_err + if(psb_get_errstatus().ne.0) return info=0 name = 'psb_dspcnv' call psb_erractionsave(err_act) diff --git a/src/tools/psb_dspfree.f90 b/src/tools/psb_dspfree.f90 index f4ea3490..08a83bd2 100644 --- a/src/tools/psb_dspfree.f90 +++ b/src/tools/psb_dspfree.f90 @@ -26,9 +26,9 @@ subroutine psb_dspfree(a, desc_a,info) integer :: temp(1) real(kind(1.d0)) :: real_err(5) integer :: icontxt,nprow,npcol,me,mypcol,err, err_act - integer,parameter :: ione=1 character(len=20) :: name, ch_err + if(psb_get_errstatus().ne.0) return info=0 name = 'psb_dspfree' call psb_erractionsave(err_act) @@ -95,78 +95,78 @@ end subroutine psb_dspfree -!!$subroutine psb_dspfrees(a, info) -!!$ !...free sparse matrix structure... -!!$ use psb_descriptor_type -!!$ use psb_spmat_type -!!$ use psb_serial_mod -!!$ use psb_const_mod -!!$ use psb_error_mod -!!$ implicit none -!!$ -!!$ !....parameters... -!!$ type(psb_dspmat_type), intent(inout) ::a -!!$ integer, intent(out) :: info -!!$ !...locals.... -!!$ integer :: int_err(5) -!!$ integer :: temp(1) -!!$ real(kind(1.d0)) :: real_err(5) -!!$ integer :: icontxt,nprow,npcol,me,mypcol,err, err_act -!!$ integer,parameter :: ione=1 -!!$ character(len=20) :: name, ch_err -!!$ -!!$ info=0 -!!$ name = 'psb_dspfrees' -!!$ call psb_erractionsave(err_act) -!!$ -!!$ !...deallocate a.... -!!$ -!!$ if ((info.eq.0).and.(.not.associated(a%pr))) info=2951 -!!$ if (info.eq.0) then -!!$ !deallocate pr field -!!$ deallocate(a%pr,stat=info) -!!$ if (info.ne.0) info=2045 -!!$ end if -!!$ if ((info.eq.0).and.(.not.associated(a%pl))) info=2952 -!!$ !deallocate pl field -!!$ if (info.eq.0) then -!!$ deallocate(a%pl,stat=info) -!!$ if (info.ne.0) info=2046 -!!$ end if -!!$ if ((info.eq.0).and.(.not.associated(a%ia2))) info=2953 -!!$ if (info.eq.0) then -!!$ !deallocate ia2 field -!!$ deallocate(a%ia2,stat=info) -!!$ if (info.ne.0) info=2047 -!!$ end if -!!$ if ((info.eq.0).and.(.not.associated(a%ia1))) info=2954 -!!$ if (info.eq.0) then -!!$ !deallocate ia1 field -!!$ deallocate(a%ia1,stat=info) -!!$ if (info.ne.0) info=2048 -!!$ endif -!!$ if ((info.eq.0).and.(.not.associated(a%aspk))) info=2955 -!!$ if (info.eq.0) then -!!$ !deallocate aspk field -!!$ deallocate(a%aspk,stat=info) -!!$ if (info.ne.0) info=2049 -!!$ endif -!!$ if (info.eq.0) call psb_nullify_sp(a) -!!$ -!!$ if(info.ne.0) then -!!$ call psb_errpush(info,name) -!!$ 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_dspfrees +subroutine psb_dspfrees(a, info) + !...free sparse matrix structure... + use psb_descriptor_type + use psb_spmat_type + use psb_serial_mod + use psb_const_mod + use psb_error_mod + implicit none + + !....parameters... + type(psb_dspmat_type), intent(inout) ::a + integer, intent(out) :: info + !...locals.... + integer :: int_err(5) + integer :: temp(1) + real(kind(1.d0)) :: real_err(5) + integer :: icontxt,nprow,npcol,me,mypcol,err, err_act + character(len=20) :: name, ch_err + + if(psb_get_errstatus().ne.0) return + info=0 + name = 'psb_dspfrees' + call psb_erractionsave(err_act) + + !...deallocate a.... + + if ((info.eq.0).and.(.not.associated(a%pr))) info=2951 + if (info.eq.0) then + !deallocate pr field + deallocate(a%pr,stat=info) + if (info.ne.0) info=2045 + end if + if ((info.eq.0).and.(.not.associated(a%pl))) info=2952 + !deallocate pl field + if (info.eq.0) then + deallocate(a%pl,stat=info) + if (info.ne.0) info=2046 + end if + if ((info.eq.0).and.(.not.associated(a%ia2))) info=2953 + if (info.eq.0) then + !deallocate ia2 field + deallocate(a%ia2,stat=info) + if (info.ne.0) info=2047 + end if + if ((info.eq.0).and.(.not.associated(a%ia1))) info=2954 + if (info.eq.0) then + !deallocate ia1 field + deallocate(a%ia1,stat=info) + if (info.ne.0) info=2048 + endif + if ((info.eq.0).and.(.not.associated(a%aspk))) info=2955 + if (info.eq.0) then + !deallocate aspk field + deallocate(a%aspk,stat=info) + if (info.ne.0) info=2049 + endif + if (info.eq.0) call psb_nullify_sp(a) + + if(info.ne.0) then + call psb_errpush(info,name) + 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_dspfrees diff --git a/src/tools/psb_dspupdate.f90 b/src/tools/psb_dspupdate.f90 index ad7502d1..03760e22 100644 --- a/src/tools/psb_dspupdate.f90 +++ b/src/tools/psb_dspupdate.f90 @@ -61,6 +61,7 @@ subroutine psb_dspupdate(a, ia, ja, blck, desc_a,info,ix,jx,updflag) integer,pointer :: iworkaux(:) character(len=20) :: name, ch_err + if(psb_get_errstatus().ne.0) return info=0 name='psb_dspupdate' call psb_erractionsave(err_act) diff --git a/src/tools/psb_glob_to_loc.f90 b/src/tools/psb_glob_to_loc.f90 index a570ad7c..2da8cbf6 100644 --- a/src/tools/psb_glob_to_loc.f90 +++ b/src/tools/psb_glob_to_loc.f90 @@ -31,6 +31,7 @@ subroutine psb_glob_to_loc2(x,y,desc_a,info,iact) integer, parameter :: zero=0 character(len=20) :: name, char_err + if(psb_get_errstatus().ne.0) return info=0 name = 'glob_to_loc' call psb_erractionsave(err_act) @@ -133,6 +134,7 @@ subroutine psb_glob_to_loc(x,desc_a,info,iact) integer, parameter :: zero=0 character(len=20) :: name, char_err + if(psb_get_errstatus().ne.0) return info=0 name = 'glob_to_loc' call psb_erractionsave(err_act) diff --git a/src/tools/psb_ialloc.f90 b/src/tools/psb_ialloc.f90 index 71643bc8..d32cd583 100644 --- a/src/tools/psb_ialloc.f90 +++ b/src/tools/psb_ialloc.f90 @@ -32,6 +32,7 @@ subroutine psb_ialloc(m, n, x, desc_a, info,js) real(kind(1.d0)) :: real_err(5) character(len=20) :: name, char_err + if(psb_get_errstatus().ne.0) return info=0 name='psb_ialloc' call psb_erractionsave(err_act) @@ -180,6 +181,7 @@ subroutine psb_iallocv(m, x, desc_a, info) logical, parameter :: debug=.false. character(len=20) :: name, char_err + if(psb_get_errstatus().ne.0) return info=0 name='psb_iallocv' call psb_erractionsave(err_act) diff --git a/src/tools/psb_iasb.f90 b/src/tools/psb_iasb.f90 index 07553c13..769f501a 100644 --- a/src/tools/psb_iasb.f90 +++ b/src/tools/psb_iasb.f90 @@ -24,11 +24,10 @@ subroutine psb_iasb(x, desc_a, info) integer, pointer :: itemp(:,:) integer :: int_err(5), i1sz, i2sz, dectype, i real(kind(1.d0)) :: real_err(5) - integer, parameter :: ione=1 - real(kind(1.d0)),parameter :: one=1 logical, parameter :: debug=.false. character(len=20) :: name, char_err + if(psb_get_errstatus().ne.0) return info=0 name='psb_iasb' call psb_erractionsave(err_act) @@ -76,7 +75,7 @@ subroutine psb_iasb(x, desc_a, info) endif ! ..update halo elements.. - call psb_halo(x,desc_a,info,alpha=one) + call psb_halo(x,desc_a,info,alpha=done) call psb_erractionrestore(err_act) return @@ -117,11 +116,10 @@ subroutine psb_iasbv(x, desc_a, info) integer :: int_err(5), i1sz,nrow,ncol, dectype, i integer, pointer :: itemp(:) real(kind(1.d0)) :: real_err(5) - integer, parameter :: ione=1 - real(kind(1.d0)),parameter :: one=1 logical, parameter :: debug=.false. character(len=20) :: name, ch_err + if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) name = 'psb_iasbv' @@ -162,7 +160,7 @@ subroutine psb_iasbv(x, desc_a, info) endif ! ..update halo elements.. - call psb_halo(x,desc_a,info,alpha=one) + call psb_halo(x,desc_a,info,alpha=done) call psb_erractionrestore(err_act) return diff --git a/src/tools/psb_ifree.f90 b/src/tools/psb_ifree.f90 index e5973635..92816cf8 100644 --- a/src/tools/psb_ifree.f90 +++ b/src/tools/psb_ifree.f90 @@ -24,9 +24,9 @@ subroutine psb_ifree(x, desc_a, info) integer :: temp(1) real(kind(1.d0)) :: real_err(5) integer :: icontxt,nprow,npcol,me,mypcol,err_act - integer,parameter :: ione=1 character(len=20) :: name, ch_err + if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) name = 'psb_ifree' @@ -104,9 +104,9 @@ subroutine psb_ifreev(x, desc_a,info) integer :: temp(1) real(kind(1.d0)) :: real_err(5) integer :: icontxt,nprow,npcol,me,mypcol,err_act - integer,parameter :: ione=1 character(len=20) :: name, ch_err + if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) name = 'psb_ifreev' diff --git a/src/tools/psb_iins.f90 b/src/tools/psb_iins.f90 index af0ee201..58f7f98e 100644 --- a/src/tools/psb_iins.f90 +++ b/src/tools/psb_iins.f90 @@ -38,6 +38,7 @@ subroutine psb_iins(m, n, x, ix, jx, blck, desc_a, info,& integer :: nprow,npcol, myrow ,mycol, int_err(5),err_act character(len=20) :: name, ch_err + if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) name = 'psb_iins' @@ -209,6 +210,7 @@ subroutine psb_iinsvm(m, x, ix, jx, blck, desc_a, info,& integer :: nprow,npcol, myrow ,mycol character(len=20) :: name, ch_err + if(psb_get_errstatus().ne.0) return info=0 name = 'psb_iinsvm' call psb_erractionsave(err_act) @@ -294,6 +296,7 @@ subroutine psb_iinsvv(m, x, ix, blck, desc_a, info,& integer :: nprow,npcol, myrow ,mycol character(len=20) :: name, ch_err + if(psb_get_errstatus().ne.0) return info=0 name = 'psb_iinsvv' call psb_erractionsave(err_act) diff --git a/src/tools/psb_loc_to_glob.f90 b/src/tools/psb_loc_to_glob.f90 index b3f8878d..8302cbe7 100644 --- a/src/tools/psb_loc_to_glob.f90 +++ b/src/tools/psb_loc_to_glob.f90 @@ -32,6 +32,7 @@ subroutine psb_loc_to_glob2(x,y,desc_a,info,iact) integer, parameter :: zero=0 character(len=20) :: name, char_err + if(psb_get_errstatus().ne.0) return info=0 name='psb_loc_to_glob2' call psb_erractionsave(err_act) @@ -124,6 +125,7 @@ subroutine psb_loc_to_glob(x,desc_a,info,iact) integer, parameter :: zero=0 character(len=20) :: name, char_err + if(psb_get_errstatus().ne.0) return info=0 name='psb_loc_to_glob' call psb_erractionsave(err_act) diff --git a/test/Fileread/RUNS/rtst.inp b/test/Fileread/RUNS/rtst.inp index 023616a4..83952dc5 100644 --- a/test/Fileread/RUNS/rtst.inp +++ b/test/Fileread/RUNS/rtst.inp @@ -1,13 +1,13 @@ 11 Number of inputs -bcsstk35.mtx This (and others) from: http://math.nist.gov/MatrixMarket/ +kivap001.mtx This (and others) from: http://math.nist.gov/MatrixMarket/ NONE -CGS +BICGSTAB ILU !!!! Actually, it's IPREC below. Should take this line out. CSR -2 IPART: Partition method +1 IPART: Partition method 1 ISTOPC 00800 ITMAX 6 ITRACE -7 IPREC 0:NONE 1:DIAGSC 2:ILU 3: AS 4: RAS 5,6: variants +4 IPREC 0:NONE 1:DIAGSC 2:ILU 3: AS 4: RAS 5,6: variants 1 ML -1.d-6 EPS +1.d-7 EPS diff --git a/test/Fileread/df_sample.f90 b/test/Fileread/df_sample.f90 index 4be5269b..88b90540 100644 --- a/test/Fileread/df_sample.f90 +++ b/test/Fileread/df_sample.f90 @@ -81,6 +81,7 @@ program df_sample amroot = (myprow==0).and.(mypcol==0) name='df_sample' + if(psb_get_errstatus().ne.0) return info=0 call psb_set_errverbosity(2) call psb_set_erraction(0) @@ -194,7 +195,7 @@ program df_sample write(*,'("Time to read and partition matrix : ",es10.4)')t2 write(*,'(" ")') end if - + ! ! prepare the preconditioning matrix. note the availability ! of optional parameters @@ -272,8 +273,8 @@ program df_sample call dgamx2d(ictxt,'a',' ',ione, ione,t2,ione,t1,t1,-1,-1,-1) call psb_axpby(1.d0,b_col,0.d0,r_col,desc_a,info) call psb_spmm(-1.d0,a,x_col,1.d0,r_col,desc_a,info) - call psb_nrm2(resmx,r_col,desc_a,info) - call psb_amax(resmxp,r_col,desc_a,info) + call psb_nrm2s(resmx,r_col,desc_a,info) + call psb_amaxs(resmxp,r_col,desc_a,info) !!$ iter=iparm(5) !!$ err = rparm(2) @@ -281,7 +282,7 @@ program df_sample ! call psb_prec_descr(6,pre) write(*,'("Matrix: ",a)')mtrx_file write(*,'("Computed solution on ",i4," processors")')nprow - write(*,'("Iterations to convergence: ",i)')iter + write(*,'("Iterations to convergence: ",i6)')iter write(*,'("Error indicator on exit: ",f7.2)')err write(*,'("Time to buil prec. : ",es10.4)')tprec write(*,'("Time to solve matrix : ",es10.4)')t2 diff --git a/test/Fileread/getp.f90 b/test/Fileread/getp.f90 index 1f7451a1..533e0672 100644 --- a/test/Fileread/getp.f90 +++ b/test/Fileread/getp.f90 @@ -98,12 +98,12 @@ CONTAINS CALL IGEBS2D(ICONTXT,'ALL',' ',6,1,INPARMS,6) CALL DGEBS2D(ICONTXT,'ALL',' ',1,1,EPS,1) - write(*,'("Solving matrix : ",a)')mtrx_file - write(*,'("Number of processors : ",i)')nprow + write(*,'("Solving matrix : ",a20)')mtrx_file + write(*,'("Number of processors : ",i3)')nprow write(*,'("Data distribution : ",i2)')ipart - write(*,'("Preconditioner : ",i)')iprec - if(iprec.gt.2) write(*,'("Overlapping levels : ",i)')novr - write(*,'("Iterative method : ",a)')cmethd + write(*,'("Preconditioner : ",i2)')iprec + if(iprec.gt.2) write(*,'("Overlapping levels : ",i2)')novr + write(*,'("Iterative method : ",a20)')cmethd write(*,'("Storage format : ",a3)')afmt(1:3) write(*,'(" ")') else