From fd706691fc83c7ab1c7923b4a7d15b3808958158 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Wed, 6 Jun 2007 13:59:46 +0000 Subject: [PATCH] Fixed error checks on X,B --- krylov/psb_dbicg.f90 | 14 ++++++++++++++ krylov/psb_dcg.f90 | 13 +++++++++++++ krylov/psb_dcgs.f90 | 13 +++++++++++++ krylov/psb_dcgstab.F90 | 21 +++++++++++++++++---- krylov/psb_dcgstabl.f90 | 13 +++++++++++++ krylov/psb_dgmresr.f90 | 13 +++++++++++++ krylov/psb_zcgs.f90 | 13 +++++++++++++ krylov/psb_zcgstab.f90 | 13 +++++++++++++ 8 files changed, 109 insertions(+), 4 deletions(-) diff --git a/krylov/psb_dbicg.f90 b/krylov/psb_dbicg.f90 index 8537a8d4..bfa58a29 100644 --- a/krylov/psb_dbicg.f90 +++ b/krylov/psb_dbicg.f90 @@ -149,6 +149,20 @@ subroutine psb_dbicg(a,prec,b,x,eps,desc_a,info,& goto 9999 endif + call psb_chkvect(mglob,1,size(x,1),1,1,desc_a,info) + if(info /= 0) then + info=4010 + call psb_errpush(info,name,a_err='psb_chkvect on X') + goto 9999 + end if + call psb_chkvect(mglob,1,size(b,1),1,1,desc_a,info) + if(info /= 0) then + info=4010 + call psb_errpush(info,name,a_err='psb_chkvect on B') + goto 9999 + end if + + naux=4*n_col allocate(aux(naux),stat=info) diff --git a/krylov/psb_dcg.f90 b/krylov/psb_dcg.f90 index cab66870..dfa6623f 100644 --- a/krylov/psb_dcg.f90 +++ b/krylov/psb_dcg.f90 @@ -140,6 +140,19 @@ Subroutine psb_dcg(a,prec,b,x,eps,desc_a,info,& goto 9999 endif + call psb_chkvect(mglob,1,size(x,1),1,1,desc_a,info) + if(info /= 0) then + info=4010 + call psb_errpush(info,name,a_err='psb_chkvect on X') + goto 9999 + end if + call psb_chkvect(mglob,1,size(b,1),1,1,desc_a,info) + if(info /= 0) then + info=4010 + call psb_errpush(info,name,a_err='psb_chkvect on B') + goto 9999 + end if + naux=4*n_col allocate(aux(naux), stat=info) if (info == 0) call psb_geall(wwrk,desc_a,info,n=5) diff --git a/krylov/psb_dcgs.f90 b/krylov/psb_dcgs.f90 index 41710237..2899f77c 100644 --- a/krylov/psb_dcgs.f90 +++ b/krylov/psb_dcgs.f90 @@ -142,6 +142,19 @@ Subroutine psb_dcgs(a,prec,b,x,eps,desc_a,info,& goto 9999 endif + call psb_chkvect(mglob,1,size(x,1),1,1,desc_a,info) + if(info /= 0) then + info=4010 + call psb_errpush(info,name,a_err='psb_chkvect on X') + goto 9999 + end if + call psb_chkvect(mglob,1,size(b,1),1,1,desc_a,info) + if(info /= 0) then + info=4010 + call psb_errpush(info,name,a_err='psb_chkvect on B') + goto 9999 + end if + naux=4*n_col Allocate(aux(naux),stat=info) if (info == 0) Call psb_geall(wwrk,desc_a,info,n=11) diff --git a/krylov/psb_dcgstab.F90 b/krylov/psb_dcgstab.F90 index 181e7748..aa90c89e 100644 --- a/krylov/psb_dcgstab.F90 +++ b/krylov/psb_dcgstab.F90 @@ -160,6 +160,19 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,& goto 9999 endif + call psb_chkvect(mglob,1,size(x,1),1,1,desc_a,info) + if(info /= 0) then + info=4010 + call psb_errpush(info,name,a_err='psb_chkvect on X') + goto 9999 + end if + call psb_chkvect(mglob,1,size(b,1),1,1,desc_a,info) + if(info /= 0) then + info=4010 + call psb_errpush(info,name,a_err='psb_chkvect on B') + goto 9999 + end if + naux=6*n_col allocate(aux(naux),stat=info) if (info == 0) call psb_geall(wwrk,desc_a,info,n=8) @@ -326,12 +339,12 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,& If (debug) Write(0,*) 'Bi-CGSTAB SIGMA:',sigma alpha = rho/sigma Call psb_geaxpby(done,r,dzero,s,desc_a,info) - if(info.ne.0) then + if(info /= 0) then call psb_errpush(4010,name,a_err='psb_geaxpby') goto 9999 end if Call psb_geaxpby(-alpha,v,done,s,desc_a,info) - if(info.ne.0) then + if(info /= 0) then call psb_errpush(4010,name,a_err='psb_geaxpby') goto 9999 end if @@ -343,7 +356,7 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,& #ifdef MPE_KRYLOV imerr = MPE_Log_event( ifcte, 0, "ed PREC" ) #endif - if(info.ne.0) then + if(info /= 0) then call psb_errpush(4010,name,a_err='psb_precaply') goto 9999 end if @@ -357,7 +370,7 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,& imerr = MPE_Log_event( imme, 0, "ed SPMM" ) #endif - if(info.ne.0) then + if(info /= 0) then call psb_errpush(4010,name,a_err='psb_spmm') goto 9999 end if diff --git a/krylov/psb_dcgstabl.f90 b/krylov/psb_dcgstabl.f90 index da23b166..5a9a9749 100644 --- a/krylov/psb_dcgstabl.f90 +++ b/krylov/psb_dcgstabl.f90 @@ -173,6 +173,19 @@ Subroutine psb_dcgstabl(a,prec,b,x,eps,desc_a,info,& goto 9999 endif + call psb_chkvect(mglob,1,size(x,1),1,1,desc_a,info) + if(info /= 0) then + info=4010 + call psb_errpush(info,name,a_err='psb_chkvect on X') + goto 9999 + end if + call psb_chkvect(mglob,1,size(b,1),1,1,desc_a,info) + if(info /= 0) then + info=4010 + call psb_errpush(info,name,a_err='psb_chkvect on B') + goto 9999 + end if + naux=4*n_col Allocate(aux(naux),gamma(0:nl),gamma1(nl),& &gamma2(nl),taum(nl,nl),sigma(nl), stat=info) diff --git a/krylov/psb_dgmresr.f90 b/krylov/psb_dgmresr.f90 index eebfaf3b..c43d1ee4 100644 --- a/krylov/psb_dgmresr.f90 +++ b/krylov/psb_dgmresr.f90 @@ -178,6 +178,19 @@ Subroutine psb_dgmresr(a,prec,b,x,eps,desc_a,info,& goto 9999 endif + call psb_chkvect(mglob,1,size(x,1),1,1,desc_a,info) + if(info /= 0) then + info=4010 + call psb_errpush(info,name,a_err='psb_chkvect on X') + goto 9999 + end if + call psb_chkvect(mglob,1,size(b,1),1,1,desc_a,info) + if(info /= 0) then + info=4010 + call psb_errpush(info,name,a_err='psb_chkvect on B') + goto 9999 + end if + naux=4*n_col Allocate(aux(naux),h(nl+1,nl+1),& diff --git a/krylov/psb_zcgs.f90 b/krylov/psb_zcgs.f90 index af00a41d..a0cfbfa2 100644 --- a/krylov/psb_zcgs.f90 +++ b/krylov/psb_zcgs.f90 @@ -145,6 +145,19 @@ Subroutine psb_zcgs(a,prec,b,x,eps,desc_a,info,& goto 9999 endif + call psb_chkvect(mglob,1,size(x,1),1,1,desc_a,info) + if(info /= 0) then + info=4010 + call psb_errpush(info,name,a_err='psb_chkvect on X') + goto 9999 + end if + call psb_chkvect(mglob,1,size(b,1),1,1,desc_a,info) + if(info /= 0) then + info=4010 + call psb_errpush(info,name,a_err='psb_chkvect on B') + goto 9999 + end if + naux=4*n_col Allocate(aux(naux),stat=info) if (info == 0) Call psb_geall(wwrk,desc_a,info,n=11) diff --git a/krylov/psb_zcgstab.f90 b/krylov/psb_zcgstab.f90 index 66c9cfc2..07ae123d 100644 --- a/krylov/psb_zcgstab.f90 +++ b/krylov/psb_zcgstab.f90 @@ -140,6 +140,19 @@ Subroutine psb_zcgstab(a,prec,b,x,eps,desc_a,info,& goto 9999 endif + call psb_chkvect(mglob,1,size(x,1),1,1,desc_a,info) + if(info /= 0) then + info=4010 + call psb_errpush(info,name,a_err='psb_chkvect on X') + goto 9999 + end if + call psb_chkvect(mglob,1,size(b,1),1,1,desc_a,info) + if(info /= 0) then + info=4010 + call psb_errpush(info,name,a_err='psb_chkvect on B') + goto 9999 + end if + naux=6*n_col allocate(aux(naux),stat=info) if (info==0) call psb_geall(wwrk,desc_a,info,n=8)