From f1a502ee8dace5df74d2ed0651863fdb95319694 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Mon, 8 May 2006 09:54:45 +0000 Subject: [PATCH] Fix handling of errors inside UMFPACK. --- src/modules/psb_error_mod.f90 | 2 ++ src/prec/psb_dbaseprc_bld.f90 | 2 +- src/prec/psb_dmlprc_bld.f90 | 7 +++++++ src/prec/psb_dumf_bld.f90 | 8 +++++--- src/prec/psb_umf_impl.c | 4 ++++ src/prec/psb_zmlprc_bld.f90 | 7 +++++++ src/prec/psb_zumf_impl.c | 11 ++++++++--- 7 files changed, 34 insertions(+), 7 deletions(-) diff --git a/src/modules/psb_error_mod.f90 b/src/modules/psb_error_mod.f90 index 35612755..2f76627a 100644 --- a/src/modules/psb_error_mod.f90 +++ b/src/modules/psb_error_mod.f90 @@ -439,6 +439,8 @@ contains write (0,'("Error from call to a subroutine ")') case(4012) write (0,'("Error ",i0," from call to a subroutine ")')i_e_d(1) + case(4110) + write (0,'("Error ",i0," from call to an external package in subroutine ",a)')i_e_d(1),a_e_d case (5001) write (0,'("Invalid ISTOP: ",i0)')i_e_d(1) case (5002) diff --git a/src/prec/psb_dbaseprc_bld.f90 b/src/prec/psb_dbaseprc_bld.f90 index 4bec8ed6..427477c1 100644 --- a/src/prec/psb_dbaseprc_bld.f90 +++ b/src/prec/psb_dbaseprc_bld.f90 @@ -225,7 +225,7 @@ subroutine psb_dbaseprc_bld(a,desc_a,p,info,upd) if(debug) write(0,*)me,': calling umf_bld' call psb_umf_bld(a,desc_a,p,info) if(debug) write(0,*)me,': Done umf_bld ',info - if(info /= 0) then + if (info /= 0) then info=4010 ch_err='umf_bld' call psb_errpush(info,name,a_err=ch_err) diff --git a/src/prec/psb_dmlprc_bld.f90 b/src/prec/psb_dmlprc_bld.f90 index 894b569b..7c651ebe 100644 --- a/src/prec/psb_dmlprc_bld.f90 +++ b/src/prec/psb_dmlprc_bld.f90 @@ -168,6 +168,13 @@ subroutine psb_dmlprc_bld(a,desc_a,p,info) call psb_baseprc_bld(ac,desc_p,p,info) if (debug) write(0,*) 'Out from basaeprcbld',info + if(info /= 0) then + info=4010 + ch_err='psb_baseprc_bld' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + ! ! We have used a separate ac because: diff --git a/src/prec/psb_dumf_bld.f90 b/src/prec/psb_dumf_bld.f90 index 6db184ee..882e8ff3 100644 --- a/src/prec/psb_dumf_bld.f90 +++ b/src/prec/psb_dumf_bld.f90 @@ -52,6 +52,7 @@ subroutine psb_dumf_bld(a,desc_a,p,info) character(len=5) :: fmt character :: upd='F' integer :: i,j,nza,nzb,nzt,icontxt, me,mycol,nprow,npcol,err_act + integer :: i_err(5) logical, parameter :: debug=.false. character(len=20) :: name, ch_err @@ -183,10 +184,11 @@ subroutine psb_dumf_bld(a,desc_a,p,info) call psb_dumf_factor(atmp%m,nzt,& & atmp%aspk,atmp%ia1,atmp%ia2,& & p%iprcparm(umf_symptr_),p%iprcparm(umf_numptr_),info) - if(info /= 0) then - info=4010 + if (info /= 0) then + i_err(1) = info + info=4110 ch_err='psb_umf_fact' - call psb_errpush(info,name,a_err=ch_err) + call psb_errpush(info,name,a_err=ch_err,i_err=i_err) goto 9999 end if diff --git a/src/prec/psb_umf_impl.c b/src/prec/psb_umf_impl.c index ef862d7e..14eb00cd 100644 --- a/src/prec/psb_umf_impl.c +++ b/src/prec/psb_umf_impl.c @@ -132,6 +132,9 @@ psb_dumf_factor_(int *n, int *nnz, *info = 0; } else { printf("umfpack_di_symbolic() error returns INFO= %d\n", *info); + *info = -11; + *numptr = (fptr) NULL; + return; } *symptr = (fptr) Symbolic; @@ -145,6 +148,7 @@ psb_dumf_factor_(int *n, int *nnz, *numptr = (fptr) Numeric; } else { printf("umfpack_di_numeric() error returns INFO= %d\n", *info); + *info = -12; *numptr = (fptr) NULL; } diff --git a/src/prec/psb_zmlprc_bld.f90 b/src/prec/psb_zmlprc_bld.f90 index 412c4d26..4672ee0b 100644 --- a/src/prec/psb_zmlprc_bld.f90 +++ b/src/prec/psb_zmlprc_bld.f90 @@ -168,6 +168,13 @@ subroutine psb_zmlprc_bld(a,desc_a,p,info) call psb_baseprc_bld(ac,desc_p,p,info) if (debug) write(0,*) 'Out from basaeprcbld',info + if(info /= 0) then + info=4010 + ch_err='psb_baseprc_bld' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + ! ! We have used a separate ac because: diff --git a/src/prec/psb_zumf_impl.c b/src/prec/psb_zumf_impl.c index b001b5b0..618056bb 100644 --- a/src/prec/psb_zumf_impl.c +++ b/src/prec/psb_zumf_impl.c @@ -131,7 +131,10 @@ psb_zumf_factor_(int *n, int *nnz, if ( *info == UMFPACK_OK ) { *info = 0; } else { - printf("umfpack_di_symbolic() error returns INFO= %d\n", *info); + printf("umfpack_zi_symbolic() error returns INFO= %d\n", *info); + *info = -11; + *numptr = (fptr) NULL; + return; } *symptr = (fptr) Symbolic; @@ -142,11 +145,13 @@ psb_zumf_factor_(int *n, int *nnz, if ( *info == UMFPACK_OK ) { *info = 0; + *numptr = (fptr) Numeric; } else { - printf("umfpack_di_numeric() error returns INFO= %d\n", *info); + printf("umfpack_zi_numeric() error returns INFO= %d\n", *info); + *info = -12; + *numptr = (fptr) NULL; } - *numptr = (fptr) Numeric; for (i = 0; i <= *n; ++i) ++colptr[i]; for (i = 0; i < *nnz; ++i) ++rowind[i]; #else