mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-19 04:12:09 +00:00
Fix handling of errors inside UMFPACK.
This commit is contained in:
@@ -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)
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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:
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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;
|
||||
}
|
||||
|
||||
|
||||
@@ -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:
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user