From 60f02d3b4936b2933e62e00cd4a5e7d8d5deac22 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Mon, 24 Apr 2006 15:25:22 +0000 Subject: [PATCH] Added checks on allocation. --- src/methd/psb_dbicg.f90 | 4 ++-- src/methd/psb_dcg.f90 | 4 ++-- src/methd/psb_dcgs.f90 | 5 ++--- src/methd/psb_dcgstabl.f90 | 12 ++++++------ src/methd/psb_dgmresr.f90 | 14 ++++---------- src/methd/psb_zcgs.f90 | 5 ++--- src/methd/psb_zcgstab.f90 | 25 ++++++++----------------- 7 files changed, 26 insertions(+), 43 deletions(-) diff --git a/src/methd/psb_dbicg.f90 b/src/methd/psb_dbicg.f90 index fbfc03f6..54a24bfb 100644 --- a/src/methd/psb_dbicg.f90 +++ b/src/methd/psb_dbicg.f90 @@ -159,8 +159,8 @@ subroutine psb_dbicg(a,prec,b,x,eps,desc_a,info,& naux=4*n_col allocate(aux(naux),stat=info) - call psb_geall(wwrk,desc_a,info,n=9) - call psb_geasb(wwrk,desc_a,info) + if (info == 0) call psb_geall(wwrk,desc_a,info,n=9) + if (info == 0) call psb_geasb(wwrk,desc_a,info) if(info.ne.0) then info=4011 ch_err='psb_asb' diff --git a/src/methd/psb_dcg.f90 b/src/methd/psb_dcg.f90 index 39f45b47..6533bdf3 100644 --- a/src/methd/psb_dcg.f90 +++ b/src/methd/psb_dcg.f90 @@ -148,8 +148,8 @@ Subroutine psb_dcg(a,prec,b,x,eps,desc_a,info,& naux=4*n_col allocate(aux(naux), stat=info) - call psb_geall(wwrk,desc_a,info,n=5) - call psb_geasb(wwrk,desc_a,info) + if (info == 0) call psb_geall(wwrk,desc_a,info,n=5) + if (info == 0) call psb_geasb(wwrk,desc_a,info) if (info.ne.0) then info=4011 call psb_errpush(info,name) diff --git a/src/methd/psb_dcgs.f90 b/src/methd/psb_dcgs.f90 index c8c07a1d..9b4375b2 100644 --- a/src/methd/psb_dcgs.f90 +++ b/src/methd/psb_dcgs.f90 @@ -152,9 +152,8 @@ Subroutine psb_dcgs(a,prec,b,x,eps,desc_a,info,& naux=4*n_col Allocate(aux(naux),stat=info) - - Call psb_geall(wwrk,desc_a,info,n=11) - Call psb_geasb(wwrk,desc_a,info) + if (info == 0) Call psb_geall(wwrk,desc_a,info,n=11) + if (info == 0) Call psb_geasb(wwrk,desc_a,info) if (info.ne.0) Then info=4011 call psb_errpush(info,name) diff --git a/src/methd/psb_dcgstabl.f90 b/src/methd/psb_dcgstabl.f90 index e8a65264..e20bbb65 100644 --- a/src/methd/psb_dcgstabl.f90 +++ b/src/methd/psb_dcgstabl.f90 @@ -183,12 +183,12 @@ Subroutine psb_dcgstabl(a,prec,b,x,eps,desc_a,info,& call psb_errpush(info,name) goto 9999 End If - Call psb_geall(wwrk,desc_a,info,n=10) - Call psb_geall(uh,desc_a,info,n=nl+1) - Call psb_geall(rh,desc_a,info,n=nl+1) - Call psb_geasb(wwrk,desc_a,info) - Call psb_geasb(uh,desc_a,info) - Call psb_geasb(rh,desc_a,info) + if (info == 0) Call psb_geall(wwrk,desc_a,info,n=10) + if (info == 0) Call psb_geall(uh,desc_a,info,n=nl+1) + if (info == 0) Call psb_geall(rh,desc_a,info,n=nl+1) + if (info == 0) Call psb_geasb(wwrk,desc_a,info) + if (info == 0) Call psb_geasb(uh,desc_a,info) + if (info == 0) Call psb_geasb(rh,desc_a,info) if (info.ne.0) Then info=4011 call psb_errpush(info,name) diff --git a/src/methd/psb_dgmresr.f90 b/src/methd/psb_dgmresr.f90 index a0e87f47..e895508b 100644 --- a/src/methd/psb_dgmresr.f90 +++ b/src/methd/psb_dgmresr.f90 @@ -182,16 +182,10 @@ Subroutine psb_dgmresr(a,prec,b,x,eps,desc_a,info,& Allocate(aux(naux),h(nl+1,nl+1),rr(nl+1,nl+1),& &c(nl+1),s(nl+1),rs(nl+1), stat=info) - If (info.Ne.0) Then - info = 4000 - call psb_errpush(info,name) - goto 9999 - End If - - Call psb_geall(v,desc_a,info,n=nl+1) - Call psb_geall(w,desc_a,info) - Call psb_geasb(v,desc_a,info) - Call psb_geasb(w,desc_a,info) + if (info == 0) Call psb_geall(v,desc_a,info,n=nl+1) + if (info == 0) Call psb_geall(w,desc_a,info) + if (info == 0) Call psb_geasb(v,desc_a,info) + if (info == 0) Call psb_geasb(w,desc_a,info) if (info.ne.0) Then info=4011 call psb_errpush(info,name) diff --git a/src/methd/psb_zcgs.f90 b/src/methd/psb_zcgs.f90 index ea6fffaa..fc3a1a24 100644 --- a/src/methd/psb_zcgs.f90 +++ b/src/methd/psb_zcgs.f90 @@ -152,9 +152,8 @@ Subroutine psb_zcgs(a,prec,b,x,eps,desc_a,info,& naux=4*n_col Allocate(aux(naux),stat=info) - - Call psb_geall(wwrk,desc_a,info,n=11) - Call psb_geasb(wwrk,desc_a,info) + if (info == 0) Call psb_geall(wwrk,desc_a,info,n=11) + if (info == 0) Call psb_geasb(wwrk,desc_a,info) if (info.ne.0) Then info=4011 call psb_errpush(info,name) diff --git a/src/methd/psb_zcgstab.f90 b/src/methd/psb_zcgstab.f90 index f7d04cb5..9adf9546 100644 --- a/src/methd/psb_zcgstab.f90 +++ b/src/methd/psb_zcgstab.f90 @@ -134,18 +134,9 @@ Subroutine psb_zcgstab(a,prec,b,x,eps,desc_a,info,& istop_ = 1 Endif ! -! ISTOP_ = 1: Normwise backward error, infinity norm -! ISTOP_ = 2: ||r||/||b|| norm 2 +! ISTOP = 1: Normwise backward error, infinity norm +! ISTOP = 2: ||r||/||b|| norm 2 ! -!!$ -!!$ If ((prec%prec < min_prec_).Or.(prec%prec > max_prec_) ) Then -!!$ Write(0,*) 'PSB_CGSTAB: Invalid IPREC',prec%prec -!!$ info=5002 -!!$ int_err(1)=prec%prec -!!$ err=info -!!$ call psb_errpush(info,name,i_err=int_err) -!!$ goto 9999 -!!$ Endif if ((istop_ < 1 ).or.(istop_ > 2 ) ) then write(0,*) 'psb_bicgstab: invalid istop',istop_ @@ -158,8 +149,8 @@ Subroutine psb_zcgstab(a,prec,b,x,eps,desc_a,info,& naux=6*n_col allocate(aux(naux),stat=info) - call psb_geall(wwrk,desc_a,info,n=8) - call psb_geasb(wwrk,desc_a,info) + if (info==0) call psb_geall(wwrk,desc_a,info,n=8) + if (info==0) call psb_geasb(wwrk,desc_a,info) if (info /= 0) then info=4011 call psb_errpush(info,name) @@ -225,10 +216,10 @@ Subroutine psb_zcgstab(a,prec,b,x,eps,desc_a,info,& rho = zzero If (debug) Write(*,*) 'On entry to AMAX: B: ',Size(b) -! -! Must always provide norm of R into RNI below for first check on -! residual -! + ! + ! Must always provide norm of R into RNI below for first check on + ! residual + ! If (istop_ == 1) Then rni = psb_geamax(r,desc_a,info) xni = psb_geamax(x,desc_a,info)