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
Pascal/Delphi Source File  |  2000-06-30  |  9KB  |  271 lines
  1.  
  2. PROCEDURE NOZERO;
  3.      BEGIN
  4.      IF M=0.0 THEN M:=0.00000001;
  5.      END;
  6.  
  7. PROCEDURE REMOVEBLANKS; {THIS PROCEDURE REMOVES LEADING AND TRAILING BLANKS FROM DATA }
  8.  
  9.      BEGIN
  10.      VAL(DATA,DUMMY,CODE);  {TRY TO CONVERT WITH A DUMMY VARIABLE}
  11.      IF CODE>0 THEN
  12.           BEGIN
  13.           REPEAT;
  14.           DELETE(DATA,CODE,1);  {REMOVE THE OFFENDING CHAR}
  15.           IF LENGTH(DATA)=0 THEN
  16.                BEGIN
  17.                WRITELN('***DATA READ ERROR***');
  18.                HALT;
  19.                END;
  20.           VAL(DATA,DUMMY,CODE);
  21.           UNTIL CODE=0;
  22.           END;
  23.      END;
  24.  
  25.  
  26. PROCEDURE PRINT_MENU;
  27. { THIS PROCEDURE PRINTS THE ELEMENT TYPE MENU }
  28.  BEGIN
  29.    CLRSCR;
  30.    WRITELN;WRITELN('       ELEMENT TYPE MENU');WRITELN;
  31.    WRITELN(' (1)  SER R                       (12)  TRANSMISSION LINE');
  32.    WRITELN(' (2)  PAR R                       (13)  PAR OPEN STUB');
  33.    WRITELN(' (3)  SER L                       (14)  PAR SHORT STUB');
  34.    WRITELN(' (4)  PAR L                       (15)  SER OPEN STUB');
  35.    WRITELN(' (5)  SER C                       (16)  SER SHORT STUB');
  36.    WRITELN(' (6)  PAR C                       (17)  TRANSFORMER');
  37.    WRITELN(' (7)  SER (S-RLC)');
  38.    WRITELN(' (8)  PAR (S-RLC)');
  39.    WRITELN(' (9)  SER (P-RLC)');
  40.    WRITELN('(10)  PAR (P-RLC)');
  41.    WRITELN('(11)  SER (S-RL/P-C)');
  42.    WRITELN;
  43.  END;
  44.  
  45. PROCEDURE PRINT_DIELECTRIC_CONSTANTS;
  46. { THIS PROCEDURE PRINTS OUT THE DIELECTRIC CONSTANTS CHART }
  47.  BEGIN
  48.    CLRSCR;
  49.    WRITELN;
  50.    WRITELN('DIELECTRIC CONSTANT CHART:');
  51.    WRITELN;
  52.    WRITELN('AIR                          1.00');
  53.    WRITELN('DUROID 5880                  2.20');
  54.    WRITELN('DUROID 5870                  2.23');
  55.    WRITELN('TEFLON-FIBERGLASS (PTFE)     2.55');
  56.    WRITELN('FUSED SILICA (QUARTZ)        3.78');
  57.    WRITELN('G-10 FIBERGLASS              4.50');
  58.    WRITELN('ALUMINA OR EPSILAM 10       10.00');
  59.    WRITELN;
  60.  END;
  61.  
  62. {THIS PROCEDURE TAKES THE STRINGS REPRESENTING THE TWO PARTS OF A COMPLEX NUMBER
  63.  AND CONVERTS THEM TO THEIR REAL EQUIVALENTS THEN IT LOADS THE VALUES INTO
  64.  THE CORRECT ELEMENT SPOTS }
  65.  
  66. PROCEDURE CALC_VALUES;
  67. BEGIN
  68.   DATA:=RESIST;
  69.   REMOVEBLANKS;
  70.   VAL(DATA,RL,CODE);
  71.   IF CODE>0 THEN
  72.     BEGIN
  73.     WRITELN('*** COMPLEX NUMBER ERROR ***');
  74.     HALT;
  75.     END;
  76.   DATA:=IMAG;
  77.   REMOVEBLANKS;
  78.   IF INDUCT THEN
  79.     BEGIN
  80.     ET[N-1]:=3;C[N-1]:=0.0;R[N-1]:=0.0;
  81.     VAL(DATA,L[N-1],CODE);
  82.     IF CODE>0 THEN
  83.       BEGIN
  84.       WRITELN('*** COMPLEX NUMBER ERROR ***');
  85.       HALT;
  86.       END;
  87.     L[N-1]:=(L[N-1]/(PI*2.0*FREQ*1E+6))*1.0E+9;
  88.     END;
  89.   IF NOT INDUCT THEN
  90.     BEGIN
  91.     ET[N-1]:=5;L[N-1]:=0.0;R[N-1]:=0.0;
  92.     VAL(DATA,C[N-1],CODE);
  93.     IF CODE>0 THEN
  94.       BEGIN
  95.       WRITELN('*** COMPLEX NUMBER ERROR ***');
  96.       HALT;
  97.       END;
  98.     C[N-1]:=(1.0/(PI*2.0*FREQ*1.0E+6*C[N-1]))*1.0E+12;
  99.     END;
  100. END;
  101.  
  102.  
  103. PROCEDURE PRINT_ELEMENT_TABLE;
  104.  
  105. { THIS PROCEDURE PRINTS A LISTING OF THE ELEMENT VALUES }
  106.  
  107. BEGIN
  108.      CLRSCR;DELAY(100);WRITELN;
  109.      WRITELN('ELEM      TYPE             R             L             C');
  110.      WRITELN('                         (ZO)           (L)           (E)');
  111.      WRITELN('SOURCE R       ',RS:14:3);
  112.      N:=1;REPEAT;
  113.      WRITELN(N:2,ET[N]:10,R[N]:17:3,L[N]:14:3,C[N]:14:3);
  114.      N:=N+1;
  115.      UNTIL N>NS;
  116.      WRITELN('LOAD R         ',RL:14:3);
  117.      WRITELN;WRITELN('NOTE:   R,L,C ARE FOR ELEMENT TYPES 1-11.');
  118.              WRITELN('        ZO,L,E ARE FOR ELEMENT TYPES 12-16.');WRITELN;
  119. END;
  120.  
  121. FUNCTION  EXPON(VALUE,POWER:REAL):REAL;
  122.  
  123. {THIS FUNCTION TAKES TWO REAL NUMBERS (VALUE AND POWER) END RAISES VALUE
  124.    BY THE POWER 'POWER'.}
  125.  
  126. BEGIN
  127.  
  128.      EXPON:=EXP(LN(VALUE)*POWER);
  129.  
  130. END;
  131.  
  132.  
  133.  
  134. FUNCTION  TAN(VALUE:REAL):REAL;
  135.  
  136. {THIS FUNCTION PRODUCES THE TANGENT OF THE VALUE }
  137.  
  138. BEGIN
  139.  
  140.      TAN:=SIN(VALUE)/COS(VALUE);
  141.  
  142. END;
  143.  
  144.  
  145.  
  146. PROCEDURE ENTER_ELEMENT_TYPE;
  147.  
  148. { THIS PROCEDURE LOADS THE PROPER INFO INTO THE COMPONENT ARRAYS.
  149. AT ENTRY THE VARIABLE "N" SHOULD BE SET TO THE ELEMENT NUMBER TO BE ASSIGNED
  150. THE PROCEDURE WILL RETURN WITH THE VAR "N" UNCHANGED AND THE VALUES SET }
  151.  
  152. LABEL  10;
  153.  
  154. BEGIN
  155.       IF SAME_TYPE THEN GOTO 10;
  156.       CORRECT:=FALSE;
  157.       REPEAT;
  158.       PRINT_MENU;
  159.       WRITELN('ENTER ELEMENT TYPE FOR SECTION ',N:2);
  160.       WRITE('ELEMENT TYPE  (1-17)? ');READLN(ET[N]);
  161.       IF (ET[N]>0) AND (ET[N]<18) THEN CORRECT:=TRUE
  162.       UNTIL CORRECT;
  163.       CORRECT:=FALSE;
  164.            { ELEMENT TYPE MUST BE OK SO PROCESS IT }
  165. 10:   IF ET[N]<3 THEN
  166.             BEGIN
  167.             WRITE('R',N:2,' (OHMS) = ');READLN(M);
  168.             NOZERO;  (* CHECKS FOR ZERO ENTRY *)
  169.             R[N]:=M;L[N]:=0.0;C[N]:=0.0;
  170.             END;
  171.       IF (ET[N]=3) OR (ET[N]=4) THEN
  172.             BEGIN
  173.             WRITE('L',N:2,'   (nH) = ');READLN(M);
  174.             NOZERO;
  175.             L[N]:=M;R[N]:=0;C[N]:=0;
  176.             END;
  177.       IF (ET[N]=5) OR (ET[N]=6) THEN
  178.             BEGIN
  179.             WRITE('C',N:2,'   (pF) = ');READLN(M);
  180.             NOZERO;  (* CHECKS FOR ZERO ENTRY *)
  181.             C[N]:=M;R[N]:=0;L[N]:=0;
  182.             END;
  183.       IF (ET[N]>6) AND (ET[N]<12) THEN
  184.             BEGIN
  185.             WRITE('R',N:2,' (OHMS) = ');READLN(M);
  186.             NOZERO;
  187.             R[N]:=M;
  188.             WRITE('L',N:2,'   (nH) = ');READLN(M);
  189.             NOZERO;
  190.             L[N]:=M;
  191.             WRITE('C',N:2,'   (pF) = ');READLN(M);
  192.             NOZERO;
  193.             C[N]:=M;
  194.             END;
  195.       IF (ET[N]>11) AND (ET[N]<17) THEN
  196.             BEGIN
  197.             PRINT_DIELECTRIC_CONSTANTS;
  198.             WRITE('ENTER DESIRED DIELECTRIC CONST. = ');READLN(M);
  199.             NOZERO;DC:=M;
  200.             C[N]:=INT(DC*100.0+0.5)/100.0;
  201.  
  202.           REPEAT;
  203.             WRITELN;WRITELN('ARE THE LINES/STUBS IN:');WRITELN;
  204.             WRITE('(1) PHYSICAL DIMENSIONS, OR (2) ELECTRICAL PARAMETERS? ');
  205.             READLN(PE);IF (PE=1) OR (PE=2) THEN CORRECT:=TRUE;
  206.           UNTIL CORRECT;
  207.           CORRECT:=FALSE;
  208.  
  209.             IF PE=1 THEN
  210.                  BEGIN
  211.                  WRITELN;WRITE('ENTER THE WIDTH (IN)      = ');READLN(M);
  212.                  NOZERO;W:=M;
  213.                  WRITE('ENTER THE LENGTH (IN)       = ');READLN(M);
  214.                  NOZERO;L[N]:=INT(M*100.0+0.5)/100.0;
  215.                  WRITE('ENTER BOARD THICKNESS (IN)  = ');READLN(M);
  216.                  NOZERO;TH:=M;
  217.                  IF W/TH<1 THEN
  218.                       BEGIN
  219.                       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));
  220.                       ZO:=(60.0/SQRT(EF))*LN(8.0*TH/W+0.25*W/TH);
  221.                       R[N]:=INT(ZO*100.0+0.5)/100.0;
  222.                       END
  223.                  ELSE
  224.                       BEGIN
  225.                       EF:=((C[N]+1.0)/2.0)+((C[N]-1.0)/2.0)*EXPON((1.0+12.0*(TH/W)),(-0.5));
  226.                       ZO:=(120.0*3.14159/SQRT(EF))/(W/TH+1.393+0.667*LN(W/TH+1.44));
  227.                       R[N]:=INT(ZO*100.0+0.5)/100.0;
  228.                       END;
  229.                  END;
  230.             IF PE=2 THEN
  231.                  BEGIN
  232.                  WRITELN;WRITE('ENTER THE CHAR. IMPEDANCE (OHMS)    = ');READLN(M);
  233.                  NOZERO;R[N]:=INT(M*100.0+0.5)/100.0;
  234.                  WRITE('ENTER ELECTRICAL LENGTH (DEGS)  = ');READLN(M);
  235.                  NOZERO;DE:=M;
  236.                  WRITE('ENTER CENTER FREQUENCY (Mhz)    = ');READLN(M);
  237.                  NOZERO;FO:=M;
  238.                  L[N]:=(DE*3.0E+10)/(C[N]*FO*FR*360.0);
  239.                  L[N]:=INT(L[N]*100.0+0.5)/100.0
  240.                  END;
  241.             END;
  242.       IF ET[N]=17 THEN
  243.             BEGIN
  244.             WRITELN;WRITE('TURNS RATIO (N)  = ');READLN(M);
  245.             NOZERO;TR:=M;
  246.             END;
  247.       END;
  248.  
  249.  
  250. PROCEDURE   PRINT_TYPE;
  251.  
  252. BEGIN
  253.   IF ET[N]=1 THEN WRITE(LST,'SERIES R               ');
  254.   IF ET[N]=2 THEN WRITE(LST,'PARALLEL R             ');
  255.   IF ET[N]=3 THEN WRITE(LST,'SERIES L               ');
  256.   IF ET[N]=4 THEN WRITE(LST,'PARALLEL L             ');
  257.   IF ET[N]=5 THEN WRITE(LST,'SERIES C               ');
  258.   IF ET[N]=6 THEN WRITE(LST,'PARALLEL C             ');
  259.   IF ET[N]=7 THEN WRITE(LST,'SERIES-SERIES RLC      ');
  260.   IF ET[N]=8 THEN WRITE(LST,'PARALLEL-SERIES RLC    ');
  261.   IF ET[N]=9 THEN WRITE(LST,'SERIES-PARALLEL RLC    ');
  262.   IF ET[N]=10 THEN WRITE(LST,'PARALLEL-PARALLEL RLC  ');
  263.   IF ET[N]=11 THEN WRITE(LST,'SERIES-SERIES RL/PARL C');
  264.   IF ET[N]=12 THEN WRITE(LST,'TRANSMISSION LINE      ');
  265.   IF ET[N]=13 THEN WRITE(LST,'OPEN PARALLEL STUB     ');
  266.   IF ET[N]=14 THEN WRITE(LST,'SHORTED PARALLEL STUB  ');
  267.   IF ET[N]=15 THEN WRITE(LST,'OPEN SERIES STUB       ');
  268.   IF ET[N]=16 THEN WRITE(LST,'SHORTED SERIES STUB    ');
  269.   IF ET[N]=17 THEN WRITE(LST,'TRANSFORMER            ');
  270. END;
  271.