readln( FF );
readln( FF, hThick, nPoints, nLayers, nFreqs, nStab, epsU, aG, nApprox );
readln( FF );
for i:=1 to nFreqs do read( FF, freqs[i] );
readln( FF );
readln( FF );
readln( FF );
for i:=1 to nPoints do readln( FF, si[i], siMin[i], siMax[i] );
readln( FF );
readln( FF );
readln( FF , incVal, parMaxH, parMaxX, parEps, derivType, eqlB );
readln( FF );
readln( FF );
for i:=1 to maxSPC do readln( FF, par0[i] , parMin[i] , parMax[i] );
readln( FF );
if ( eqlB=0 )then
begin
for i:=1 to nLayers+1 do read( FF, zLayer[i] );
parEqlB:=false;
end
else parEqlB:=true;
close( FF );
for i:=1 to maxPAR do mu[i]:=1;
end;
Var
str : string;
Begin
if( ParamCount = 1 )then str:=ParamStr(1)
else
begin
write('Enter I/O file name, please: ');
readln( str );
end;
inFileName :=str+'.txt';
outFileName:=str+'.lst';
End.
П1.6 Модуль работы с файлами EFile
Unit EFile;
Interface
Uses
DOS, EData;
function isStable( ns : integer; var RG1,RG2 ) : boolean;
function saveResults( ns,iter : integer ) : boolean;
procedure saveExpResults;
procedure saveHypTgResults;
procedure clock;
procedure saveTime;
Implementation
Var
FF : text;
i : byte;
function decimalDegree( n:integer ) : real;{10^n}
var
s:real; i:byte;
begin
s:=1;
for i:=1 to n do s:=s*10;
decimalDegree:=s;
end;
function isStable( ns:integer ; var RG1,RG2 ) : boolean;
var
m : real;
R1 : Parameters absolute RG1;
R2 : Parameters absolute RG2;
begin
isStable:=TRUE;
m:=decimalDegree( ns-1 );
for i:=1 to mCur do
begin
if NOT(( ABS( R2[i]-R1[i] )*m )<=ABS( R2[i]) ) then isStable:=FALSE;
RgS[i]:=Rg[i];
end;
end;
function saveResults( ns , iter : integer ) : boolean;
var
sum : real;
begin
sum:=0;
for i:=1 to nFreqs do sum:=sum + Fh[1,i];
sum:=SQRT( sum/nFreqs );
assign( FF , outFileName );
append( FF );
write( iter:2, ' <”>', sum:10:7, ' Rg=' );
write( FF , iter:2, ' <”>', sum:10:7, ' Rg=');
for i:=1 to mCur do
begin
write( Rg[i]:6:3, ' ');
write( FF , Rg[i]:6:3, ' ');
end;
writeln;
writeln( FF );
close( FF );
saveResults:=isStable( ns , Rgs , Rg );
end;
procedure saveExpResults;
begin
assign( FF , outFileName );
append( FF );
writeln( ' siE=',Rg[2]:6:3,' siI=',Rg[1]:6:3,' alfa=',Rg[3]:6:3);
writeln( FF , ' siE=',Rg[2]:6:3,' siI=',Rg[1]:6:3,' alfa=',Rg[3]:6:3);
write( ' SI: ');
write( FF , ' SI: ');
for i:=1 to nPoints do
begin
write( si[i]:6:3,' ');
write( FF , si[i]:6:3,' ');
end;
writeln;
writeln( FF );
close( FF );
end;
procedure saveHypTgResults;
begin
assign( FF , outFileName );
append( FF );
writeln( ' si1=',Rg[2]:6:3,' si2=',Rg[1]:6:3,' beta=',Rg[3]:6:3,' gamma=',Rg[4]:6:3);
writeln( FF , ' si1=',Rg[2]:6:3,' si2=',Rg[1]:6:3,' beta=',Rg[3]:6:3,' gamma=',Rg[4]:6:3);
write( ' SI: ');
write( FF , ' SI: ');
for i:=1 to nPoints do
begin
write( si[i]:6:3,' ');
write( FF , si[i]:6:3,' ');
end;
writeln;
writeln( FF );
close( FF );
end;
procedure clock; {t2 = t2-t1}
var
H1,M1,S1,H2,M2,S2,sec1,sec2 : longint;
begin
GetTime( clk2.H, clk2.M, clk2.S, clk2.S100 ); {current time}
H2:=clk2.H; M2:=clk2.M; S2:=clk2.S; H1:=clk1.H; M1:=clk1.M; S1:=clk1.S;
sec2:= ( H2*60 + M2 )*60 + S2;
sec1:= ( H1*60 + M1 )*60 + S1;
if( sec2 < sec1 )then sec2:=sec2 + 85020; {+23.59.59}
sec2:=sec2 - sec1;
clk2.H := sec2 div 3600; sec2:=sec2 - clk2.H*3600;
clk2.M := sec2 div 60; sec2:=sec2 - clk2.M*60;
clk2.S := sec2;
writeln( clk2.H:2, ':', clk2.M:2, ':', clk2.S:2 );
end;
procedure saveTime;
begin
assign( FF , outFileName );
append( FF );
write( FF ,'* Processing time ',clk2.H:2, ':', clk2.M:2, ':', clk2.S:2 );
close( FF );
end;
End.
П1.7 Модуль решения прямой задачи ВТК для НВТП EDirect
{****************************************************************************}
{ ERIN submodule : EDirect , 15.02.99, (C) 1999 by Nikita U.Dolgov }
{****************************************************************************}
{ Estimates Uvn* for Eddy current testing of inhomogeneous multilayer slab }
{ with surface( flat ) probe. }
{ It can do it using one of five types of conductivity approximation : }
{Spline, Exponential, Piecewise constant, Piecewise linear,Hyperbolic tangent}
{****************************************************************************}
{$F+}
Unit EDirect;
Interface
Uses EData, EMath;
Type
siFunc = function( x:real ) : real;
Var
getSiFunction : siFunc; {for external getting SI estimate}
procedure initConst( par1,par2:integer; par3,par4:real; par5:boolean );
procedure getVoltage( freq : real ; var ur,ui : real ); { Uvn* = ur + j*ui }
procedure setApproximationType( approx : byte ); { type of approx. }
procedure setApproximationItem( SIG:real ; N : byte ); { set SIGMA[ N ]}
procedure setApproximationData( var SIG; nVal : byte ); { SIGMA[1..nVal] }
procedure getApproximationData( var SIG ; var N : byte ); { get SIGMA[ N ]}
Implementation
Const
PI23 = 2000*pi; {2*pi*KHz}
mu0 = 4*pi*1E-7; {magnetic const}
Var
appSigma : Parameters; {conductivity approximation data buffer}
appCount : byte; {size of conductivity approximation data buffer}
appType : byte; {conductivity approximation type identifier}
Type
commonInfo=record
w : real; {cyclical excitation frecuency}
R : real; {equivalent radius of probe}
H : real; {generalized lift-off of probe}
Kr : real; {parameter of probe}
eps : real; {error of integration}
xMax : real; {upper bound of integration}
steps : integer; {current number of integration steps}
maxsteps: integer; {max number of integration steps}
Nlay : integer; {number of layers in slab}
sigma : Parameters; {conductivity of layers}
m : Parameters; {relative permeability of layers}
b : Parameters; {thickness of layers}
zCentre : Parameters; {centre of layer}
end;
procFunc = procedure( x:real; var result:complex);
Var
siB, siC, siD : Parameters; {support for Spline approx.}
cInfo : commonInfo; {one-way access low level info}
function siSpline( x:real ) : real;{Spline approximation}
begin
if( appCount = 1 )then
siSpline := appSigma[ 1 ]
else
siSpline:=Seval( appCount, x, appSigma, siB, siC, siD);
end;
function siExp( x:real ) : real;{Exponential approximation}
begin
siExp:=(appSigma[2]-appSigma[1])*EXP( -appSigma[3]*(1-x) ) + appSigma[1];
end;
function siPWConst( x:real ) : real;{Piecewise constant approximation}
var
dx, dh : real; i : byte;
begin
if( appCount = 1 )then siPWConst := appSigma[ 1 ]
else
begin
dh:=1/( appCount-1 );
dx:=dh/2;
i:=1;
while( x > dx ) do
begin
i:=i + 1;
dx:=dx + dh;
end;
siPWConst:=appSigma[ i ];
end;
end;
function siPWLinear( x:real ) : real;{Piecewise linear approximation}
var
dx, dh : real;
i : byte;
begin
if( appCount = 1 )then siPWLinear := appSigma[ 1 ]
else
begin
dh:=1/( appCount-1 );
dx:=0;
i:=1;
repeat
i:=i + 1;
dx:=dx + dh;
until( x <= dx );
siPWLinear:=appSigma[i-1]+( appSigma[i]-appSigma[i-1] )*( x/dh+2-i);
end;
end;
function siHyperTg( x:real ) : real;{Hyperbolic tangent approximation}
begin
siHyperTg:=appSigma[2]+(appSigma[1]-appSigma[2])*(1+th((appSigma[3]-x)/appSigma[4]))/2;
end;
procedure setApproximationType( approx : byte );
begin
appType := approx;
write('* conductivity approximation type : ');
case approx of
apSpline : begin
writeln('SPLINE');
getSiFunction := siSpline;
end;
apExp : begin
writeln('EXP');
Страницы: 1, 2, 3, 4, 5, 6, 7, 8
