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

Fixed error handling on ALLOCATE.

Browse Source
This commit is contained in:
Salvatore Filippone
2007-05-28 09:11:40 +00:00
parent 88f0e7ef53
commit 801d3498a0
2 changed files with 8 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/modules/psb_error_mod.F90
+1 -1
View File
@@ -465,7 +465,7 @@ contains
case(4013)
write (0,'("Error from call to subroutine ",a," ",i0)')a_e_d,i_e_d(1)
case(4025)
write (0,'("Error on allocation request for ",i0," items of type ")')i_e_d(1),a_e_d
write (0,'("Error on allocation request for ",i0," items of type ",a)')i_e_d(1),a_e_d
case(4110)
write (0,'("Error ",i0," from call to an external package in subroutine ",a)')i_e_d(1),a_e_d
case (5001)
base/modules/psb_realloc_mod.F90
+7 -1
View File
@@ -658,6 +658,7 @@ Contains
return
9999 continue
info = err
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_ret_) then
@@ -733,6 +734,7 @@ Contains
return
9999 continue
info = err
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_ret_) then
@@ -806,6 +808,7 @@ Contains
return
9999 continue
info = err
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_ret_) then
@@ -852,7 +855,7 @@ Contains
ub2_ = lb2_ + len2 -1
if (len1 < 0) then
err=4025
err=4025
call psb_errpush(err,name,i_err=(/len1,0,0,0,0/),a_err='real(kind(1.d0))')
goto 9999
end if
@@ -898,6 +901,7 @@ Contains
return
9999 continue
info = err
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_ret_) then
@@ -991,6 +995,7 @@ Contains
return
9999 continue
info = err
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_ret_) then
@@ -1081,6 +1086,7 @@ Contains
return
9999 continue
info = err
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_ret_) then