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.
69 lines
1.8 KiB
69 lines
1.8 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=======================================================================
|
|
LOGICAL FUNCTION OKABRT (ISOK)
|
|
C=======================================================================
|
|
|
|
C --*** OKABRT *** (ETCLIB) Initialize cancel function
|
|
C -- Written by Amy Gilkey - revised 12/21/87
|
|
C --
|
|
C --OKABRT initializes the cancel flag. It must be called before ISABRT.
|
|
|
|
C --Routines Called:
|
|
C -- CPUIFC - (PLTLIB) Check interrupt flag
|
|
|
|
LOGICAL ISABRT
|
|
LOGICAL ISOK
|
|
|
|
LOGICAL CPUIFC, LDUM
|
|
|
|
LOGICAL DOABRT
|
|
SAVE DOABRT
|
|
|
|
DATA DOABRT / .FALSE. /
|
|
|
|
C --Initialize enable cancel flag
|
|
DOABRT = ISOK
|
|
|
|
IF (DOABRT) THEN
|
|
C --Initialize cancel flag
|
|
LDUM = CPUIFC (.TRUE.)
|
|
END IF
|
|
|
|
OKABRT = DOABRT
|
|
|
|
RETURN
|
|
|
|
C=======================================================================
|
|
ENTRY ISABRT ()
|
|
C=======================================================================
|
|
|
|
C --*** ISABRT *** (ETCLIB) Check cancel function
|
|
C -- Written by Amy Gilkey - revised 12/17/87
|
|
C --
|
|
C --ISABRT checks the cancel flag. If it is set, it aborts the current
|
|
C --processing. In any case, the value of the cancel flag is returned
|
|
C --as the function value.
|
|
|
|
C --Routines Called:
|
|
C -- CPUIFC - (PLTLIB) Check interrupt flag
|
|
|
|
IF (DOABRT) THEN
|
|
C --Return cancel flag
|
|
ISABRT = CPUIFC (.FALSE.)
|
|
|
|
IF (ISABRT) THEN
|
|
C --Send abort message
|
|
WRITE (*, '(1X, A)') '*** Processing aborted ***'
|
|
END IF
|
|
|
|
ELSE
|
|
ISABRT = .FALSE.
|
|
END IF
|
|
|
|
RETURN
|
|
END
|
|
|