[librar,subrou,messg,kflag,nerr,level,icount]=xersve(librar,subrou,messg,kflag,nerr,level,icount);

function [librar,subrou,messg,kflag,nerr,level,icount]=xersve(librar,subrou,messg,kflag,nerr,level,icount);
persistent firstCall i iunit kount kountx kunit lentab levtab lib libtab lun mes mestab nertab nmsg nunit sub subtab ; if isempty(libtab),libtab={};end; if isempty(mestab),mestab={};end; if isempty(subtab),subtab={};end; if isempty(firstCall),firstCall=1;end; 

if isempty(i), i=0; end;
if isempty(iunit), iunit=0; end;
if isempty(kount), kount=zeros(1,lentab); end;
if isempty(kountx), kountx=0; end;
if isempty(kunit), kunit=0; end;
if isempty(levtab), levtab=zeros(1,lentab); end;
if isempty(nertab), nertab=zeros(1,lentab); end;
if isempty(nmsg), nmsg=0; end;
if isempty(nunit), nunit=0; end;
%***BEGIN PROLOGUE  XERSVE
%***SUBSIDIARY
%***PURPOSE  Record that an error has occurred.
%***LIBRARY   SLATEC (XERROR)
%***CATEGORY  R3
%***TYPE      ALL (XERSVE-A)
%***KEYWORDS  ERROR, XERROR
%***AUTHOR  Jones, R. E., (SNLA)
%***DESCRIPTION
%
% *Usage:
%
%        INTEGER  KFLAG, NERR, LEVEL, ICOUNT
%        CHARACTER * (len) LIBRAR, SUBROU, MESSG
%
%        CALL XERSVE (LIBRAR, SUBROU, MESSG, KFLAG, NERR, LEVEL, ICOUNT)
%
% *Arguments:
%
%        LIBRAR :IN    is the library that the message is from.
%        SUBROU :IN    is the subroutine that the message is from.
%        MESSG  :IN    is the message to be saved.
%        KFLAG  :IN    indicates the action to be performed.
%                      when KFLAG > 0, the message in MESSG is saved.
%                      when KFLAG=0 the tables will be dumped and
%                      cleared.
%                      when KFLAG < 0, the tables will be dumped and
%                      not cleared.
%        NERR   :IN    is the error number.
%        LEVEL  :IN    is the error severity.
%        ICOUNT :OUT   the number of times this message has been seen,
%                      or zero if the table has overflowed and does not
%                      contain this message specifically.  When KFLAG=0,
%                      ICOUNT will not be altered.
%
% *Description:
%
%   Record that this error occurred and possibly dump and clear the
%   tables.
%
%***REFERENCES  R. E. Jones and D. K. Kahaner, XERROR, the SLATEC
%                 Error-handling Package, SAND82-0800, Sandia
%                 Laboratories, 1982.
%***ROUTINES CALLED  I1MACH, XGETUA
%***REVISION HISTORY  (YYMMDD)
%   800319  DATE WRITTEN
%   861211  REVISION DATE from Version 3.2
%   891214  Prologue converted to Version 4.0 format.  (BAB)
%   900413  Routine modified to remove reference to KFLAG.  (WRB)
%   900510  Changed to add LIBRARY NAME and SUBROUTINE to calling
%           sequence, use IF-THEN-ELSE, make number of saved entries
%           easily changeable, changed routine name from XERSAV to
%           XERSVE.  (RWC)
%   910626  Added LIBTAB and SUBTAB to SAVE statement.  (BKS)
%   920501  Reformatted the REFERENCES section.  (WRB)
%***end PROLOGUE  XERSVE
if isempty(lentab), lentab=10 ; end;
if isempty(lun), lun=zeros(1,5); end;
if isempty(libtab), libtab=cell(1,lentab); end;
if isempty(subtab), subtab=cell(1,lentab); end;
if isempty(lib), lib=repmat(' ',1,8); end;
if isempty(sub), sub=repmat(' ',1,8); end;
if isempty(mestab), mestab=cell(1,lentab); end;
if isempty(mes), mes=repmat(' ',1,20); end;
if firstCall,   kountx=[0];  end;
if firstCall,  nmsg=[0];  end;
firstCall=0;
%***FIRST EXECUTABLE STATEMENT  XERSVE
%
if( kflag<=0 )
%
%        Dump the table.
%
if( nmsg==0 )
return;
end;
%
%        Print to each unit.
%
[lun,nunit]=xgetua(lun,nunit);
for kunit = 1 : nunit;
iunit = fix(lun(kunit));
if( iunit==0 )
[ iunit ]=i1mach(4);
end;
%
%           Print the table header.
%
writef(iunit,['0          ERROR MESSAGE SUMMARY', '\n ' ,' LIBRARY    SUBROUTINE MESSAGE START             NERR','     LEVEL     COUNT' ' \n']);
%
%     Formats.
%
%format ('0          ERROR MESSAGE SUMMARY'/' LIBRARY    SUBROUTINE MESSAGE START             NERR','     LEVEL     COUNT');
%
%           Print body of table.
%
for i = 1 : nmsg;
writef(iunit,[repmat(' ',1,1),'%s',repmat(' ',1,3),'%s',repmat(' ',1,3),'%s',repmat('%10i',1,3) ' \n'], libtab{i} , subtab{i} , mestab{i} ,nertab(i) , levtab(i) , kount(i));
%format(1x,a,3x,a,3x,a,3i10);
end; i = fix(nmsg+1);
%
%           Print number of other errors.
%
if( kountx~=0 )
writef(iunit,['0OTHER ERRORS NOT INDIVIDUALLY TABULATED = ','%10i' ' \n'], kountx);
end;
%format ('0OTHER ERRORS NOT INDIVIDUALLY TABULATED = ',i10);
writef(iunit,[repmat(' ',1,1) ' \n']);
%format(1x);
end; kunit = fix(nunit+1);
%
%        Clear the error tables.
%
if( kflag==0 )
nmsg = 0;
kountx = 0;
end;
else;
%
%        PROCESS A MESSAGE...
%        SEARCH FOR THIS MESSG, OR ELSE AN EMPTY SLOT FOR THIS MESSG,
%        OR ELSE DETERMINE THAT THE ERROR TABLE IS FULL.
%
lib = librar;
sub = subrou;
mes = messg;
for i = 1 : nmsg;
if( strcmp(deblank(lib),deblank(libtab{i})) && strcmp(deblank(sub),deblank(subtab{i})) && strcmp(deblank(mes),deblank(mestab{i}))&& nerr==nertab(i) && level==levtab(i) )
kount(i) = fix(kount(i) + 1);
icount = fix(kount(i));
return;
end;
end; i = fix(nmsg+1);
%
if( nmsg<lentab )
%
%           Empty slot found for new message.
%
nmsg = fix(nmsg + 1);
libtab{i} = lib;
subtab{i} = sub;
mestab{i} = mes;
nertab(i) = fix(nerr);
levtab(i) = fix(level);
kount(i) = 1;
icount = 1;
else;
%
%           Table is full.
%
kountx = fix(kountx + 1);
icount = 0;
end;
end;
return;
end
%DECK XGETF