fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-19 12:22:10 +00:00
Code Issues Packages Projects Releases Wiki Activity

Added checks on allocation.

Browse Source
This commit is contained in:
Salvatore Filippone
2006-04-24 15:25:22 +00:00
parent 54005b4b78
commit 60f02d3b49
7 changed files with 26 additions and 43 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/methd/psb_dbicg.f90
+2 -2
View File
@@ -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'
src/methd/psb_dcg.f90
+2 -2
View File
@@ -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)
src/methd/psb_dcgs.f90
+2 -3
View File
@@ -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)
src/methd/psb_dcgstabl.f90
+6 -6
View File
@@ -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)
src/methd/psb_dgmresr.f90
+4 -10
View File
@@ -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)
src/methd/psb_zcgs.f90
+2 -3
View File
@@ -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)
src/methd/psb_zcgstab.f90
+8 -17
View File
@@ -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)