mirror of
https://git.planet-casio.com/Lephenixnoir/OpenLibm.git
synced 2025-01-01 06:23:39 +01:00
41 lines
1.4 KiB
Fortran
41 lines
1.4 KiB
Fortran
*DECK MPERR
|
|
SUBROUTINE MPERR
|
|
C***BEGIN PROLOGUE MPERR
|
|
C***SUBSIDIARY
|
|
C***PURPOSE Subsidiary to DQDOTA and DQDOTI
|
|
C***LIBRARY SLATEC
|
|
C***TYPE ALL (MPERR-A)
|
|
C***AUTHOR (UNKNOWN)
|
|
C***DESCRIPTION
|
|
C
|
|
C This routine is called when a fatal error condition is
|
|
C encountered, and after a message has been written on
|
|
C logical unit LUN.
|
|
C
|
|
C***SEE ALSO DQDOTA, DQDOTI, MPBLAS
|
|
C***ROUTINES CALLED (NONE)
|
|
C***COMMON BLOCKS MPCOM
|
|
C***REVISION HISTORY (YYMMDD)
|
|
C 791001 DATE WRITTEN
|
|
C ?????? Modified for use with BLAS. Blank COMMON changed to named
|
|
C COMMON. R given dimension 12.
|
|
C 891214 Prologue converted to Version 4.0 format. (BAB)
|
|
C 900402 Added TYPE section. (WRB)
|
|
C 930124 Increased Array size in MPCON for SUN -r8. (RWC)
|
|
C***END PROLOGUE MPERR
|
|
COMMON /MPCOM/ B, T, M, LUN, MXR, R(30)
|
|
INTEGER B, T, R
|
|
C***FIRST EXECUTABLE STATEMENT MPERR
|
|
CALL XERMSG('SLATEC', 'MPERR',
|
|
1 ' *** EXECUTION TERMINATED BY CALL TO MPERR' //
|
|
2 ' IN MP VERSION 770217 ***', 1, 2)
|
|
C
|
|
C AT PRESENT JUST STOP, BUT COULD DUMP B, T, ETC. HERE.
|
|
C ACTION COULD EASILY BE CONTROLLED BY A FLAG IN LABELLED COMMON.
|
|
C ANSI VERSION USES STOP, UNIVAC 1108 VERSION USES
|
|
C RETURN 0 IN ORDER TO GIVE A TRACE-BACK.
|
|
C FOR DEBUGGING PURPOSES IT MAY BE USEFUL SIMPLY TO
|
|
C RETURN HERE. MOST MP ROUTINES RETURN WITH RESULT
|
|
C ZERO AFTER CALLING MPERR.
|
|
STOP
|
|
END
|