From 801d3498a0a704e8a92fc5880bfe0cc77b1237f6 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Mon, 28 May 2007 09:11:40 +0000 Subject: [PATCH] Fixed error handling on ALLOCATE. --- base/modules/psb_error_mod.F90 | 2 +- base/modules/psb_realloc_mod.F90 | 8 +++++++- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/base/modules/psb_error_mod.F90 b/base/modules/psb_error_mod.F90 index 58e00ca5..142e0a61 100644 --- a/base/modules/psb_error_mod.F90 +++ b/base/modules/psb_error_mod.F90 @@ -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) diff --git a/base/modules/psb_realloc_mod.F90 b/base/modules/psb_realloc_mod.F90 index 1ee570cc..a7f4039b 100644 --- a/base/modules/psb_realloc_mod.F90 +++ b/base/modules/psb_realloc_mod.F90 @@ -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