| [lenmlv,scomp,strue,ssize,sfac,kprint]=stest(lenmlv,scomp,strue,ssize,sfac,kprint); |
function [lenmlv,scomp,strue,ssize,sfac,kprint]=stest(lenmlv,scomp,strue,ssize,sfac,kprint);
persistent firstCall i releps sd ; if isempty(firstCall),firstCall=1;end;
if isempty(i), i=0; end;
global combla_2; if isempty(combla_2), combla_2=0; end;
global combla_4; if isempty(combla_4), combla_4=0; end;
global combla_5; if isempty(combla_5), combla_5=0; end;
global combla_6; if isempty(combla_6), combla_6=0; end;
global combla_3; if isempty(combla_3), combla_3=0; end;
global combla_1; if isempty(combla_1), combla_1=0; end;
scomp_shape=size(scomp);scomp=reshape(scomp,1,[]);
strue_shape=size(strue);strue=reshape(strue,1,[]);
ssize_shape=size(ssize);ssize=reshape(ssize,1,[]);
if isempty(sd), sd=0; end;
if isempty(releps), releps=0; end;
global combla_7; if isempty(combla_7), combla_7=false; end;
% common :: ;
%% common /combla/ nprint , icase , n , incx , incy , mode , pass;
%% common /combla/ combla_1 , combla_2 , combla_3 , combla_4 , combla_5 , combla_6 , combla_7;
if firstCall, releps=[0.0e0]; end;
firstCall=0;
if( releps==0.0e0 )
[ releps ]=r1mach(4);
end;
for i = 1 : lenmlv;
sd = abs(scomp(i)-strue(i));
if( sfac.*sd>abs(ssize(i)).*releps )
if( combla_7 )
combla_7 = false;
if( kprint>=3 )
writef(combla_1,['+',repmat(' ',1,39),'FAIL' ' \n']);
%format ('+',39X,'FAIL');
writef(combla_1,['0CASE N INCX INCY MODE I',repmat(' ',1,29),'COMP(I)',repmat(' ',1,29),'truemlv(I)',repmat(' ',1,2),'DIFFERENCE',repmat(' ',1,5),'SIZE(I)', '\n ' ,repmat(' ',1,1) ' \n']);
%format ('0CASE N INCX INCY MODE I',29X,'COMP(I)',29X,'truemlv(I)',2X,'DIFFERENCE',5X,'SIZE(I)'/1X);
end;
end;
if( kprint>=3 )
writef(combla_1,[repmat(' ',1,1),'%4i','%3i',repmat('%5i',1,3),'%3i',repmat('%36.8f',1,2),repmat('%12.4f',1,2) ' \n'], combla_2 , combla_3 , combla_4 , combla_5 ,combla_6 , i , scomp(i) , strue(i) , sd ,ssize(i));
end;
%format(1x,i4,i3,3i5,i3,2e36.8,2e12.4);
end;
end; i = fix(lenmlv+1);
scomp_shape=zeros(scomp_shape);scomp_shape(:)=scomp(1:numel(scomp_shape));scomp=scomp_shape;
strue_shape=zeros(strue_shape);strue_shape(:)=strue(1:numel(strue_shape));strue=strue_shape;
ssize_shape=zeros(ssize_shape);ssize_shape(:)=ssize(1:numel(ssize_shape));ssize=ssize_shape;
return;
end %subroutine stest
|
|