You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
66 lines
2.3 KiB
66 lines
2.3 KiB
C Copyright(C) 1999-2020 National Technology & Engineering Solutions
|
|
C of Sandia, LLC (NTESS). Under the terms of Contract DE-NA0003525 with
|
|
C NTESS, the U.S. Government retains certain rights in this software.
|
|
C
|
|
C See packages/seacas/LICENSE for details
|
|
C=======================================================================
|
|
subroutine chkerr (routine, caller, ierr)
|
|
C=======================================================================
|
|
C Modified 9/13/95 for EXODUSIIV2 API calls
|
|
|
|
C This subroutine should be called after an EXODUSIIV2 subroutine has
|
|
C been invoked. The arguments of this subroutine are as follows:
|
|
C routine - IN - The exodusIIv2 subroutine
|
|
C caller - IN - The subroutine invoking the exodusII call
|
|
C ierr - IN - The error code returned from the exodusII call
|
|
|
|
include 'exodusII.inc'
|
|
|
|
character*6 routine
|
|
CHARACTER*8 caller
|
|
character*(512) string, path, msg
|
|
integer ierr
|
|
|
|
C No error occurred
|
|
if (ierr .eq. EXOK) RETURN
|
|
|
|
write (path, '(A,A2,A)') CALLER(:LENSTR(CALLER)), '->',
|
|
& ROUTINE(:LENSTR(ROUTINE))
|
|
lp = lenstr(path)
|
|
|
|
if (ierr .eq. EXWARN) then
|
|
write (string, '(A,A)')'ExodusII V2 WARNING in ', path(:lp)
|
|
call prterr('WARNING', string)
|
|
RETURN
|
|
else if (ierr .lt. EXOK) then
|
|
write (string, '(A)')'ExodusII V2 ERROR'
|
|
call prterr('ERROR', string)
|
|
end if
|
|
|
|
if (ierr .eq. EXFATL) then
|
|
write (msg, '(A,A)')
|
|
& 'A Fatal error occurred in ', path(:lp)
|
|
else if (ierr .eq. EXMEMF) then
|
|
write (msg, '(A,A)')
|
|
& 'Memory allocation failure flag in ', path(:lp)
|
|
else if (ierr .eq. EXBFMD) then
|
|
write (msg, '(A,A)')
|
|
& 'Bad file mode in ', path(:lp)
|
|
else if (ierr .eq. EXBFID) then
|
|
write (msg, '(A,A)')
|
|
& 'BAD file ID in ', path(:lp)
|
|
else if (ierr .eq. EXBTID) then
|
|
write (msg, '(A,A)')
|
|
& 'Property table lookup failed in ', path(:lp)
|
|
else if (ierr .eq. EXBPRM) then
|
|
write (msg, '(A,A)')
|
|
& 'Bad parameter passed in ', path(:lp)
|
|
else
|
|
write (msg, '(A,A,A,I4)')
|
|
& 'Unknown Error in ', path(:lp), ': IERR = ',ierr
|
|
end if
|
|
|
|
call prterr ('ERROR', msg)
|
|
|
|
return
|
|
end
|
|
|