[sci.electronics] smith.ps: Smith Chart generator

mjj@stda.jhuapl.edu (Marshall Jose) (01/09/91)

The following is a shar archive of a PostScript program which prints out
a Smith chart.  Such a chart is useful to RF engineers and other
microwave weenies who still occasionally do things on paper.  See the
README file for details.


Marshall Jose  WA3VPZ
mjj%stda@aplcen.apl.jhu.edu  ||  ...mimsy!aplcen!aplvax!mjj

#---------------------<cut before here>--------------------------
# This is a shell archive. Remove anything before this line,
# then unpack it by saving it into a file and typing "sh file".
# Bundled by stda.jhuapl.edu!mjj on Jan 7 at 16:07
#
# Contents: README smith.ps
echo + README
sed 's/^X//' <<'E*O*F_README' > README
XDescription of smith.ps (Smith chart PostScript program)
X7 January 1991
XMarshall Jose, WA3VPZ
XJHU - Applied Physics Laboratory, Laurel, MD
X
XThe file "smith.ps" is a first-cut attempt at recreating within PostScript
Xthe chart invented by Phillip Smith of RCA which is of inestimable utility
Xto RF engineers.  The most significant object on the chart is the reflection
Xcoefficient chart in the chart's center.  This chart relates complex
Ximpedances (or admittances) to their resultant reflection coefficient.
XSee just about any introductory microwave text for further information.
X
XI reproduced the nomographs along the bottom as best as I could from the
X1966 original (Kay Electric Company #82-BSPR (9-66)), but I deleted some
Xnumerical labels to accommodate the font used; this shouldn't affect their
Xuse.
X
XAs I mention in the beginning comments, this program is for cheap
Xstudents and other not-for-profit individuals.  Anybody incorporating
Xany part of this code into a commercial product is welcome to risk
Xtheir own legal neck, but leave me OUT of it.
X
XI confess I failed in my primary aim with this chart, namely to generate
Xa combined impedance-admittance chart with different colors on a color
XPostScript printer.  Unfortunately, I was unable to get access to one,
Xso I gave up.  Nevertheless, I do have a procedure "DoGB" which will
Xgenerate the admittance circles using dashed lines and a sparser grid.
XIf it is used it should be executed prior to the execution of "DoRX"
Xso that the impedance circles are drawn on top.
X
XI have tried to be fairly straightforward with the coding so that others
Xcould modify it without much grief.  The brave souls who wouldst hack
Xthis code might find lots of places where the code could be optimized
Xfor speed; I encourage them.  There are probably way more call to "sin"
Xor "atan" than are necessary, making the whole chart take about 60 seconds
Xto print out on a LaserWriter II NTX.  Your mileage may vary.
X
XThe casual observer will notice that smith.ps does NOT adhere to
XEncapsulated PostScript Format (EPSF).  This is probably a bummer
Xif you wanted to use this in a document.  Anybody knowing how to
Xput it in EPS format, be my guest.
X
XThe procedure "Dotitles" lets you personalize the chart.  If you want to
Xmake a whole bunch of blank charts you can replace my supplied text with
Xnothings or with underlines.  The procedure "Dodots" is a half-hearted
Xtry at plotting points on the chart; it accepts an array of complex
Ximpedances and labels, and a normalizing resistance.  I gave the
XBezier fitter in PostScript a try, but it didn't work so I ripped the
Xcode out.  Any takers?
X
XAnyway, it was a interesting exercise, and I think I understand the
Xchart a whole bunch more.  Even if you're a total CAE proselyte, when
Xyou print it out and look at it, you'll still get a rush of
Xappreciation for the chart's mathematical beauty and engineering
Xutility.
X
XHave fun & 7'nerds,
XMarshall Jose   mjj@stda.jhuapl.edu  ||  WA3VPZ@N2GTE.MD.USA
E*O*F_README
echo + smith.ps
sed 's/^X//' <<'E*O*F_smith.ps' > smith.ps
X%!
X% smith.ps:
X%
X% The following PostScript(R) program produces a Smith chart which is
X% functionally equivalent to the ubiquitous Smith chart created by
X% Phillip Smith and marketed by the Kay Electric Company [#82-BSPR (9-66)]
X% and others.  It is reproduced here without permission & is intended for
X% use by cheap students; any plagiarizer incorporating this code into
X% marketed products is welcome to risk his/her own legal neck, but please
X% leave me out of it.
X%
X% Questions, corrections, & such may be sent to mjj@stda.jhuapl.edu.
X% However, suggestions for improvement might best be sent to sci.electronics
X% or rec.ham-radio (or to whatever they rename it) instead.
X%
X% 18 December 1990
X% Marshall Jose
X% JHU - Applied Physics Laboratory, Laurel, MD
X%
X%
X% N.B.:  In the syntax comments below, the top of the stack is designated
X%        by the object "closest" to the procedure-name.  In the following
X%        example, "var1" is on the top of stack upon entry and "res1" is on
X%        the top upon exit:
X%
X%            var2 var1  Procname  res1 res2
X%
X%        
X
X4.25 72 mul 5.9 72 mul translate
X
X/Helvfont {/Helvetica findfont 5 scalefont setfont} def Helvfont
X/Symfont {/Symbol findfont 5 scalefont setfont} def
X
X%*
X%*   "Labels" are the numbers which index the R & X circles; "Lvalues"
X%*   are the actual label values; "Regions", "Minordiv", and
X%*   "Majordiv" define the boundaries and divisions of the various
X%*   regions within with the same grid density is kept.
X%*
X[(0) (0.1) (0.2) (0.3) (0.4) (0.5) (0.6) (0.7) (0.8) (0.9)
X (1.0) (1.2) (1.4) (1.6) (1.8) (2.0) (3.0) (4.0) (5.0)
X (10) (20) (50)] /Labels exch def
X[0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0 1.2 1.4
X 1.6 1.8 2.0 3.0 4.0 5.0 10 20 50] /Lvalues exch def
X[ 0  0.2   0.5   1     2     5    10    20    50 ] /ZRegions exch def
X   [ 0.01  0.02  0.05  0.1   0.2   1     2    10 ] /ZMinordiv exch def
X   [ 5     5     2     2     5     5     5    5  ] /ZMajordiv exch def
X[ 0  1     2     4    10    20    50 ] /YRegions exch def
X   [ 0.1  0.2  0.5     1     5    30 ] /YMinordiv exch def
X   [ 5     5     2     6     2     1 ] /YMajordiv exch def
X/minorinc 0 def
X/majorinc 0 def
X
X/Unitradius 3.25 72 mul def	% Radius of rho=1 circle
X				% (also used for general scaling)
X/Coeffradius 3.375 72 mul def	% Radius of angle circle
X/Waveradius  3.625 72 mul def	% Radius of wavelength circle
X
X%*****  r x RXtoUV v u
X%*
X%*   Converts Z space (r + jx) to gamma space (u + jv)
X%*
X/RXtoUV {
X  /xtmp exch def   /rtmp exch def
X  rtmp rtmp mul xtmp xtmp mul add rtmp 2 mul add 1 add /dtmp exch def
X  rtmp rtmp mul xtmp xtmp mul add 1 sub dtmp div
X  xtmp 2 mul dtmp div
X} def
X
X%*****  r x  AngR  thetaR
X%*
X%*   Finds the angle of the line from the center of the R=r circle to (r + jx)
X%*
X/AngR {
X  /xa exch def   /ra exch def
X  ra xa RXtoUV
X  exch ra ra 1 add div sub atan
X} def
X
X%***** r x  AngX  thetaX
X%*
X%*   Finds the angle of the line from the center of the X=x circle to (r + jx)
X%*
X/AngX {
X  /xa exch def   /ra exch def
X  ra xa RXtoUV
X  1 xa div sub exch 1 sub atan
X} def
X
X%***** u v radius ang1 ang2  Doarc  -
X%*
X%*   Guess.
X%*
X/Doarc {
X  5 -1 roll Unitradius mul
X  5 -1 roll Unitradius mul
X  5 -1 roll Unitradius mul
X  5 -2 roll
X  arc stroke
X} def
X
X%***** r x1 x2  DrawRarc  -
X%*
X%*   Right again.
X%*
X/DrawRarc {
X  /xx2 exch def  /xx1 exch def  /rr exch def
X
X  rr dup 1 add div /u0 exch def
X  /v0 0 def
X  1 rr 1 add div /radius exch def
X
X  rr xx1 AngR /theta1 exch def
X  rr xx2 AngR /theta2 exch def
X  u0 v0 radius theta1 theta2 Doarc
X} def
X
X%***** x r1 r2  DrawXarc  -
X%*
X%*   Hey!  3 for 3!
X%*
X/DrawXarc {
X  /rr2 exch def  /rr1 exch def  /xx exch def
X
X  /u0 1 def
X  1 xx div /v0 exch def
X  1 xx div abs /radius exch def
X
X  rr1 xx AngX /theta1 exch def
X  rr2 xx AngX /theta2 exch def
X  u0 v0 radius theta1 theta2 Doarc
X} def
X
X%*****  Doblock
X%*
X%*   Draws a grid block bounded by (r1 + jx1) and (r2 + jx2)
X%*
X/Doblock {
X  /rtics 0 def
X  r1 minorinc add minorinc r2 minorinc 2 div add {
X    /r exch def
X    rtics 1 add dup /rtics exch def
X    majorinc mod 0 eq {0.5 setlinewidth} {0 setlinewidth} ifelse
X    r x2 x1 DrawRarc
X    r x1 neg x2 neg DrawRarc
X  } for
X
X  /xtics 0 def
X  x1 minorinc add minorinc x2 minorinc 2 div add {
X    /x exch def
X    xtics 1 add dup /xtics exch def
X    majorinc mod 0 eq {0.5 setlinewidth} {0 setlinewidth} ifelse
X    x r1 r2 DrawXarc
X    x neg r2 r1 DrawXarc
X  } for
X} def
X
X%***** regions minordiv majordiv  Doimmittance  -
X%*
X%*   Draws the R & X (or G & B) circles
X%*
X/Doimmittance {
X  /Majordiv exch def  /Minordiv exch def  /Regions exch def
X  0 1 Minordiv length 1 sub {/index exch def
X
X    Minordiv index get /minorinc exch def
X    Majordiv index get /majorinc exch def
X
X    0 /r1 exch def				% wings
X    Regions index 1 add get /r2 exch def
X    Regions index get /x1 exch def
X    Regions index 1 add get /x2 exch def
X    Doblock
X
X    Regions index get /r1 exch def		% trunk
X    Regions index 1 add get /r2 exch def
X    0 /x1 exch def
X    Regions index get /x2 exch def
X    index 7 eq {majorinc 3 def} if	% yukky hack
X    Doblock
X  } for
X
X  0.5 setlinewidth
X  Unitradius neg 0 moveto Unitradius 0 lineto stroke
X  0 0 Unitradius 0 360 arc stroke
X  50 10000 0  DrawRarc
X  50 0 -10000 DrawRarc
X  50 0 10000  DrawXarc
X  -50 10000 0 DrawXarc
X  newpath 0 0 2 0 360 arc
X  currentgray 1 setgray fill setgray 0 setlinewidth
X  0 0 2 0 360 arc stroke
X  0 0 0.25 0 360 arc stroke
X
X} def
X
X%***** x y label  Dorightstring  -
X%*
X%*  Right-justifies "label" and writes it on a white background
X%*
X/Dorightstring {
X  /lab exch def  /yl exch def  /xl exch def
X  lab stringwidth pop /wid exch def
X  newpath  xl yl moveto
X	   wid neg 0 rlineto
X           0 5 rlineto
X           wid 0 rlineto
X           0 -5 rlineto
X  closepath currentgray 1 setgray fill
X  xl yl moveto wid neg 1 rmoveto setgray lab show
X} def
X
X%*****  x y label  Doleftstring  -
X%*
X%*   Left-justifies "label" and writes it on a white background
X%*
X/Doleftstring {
X  /lab exch def  /yl exch def  /xl exch def
X  lab stringwidth pop /wid exch def
X  newpath  xl yl moveto
X           wid 0 rlineto
X           0 5 rlineto
X           wid neg 0 rlineto
X           0 -5 rlineto
X  closepath currentgray 1 setgray fill
X  xl yl 1 add moveto setgray lab show
X} def
X
X%***** -  DoLabels  -
X%*
X%*   Writes all the numbers within the R-X area
X%*
X/DoLabels {
X  1 1 Lvalues length 1 sub { dup
X    Labels exch get /label exch def
X    Lvalues exch get /x exch def
X    0 x RXtoUV exch atan
X    gsave rotate Unitradius 1 sub 1 label Dorightstring grestore
X    0 x neg RXtoUV exch atan 180 add
X    gsave rotate Unitradius 1 sub neg 1 label Doleftstring grestore
X    x 0 RXtoUV pop Unitradius mul neg
X    gsave 90 rotate 1 add 2 exch label Doleftstring grestore
X  } for
X
X  2 2 10 { dup
X    Labels exch get /label exch def
X    Lvalues exch get /x exch def
X    x 1 RXtoUV Unitradius mul exch Unitradius mul exch
X    gsave translate x 1 AngX 180 add rotate
X          1 1 label Doleftstring grestore
X    x -1 RXtoUV Unitradius mul exch Unitradius mul exch
X    gsave translate x -1 AngX rotate
X          -1 1 label Dorightstring grestore
X    1 x RXtoUV Unitradius mul exch Unitradius mul exch
X    gsave translate 1 x AngR rotate
X          -1 1 label Dorightstring grestore
X    1 x neg RXtoUV Unitradius mul exch Unitradius mul exch
X    gsave translate 1 x neg AngR 180 add rotate
X          1 1 label Doleftstring grestore
X  } for
X
X} def
X
X%*
X%*   Draws the R & X (impedance) circles
X%*
X/DoRX {
X  ZRegions ZMinordiv ZMajordiv Doimmittance DoLabels
X} def
X
X%*
X%*   Draws the G & B (admittance) circles in gray
X%*
X/DoGB {
X  gsave
X    currentdash [1 1] 0 setdash
X    180 rotate
X    YRegions YMinordiv YMajordiv Doimmittance DoLabels
X    setdash
X  grestore
X} def
X
X%*****  string radius radial  Doperp  -
X%*
X%*   Writes "string" centered at the point which is "radial" units, along
X%*   the angle "radial", from the center.
X%*
X/Doperp {
X  gsave rotate 0 translate -90 rotate
X  dup stringwidth pop 2 div neg 0 moveto show grestore
X} def
X
X%*****  angle  FindTCrad  radius
X%*
X%*   A messy hack which finds the distance from the (-1,0) to the
X%*   coefficient angle circle.
X%*
X/FindTCrad {/th exch def
X  th sin Unitradius mul Coeffradius div
X  dup dup mul neg 1 add sqrt div 1 atan
X  180 th sub exch sub sin Coeffradius mul th sin div
X} def
X
X%*****  Docoeffcircle
X%*
X%*   Draws and labels the coefficient angle circle.
X%*
X/Docoeffcircle {
X  0 setlinewidth 0 setgray
X  0 0 Coeffradius 0 360 arc stroke
X  gsave
X  0 2 178 { pop
X    Coeffradius neg 0 moveto -2 0 rlineto stroke
X    Coeffradius 0 moveto 2 0 rlineto stroke
X    2 rotate
X  } for
X  grestore
X  /str 20 string def
X  20 10 170 { dup dup
X    str cvs exch Coeffradius 3 add exch Doperp
X    neg dup str cvs exch Coeffradius 3 add exch Doperp
X  } for
X  (180) Coeffradius 3 add 180 Doperp
X  Symfont (\261) Coeffradius 3 add 181.5 Doperp Helvfont
X
X  gsave Unitradius neg 0 translate
X  90 -1 1 {/thet exch def
X    thet FindTCrad /TCrad exch def
X    gsave thet rotate TCrad 0 moveto -3 0 rlineto stroke
X    thet 10 ge thet 5 mod 0 eq and {
X      TCrad 2 sub -4 moveto thet str cvs 
X      dup stringwidth pop neg 0 rmoveto show
X    } if
X    grestore
X    gsave 180 thet sub rotate TCrad neg 0 moveto 3 0 rlineto stroke
X    thet 10 ge thet 5 mod 0 eq and {
X      TCrad neg 1 add -4 moveto thet neg str cvs show
X    } if
X    grestore
X  } for
X  grestore
X  0.5 setlinewidth 0 0 Coeffradius Waveradius add 2 div 0 360 arc stroke
X  0 setlinewidth Coeffradius 3 sub 0 moveto 3 0 rlineto stroke
X} def
X
X%***** Dowavecircle
X%*
X%*   Draws and labels the wavelength circle.
X%*
X/Dowavecircle {
X  /str 20 string def
X  0 setlinewidth 0 setgray
X  0 0 Waveradius 0 360 arc stroke
X  /lstep 180 125 div def
X  1 1 250 {/ix exch def
X    gsave ix lstep mul rotate
X    Waveradius 2 add neg 0 moveto 4 0 rlineto stroke grestore
X    ix 5 mod 0 eq ix 16 gt and {
X      ix 250 eq {0} {ix} ifelse
X      500 div str cvs dup
X      gsave ix lstep mul rotate Waveradius 7 sub neg 0 translate 90 rotate
X      dup stringwidth pop 2 div neg 0 moveto show grestore
X      gsave ix lstep mul neg rotate Waveradius 3 add neg 0 translate 90 rotate
X      dup stringwidth pop 2 div neg 0 moveto show grestore
X    } if
X  } for
X  0.5 setlinewidth
X  0 0 Waveradius dup Coeffradius sub 2 div add 0 360 arc stroke
X  0 setlinewidth
X} def
X
X%*
X%*   The following three procedures were stolen from the Adobe
X%*   "Blue book".  Together, they place a string along an arc.
X%*
X/pi 3.141592654 def
X/findhalfangle {
X  stringwidth pop 2 div 2 xrad mul pi mul div 360 mul
X} def
X/outsideplacechar {
X  /char exch def  /halfangle char findhalfangle def
X  gsave
X    halfangle neg rotate rad 0 translate -90 rotate
X    char stringwidth pop 2 div neg 0 moveto char show
X  grestore
X  halfangle 2 mul neg rotate
X} def
X%*****  string pointsize centerangle radius  outsidecircletext  -
X/outsidecircletext {
X  /rad exch def  /centerangle exch def
X  /ptsize exch def  /str exch def
X  /xrad rad ptsize 4 div add def
X  gsave
X    centerangle str findhalfangle add rotate
X    str {/charcode exch def ( ) dup 0 charcode put outsideplacechar } forall
X  grestore
X} def
X
X%***** Docircletext
X%*
X%*   Draws all the text which is written along an arc.  What a mess.
X%*
X/Docircletext {
X  (ANGLE OF TRANSMISSION COEFFICIENT IN DEGREES)
X  5 0 Coeffradius 7 sub outsidecircletext
X  (ANGLE OF REFLECTION COEFFICIENT IN DEGREES)
X  5 0 Coeffradius 3 add outsidecircletext
X  (\320> WAVELENGTHS TOWARD GENERATOR \320>)
X  5 166 Waveradius 3 add outsidecircletext
X  (<\320 WAVELENGTHS TOWARD LOAD <\320)
X  5 -166.5 Waveradius 7 sub outsidecircletext
X  /a1 164 def  /u1 a1 cos def  /v1 a1 sin def
X  /a2 108 def  /u2 a2 cos def  /v2 a2 sin def
X  /r Unitradius 0.940 mul def
X  newpath
X    u1 r mul 1 sub v1 r mul 1 sub moveto
X    u1 5 mul v1 5 mul rlineto
X    0 0 r 5 add a1 a2 arcn
X    u2 5 mul neg u2 5 mul neg rlineto
X    0 0 r 1 sub a2 a1 arc
X  closepath currentgray 1 setgray fill setgray
X  (INDUCTIVE REACTANCE COMPONENT \(+jX/Zo\), \
XOR CAPACITIVE SUSCEPTANCE \(+jB/Yo\))
X  5 136 r outsidecircletext
X  gsave 1 -1 scale
X  newpath
X    u1 r mul 1 sub v1 r mul 1 sub moveto
X    u1 5 mul v1 5 mul rlineto
X    0 0 r 5 add a1 a2 arcn
X    u2 5 mul neg u2 5 mul neg rlineto
X    0 0 r 1 sub a2 a1 arc
X  closepath currentgray 1 setgray fill setgray
X  grestore
X  (CAPACITIVE REACTANCE COMPONENT \(-jX/Zo\), \
XOR INDUCTIVE SUSCEPTANCE \(-jB/Yo\))
X  5 -136 r outsidecircletext
X  /u1 Unitradius 0.800 mul neg def
X  (RESISTANCE COMPONENT \(R/Zo\), OR CONDUCTANCE COMPONENT \(G/Yo\))
X  dup stringwidth pop /u2 exch u1 add def
X  newpath
X    u1 -15 moveto
X    u1 -10  lineto
X    u2 -10  lineto
X    u2 -15 lineto
X  closepath currentgray 1 setgray fill setgray
X  u1 1 add -14 moveto show
X  0 setgray
X} def
X
X%*
X%*   These arrays define most of the nomograph lines.  This was the
X%*   fastest way to grind these out (no, really).  The "...labels" array
X%*   gives the values which should be placed along the axis; the "...divs"
X%*   and "...breaks" define the distance between tics, and where the distance
X%*   changes, respectively.
X%*
X/Swrlabels [1.1 1.2 1.4 1.6 1.8 2 2.5 3 4 5 10 20 40 100] def
X/Swrbreaks [1.05 1.2 3 4 5 10 20 40 100] def
X/Swrdivs   [0.05 0.1 0.2 0.5 1 2 10 60] def
X
X/Dbslabels [1 2 3 4 5 6 8 10 15 20 30 40] def
X/Dbsbreaks [0.5 6 20 30 40] def
X/Dbsdivs   [0.5 1 2 5] def
X
X/Attlabels [1 2 3 4 5 7 10 15] def
X/Attbreaks [0.2 5 10 15] def
X/Attdivs  [0.2 0.5 1] def
X
X/Swllabels [1.1 1.2 1.3 1.4 1.6 1.8 2 3 4 5 10 20] def
X/Swlbreaks [1.02 1.2 1.4 2 3 5 10 20 50] def
X/Swldivs   [0.02 0.05 0.1 0.2 0.5 1 5 30] def
X
X/Rldblabels [0 1 2 3 4 5 6 7 8 9 10 12 14 20 30] def
X/Rldbbreaks [0.2 6 10 20 30] def
X/Rldbdivs   [0.2 0.5 1 2] def
X
X/Rcplabels [0.01 0.05 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1] def
X/Rcpbreaks [0.005 .01 0.1 0.5 1] def
X/Rcpdivs   [0.005 0.01 0.02 0.05] def
X
X/Rfllabels [0.1 0.2 0.4 0.6 0.8 1 1.5 2 3 4 5 6 10 15] def
X/Rflbreaks [0.02 0.1 0.2 2 4 6 10 15] def
X/Rfldivs   [0.02 0.05 0.1 0.2 0.5 1 5] def
X
X/Swplabels [1.1 1.2 1.3 1.4 1.5 1.6 1.7 1.8 1.9 2 2.5 3 4 5 10] def
X/Swpbreaks [1.02 1.5 2 3 4 5 10] def
X/Swpdivs   [0.02 0.05 0.1 0.2 0.5 1] def
X
X/Rclabels [0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1] def
X/Rcbreaks [0 1] def
X/Rcdivs   [0.02] def
X
X/Tcplabels [0.99 0.95 0.9 0.8 0.7 0.6 0.5 0.4 0.3 0.2 0.1 0] def
X/Tcpbreaks [0.05 5 0.9 0.99 0.995] def
X/Tcpdivs   [0.05 0.02 0.01 0.005] def
X
X/Tclabels [1 1.1 1.2 1.3 1.4 1.5 1.6 1.7 1.8 1.9 2] def
X/Tcbreaks [1 2] def
X/Tcdivs   [0.02] def
X
X%*
X%*   The following functions translate the various quantities to the
X%*   corresponding value of rho.
X%*
X/swr-rho {dup 1 sub exch 1 add div} def		  % Standing-wave ratio
X/dbs-rho {20 div 10 exch exp swr-rho} def	  % 10 log (SWR)
X/att-rho {-10 div 10 exch exp} def		  % Attenuation [dB]
X/swl-rho {dup 1 sub exch 1 add div sqrt} def	  % Standing-wave loss coeff
X/rldb-rho {-20 div 10 exch exp} def		  % Return loss [dB]
X/rcp-rho {0 exch dup 0 ge {exch} if pop sqrt} def % Reflection coeff [dB]
X/tcp-rho {1 sub neg rcp-rho} def		  % (Trans. coeff.)^2
X/rfl-rho {-10 div 10 exch exp tcp-rho} def	  % Reflection loss (a.k.a.
X						  %   mismatch loss) [dB]
X/swp-rho {dup mul swr-rho} def			  % Standing-wave peak
X/tc-rho {1 sub} def				  % A hack :-)
X
X%***** labels brks divs qty-rho lineside direction name  Donomoline  -
X%*
X%*   Does the nomograph line "name" according to "labels", "brks", and
X%*   "divs", on the [left,right] side according to "direction", and on
X%*   the [top/bottom] side according to "lineside".
X%*
X/Donomoline {
X  /name exch def     /direction exch def  /lineside exch def
X  /qty-rho exch def  /divs exch def       /breaks exch def
X  /labels exch def
X
X  /fullscale Unitradius direction mul def
X  /tic 2 lineside mul def
X  0 0 moveto 0 2 rlineto stroke
X  fullscale 0 moveto 0 tic rlineto stroke
X
X  0 1 divs length 1 sub {/ix exch def
X    breaks ix get divs ix get breaks ix 1 add get {
X      qty-rho cvx exec fullscale mul 0 moveto 0 tic rlineto stroke
X    } for
X  } for
X
X  0 1 labels length 1 sub {
X    labels exch get dup qty-rho cvx exec fullscale mul 0 moveto
X    0 lineside 0 gt {3} {-7} ifelse rmoveto
X    str cvs dup stringwidth pop 2 div neg 0 rmoveto show
X  } for
X
X  fullscale 0 moveto 0.05 fullscale mul 0 rlineto stroke
X  gsave
X    fullscale 1.05 mul 0 translate 45 direction mul rotate
X    0 0 moveto 0.22 fullscale mul 0 lineto stroke
X    lineside 0 gt {3} {-3} ifelse direction mul
X    lineside 0 gt {1} {-5} ifelse moveto
X    direction 0 lt {name stringwidth pop neg 0 rmoveto} if
X    name show
X  grestore
X} def
X
X%*****   -  Donomograph  -
X%*
X%*   Draws all the nomograph scales, taking care of pesky "infinity"
X%*   symbols and other asymmetries.  Very tacky.
X%*
X/Donomograph {
X  0 setlinewidth
X  0 setgray
X  /str 20 string def
X  gsave
X    0 -4.0 72 mul translate
X    0 0 moveto (RADIALLY SCALED PARAMETERS) dup
X      stringwidth pop 2 div neg 0 rmoveto show
X    0.1 Unitradius mul -10 moveto (TOWARD LOAD \320\>) show
X    0.9 Unitradius mul -10 moveto (\<\320 TOWARD GENERATOR)
X      dup stringwidth pop neg 0 rmoveto show
X
X    0 -0.25 72 mul translate
X    0 0 moveto 0 -.5 72 mul lineto stroke
X    Unitradius neg 10 moveto 0 0.65 Unitradius mul rlineto stroke
X    Unitradius 10 moveto 0 0.65 Unitradius mul rlineto stroke
X
X    Unitradius neg 0 moveto Unitradius 0 lineto stroke
X    Swrlabels Swrbreaks Swrdivs (swr-rho) 1 -1 (SWR) Donomoline
X      -4 3 moveto (1) show
X      Symfont Unitradius 3 add neg 3 moveto (\245) show Helvfont
X    Dbslabels Dbsbreaks Dbsdivs (dbs-rho) -1 -1 (dBS) Donomoline
X      -4 -7 moveto (1) show
X      Symfont Unitradius 2 add neg -7 moveto (\245) show Helvfont
X    Attlabels Attbreaks Attdivs (att-rho) 1 1 (ATTEN. [dB]) Donomoline
X    Swllabels Swlbreaks Swldivs (swl-rho) -1 1 (S.W. LOSS COEFF) Donomoline
X      1 -7 moveto (1) show
X      Symfont Unitradius 2 sub -7 moveto (\245) show Helvfont
X
X    0 -0.25 72 mul translate
X    Unitradius neg 0 moveto Unitradius 0 lineto stroke
X    Rldblabels Rldbbreaks Rldbdivs (rldb-rho) 1 -1 (RTN. LOSS [dB]) Donomoline
X      Symfont -4 3 moveto (\245) show Helvfont
X    Rcplabels Rcpbreaks Rcpdivs (rcp-rho) -1 -1 (RFL. COEFF, P) Donomoline
X      -4 -7 moveto (0) show
X    Rfllabels Rflbreaks Rfldivs (rfl-rho) 1 1 (RFL. LOSS [dB]) Donomoline
X      Symfont Unitradius 1 sub 3 moveto (\245) show Helvfont
X      1 3 moveto (0) show
X    Swplabels Swpbreaks Swpdivs (swp-rho) -1 1 (S.W. PEAK \(CONST. P\))
X      Donomoline
X      1 -7 moveto (0) show
X      Symfont Unitradius 1 sub -7 moveto (\245) show Helvfont
X
X    0 -0.25 72 mul translate
X    Unitradius neg 0 moveto Unitradius 0 lineto stroke
X    Rclabels Rcbreaks Rcdivs () 1 -1 (RFL. COEFF, E or I) Donomoline
X    -4 3 moveto (0) show
X    Tcplabels Tcpbreaks Tcpdivs (tcp-rho) 1 1 (TRANSM. COEFF, P) Donomoline
X    1 3 moveto (1) show
X    newpath 0 0 moveto -2 -3 lineto 2 -3 lineto 2 -3 lineto closepath fill
X    0 -8 moveto (CENTER) dup stringwidth pop 2 div neg 0 rmoveto show
X
X    0 -0.25 72 mul translate
X    Unitradius neg 0 moveto Unitradius 0 lineto stroke
X    Tclabels Tcbreaks Tcdivs (tc-rho) 1 1 (TRANSM. COEFF, E or I) Donomoline
X    Unitradius neg 0 translate
X    0 2 98 {
X      dup Unitradius mul 0.01 mul dup 0 moveto 0 2 rlineto stroke
X      exch dup 10 mod 0 eq
X        {exch 3 moveto .01 mul str cvs dup
X         stringwidth pop 2 div neg 0 rmoveto show}
X        {pop pop}
X      ifelse
X    } for
X    newpath 0 0 moveto -2 -3 lineto 2 -3 lineto closepath fill
X    0 -8 moveto (ORIGIN) dup stringwidth pop 2 div neg 0 rmoveto show
X
X  grestore
X} def
X
X%***** Pointarray Zo  Dodots  -
X%*
X%*   Dodots plots specific points on the chart.  The points are supplied
X%*   as triads of unnormalized resistance, unnormalized reactance, and
X%*   a string label to be associated with the point.  The system impedance
X%*   is given by Zo.
X%*
X/Dodots {
X  /znaught exch def  /pointarray exch def
X  pointarray length 3 mod 0 eq {
X    0 3 pointarray length 3 sub { /ix exch def
X      pointarray ix get znaught div
X      pointarray ix 1 add get znaught div
X      RXtoUV Unitradius mul exch Unitradius mul exch 2 copy moveto
X      2 copy 3 0 360 arc currentgray 0 setgray fill setgray
X      moveto 4 -3 rmoveto
X      currentfont
X        /Helvetica-Bold findfont 8 scalefont setfont
X        pointarray ix 2 add get show
X      setfont
X    } for
X  } if
X} def
X
X%*****  title subtitle param1 ... param6  Dotitles  -
X%*
X%*  Prints nice titles at the top of the page.
X%*
X/Dotitles {
X  /fontstash currentfont def
X    /Helvetica findfont 10 scalefont setfont
X    1.5 72 mul 3.6 72 mul moveto show
X    1.5 72 mul 3.74 72 mul moveto show
X    1.5 72 mul 3.88 72 mul moveto show
X    -3.5 72 mul 3.6 72 mul moveto show
X    -3.5 72 mul 3.74 72 mul moveto show
X    -3.5 72 mul 3.88 72 mul moveto show
X    /Helvetica findfont 14 scalefont setfont
X    0 4.1 72 mul moveto dup stringwidth pop 2 div neg 0 rmoveto show
X    /Helvetica-Bold findfont 16 scalefont setfont
X    0 4.4 72 mul moveto dup stringwidth pop 2 div neg 0 rmoveto show
X  fontstash setfont
X} def
X
X
X%DoGB
XDoRX
XDocoeffcircle
XDowavecircle
XDocircletext
XDonomograph
X
X(A Complete Smith Chart)
X(Courtesy of WA3VPZ)
X(Parameter #1)
X(Parameter #2)
X(Parameter #3)
X(Parameter #4)
X(Parameter #5)
X(Parameter #6)
XDotitles
X
X[50 -5 (100 MHz)  35 -7 (200 MHz)
X 25 5 (300 MHz) 20 20 (400 MHz)] 50 Dodots
X
X/#copies 1 def
Xshowpage
E*O*F_smith.ps
Marshall Jose  WA3VPZ
mjj%stda@aplcen.apl.jhu.edu  ||  ...mimsy!aplcen!aplvax!mjj