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
/
NETWORK2.PZS
/
NETWORK2.PAS
Wrap
Pascal/Delphi Source File
|
2000-06-30
|
15KB
|
446 lines
{ THIS SECTION PRINTS THE TITLE AND REFERANCE INFO }
LABEL 100,200,300,400,500;
BEGIN
CLRSCR;MF:=0.0;
SAME_TYPE:=FALSE; { NOT EDITING SO SET TO FALSE }
WRITELN(' RF NETWORK ANALYSIS PROGRAM');
WRITELN(' by: WILLIAM L. MUNSON');
WRITELN(' VERSION 1.1 - OCT. 22 1987');
WRITELN;
WRITELN('NETWORK may be used for non-commercial purposes only.');
WRITELN('No commercial use of NETWORK may be made without the');
WRITELN('author',chr(39),'s express written permission.');WRITELN;
WRITELN('1) Units are ohms, nH, pF, Mhz and inches.');
writeln('2) Maximum number of sections is Two Hundred.');
writeln('3) IL(DB)= Insertion loss in dB.');
writeln('4) RL(DB)= Return loss in dB.');
writeln('5) VSWR = Volatage Standing Wave Ratio.');
writeln('6) RHO = Reflection Coefficient.');
writeln('7) ZIN(R)= Real part of input impedance.');
writeln('8) ZIN(I)= Imag. part of input impedance.');writeln;
WRITELN('NOTE: The load resistance can be entered as a complex number.');
writeln;
{ THIS SECTION CHECKS FOR INPUT FROM FILE REQUEST }
BEGIN
{ THIS SECTION CLEARS ALL OF THE ARRAYS TO 0 }
I:=1;
REPEAT;
R[I]:=0;
C[I]:=0;
L[I]:=0;
ET[I]:=0;
I:=I+1
UNTIL I=201;
300: WRITE('DO YOU WANT A (N)EW OR A (S)AVED NETWORK? ');READLN(Q1);
IF (Q1='S') OR (Q1='s') THEN
BEGIN
CLRSCR;
WRITE('DO YOU WANT A DIRECTORY (Y/N)? ');READLN(FILENAME);
WRITELN;
IF (FILENAME='Y') OR (FILENAME='y') THEN FILES;
WRITELN;WRITELN;WRITE('WHAT IS THE NAME OF THE FILE? ');READLN(FILENAME);
ASSIGN(SAVEFILE,FILENAME);
RESET(SAVEFILE);
READLN(SAVEFILE,DATA); {READ NUMBER OF SECTIONS}
REMOVEBLANKS;
VAL(DATA,NS,CODE);
READLN(SAVEFILE,DATA); {READ SOURCE RESISTANCE}
REMOVEBLANKS;
VAL(DATA,RS,CODE);
READLN(SAVEFILE,DATA);
REMOVEBLANKS;
VAL(DATA,RL,CODE);
FOR N:=1 TO NS DO
BEGIN
READLN(SAVEFILE,DATA);
REMOVEBLANKS;
VAL(DATA,ET[N],CODE);
READLN(SAVEFILE,DATA);
REMOVEBLANKS;
VAL(DATA,R[N],CODE);
READLN(SAVEFILE,DATA);
REMOVEBLANKS;
VAL(DATA,L[N],CODE);
READLN(SAVEFILE,DATA);
REMOVEBLANKS;
VAL(DATA,C[N],CODE);
END;
CLOSE(SAVEFILE);
END;
{ THIS SECTION INPUTS AND CHECKS THE NUMBER OF CIRCUIT ELEMENTS }
IF (Q1<>'S') AND (Q1<>'s') THEN
BEGIN
CORRECT:=FALSE;
REPEAT;
WRITELN('HOW MANY SECTIONS [MAX=200]');
WRITE('(DONT COUNT THE LOADS)? ');READLN(NS);
IF (NS>0) AND (NS<=200) THEN CORRECT:=TRUE
UNTIL CORRECT;
CORRECT:=FALSE;
REPEAT;
WRITELN;WRITE('ENTER THE SOURCE RESISTANCE (OHMS)? ');
READLN(RS);IF RS>0.0 THEN CORRECT:=TRUE;
UNTIL CORRECT;
CORRECT:=FALSE;
{ THIS SECTION ENTERS THE COMPONENT VALUES INTO THE ARRAYS }
N:=1;
REPEAT;
ENTER_ELEMENT_TYPE;
N:=N+1;
UNTIL N>NS;
CLRSCR;
{ THIS SECTION ENTERS THE LOAD RESISTANCE }
500: CORRECT:=FALSE;
BEGIN
WRITELN('TO ENTER A COMPLEX NUMBER FOR THE LOAD VALUE.');
WRITELN('USE THE SERIES EQUIVALENT FORM EG.- (1.28+J12.45) or (1.28-J12.45)');
WRITELN;
REPEAT;
WRITELN;WRITE('LOAD RESISTANCE (OHMS)? ');READLN(DATA);
UNTIL LENGTH(DATA)>0;
CORRECT:=FALSE;
IF POS('J',DATA)>0 THEN CORRECT:=TRUE;
IF POS('j',DATA)>0 THEN CORRECT:=TRUE;
IF CORRECT THEN
BEGIN
WRITELN;WRITELN('WHAT IS THE FREQ. THAT THE COMPLEX NUMBER IS SPECIFIED AT? ');
WRITE('FREQUENCY (Mhz)? ');
READLN(FREQ);
NS:=NS+1;N:=N+1; {MAKE ROOM FOR ONE MORE SECTION }
POSITION:=POS('+',DATA);
IF POSITION>0 THEN
BEGIN
RESIST:=COPY(DATA,1,POSITION-1);
IMAG:=COPY(DATA,POSITION+2,LENGTH(DATA)-POSITION);
INDUCT:=TRUE;
CALC_VALUES;
END;
POSITION:=POS('-',DATA);
IF POSITION>0 THEN
BEGIN
RESIST:=COPY(DATA,1,POSITION-1);
IMAG:=COPY(DATA,POSITION+2,LENGTH(DATA)-POSITION);
INDUCT:=FALSE;
CALC_VALUES;
END;
END;
{ THE NUMBER MUST NOT BE COMPLEX SO ASSUME IT IS JUST A SIMPLE VALUE }
IF NOT CORRECT THEN
BEGIN
REMOVEBLANKS; {REMOVE ALL ILLEGAL CHAR FROM THE STRING}
VAL(DATA,RL,CODE);
IF CODE>0 THEN GOTO 500;
END;
END;
END;
{ THIS SECTION EDITS THE ELEMENT VALUES }
WRITELN;WRITE('EDIT ELEMENTS (Y/N)? ');READLN(Q1);
200: IF (Q1='Y') OR (Q1='y') THEN
BEGIN
WRITELN(' ');
PRINT_ELEMENT_TABLE;
REPEAT;
WRITE('ENTER (S)OURCE, (L)OAD, ELEMENT #, OR (Q) TO QUIT ? ');
READLN(Q1);
IF (Q1='S') OR (Q1='s') THEN
BEGIN
WRITE('SOURCE RESISTANCE (OHMS)? ');READLN(RS);
PRINT_ELEMENT_TABLE;
END;
IF (Q1='L') OR (Q1='l') THEN
BEGIN
WRITE('LOAD RESISTANCE (OHMS)? ');READLN(RL);
PRINT_ELEMENT_TABLE;
END;
VAL(Q1,N,CODE);
IF (CODE=0) AND (N>0) AND (N<=NS) THEN
BEGIN
WRITELN;WRITE('CHANGE ELEMENT TYPE (Y/N)? ');READLN(Q1);
IF (Q1='Y') OR (Q1='y') THEN SAME_TYPE:=FALSE ELSE SAME_TYPE:=TRUE;
ENTER_ELEMENT_TYPE;SAME_TYPE:=FALSE;
PRINT_ELEMENT_TABLE;
END;
UNTIL (Q1='Q') OR (Q1='q');
END;
{ THIS SECTION DEFINES OR EDITS THE FREQUENCY RANGE }
CLRSCR;
IF MF>0 THEN
BEGIN
WRITE('SAME FREQUENCY RANGE (Y/N)? ');READLN(Q1);
END;
100: IF (Q1='N') OR (Q1='n') OR (MF=0.0) THEN
BEGIN
WRITE('START FREQUENCY (Mhz)? ');READLN(MF);
WRITE('STEP FREQUENCY (Mhz)? ');READLN(DF);
WRITE('NUMBER OF STEPS ? ');READLN(NF);NF:=NF-1;
END;
WRITE('OUTPUT TO (S)CREEN OR (P)RINTER? ');READLN(Q1);
IF Q1='p' THEN Q1:='P';
IF Q1='P' THEN
BEGIN
WRITELN('ENTER A DESCRIPTION OF THE NETWORK TO BE USED AS A HEADER ON THE PRINTOUT.');
WRITE('? ');READLN(DESCRIPTION);
END;
CLRSCR;
{ THIS SECTION PRINTS THE HEADER INFO FOR THE SCREEN AND IF SELECTED
FOR THE PRINTER }
WRITELN(' FREQ(Mhz) IL(DB) RL(DB) VSWR RHO ZIN(R) ZIN(I)');
IF Q1='P' THEN
BEGIN
WRITELN(LST,' =================================== ');
WRITELN(LST,' RF NETWORK ANALYSIS PROGRAM VER 1.1');
WRITELN(LST,' ===================================');
WRITELN(LST,'');WRITELN(LST,DESCRIPTION);WRITELN(LST,'');
WRITELN(LST,'NETWORK LISTING.');WRITELN(LST,'');
WRITELN(LST,'ELEM TYPE DESCRIPTION R L C');
WRITELN(LST,' (ZO) (L) (E)');
WRITELN(LST,'SOURCE R ',RS:14:3);
N:=1;REPEAT;
WRITE(LST,N:2,ET[N]:7,' ');
PRINT_TYPE;
WRITELN(LST,R[N]:14:3,L[N]:14:3,C[N]:14:3);
N:=N+1;
UNTIL N>NS;
WRITELN(LST,'LOAD R ',RL:14:3);
WRITELN(LST,'');WRITELN(LST,'NOTE: R,L,C ARE FOR ELEMENT TYPES 1-11.');
WRITELN(LST,' ZO,L,E ARE FOR ELEMENT TYPES 12-16.');WRITELN(LST,'');
WRITELN(LST,' FREQ(Mhz) IL(DB) RL(DB) VSWR RHO ZIN(R) ZIN(I)');
END;
{ THIS SECTION SETS UP THE LOOPS WHICH CALCULATE THE GAIN AND IMPEDANCE OF
THE NETWORK.}
CO:=MF+DF*NF*FR;K:=0.0;
WHILE K<=NF DO (* THIS IS THE START OF THE 'K' LOOP WHICH ENDS WHEN K>NF *)
BEGIN
F:=(MF+K*DF)*FR;W:=2.0*PI*F;
A1:=1.0;D1:=1.0;A4:=0.0;B1:=0.0;B4:=0.0;C1:=0.0;C4:=0.0;D4:=0.0;
N:=1;
WHILE N<=NS DO { THIS IS THE START OF THE 'N' LOOP WHICH ENDS WHEN N>NS }
BEGIN
IF ET[N]=1 THEN
BEGIN
RA:=1.0;IA:=0.0;RB:=R[N];IB:=0.0;RC:=0.0;IC:=0.0;RD:=1.0;ID:=0.0;
END;
IF ET[N]=2 THEN
BEGIN
RA:=1.0;IA:=0.0;RB:=0.0;IB:=0.0;RC:=1.0/R[N];IC:=0.0;RD:=1.0;ID:=0.0;
END;
IF ET[N]=3 THEN
BEGIN
RA:=1.0;IA:=0.0;RB:=0.0;IB:=W*L[N]*LC;RC:=0.0;IC:=0.0;RD:=1.0;ID:=0.0;
END;
IF ET[N]=4 THEN
BEGIN
RA:=1.0;IA:=0.0;RB:=0.0;IB:=0.0;RC:=0.0;IC:=-1.0/(W*L[N]*LC);RD:=1.0;ID:=0.0;
END;
IF ET[N]=5 THEN
BEGIN
RA:=1.0;IA:=0.0;RB:=0.0;IB:=-1/(W*C[N]*CC);RC:=0.0;IC:=0.0;RD:=1.0;ID:=0.0;
END;
IF ET[N]=6 THEN
BEGIN
RA:=1.0;IA:=0.0;RB:=0.0;IB:=0.0;RC:=0.0;IC:=W*C[N]*CC;RD:=1.0;ID:=0.0;
END;
IF ET[N]=7 THEN
BEGIN
RA:=1.0;IA:=0.0;RB:=R[N];IB:=W*L[N]*LC-1/(W*C[N]*CC);
RC:=0.0;IC:=0.0;RD:=1.0;ID:=0.0;
END;
IF ET[N]=8 THEN
BEGIN
RA:=1.0;IA:=0.0;RB:=0.0;IB:=0.0;V4:=SQR(W)*L[N]*LC*C[N]*CC-1;
RC:=W*W*SQR(C[N]*CC)*R[N]/(W*W*SQR(C[N]*CC)*SQR(R[N])+SQR(W*W*L[N]*LC*C[N]*CC-1));
IC:=-W*C[N]*CC*V4/(SQR(W)*SQR(C[N]*CC)*SQR(R[N])+SQR(V4));
RD:=1.0;ID:=0.0;
END;
IF ET[N]=9 THEN
BEGIN
RB:=SQR(W)*R[N]*SQR(L[N]*LC)/(W*W*SQR(L[N]*LC)+SQR(R[N])*SQR(1-W*W*L[N]*LC*C[N]*CC));
RA:=1.0;IA:=0.0;T:=W*W*SQR(L[N]*LC)+SQR(R[N])*SQR(1-W*W*L[N]*LC*C[N]*CC);
IB:=W*L[N]*LC*R[N]*R[N]*(1-W*W*L[N]*LC*C[N]*CC)/T;RC:=0.0;IC:=0.0;RD:=1;ID:=0.0;
END;
IF ET[N]=10 THEN
BEGIN
RC:=1/R[N];IC:=(-1+W*W*L[N]*LC*C[N]*CC)/(W*L[N]*LC);
RA:=1.0;IA:=0.0;RB:=0.0;IB:=0.0;RD:=1.0;ID:=0.0;
END;
IF ET[N]=11 THEN
BEGIN
RB:=R[N]/(SQR(1-W*W*L[N]*LC*C[N]*CC)+SQR(W*C[N]*CC*R[N]));
IB:=W*(L[N]*LC*(1-W*W*L[N]*LC*C[N]*CC)-C[N]*CC*SQR(R[N]))*RB/R[N];
RA:=1.0;IA:=0.0;RC:=0.0;IC:=0.0;RD:=1.0;ID:=0.0;
END;
IF ET[N]=12 THEN
BEGIN
V3:=W*L[N]*CM*EXPON(C[N],0.5)/3.0E+10;RA:=COS(V3);IA:=0.0;RB:=0.0;IB:=R[N]*SIN(V3);
RC:=0.0;IC:=SIN(V3)/R[N];RD:=COS(V3);ID:=0.0;
END;
IF ET[N]=13 THEN
BEGIN
V3:=W*L[N]*CM*EXPON(C[N],0.5)/3.0E+10;
RA:=1.0;IA:=0.0;RB:=0.0;IB:=0.0;RC:=0.0;IC:=TAN(V3)/R[N];RD:=1.0;ID:=0.0;
END;
IF ET[N]=14 THEN
BEGIN
V3:=W*L[N]*CM*EXPON(C[N],0.5)/3.0E+10;
RA:=1.0;IA:=0.0;RB:=0.0;IB:=0.0;RC:=0.0;IC:=-1/(TAN(V3)*R[N]);RD:=1.0;ID:=0.0;
END;
IF ET[N]=15 THEN
BEGIN
V3:=W*L[N]*CM*EXPON(C[N],0.5)/3.0E+10;
RA:=1.0;IA:=0.0;RB:=0.0;IB:=-R[N]/TAN(V3);RC:=0.0;IC:=0.0;RD:=1.0;ID:=0.0;
END;
IF ET[N]=16 THEN
BEGIN
V3:=W*L[N]*CM*EXPON(C[N],0.5)/3.0E+10;
RA:=1.0;IA:=0.0;RB:=0.0;IB:=R[N]*TAN(V3);RC:=0.0;IC:=0.0;RD:=1.0;ID:=0.0;
END;
IF ET[N]=17 THEN
BEGIN
RA:=TR;IA:=0.0;RB:=0.0;IB:=0.0;RC:=0.0;IC:=0.0;RD:=1/TR;ID:=0.0;
END;
{ THIS SECTION MULTIPLIES THE ABCD MATRICIES TOGETHER }
A3:=A1*RA-A4*IA+B1*RC-B4*IC;A6:=A1*IA+A4*RA+B1*IC+B4*RC;
B3:=A1*RB-A4*IB+B1*RD-B4*ID;B6:=A1*IB+A4*RB+B1*ID+B4*RD;
C3:=C1*RA-C4*IA+D1*RC-D4*IC;C6:=C1*IA+C4*RA+D1*IC+D4*RC;
D3:=C1*RB-C4*IB+D1*RD-D4*ID;D6:=C1*IB+C4*RB+D4*RD+D1*ID;
A1:=A3;A4:=A6;B1:=B3;B4:=B6;C1:=C3;C4:=C6;D1:=D3;D4:=D6;
N:=N+1;
END; { END OF 'N' LOOP }
{ THIS SECTION CALCULATES THE OUTPUT DATA }
G:=(A3*RL+B3+C3*RS*RL+D3*RS)/RL; H:=(A6*RL+B6+C6*RS*RL+D6*RS)/RL;
II:=SQRT(SQR(G)+SQR(H));
NU[2]:=INT(-10*LN(RL*SQR(II)/(4*RS))/LN(10.0)*100.0+0.5)/100.0;
V1:=C3*RL+D3; V2:=C6*RL+D6; Q:=SQR(V1)+SQR(V2);
NU[6]:=INT(((A3*RL+B3)*V1+(A6*RL+B6)*V2)/Q*100.0+0.5)/100.0;
NU[7]:=INT(((A6*RL+B6)*V1-(A3*RL+B3)*V2)/Q*100.0+0.5)/100.0;
NU[1]:=INT(F*1000.0/(1.0E+6)+0.5)/1000.0;
R1:=SQRT(SQR(NU[6]-RS)+SQR(NU[7]));
R2:=SQRT(SQR(NU[6]+RS)+SQR(NU[7])); RO:=R1/R2;
IF RO=1.0 THEN RO:=0.999999;
NU[5]:=INT(RO*100.0+0.5)/100.0;
NU[3]:=-INT(20.0*LN(1/RO)/LN(10.0)*100.0+0.5)/100.0;
NU[4]:=INT((1.0+RO)/(1-RO)*100.0+0.5)/100.0;
I:=1;
REPEAT;
WRITE(NU[I]:11:2);
IF Q1='P' THEN WRITE(LST,NU[I]:11:2);
I:=I+1;
UNTIL I>7;
WRITELN;
IF Q1='P' THEN WRITELN(LST,'');
K:=K+1.0;
END;
{ THIS SECTION HANDLES THE OPTIONS MENU SELECTIONS }
WRITELN;
IF Q1='P' THEN WRITELN(LST,CHR(12));
400: REPEAT;
WRITE('(1)CHANGE FREQ (2)EDIT ELEMENTS (3)START OVER (4)QUIT OR (5)SAVE ? ');
{$I-}
READLN(A);
UNTIL (A>0) AND (A<6) AND (IORESULT=0);
{$I+}
CLRSCR;
IF A=1 THEN
BEGIN
Q1:='N';
GOTO 100;
END;
IF A=2 THEN
BEGIN
(*CLRSCR;*)
Q1:='Y';
GOTO 200;
END;
IF A=3 THEN GOTO 300;
IF A=5 THEN
BEGIN
WRITE('WHAT NAME TO SAVE THE NETWORK UNDER ? ');READLN(FILENAME);;
ASSIGN(SAVEFILE,FILENAME);
REWRITE(SAVEFILE);
STR(NS,DATA);
WRITELN(SAVEFILE,DATA); {WRITE NUMBER OS SECTIONS TO FILE}
STR(RS,DATA);
WRITELN(SAVEFILE,DATA); {WRITE SOURCE RESISTANCE TO FILE}
STR(RL,DATA);
WRITELN(SAVEFILE,DATA); {WRITE LOAD RESISTANCE TO FILE}
FOR N:= 1 TO NS DO
BEGIN
STR(ET[N],DATA);
WRITELN(SAVEFILE,DATA); {WRITE ELEM TYPE TO FILE}
STR(R[N],DATA);
WRITELN(SAVEFILE,DATA); {WRITE R VALUE TO FILE}
STR(L[N],DATA);
WRITELN(SAVEFILE,DATA); {WRITE L VALUE TO FILE}
STR(C[N],DATA);
WRITELN(SAVEFILE,DATA); {WRITE C VALUE TO FILE}
END;
CLOSE(SAVEFILE);
GOTO 400;
END;
END;
END.