function mperr(varargin)
global mpcom_4; if isempty(mpcom_4), mpcom_4=0; end;
global mpcom_3; if isempty(mpcom_3), mpcom_3=0; end;
global mpcom_5; if isempty(mpcom_5), mpcom_5=0; end;
%***BEGIN PROLOGUE MPERR
%***SUBSIDIARY
%***PURPOSE Subsidiary to DQDOTA and DQDOTI
%***LIBRARY SLATEC
%***TYPE ALL (MPERR-A)
%***AUTHOR (UNKNOWN)
%***DESCRIPTION
%
% This routine is called when a fatal error condition is
% encountered, and after a message has been written on
% logical unit LUN.
%
%***SEE ALSO DQDOTA, DQDOTI, MPBLAS
%***ROUTINES CALLED (NONE)
%***COMMON BLOCKS MPCOM
%***REVISION HISTORY (YYMMDD)
% 791001 DATE WRITTEN
% ?????? Modified for use with BLAS. Blank COMMON changed to named
% COMMON. R given dimension 12.
% 891214 Prologue converted to Version 4.0 format. (BAB)
% 900402 Added TYPE section. (WRB)
% 930124 Increased Array size in MPCON for SUN -r8. (RWC)
%***end PROLOGUE MPERR
% common :: ;
global mpcom_1; if isempty(mpcom_1), mpcom_1=0; end;
global mpcom_2; if isempty(mpcom_2), mpcom_2=0; end;
global mpcom_6; if isempty(mpcom_6), mpcom_6=zeros(1,30); end;
%% common /mpcom / b , t , m , lun , mxr , r(30);
%% common /mpcom / mpcom_1 , mpcom_2 , mpcom_3 , mpcom_4 , mpcom_5 , mpcom_6(30);
%***FIRST EXECUTABLE STATEMENT MPERR
xermsg('SLATEC','MPERR',[' *** EXECUTION TERMINATED BY CALL TO MPERR',' IN MP VERSION 770217 ***'],1,2);
%
% AT PRESENT JUST STOP, BUT COULD DUMP B, T, ETC. HERE.
% ACTION COULD EASILY BE CONTROLLED BY A FLAG IN LABELLED COMMON.
% ANSI VERSION USES STOP, UNIVAC 1108 VERSION USES
% RETURN 0 IN ORDER TO GIVE A TRACE-BACK.
% FOR DEBUGGING PURPOSES IT MAY BE USEFUL SIMPLY TO
% RETURN HERE. MOST MP ROUTINES RETURN WITH RESULT
% ZERO AFTER CALLING MPERR.
error(['stop encountered in original fortran code ',char(10),';']);
end
%DECK MPMAXR
