Title                  :Stereographic Projection Program Version 4.00
Keywords               :Stereographic Projection, CBED, SAD, TEM, AEM, HOLZ
Computer               :IBM PC/XT/AT or compatible
Operating System       :PC-DOS
Programming Language   :BASICA or QUICKBASIC (QUICKBASIC preferred)
Hardware Requirements  :Hewlett Packard HP7470A Plotter required.
Author(s)              :John R. Porter
Correspondence Address :Rockwell International Science Center,
                       :Thousand Oaks, CA 91360.
Abstract:
The program, written in IBM BASICA, plots stereographic projections, CBED and
HOLZ line simulations, and performs axis/angle pair calculations.  Output is to
the screen or a Hewlett Packard HP 7470A Plotter.  Stereographic projections
are drawn to scale for subsequent manipulations with a standard 18cm. Wulff net
and can be plotted for cubic, hexagonal, tetragonal and monoclinic crystal
systems in any orientation.  Plotted poles can be restricted to those allowed
by structure factor considerations (for certain structures) or restricted to
those in certain Laue zones.  The program leads the user through menus to
determine the structure and orientation for the projection, which is then
plotted accordingly.  Version 4.00 is significantly enhanced compared to
earlier versions.  Screen output is improved, more crystal structures are
supported the user interface is more forgiving and the program is faster.
Also, the HOLZ line routine has been modified and should be more accurate.
Title                  :Stereographic Projection Program Version 4.00
Keywords               :Stereographic Projection, CBED, SAD, TEM, AEM, HOLZ
Computer               :IBM PC/XT/AT or compatible
Operating System       :PC-DOS
Programming Language   :BASICA or QUICKBASIC (QUICKBASIC preferred)
Hardware Requirements  :Hewlett Packard HP7470A Plotter required.
Author(s)              :John R. Porter
Correspondence Address :Rockwell International Science Center,
                       :Thousand Oaks, CA 91360.

STERPROJ.SRC is a program for an IBM PC which plots most combinations of
stereographic projections, CBED and HOLZ line simulations and axis/angle pair
calculations for cubic, tetragonal, hexagonal and monoclinic crystals.  Version
4.0 of the program has been significantly enhanced compared with the previous
program available through EMMPDL.  In particular, screen output has been
improved, more crystal systems are incorporated, an easier to use menu
interface has been designed and the program runs faster.

The program is written in IBM BASICA and requires a Hewlett Packard HP 7470A
Plotter connected to an IBM PC or compatible via COM1:.  The communications
parameters should be as described on p. 35 of the HP7470A Plotter
Interconnection Guide (i.e. set dip-switches on plotter for 9600 baud, 7 data
bits, 1 stop bit, no parity - or change program line 4250).  The plotter must
be connected to the computer via a null modem cable.  For screen output, the
IBM color graphics adapter is required.

The ASCII file STERPROJ.SRC can either be used directly by BASICA or
(preferably) compiled by the Microsoft Quickbasic compiler Version 2.0.  If
using Quickbasic, the BCOM.LIB and SPEED options in the compiler menu should be
selected for speed optimization.  The program then must be linked with the
GWCOM.OBJ file supplied on the Quickbasic disk.  After compiling, therefore,
exit Quickbasic and type LINK SP+GWCOM.

To run the compiled program, at the A> prompt, type STERPROJ<RETURN>.  To run
the BASICA mode, at the A> prompt, type BASICA STERPROJ.SRC.  Immediately,
press <CTRL><BREAK> to stop the program and save it again as STERPROJ.BAS by
typing SAVE STERPROJ.  Then run the program.

The program opens to a menu and the selections should be answered in turn
(asterisks indicate questions to be answered).  The program saves information
about crystals in data files with the extension .XTL.  Sample .XTL files are at
the end of this documentation file or the program will make them by selecting
menu choice 2.  Therefore, initially select a crystal by choosing 1 or 2.
Lattice parameter changes can be made in choice 3.  Use item 4 to select
whether output is to the screen or the plotter.  In item 5, select from an
Axis/Angle pair computation, a blank circle (for manual stereographic
projection plots), a CBED pattern simulation, a HOLZ line pattern simulation or
a Stereographic projection.  Not all options are available for output to the
screen, however.

Depending on the selection, further choices need to be made.  There are two
ways to input orientation data for stereographic projections. One option is to
enter the pole which is to appear at the center of a projection and a second
pole which is to appear on the horizontal axis.  More useful, perhaps, to
electron microscopists is the second option which allows you to enter two poles
which are to appear on the circumference of a projection - these correspond to
indexed spots on a diffraction pattern.  Having selected the way the data is to
be entered, the actual orientations are entered in choice 6 from the main menu.

Of interest to people working with convergent beam diffraction patterns is the
ability to plot only those poles which appear in the zero, first and second
order Laue zones.  The program provides this as an option.  The structure
factor parameter "p" is explained in "Practical Analytical Electron Microscopy
in Materials Science" by D. B. Williams on p. 128.  Basically, for certain
orientations of some crystals, structure factor considerations mean that entire
Laue zones will be forbidden.  "p" is a multiplicity factor which tells the
program to consider only every second or third zone.  "p" should be 1 or 2 in
cubic crystals and 1 or 3 in hexagonal crystals.

In item 7, the program will ask you for the highest value of h, k, (i) and l to
plot (3 is recommended for a first try for a stereographic projection, 20 for a
diffraction pattern) and for primitive hexagonal systems the increment for
changing l values (i.e. an increment of 2 will plot l's of say -4, -2, 0, 2, 4
etc.).

Finally, the program will give you the option of manually entering additional
poles.  Experiment!  After confirming that your entry parameters are correct,
the program will proceed to plot the projection on the plotter.  The projection
will be 18 cm in diameter but this can be altered by anyone with knowledge of
BASIC.  Wulff nets and Polar nets of this size can be obtained from N. P. Nies,
969 Skyline Drive, Laguna Beach, CA 92651.  Tel. (714) 494-4619.

Remember that if you make a mistake during program entry, you can reselect a
menu item.  The options are extensive, but one example set of answers is listed
here:

The first choice in the program is to select the crystal.  Select "2<RTN>".
Enter "Aluminum<RTN>", "c"<RTN>", "fcc<RTN>" and "4.05<RTN>" in response to the
questions (do not type the "'s).  The program will store the crystal data in a
file called ALUMINUM.XTL and another time the data can be recalled in choice 1.

Choose 4 and select "s<RTN>" for output to screen.

Choose 5 and select "p<RTN>" for a stereographic projection.  Then "2<RTN>" to
select the data input method (see above).  Then "<RTN>" to NOT select 1st. and
2nd. HOLZ poles only.  (Try that another time).

Now the program requires the Miller indices for a pole which is to appear on
the circumference, in the vicinity of the East pole.  h, k and l will be
selected separately.  Then the exact position is specified by entering the
angle the input pole makes with the horizontal axis by rotation about the
center.  This angle should be less than 90 degrees and counterclockwise is
positive.  Next, the indices of a second pole, located anticlockwise from the
first pole, should be entered.  This uniquely defines the geometry of the
projection.  Note that defaulting any answers in this part of the program
corresponds to entering zero.

Therefore, choose 6 and select "2<RTN>2<RTN><RTN>" for h1k1l1, "<RTN>" for the
rotation angle and "1<RTN>-3<RTN>1<RTN>" for h2k2l2.

Choose 7 and select "2<RTN>" for max hkl.  Select "N<RTN>" to NOT select more
poles.

Choose 8 and a stereographic projection will be plotted for the 1-1-4
orientation selected.  The 220 and 1-31 poles will be on the circumference.
Select "N<RTN>" to return to the main menu.

Go back to item 5 and select "h<RTN>" for HOLZ line simulation.  Default the
next two questions with "<RTN><RTN>"  Go to 7 and select a max hkl of 15 and a
HOLZ parameter, p, of 2.  Replot in 8 and get a HOLZ line simulation for the
1-1-4 orientation.  The choices are numerous!

You can color code for higher order Laue zones - this selection will cause the
program only to plot poles in the zero, first and second order Laue zones.
When plotted, the ZOLZ poles will be black open circles, the FOLZ poles will be
red and the SOLZ poles filled black circles.  Defaulting the question (i.e.
just pressing <RETURN> will plot all poles in the specified range).

Finally - will you wish to plot more poles (say the 7 -3 32 pole)?  If so,
answer Y and follow screen instructions.

Other pathways through the menus are similar.  Of interest could be the option
that appears when selecting a projection for alumina (hexagonal) which plots
facet planes.  For this option, the poles corresponding to the planes on which
alumina is known to facet are plotted instead of a specified range of h, k and
l.

A little more specialized is the axis / angle pair pathway.  Here data for two
crystal orientations is entered, corresponding to two grains. Key poles for
grain 1 are plotted as open circles and for grain 2 as closed circles.  Now you
have to select two poles from grain 1 (a and b) which are to rotate to
equivalent poles (a' and b') in grain 2.  All four poles should be on the
as-plotted projection.  Follow the menu instructions to choose poles a, b, a'
and b'.  Be careful to rotate only to equivalent poles.  i.e. for the hexagonal
{11.0} poles, only rotate red to red and black to black (note that {00.1} poles
are always equivalent and there is no corresponding restriction).

The simulated CBED pattern menus provide similar choices.  The large plotted
circles represent the positions of the HOLZ rings and the small circles the
positions of the reflections.  If no reflections are plotted, there are two
possible explanations that don't involve program error.  First, the specified
range of h, k and l may be too small (up to 50 can be needed in some cases - in
which case plotting can take a long time while the computer completes 1,000,000
iterations of a loop).  Second, if a structure factor calculation is being
performed, the parameter p may need to be entered as 2 or 3.

The following notes make reference to figures 1 and 2.  These figures should be
plotted by printing them to the plotter, using the DOS PRINT command.  The
ASCII code for each figure is at the end of this file between asterisks.  Use
your word processor to mark each block and save each block as an ASCII file
named FIGURE.1 and FIGURE.2 respectively.  Now, there is a small problem.  Each
C in the figure codes must be converted to a <CTRL>C and each H converted to a
<CTRL>H.  Again, use your word processor (Sidekick works well).  Resave the
code.  Then, at the DOS prompt, type PRINT FIGURE.1 and PRINT FIGURE.2.
Respond AUX when asked for the printing device (make sure PRINT.COM is present
on your disk).  If this doesn't work for any reason - write to the address
below for copies of the figures.

The procedures used in writing the program are explained with reference to
figures 1 and 2.  To plot a pole, e.g. hkl in figure 1, a number of values need
to be calculated.  First, the direction u3v3w3 at the center of the projection
is established as a reference together with two poles at the circumference,
h1k1l1 and h2k2l2.  u1v1w1 and u2v2w2 are then the zone axes of h1k1l1 and
h2k2l2 with the plane normal to u3v3w3 (defined as h3k3l3).

For each pole, hkl, the angle the line from the center to hkl makes with the
horizontal x-axis, rho, needs to be determined.  This is done by measuring the
angle uvw (zone axis of hkl and h3k3l3) makes with u1v1w1 (zone axis of h1k1l1
with h3k3l3).  However, rho is calculated from an arccosine formula, which
cannot differentiate between rho and (2 pi - rho).  Therefore a pole in the
upper right hand quadrant is defined, h2k2l2, and angles rho 1 and rho 2 are
calculated in similar ways.  Then the true value of rho can be established by
the requirement that rho = rho 1 + rho 2.

Having established rho, the radial distance of the pole from the center needs
to be established.  Figure 2 shows the geometry of the projection.  The radial
distance is the diameter multiplied by the tangent of theta / 2, where theta is
the interplanar angle between hkl and h3k3l3.

During the execution of the program, all potential poles within a user
specified range are selected.  If certain criterion are met, the pole is
plotted according to the geometrical procedures outlined above.

The extra features of the program (simulated CBED patterns, axis / angle pair
determinations, etc.) make use of the same routines.  Remember, however, that a
simulated diffraction pattern will need to be plotted out to higher maximum
values of h, k and l (probably 20 or higher if poles in HOLZ rings are to be
plotted).

The program itself is extensively documented.  For more information, examine
the BASICA program listing.

In computereze, this program is classified as "Shareware".  In other words, if
you find the program useful, I would like you or your institution to buy it.
In return for a nominal fee ($50.00), the author will provide updates as they
become available, in both compiled and source code form, or make minor
modifications for specific purposes.  Suggestions for changes (or corrections)
would be welcomed.  Contact:-

         John R. Porter,
         2434 Cazaux Place,
         Los Angeles, CA 90068

         (805) 373 4702 - Daytime.

Figure.1 code:
*****
in;sp 1;sc -1400,1400,-1000,1000;
pa 0,0;vs 15;ci 1000;vs;
sr 0.5,1;
pa 0,0;pd 1000,0;pu 0,0;pd 707,707;pu 0,0;pd 0,1000;pu;
pa 0,0;pd -707,707;pu;ci10,pa -850,707;lbu v wC;pa -850,692;lb 2 2 2C;
pa 0,0;ci 10;pa -180,0;lb u v wC;pa -180,-15;lb  3 3 3C;
pa 1000,0; ci 10; lb h k lC;pa 1000,-15; lb  1 1 1C;
pa 707,707; ci 10; lb h k lC;pa 707,692; lb  2 2 2C;
pa 0,-40; lb h k lC;pa 0,-55; lb  3 3 3C;
pa 0,1000; ci 10; pa 0,970; lb u v wC;pa 0,955;lb  1 1 1C;
pa 200,0; pd; aa 0,0,45;pu;
pa 0,0; pd -300,-200;pu; ci 10; lb hklC;pu
pa 0,0; pd 554,-832;pu;ci 10;lb uvwC;pu
pa 0,200;pd; aa 0,0 213;pu -350,350;pd;aa 0,0,168;pu
pa 200,100;lb rho 1C;pa -270,50; lbrhoC;
pa 0,300;pd;aa 0,0,45;pu;pa -220,300;lbrho 1C;pa -620,0;lbrho 2C;
pa -1300,900; sr;lb Figure 1C;
pa -1400,-1000;sp 0;
*****
Figure.2 code
*****
in;sp 1;sc -1400,1400,-1000,1000;
pa 0,0;vs 15;ci 500;vs;
sr 0.5,1;
pa -1100,500;pd 1100,500;pu 0,0;pd 353,353;pu 0,-500;
pd 0,500;pu;pa -500,0; pd 500,0; pa 0,-500;pd -1000,500;pu 0,-500;pd 1000,500;
pu 0,-500;pd 414,500;pu;pa 5,-350;lb0H-/2C; pa 20,50;lbOH-C;
pa 0,100; pd;ar 0,-100,-45;pu 0,-250; pd;ar 0,-250,-22;pu;
pa -50,525;lbh k lC;pa -50,510;lb 3 3 3C;
pa 400,525;lbhklC;pa 950,525;lbh k lC;pa 950,510;lb 1 1 1C;
pu 0,0;ci 10; pa -1300,900; sr;lb Figure 2C; pa -1400,-1000;;sp 0;
*****
The following should be saved as ALUMINA.XTL
*****
"Alumina"
"H"
"Alumina"
4.758
12.991
*****
The following should be saved as ZINC.XTL
*****
"Zinc"
"H"
"cph"
2.664
4.946
*****
Title                  :Stereographic Projection Program Version 4.00
Keywords               :Stereographic Projection, CBED, SAD, TEM, AEM, HOLZ
Computer               :IBM PC/XT/AT or compatible
Operating System       :PC-DOS
Programming Language   :BASICA or QUICKBASIC (QUICKBASIC preferred)
Hardware Requirements  :Hewlett Packard HP7470A Plotter required.
Author(s)              :John R. Porter
Correspondence Address :Rockwell International Science Center,
                       :Thousand Oaks, CA 91360.
*****
10 REM Stereographic Projection Program for Hewlett Packard Plotter
20 REM IBM PC/XT/AT or compatible
30 REM BASICA or QUICKBASIC (QUICKBASIC preferred)
40 REM Hewlett Packard HP 7470A Plotter required for output
50 REM John R. Porter
60 REM Rockwell International Science Center, Thousand Oaks, CA 91360
70 REM Version 4.00
80 REM
90 REM Contact address:-
100 REM
110 REM             John R. Porter
120 REM             Rockwell International Science Center
130 REM             P. O. Box 1085
140 REM             1049 Camino Dos Rios
150 REM             Thousand Oaks, CA 91360
160 REM
170 REM             (805) 373 4702 - work
180 DEFINT N: DEFDBL E
190 DIM A(15,4): DIM B(3): DIM C(4,2): DIM D(7): DIM E(9): H = 0: K = 0: I = 0: L = 0: NMAX = 0: LMAX% = 0: LZ = 0: PI = 4 * ATN(1): NPN = 1: FLAG = 0: LINCR% = 1: RH = 0: RV = 0: CA = 0: LPA = 0: LPC = 0: NC = 0
200 RD = 0: GMAX = 0: G1MIN = 0: G1MAX = 0: G2MIN = 0: G2MAX = 0
210 C$ = CHR$(3): LNF$ = CHR$(10): CR$ = CHR$(13): HOLZ$ = "": HOLZR$ = "": LABEL$ = "":LF$ = "20":  PLOT% = 0
220 DIM NB9(13)
230 DIM NB8(13)
240 DIM NB7(13)
250 DIM NB6(13)
260 DIM NB5(13)
270 DIM NB4(13)
280 DIM NB3(13)
290 DIM NB2(13)
300 DIM NB1(13)
310 DIM N0(13)
320 DIM N1(13)
330 DIM N2(13)
340 DIM N3(13)
350 DIM N4(13)
360 DIM N5(13)
370 DIM N6(13)
380 DIM N7(13)
390 DIM N8(13)
400 DIM N9(13)
410 CLS
420 SCREEN 2
430 WINDOW (0,0)-(640,200)
440 LINE (8,9)-(13,9)
450 LOCATE 25,1:PRINT 9;:GET (8,1)-(16,9),NB9
460 LOCATE 25,1:PRINT 8;:GET (8,1)-(16,9),NB8
470 LOCATE 25,1:PRINT 7;:GET (8,1)-(16,9),NB7
480 LOCATE 25,1:PRINT 6;:GET (8,1)-(16,9),NB6
490 LOCATE 25,1:PRINT 5;:GET (8,1)-(16,9),NB5
500 LOCATE 25,1:PRINT 4;:GET (8,1)-(16,9),NB4
510 LOCATE 25,1:PRINT 3;:GET (8,1)-(16,9),NB3
520 LOCATE 25,1:PRINT 2;:GET (8,1)-(16,9),NB2
530 LOCATE 25,1:PRINT 1;:GET (8,1)-(16,9),NB1
540 CLS
550 LOCATE 25,1:PRINT 0;:GET (8,1)-(16,9),N0
560 LOCATE 25,1:PRINT 1;:GET (8,1)-(16,9),N1
570 LOCATE 25,1:PRINT 2;:GET (8,1)-(16,9),N2
580 LOCATE 25,1:PRINT 3;:GET (8,1)-(16,9),N3
590 LOCATE 25,1:PRINT 4;:GET (8,1)-(16,9),N4
600 LOCATE 25,1:PRINT 5;:GET (8,1)-(16,9),N5
610 LOCATE 25,1:PRINT 6;:GET (8,1)-(16,9),N6
620 LOCATE 25,1:PRINT 7;:GET (8,1)-(16,9),N7
630 LOCATE 25,1:PRINT 8;:GET (8,1)-(16,9),N8
640 LOCATE 25,1:PRINT 9;:GET (8,1)-(16,9),N9
650 CLS
660 SCREEN 0,0,0
670 COLOR 3,1,1: CLS: PRINT: PRINT "         Stereographic Projection for Hewlett Packard Plotter"
680 PRINT: PRINT: PRINT "Choose from:"
690 PRINT:IF NMEN1 = 0 AND NMEN2 = 0 AND NMEN3 = 0 THEN PRINT "* "; ELSE PRINT"  ";
700 PRINT "1 - Retrieve crystal data file" TAB(50) CRYSTAL$
710 IF NMEN1 = 0 AND NMEN2 = 0 AND NMEN3 = 0 THEN PRINT "* "; ELSE PRINT"  ";
720 PRINT "2 - Make crystal data file"
730 IF NMEN1 = 0 AND NMEN2 = 0 AND NMEN3 = 0 THEN PRINT "* "; ELSE PRINT"  ";
740 PRINT "3 - Modify crystal data"
750 IF NMEN4 = 0 THEN PRINT "* "; ELSE PRINT"  ";
760 PRINT "4 - Select output device" TAB(50) DEVICE$
770 IF NMEN5 = 0 THEN PRINT "* "; ELSE PRINT"  ";
780 PRINT "5 - Select output type" TAB(50) TYPE$
790 IF NMEN6 = 0 THEN PRINT "* "; ELSE PRINT"  ";
800 PRINT "6 - Input crystal orientation" TAB(50) H1$;K1$;I1$;L1$ TAB(65) H2$;K2$;I2$;L2$
810 IF NMEN7 = 0 THEN PRINT "* "; ELSE PRINT"  ";
820 PRINT "7 - Select output variables"
830 PRINT "  8 - Plot"
840 PRINT "  0 - Quit"
850 PRINT: INPUT "Make selection: ",NSEL
860 IF NSEL = 1 THEN 960
870 IF NSEL = 2 THEN 1170
880 IF NSEL = 3 THEN 1500
890 IF NSEL = 4 THEN 1560
900 IF NSEL = 5 THEN 1670
910 IF NSEL = 6 THEN 2160
920 IF NSEL = 7 THEN 2450
930 IF NSEL = 8 THEN 2710
940 IF NSEL = 0 THEN PRINT: INPUT"Are you sure (Y/N): ",ANS$: IF ANS$ = "y" OR ANS$ = "Y" THEN SYSTEM ELSE 670
950 GOTO 670
960 CLS: PRINT "         Stereographic Projection for Hewlett Packard Plotter"
970 NMEN1 = 1
980 PRINT: PRINT: FILES "*.xtl":PRINT: PRINT: INPUT "Enter crystal: ",CRYSTAL$
990 OPEN CRYSTAL$ + ".xtl" FOR INPUT AS #2
1000 INPUT #2, CRYSTAL$: INPUT #2, ST$: INPUT #2, SF$: INPUT #2, LPA
1010 IF ST$ = "M" OR ST$ = "O" THEN INPUT #2, LPB
1020 IF ST$ <> "C" THEN INPUT #2, LPC
1030 IF ST$ = "M" THEN INPUT #2, BETA
1040 CLOSE #2
1050 IF SF$ = "" THEN SF% = 0
1060 IF SF$ = "fcc" THEN SF% = 1
1070 IF SF$ = "fct" THEN SF% = 2
1080 IF SF$ = "ooe" THEN SF% = 3
1090 IF SF$ = "dc" THEN SF% = 4
1100 IF SF$ = "bcc" THEN SF% = 5
1110 IF SF$ = "bct" THEN SF% = 6
1120 IF SF$ = "cph" THEN SF% = 7
1130 IF SF$ = "Alumina" THEN SF% = 11
1140 IF SF$ = "SiC" THEN SF% = 12
1150 IF SF$ = "Rutile" THEN SF% = 13
1160 GOTO 670
1170 CLS: PRINT "         Stereographic Projection for Hewlett Packard Plotter"
1180 NMEN2 = 1
1190 PRINT: PRINT: INPUT "Enter crystal: ",CRYSTAL$
1200 OPEN CRYSTAL$ + ".xtl" FOR OUTPUT AS #2
1210 PRINT:PRINT "Enter crystal structure:":PRINT:PRINT "C(ubic)":PRINT "T(etragonal)":PRINT "H(exagonal)":PRINT "O(rthorhombic)":PRINT"M(onoclinic)":PRINT:INPUT "Make selection: ";ST$
1220 IF ST$ = "c" THEN ST$ = "C"
1230 IF ST$ = "t" THEN ST$ = "T"
1240 IF ST$ = "h" THEN ST$ = "H"
1250 IF ST$ = "o" THEN ST$ = "O"
1260 IF ST$ = "m" THEN ST$ = "M"
1270 IF ST$ = "C" OR ST$ = "H" OR ST$ = "M" OR ST$ = "O" OR ST$ = "T" THEN 1280 ELSE 1210
1280 WRITE #2, CRYSTAL$: WRITE #2, ST$
1290 SF$ = "": SF% = 0
1300 IF ST$ = "C" THEN PRINT: INPUT "Enter structure factor (P(rimitive), fcc, bcc or dc(diamond): ";SF$
1310 IF ST$ = "T" THEN PRINT: INPUT "Enter structure factor - P(rimitive), fct, bct, ooe or R(utile): ";SF$
1320 IF ST$ = "H" THEN PRINT: INPUT "Enter structure factor - P(rimitive), cph or A(lumina): ";SF$
1330 IF SF$ = "p" OR SF$ = "P" THEN SF$ = "":SF% = 0
1340 IF SF$ = "FCC" THEN SF$ = "fcc": SF% = 1
1350 IF SF$ = "BCC" THEN SF$ = "bcc": SF% = 5
1360 IF SF$ = "DC" THEN SF$ = "dc": SF% = 4
1370 IF SF$ = "FCT" THEN SF$ = "fct": SF% = 2
1380 IF SF$ = "BCT" THEN SF$ = "bct": SF% = 6
1390 IF SF$ = "CPH" THEN SF$ = "cph": SF% = 7
1400 IF SF$ = "a" OR SF$ = "A" THEN SF$ = "Alumina": SF% = 11
1410 IF SF$ = "s" OR SF$ = "S" THEN SF$ = "Silicon carbide": SF% = 12
1420 IF SF$ = "r" OR SF$ = "R" THEN SF$ = "Rutile": SF% = 13
1430 WRITE #2, SF$
1440 PRINT:INPUT "Enter lattice parameter, a: ",LPA: WRITE #2, LPA
1450 IF ST$ = "M" OR ST$ = "O" THEN INPUT "Enter lattice parameter, b: ",LPB: WRITE #2, LPB
1460 IF ST$ = "T" OR ST$ = "H" OR ST$ = "M" OR ST$ = "O" THEN INPUT "Enter lattice paramete, c: ",LPC: WRITE #2, LPC
1470 IF ST$ = "M" THEN INPUT "Enter angle, beta: ", BETA: BETA = BETA * PI / 180: WRITE #2, BETA
1480 CLOSE #2
1490 GOTO 670
1500 LP = 0: PRINT "Lattice parameter 'a' is currently ";LPA;:INPUT " Enter new value: ",LP: IF LP > 0 THEN LPA = LP
1510 LP = 0: IF ST$ = "O" OR ST$ = "M" THEN PRINT "Lattice parameter 'b' is currently ";LPB;:INPUT " Enter new value: ",LP: IF LP > 0 THEN LPB = LP
1520 LP = 0: IF ST$ <> "C" THEN PRINT "Lattice parameter 'c' is currently ";LPC;:INPUT " Enter new value: ",LP: IF LP > 0 THEN LPC = LP
1530 LP = 0: IF ST$ = "M" THEN PRINT "'beta' currently ";BETA;:INPUT " Enter new value: ",LP: IF LP > 0 THEN BETA = LP
1540 NMEN3 = 1
1550 GOTO 670
1560 CLS: PRINT "         Stereographic Projection for Hewlett Packard Plotter"
1570 NMEN4 = 1:NMEN6 = 0
1580 PRINT:PRINT: INPUT "Output to screen, plotter or both (S, P or B): ",SPB$
1590 IF SPB$ = "s" OR SPB$ = "S" THEN SPB$ = "S": DEVICE$ = "Screen"
1600 IF SPB$ = "p" OR SPB$ = "P" THEN SPB$ = "P": DEVICE$ = "Plotter"
1610 IF SPB$ = "b" OR SPB$ = "B" THEN SPB$ = "B": DEVICE$ = "Screen and plotter"
1620 IF SPB$ <> "S" AND SPB$ <> "P" AND SPB$ <> "B" THEN 1580
1630 IF SPB$ = "S" THEN 1660
1640 GOSUB 4240
1650 CLOSE #1
1660 GOTO 670
1670 CLS: PRINT: PRINT "         Stereographic Projection for Hewlett Packard Plotter"
1680 NMEN5 = 1
1690 PRINT:PRINT"Select:":PRINT
1700 IF SPB$ = "P" THEN IF ST$ = "C" OR ST$ = "T" OR ST$ = "H" THEN PRINT "Axis/angle pair plot (A)"
1710 IF SPB$ = "P" THEN PRINT "Blank circle (B)"
1720 PRINT"Diffraction Pattern (D)": PRINT "HOLZ line pattern (H) ":PRINT "Stereographic Projection (P)"
1730 IF SPB$ = "P" THEN IF ST$ = "C" OR SF% = 11 THEN PRINT "Unit triangle (T)
1740 PRINT: INPUT "Make selection: ",DPSP$
1750 IF DPSP$ = "d" OR DPSP$ = "D" THEN DPSP$ = "D": TYPE$ = "CBED simulation"
1760 IF DPSP$ = "h" OR DPSP$ = "H" THEN DPSP$ = "H": TYPE$ = "HOLZ line simulation"
1770 IF DPSP$ = "p" OR DPSP$ = "P" THEN DPSP$ = "P": TYPE$ = "Stereographic Projection"
1780 IF DPSP$ = "a" OR DPSP$ = "A" THEN DPSP$ = "A": AAP = 0: NMEN7 = 1: TYPE$ = "Axis/angle pair"
1790 IF DPSP$ = "t" OR DPSP$ = "T" THEN DPSP$ = "T": NMEN6 = 1: NMEN7 = 1: TYPE$ = "Unit triangle"
1800 IF DPSP$ = "b" OR DPSP$ = "B" THEN DPSP$ = "B": NMEN6 = 1: NMEN7 = 1: TYPE$ = "Blank Circle"
1810 IF DPSP$ = "A" OR DPSP$ = "B" OR DPSP$ = "D" OR DPSP$ = "H" OR DPSP$ = "P" OR DPSP$ = "T" THEN 1820 ELSE 1690
1820 IF DPSP$ = "B" THEN 2150
1830 IF DPSP$ = "D" OR DPSP$ = "H" THEN PRINT: INPUT "Operating voltage? (default 120) ",KV:PRINT: INPUT "Convergence half-angle (mrad)? (default 10) ",CONANG:PRINT
1840 IF DPSP$ = "D" THEN INPUT "Camera length? (default 1000) ",CAMLEN
1850 IF KV = 0 THEN KV = 120
1860 K120 = SQR(KV * 1000 + KV*KV) / 12.3' reciprocal wavelength
1870 IF CONANG = 0 THEN CONANG = 10
1880 IF DPSP$ = "H" THEN CAMLEN = 100000!/CONANG
1890 IF CAMLEN = 0 THEN CAMLEN = 1000
1900 SCALE = 10 ' CONVERT TO PLOTTER UNITS
1910 LAMDAL = CAMLEN / K120 * SCALE
1920 CONANG = CONANG/1000 ' radians
1930 DRRL = CONANG * K120 ' Disc radius - recip lattice
1940 DR = DRRL * LAMDAL
1950 IF DPSP$ = "H" THEN HOLZ$ = "H"
1960 IF DPSP$ = "P" OR DPSP$ = "A" OR DPSP$ = "T" THEN DR = 10
1970 IF DPSP$ = "D" OR DPSP$ = "H" THEN IP$ = "2": IPUH$ = "H": GOTO 2110
1980 IF DPSP$ = "A" OR DPSP$ = "T" THEN 670
1990 PRINT: INPUT "Select center pole (1) or diffraction pattern data (2): ",IP$
2000 IF IP$ = "1" OR IP$ = "2" THEN 2010 ELSE 1990
2010 IF IP$ = "1" AND ST$ <> "C" THEN PRINT: INPUT "Choose to input direction indices, uvw, or plane normals, hkl (U/H): ",IPUH$ ELSE 2050
2020 IF IPUH$ = "u" THEN IPUH$ = "U"
2030 IF IPUH$ = "h" THEN IPUH$ = "H"
2040 IF IPUH$ <> "U" AND IPUH$ <> "H" THEN 2010
2050 IF ST$ = "H" THEN PRINT: INPUT "Choose to output direction indices, uvw, or plane normals, hkl (U/H): ",OPUH$ ELSE 2100
2060 IF OPUH$ = "u" THEN OPUH$ = "U"
2070 IF OPUH$ = "h" THEN OPUH$ = "H"
2080 IF OPUH$ <> "U" AND OPUH$ <> "H" THEN 2050
2090 IF OPUH$ = "U" THEN 2190
2100 IF DPSP$ <> "D" AND DPSP$ <> "H" THEN IF IP$ = "2" OR ST$ = "C" OR IPUH$ = "U" THEN PRINT: INPUT "Select (H) to color code for HOLZ patterns: ",HOLZ$ ' routine needs u3,v3,w3
2110 IF DPSP$ = "D" THEN HOLZ$ = "H": PRINT: INPUT "Select (H) to display HOLZ rings ",HOLZR$:IF HOLZR$ = "h" THEN HOLZR$ = "H"
2120 IF HOLZR$ <> "H" AND HOLZR$ <> "" THEN 2110
2130 IF HOLZ$ = "h" THEN HOLZ$ = "H"
2140 IF HOLZ$ <> "H" AND HOLZ$ <> "" THEN 2100
2150 GOTO 670
2160 IF DPSP$ = "A" THEN AAP = 0: NC=0
2170 IF DPSP$ = "A" THEN AAP = AAP + 1
2180 IF DPSP$ = "T" THEN PRINT: PRINT"This selection not needed for this output selection":PRINT: INPUT "Press <RTN> to continue",ANS$: GOTO 670
2190 COLOR 3,1,1: CLS: PRINT: PRINT "         Stereographic Projection for Hewlett Packard Plotter"
2200 NMEN6 = 1
2210 IF DPSP$ = "D" THEN POLE$ = " reflection" ELSE POLE$ = " pole"
2220 IF DPSP$ = "A" THEN IP$ = "2": PRINT:PRINT"Enter data for grain ";AAP
2230 IF IPUH$ = "U" THEN PRINT: PRINT "Enter direction indices for"; POLE$ ;" at center of stereogram":PRINT :INPUT;"u = ",U3:INPUT;", v = ",V3:INPUT " , w = ",W3: T3 = -(U3 + V3)
2240 IF IPUH$ = "U" THEN PRINT :PRINT "Enter direction indices for"; POLE$ ;" on right hand horizontal axis":PRINT :INPUT;"u = ",U4:INPUT;", v = ",V4:INPUT " , w = ",W4: T4 = -(U4 + V4): GOTO 2440
2250 IF ST$ <> "H" AND IP$ = "1" THEN PRINT: PRINT "Enter Miller indices for"; POLE$ ;" at center of stereogram" ' Pole at center of projection - cubic
2260 IF ST$ = "H" AND IP$ = "1" THEN PRINT: PRINT "Enter Miller-Bravais indices for"; POLE$ ;" at center of stereogram" ' Pole at center of projection  - hexagonal
2270 IF ST$ <> "H" AND IP$ = "2" THEN PRINT:PRINT "Enter Miller indices for"; POLE$ ;" near RH horizontal axis"
2280 IF ST$ = "H" AND IP$ = "2" THEN PRINT: PRINT "Enter Miller-Bravais indices for"; POLE$ ;" near RH horizontal axis"
2290 PRINT: INPUT; "h = ",H1: INPUT; " , k = ",K1: INPUT " , l = ",L1
2300 I1= - (H1+ K1)
2310 H1$ = STR$(H1):K1$ = STR$(K1):I1$ = STR$(I1):L1$ = STR$(L1)
2320 IF ST$ <> "H" THEN I1$ = ""
2330 IF IP$ = "2" THEN PRINT: PRINT "Enter angle of"; POLE$ ;:INPUT " with horizontal axis (+ve is anticlockwise): ",THETA' applies to diffraction pattern data input only
2340 THETA = THETA * PI / 180
2350 IF ST$ <> "H" AND IP$ = "1" THEN PRINT: PRINT "Enter Miller indices for"; POLE$ ;" on the right hand horizontal axis"
2360 IF ST$ = "H" AND IP$ = "1" THEN PRINT: PRINT "Enter Miller-Bravais indices for"; POLE$ ;" on the right hand horizontal axis"
2370 IF ST$ <> "H" AND IP$ = "2" THEN PRINT: PRINT "Enter Miller indices for"; POLE$ ;" anticlockwise from first "; POLE$
2380 IF ST$ = "H" AND IP$ = "2" THEN PRINT: PRINT "Enter Miller-Bravais indices for"; POLE$ ;" anticlockwise from first"; POLE$
2390 PRINT: INPUT; "h = ",H2: INPUT;" , k = ",K2: INPUT" , l = ",L2
2400 I2= - (H2+ K2)
2410 H2$ = STR$(H2):K2$ = STR$(K2):I2$ = STR$(I2):L2$ = STR$(L2)
2420 IF ST$ <> "H" THEN I2$ = ""
2430 IF AAP = 2 THEN 2880
2440 GOTO 670
2450 IF DPSP$ = "A" OR DPSP$ = "T" THEN PRINT: PRINT"This selection not needed for this output type":PRINT: INPUT "Press <RTN> to continue",ANS$: GOTO 670
2460 NMEN7 = 1
2470 CLS: PRINT: PRINT "         Stereographic Projection for Hewlett Packard Plotter"
2480 IF DPSP$ = "P" AND SF% = 11 THEN PRINT: INPUT "Enter <F> for facet plane indices: ",FACET$
2490 IF FACET$ = "f" THEN FACET$ = "F"
2500 IF FACET$ <> "" AND FACET$ <> "F" THEN 2480
2510 IF FACET$ = "F" THEN EXTRA$ = "N": HOLZ$ = "": GOTO 670
2520 IF DPSP$ = "A" THEN 670
2530 IF ST$ <> "H" THEN PRINT: INPUT "Enter maximum value for h, k, l: ",NMAX
2540 IF ST$ = "H" THEN PRINT: INPUT "Enter maximum value for h, k, i: ",NMAX
2550 IF ST$ = "H" THEN PRINT: INPUT "Enter maximum value for l: ",LMAX%
2560 IF ST$ = "H" THEN IF SF% = 0 AND HOLZ$ <> "H" THEN PRINT: INPUT "Enter increment for l: ",LINCR%
2570 IF HOLZ$ = "H" AND SF% > 0 THEN PRINT: INPUT "Enter HOLZ structure parameter, p: ", NP
2580 IF DPSP$ = "H" AND SF% = 0 THEN PRINT: INPUT "Enter HOLZ ring contributing to pattern: ", NP
2590 IF NP = 0 THEN NP = 1
2600 IF NMAX = 0 THEN NMAX = 2
2610 IF LMAX% = 0 THEN LMAX% = 2
2620 IF LINCR% = 0 THEN LINCR% = 2
2630 IF HOLZ$ = "H" OR SF% > 0 THEN LINCR% = 1
2640 IF ST$ <> "H" THEN LMAX% = NMAX
2650 IF DPSP$ = "H" THEN EXTRA$ = "N" : GOTO 2700
2660 PRINT: PRINT "Will you wish to plot more"; POLE$ ;"s? (Y/N): ";: INPUT "", EXTRA$
2670 IF EXTRA$ = "y" THEN EXTRA$ = "Y"
2680 IF EXTRA$ = "n" THEN EXTRA$ = "N"
2690 IF EXTRA$ = "N" OR EXTRA$ = "Y" THEN 2700 ELSE 2660
2700 GOTO 670
2710 IF SPB$ <> "S" THEN GOSUB 4250
2720 IF SPB$ = "P" AND DPSP$ = "B" THEN GOSUB 10380
2730 IF SPB$ = "P" AND DPSP$ = "B" THEN GOTO 3740
2740 IF NMEN1 = 0 AND NMEN2 = 0 AND NMEN3 = 0 THEN INPUT "Crystal must be selected - Press <RTN> to continue",ANS$: GOTO 670
2750 IF NMEN4 = 0 THEN INPUT "Output device must be selected - Press <RTN> to continue",ANS$: GOTO 670
2760 IF NMEN5 = 0 THEN INPUT "Output style must be selected - Press <RTN> to continue",ANS$: GOTO 670
2770 IF NMEN6 = 0 THEN INPUT "Orientation must be selected - Press <RTN> to continue",ANS$: GOTO 670
2780 IF NMEN7 = 0 THEN INPUT "Output variables must be set - Press <RTN> to continue",ANS$: GOTO 670
2790 CA = LPC/LPA
2800 IF CA = 0 THEN CA = 1
2810 AC2 = 3/(4 * CA*CA) ' 3/4 of inverse square of c/a ratio
2820 ACSQ = 1/(CA*CA) ' inverse square of c/a ratio
2830 ASQ = LPA*LPA: BSQ = LPB*LPB: CSQ = LPC*LPC: COSBETA = COS(BETA): SINBETA = SIN(BETA)
2840 CASQO3 = CA * CA / 3
2850 IF DPSP$ = "T" THEN 3770
2860 IF IPUH$ = "U" THEN GOSUB 6720
2870 IF IP$ = "1" AND IPUH$ <> "U" THEN GOSUB 6780
2880 IF IP$ = "2" THEN GOSUB 6840 ' returns u3v3w3 ((Miller) integers) and h3k3l3 (not integers). uvw are Miller-Bravais zone axis for Hexagonal.
2890 GOSUB 8610 ' compute lhsphi
2900 IF ST$ = "H" THEN HPSQ = NP*NP / (LPA*LPA * (U3*U3 + V3*V3 - U3 * V3) + LPC*LPC * W3*W3) ' H parameter squared
2910 IF ST$ = "C" THEN HPSQ = NP*NP / (LPA*LPA * (U3*U3 + V3*V3 + W3*W3))
2920 IF ST$ = "T" THEN HPSQ = NP*NP / (LPA*LPA * (U3*U3 + V3*V3) + LPC*LPC*W3*W3)
2930 IF ST$ = "O" THEN HPSQ = NP*NP / (LPA*LPA*U3*U3 + LPB*LPB*V3*V3 + LPC*LPC*W3*W3)
2940 IF ST$ = "M" THEN HPSQ = NP*NP / (LPA*LPA*U3*U3 + LPB*LPB*V3*V3 + LPC*LPC*W3*W3 + 2*U3*W3*LPA*LPC*COSBETA)
2950 IF DPSP$ = "D" THEN G1SQ = 2*K120*SQR(HPSQ) - HPSQ: G2SQ = G1SQ*2: GMAX = 1.5: G1MIN = G1SQ * .8: G1MAX = G1SQ * 1.2: G2MIN = G2SQ * .8: G2MAX = G2SQ * 1.2
2960 IF DPSP$ = "H" THEN G1SQ = 2*K120*SQR(HPSQ)- HPSQ: G1MIN = (SQR(G1SQ) - DRRL)^2 * 1.001: G1MAX = (SQR(G1SQ) + DRRL)^2 * .999: X = SQR(G1SQ)/(2*K120): Y = ATN(X/SQR(1-X*X)):HR = CAMLEN*SCALE*TAN(2*Y)
2970 IF AAP = 2 THEN 3030
2980 RH = 0: RV = 0: LABEL$ = ""
2990 GOSUB 10380 ' Draw circle and tick marks or center spot
3000 IF IPUH$ = "U" THEN H = 0: K = 0: L = 0
3010 IF IPUH$ = "H" THEN H = H3: K = K3: L = L3
3020 IF ST$ = "C" THEN H = H3: K = K3: L = L3
3030 IF IP$ = "2" THEN H = U: K = V: I = -(H+K): L = W ' center pole - plane with indices uvw
3040 H4 = H:K4 = K: L4 = L:I4 = -(H4 + K4) ' used to prevent subsequent plotting
3050 IF SF% > 0 THEN GOSUB 9680 ' Only plot allowed reflections
3060 IF PLOT% > 0 THEN IF DPSP$ <> "A" AND DPSP$ <> "D" AND DPSP$ <> "H" THEN IF IP$ = "1" AND IPUH$ = "H" OR ST$ = "C" THEN GOSUB 8970 ' Plots point and prints label at center
3070 H = H1: K = K1: L = L1: I = -(H+K)
3080 GOSUB 8660 ' Calculates radial distance RD from center
3090 IF RD > 1005 THEN PRINT"Second"; POLE$ ;" must be less than 90 degrees from first"; POLE$ ;" - re-enter":GOTO 2230
3100 RHO = 0
3110 IF ST$ = "H" THEN GOSUB 8000 ELSE GOSUB 8050 ' Calculates zone axis for pole at center and pole on x-axis
3120 U1 = U: V1 = V: W1 = W
3130 GOSUB 8170 ' compute lhsden
3140 IF IP$ = "1" THEN H = U + H1: K = V + K1: L = W + L1 ' Pole in upper right hand quadrant
3150 IF IP$ = "2" THEN H = H2: K = K2:: L = L2: I = -(H + K)
3160 IF ST$ = "H" THEN GOSUB 8000 ELSE GOSUB 8050
3170 GOSUB 8090 ' Calculate rho1 between u1v1w1 and u2v2w2
3180 RHO1 = RHO
3190 U2 = U: V2 = V: W2 = W
3200 GOSUB 8430
3210 IF DPSP$ = "P" AND IP$ = "2" THEN GOSUB 7000 ' Plot input poles first
3220 FLAG = 1 ' Allows coloring for HOLZ
3230 IF SPB$ = "P" THEN COLOR 4,0,0: CLS
3240 IF FACET$ = "F" THEN GOSUB 5120
3250 IF FACET$ = "F" THEN 3320
3260 IF DPSP$ = "P" THEN GOSUB 4280
3270 IF DPSP$ = "D" THEN IF W3 <> 0 THEN GOSUB 4400 ELSE IF V3 <> 0 THEN GOSUB 4550 ELSE GOSUB 4670
3280 IF DPSP$ = "H" THEN IF W3 <> 0 THEN GOSUB 4790 ELSE IF V3 <> 0 THEN GOSUB 4920 ELSE GOSUB 5020
3290 IF DPSP$ = "A" THEN GOSUB 5390
3300 IF DPSP$ = "A" AND AAP = 1 THEN 2170
3310 IF DPSP$ = "A" THEN 3730
3320 IF SPB$ = "P" THEN COLOR 3,1,1: CLS: PRINT: PRINT "         Stereographic Projection for Hewlett Packard Plotter"
3330 IF EXTRA$ = "N" THEN 3420
3340 EXTRA$ = "EXTRA"
3350 PRINT: PRINT "Input additional "; POLE$ ;"s - input 0,0,0 to end"
3360 PRINT: INPUT; "h = ",H: INPUT; " , k = ",K: INPUT " , l = ",L: I = -(H + K)
3370 IF H = 0 AND K = 0 AND L = 0 THEN 3420
3380 NPM = 0: GOSUB 9360
3390 FLAG = 0
3400 IF DPSP$ <> "D" THEN GOSUB 7270 ELSE LZ = (H * U3 + K * V3 + L * W3)/NP: IF LZ > 2 OR LZ < 0 THEN 3360 ELSE GOSUB 7510
3410 GOTO 3360
3420 IF LINCR% = 1 THEN 3520 ' true for all except hexagonal
3430 H = 0: K = 0: I = 0
3440 FLAG = 1
3450 IF U3 = 0 AND V3 = 0 THEN 3520
3460 FOR L% = -1 TO 1 STEP 2
3470 L = L%
3480 IF HOLZ$ = "H" THEN GOSUB 9340
3490 IF NPM > 2 THEN NPM = 2: PLOT% = 1
3500 GOSUB 7270
3510 NEXT
3520 NPM = 0: GOSUB 9360
3530 IF ST$ = "H" THEN U = (2 * U3 - V3): V = (2 * V3 - U3): W = W3 * 3: GOSUB 9570 ' return Miller-Bravais index for final label
3540 IF ST$ = "H" THEN U3 = U: V3 = V: T3 = -(U3 + V3): W3 = W
3550 H = CINT(U3*100)/100: K = CINT(V3*100)/100: I = CINT(T3*100)/100: L = CINT(W3*100)/100
3560 IF DPSP$ = "D" THEN B$ = " Zone Axis" ELSE B$ = " Projection"
3570 IF SPB$ <> "P" THEN IF ST$ = "H" THEN PRINT B$;" ";U3;" ";V3;" ";-(U3+V3);" ";W3 ELSE PRINT B$;" ";U3;" ";V3;" ";W3
3580 IF SPB$ = "S" THEN INPUT " Plot this projection? ", ANS$: IF ANS$ <> "y" AND ANS$ <> "Y" THEN 3760 ELSE SCREEN 0,0,0: GOSUB 4240
3590 IF SPB$ = "S" THEN CLOSE #1: SPB$ = "P": GOTO 2710
3600 PRINT #1, "PA 800,900;"
3610 PRINT #1, "SR;" ' default type size
3620 LABEL$ = "TITLE":LF$ = "30": GOSUB 8970
3630 PRINT #1, "LB";B$ + CR$ + LNF$ + LNF$ + C$
3640 LA$ = STR$(CINT(LPA*1000)/1000): LB$ = STR$(CINT(LPB*1000)/1000): LC$ = STR$(CINT(LPC*1000)/1000): BETA$ = STR$(CINT(BETA / PI * 1800)/10)
3650 IF ST$ = "M" THEN PRINT #1, "pr 100,0;lba = ";LA$ + CR$ + LNF$;"b = "; LB$ + CR$ + LNF$;"c = ";LC$ + CR$ + LNF$;"beta = ";BETA$ + C$;"pr 3,20;lbo";C$
3660 IF DPSP$ = "P" THEN CA = CINT(CA*1000)/1000: IF ST$ = "H" OR ST$ = "T" THEN B$ = STR$(CA): GOSUB 10620
3670 IF DPSP$ = "D" OR DPSP$ = "H" THEN IF ST$ = "H" OR ST$ = "T" THEN PRINT #1, "pr 100,0;lba = ";LA$ + CR$ + LNF$;"c = ";LC$ + C$
3680 IF DPSP$ = "D" OR DPSP$ = "H" THEN IF ST$ = "C" THEN PRINT #1, "pr 100,0;lba = ";LA$ + C$
3690 IF DPSP$ = "D" OR DPSP$ = "H" THEN KV$ = STR$(KV): PRINT #1, "PA 800,-900;lb";KV$;" kV";C$
3700 PRINT #1, "PA -1380,870;"
3710 PRINT #1, "LB";CRYSTAL$ + C$
3720 IF HOLZ$ = "H" AND DPSP$ <> "H" THEN GOSUB 10640 ' label HOLZ colors
3730 IF DPSP$ = "A" THEN IF BNS$ = "y" OR BNS$ = "Y" THEN GOSUB 10670 ' label rotation axis
3740 GOSUB 10730
3750 CLOSE # 1
3760 SCREEN 0,0,0: GOTO 670
3770 IP$ = "1"' Start of unit triangle routine
3780 POLE$ = "pole"
3790 H1 = 0: K1 = 0: I1 = 0: L1 = 1: H2 = 0: K2 = 1: I2 = -1: L2 = 0: CA = 0: EXTRA$ = "Y": IF ST$ = "C" THEN L2 = 1
3800 IF ST$ = "H" THEN PRINT: INPUT "Choose to output direction indices, uvw, or plane normals, hkl (U/H): ",OPUH$ ELSE 3840
3810 IF OPUH$ = "u" THEN OPUH$ = "U"
3820 IF OPUH$ = "h" THEN OPUH$ = "H"
3830 IF OPUH$ <> "U" AND OPUH$ <> "H" THEN 3800
3840 LAB = 0
3850 PRINT: PRINT "Do you wish to label "; POLE$ ;"s? (Y/N): ";: INPUT "",ANS$
3860 IF ANS$ = "Y" OR ANS$ = "y" THEN LAB = 1
3870 IF ANS$ = "N" OR ANS$ = "n" THEN LAB = 2
3880 IF ANS$ <> "Y" AND ANS$ <> "y" AND ANS$ <> "N" AND ANS$ <> "n" THEN GOTO 3850
3890 IF LAB = 1 THEN INPUT "Angles or indices (A/I): ", ANS$
3900 IF ANS$ = "A" OR ANS$ = "a" THEN LAB = 3
3910 GOSUB 6780 ' Calculate h3, k3, l3
3920 GOSUB 8610
3930 IF ST$ = "H" THEN GOSUB 11190 ' Plot and label unit triangle - hexagonal
3940 IF ST$ = "C" THEN GOSUB 11280 ' Cubic
3950 H = H1: K = K1: L = L1: I = -(H+K)
3960 RHO = 0
3970 IF ST$ = "H" THEN GOSUB 8000 ELSE GOSUB 8050 ' Calculates zone axis for pole at center and pole on x-axis
3980 U1 = U: V1 = V: W1 = W
3990 GOSUB 8170
4000 H = U + H1: K = V + K1: L = W + L1 ' Pole in upper right hand quadrant
4010 IF ST$ = "H" THEN GOSUB 8000 ELSE GOSUB 8050
4020 GOSUB 8090 ' Calculate rho1 between u1v1w1 and u2v2w2
4030 RHO1 = RHO
4040 U2 = U: V2 = V: W2 = W
4050 GOSUB 8430
4060 IF SPB$ = "P" THEN CLS: PRINT: PRINT "         Stereographic Projection for Hewlett Packard Plotter"
4070 EXTRA$ = "EXTRA"
4080 PRINT: PRINT "Input "; POLE$ ;"s - input 0,0,0 to end"
4090 PRINT: INPUT; "h = ",H: INPUT; " , k = ",K: INPUT " , l = ",L: I = -(H + K)
4100 IF H = 0 AND K = 0 AND L = 0 THEN 4170
4110 IF ST$ = "H" AND L < 0 THEN H = -H: K = -K: L = -L: I = -(H + K)
4120 FLAG = 0: PLOT% = 1
4130 GOSUB 7270
4140 IF ST$ = "H" AND OPUH$ = "U" THEN L = LTEMP
4150 IF ST$ = "H" AND PLOT% = 0 THEN K = H: H = I: I = -(H + K): GOTO 4120
4160 GOTO 4090
4170 PRINT
4180 IF ST$ = "H" THEN GOSUB 11240
4190 IF ST$ = "C" THEN GOSUB 11320
4200 CLOSE # 1
4210 GOTO 670
4220 REM *************************************************************
4230 REM BEGINNING OF SUBROUTINES
4240 PRINT: PRINT: INPUT"Set up plotter and press return to continue ",B$
4250 CLOSE #1: OPEN "COM1:9600,S,7,1,RS,CS65535,DS,CD" AS # 1 ' This line is IBM specific and sets up communication parameters at 9600 baud for output port #1
4260 GOSUB 10200 ' Initialize plotter
4270 RETURN
4280 FOR H = -NMAX TO NMAX
4290 FOR K = -NMAX TO NMAX
4300 IF SPB$ = "P" THEN LOCATE 25,65,0: PERCENT% = (H + NMAX + (K + NMAX) / (2 * NMAX + 1)) * 100 /(2 * NMAX + 1): PRINT PERCENT%
4310 HK = H * U3 + K * V3
4320 FOR L% = -LMAX% TO LMAX% STEP LINCR%
4330 L = L%
4340 IF HOLZ$ = "H" THEN LZ = L * W3 + HK: IF LZ > NP * 2 THEN 4360 ELSE IF LZ < 0 THEN 4360 ELSE LZ = LZ / NP
4350 GOSUB 7210
4360 NEXT
4370 NEXT
4380 NEXT
4390 RETURN
4400 VW = V3 / W3 ' CBED routine - w3 <> 0
4410 FOR LZ = 0 TO 2
4420 GOSUB 9340
4430 Z = LZ * NP
4440 FOR H = -NMAX TO NMAX
4450 ZH = (Z - H * U3) / W3
4460 FOR K = -NMAX TO NMAX
4470 L = ZH - VW * K
4480 IF L <> CINT(L) THEN 4510
4490 IF L > LMAX% THEN 4510 ELSE IF L < -LMAX% THEN 4510
4500 GOSUB 7510 ' CBED routine
4510 NEXT
4520 NEXT
4530 NEXT
4540 RETURN
4550 FOR LZ = 0 TO 2 ' v3 <> 0: w3 = 0
4560 GOSUB 9340
4570 Z = LZ * NP
4580 FOR H = -NMAX TO NMAX
4590 K = (Z - H * U3)/V3
4600 IF K <> CINT(K) THEN 4630
4610 FOR L = -LMAX% TO LMAX%
4620 GOSUB 7510
4630 NEXT
4640 NEXT
4650 NEXT
4660 RETURN
4670 FOR LZ = 0 TO 2 ' v3 = 0:w3 = 0
4680 GOSUB 9340
4690 Z = LZ * NP
4700 H = Z / U3
4710 IF H <> CINT(H) THEN 4750
4720 FOR K = -NMAX TO NMAX
4730 FOR L = -LMAX% TO LMAX%
4740 GOSUB 7510
4750 NEXT
4760 NEXT
4770 NEXT
4780 RETURN
4790 LZ = 1 ' Start of HOLZ line subroutines
4800 VW = V3 / W3 ' HOLZ routine - w3 <> 0
4810 GOSUB 9340
4820 FOR H = -NMAX TO NMAX
4830 ZH = (NP - H * U3) / W3
4840 FOR K = -NMAX TO NMAX
4850 L = ZH - VW * K
4860 IF L <> CINT(L) THEN 4890
4870 IF L > LMAX% THEN 4890 ELSE IF L < -LMAX% THEN 4890
4880 GOSUB 7720 ' HOLZ routine
4890 NEXT
4900 NEXT
4910 RETURN
4920 LZ = 1 ' w3 = 0
4930 GOSUB 9340 ' check "p"
4940 FOR H = -NMAX TO NMAX
4950 K = (NP - H * U3)/V3
4960 IF K <> CINT(K) THEN 4990
4970 FOR L = -LMAX% TO LMAX%
4980 GOSUB 7720 ' HOLZ routine
4990 NEXT
5000 NEXT
5010 RETURN
5020 LZ = 1 ' v3 = 0: w3 = 0
5030 GOSUB 9340
5040 H = NP / U3
5050 IF H <> CINT(H) THEN 5090
5060 FOR K = -NMAX TO NMAX
5070 FOR L = -LMAX% TO LMAX%
5080 GOSUB 7720
5090 NEXT
5100 NEXT
5110 RETURN
5120 H = 0: K = 0: L = 6:GOSUB 7210 ' Basal plane - facet plane poles for alumina
5130 L = -6: GOSUB 7210
5140 H = 1: K = 1: L = 0: GOSUB 7210 ' Prism planes
5150 H = -2:GOSUB 7210
5160 H = 1: K = -2: GOSUB 7210
5170 H = -1: K = -1: GOSUB 7210
5180 H = 2: K = -1: GOSUB 7210
5190 H = -1: K = 2: GOSUB 7210
5200 H = -1: K = 0: L = 2: GOSUB 7210 ' Rhombohedral planes
5210 H = 1: K = -1: GOSUB 7210
5220 H = 0: K = 1: GOSUB 7210
5230 H = 1: K = 0: L = -2: GOSUB 7210
5240 H = -1: K = 1: GOSUB 7210
5250 H = 0: K = -1: GOSUB 7210
5260 H = 1: K = 0: L = 4: GOSUB 7210  ' 10-14 type planes
5270 H = -1: K = 1: GOSUB 7210
5280 H= 0: K = -1: GOSUB 7210
5290 H = -1: K = 0: L = -4: GOSUB 7210
5300 H = 1: K = -1: GOSUB 7210
5310 H = 0: K = 1: GOSUB 7210
5320 H = 1: K = 0: L = 1: GOSUB 7210 ' 10-11 type planes
5330 H = -1: K = 1: GOSUB 7210
5340 H = 0: K = -1: GOSUB 7210
5350 K = 1: L = -1: GOSUB 7210
5360 H = -1: K = 0: GOSUB 7210
5370 H = 1: K = -1: GOSUB 7210
5380 RETURN
5390 IF ST$ = "H" THEN GOSUB 5430 ELSE GOSUB 5680 ' Axis/angle pair subroutine
5400 IF AAP = 1 THEN 5420 ELSE PRINT: INPUT "Do you wish to locate a rotation axis? (Y/N): ", BNS$
5410 IF BNS$ = "y" OR BNS$ = "Y" THEN GOSUB 5980 ELSE IF BNS$ = "n" OR BNS$ = "N" THEN 5420 ELSE 5400
5420 RETURN
5430 NPN = 0: H =-1:K=-1: I= 2: L=0: GOSUB 7270 ' plot pole
5440 GOSUB 5870
5450 NC = NC + 1
5460 H =-1:K= 2: I=-1: L=0: GOSUB 7270
5470 GOSUB 5870
5480 NC = NC + 1
5490 H = 2:K=-1: I=-1: L=0: GOSUB 7270
5500 GOSUB 5870
5510 NC = NC + 1
5520 H = 0:K= 0: I= 0: L=1: GOSUB 7270
5530 GOSUB 5870
5540 NC = NC + 1
5550 NPN = 1: H = 1:K=-2: I= 1: L=0: GOSUB 7270
5560 GOSUB 5870
5570 NC = NC + 1
5580 H = 1: K= 1: I=-2: L=0: GOSUB 7270
5590 GOSUB 5870
5600 NC = NC + 1
5610 H =-2:K= 1: I= 1: L=0: GOSUB 7270
5620 GOSUB 5870
5630 NC = NC + 1
5640 H = 0:K= 0: I= 0: L=-1: GOSUB 7270
5650 GOSUB 5870
5660 NC = NC + 1
5670 RETURN
5680 NPN = AAP - 1:H=0:K=0:L=1:GOSUB 7270
5690 GOSUB 5870
5700 NC = NC + 1
5710 L=-1:GOSUB 7270
5720 GOSUB 5870
5730 NC = NC + 1
5740 K=1:L=0:GOSUB 7270
5750 GOSUB 5870
5760 NC = NC + 1
5770 K=-1:GOSUB 7270
5780 GOSUB 5870
5790 NC = NC + 1
5800 H=1:K=0:GOSUB 7270
5810 GOSUB 5870
5820 NC = NC + 1
5830 H=-1:GOSUB 7270
5840 GOSUB 5870
5850 NC = NC + 3
5860 RETURN
5870 A(NC,0) = RHO+THETA: A(NC,1) = PHI ' conversion to standard cubic hkl
5880 IF COS(A(NC,0)) <> 0  THEN A = (1 - COS(A(NC,0))^2)/(COS(A(NC,0))^2)
5890 IF COS(A(NC,1)) <> 0  THEN B = (1 - COS(A(NC,1))^2)/(COS(A(NC,1))^2)
5900 IF COS(A(NC,0)) = 0  THEN A(NC,2) = SQR(B/(1+B)): A(NC,3) = 0: A(NC,4) = SQR(1/(1+B)): GOTO 5930
5910 IF COS(A(NC,1)) = 0  THEN A(NC,2) = SQR(A/(1+A)): A(NC,3) = SQR(1/(1+A)): A(NC,4) = 0: GOTO 5930
5920 A(NC,2) = SQR((B*A)/((1+B)*(1+A))):A(NC,3) = SQR(B/((1+B)*(1+A))):A(NC,4) = SQR(1/(1+B)) ' equivalent h k l in standard cubic projection
5930 IF A(NC,0) > 2 * PI THEN A(NC,2) = -A(NC,2)
5940 IF A(NC,0) > 0 AND A(NC,0) < PI THEN A(NC,2) = -A(NC,2)
5950 IF A(NC,0) > PI / 2 AND A(NC,0) < 3 * PI / 2 THEN A(NC,3) = -A(NC,3)
5960 IF A(NC,1) > PI / 2 THEN A(NC,4) = -A(NC,4)
5970 RETURN
5980 IF ST$ <> "H" THEN 6100
5990 CLS:PRINT"Select poles for rotation axis" ' hexagonal
6000 PRINT:PRINT"Pole 1: -1 -1  2  0":PRINT"Pole 2: -1  2 -1  0":PRINT"Pole 3:  2 -1 -1  0":PRINT"Pole 4:  0  0  0  1":PRINT"Pole 5:  1 -2  1  0":PRINT"Pole 6:  1  1 -2  0":PRINT"Pole 7: -2  1  1  0":PRINT"Pole 8:  0  0  0 -1"
6010 PRINT:INPUT "Select pole a from grain 1 (1-8) ",B(0):INPUT "Select pole b from grain 1 (1-8) ",B(1): INPUT "Select pole a' from grain 2 (1-8) ",B(2): INPUT "Select pole b' from grain 2 (1-8) ",B(3)
6020 IF B(0) < 1 OR B(0) > 8 THEN 5990
6030 IF B(1) < 1 OR B(1) > 8 THEN 5990
6040 IF B(2) < 1 OR B(2) > 8 THEN 5990
6050 IF B(3) < 1 OR B(3) > 8 THEN 5990
6060 GOSUB 6170
6070 PRINT: INPUT "Do you want to plot another? (Y/N): ", ANS$
6080 IF ANS$ = "y" OR ANS$ = "Y" THEN GOTO 5990 ELSE IF ANS$ = "n" OR ANS$ = "N" THEN 6090 ELSE 6070
6090 GOTO 6160
6100 CLS:PRINT"Select poles for rotation axis" ' cubic and tetragonal
6110 PRINT:PRINT"Pole 1:  0  0  1":PRINT"Pole 2:  0  0 -1":PRINT"Pole 3:  0  1  0":PRINT"Pole 4:  0 -1  0":PRINT"Pole 5:  1  0  0":PRINT"Pole 6: -1  0  0"
6120 PRINT:INPUT "Select pole a from grain 1 (1-6) ",B(0):INPUT "Select pole b from grain 1 (1-6) ",B(1): INPUT "Select pole a' from grain 2 (1-6) ",B(2): INPUT "Select pole b' from grain 2 (1-6) ",B(3)
6130 GOSUB 6170
6140 PRINT: INPUT "Do you want to plot another? (Y/N): ", ANS$
6150 IF ANS$ = "y" OR ANS$ = "Y" THEN GOTO 6100 ELSE IF ANS$ = "n" OR ANS$ = "N" THEN 6160 ELSE 6140
6160 RETURN
6170 C(0,0) = A(B(0)-1,2) - A(B(2)+7,2):C(0,1) = A(B(0)-1,3) - A(B(2)+7,3): C(0,2) = A(B(0)-1,4) - A(B(2)+7,4) ' (a - a prime) standard cubic hkl
6180 C(1,0) = A(B(1)-1,2) - A(B(3)+7,2):C(1,1) = A(B(1)-1,3) - A(B(3)+7,3): C(1,2) = A(B(1)-1,4) - A(B(3)+7,4) ' (b - b prime) standard cubic hkl
6190 C(2,0) = C(0,1)*C(1,2) - C(0,2)*C(1,1): C(2,1) = C(0,2)*C(1,0) - C(0,0)*C(1,2): C(2,2) = C(0,0)*C(1,1) - C(0,1)*C(1,0)
6200 IF C(2,2) < 0 THEN C(2,0) = - C(2,0): C(2,1) = - C(2,1): C(2,2) = - C(2,2)
6210 IF ST$ = "C" OR ST$ = "T" THEN 6290
6220 D(0) = (A(2,2) * C(2,0) + A(2,3) * C(2,1) + A(2,4) * C(2,2)) / SQR((A(2,2)^2 + A(2,3)^2 + A(2,4)^2)*(C(2,0)^2 + C(2,1)^2 + C(2,2)^2)) ' cos angle hkl^(2-1-10)
6230 D(1) = (A(1,2) * C(2,0) + A(1,3) * C(2,1) + A(1,4) * C(2,2)) / SQR((A(1,2)^2 + A(1,3)^2 + A(1,4)^2)*(C(2,0)^2 + C(2,1)^2 + C(2,2)^2)) ' cos angle hkl^(-12-10)
6240 D(2) = (A(3,2) * C(2,0) + A(3,3) * C(2,1) + A(3,4) * C(2,2)) / SQR((A(3,2)^2 + A(3,3)^2 + A(3,4)^2)*(C(2,0)^2 + C(2,1)^2 + C(2,2)^2)) ' cos angle hkl^(0001)
6250 D(3) = D(0): D(4) = D(1) ' h and k index - hexagonal
6260 D(5) = -(D(3) + D(4)) ' i index - hexagonal
6270 D(6) = D(2) * CA ' l index - hexagonal
6280 GOTO 6340
6290 D(3) = (A(4,2) * C(2,0) + A(4,3) * C(2,1) + A(4,4) * C(2,2)) / SQR((A(4,2)^2 + A(4,3)^2 + A(4,4)^2)*(C(2,0)^2 + C(2,1)^2 + C(2,2)^2)) ' cos angle hkl^(100)
6300 D(4) = (A(2,2) * C(2,0) + A(2,3) * C(2,1) + A(2,4) * C(2,2)) / SQR((A(2,2)^2 + A(2,3)^2 + A(2,4)^2)*(C(2,0)^2 + C(2,1)^2 + C(2,2)^2)) ' cos angle hkl^(010)
6310 D(5) = 1 ' redundant index
6320 D(6) = (A(0,2) * C(2,0) + A(0,3) * C(2,1) + A(0,4) * C(2,2)) / SQR((A(0,2)^2 + A(0,3)^2 + A(0,4)^2)*(C(2,0)^2 + C(2,1)^2 + C(2,2)^2)) ' cos angle hkl^(001)-cubic
6330 IF ST$ = "T" THEN D(6) = D(6) * CA ' tetragonal - l index
6340 IF ABS(D(3)) < ABS(D(4)) AND ABS(D(3)) < ABS(D(5)) AND ABS(D(3)) < ABS(D(6)) AND ABS(D(3)) > .1 THEN D(7) = ABS(D(3)): FOR J = 3 TO 6: D(J) = D(J)/D(7):NEXT
6350 IF ABS(D(4)) < ABS(D(3)) AND ABS(D(4)) < ABS(D(5)) AND ABS(D(4)) < ABS(D(6)) AND ABS(D(4)) > .1 THEN D(7) = ABS(D(4)): FOR J = 3 TO 6: D(J) = D(J)/D(7):NEXT
6360 IF ABS(D(5)) < ABS(D(3)) AND ABS(D(5)) < ABS(D(4)) AND ABS(D(5)) < ABS(D(6)) AND ABS(D(5)) > .1 THEN D(7) = ABS(D(5)): FOR J = 3 TO 6: D(J) = D(J)/D(7):NEXT
6370 IF ABS(D(6)) < ABS(D(3)) AND ABS(D(6)) < ABS(D(4)) AND ABS(D(6)) < ABS(D(5)) AND ABS(D(6)) > .1 THEN D(7) = ABS(D(6)): FOR J = 3 TO 6: D(J) = D(J)/D(7):NEXT
6380 FOR J = 3 TO 6
6390 D(J) = CINT(D(J)*1000)/1000
6400 NEXT
6410 IF ST$ = "H" THEN PRINT: PRINT"h = ";D(3),"k = ";D(4),"i = ";D(5),"l = ";D(6):PRINT
6420 IF ST$ = "C" OR ST$ = "T" THEN PRINT: PRINT"h = ";D(3),"k = ";D(4),"l = ";D(6):PRINT
6430 COSPHI = C(2,2) / SQR(C(2,0)^2 + C(2,1)^2 + C(2,2)^2)
6440 IF COSPHI >= 1 AND COSPHI < 1.001 THEN PHI = 0: GOTO 6470
6450 IF COSPHI <= - 1 AND COSPHI > -1.001 THEN PHI = PI: GOTO 6470
6460 PHI = PI/2-ATN(COSPHI/SQR(1-COSPHI^2))
6470 RD = 1000 * TAN(PHI/2)
6480 IF C(2,1) = 0 THEN RHO = 0 :GOTO 6530
6490 COSRHO = C(2,1) / SQR(C(2,0)^2 + C(2,1)^2)
6500 IF COSRHO >= 1 AND COSRHO < 1.001 THEN RHO = 0: GOTO 6530
6510 IF COSRHO <= - 1 AND COSRHO > -1.001 THEN RHO = PI: GOTO 6530
6520 RHO = PI/2-ATN(COSRHO/SQR(1-COSRHO^2)): IF C(2,0) > 0 THEN RHO = 2 * PI - RHO
6530 RH = RD * COS (RHO) ' Calculate plotting co-ordinates
6540 RV = RD * SIN (RHO)
6550 IF RH < 1 AND RH > -1 THEN RH = 0
6560 IF RV < 1 AND RV > -1 THEN RV = 0
6570 GOSUB 10770
6580 C(3,0) = A(B(0)-1,3) * C(2,2) - A(B(0)-1,4) * C(2,1) ' a ^ axis (cross product)
6590 C(3,1) = A(B(0)-1,4) * C(2,0) - A(B(0)-1,2) * C(2,2)
6600 C(3,2) = A(B(0)-1,2) * C(2,1) - A(B(0)-1,3) * C(2,0)
6610 C(4,0) = A(B(2)+7,3) * C(2,2) - A(B(2)+7,4) * C(2,1) ' a prime ^ axis (cross product)
6620 C(4,1) = A(B(2)+7,4) * C(2,0) - A(B(2)+7,2) * C(2,2)
6630 C(4,2) = A(B(2)+7,2) * C(2,1) - A(B(2)+7,3) * C(2,0)
6640 COSALPHA = (C(3,0)*C(4,0) + C(3,1)*C(4,1) + C(3,2)*C(4,2))/SQR((C(3,0)^2+C(3,1)^2+C(3,2)^2)*(C(4,0)^2+C(4,1)^2+C(4,2)^2)) ' rotation angle
6650 IF COSALPHA >= 1 AND COSALPHA < 1.001 THEN ALPHA = 0: GOTO 6680
6660 IF COSALPHA <= - 1 AND COSALPHA > -1.001 THEN ALPHA = PI: GOTO 6680
6670 ALPHA = PI/2-ATN(COSALPHA/SQR(1-COSALPHA^2))
6680 ALPHA% = ALPHA * 1800 / PI
6690 ALPHA$ = STR$(ALPHA%/10): GOSUB 10790
6700 PRINT "The rotation angle = ";ALPHA% / 10;" degrees"
6710 RETURN
6720 IF ST$ = "T" THEN H3 = U3: K3 = V3: L3 = W3 / ACSQ: I3 = - (H3 + K3): H1 = U4: K1 = V4: I1 = - (H1 + K1): L1 = W4 / ACSQ ' Pole at center of projection and on right hand axis
6730 IF ST$ <> "H" THEN 6770
6740 H3 = U3: K3 = V3: L3 = W3 / ( 2 * AC2): I3 = - (H3 + K3): H1 = U4: K1 = V4: I1 = - (H1 + K1): L1 = W4 / (2 * AC2): H2 = H1: K2 = K1: I2 = I1: L2 = L1 ' Pole at center of projection and on right hand axis - uvw input
6750 U = 2 * U3 + V3: V = 2 * V3 + U3: W = W3: GOSUB 9620
6760 U3 = U: V3 = V: T3 = -(U3 + V3): W3 = W
6770 RETURN
6780 H3 = H1: L3 = L1: I3 = I1: K3 = K1: H1 = H2: L1 = L2: I1 = I2: K1 = K2 ' See Figure 1
6790 IF ST$ = "C" THEN U3 = H3: V3 = K3: W3 = L3 ' Beam direction - used in HOLZ subroutines and final label
6800 IF ST$ = "H" THEN U3 = H3: V3 = K3: W3 = L3 * 2 * AC2: T3 = -(U3 + V3) ' Beam direction - used in final label
6810 IF ST$ = "T" THEN U3 = H3: V3 = K3: W3 = L3 * ACSQ: T3 = -(U3 + V3) ' Beam direction - used in final label
6820 U = U3: V = V3: W = W3
6830 RETURN
6840 H = H2: K = K2: L = L2: H3 = H1: K3 = K1: L3 = L1 ' temporary assignment
6850 GOSUB 8050 ' Calculate beam direction, u3v3w3 - Miller indices
6860 GOSUB 9130 ' reduce to smallest integers - returns NN
6870 IF NN > 0 THEN U = U / NN: V = V / NN: W = W / NN: T = - (U + V): GOTO 6860
6880 U3 = U: V3 = V: W3 = W: T3 = -(U3 + V3) ' Miller indices used for all crystal systems
6890 IF ST$ = "H" THEN GOSUB 8000 ' Miller-Bravais indices
6900 IF ST$ = "H" THEN GOSUB 9130 ' reduce to smallest integers - returns NN
6910 IF ST$ = "H" AND NN > 0 THEN U = U / NN: V = V / NN: W = W / NN: T = - (U + V): GOTO 6900
6920 IF ST$ = "C" THEN GOSUB 9660 ' indices of plane normal to u3v3w3
6930 IF ST$ = "H" THEN GOSUB 9420
6940 IF ST$ = "T" THEN GOSUB 9440
6950 IF ST$ = "M" THEN GOSUB 9460
6960 IF SF% = 0 THEN GOSUB 9210
6970 IF SF% = 0 AND NN > 0 THEN H = H/NN: K = K/NN: L = L/NN: I = -(H + K)/NN:GOTO 6960
6980 H3 = H:K3 = K:L3 = L:I3 = -(H3+K3)
6990 RETURN
7000 IF SF% > 0 THEN 7050
7010 H = H4: K = K4: L = L4: I = -(H + K) ' Plot poles near center
7020 IF ST$ = "H" THEN GOSUB 8000 ELSE GOSUB 8050 ' Calculate zone axis
7030 IF ST$ <> "C" THEN IF U <> 0 OR V <> 0 OR W <> 0 THEN GOSUB 7350 ELSE RD = 0: GOSUB 8970 ' Plot point near center
7040 IF ST$ = "C" THEN GOSUB 8970
7050 IF IPUH$ = "U" THEN RETURN
7060 H = H1: K = K1: L = L1: I = -(H + K) ' Plot input poles
7070 IF SF% > 0 THEN GOSUB 9680
7080 IF SF% > 0 THEN IF PLOT% = 0 THEN 7120 ELSE 7110
7090 GOSUB 9210 ' reduce hkl's
7100 IF NN > 0 THEN H = H / NN: K = K / NN: L = L / NN: I = - (H + K): GOTO 7090
7110 GOSUB 7340 ' plot poles
7120 H1 = H: K1 = K: L1 = L
7130 H = H2: K = K2: L = L2: I = -(H + K) ' Plot input poles
7140 IF SF% > 0 THEN GOSUB 9680
7150 IF SF% > 0 THEN IF PLOT% = 0 THEN 7190 ELSE 7180
7160 IF DPSP$ <> "D" THEN GOSUB 9210
7170 IF NN > 0 THEN H = H / NN: K = K / NN: L = L / NN: I = - (H + K): GOTO 7160
7180 GOSUB 7340 ' plot poles
7190 H2 = H: K2 = K: L2 = L
7200 RETURN
7210 I = -(H + K): PLOT% = 1: IF H = 0 AND K = 0 AND L = 0 THEN RETURN ' Main subroutine
7220 IF FACET$ = "F" THEN 7340
7230 IF SF% = 0 THEN GOSUB 9210 ' Check indices for divisibility
7240 IF SF% = 0 AND NN > 0 THEN RETURN
7250 IF SF% > 0 THEN GOSUB 9680 ' Only plot allowed reflections
7260 IF PLOT% = 0 THEN RETURN
7270 IF OPUH$ = "U" THEN 7320 ' Second entry point
7280 IF DPSP$ = "A" THEN 7340
7290 IF IP$ = "2" THEN IF H = H1 AND K = K1 AND L = L1 THEN RETURN ' already plotted
7300 IF IP$ = "2" THEN IF H = H2 AND K = K2 AND L = L2 THEN RETURN ' already plotted
7310 IF H = H4 AND K = K4 AND L = L4 THEN RETURN ' already plotted
7320 IF ST$ = "H" AND EXTRA$ <> "EXTRA" THEN IF I > NMAX OR I < -NMAX THEN RETURN
7330 IF OPUH$ = "U" THEN LTEMP = L: L = 2 * CA * CA * LTEMP / 3 ' Find equivalent plane indices
7340 IF ST$ = "H" THEN GOSUB 8000 ELSE GOSUB 8050 ' Calculate zone axis
7350 GOSUB 8660 ' Calculates radial distance
7360 IF DPSP$ = "P" THEN IF RD > 1005 OR PHI = PI THEN RETURN ' ploe would be outside projection
7370 GOSUB 8090 ' Calculates angle RHO between zone axes
7380 GOSUB 8350 ' Calculate zone axis with pole 3
7390 IF U = 0 AND V = 0 AND W = 0 THEN 7950
7400 GOSUB 9090 ' Determine sign of rho
7410 IF DPSP$ = "A" THEN IF RD > 1005 OR PHI = PI THEN RETURN ' ploe would be outside projection
7420 IF ST$ = "H" AND LAB > 0 AND RHO > PI * 2 / 3 THEN PLOT% = 0: RETURN
7430 IF ST$ = "H" AND LAB > 0 THEN IF RHO > PI/3 THEN RHO = 2 * PI / 3 - RHO
7440 IF FLAG = 0 THEN 7470 ' Prevents coloring for HOLZ
7450 IF HOLZ$ = "" THEN IF DPSP$ = "A" THEN GOSUB 10750 ELSE GOSUB 9290 ' Change pen color
7460 IF HOLZ$ = "H" THEN GOSUB 9340
7470 GOSUB 8770 ' Calculates RH and RV
7480 IF OPUH$ = "U" THEN L = LTEMP ' Convert back to direction indices
7490 GOSUB 8970 ' Plot and label
7500 RETURN
7510 I = -(H + K): IF ST$ = "H" THEN IF I > NMAX OR I < -NMAX THEN RETURN ' CBED subroutine
7520 IF ST$ = "H" THEN GSQ = (4 * (H*H + H*K + K*K) / (3 * LPA*LPA)) + (L*L / (LPC*LPC)) ' Hexagonal diffraction pattern
7530 IF ST$ = "C" THEN GSQ = (H*H + K*K + L*L)/(LPA*LPA)
7540 IF ST$ = "T" THEN GSQ = (H*H + K*K)/(LPA*LPA) + L*L/(LPC*LPC)
7550 IF ST$ = "O" THEN GSQ = H*H/(LPA*LPA) + K*K/(LPB*LPB) + L*L/(LPC*LPC)
7560 IF ST$ = "M" THEN GSQ = H*H/(LPA*LPA*SINBETA*SINBETA) + K*K/(LPB*LPB) + L*L/(LPC*LPC*SINBETA*SINBETA) - (2*H*L*COSBETA)/(LPA*LPC*SINBETA*SINBETA)
7570 IF GSQ = 0 THEN RETURN
7580 GHSQ = GSQ - (HPSQ * LZ*LZ)
7590 IF LZ = 0 THEN IF GHSQ > GMAX THEN RETURN
7600 IF LZ = 1 THEN IF GHSQ < G1MIN OR GHSQ > G1MAX THEN RETURN
7610 IF LZ = 2 THEN IF GHSQ < G2MIN OR GHSQ > G2MAX THEN RETURN
7620 RD = LAMDAL * SQR(GHSQ)
7630 IF SF% > 0 THEN GOSUB 9680 ' Only plot allowed reflections
7640 IF PLOT% = 0 THEN RETURN
7650 IF ST$ = "H" THEN GOSUB 8000 ELSE GOSUB 8050 ' Calculate zone axis
7660 GOSUB 8090 ' Calculates angle RHO between zone axes
7670 GOSUB 8350 ' Calculate zone axis with pole 3
7680 GOSUB 9090 ' Determine sign of rho
7690 GOSUB 8770 ' Calculates RH and RV
7700 GOSUB 8970 ' Plot and label
7710 RETURN
7720 I = -(H + K): IF ST$ = "H" THEN IF I > NMAX OR I < -NMAX THEN RETURN ' HOLZ subroutine
7730 IF SF% > 0 THEN GOSUB 9680 ' Only plot allowed reflections
7740 IF PLOT% = 0 THEN RETURN
7750 IF ST$ = "H" THEN GSQ = (4 * (H*H + H*K + K*K) / (3 * LPA*LPA)) + (L*L / (LPC*LPC)) ' Hexagonal diffraction pattern
7760 IF ST$ = "C" THEN GSQ = (H*H + K*K + L*L)/(LPA*LPA)
7770 IF ST$ = "T" THEN GSQ = (H*H + K*K)/(LPA*LPA) + L*L/(LPC*LPC)
7780 IF ST$ = "O" THEN GSQ = H*H/(LPA*LPA) + K*K/(LPB*LPB) + L*L/(LPC*LPC)
7790 IF ST$ = "M" THEN GSQ = H*H/(LPA*LPA*SINBETA*SINBETA) + K*K/(LPB*LPB) + L*L/(LPC*LPC*SINBETA*SINBETA) - (2*H*L*COSBETA)/(LPA*LPC*SINBETA*SINBETA)
7800 IF GSQ = 0 THEN RETURN
7810 IF GSQ < G1MIN OR GSQ > G1MAX THEN RETURN
7820 REM RD = LAMDAL * SQR(GSQ)
7830 X = SQR(GSQ)/(2 * K120): Y = ATN(X/SQR(1-X*X)): RD = CAMLEN*SCALE*TAN(2*Y)
7840 IF ST$ = "H" THEN GOSUB 8000 ELSE GOSUB 8050 ' Calculate zone axis
7850 GOSUB 8090 ' Calculates angle RHO between zone axes
7860 GOSUB 8350 ' Calculate zone axis with pole 3
7870 GOSUB 9090 ' Determine sign of rho
7880 GOSUB 8770 ' RH and RV
7890 GOSUB 8820 ' HOLZ line positions
7900 GOSUB 10570 ' Plot lines
7910 RETURN
7920 IF RHO > PI/3 THEN RHO = 2 * PI / 3 - RHO
7930 IF RHO > PI / 6 THEN RHO = PI / 3 - RHO
7940 RETURN
7950 GOSUB 10750
7960 RHO = 0: PHI = 0: RD = 0: RH = 0:RV = 0
7970 GOSUB 10750
7980 GOSUB 8970
7990 RETURN
8000 U = L * (2*K3 + H3) - L3 * (2*K + H) ' Calculates zone axis - hexagonal - Miller Bravais Notation
8010 V = L3 * (2*H + K) - L * (2*H3 + K3)
8020 W = 3 * (H3*K - H*K3)
8030 T = -(U + V)
8040 RETURN
8050 U = K3 * L - K * L3 ' Calculates zone axis - all systems in Miller notation
8060 V = L3 * H - L * H3
8070 W = H3 * K - H * K3
8080 RETURN
8090 IF ST$ = "C" THEN GOSUB 8320
8100 IF ST$ = "T" THEN GOSUB 8250
8110 IF ST$ = "H" THEN GOSUB 8220
8120 IF ST$ = "M" THEN GOSUB 8280
8130 IF COSRHO >= 1 AND COSRHO < 1.001 THEN RHO = 0: GOTO 8160
8140 IF COSRHO <= - 1 AND COSRHO > -1.001 THEN RHO = PI: GOTO 8160
8150 RHO = PI/2 - ATN(COSRHO/SQR(1-COSRHO^2))
8160 RETURN
8170 IF ST$ = "H" THEN LHSDEN = U1*U1 + V1*V1 + U1*V1 + CASQO3*W1*W1
8180 IF ST$ = "T" THEN LHSDEN = ACSQ * (U1*U1 + V1*V1) + W1*W1
8190 IF ST$ = "M" THEN LHSDEN = ASQ*U1*U1+BSQ*V1*V1+CSQ*W1*W1+2*LPA*LPC*U1*W1*COSBETA
8200 IF ST$ = "C" THEN LHSDEN = U1*U1 + V1*V1 + W1*W1
8210 RETURN
8220 IF U*U + V*V + U*V + CASQO3*W*W = 0 THEN COSRHO = 0: RETURN ' hexagonal
8230 COSRHO = (U1*U + V1*V + (U1*V + V1*U)/2 + CASQO3*W1*W)/SQR(LHSDEN * (U*U + V*V + U*V + CASQO3*W*W))
8240 RETURN
8250 IF U*U+V*V+W*W = 0 THEN COSRHO = 0: RETURN
8260 COSRHO = (ACSQ * (U1*U + V1*V) + W1*W)/SQR(LHSDEN * (ACSQ * (U*U + V*V) + W*W))
8270 RETURN
8280 DENOMSQ = LHSDEN * (ASQ*U*U+BSQ*V*V+CSQ*W*W+2*LPA*LPC*U*W*COSBETA)
8290 IF DENOMSQ = 0 THEN COSRHO = 0: RETURN ' monoclinic
8300 COSRHO = (ASQ*U1*U+BSQ*V1*V+CSQ*W1*W+LPA*LPC*(W1*U+U1*W)*COS(BETA))/SQR(DENOMSQ)
8310 RETURN
8320 IF U*U + V*V + W*W = 0 THEN COSRHO = 0: RETURN ' cubic
8330 COSRHO = (U1*U + V1*V + W1*W)/SQR(LHSDEN * (U*U + V*V + W*W))
8340 RETURN
8350 IF ST$ = "C" THEN GOSUB 8580
8360 IF ST$ = "T" THEN GOSUB 8510
8370 IF ST$ = "H" THEN GOSUB 8480
8380 IF ST$ = "M" THEN GOSUB 8540
8390 IF COSRHO2 >= 1 AND COSRHO2 < 1.001 THEN RHO2 = 0: GOTO 8420
8400 IF COSRHO2 <= - 1 AND COSRHO2 > -1.001 THEN RHO2 = PI: GOTO 8420
8410 RHO2 = PI/2 - ATN(COSRHO2/SQR(1-COSRHO2^2))
8420 RETURN
8430 IF ST$ = "H" THEN LHSDEN2 = U2*U2 + V2*V2 + U2*V2 + CASQO3*W2*W2
8440 IF ST$ = "T" THEN LHSDEN2 = ACSQ * (U2*U2 + V2*V2) + W2*W2
8450 IF ST$ = "M" THEN LHSDEN2 = ASQ*U2*U2+BSQ*V2*V2+CSQ*W2*W2+2*LPA*LPC*U2*W2*COSBETA
8460 IF ST$ = "C" THEN LHSDEN2 = U2*U2 + V2*V2 + W2*W2
8470 RETURN
8480 IF U*U + V*V + U*V + CASQO3*W*W = 0 THEN COSRHO2 = 0: RETURN ' hexagonal
8490 COSRHO2 = (U2*U + V2*V + (U2*V + V2*U)/2 + CASQO3*W2*W)/SQR(LHSDEN2 * (U*U + V*V + U*V + CASQO3*W*W))
8500 RETURN
8510 IF U*U+V*V+W*W = 0 THEN COSRHO2 = 0: RETURN
8520 COSRHO2 = (ACSQ * (U2*U + V2*V) + W2*W)/SQR(LHSDEN2 * (ACSQ * (U*U + V*V) + W*W))
8530 RETURN
8540 DENOMSQ = LHSDEN2 * (ASQ*U*U+BSQ*V*V+CSQ*W*W+2*LPA*LPC*U*W*COSBETA)
8550 IF DENOMSQ = 0 THEN COSRHO2 = 0: RETURN ' monoclinic
8560 COSRHO2 = (ASQ*U2*U+BSQ*V2*V+CSQ*W2*W+LPA*LPC*(W2*U+U2*W)*COSBETA)/SQR(DENOMSQ)
8570 RETURN
8580 IF U*U + V*V + W*W = 0 THEN COSRHO2 = 0: RETURN ' cubic
8590 COSRHO2 = (U2*U + V2*V + W2*W)/SQR(LHSDEN2*(U*U + V*V + W*W))
8600 RETURN
8610 IF ST$ = "H" THEN LHSPHI = H3*H3+K3*K3+H3*K3+AC2*L3*L3
8620 IF ST$ = "C" THEN LHSPHI = H3*H3+K3*K3+L3*L3
8630 IF ST$ = "T" THEN LHSPHI = H3*H3+K3*K3+L3*L3*ACSQ
8640 IF ST$ = "M" THEN LHSPHI = H3*H3/(ASQ)+K3*K3/(BSQ)*(SINBETA)^2+L3*L3/(CSQ)-2*H3*L3/(LPA*LPC)*COSBETA
8650 RETURN
8660 IF ST$ = "H" THEN COSPHI = (H3*H+K3*K+(H3*K+K3*H)/2+AC2*L3*L)/SQR(LHSPHI * (H*H+K*K+H*K+AC2*L*L)) ' hexagonal
8670 IF ST$ = "C" THEN COSPHI = (H3*H+K3*K+L3*L)/SQR(LHSPHI * (H*H+K*K+L*L)) ' cubic
8680 IF ST$ = "T" THEN COSPHI = ((H3*H)+(K3*K)+(L3*L*ACSQ))/SQR(LHSPHI * (H*H+K*K+L*L*ACSQ)) ' tetragonal
8690 IF ST$ <> "M" THEN 8720
8700 DENOMSQ = LHSPHI * (H*H/(ASQ)+K*K/(BSQ)*SINBETA^2+L*L/(CSQ)-2*H*L*COSBETA/(LPA*LPC))
8710 COSPHI = ((H3*H/(ASQ))+(K3*K/(BSQ))*((SINBETA)^2)+(L3*L/(CSQ))-((L3*H+L*H3)*COSBETA)/(LPA*LPC))/SQR(DENOMSQ)
8720 IF COSPHI >= 1 AND COSPHI < 1.001 THEN PHI = 0: GOTO 8750
8730 IF COSPHI <= - 1 AND COSPHI > -1.001 THEN PHI = PI: GOTO 8760
8740 PHI = PI/2-ATN(COSPHI/SQR(1-COSPHI^2))
8750 RD = 1000 * TAN(PHI/2)
8760 RETURN
8770 RH = RD * COS (RHO + THETA) ' Calculate plotting co-ordinates
8780 RV = RD * SIN (RHO + THETA)
8790 IF RH < 1 AND RH > -1 THEN RH = 0
8800 IF RV < 1 AND RV > -1 THEN RV = 0
8810 RETURN
8820 IF RHO + THETA = 0 THEN 8920
8830 E(0) = (HR-RD)/SIN(RHO+THETA) ' y intercept of HOLZ line
8840 E(1) = TAN(PI/2+RHO+THETA) 'slope
8850 E(2) = E(1)*E(1) + 1: E(3) = 2 * E(0) * E(1): E(4) = E(0)*E(0) - (DR*DR) ' a b & c of quadratic
8860 E(5) = E(3)*E(3)-4*E(2)*E(4)
8870 E(6) = (-E(3) + SQR(E(5)))/(2*E(2))'x1
8880 E(7) = E(0) + E(1)*E(6) ' y1
8890 E(8) = (-E(3) - SQR(E(5)))/(2*E(2))'x2
8900 E(9) = E(0) + E(1)*E(8) ' y2
8910 RETURN
8920 E(6) = HR-RD
8930 E(8) = E(6)
8940 E(7) = SQR(DR*DR-E(6)*E(6))
8950 E(9) = -E(7)
8960 RETURN
8970 H$ = STR$(H) ' Prepares plotting label
8980 HS$ = LEFT$(H$,1): HI$ = RIGHT$(H$,LEN(H$)-1)
8990 K$ = STR$(K)
9000 KS$ = LEFT$(K$,1): KI$ = RIGHT$(K$,LEN(K$)-1)
9010 I$ = STR$(I)
9020 IS$ = LEFT$(I$,1): II$ = RIGHT$(I$,LEN(I$)-1)
9030 IF ST$ <> "H" THEN IS$ = "": II$ = ""
9040 L$ = STR$(L)
9050 LS$ = LEFT$(L$,1): LI$ = RIGHT$(L$,LEN(L$)-1)
9060 IF LEN(L$) = 3 THEN LS$ = LS$ + LS$
9070 IF LABEL$ = "TITLE" THEN GOSUB 10920 ELSE GOSUB 10810 ' Plotter instruction
9080 RETURN
9090 IF RHO < RHO1 THEN RHO2 = -RHO2 ' provides sign for angle obtained from arccosine
9100 IF RHO - RHO1 - RHO2 > .01 THEN RHO = 2*PI - RHO
9110 IF RHO - RHO1 - RHO2 < -.01 THEN RHO = 2*PI - RHO
9120 RETURN
9130 NN = 0 ' reduces uvw's to smallest integer values
9140 FOR N = 5 TO 2 STEP -1
9150 IF U/N <> INT(U/N) THEN 9190
9160 IF V/N <> INT(V/N) THEN 9190
9170 IF W/N <> INT(W/N) THEN 9190
9180 NN = N
9190 NEXT
9200 RETURN
9210 NN = 0 ' eliminates the plotting of reducable hkl's
9220 FOR N = 5 TO 2 STEP -1
9230 IF H/N <> INT(H/N) THEN 9270
9240 IF K/N <> INT(K/N) THEN 9270
9250 IF L/N <> INT(L/N) THEN 9270
9260 NN = N
9270 NEXT
9280 RETURN
9290 NPM = H MOD 2 ' Change pen color for even and odd h values
9300 IF NPM = NPN THEN GOTO 9330
9310 NPN = NPM ' Pen number
9320 GOSUB 10750
9330 RETURN
9340 IF LZ <> CINT(LZ) THEN COLOR 13:LOCATE 1,1:PRINT CHR$(7);"An inappropriate value of p is being used": PRINT "Color coding would be incorrect":PRINT:PRINT:GOTO 3750
9350 NPM = LZ
9360 IF NPM = 2 THEN NPM = 0 ' Change pen color for HOLZ
9370 NPM = NPM + 1: IF NPM = 2 THEN NPM = 0
9380 IF NPM = NPN THEN GOTO 9410
9390 NPN = NPM ' Pen number: 0 - red, 1 - black
9400 GOSUB 10750
9410 RETURN
9420 H = U: K = V: L = 2 * CASQO3 * W: I = -(H + K) ' indices of plane normal to uvw - hexagonal
9430 RETURN
9440 H = U: K = V: L = W * (CA*CA) ' indices of plane normal to uvw - tetragonal
9450 RETURN
9460 H = U * ASQ + W * LPC * LPA * COSBETA: K = V * BSQ: L = U * LPC * LPA * COSBETA + W * CSQ ' monoclinic
9470 RETURN
9480 IF H = CINT(H) AND K = CINT(K) AND L = CINT(L) THEN 9530
9490 HA = ABS(H): KA = ABS(K): LA = ABS(L)
9500 IF HA > KA AND HA > LA THEN H = CINT(9 * H / HA): K = CINT(9 * K / HA): L = CINT(9 * L / HA)
9510 IF KA > HA AND KA > LA THEN H = CINT(9 * H / KA): K = CINT(9 * K / KA): L = CINT(9 * L / KA)
9520 IF LA > HA AND LA > KA THEN H = CINT(9 * H / LA): K = CINT(9 * K / LA): L = CINT(9 * L / LA)
9530 GOSUB 9210 ' Reduce to smallest integers
9540 IF NN > 0 THEN H = H / NN: K = K / NN: L = L / NN: I = - (H + K): GOTO 9530
9550 I = - (H + K)
9560 RETURN
9570 IF U = CINT(U) AND V = CINT(V) AND W = CINT(W) THEN 9620
9580 UA = ABS(U): VA = ABS(V): WA = ABS(W)
9590 IF UA > VA AND UA > WA THEN U = CINT(9 * U / UA): V = CINT(9 * V / UA): W = CINT(9 * W / UA)
9600 IF VA > UA AND VA > WA THEN U = CINT(9 * U / VA): V = CINT(9 * V / VA): W = CINT(9 * W / VA)
9610 IF WA > UA AND WA > VA THEN U = CINT(9 * U / WA): V = CINT(9 * V / WA): W = CINT(9 * W / WA)
9620 GOSUB 9130 ' Reduce to smallest integers
9630 IF NN > 0 THEN U = U / NN: V = V / NN: W = W / NN: GOTO 9620
9640 T = - (U + V)
9650 RETURN
9660 H = U: K = V: L = W ' indices of plane normal to uvw - cubic
9670 RETURN
9680 IF SF% < 5 THEN GOSUB 9940 ' Only plot allowed reflections
9690 IF SF% = 5 OR SF% = 6 THEN GOSUB 9990
9700 IF SF% = 7 THEN GOSUB 10010 ' cph
9710 IF SF% = 11 THEN GOSUB 10030 ' Alumina
9720 IF SF% = 12 THEN GOSUB 10090 ' SiC
9730 IF SF% = 13 THEN GOSUB 10130 ' Rutile
9740 IF PLOT% = 0 THEN RETURN
9750 IF DPSP$ = "D" OR DPSP$ = "H" THEN RETURN
9760 GOSUB 9210 ' Check for divisibility
9770 IF NN = 0 THEN RETURN
9780 H = H / NN: K = K /NN: L = L / NN
9790 IF SF% < 5 THEN GOSUB 9940
9800 IF SF% = 5 OR SF% = 6 THEN GOSUB 9990
9810 IF SF% = 7 THEN GOSUB 10010 ' cph
9820 IF SF% = 11 THEN GOSUB 10030 ' Alumina
9830 IF SF% = 12 THEN GOSUB 10090 ' SiC
9840 IF SF% = 13 THEN GOSUB 10130 ' Rutile
9850 H = H * NN: K = K * NN: L = L * NN
9860 IF PLOT% > 0 THEN PLOT% = 0: RETURN
9870 IF SF% < 5 THEN GOSUB 9940
9880 IF SF% = 5 OR SF% = 6 THEN GOSUB 9990
9890 IF SF% = 7 THEN GOSUB 10010 ' cph
9900 IF SF% = 11 THEN GOSUB 10030 ' Alumina
9910 IF SF% = 12 THEN GOSUB 10090 ' SiC
9920 IF SF% = 13 THEN GOSUB 10130 ' Rutile
9930 RETURN
9940 MH = ABS(H MOD 2): MK = ABS(K MOD 2): ML = ABS(L MOD 2) ' fcc structure factor
9950 IF MH = MK AND MH = ML THEN PLOT% = 1 ELSE PLOT% = 0
9960 IF SF% = 4 THEN IF H MOD 2 = 0 AND K MOD 2 = 0 AND L MOD 2 = 0 AND (H + K + L) MOD 4 <> 0 THEN PLOT% = 0
9970 IF SF% = 3 THEN IF MH = 1 AND MK = 1 AND ML = 0 THEN PLOT% = 1 ' tetragonal zirconia structure factor
9980 RETURN
9990 IF (H + K + L) MOD 2 = 0 THEN PLOT% = 1 ELSE PLOT% = 0 ' bcc and bct
10000 RETURN
10010 IF (H + 2*K) MOD 3 = 0 AND L MOD 2 = 0 THEN PLOT% = 1 ELSE PLOT% = 0 ' cph
10020 RETURN
10030 AL = (-H + K + L)/3: IF AL = CINT(AL) THEN PLOT% = 1 ELSE PLOT% = 0: RETURN ' Alumina structure factor
10040 I = - (H + K)
10050 IF H = 0 AND L MOD 2 <> 0 THEN PLOT% = 0
10060 IF K = 0 AND L MOD 2 <> 0 THEN PLOT% = 0
10070 IF I = 0 AND L MOD 2 <> 0 THEN PLOT% = 0
10080 RETURN
10090 IF H = 0 AND K = 0 AND L MOD 2 <> 0 THEN PLOT% = 0 ELSE PLOT% = 1' Silicon carbide structure factor
10100 I = - (H + K)
10110 IF H = K OR H = I OR K = I THEN IF L MOD 2 <> 0 THEN PLOT% = 0
10120 RETURN
10130 PLOT% = 1: IF H = 0 THEN IF (K+L) MOD 2 <> 0 THEN PLOT% = 0
10140 IF K = 0 THEN IF (H+L) MOD 2 <> 0 THEN PLOT% = 0 ELSE PLOT% = 1
10150 IF H = 0 AND K = 0 THEN IF L MOD 2 <> 0 THEN PLOT% = 0 ELSE PLOT% = 1
10160 IF H = 0 AND L = 0 THEN IF K MOD 2 <> 0 THEN PLOT% = 0 ELSE PLOT% = 1
10170 IF K = 0 AND L = 0 THEN IF H MOD 2 <> 0 THEN PLOT% = 0 ELSE PLOT% = 1
10180 RETURN
10190 REM Plotter instruction subroutines
10200 PRINT #1, "IN;" ' Initialize HP Plotter
10210 COLOR 12
10220 PRINT #1, "OI;"
10230 WHILE EOF(1) = -1: WEND
10240 INPUT #1, A$
10250 IF A$ <> "7470A" THEN PRINT: PRINT "You are not using an HP 7470A plotter": PRINT : INPUT "Press <RTN> to continue ", B$: CLOSE #1: GOTO 670
10260  PRINT #1, "oe;"
10270 WHILE EOF(1) = -1: WEND
10280 INPUT #1, A$
10290 IF A$ <> "0" THEN PRINT: PRINT "HP 7470A plotter error": IF A$ = "8" THEN PRINT :PRINT "Lower pinch wheel"
10300 IF A$ <> "0" THEN PRINT: INPUT "Press <RTN> to continue ",B$: CLOSE #1: GOTO 670
10310  PRINT #1, CHR$(27) + ".E"
10320 WHILE EOF(1) = -1: WEND
10330 INPUT #1, A$
10340 IF A$ <> "0" THEN PRINT: PRINT "Communication error": PRINT: INPUT "Press <RTN> to continue ",B$: GOTO 670
10350 PRINT #1, "SC -1400,1400,-1000,1000;"
10360 COLOR 3
10370 RETURN
10380 IF SPB$ = "S" THEN 10500 ELSE PRINT #1, "SP 1;PA 0,0;" ' Draw circumference
10390 IF DPSP$ = "D" THEN PRINT #1, "CI 10,30; CI 13,30;"
10400 IF DPSP$ = "H" THEN PRINT #1, "CI ";DR;";":GOTO 10490
10410 PRINT #1, "VS15;" ' Pen velocity
10420 IF DPSP$ = "D" THEN PRINT #1, "VS; SR 0.4,0.8;":IF HOLZR$ = "" THEN RETURN ELSE PRINT #1, "CI ";CINT(LAMDAL * SQR(G1SQ));";CI ";CINT(LAMDAL * SQR(G2SQ));";": GOTO 10490
10430 PRINT #1, "CI 1000;"
10440 PRINT #1, "VS;" ' Pen velocity
10450 PRINT #1,"pa -50,0;pd;pa 50,0;pu;pa 0,-50;pd;pa 0,50;pu;"
10460 PRINT #1,"pa -1000,0;pd;pa -950,0;pu;pa 950, 0;pd;pa 1000, 0;pu;"
10470 PRINT #1,"pa 0,-1000;pd;pa 0, -950;pu;pa 0, 950;pd;pa 0, 1000;pu;"
10480 PRINT #1, "SR 0.5,1;" ' Set type size
10490 IF SPB$ = "P" THEN RETURN
10500 SCREEN 2,0: WINDOW (-1450,-1050)-(1450,1140)
10510 CIRCLE (0,0),DR
10520 IF DPSP$ = "H" THEN RETURN
10530 IF DPSP$ = "P" THEN CIRCLE (0,0),1000: LINE (-1000,0)-(-970,0): LINE (970,0)-(1000,0): LINE (0,-1000)-(0,-950): LINE (0,950)-(0,1000): RETURN
10540 IF HOLZR$ = "" THEN RETURN
10550 CIRCLE (0,0),LAMDAL * SQR(G1SQ): CIRCLE (0,0),LAMDAL * SQR(G2SQ)
10560 RETURN
10570 IF SPB$ = "S" THEN 10600
10580 PRINT #1, "pa ";CINT(E(6));",";CINT(E(7));"; pd; pa ";CINT(E(8));","CINT(E(9));"; pu;"
10590 IF SPB$ = "P" THEN RETURN
10600 LINE (E(6),E(7))-(E(8),E(9))
10610 RETURN
10620 PRINT #1, "LB  c/a = ";B$ + C$
10630 RETURN
10640 PRINT #1, "PA -1380,-600;LBp =";NP; C$ ' label for HOLZ symbols
10650 PRINT #1, "PA -1380,-700;CI 10,30;LB ZOLZ";C$;"PA -1380,-900;PD;PU;CI 5,45;CI 7,30;CI 10,30; LB SOLZ"; C$; "PA -1380,-800; SP2; CI 8,30; LB FOLZ"; C$
10660 RETURN
10670 PRINT #1, "PA -1380,-600;LBh = ";D(3); C$ ' label for rotation axis
10680 PRINT #1, "PA -1380,-700;LBk = ";D(4); C$
10690 IF ST$ = "H" THEN PRINT #1, "PA -1380,-800;LBi = ";D(5); C$;"PA -1380,-900;LBl = ";D(6); C$
10700 IF ST$ = "C" OR ST$ = "T" THEN PRINT #1, "PA -1380,-800;LBl = ";D(6); C$
10710 CLS
10720 RETURN
10730 PRINT #1, "PA -1400,-1000;SP 0;" ' End of plotting
10740 RETURN
10750 IF SPB$ = "S" THEN RETURN ELSE IF NPN = 0 THEN PRINT #1,"SP2;" ELSE PRINT #1,"SP1;"
10760 RETURN
10770 PRINT #1, "PA";RH;",";RV;";pd;pu;ci 20,15;"
10780 RETURN
10790 PRINT #1, "pr 20,20;LB"; ALPHA$ + C$;"pr 10,30;ci 7,15;
10800 RETURN
10810 IF SPB$ = "S" THEN 10970
10820 IF LZ = 2 OR AAP = 2 THEN PRINT #1, "PA";RH;",";RV;";PD;PU;CI 4,45;CI 7,30"
10830 IF LAB = 0 AND LZ = 1 THEN PRINT #1, "PA";RH;",";RV;";CI 8,30;PR 20,30;" ' LAB value determines size of plotted circles
10840 IF LAB = 0 AND LZ <> 1 THEN PRINT #1, "PA";RH;",";RV;";CI 10,30;PR 20,30;"
10850 IF DPSP$ = "T" AND ST$ = "C" THEN PRINT #1, "PA";RH;",";RV;";CI 2,45;PR 5,7;": LF$ = "5": GOTO 10880
10860 IF DPSP$ = "D" THEN IF H > 9 OR H < -9 OR K > 9 OR K < -9 OR I > 9 OR I < -9 OR L > 9  OR L < -9 THEN 10960
10870 IF LAB > 0 THEN PRINT #1, "PA";RH;",";RV;"; CI 7,30;"
10880 IF LAB = 2 THEN 10960
10890 IF LAB = 3 THEN INPUT "Enter rotation angle ";ANG:PH = 5: IF ANG < 0 THEN ANG = -ANG:PH = -60 ' label with rotation angles for axis/angle pairs
10900 IF LAB = 3 THEN ANG$ = STR$(ANG): PRINT #1,"pr ";PH;",0;lb"; ANG$ + C$: RETURN
10910 IF LAB > 0 THEN PRINT #1, "PR 20,30;"
10920 PRINT #1, "LB" + HS$ + KS$ + IS$ + LS$ + CR$ + C$
10930 PRINT #1,"PR 0,-";LF$;";"
10940 PRINT #1, "LB" + HI$ + KI$ + II$ + LI$ + C$
10950 IF LEN(L$) = 3 THEN PRINT #1, "PR 0,-7; LB" + CHR$(8) + CHR$(8) + CHR$(95) + CHR$(95) +C$
10960 IF SPB$ = "P" THEN RETURN
10970 CIRCLE (RH,RV),DR
10980 IF ST$ <> "H" THEN I = 0
10990 IF H > 4 OR H < -4 OR K > 4 OR K < -4 OR I > 4 OR I < -4 OR L > 4  OR L < -4 THEN RETURN
11000 NH = 20
11010 ON H+5 GOSUB 11090,11100,11110,11120,11130,11140,11150,11160,11170
11020 NH = 60
11030 ON K+5 GOSUB 11090,11100,11110,11120,11130,11140,11150,11160,11170
11040 NH = 100
11050 IF ST$ = "H" THEN ON I+5 GOSUB 11090,11100,11110,11120,11130,11140,11150,11160,11170
11060 IF ST$ = "H" THEN NH = 140
11070 ON L+5 GOSUB 11090,11100,11110,11120,11130,11140,11150,11160,11170
11080 RETURN
11090 PUT(RH+NH,RV+20),NB4,OR:RETURN
11100 PUT(RH+NH,RV+20),NB3,OR:RETURN
11110 PUT(RH+NH,RV+20),NB2,OR:RETURN
11120 PUT(RH+NH,RV+20),NB1,OR:RETURN
11130 PUT(RH+NH,RV+20),N0,OR:RETURN
11140 PUT(RH+NH,RV+20),N1,OR:RETURN
11150 PUT(RH+NH,RV+20),N2,OR:RETURN
11160 PUT(RH+NH,RV+20),N3,OR:RETURN
11170 PUT(RH+NH,RV+20),N4,OR:RETURN
11180 RETURN
11190 PRINT #1, "IN; SC -600,1365,-250,1180; SP 1; PA 0,0: PD; PA 1000,0; AA 0,0,60; PA 0,0; PU;" ' Alumina unit triangle
11200 PRINT #1, "CI 7,30; PA -90,-30;SR 0.5,1; LB0001" + C$ + "PA 1000,0; CI 7,30; PA 1020,-10;LB  -" + C$ + "PA 1020,-30;LB0110" + C$
11210 PRINT #1, "PA 866,500; CI 7,30; PA 880,540; LB- -" + C$ + "PA 880,520; LB1210" + C$
11220 PRINT #1, "PA 500,866; CI 7,30; PA 520,900; LB-" + C$ + "PA 520,880; LB1100" + C$
11230 RETURN
11240 PRINT #1, "SR; PA 900,1000; LBUnit triangle" + C$
11250 IF SF% = 11 THEN PRINT #1, "PA 900,900; LBAlumina" + C$
11260 PRINT #1, "PA -600,-250; SP 0;"
11270 RETURN
11280 PRINT #1, "IN; SC -100,600,-100,400; SP 1; PA 0,0: PD; PA 414,0; AR -1414,0,15,1; PA 0,0; PU;" ' Cubic unit triangle
11290 PRINT #1, "CI 2,45; PA -30,-10;SR 0.5,1; LB001" + C$ + "PA 414,0; CI 2,45; PA 430,-10;LB011" + C$
11300 PRINT #1, "PA 366,366; CI 2,45; PA 380,380; LB-" + C$ + "PA 380,375; LB111" + C$
11310 RETURN
11320 PRINT #1, "SR; PA 450,350; LBUnit triangle" + C$
11330 PRINT #1, "SR; PA 450,330; LBCubic" + C$
11340 PRINT #1, "PA -100,-100; SP 0;"
11350 RETURN