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

Fixed error checks on X,B

Browse Source
This commit is contained in:
Salvatore Filippone
2007-06-06 13:59:46 +00:00
parent 82b797932e
commit fd706691fc
8 changed files with 109 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files
krylov/psb_dbicg.f90
+14
View File
@@ -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)
krylov/psb_dcg.f90
+13
View File
@@ -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)
krylov/psb_dcgs.f90
+13
View File
@@ -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)
krylov/psb_dcgstab.F90
+17 -4
View File
@@ -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
krylov/psb_dcgstabl.f90
+13
View File
@@ -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)
krylov/psb_dgmresr.f90
+13
View File
@@ -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),&
krylov/psb_zcgs.f90
+13
View File
@@ -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)
krylov/psb_zcgstab.f90
+13
View File
@@ -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)