Added checks on allocation.

psblas3-type-indexed
Salvatore Filippone 20 years ago
parent 54005b4b78
commit 60f02d3b49

@ -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'

@ -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)

@ -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)

@ -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)

@ -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)

@ -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)

@ -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)

Loading…
Cancel
Save