home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
walnut-creek-CDROM
/
CPM
/
HAMRADIO
/
NETWORK2.LBR
/
NETWORK1.PZS
/
NETWORK1.PAS
Wrap
Pascal/Delphi Source File
|
2000-06-30
|
9KB
|
271 lines
PROCEDURE NOZERO;
BEGIN
IF M=0.0 THEN M:=0.00000001;
END;
PROCEDURE REMOVEBLANKS; {THIS PROCEDURE REMOVES LEADING AND TRAILING BLANKS FROM DATA }
BEGIN
VAL(DATA,DUMMY,CODE); {TRY TO CONVERT WITH A DUMMY VARIABLE}
IF CODE>0 THEN
BEGIN
REPEAT;
DELETE(DATA,CODE,1); {REMOVE THE OFFENDING CHAR}
IF LENGTH(DATA)=0 THEN
BEGIN
WRITELN('***DATA READ ERROR***');
HALT;
END;
VAL(DATA,DUMMY,CODE);
UNTIL CODE=0;
END;
END;
PROCEDURE PRINT_MENU;
{ THIS PROCEDURE PRINTS THE ELEMENT TYPE MENU }
BEGIN
CLRSCR;
WRITELN;WRITELN(' ELEMENT TYPE MENU');WRITELN;
WRITELN(' (1) SER R (12) TRANSMISSION LINE');
WRITELN(' (2) PAR R (13) PAR OPEN STUB');
WRITELN(' (3) SER L (14) PAR SHORT STUB');
WRITELN(' (4) PAR L (15) SER OPEN STUB');
WRITELN(' (5) SER C (16) SER SHORT STUB');
WRITELN(' (6) PAR C (17) TRANSFORMER');
WRITELN(' (7) SER (S-RLC)');
WRITELN(' (8) PAR (S-RLC)');
WRITELN(' (9) SER (P-RLC)');
WRITELN('(10) PAR (P-RLC)');
WRITELN('(11) SER (S-RL/P-C)');
WRITELN;
END;
PROCEDURE PRINT_DIELECTRIC_CONSTANTS;
{ THIS PROCEDURE PRINTS OUT THE DIELECTRIC CONSTANTS CHART }
BEGIN
CLRSCR;
WRITELN;
WRITELN('DIELECTRIC CONSTANT CHART:');
WRITELN;
WRITELN('AIR 1.00');
WRITELN('DUROID 5880 2.20');
WRITELN('DUROID 5870 2.23');
WRITELN('TEFLON-FIBERGLASS (PTFE) 2.55');
WRITELN('FUSED SILICA (QUARTZ) 3.78');
WRITELN('G-10 FIBERGLASS 4.50');
WRITELN('ALUMINA OR EPSILAM 10 10.00');
WRITELN;
END;
{THIS PROCEDURE TAKES THE STRINGS REPRESENTING THE TWO PARTS OF A COMPLEX NUMBER
AND CONVERTS THEM TO THEIR REAL EQUIVALENTS THEN IT LOADS THE VALUES INTO
THE CORRECT ELEMENT SPOTS }
PROCEDURE CALC_VALUES;
BEGIN
DATA:=RESIST;
REMOVEBLANKS;
VAL(DATA,RL,CODE);
IF CODE>0 THEN
BEGIN
WRITELN('*** COMPLEX NUMBER ERROR ***');
HALT;
END;
DATA:=IMAG;
REMOVEBLANKS;
IF INDUCT THEN
BEGIN
ET[N-1]:=3;C[N-1]:=0.0;R[N-1]:=0.0;
VAL(DATA,L[N-1],CODE);
IF CODE>0 THEN
BEGIN
WRITELN('*** COMPLEX NUMBER ERROR ***');
HALT;
END;
L[N-1]:=(L[N-1]/(PI*2.0*FREQ*1E+6))*1.0E+9;
END;
IF NOT INDUCT THEN
BEGIN
ET[N-1]:=5;L[N-1]:=0.0;R[N-1]:=0.0;
VAL(DATA,C[N-1],CODE);
IF CODE>0 THEN
BEGIN
WRITELN('*** COMPLEX NUMBER ERROR ***');
HALT;
END;
C[N-1]:=(1.0/(PI*2.0*FREQ*1.0E+6*C[N-1]))*1.0E+12;
END;
END;
PROCEDURE PRINT_ELEMENT_TABLE;
{ THIS PROCEDURE PRINTS A LISTING OF THE ELEMENT VALUES }
BEGIN
CLRSCR;DELAY(100);WRITELN;
WRITELN('ELEM TYPE R L C');
WRITELN(' (ZO) (L) (E)');
WRITELN('SOURCE R ',RS:14:3);
N:=1;REPEAT;
WRITELN(N:2,ET[N]:10,R[N]:17:3,L[N]:14:3,C[N]:14:3);
N:=N+1;
UNTIL N>NS;
WRITELN('LOAD R ',RL:14:3);
WRITELN;WRITELN('NOTE: R,L,C ARE FOR ELEMENT TYPES 1-11.');
WRITELN(' ZO,L,E ARE FOR ELEMENT TYPES 12-16.');WRITELN;
END;
FUNCTION EXPON(VALUE,POWER:REAL):REAL;
{THIS FUNCTION TAKES TWO REAL NUMBERS (VALUE AND POWER) END RAISES VALUE
BY THE POWER 'POWER'.}
BEGIN
EXPON:=EXP(LN(VALUE)*POWER);
END;
FUNCTION TAN(VALUE:REAL):REAL;
{THIS FUNCTION PRODUCES THE TANGENT OF THE VALUE }
BEGIN
TAN:=SIN(VALUE)/COS(VALUE);
END;
PROCEDURE ENTER_ELEMENT_TYPE;
{ THIS PROCEDURE LOADS THE PROPER INFO INTO THE COMPONENT ARRAYS.
AT ENTRY THE VARIABLE "N" SHOULD BE SET TO THE ELEMENT NUMBER TO BE ASSIGNED
THE PROCEDURE WILL RETURN WITH THE VAR "N" UNCHANGED AND THE VALUES SET }
LABEL 10;
BEGIN
IF SAME_TYPE THEN GOTO 10;
CORRECT:=FALSE;
REPEAT;
PRINT_MENU;
WRITELN('ENTER ELEMENT TYPE FOR SECTION ',N:2);
WRITE('ELEMENT TYPE (1-17)? ');READLN(ET[N]);
IF (ET[N]>0) AND (ET[N]<18) THEN CORRECT:=TRUE
UNTIL CORRECT;
CORRECT:=FALSE;
{ ELEMENT TYPE MUST BE OK SO PROCESS IT }
10: IF ET[N]<3 THEN
BEGIN
WRITE('R',N:2,' (OHMS) = ');READLN(M);
NOZERO; (* CHECKS FOR ZERO ENTRY *)
R[N]:=M;L[N]:=0.0;C[N]:=0.0;
END;
IF (ET[N]=3) OR (ET[N]=4) THEN
BEGIN
WRITE('L',N:2,' (nH) = ');READLN(M);
NOZERO;
L[N]:=M;R[N]:=0;C[N]:=0;
END;
IF (ET[N]=5) OR (ET[N]=6) THEN
BEGIN
WRITE('C',N:2,' (pF) = ');READLN(M);
NOZERO; (* CHECKS FOR ZERO ENTRY *)
C[N]:=M;R[N]:=0;L[N]:=0;
END;
IF (ET[N]>6) AND (ET[N]<12) THEN
BEGIN
WRITE('R',N:2,' (OHMS) = ');READLN(M);
NOZERO;
R[N]:=M;
WRITE('L',N:2,' (nH) = ');READLN(M);
NOZERO;
L[N]:=M;
WRITE('C',N:2,' (pF) = ');READLN(M);
NOZERO;
C[N]:=M;
END;
IF (ET[N]>11) AND (ET[N]<17) THEN
BEGIN
PRINT_DIELECTRIC_CONSTANTS;
WRITE('ENTER DESIRED DIELECTRIC CONST. = ');READLN(M);
NOZERO;DC:=M;
C[N]:=INT(DC*100.0+0.5)/100.0;
REPEAT;
WRITELN;WRITELN('ARE THE LINES/STUBS IN:');WRITELN;
WRITE('(1) PHYSICAL DIMENSIONS, OR (2) ELECTRICAL PARAMETERS? ');
READLN(PE);IF (PE=1) OR (PE=2) THEN CORRECT:=TRUE;
UNTIL CORRECT;
CORRECT:=FALSE;
IF PE=1 THEN
BEGIN
WRITELN;WRITE('ENTER THE WIDTH (IN) = ');READLN(M);
NOZERO;W:=M;
WRITE('ENTER THE LENGTH (IN) = ');READLN(M);
NOZERO;L[N]:=INT(M*100.0+0.5)/100.0;
WRITE('ENTER BOARD THICKNESS (IN) = ');READLN(M);
NOZERO;TH:=M;
IF W/TH<1 THEN
BEGIN
EF:=((C[N]+0.5)+((C[N]-1.0)/2.0)*(EXPON((1+12.0*(TH/W)),-0.5))+0.04*EXPON((1.0-W/TH),2.0));
ZO:=(60.0/SQRT(EF))*LN(8.0*TH/W+0.25*W/TH);
R[N]:=INT(ZO*100.0+0.5)/100.0;
END
ELSE
BEGIN
EF:=((C[N]+1.0)/2.0)+((C[N]-1.0)/2.0)*EXPON((1.0+12.0*(TH/W)),(-0.5));
ZO:=(120.0*3.14159/SQRT(EF))/(W/TH+1.393+0.667*LN(W/TH+1.44));
R[N]:=INT(ZO*100.0+0.5)/100.0;
END;
END;
IF PE=2 THEN
BEGIN
WRITELN;WRITE('ENTER THE CHAR. IMPEDANCE (OHMS) = ');READLN(M);
NOZERO;R[N]:=INT(M*100.0+0.5)/100.0;
WRITE('ENTER ELECTRICAL LENGTH (DEGS) = ');READLN(M);
NOZERO;DE:=M;
WRITE('ENTER CENTER FREQUENCY (Mhz) = ');READLN(M);
NOZERO;FO:=M;
L[N]:=(DE*3.0E+10)/(C[N]*FO*FR*360.0);
L[N]:=INT(L[N]*100.0+0.5)/100.0
END;
END;
IF ET[N]=17 THEN
BEGIN
WRITELN;WRITE('TURNS RATIO (N) = ');READLN(M);
NOZERO;TR:=M;
END;
END;
PROCEDURE PRINT_TYPE;
BEGIN
IF ET[N]=1 THEN WRITE(LST,'SERIES R ');
IF ET[N]=2 THEN WRITE(LST,'PARALLEL R ');
IF ET[N]=3 THEN WRITE(LST,'SERIES L ');
IF ET[N]=4 THEN WRITE(LST,'PARALLEL L ');
IF ET[N]=5 THEN WRITE(LST,'SERIES C ');
IF ET[N]=6 THEN WRITE(LST,'PARALLEL C ');
IF ET[N]=7 THEN WRITE(LST,'SERIES-SERIES RLC ');
IF ET[N]=8 THEN WRITE(LST,'PARALLEL-SERIES RLC ');
IF ET[N]=9 THEN WRITE(LST,'SERIES-PARALLEL RLC ');
IF ET[N]=10 THEN WRITE(LST,'PARALLEL-PARALLEL RLC ');
IF ET[N]=11 THEN WRITE(LST,'SERIES-SERIES RL/PARL C');
IF ET[N]=12 THEN WRITE(LST,'TRANSMISSION LINE ');
IF ET[N]=13 THEN WRITE(LST,'OPEN PARALLEL STUB ');
IF ET[N]=14 THEN WRITE(LST,'SHORTED PARALLEL STUB ');
IF ET[N]=15 THEN WRITE(LST,'OPEN SERIES STUB ');
IF ET[N]=16 THEN WRITE(LST,'SHORTED SERIES STUB ');
IF ET[N]=17 THEN WRITE(LST,'TRANSFORMER ');
END;