Quickplot: A microcomputer-based program for processing of orientation data

Computers & Geosciences Vol. 18, No. 2/3, pp. 183-287, 1992 Printed in Great Britain. All rights reserved

0098-3004/92 $5.00 + 0.00 Copyright © 1992 Pergamon Press Ltd

QUICKPLOT: A MICROCOMPUTER-BASED PROGRAM FOR PROCESSING OF ORIENTATION DATA D. A. VAN EVERDINGEN, ! J. A. M. VAN GOOL,~ and R. L. M. VISSERS 2 ~Department of Earth Sciences, Memorial University of Newfoundland, St. John's, Newfoundland, Canada AIB 3X5 and ZDepartment of Geology, Institute of Earth Sciences, University of Utrecht, P.O. Box 80.021, 3508 TA Utrecht, The Netherlands (Received 30 January 1991; accepted 3 December 1991)

Abstract--QuickPlot is an interactive, MS-DOS based computer program which allows plotting, contouring, rotation, and statistical analysis of orientation data. Output of stereographic equal-area projections, modified Flinn, and triangular fabric diagrams may be saved as PIC-format graphics files, which can be printed readily, plotted, or incorporated into widely used graphics software to edit or combine diagrams. Key Words: Orientations, Structural geology, Contouring, Statistics, IBM-compatible microcomputers, Equal area projection.

INTRODUCTION Many computer programs have been produced to plot and analyze orientation data in the earth sciences (e.g. Charlesworth and others, 1989; Griffis, Gustafson, and Adams, 1985; Guth, 1987; Diggle and Fisher, 1985; Pecher, 1989; Pilant, 1989; Starkey, 1977). Generally, such programs have been written to satisfy specific needs of the authors and most require specialized input data format. In addition, limitations of programs have been put on the style or quality of the output. Earlier programs produced characterstyle output to a printer whereas more recent programs produced graphics on the monitor allowing only screen dump output and necessitating manual redrafting of plots or writing of specific plotting routines. QuickPlot was written as a general purpose menu-driven orientation data-analysis program, which accepts several data input formats. QuickPlot combines the capabilities of a number of previously published programs and routines. Because most routines were taken from other sources with only minor adaptations, we do not explain methods of plotting or calculation, but rather refer the reader to the respective literature sources. The capabilities of the program include reading data in several formats; plotting, contouring, and rotating the data; combining data files and plotting stereographic projections and modified Fiinn and triangular fabric diagrams. In addition, several statistical tests may be performed, including eigen analysis, Fisher test of significance and a uniformity test. As an added feature, plotted data remain on the screen during further manipulations, allowing plotting of additional points or additional data sets on the same projection.

QuickPlot was written in MicroSoft QuickBASIC ~ and compiled using the MicroSoft QuickBASIC ~ version 4.5 compiler. The following hardware is required to run the program: an IBM-PC or compatible with at least 512 kbyte of memory, one disk drive (at least 360 kbyte), a graphics card (Hercules, CGA, EGA, or VGA) and at least DOS version 2.11. A math coprocessor is advisable although not necessary. A sample data set of dike orientations within the Sheeted Dyke Complex of the Troodos Ophiolite, Cyprus (Table 1) were used to produce the figures in the paper. These figures were produced from QuickPlot output using Lotus ~ Freelance and printed on a Hewlett Packard Laser Jet III printer, with the exception of Figure 3, which was printed on an Epson 9-pin dotmatrix printer.

GENERAL FEATURES QuickPlot plots displayed on the monitor can be sent directly to the printer by a screen dump or saved as a Lotus ~ PIC-format file (Lotus Development Corp., 1987), readable by such programs as Lotus ® 123 (PGRAPH), Lotus ® Freelance, Lotus ~ Manuscript, WordPerfect (version 5.0 and later), Corel Draw, and other software packages such as AutoCAD ~' through the use of file conversion utilities. Any of these software packages enable QuickPlot users to make high quality prints of the plotted datasets. The program code has been designed with special attention to user friendliness, such that the program is run completely through the use of simple menu solutions. Data input integrity, whether from the keyboard or a file, and input of directory and file 183

184

D. A. VANEVERDINGEN,J. A. M. VANGOOL, and R. M. VISSERS Table 1. Sample d a t a ~ i k e orientation data from Sheeted Dyke Complex of the Troodos Ophiolite, Cyprus (100 data points, dip-azimuth/dip) used for diagrams in this paper 216/76 359/46 207'81 338'74 224'75 251'75 339 '89 334 '59 28 '80 230 '73 152 ¢83 206f77 28 37 68 63 296 53

159/86 74/90 209/86 188/74 190/71 49/88 316/83 356/65 188/70 231/61 331/70 277/77 357/35 314/52 92/89

299/84 206/80 325/81 306/84 215/77 209/84 271/09 330/60 8/64 340/43 142/65 323/81 21/75 268/85

316/82 200/78 272/81 61/90 310/84 249/79 267/68 259/80 12/77 222/80 216/81 34/28 297/48 191/64

names are checked for errors through various error trapping procedures. The stereographic projections may appear as ellipses on some monitors driven by Hercules, CGA, or EGA graphics cards and VGA graphics cards in laptop computers. To alleviate this problem, the aspect ratio of the stereographic plot primitive circle can be adjusted to appear as a circle on the screen. QuickPlot can be run interactively or in batch mode. In batch mode, the program automatically will produce PIC format graphics files for any number of data sets without operator intervention using a batch command file. Batch mode operation allows plotting of up to eight plots per page. Most of the options available in the interactive mode (described next) are available in the batch mode. QuickPlot has the limitation of being able to handle a maximum of 1000 data points at a time, because of the memory intensive method used for storing the data in random access memory (RAM) during program execution. Exceeding these limits may cause problems for computers with less than 640 kbyte of RAM memory.

179/89 208/80 323/86 327/85 144/87 221/71 8/87 223/78 270/72 237/77 235/86 26/67 21/66 293/55

348/66 209/71 256/79 221/59 344/81 330/85 204/80 227/70 9/65 165/88 52/89 228/66 80/89 239/53

227/80 206/71 170/81 212/84 172/89 178/87 329/66 227/75 240/66 238/75 234/75 216/75 274/50 100/83

To save time during later calculations the data are stored in memory in two formats: polar coordinates and direction cosines. The disadvantages of such an inefficient use of memory are counter-balanced by faster data manipulation during otherwise timeconsuming calculations. (2) Plot: entered data are plotted on a Schmidt equal area projection using one of six symbol shapes in two sizes. The projection can be annotated with tick marks at 10° intervals of azimuth, a North symbol, and a message indicating data type. Multiple data sets from different files may be plotted on one projection using different symbols, or a single data file containing several data sets, may be plotted or manipulated in parts or as a whole, using different symbols for each set. Output (Fig. 1) can be sent

ata I

QUICKPLOT OPERATION In its interactive mode, the QuickPlot main menu offers eight selections: (1) Input, (2) Plot, (3) Contouring, (4) Rotate, (5) Stats, (6) Options, (7) DOS Shell, and (8) Exit. The first five are described next. (1) Input: orientation data can be loaded into memory from the keyboard or from an ASCII file consisting of numbers in two columns. The following formats are acceptable: dip-azimuth/dip, dip/dipazimuth, strike/dip. The data type may be planes, lineations, great circle data, or a combination of great circles and lineations. Paired planes may be input for the computation and plotting of intersection lineations according to the method described by Duncan (1985). Comments may be included anywhere in data files. This versatility of input data format allows the user to use data files set up for other software, without having to change the data format.

Eigen values: ~ N = 100 .550 .369 .060 Poles to Planes Eigen vectors: Dip-Dir Dip 28.07 4.758 119.7 18.91 284.5 70.45 Confidence Radius 95% Signif.: 17.0 deg. K = 1.68 Figure l. Sample data set---equal area projection with eigenvectors (I, 2, 3) and 95% confidence circle.

Processing orientation data with QuickPlot directly to a printer or saved to a file. This output option also is available within the contouring and the rotation menus of the program. (3) Contour: the data are counted and contoured, using a counting net similar to the Kalsbeek net (Kalsbeek, 1963). Two counting methods are offered, both using the approach presented by Pecher (1989) of locating the nearest counting nodes surrounding each data point, rather than comparing all data points with all counting points. The first method uses a I% counting circle and is fast (Pecher, 1989), but produces rather angular contour lines. The second method uses a Gaussian distribution function as published by Robin and Jowett (1986) and produces smoother contour lines (Fig. 2). The density of the counting grid can be differed. The orientation of the counting node with the maximum count is printed to the screen. Patterns indicating different contour levels can be added to the screen only (Fig. 3). They are not saved to the file containing the plot. (4) Rotate: orientation data can be rotated about a user specified axis (e.g. to unfold bedding to an original horizontal orientation). The rotation procedure uses an algorithm presented by Vissers and Bollegraaf (1989), which uses matrix multiplication to accomplish the rotation. Rotated data may be manipulated further within QuickPlot or saved to a file. (5) Stats: five statistical analyses are available in QuickPlot: Eigen analysis: the eigen analysis performed by QuickPlot uses a routine presented by Diggle and Fisher (1985) which calculates the eigenvectors and associated eigenvalues of the data set. The eigenvectors may be saved to a file or displayed on the projection (Fig. 1). The relative magnitudes of eigenvalues indicate the mode of the distribution of the

Max.9.09valuetimescounted:uniform at 210/79

Contours: 12468

ata I

N = 100

Poles to Planes

Figure 2. Sample data set---contoured using Gaussian weighting function and high density grid. Contours are multiples of uniform distribution,

185

2 ~

Max. value counted: 9.1 times uniform at

N

I Sample Data

Conoturs:

N = 100 124 68 Poles to Planes Figure 3. Sample data set--contoured as in Figure 2, screen dump to dotmatrix printer. Patterns indicate different contour levels. data in either a cluster or a girdle and are used by QuickPlot in the construction of the modified Flinn and triangular fabric diagrams (see next). Best-fit-girdle: a best-fit girdle is computed using the eigenvalues of a data set. The program runs a uniformity test to determine whether the data set

Eigen values: .550 .369 .080 Eigen vectors: Dip-Dir Dip 28.07 4.758 119.7 18.91 284 " '

Fold Axis: Azim = 284.

l Sample Data-]

N = 100

Poles to Planes

Ping = 70.4 Figure 4. Sample data set--as Figure 1 with fold axis (star) and best-fit girdle superimposed on data set.

186

D. A. VAN EVERDINGEN,J. A. M. vA~ GOAL, and R. M. VISSERS

conforms to a cluster or a girdle distribution. In the situation of a great circle distribution the best-fit girdle can be plotted (Fig. 4). It is useful to plot the data first to determine whether it is muitimodal, then a computed girdle or axis is meaningless and the data set should be split into unimodal subsets. Fisher: the Fisher analysis (Fisher, 1953) computes the diameter of a 95% confidence cone about the mean of a data set. This test is useful only for unimodal data sets. A ' K ' value is calculated describing the strength of clustering of the data as described in Fisher's (1953) paper. A large K value indicates unimodal data are highly clustered. The 95% confidence circle may be plotted on the projection (Fig. 1) and its subtended angle and the K-value may be saved to a file. Modified Flinn and triangular fabric diagrams: modified Flinn diagrams (Fig. 5A), developed by Woodcock (1977) and Woodcock and Naylor (1983), quantitatively describe clustering or girdling of orientation data and the strength of the cluster or girdle, respectively, K and C,

SAMPLEDATASETS (modified Flinndiagram) Symb. Set Name CLUSTERS K=5 K=2 K=I • SAMPLE 1 + z~ * •

•

=

CONCLUSIONS QuickPlot is an easy-to-use MS-DOS based orientation analysis program, using a simple menu system which results in short learning time. The flexibility in handling various data types and in data manipulation, and its ability to run on most IBM and compatible computers make it a useful tool for any geoscientist. The possibility of producing multiple stereographic plots in a batch style operation greatly speeds the processing and evaluation of numerous data sets. The ability of the program to produce stereonet plots that may be saved to a graphics file which can

5

2

1~

~ 1

A

Point \

K=0.2 2

3 4 In(E2]E3)

+ ,a •

• •

SAMPLE 1 \

/ *

*

SAMPLE-2 + ~ SAMPLE-4-/ ~

SAMPLE-5 SAMPLE-6 SAMPLE'S3

/

\ B

5

SAMPLEDATASETS (Triangular FabricDiagram) X3=O . . . . . . . . . . / Girdle

Symb. Set Name ~

g = [ln(S1/$2)]/[1n($2/$3)] and C = ln(Sj/$3), where S~, $2 and $3 are the eigenvalues of the data set. A problem with the modified Flinn diagrams is that highly clustered or girdled data may plot beyond the limits of the graph. Therefore an alternative plotting option was included, based on a triangular plotting method presented by Vollmer (1990). Eigenvalue differences are used to create inverted closed triangular plots (Fig. 5B) which accommodate every extreme of orientation configuration. U p to ten data sets may be plotted in each diagram. Uniformity test: the uniformity test used here (after Griffis, Gustafson, and Adams, 1985) provides information similar to the Flinn diagram, but the results are presented as text on the screen so that the plots on the screen will not be erased (as is the situation when producing fabric diagrams). For simplicity only one uniformity test was included in the program, although Gillett (1987) points out that a n u m b e r of tests may be useful to cover all possibilities of data set orientation configurations.

SAMPLE-2 SAMPLE-4 SAMPLE-5 SAMPLE-6 SAMPLE[3

\

/

/

//~'~? f ~, "~

/

/ "~/ Random

Figure 5 . A - - M o d i f i e d F]inn diagram with five data sets

(after Woodcock and Naylor, 1983). K and C represent amount of clustering or girdling of data and strength of grouping, respectively. Mode of concentration changes from girdle for K < 1 to a cluster for K > 1; B--triangular fabric diagram with five data sets as in A (after Vollmer, 1990). End points are represented by differences in eigenvalues: Point = (21 - 22)/N; Girdle = 2(22 -23)N; Random = 3(23)/N where N is number of points in data set.

be plotted and modified through numerous programs on various dotmatrix and laser printers and plotters is a distinct advantage over previous microcomputer based stereoplotting software packages. AVAILABILITY A copy of this program (including the executable code, a batch command file creation program, help file, manual and sample data set) may be obtained from D.A.v.E. or J.A.M.v.G. for $10 (Canadian or US dollars) (specify either 3½" or 51" diskette) at the Memorial University of Newfoundland. REFERENCES

Charlesworth, H., Cruden, D., Ramsden, J., and Huang, Q., 1989, ORIENT: an interactive FORTRAN-77 program for processing orientations on a microcomputer: Computers & Geosciences, v. 15, no. 3, p. 275 293. Diggle, P. J., and Fisher, N. I., 1985, SPHERE: a contouring program for spherical data: Computers & Geosciences, v. ll, no. 6, p. 725 766. Duncan, A. C., 1985, PLANE: an interactive program for calculating intersections lineations from planes, planes from lines and plunges from pitches: Computers & Geosciences, v. ll, no. 2, p. 183-202.

Processing orientation data with QuickPlot Fisher, R., 1953, Dispersion on a sphere: Roy. Soc. London Proc., v. 217, no. A, p. 295-305. Gillett, S. L., 1987, CLUSTRAN: extract clusters from axial data sets using the algorithm of Shanley and Mahtab, Instruction manual from commercial CLUSTRAN software package: 2214 Road 34, Pasco, Washington 99301, 20 p. Griffis, R. A., Gustafson, S. J., and Adams, H. G., 1985, PETFAB: user considerate FORTRAN-77 program for the generation and statistical evaluation of fabric diagrams: Computers & Geosciences, v. 4, no. 4, p. 369 408. Guth, P. L., 1987, MICRONET: interactive equal area and equal angle nets: Computers & Geosciences, v. 13, no. 5, p. 541-543. Kalsbeek, F., 1963, A hexagonal net for the counting-out and testing of fabric diagrams: Neues Jahrbuch fiir Mineralogie, Monatscheft, v. 7, p. 173-176. Lotus Development Corp., 1987, Lotus file formats for 1-2-3, Symphony and Jazz: file structure descriptions for developers: Lotus Books, AddisonWesley Publishing Co., Inc., Reading, Massachusetts, p. 129--134. Pecher, A., 1989, SCHMIDTMAC--a program to display

187

and analyze directional data: Computers & Geosciences, v. 15, no. 8, p. 1315-1326. Pilant, W. L., 1989, A PC-interactive stereonet plotting program: Computers & Geosciences, v. 15, no. 1, p. 43-58. Robin, P.-Y. F., and Jowett, E. C., 1986, Computerized density contouring and statistical evaluation of orientation data using counting circles and continuous weighting functions: Tectonophysics, v. 121, no. 2-4, p. 207-233. Starkey, J., 1977, The contouring of orientation data represented in spherical projection: Can. Jour. Earth Sciences, v. 14, no. 2, p. 268-277. Vissers, R. J. M., and Bollegraaf, B., 1989, An algorithm for rotation of axial data: Computers & Gcosciences, v. 15, no. 1, p. 157-161. Vollmer, F. W., 1990, An application of eigenvalue methods to structural domain analysis: Geol. Soc. America Bull., v. 102, no. 6, p. 786-791. Woodcock, N. H., 1977, Specification of fabric shapes using an eigenvalue method: Geol. Soc. America Bull., v. 88, no. 9, p. 1231-1236. Woodcock, N. H., and Naylor, M. A., 1983, Randomness testing in three dimensional orientation data: Structural Geology, v. 5, no. 5, p. 539-548.

APPENDIX

QuickPlot Program Listing ~Program to plot data points on a .teceo net and/or rotate them rod/or -----contourthem. Some parts of progrma from a version from the University ----of Utrecht, Netherlands by R. Vissers. ~Modified by Jeroea van Gooi and by D. vim Everdingea (6/90) ~ a t the Memorial University of Newfoundland

~ T h e routine to determine the current drive and direetovy r e q u m that ---QuiekBASIC must be loaded with the/LQB option laid the liaking must ----must be done with LINK fdenmne,ctc, +QB.LIB (D.A.v.E. 11-7-91)

NOTE ~ L i n e s longer tlum 80 columns are truncated by a '@' symbol - the line ~ i s continued on 1he followinglineafterthe '@' symbol ~ S U B R O U T I N E DECLARATIONS DECLARE SUB BatchI-ldp ( ) DECLARE SUB BatchInput (Opemtio~ %, I~8B%, Sel%) DECLARE SUB BatchMode (FinishS) DECLARE SUB BLPrint (LptNo~. S$. EnCotmt~) DECLARE SUB CalcSaveAzHel (AzRI(). ThetRt(). AZI(). HELl()) DECLARE SUB CheckFree (SourceS, TypeS, Numb%) DECLARE SUB C'ngCentl..oc(XXX%, YYY%) DECLARE SUB ContGausRin8 (I%, L%, AZI, CheckFiag%) DECLARE SUB ContIntervals (AutoContFlag %, NCON%, CVALt()) DECLARE SUB ContNetSetup ( ) DECLARE SUB ContourData ( ) DECLARE SUB CotmtCircle (IMax%, JMax~) DECLARE SUB Co~mtCurve (IMax~, JMax%) DECLARE SUB ContourDraw (CVAL~(), NCON~, XPTt(), YPTI()) DECLARE SUB ContourMenu ( A N S i , Dense) DECLARE SUB DefaultFind ( ) DECLARE SUB DefauitSet ( ) DECLARE SUB DrawCursor (NewX %, OldX ~, Menus$()) DECLARE SUB DrawLine (XI~, Y I ~ , X2~, Y2%, K%) DECLARE SUB Eigen (at, Bt, Ct, Dlt, E[, Pl, EVal[(), EVec[()) DECLARE SUB EigenAnalysi, (Thetal!(). ~hilt(). FS) DECLARE SUB E i g e ~ n t frhcal l(), Phil!(), TypeS) DECLARE SUB EruePIot (CireleFIgl, PieFIgl, Nmnb%, Pictm¢$) DECLARE SUB FileExist (FileS, E%) DECLARE SUB FileMenu (File.SpecS, FiNm$, Choiee.~)

188

D.A. VAN EVERDINGEN,J. A. M. VANGOOL, and R. M. VISSERS

DECLARE SUB FisherAnalysis (F$, T!()) DECLARE SUB FisherPrint (T!(), TypeS) DECLARE SUB FisherVector (Tlf, 1"2!, T3!) DECLARE SUB Flinn (EVaI!(), ECount~) DECLARE SUB FlinnVollmer (Whiehs) DECLARE SUB GetFileName (FileName$, PicFile$) DECLARE SUB GetHex (ival%, hiS, loS) DECLARE SUB GreatCircle (Azimuth[, DipAngle!) DECLARE SUB Help 0"%) DECLARE SUB Logo ( ) DECLARE SUB MakeBatch ( ) DECLARE SUB Menu (Menus$(), ExplainS(), Chose%, LastP%) DECLARE SUB Parse (Entry$, NI!, N2!, N3[, FIg%) DECLARE SUB PCircle (PictureS, X!, Y!, PieR%, TickS) DECLARE SUB PCIose (PictureS) DECLARE SUB PColor (PictureS, pc %) DECLARE SUB PDraw (PictureS, X%, Y%) DECLARE SUB PDrawSym (PictureS, X%, Y%, isym%, ipengg) DECLARE SUB PDump (PictureS, Numb%, TypeS, F$, DumpFIgf) DECLARE SUB PPiHo (PictureS, nve~%, xvert%(), yvert%()) DECLARE SUB PFlinnSym (PictureS, X%, Y%, isym96, ipen°~) DECLARE SUB PFSize (P/crateS, X%, Y%) DECLARE SUB PHead (PictureS) DECLARE SUB PicFileOpen (PictureS, PicFIg!, T$, FS) DECLARE SUB Plane ( ) DECLARE SUB PlotCircle (XX%, YYSg, R%, YRATIOf, PicFIgl, CireleFIg!@ @, XXX%, YYY~) DECLARE SUB PiotData ( ) DECLARE SUB PIotPattem2 (CVAL!(), NCON%) DECLARE SUB PlotPatteml (CVAL!(), NCON%) DECLARE SUB PlotTitle (Numb%, Mode%, PicFIgI, PIotOnlyFIgf, Menus$()) DECLARE SUB PMove (PictureS, X%, Y%) DECLARE SUB PrintBIock (FileName$(), StartColunm%, HorN%, VerHg$@ @, MaxColunm%) DECLARE SUB PrintFlinn (LEI2!(), LE23!(), SetName$(), ECount%) DECLARE SUB PrintToPlot (PAl(), P!(), T$) DECLARE SUB PrintVollmer (pVal!(), RVaI[(), GVal!(), SetName$(), ECount~) DECLARE SUB PText (PictureS, DI %, P%, Msgs) DECLARE SUB Query (NumberS, NumFIg%) DECLARE SUB ReadData ( ) DECLARE SUB RotateDala ( ) DECLARE SUB RotateMath (RAZI!, RDIP[, RAN[, DI[, af, HI, NA!(), NBf()) DECLARE SUB SaveFile (F$, AZ)(), HELl(), Symb%(), Kountg$) DECLARE SUB ScrecnAspect ( ) DECLARE SUB ScmDump (sumgg$, LptNo%, Transl%) DECLARE SUB SetContcmr(CVALf, CAt, CBf, XAI, XBf, YAI, YBf@ @, CON'X~, C O ~ ' ~ ) DECLARE SUB SetMinMax (A!, B!, MIN!, max!) DECLARE SUB SortReals (CVALI(), NCON%) DECLARE SUB SortStrings (FileName$(), FileCount%) DECLARE SUB StatsData ( ) DECLARE SUB StDriveDirec (DataDirs) DECLARE SUB StoreName (dta%(), A%, FileName$()) DECLARE SUB SW (Msg$, PosX!, PosY!, Opt!) DECLARE SUB Uniform 0"[(), Disp$) DECLARE SUB Vollmer (EVal!(), ECount%) DECLARE SUB WhatGraphics ( ) DECLARE SUB WipeArea (Location%) '----Common blocks of variables COMMON SHARED/Picl/PictureS, CircleS, CircleOnceFlg, PrintOutS, ipen% COMMON SHARED/Pie2/PicFile$, MoreDataFIg COMMON SHARED/StereoPIotl/PlotS, Directory$, DataDirln$, DataDirOutS COMMON SHARED/StereoPlot2/TitleMsg$, North%, NumbPls% COMMON SHARED/Defaultl/YRATIO, DatalnputS, DataFormats, Tickg;,@ @Diametre COMMON SHARED/lkfault2/StartPrgmFIg, YSRatio, YPRatio, AspectS,@ @HomeDir$

Processing orientation data with QuickPlot COMMON SHARED/Batch/Batch%, F$, NMode$, OperFIg, Sei~ COMMON SHARED/Flinnl/LEI2(), LE23(), SetName$(), ECount~, El( ),@

@E2(), E3( ) COMMON SHARED IFlinn21 K(), C(), PlotOr ~ COMMON SHARED IVollmer/PVtI(), OVal(), RVtl( ) COMMON SHARED/Rottta NA(), biB(), NC(), LL(), FithCir( ) COMMON SHARED/Fhgsl/Numb%, FisherFig, EigcnFlg, EigFishFIg, PiFlg

COMMON SHARED/l~gs2/VFIg~, Iqinnl~ ~, CPiFM~. NctF~g~ COMMON SHARED/Flags3/Oper$, PlotOnlyFlg, PieFIg, Flg8~, PltNtmeFIg COMMON SHARED/Piotl/XX~, YY%, R%, CirelcFIg, NctOnScrctmFIg ~ COMMON SHARED IFlot2/ThetR(), AzR(), Symb%(), Mode%, SymbolS, PT$( ) COMMON SHARED/Pl~,31 PItOnlyFlg, Mcnus$(), PA(), P(), Exphdn$( ) COMMON SHARED/Plot4/CXPT(), CYPT(), XPT(), YPT(), Rings%, PieR%, COMMON SHARED ~PlotS/CNT(), NN$(), EVaI!(), EVcc(), T(), Vector COMMON SHARED IPIot61CountFIg%, VcctorData(), OWSymb$, Points% COMMON SHARED IPIot7/XXX %, YYY ~, Grad, PI, WhatSymb$, Sets() COMMON SHARED/Plot8/DumpFlg, ODFommt$, MultFlg$, PolcCntP( ) COMMON SHARED/Contourl/MAXPERCEIWr, Maxcount$, OridMsity % COMMON SHARED/Contour2/AutocontFlag ~ , DataLoadFlag %, ContLcvel$, COMMON SHARED/Contour3/Dens %, CircleGansFlag % COMMON SHARED/Cursor/LtstPos% COMMON SHARED/Patterns/Pattern% COMMON SHARED/Misc/NoG$, Neff% ' ~ D i s p l a y type characteristics TYPE Display MX AS INTEGER 'max X limit of screen MY AS INTEGER 'max Y limit of screen CX AS INTEGER 'X size of clmmctcr CY AS INTEGER 'Y size of character M L A S I N T E G E R '# of minesof screen AS INTEGER

'defaultdiamter of circle

ASP AS SINGLE 'default aspect ratio for screen SCR AS INTEGER 'screen type (Here, CGA, EGA or VGA) END TYPE COMMON SHARED/Display/D AS Display TYPE RegType ax AS INTEGER bx AS INTEGER cX AS INTEGER dx AS INTEGER bp AS INTEGER si AS INTEGER di AS INTEGER flags AS INTEGER END TYPE C L E A R , , 4000 Constants PI = 3.141592654~ Grad = PI / 180: PieR% = 200 Rings~ = 1: J = Rings~ * 6: ipen~ = 7 Trap = 1 ' - - D i m e n s i o n the arrays DIM FishCir(36, 2), X(13), Y(13), Image(4000) DIM AzRfrmp), ThetRfrmp), XPT(Tmp), Symb%(1000) DIM YPT(Tmp), KK06), SYM$(6), P$(5), NN$(9), Sets(13) DIM CNT(Rings%, J), CXPT(Rings%, J), CYPT(Rings%, I), FT$(I5) DIM Meaus$(ll), Explain$(l I), NAO, 3), NBO, 3), NCO, 3), LLO) DIM PO), PA(3), EVal!O), EVccO, 3), T(8), PVaI(50), GVaI(50), RVaI(50) DIM LEI2(50), LE23(50), SetNsmc$(50), El(50), E2(50), E3(50), K(50), C(50) DIM PoleCntP(l TO 3, Rings~, J), VectorData(1 TO 3, "Imp) ' - - V a r i a b l e l)cfmitions and comments '

•

' - - - - ~ % , Y Y % = screen net ccutrc; X X X % , Y Y Y ~ '~AZ and HEL are szimuth and dip of data

= PIC net centre

' - - A Z R and THETR are sTimuth and dip in radimm '----XPT and YPT are X-Y coorditmtes of dampoint in plot ' - - - S I G -- sigma MODE --- l-planes,2-1ineations,3-great circles ' ~ D i a m e t r e = diametre of net in cm(+) on paper

189

190

D . A . VAN EVERDINGEN, J. A. M. VAN GOOL, a n d R. MI V1SSERS

--R% = diametre of net in screon pixel trait• ~PicR% = diametre for PIC plot ('200=large, 65=~nnall) - - N e t O n S c r e e n F l g % = O- plot area is clear;, 1- plot area is not clear - - - - N o G $ = " " for graphics = yes, "N" for no graphics - - F i g 8 % = number of net in case of 8 on • page - - F l g S B % = specifies whether to plot or contour in BOTH Batch mode - - C i r c l e O n c e F I g = set to 1 ff circle for .PIC file has been created - - - N e t F l a g = counting net e x i ~ if = 1 - - C o u n t F l a g = current data~.t is counted if = 1 - - O p e r a t i o n % = what is to be done in batch mode ----Draw Commands for Symbol Shapes SIG$ = "D3GI L 3 H I U 2 E I R6" 'Sigma PT$(I)

=

""

'.

PT$(2) = " U I L I D 2 R 2 U 2 G 2 " 'small Uluare PT$(3) = " B D I L 3 E 3 F 3 L 3 U 1 C O U I " 'triangle point up P T $ ( 4 ) = "BU2D4BH2R4" 'large cross PT$(5) = " B D 2 L I H I U 2 E 1 R T . F I D 2 G I L I U I C O U I " 'open circle PT$(6) = " D 2 L I H I U 2 E I R 2 F I D 2 G I U 3 L 2 D 2 R I U I " 'closed circle PT$(7) = " B U 1 L 3 F 3 E 3 L 3 D I C O D I " 'small triangle point dn PT$(8) = "UIL3F3E3L3D2EIL2" 'smalltriangle point dn PT$(9) = "BU2L2D4R4U4L2DICODI" 'open squarc PT$(10) = " U 2 L 2 D 4 R 4 U 4 L 2 D 3 L I U 2 R 2 D 2 " 'f'dled square PT$(I 1) = "BL6E6F6G6H6RICORS" 'open diamond P T $ ( l l ) = "BL3E3F3G31-13RICOR2" 'open diamond PT$(12) = "L3E3F3G3H3R5G2H2E2F2H2D3" 'f'dled diamond '-----Symbols for rotation etc. PT$(13) = "BD4L2H2U4E2R4F2D4G2L2D2UI2BG6RI2" 'circle with cross PT$(14) = "BDIH3R6G3"

PT$(15) = " B D 6 H I U I H 1 L 3 E I U I E I H I U I H I R 3 E I U I E I F I D I F I R 3 O ~G1DIGIFIDIFIL3GIDIGI" N N $ ( I ) = " B L I B U 2 E 1 D 6 B L I R 2 " : NN$(2) = " B L 2 B U 2 E I R 2 F 1 G 4 D I R 4 " NN$O) = " B L 2 B U 2 E I R 2 F I D I O I L 2 B R 2 F I D 1 G I L 2 H I " NN$(4) = " B D 3 B R 1 U 6 G 3 D I R 4 " NN$(5) = " B U 3 B R 2 L 4 D 3 R 4 D 2 G I L 2 H I " NN$(6) -- " B I D B R 1 L 2 0 1 D 4 F I R 2 E I U I H I L 3 " NN$(7) = " B D 3 B L 2 U I E 4 U I I A " NN$(8) = "BLIHIUIEIR2FIDIGIFIDIGIL2H1UIEIR2" NN$(9) = "BD3BL2P.3EIU4HIL2G1DIFIR2" ' - - lnitialise 8-plots-flag

F1gs~ '--

=

1

Check what graphics card is present

WhatOraphics '~

X X , Y Y are circle center in screen coords/XXX,YYY in PIC coords

XX% = 2 * D.MX/3: YY% = 5 * D.MY/9 X X X % = 462: Y Y Y % = 172 'since P I C p l e t t i n g was b u e d on Here coords. IF NoG$ = "N" T H E N GOTO EodStereo: ' - - Display Logo 5 secs or til key press IF No(iS = " " T H E N

L~o start = T I M E R DO Stopw = T I M E R L O O P W H I L E INKEY$ = "" A N D (Stopw - start) < 8 ENDIF ' - - Check for Batch Input CL$ = C O M M A N D S IF NoG$ = "Y" T H E N C L $ = "BATCH" IF UCASE$(CL$) = "BATCH" T H E N 'Find batch file and open it BatehMode (FinishS) IF Finishs = "Y" T H E N GOTO EndStereo: ENDIF ' - - - Check for existence of defaults fde: Q P . D E F & read default value~ CLS IF NoG$ = " " T H E N L I N E (0, 2 * D . C Y + 2)-(D.MX, 2 * D.CY + 2) DefaultFind WipeArea I

Processing orientation data with QuickPlot ' - - - START QUICKPLOT MAIN ROU'ITNE ' - - - r e a d in the default data once flag IF Batch % = 1 THEN Operation % - 0 Numb% = 0 StereoMenu: ' - - - - Put menu labels into the MENUS array Menus$(l) = "Input" IF ElfipFIg = 0 THEN Menus$(2) = "Plot" '----Disable Contouring & Rotation if using great circles IF EllipFIg = 0 OR Mode% < > 3 OR Mode% < > 4 THEN Menus$O) = "Contour" Menus$(4) ~- "Rotate" ENDIF Menus$(5) = "Stats" Meaus$(6) = "Options" Menus$(7) = "DOS" Menus$(8) = "Exit" ' - - - Set explanations IF DataInput$ = " K E Y B O A R D " THEN ExplainS(l) = "Input data from: Keyboard, data may be saved to " + @ @MID$(DataDirOut$, 1, LEN(DatsDirOut$) - 1) ELSE ExplainS(l) = "Input data from: Datafile in " + MID$(DataDirla$, I, @ @LEN(DataDirIn$) - 1) ENDIF ExplainS(2) = "Plot points on stereo plot" ExplainS(3) = "Calculate and plot contour lines" ExplainS(4) = "Rotate data points about a specified pole" ExplainS(5) = "Statistics: Eigenvalues, Fisher, Girdle, Unifmmity, @ @Fabric d i ~ n m a " ExplainS(6) = "Set data (inlmt, format, directory) and p l o t t ~ default @ Oparameters" Expttm$(7) = "Exit temporarily to • D O S shell" ExplainS(8) = "Leave program, exit to D O S " ' ~ Print lines IF NoG$ = " " THEN LINE (0, 2 * D.CY + 2)-(D.MX, 2 • D.CY + 2) WipeAres 1 ' ~ Pick menu choice using cursor keys '~ if in batch mode then read the contents of the batch fde LOCATE 1, 1: PRINT "Menu:" IF Batch% = 0 THEN Menu Menus$0, ExplainS(), S¢1%, L u t P m l ELSEIF Batch% = 1 THEN BatchInput Operation%, FIgSB%, Sel% ENDIF '~ Check to see that data has been entered, if net require that fwst IF SeI% = -1 THEN Sel% = 8 '--¢~ape IF Numb% = 0 AND ~ 1 % < 6 THEN Sel% -- 1 ' ~ i m d datapoints first IF Sel% > 1 AND Sel% < 5 T H E N IF PlotGr% = I T H E N WipeAres 2: WipeArca 4: NetOnScreenFI8% -- 0: PlotGr% = 0 ENDIF ENDIF SELECT CASE S¢1% CASE 1 ResdData CASE 2 PlotDats CASE 3 ContourData CASE 4 RotateData CASE 5 StatsData ' - - S e t Defaults CASE 6 DefauilS~

191

D . A . VAN EVERDINGEN, J. A. M. VAN CJOOL, and R. M. V1SSERS

192

' ~ D O S Shell CASE 7 WipeArea 1 LOCATE 1, 1: PRINT "DOS Shell:" Menus$(2) = "Yes': Menus$O) = "No" ExplainS('2) = "Go to DOS" IF NetOnScrceaFlg% ffi I OR P1o~r% = 1 THEN Explain$(2) = @ @ExplainS(2) + "(Note screen will he cleared)" ExplainS(3) = "Cancel and return to program" Menu Menus$(), ExplainS(), Q%, 0 IFQ% =2THEN 'Yes NctOnScrecnFlg% = O: PlotGr% = 0 SCR~-~Jq 0 ' - - - O n some computen the following commented star:meatscause an out of '---memory error - probably due to the shitty QuickBASIC compiler 'E$ = ENVIRON$('PROMPT'): E$ -- "PROMPT=" + E$ 'NE$ = "PROMPT Type EXIT to return to QuickPlot$_$PSG" 'ENVIRON NE$ LOCATE 5, 1: PRINT "To get back to QuickPIot you must type ' E X I T " PRINT SHELL 'ENVIRON E$ SCREEN D.SCR ENDIF ' - - - L e a v e program and return to DOS CASE ELSE WipeArea 1 IF FllnnVlg % = 1 THEN LOCATE 1, 1: PRINT "Fabric:" Mouus$(l) = "Save': Mouus$(2) = "Don't Save" ExplainS(l) = "Mod.Flinn/Tri. fabric Diagram not saved V

ExptmS(2) = Hxp~in$(l) IF Batch% = 0 THEN Menu Menm$(), ExplainS(), Sel%, 0 ELSEIF Batch % ffi 1 THEN Sel% = 1 ENDIF IF Sel% = I THEN WlpeArca 1 L O C A T E l, I: PRINT "Which:" Menm$(l) ffi"Mod.Fl.': Menus$(2) ffi"Tri." ExplainS(l) ffi "Save modifmd Flina diagram" ExplainS('2) -- "save triangular fabric diagram" IF Batch% ffi 0 THEN Menu Mouus$(), ExplainS(), Sel %, 0 EI.~EIF Batch % = I T H E N PrintOutS = PrintOutS + " N O W "

IF Mn)S(Oper$, ], 5)

= "FLnqN" THEN Sol% ffiI ELSEIF MID$(Oper$, 1, 5) = "TRIAN" THEN Sol% = 2 ENDIF ENDIF IF Sel% = 1 TI-IF~ PrintFlinn L E i 2 ( ) , LE23(), SetName$(), ECmmt% ELSE PrintVollmer PVaI(), RVaI(), GVaI(), SetName$(), ECotmt% ENDIF ENDIF ENDIF WipeArea 1 LOCATE 1, 1: PRINT "Leave program:" Menus$('2) = "No': Menus$O) -- "Yes" ExplainS('2) = "Cancel, return to program': Explain$O) ffi "Exit to DOS" IF Batch% ffi 0 T H E N Menu Menus$(), ExplainS(), Sol%, 0

Processing orientation data with QuickPlot

ELSEIF Batch% = 1 THEN

Sel% = 3 ENDIF IF Sel % = 3 THEN GOT* EndS*ere.: ENDIF END SELECT ' - - P r i n t file name at boOxxn of screen IF Numb% > 0 T H E N WipcAre~ 3

IF NoG$ = " " T H E N LINE (0, (D.ML - I) * D.CY)-(14 * D.CX, (D.ML @ @- 3) * D . C Y - 3 ) , , B LOCATE D.ML - 2, 2 IFF$ <> "'THEN PRINT UCASE$(F$); ELSE PRINT "KEYBOARD'; ENDIF LOCATE D.ML - 1, 2: PRINT "N = "; : PRINT USING "##g"; Numb%; ENDIF GOTO Stere.Menu: ' - - E n d of Program ' - - E r r o r trapping Gencrr: Neff% -- ERR RESUME NEXT EndStereo: SCREEN 0 CLS END ' ~ D A T A PLOTrIN'G SUB PlotData '----Subroutine to plot the data on the stereo net DIM GrratC(20, 2) Pohms % = 0 IF MID$(Oper$, I, 5) = "EIGHT" T H E N C h g C m t L ~ X X X % , Y Y Y % WipcArea 1 ' ~ t h e r c is • plot in graphics part IF NetOnScreenFlg% ffi 1 ErasePlot CircleFlg, PicFlg, Nmnb%, Pictures

ENDIF IF NoG$ ffi"Y" T H E N L O C A T E 12, 45: C O L O R 16, 15: @ @ P R I N T "PLOTTING': C O L O R 7, 0 '--Check ifoutput will be needed for P G R A P H compaU~vle *'de PicPilcOpen PictureS, PicFlg, "P', F$ IF MID$(MultI~$, 3, I) < > "M" A N D Mode% < 3 T H E N F ~ % = 1: F l g l % = 0 F O R I = I TO 8: ExplainS(1) = "SelectData-Symbol for plotting':NID(T I WipeArea I WHILE Flgl% = 0

IF Flg% = l T m ~ WipcA~.a 1 FOR I = 1 TO 6: Menus$(l) = LTRIM$(RTRIM$(STR$(I))): NEXT I Menus$(7) = "More" FORPT% = I T * 6 IF NoG$ = " " THEN : PSET (D.CX * (3 + PT% *9) + 8, @ @D.CY / 2): DRAW PT$(PT%) NEXT PT%

F~% ELSE

=2

WipeArea 1 FOR I = 1 TO 3: Meaus$(1) = LTRIM$(RTRIM$(STR$(I + 6)))@ @ N E X T I: Menus$(7) ffi "Previous" Menu,S(4) = "A": Menus$(5) = "B': Menus$(6) = "C"

193

t94

D . A . VAN EVERDINGEN, J. A. M. VAN GOOL, and R. M. VISSERS

FOR PT95 = 1 TO 6 IF NoO$ = " " THEN : PSET (D.CX * (3 + PT95 * 9) + @ @ 8 , D . C Y / 2 + 2): DRAW PT$(PT95 + 6) NEXT PTg$ F~95

=

1

ENDIF IF Batch95 = 0 THEN Menu Menus$(), ExplainS(), PT95, 0 ELSEIF Batch95 = 1 THEN PT% = VAL(Symbol$) ENDIF IF PT95 < > 7 THF3q Flg195 = 1 IF Fig95 = 1 THEN PT95 = PT95 + 6 WEND IF PT% = -1 THEN GOTO EndPIotData: 'If multiple data set check which symbol or if all are to be plotted ELSEIF Batch95 = 0 AND MID$(MultFIg$, 3, 1) = "M" THEN II = 1: FOR I = 1 TO 13: Sets(l) = 0: NEXT I FOR I = 1 TO Numb95 Okay95 = 0 FORJ = 1 TOII IF Sets(J) = Symb95(1) THEN Okay95 = 1: EXIT FOR NEXT J IF Okay95 = 0 THEN Sets(I1) = Symb95(I): II = II + 1 NEXTI Sets(13) = I I - 1 PickSymbol: WipeArea 1 LOCATE 2, 1: PRINT "(Set numbers present in data: "; FOR I = 1 TO Sets(13): PRINT Sots(l); " "; : NEXT I: PRINT ")" LOCATE 1, 1 PRINT "These data have "; Sets(13); " sets, enter set number to plot @ @(A for all): "; INPUT ; " ", WhatSymb$

WhatSymb$ = UC^S~(W~tSymb$) IF Wha~Symb$ = CHR$(13) T H E N G O T O PickSymbol: Query WhalSymb$, NumJF~ 95 IF NumFl8 95 = 1 AND WhalSymb$ < > "A" THEN GOTO PickSymbol: 'Make sure the cntcred number is one of the possible choices Okay95 = 0 FOR I = 1 TO Sets(13) IF VAL(WhatSymb$) -- Sets(l) THEN Okay 96 = 1 NEXTI IF WhatSymb$ < > "A" AND Olmy95 ffi 0 THEN GOTO PkkSymbol: IF OWSymb$ < > "" AND OWSymb$ < > WhatSymb$ THEN EigenFig = 0: FisberFIg = 0: PiFig = 0: VFIg 95 = 0 ENDIF ENDIF W~,Area 1 PlotCir¢i¢ XX95, YY95, R95, YRATIO, PieFIg, CireleFig, XXX95, YYY95 LOCATE 1, 1: PRINT "Plotting data .... " NetOnScreenFIg95 = 1 Points95 = 0 FOR I = 1 TO Numb95 IF Mode95 < 3 OR (Mode95 -- 4 AND Symb95(1) = 2) THEN RSQ = R 95 * SQR(2) DD = RSQ * S I N G ' h e r R ( l ) / 2): D D N = D D * YRATIO XPT = DD * SIN(AzR(1)): YPT = DDN * COS(AzR(I)) ENDIF IF NoG$ = " " THEN IF M I D $ ( M u l t F i 8 $ , 3, 1) < > "M" AND Mode95 < 3 THEN PSET ( X X % + XPT, Y'Y95 - YPT): DRAW PT$(PT95) ELSEIF M I D $ ( M ~ $ , 3, 1) = "M" AND Mode95 < 3 THEN PT% = Symb95(l) IF Batch95 = 0 AND WhalSymb$ < > "A" THEN 'Check if there is • match botweqm the choten t,~M~ol and the data record symbol

Processing orientation data with QuickPlot 'if so plot the symbol IF Symb%(l) ----VAL(WhatSymb$) T H E N PSET fX'X% + XPT, Y Y % - YPT): D R A W PT$(Irr%) Points% = Points% + 1 ENDIF ELSEIF Batch% = 1 OR WhalSymb$ = "A" THEN PSET (XX% + XPT, YY% - YPT): DRAW PT$ff'T%) ENDIF ELSEIF (MID$0dultlqg$, 3, 1) = "M" AND Mode% = 4) OR @ @Mode% = 3 THEN PiFlg% = 0 ' - - p l o t slickenside lineations IF Symb%(I) = 2 THEN PT% - - 6 PSET (XX% + XPT, Y'Y% - YPT): DRAW PT$(PT%) ' - - p l o t great circles ELSEIF Symb%(l) = 1 OR Mode% = 3 THEN GreatCircle AzR(I), ThetR(1) ENDIF ENDIF END IF ' - - t h e following few lines put the points into a .PIC style format so that ' - - t h e data can be printed using Lotua (R) PGRAPH IF PicFIg = 1 AND (Mode% < 3 OR (Mode% = 4 AND Symb~(1) = @ @2)) THEN IF LEN(Picture$) > 1000 THEN 'If longer then lkB - dump to file PDump PictureS, Numb%, "P', F$, DumpFig ENDIF PDD = PieR% * SQR(2) * SIN(ThetR(I) / 2) XXI% = XXX% + PDD * SIN(AzR(I)): YYI% = YYY% - PDD *@

@COS(AzR(D) IF MIDS0dutt~8$, 3, 1) = " M " A N D Mode% < 3 T H E N PT~ = Symb%0)

IF Batch% = 0 AND WhalSymb$ < > "A" THE/q ' - - - - C h e c k if there is • match between the chosen symbol and the data

' - - r e c o r d symbol if so plot the symbol IF Symb%(1) = VAL(WhatSymb$) THEN PDrawSym PictureS, X X I % , Y Y I % , PT%, ipen% 'draw to .PIC ENDIF 'file ELSEIF Batch% = 1 OR WhatSymb$ -- "A" THEN PD.rawSym PictureS, X X 1%, Y Y 1%, PT %, ipen% 'drawto .PIC END IF ' file ELSE PDrawSym PictureS, XX1%, YY1%, PT%, ipen% 'draw to .PIC file ENDIF ENDIF NEXTI NetOnScremFtg% = 1 ' - - Sum Piecing

PrintToPlct P A ( ) , P ( ) , "P" ' m End of platting EndPiotData: END SUB '-----~PUT DATA ' - - I n p u t data files SUB ReadData MaxNumb% -- 1000 ERASE VeetorData DIM E L O ) DIM dummyarray('2, Nmnb%) DIM AZ(MaxNtanb%), HEL(MaxNumb%) ' - - - S e t the old kotmtcr to 1 if no data IF Numb% = 0 T H E N O I d K % = 1 ' - - R e m e m b e r old f'de name OF$ = F$ WiI~A m 1

195

196

D . A . VAN EVERDINGEN, J. A. M. VAN GOOL, a n d R. M. VISSERS

Readanotheffde: ' - - R e a d in Data From Disk IF Datalnput$ = " D A T A F I L E " T H E N FindAnother: IF Batch 96 = O T H E N Choices = " " W H I L E ChoiceS = " " WipcArca 1 IF Numb% < > 0 T H E N L O C A T E 2, 1: PRINT " A p p e n d / A to name@ @to add data to last set" FA$ = "" L O C A T E 1, 1: PRINT SPACES(70): L O C A T E 1, 1 INPUT ; "Give fde name ( ? = f o r listing; wildcards okay; dir = @ @change dir): ", FA$ ' - - - - C h e c k for invalid inputs of/,X,:; and valid ones of ?,dir,* IF FA$ = "/" T H E N GOTO FindAnothcr: 'Invalid input ColonFlg % = 0

F O R I = I T O LEN(FA$) IF MID$(FA$, I, 1) = "\" OR MID$(FA$, I, 1) = ":" T H E N @

@Col~ = I NEXTI IF ColoeFlg 9~ = I T H E N G O T O FindAnothcr: FA$ = UCASE$(FA$) IF FA$ = "DIR" T H E N StDrivcDircc DataDirln$ GOTO FindAnothcr: ENDIF ST% = 0 FOR I = 1 T O LEN(FA$) IF M~D$(FA$, L I) = "*" OR MID$(FA$, i, I) = "7"@ @ THEN ST~ = I

NEXTI '--File

name was typed in IFST~ = 0 THEN C h o k e s = "made" IF RIGHT$(UCASE$(FA$), 2) = "/A" T H E N

FA$ = LEFr$(FA$, LEN(FA$) - 2) AddS = "/A" ENDIF '-----Get f'de name from menu E L S E I F ST96 = 1 T H E N W~e.Area 1 L O C A T E 2, 8: PRINT "(for f'des in "; DataDirln$; ")" F.c,.~$ = " W H I L E File.SpecS = "" IF F A $ = "7" T H E N FilcSpec$ = "* *" ELSE FileSla~C$ = FA$ ENDIF A d d s = "" IF RIGHT$(UCASE$(FileSpec$), 2) = "/A" T H E N FiicSpec$ = LEFT$(FileSpec$, LEN(FileSpec$) - 2) AddS = "/A" ENDIF WEND L O C A T E 1, 1: PRINT SPACES(70): L O C A T E 2, 8: PRINT@ @SPACES(60) L O C A T E 1, 1: PRINT "Give fde name: " FilcMenu DataDirln$ + FileSpe¢$, FA$, Choices IF F A $ < > "" T H E N L O C A T E 1, 17: PRINT FA$ ENDIF IF ChoiceS = "not made" T H E N C h o k e s = " " WEND ' - - - C h e c k if data file is to be added to previous data (add "/A"

Processing orientation data with QuickPlot

'~to

f'de name) IF Numb% < > 0 AND AddS = "/A" THEN

AddFlg =

1

OldK% = Numb% + 1 ELSE AddFlg -- 0 ENDIF ' ~ F $ is a global variable; FA$ is not: so reassign the file name F$ = FA$ ELSEIF Batch% = 1 THEN ^dd~g

= 0

ENDIF ' - - - B l a n k input IF F$ = "" THEN GOTO Find.Another: CLOSE #1 Files = DataDirIn$ + F$ ' - - - C h e c k for file existence FileExist FileS, E% IF E% = 0 THEN 'File Doesn't exist QI$ = "P" WHILE INSTR(" Q ' , QI$) = 0 WipeArea 1 LOCATE 1, 1: PRINT "File Doesn't Exist. Press any key to continue @ ( ' Q ' = Exit)* QI$ = UCASE$(INPUT$(I)) IF QI$ = CHR$(13) THEN QI$ = " " IF QI$ = CHR$(27) THEN QI$ = "Q" WEND WipeArea 1 IF QI$ = "Q" THEN ' ~ r e u s e old f'de name, no data read: counting flag not reset F$ = OF$ GOTO EndReadDattg: ENDIF OOTO FindAnother: ELSEIF E% = 1 T H E N w

^adF~

= 0 THEU

Numb% = 0 OidK% = 1 ENDIF OPEN Files FOR INPUT AS #1 ENDIF t

'--

s u m reading in data

s

LOCATE 2, 1: PRINT SPACES(79) LOCATE 2, 1: PRINT "Lmding datafile... "; UCASE$(File$) WipeArea 2 'Clear extra info off ten,ca Kouat% = 0 '----Read data into string and use parser to separate out vtlu~ IF MID$(MultI~$, 3, l) = "M" T H E N M F % = 3 ELSE M F % = 2 W H I L E N O T EOF(1) ReadMote: IF NOT EOF(I) THEN LINE INPUT #1, E$ ELSE GOTO NextS1ep: ENDIF ' ~ C a l l routine to read data string t a d parte into vah~.a NI = 0 : N 2 = 0 : N 3 = 0:. Flg% = 0 Parse E$, N I , N'2, N3, Fig% IF Fig% < I T H E N GOTO ReadMore: 'Read a blank or comment line so fred more data ELSEIF Fig% < > Ik~'% T H E N GOTO EndRead: 'Too much data or wrong data ENDIF C A G E O 18,2/3--G

197

198

D . A . VAN EVERDINGEN,J. A. M. VAN GOOL, and R. M. VISSERS '

' - - I n c r e m e n t counter since data is okay Kount% = Kotmt% + 1 IF MID$(DataFmmat$, I, I) ffi "A" THEN 'Az.-Dip AZOKotmt%) = NI: HEL(Kotmt¢~) = N2 IF MID$Odult]~$, 3, I) = "M" THEN Symb%(Numb% + O @Kotmt%) = N3 ELSEIF MID$(DataFormat$, 1, 1) = "D" THEN 'Dip Azimuth HEL(Kotmt~) = NI: AZ(Kouat%) -- N2 IF MID$(MultFIg$, 3, 1) = "M" THEN Symb~6(Numb~ + ~ @Kount%) = N3 ELSEIF MlD$(DautFonnat$, 1, 1) -- "S" THEN 'Strike/Dip AZ(Kotmt%) -- NI: HEL(Kount~) ffi N2 IF MID$(MultFIg$, 3, 1) = "M" THEN Symb~(Numb% + O @Kount~) = N3 AZ(Kount%) = (AZ(Kount%) + 90) MOD 360 ENDIF WEND NcxtStcp: CLOSE #1 Numb% = Numb% + Kount% IF Kotmt% = 0 THEN WipcArca ! LOCATE 1, 10: PRINT "NO DATA, CHOOSE ANOTHER FILE" LOCATE 2, 10: PRINT "Hit any key to continue" DO: LOOP UNTIL INKEY$ < > "" WipcArca 1 GOTO Rcadanolhcrfdc: ENDIF ELSEIF DItalnput$ = "KEYBOARD" THEN 'Read in data from kcybollrd IF Ntmab% < > 0 T H E N WipcArea I L O C A T E I, I: PRINT "Add Data:" Mcnus$(2) = "Yes': Mmus$O) = "No" Exphdn$(2) = "Add this data set to the previomly loaded cue" Explain$O) ffi "Remove first data set from m e m o ~ sad load next Kt" Menu Menem$(), Explahl$(), ANSI ~$, 0 IF ANSI % ffi 3 THEN AddFig ffi • Numb~$ ffi 0: OIdlK~ = 1 ELSE ' - - I f the dala format ha. bern clumgcd s ~ © the last data set was ~tcn:d '--mxl new dJta is to be added resetthe ~U~ormat to the o ~ I IF ODFonnat$ < > DataFonnat$ T H E N D a t a F o n ~ = ODFonMt$ AddFIg = 1: OIdK% ffi N u m b ~ + 1 ENDW ENDIF IF MID$(DatmFonmat$, I, I) ffi " D " T H E N AA$ -- "Dip/Az": A I $ -- "Dip': A25 -- =Az " ELSEIF MID$(DataFommt$, I, I) ffi " S ' T H E N A A $ ffi "Sir/Dip=: A I $ ffi "Sir": A25 ffi "Dip" ELSEIF MlD$(DitaFonnat$, 1, 1) = "A" THEN AA$ = "Az/Dip=: AI$ = =Az ": A25 ffi =Dip= ENDIF LOCATE 1, 1: PRINT "Data: =; AA$ PRINT "Input "; AI$; " < E N T E R > , "; A25; • < E N T E R > . ]~t~. =;O @AI$; " < 0 t o stop" Kouat% = 0 DO WHILE ATAqKouat%) > = 0 LOCATE !, 60:. PRINT "# Polnta: "; Kotmt56 IF Kotmt~6 > 0 THEN LOCATE2, 60:. PRINT "lE~ered:';O @AZ(Kount~6); " / ' ; HEL(Kotmt~6) Kotmt~ = Kount~ + 1 lnp~-" LOCATE 1, 23: PRINT SPACF~(3) LOCATE 1, 33: PRINT SPACES(3) LOCATE 1, 18: PRINT AI$; : INPUT ; ": =, Numbers

Processing orientation data with QuickPlot

' - - - C h e c k if input is valid number Queny NumberS, Ntm~Figg; IF NumFIg ~ = 1 THEN LOCATE 1, 23: PRINT SPACES(60) GOTO lnputAz: ENDIF IF DataFormat$ = "AD" THEN AZ(Kotmt~) = VAL(Number$) IF DataFormat$ = "DA" THEN HEL(Kotmt~) -- VAL(Number$) IF DataFormat$ = "SD" THEN AZ(Kotmt~) -- (VAL(Nmnber$) + 0 @90) MOD 360 IF VAL(Number$) < O THEN EXIT DO InputDip: LOCATE I, 28: PRINT A25; : INPUT ; ": ", Numbers Query NumberS, NumFIg IF NumFIg% = 1 THEN LOCATE 1, 33: PRINT SPACES(50) GOTO InputDip: ENDIF IF DataFormat$ = "AD" THEN HEL(Kount~;) = VAL(Number$) IF DataFormat$ -- "DA" THEN A7~Kount~) ffi VAL(Number$) IF DataFormat$ = "SD" THEN HEL(Kotmtg;) = VAL(Number$) IF M [ D S ( M u ~ g $ , 3, 1) = "M" THEN InputSym: LOCATE 1, 46: PRINT SPACES(2) LOCATE 1, 38: INPUT "Symbol: ", Numbers Query NumberS, NumFlg IF NumFIg 96 = 1 THEN LOCATE 1, 46: PRINT SPACES(30) GOTO lnpmSym: ENDIF Symb%(Kount%) -- VAL(Number$) LOCATE 1, 16: PRINT SPACES(50) ENDIF LOOP WipeArca 1: LOCATE 1, 1: PRINT "Save to disk:" Mcnus$(2) ffi "Yes': Menus$O) = "No" Explain$C2) ffi "Save en~red data to its o w n ilk.': ExplaiB$O) ffi@

@ ' D o net save to file" Menu Menus$(), ExplainS(), ANSI ~ , 3 F$='" Kc~mt% -- Kotmt~ - 1 IF ANSI ~ = 2 THEN SaveFile F$, A Z ( ) , HEL(), S y m b ~ ( ) , Kount~ N u m b ~ = N u m b ~ + Kount% ENDIF '--

data have been read i . either fde or keyboard mode

W AddFig = t THEN ' - - s t o r e old data in dummy so the AZR and ThetR arrays can be redimeasioned FORI = ITOOklK~-I dummyarray(l, 1) ffi AzR(1) dummyarray(2, l) -- "I'netR(I) NEXTI ENDIF ERASE AzR, T h e i r REDIM A z l t ~ u m b ~ ; ) , T h e t l t ~ e m b ~ ) IF AddFlg = I THEN FORI = ITOOIdK~-I AzR(I) -- dummyarray(l, I) ThetR(1) = dummyarrsy(2, I) NEXTI ENDIF PickMode: W~peArea I LOCATE I, I: PRINT "Nature of the Data:': PRINT Me~us$O) = "Planes"

199

200

D . A . VAN EVERDINGEN,J. A. M. VAN GOOL, and R. M. VISSERS

ExplainS(3) = "Data a ~ planes (to be plotted as poles)" Menus$(4) = "Lines" ExplainS(4) = "Data are lineatbms" Menus$(5) = "Great" ExplainS(5) -- "Data are planes (to be plotted as great circles)" Menus$(6) ffi "Muit" ExplainS(6) ffi "Multiple data: Planes as great circles and lines as points" Menus$O) ffi "Ikd/Clesv" ExplainS(7) = "Data arc alternating bedding/cleavages (results are lines)" IF Bateh% = 0 T H E N Menu Menus$(), ExplainS(), Mode%, 0 M o d e % -- M o d e % - 2 E L S E I F Bateh% = 1 THEN IF M I D $ ( U C A S E $ ( N M o d d ) , I, 5) = " P L A N E " T H E N M o d e % ffi I IF M I D $ ( U C A S E $ ( N M o d e $ ) , I, 4) = "LINE" T H E N M e d e % = 2 IF M I D $ ( U C A S E $ ( N M o d d ) , I, 5) = " G R E A T " T H E N M o d e % = 3 IF MID$(UCASE$(NMode$), I, 4) = "BOTH" THEN Mode% = 4 IF MID$(UCASE$(NMode$), I, 4) = "INTER" THEN Mode% = 5 ENDIF 'MODE indicates data are either 1-planes 2-1inestions 3-planes(grest circles) '4-planes(great circles) & linestions(points) or 5-beddingplanes/eleavegelines LOCATE 1, 1: PRINT "Loading data in memory" PRINT "Please wait...': LOCATE 3, 1 SELECT CASE Mode% CASE I FOR I ffi 1 TO Kotmt% AzR(I + OIdK% - 1) ffi ((AZ(1) + 180) MOD 360) * Grad TbetR(l + OIdK% - 1) -- HEL(1) * Grad NEXTI CASE 2 IF MID$(DataFonnat$, 1, I) < > "S" THEN FOR I -- 1 TO Kotmt% AzR(I + OklK% - 1) ffi Az(r) * Grad ' r h ~ O + O l d X % - 1) = (9O - HEL(D) * Grad NIDtW I ELSE 'in str~e & dip format subtract 90 degrees for lineations FOR I = 1 TO Kotmt% AzR(I + OklK% - 1) ffi ((AZ(I) + 270) MOD 360) * Grad TbeOt(l + OklK% - 1) = (90 - HEL(1)) * Grad NEXTI ENDIF CASE 3 FOR I -- 1 TO Kouat% AzR(I + O l d K % - I) ffiA Z ( D TbetR0 + O l d K % - I) = H E L f D NEXTI CASE 4 F O R I = I TO K o u n t % S T E P 2 A z R 0 + O h / K % - I) ffiA Z ( D TbetR(I + O l d X % - 1) ffi HEL(I) AzR(I + O k l K % ) ffiAZ(I + I) * Grad TbetR(l + OklK%) ffi (90 - HEL(I + I)) * Grad NEXTI CASE 5 Po****o.o**et****qldtetls**********OpJ~[~lC8 ~ 8t******O***@dt****o,oer*** ' Calculate intorsectinm between: ' - - I ) lineatinm from plaae~: 2) planea from lines: 3) pluage, from pitehes ' - - F r o m : Duncan, A.C.; 1985; PLANE: An Interactive Program For Calculating ' ~ I n t e n ~ c ~ o a Lineafions From pirates, ~ From Lines, and Plunges From '~Pit~hes ' Note: Parallel data pairs are removed from the data set ( P > 0 ) ' Note: This is net put as • separate subroutine because AZ and HEL are '~ no longer global variables P ffi O: C e t m t e r %

ffi 1

F O R II ffi 1 T O K o t m t % S T E P 2

Processing orientation data with QuickPlot

-Test if plane8 are// w A Z ( n ) = AZ(N + I) A N D HEL(II) ffi HEL(II + I) T H E N P = P + I: GOTO DoNcxtOne: ENDIF - T e s t if both are horizental IF HEL(ID ffi 0 A N D HEL(II + I) = 0 T H E N P = P + I: GOTO DoNextOne: ENDIF -Teat if both are vertical IF HEL(ID = 90 A N D HEL(II + I) = 90 T H E N Test = ABS(AZ(II) - AZ(II + l)) IF Test = 0 O R ABS(Test - 180) = 0 T H E N P = P + 1: G O T O DoNextOne: ENDIF R1 = 9 0 : R 2 = 0 G O T O UseThisOne: ENDIF - T e s t if one is horizontal IF HEL(II) = 0 OR HEL(II + 1) ffi 0 T H E N IF HEL(II) ffi 0 T H E N R2 ffi AZ(II + 1) + 90 IF H E L G I + 1) = 0 T H E N R2 ffi AZ(II) + 90 R1 = 0 I F P . 2 > 360 T H E N R2 = R 2 - 360 GOTO UseThisOne: ENDIF -Test if strikes are parallel Test = ABS(AZ(II) - AZ(II + 1)) IF Test = 0 O R ABS(Test - 180) = 0 T H E N R2 = AZ(ID + 90 RI = 0 I F R 2 > 360 T H E N P.2 = R 2 - 3 6 0 GOTO UseThisOne: ENDIF -.Convert to radians F O R I = 0 TO 1 AZ(II + I) = Grad * AZOI + I): HEL(II + I) -- Grad * HELOI + I) -Calc line length s = s n ~ ( H E L ( n + I)) I F S ffi 0 T H E N S ffi .0000000001# IFs = I THEN Cot= 0 E L S E I F $ ffi 0 T H E N Cot = I E + 2 0 ELSE Cot = C O S ( H E L 0 1 + D) / S ENDIF EL(I + D = c o t NIDcr I -Cal¢ plunge and plunge direction of lineation E = SlN(AZ(I1) - AZ(II + I)) WE = 0 THEN E = .000(gXg~l# X = (EL(I) * S m ( A Z ( R + l)) - ELf2) * s n q ( A z 0 D ) ) / ~Y - (EL(I) * C O ~ A Z ( I I + l)) - EL(2) * COS(AZ(ID)) / E - C a k Phi and P.ho values (i.e. plunge & direction) ELi3) = SQRtX * X + Y * Y ) IF ~ ( 3 ) = 0 T H E N E L O ) = .0000000001# Rho = A T N ( I I / EL(3)) W X = 0 T H E N X = .0000000001# Phi ffiATN(SQR(1 - (X / F-J..O)) * (X / ELO))) / {X / ELO))) RI = CINT(Rho / Grad) R2 = CINT(Phi / Grad) -test plunge azimuth (R2) and convert to 360 degree format IFY > 0THEN IFR.2 > 0 T H E N R2 = 1 8 0 - R2

201

202

D . A . VAN EVERDINGEN,J. A. M. VAN GOOL, and R. M. VISSERS

ELSE R2 = ABS0t2) ENDIF ELSE R2 : 180 + R2 ENDIF UseThisOnc: ' - - P u t the resultant mteraections into the azimuth and dip arrays AZ(Coonter96) : R2: HEL(Coonter~) : RI Counter% : Coonter% + I DoNextOne: N E X T 11 '-----Set Kount~ to ignore remaining part of the old azimuth and dip arrays Konnt% = Ccenter% - 1 ' - - - - I f parallel planes were found then print message IFP <> 0THEN WipeA tea 1 LOCATE 1, 1 I F P = 1 THEN PRINT "Note: 1 bedding/cleavage pair was parallel it is ignored" ELSEIF P > I THEN PRINT "Note: "; P; " bedding/cleavage pairs were parallel they @

@are ignored" ENDIF PRINT "Press any key to continue" DO: LOOP UNTIL INKEY$ < > "" ENDIF ' ~ T h e intersections are lineations: so change mode Made~ ffi 2 ' ~ S a v © the intersection data to disk WipeArea 1: LOCATE 1, 1: PRINT "Save intersections to disk:" Menus$(4) = "Yes': Menus$(5) ffi "No" ExplainS(4) : "Save bedding/cleavage intersection re~fl~ to a ['de." ExplainS(5) = "Do not u v c to a disk f'de" Menu Menus$(), ExplainS(), ANSI ~ , 0 IF ANSI % = 4 THEN F~

~

wl

IF LEFT$(DalaFormat$, 1) = "S" THEN DataFormat$ = @ @'Azimuth-Dip" IF LEFT$(DataFomlat$, I) ffi "A" T H E N SaveFile F$, A Z ( ) , HEL(), Symb%(), Katmt~ ELSEIF LEFT$(DattFormat$, 1) ffi "D" THEN SaveFile F$, HEL(), A Z ( ) , S y m b ~ ( ) , Kotmt~ ENDIF ENDIF

WipeArea 1 '

Treat data as linentiem FOR I ffi 1 TO Koontg; AzR(I + OIdK~ - 1) ffi AZ(I) * Grad ThelR(l + OklK~ - 1) ffi: (90 - HEL(1)) * Grad NEXT1 N u m b ~ ffi OldK~ - 1 + Koont~ •**************************end of planes routine ******************** CASE ELSE END SELECT EndReadData:

ERASE AZ, HEL, dmmnyarray REDIM VectorDita(l TO 3, Numb%) FOR I -- 1 TO Numb% VectofData(l, VcctorData(2, VectorDataO, NEXTI WipeA~ 1 '--Remember

!) ffi SIN(ThetR(l)) * COS(AzR(I)) I) ffi SINfrhetR(1)) * SIN(AzR(I)) 1) = COSG~etR(I))

old data format in case data is to be added to the data in memory

Processing orientation data with QuickPlot

ODFormat$ = DstaFormat$ CouaiFIg% = 0: EigenFIg = 0: FisherFIg = O: PiFIg = O: VFig% = 0 Flg% = 0: Check% ffi 0 EadReadData2: EXIT SUB EndRead: ' - - ~ R e a d data error messages '----Note that MF% =3 if MID$(MultFll,3,1) = ' M " else it is 2 WipeArea 1 F$ = OF$ IF Kotmt% < = 1 THEN IFFIg% = 1 ~ L O C A T E I, I PRINT "Data li+=ein file contains too few numbers - check ['de" PRINT "Press say key to conlinue" ELSEIF Fig % > 3 THEN LOCATE I, I PRINT "Data line in file contain too numy numbers - check fde" PRINT "Press say key to continue" ELSEIF FIg% = 2 AND MF% -- 3 THEN LOCATE I, I PRINT "Defaults are set for multiple .eta - y o e n is • simile m " PRINT "Reset in Option menu and try slain, Press any key to conlinue" ELSEIF FI8% = 3 A N D M F % = 2 T H E N LOCATE 1, 1 PRINT "Defaults are set for single sets - yours is • multiple Et" PRINT "Reset in Option menu and try again. Preu my key to continue" ENDIF ELSEIF Kount% > I THEN LOCATE 1, 1 PRINT "Data set has internal inconsistencies. Please check it out." PRINT "Press any key to continue" ENDIF DO: L O O P U N T I L INKEY$ < > "" END SUB ' - - - D A T A ROTATION 'Subroutine to mote stereaaet data SUB RotateData ' '~

Published by V i u e n , 1988

Cham~eFlag% ffi 1 indicates that dala in ThetR m d AzR dom't match data in direction emine f o n m t (veeton) mymore.

D I M AzTemp(Numb%), 1"aTemp(Numb~), AZ(Numb%), H E L ( N u ~ % ) PktOnlyl~

-- I

C'h~GcFlq% = 0 , Check if~ of m u l ~ k ~ a... an= to ~ plcaed ~teh% = 0 A N D M)DS(Mu~ls$, 3, 1) .. "M" T H E N 11 ffi 1: F O R I ffi 1 T O 13: Sets(l) ffi 0:. ~ I FOR I ffi 1 T O Numb% Okay% = 0 FORJ-- ITOll IF s i n ( J ) = Symb%0) THEN O h y ~ = 1: EXIT P O i NEXTJ IF Olmy% = 0 T t l ] ~ Sets(ll) = Symb%(l): 11 = 11 + 1

SeU(13) = 11- I PiekSymbol1: Wile.Area I LOCATE 2, 1: PRINT "(Set aumbers Immmat ia data: "; FOR I ffi I TO Sete(l$): PRINT Sela(l); " "; : NEXT I: PRINT ")" LOCATE 1, 1 PRINT "These dam have "; ~ t s ( 1 3 ) ; " ~ t a , cater set number to plot 0 @ ( A for all): "; n , ~ u T ; - -, WUamymbS WhatSymb$ ffi UCASE$(WhatSymb$)

203

204

D . A . VAN EVERDINGEN, J. A. M. VAN GOOL, and R. M. VISSERS

IF Wha~ymb$ ffi CHR$(13) THEN GOTO PickSymboil: Query WhatSymb$, NumFlg % IF N u m F 1 g % = I A N D WhatSymb$ < > "A" T H E N G O T O PickSymbol1: ' ~ M a k e sure the entered number is one of the poss~le choices Okay% = 0 FOR I = I TO Sets(13) IF VAL(WhatSymb$) = Sets(1) THEN Okay% ffi I NEXTI IF WhatSymb$ < > "A" AND Okay% = 0 THEN GOTO PickSymboll: IF OWSymb$ < > "" AND OWSymb$ < > WhatSymb$ THEN EigenFIg = 0: FisherFIg = 0: PiFIg = 0: VFIg % = 0 ENDIF ENDIF 4020 WipeArea 1 LOCATE 1, 1 PRINT "Enter rotation axis (Set Azimuth = -999 to Escape to Main Menu)" InputRA: LOCATE 2, 5: INPUT ; "Azimuth: ", Numbers Query NumberS, NumFIg W N u m ~ % = ] THEN LOCATE 2, 14: PRINT SPACES(60) GOTO InputRAENDIF RAZI = VAL(Number$) IF RAZI = -999 T H E N G O T O EndRotateData: InpulRD: LOCATE 2, 20: INPUT ; "Plunge: ", Numbcr$ Qucry Numbcr$, NumFIg % IF NumFIg% -- 1 THEN LOCATE 2, 28: PRINT SPACES(50) GOTO lnputRD: ENDIF RDIP = VAL(Number$) InputRN: LOCATE 2, 34: INPUT "Ealer right-handed ro~fioQ angle ", Numbers Query Nmnber$, NemFI8 9; IF NumFIg % = 1 THEN LOCATE 2, 68: PRINT SPACES(! 1) GOTO InputRN: ENDIF RAN -- VAL(Number$) W ~ A r e a I 'Print values to screen and confirm LOCATE 2, I: PRINT " Axis azimuth: "; : PRINT USING "#JW'; RAZI; PRINT " Axis plunge: "; : PRINT USING " g r ; RDIP; PRINT " Rotation angle: "; : PRINT USING "Mh'; RAN; LOCATE 1, 1: PRINT "Corr~t" Menus$(2) = "Yes': Mmus$(3) = "No" Meau Menus$(), ExplainS(), A N S I %, 0 IF A N S I % = 3 T H E N 4 0 2 0 LOCATE 1, 1: PRINT *Calculating ..... "; ReqateMath RAZI, RDIP, RAN, DI, a, H, N A ( ) , NB( ) F O R I -- 1 T O N u a ~ % F O R J -- I T O 3 I2.(J) = NA(I, J) * VectorData(1, D + NA(2, J) * VectorData(2, D + @ @ N A O , J) * VectorDataO, I) NEXTJ A z T e m p ~ ---ATN(LL(2) / LL(D) IF LL(1) < 0 T H E N AzTemp(1) ---AzTemp(1) + PI ThTemp(1) -- ATN(((I / LL(3)) ~ 2 - l) ^ .5) IF LLO) < 0 THEN AzTemp(1) -- AzTcmp(I) + PI IF AzTemp(1) < 0 THEN AzTemp(1) ffi AzTcn-@(I) + 2 * PI IF AzTemp(1) > (2 * PD T H E N AzTemp(1) = AzTemp(]) - 2 * Pl

Processing orientation data with QuickPlot

NEXTI RFLAG% = I W~eArea ! L O C A T E I, I: PRINT "Rotationcomplete, Show?" Meaus$O) -- "Yes': Meaus$(4) == "No" Expl~n$0) = "plot r ~ t e d point- on .on,an" ~ # . i n S ( 4 ) = " D o not p~¢ ~ t e d p ~ n ~ " Menu Menus$(), ExplainS(), ANSI %, 0 WipeArea i: LOCATE 5, 1: PRINT SPACES(20) IF ANSI % = 4 THEN 4630 'Put rotation data on ~recn LOCATE 4, h PRINT "Rotation Axis: " PRINT " Azimuth --- "; : PRINT USING "J~tW'; RAZI PRINT " Plunge = "; : PRINT USING " # # r ; RDIF PRINT " Rot.Angle -- "; : PRINT USING "###'; RAN IF NetOnScreonFIg% = 1 THEN Erueplot CircleFIg, PicFlg, Numb%@ @, Pictures 'Check if output will be needed for PGRAPH compatible fde PicPileOpon PictureS, PicFlg, "R', F$ 'Plot rO,,tion axis F r E T = DI: PAZ = • DD - R% * SQR(2) * SIN(PTET / 2) XPT% = DD * SIN(PAZ): YFT% = YRATIO * DD * COS(PAZ) IF NoG$ = " " T H E N PSET ( X X % + X P T % , Y Y % - Y P T % ) : @ @ D R A W PT$(13) IF Picplg = I T H E N PDD = PieR% * SQR(2) * SIN(PTET / 2) XXI% = XXX% + CINT(PDD * SIN(PAZ)): YYI% = YYY% -O @CINT(PDD * COS(PAZ)) PDrawSym PictureS, XXI %, YYI %, 18, ipen% 'draw to .PIC file ENDIF 'Plot rotated data PT=I4 WipcArca 1 LOCATE 1, h PRINT "Plotting data .... "; plotCircle XX%, YY%, R%, YRATIO, PicFig, CircleFIg, XXX%, YYY% Points% = 0 FOR I = 1 TO Numb% RSQ = R% * SQR(2) DD = RSQ * SiN(ThTemp(l) / 2): DDN = DD * YRATIO XPT% = CINT(DD * SiN(AzTemp(1))): YFI'% = C I N T ( D D N *@ @COS(AzTcmp0))) IF MID$(MulLFIg$, 3, 1) < > "M" THEN ' A d d 2 to the PSET X value for plotting centered upside down triangles IF N o G $ = " " T H E N PSET 0 0 [ % + X P T % + 2, Y Y % - Y P T % ) : @ @ D R A W PT$(PT) EI~EIF MID$0dultlFlg$,3, I) = "M" AND Mode% < 3 THEN IF Bitch% = 0 AND WlmtSymb$ < > "A" THEN '~k if there is • match between the chosen symbol and the data record t~mbol 'if so plot the o, mbol IF Symb%(1) = VAL(WhalSymb$) THEN IF N o O $ -- " " T H E N PSET 0 C ~ % + X P T % + 2, Y Y % - Y P T % ) : @ @ D R A W PT$(PT) Points% = Points% + 1 ENDIF ELSEIF Batch% = I O R WhatSymb$ = "A" THEN IF NoG$ = " " THEN PSET ( X X % + X P T % , Y Y % - Y P T % ) : @ @ D R A W PT$(Symb % (1)) ENDIF ENDIF '= the followingfew linesput the pointsinto• .PIC styleformat ' ~ a o thatthe data ram be prited using Lotus (R) P G R A P H IF PicFlg = 1 T H E N IF MID$(MultFIs$, 3, 1) < > "M" THEN PT% = PT 'Set symbol type IF I MOD 150 = 0 THEN 'If more than 150 pta - dump to fde r D o n ~ PictureS,N e m b % , "R', F$, D u m p F ~

205

206

D . A . VAN EVERDINGEN, J. A. M. VAN GOOL, and R. M. VISSERS

ENDIF PDD = PicR% * SQR(2) * SIN('rhTemp(1) / 2) X X I % - - X X X % + CINT(PDD * SlN(AzTemp(1))) YYI % = YYY % - CINT(PDD * COS(AzTemp(D)) '---C'beck for multiple data sets if all points are to be plotted IF M]D$(]VlultFIg$, 3, 1) = "M" AND Mode% < 3 THEN PT% = Symb%(D IF Batch% = 0 AND WhatSymb$ < > "A" THEN IF Symb%(l) = VAL(WhatSymb$) THEN PDrawSym PictureS, XXi %, Y~'1%, PT%, ipen% 'draw to .PIC END IF file EI~EIF Batch% = 1 OR WhatSymb$ = "A" THEN PDrawSym PictureS, XXI %, YYI %, PT%, ipon% 'draw to .PIC ENDIF ' file ELSE PDrawSym PictureS, XXI %, Y'YI %, PT%, ipen% 'draw to .PIC file ENDIF ENDIF NEXTI ' - - F o r ease of programming output the plot if wanted at this point PlotTitle Numb%, Mode%, PicFIg, PlotOnlyFIg, Menus$( ) WipcArea 1

L O C A T E I, l: PRINT "Make a printout:" IF Batch% = 0 T H E N Monus$(2) = "Yes': Menus$(3) = "No" IF PicF~g = I T H E N S$ = "Lotus (R) compatible PIC file." Menus$(4) = "Later" ExplainS(4) = "Save data to file & leave open to add more data later" ELSE S$ = "print of green." ENDIF ExplainS(2) = "Make " + s $ ExplainS(3) : "Do not make printout" Menu Monus$(), ExplainS(), ANSI %, 0 ELSEIF Batch% = 1 THEN ANSI% = 2 ENDIF IF ANSI % = 2 OR ANSI % = 4 THEN IF PicFig = 1 THEN PMove PictureS, 1, 1764 PTcxt PictureS, 0, 1, "Rotation axis (" PDrawSym PictureS, 146, 76, 18, ipon% PMove PictureS, 680, 1764 PText PictureS,O, 1, " ) : " PMove PictureS, 1, 1680 Msg$ = " Azimuth = " + STR$(RAT_J) PText PictureS, 0, 1, Msg$ PMove PictureS, 1, 1596 Msg$ = " P l m g e = " + STR$(RDIP) PText Picture3, 0, 1, HagS PMove PictureS, 1, 1512

M~g$ = " Rot.AaSte =" + MIDS(STRSfRAN), 1, 3) PTcxt PictureS, 0, 1, M ~ $ IV MID$(MuitI~$, 3, !) < > "M" T m ~ PDrawSym PictureS, 20, 151, 14, ipea% PMove PictureS, 80, 1428 PTcxt PictureS, O, 1, " -- Rotated pts." ENDIF IF ANSI% -- 2 THEN P C I o ~ Picm~.~ E/~E Wq~.Aren 3 W~.Area 5

Processing orientation data with QuickPlot

eheckpdnter2: LOCATE 1, 1: PRINT "Checking printer" LPRINT " " + CHRS(g) '**print space/backspace WipeAre. I IF Neff% < > 0 T H E ~ '** printer is not on line BEEP Neff% = 0 LOCATE 1, 1: PRINT "Printer not ready. Check printer and press any@ @ key to continue." PRINT "(press escape to return to main menu)" DO: aS = INKEY$: LOOP WHILE aS = "" WipeArea 1 IF aS = CHR$(2"7) THEN GOTO endprinl2 ELSE GOTO checkprinter2 ELSE '** do screendump IF D.SCR = 3 THEN '*** Hercules screen put 0 in keyboard DEF SEG = &H40 '*** buffer for monoprt POKE &HIA, &HIE POKE &HIC, &H20 POKE &HIE, 48 ENDIF CALL interrupt(&HS, lnReg, OutReg) '*** printscreen LPRINT CHRS(12) '*** fonnfecd ENDIF ENDIF ENDIF endprint2: NetOnScrccnFlg% = 1 4630 : RFLAG % = 0 WipeArea 1 LOCATE 1, 1: PRINT "New rotation:" Menus$(2) = "No': Menuss(3) = "Original': Menuss(4) = "Rotated" ExplainS(2) = "Continue, do not try another rotation" Explains(3) = "Rotate original data set using another axis of rotation" Explains(4) = "RoUte rotated datasct using anclher rotation axis" Menu Menus$(), ExplainS(), ANSI %, 0 IF ANSI % = 3 THEN 4020 IF ANSI % = 4 THEN FOR I = I TO Numb% VectorData(l, 1) -- SIN(ThTemp(l)) * COS(AzTemp(I)) VectorData('2, I) -- SINO'hTemp(l)) * SIN(AzTemp(l)) VectorDataO, I) = COS(ThTemp0)) NEXTI ChangeF~% = I GOTO 4020 ENDIF LOCATE I, I: PRINT "Further proce.ing of rotated data:" Menus$(5) = "Yes': Monuss(6) ffi "No" Explains(5) = "Rotated data set used in further actions" ExplainS(6) ffi "Orighud data set used in fuaher actiom" Menu Menus$(), ExplainS(), ANSI %, 0 IF ANSI % = 6 THEN 4950

IF Datalnlmt$ = " K E Y B O A R D " T H E N L(K~ATE 2, I PRINT "Non-saved originaldata will be lostunless saved now I" P$ ffi "Retted Set" LOCATE 1, 1: PRINT "Save data:" Mmus$O) ffi "Save Data': Mmus$(5) -- "Don't Save" Menu M m u s $ ( ) , F~plains(), ANSI %, 0 IF ANSI % = 3 THEN Calr~veAzHel AzR(), ThctR(), A Z ( ) , HEL( ) ENDIF An$ -- " " FOR I = I TO 11: Menus$(l) •ffi " ' : ExplainS(l) ffi "': NEXT I Menus$O) = "Yes': Menuss(4) ffi "No" WipcAr~. l LOCATE 1, 1: PRINT "Save rotated data:"

207

208

D . A . VAN EVERDINGEN,J. A. M. VAN CrOOL, and R. M. VISSERS Explah~$O) -- "Save rotated data to fdc" ExplainS(4) = "Do net .ave rotated data" Menu Menus$(), ExplainS(), ANSI %, 0 IF ANSI % = 3 THEN CakSaveAzHel AzTemp(), ThTemp(), A Z ( ) , HEL( ) FOR I ffi I TO N u m b S : AzR(I) = AZTemp(I): ThetR(1) = ThTemp(I): NEXT I WipeArea 1 Coentlqg$ = 0 FJgenFlg = 0: FisherFlg = 0 PiFIg = 0: VFlg ~ = 0

Cl~geFt~

=

1

L O C A T E l, 1 PRINT "Rotated dataset is now resident. Press " key to continue" DO: LOOP UNTIL INKEY$ < > "" 4950 IF ChangeFlag % = 1 THEN

OumgeFt~g~ - - o WipcArea 1 LOCATE l, l PRINT "Recalculating vectors. Please wait." FOR I = 1 TO Numb% VectorDat*(l, 1) = SIN(TheIR(1)) * COS(AzR(I)) VectorData('2, 1) = SIN(ThctR(I)) * SIN(AzR(1)) VectotDam(3, O = COS(TheIR(I)) NEXT I ENDIF RFLAG% = 0 EadRotatcDala: ERASE AzTemp, ThTcmp, AZ, HEL WipeArea 2 END SUB ***************************************************************

SUB RotatcMalh (RAZI, RDIP, RAN, DI, a, H, NA(), biB()) a = RAZI * Grad: DIP = RDIP * Grad: DI = PI / 2 - DIP: H --@ @RAN * Grad NA(1, 1) = COS('): NA(2, 1) = SIN(,,): N A 0 , 1) = 0 NA(I, 2) = -SIN('): NA(2, 2) = COS(a): N A O , 2) = 0 NA(I, 3) = 0: NA(2, 3) = 0: NA(3, 3) = 1 NB(I, I) = COS(D1): NB(2, 1) = O: NBO, 1) = -SIN(DI) b m O , 2) = 0: NB(2, 2) = 1: NBO, 2) = 0 NB(I, 3) = SIN(DI): NB(2, 3) = 0: NBO, 3) = COS(DI): GOSUB 4800

N B O , 1) = COS(H): NB(2, I) ffi-SIN(H): N B O , I) = 0 N B O , 2) = SIN(H): NB(2, 2) = COS(H): N B O , 2) ffi0 NB(I, 3) = 0: NB(2, 3) -- 0: NB(3.3) -- 1: GOSUB 4800 N B 0 , i) = c o s ( m ) : NB(2, D = 0: N B O ,

D = SIN(DD NB(I, 2) = 0: NB(2, 2) = I: NB(3, 2) = 0 NB(I, 3) = -81N(DI): NB(2, 3) = 0: NB(3, 3) = CO8(DI): G O S U B

4800

NB(I, I) = COS(a): NB(2, I) = -SIN(a): N B O , I) ffi0 N B O , 2) = SIN(a): NB(2, 2) = c o s ( a ) : N B O , 2) = 0 NB(I, 3) -- 0: NB(2, 3) ffi 0: NB(3, 3) ffi 1: GOSUB 4800 GOTO Ro~tenmthc~l: 4800 FOR J - - 1 T O 3 : F O R I = I T O 3 NC(I, J) ffiNB(I, F) * NA(I, I) + NB(2, J) * NA(I, 2) + NB(3, J) @ @* NA(I, 3) NEXT I: N E X T J FOR J = 1 TO 3: FOR I = I TO 3: NA(I, J) = NC0, J): NEXT I: NEXT J RETURN

Processing orientation data with QuickPlot

Rotatematbend: END SUB ' - - D a t a for subroutine Uniform - uniformity testing lookup table DATA .7, .642, .597, .56, .529, .503, .48, .46, .442, .427, .413, .4, .388 DATA .377, .367, .358, .35, .342, .334, .328, .321, .29, .27, .26, .24, .23 DATA .16, 7.185 ' - - - S E T - U P F O R RUNNING PROGRAM IN BATCH M O D E *********************************************************************

DEFINT l-N SUB BatchHcip CLS : IF NoG$ = " " THEN LINE (1, I)-(D.MX, D.MY),, B LOCATE 2, 30 PRINT "BATCH File Format:" LOCATE 4, 5 PRINT "Line 1: Full pathueme of directory where data files are (e.g. C:\DATA)" LOCATE 5, 5 PRINT "Line 2: Full pathname of directory for destination of output f'des" LOCATE 6, 5 PRINT "Line 3: Type of data: AD-Azimuth Dip, DA-Dip Azimuth, S-Strike Dip" LOCATE 7, 5 PRINT " MULT - Mult. data sets (Azimuth Dip Symbol#); GREAT circle@ @plot" LOCATE 8, 5 PRINT "Line 4: Mode type: PI.ANE=planeslLINE=FmeationslGREAT=great@ @circles" LOCATE 9, 5 PRINT "Line 5: The operation you want to perform on the data: PLOT-plot data" LOCATE 10, 5 PRINT " use PLOT## (##= 1-12 for diff. ~ n b o l s ) CONTOUR-use Gaus.q@ @weight" LOCATE 11, 5 PRINT " contouring: EIGHT?-8 plots/page ~ = P for plotm,C for contours" LOCATE 12, 5 PRINT " B for both.Plot statistics: ?EIGEN=eigen analysis ?FISHER=disp-" LOCATE 13, 5 PRINT " persion on • sphere, ?PI-Pi girdles (7=STATS to save to file," LOCATE 14, 5 PRINT " 7=PLOTS to put on net, ?=CONTS to contour): FLINN for@ @diagram" LOCATE 15, 5 PRINT "Line 6: Output to PIC file or SCREEN dump to printer" LOCATE 16, 5 PRINT "Line 7: If Contouring~ounting pt density 10,15 or 20 (Low, Meal, High)" LOCATE 17, 5 PRINT "Line 8: If Contouring & output to SCREE.N then fdl:@ @0,1,2 (none,some,all)" LOCATE 18, 5 PRINT "Line 9 to the file end contain the fde name• (one name in each row)" LOCATE 19, 5 PRINT" E.g. JUHKI.PLT" LOCATE 21, 5 PRINT "Blank files will cause program to halt. "Fnis format MUST be followed." LOCATE 24, 25: PRINT "Preu any key to continue'; DO: LOOP UNTIL INKEY$ < > "" CLS END SUB

DEFSNG L-N , *~oe~seee~cJoeoeteoeleQeQeotQsosoQ~ooseeeso~e~oo~e~s~os~eeI~ottesl

' r e R e a d Imtch file to get input parmnmers SUB B a t c h l n ~ (Opcmtion~, FlgSB~, S c I ~ ) '----Set correct data directory

209

210

D . A . VAN EVERDINGEN, J. A. M. VAN GOOL, and R. M. VISSERS

IF Operation % = 0 THEN INPUT #50, DataDirln$ DataDirln$ = DataDirln$ + "\" INPUT//50, DataDirOut$ DataDirOut$ = DataDirOut$ + "\" '----Determine data type (MID$(MultFIg$,3,1)='M = then multiple sets) INPUT #50, MultFlg$ DataFormat$ = UCASE$(MID$(MultFlg$, 1, 2)) ' - - - R e a d the data mode (Plane/Lineatiou) INPUT #50, NMode$ NMode$ = UCASE$(NlVlod¢$) IF MID$(NMod¢$, 7, 1) = "N" ~ North% = 1 IF MID$(NMode$, 8, 1) = "T" THEN Tick% = 1 '----De,ten'nine what is to be done INPUT #50, Oper$ Oper$ = UCASE$(Oper$) '---Symbol needed for plottin8 IF MID$(Oper$, 1, 4) = "PLOT" AND MID$(Oper$, 5, 1) < > "S" THEN IF MID$(Oper$, 5, 2) < > "= AND MID$(Oper$, 5, 2) < > " " THEN Symbols = MID$(Oper$, 5, 2) ELSE Symbols = "4" ENDIF ELSEIF MID$(Oper$, 1, 5) -- "PLOTS" THEN Symbols = "2" ENDIF IF MIDS(Oper$, I, 5) = "EIGHT" THEN ' - - f o r plotting eight to a page the small net diameter is used (65) PicR% = 65 IF MID$(Oper$, 7, 2) < > =" AND MID$(Oper$, 7, 2) < > " " THEN Symbols = MID$(Oper$, 7, 2) ELSE Symbols = "2" ENDIF ELSE ' - - n o r m a l l y use the large net diameter=200 PicR% = 200 ENDIF ' - - - D ~ r m i n ¢ output type (PIC or SCREEN) INPUT//50, P r i n t O ~ ' - - D e t e r m i n e contour density and pattern (if not to PlC fde) IF MIDS(Ovcr$, l, 4) = "CONT" OR MIDS(Oper$, 6, I) = "C" OR@ @MID$(Oper$, 6, I) = "B = INPUT #50, Densg~ IF PrintOutS < > "PIC" T H E N INPUT #50, Pattem~ ENDIF Operation g~ = 1 ENDIF ' - - - G e t t'de name IF Operation 96 = I T H E N Sc196 = 1 IF NOT EOF(50) THEN INPUT XS0, F$ IF (MID$(Oper$, 1, 5) = =PLOTS" OR MID$(Oper$, 1, 5) = = C O N T S ' ) ~ @THEN OpcrF~ = 1 Operatiou~ = 2

ELSP.W EOF(50) THEN '--If

end of fde exit program Sel~$ = 9 (MID$(Oper$, I, 5) = "EIGHT" A N D m / 8 ~ < 8) T H E N PDump PictureS, Numb ~ , T$, F$, 1 ENDIF ENDIF ' - - - - A p p l y o ~ t i o n to data ELSEIF Opemtiou96 = 2 THEN ' - - F i r s t do mtistics ff necessary in combination with plots

Processing orientation data with QuickPlot

OPEN "junk.qp" FOR OUTPUT AS #52 PRINT #52, OperFIg; " :'; Oper$;@ ":" IF (MID$(Oper$, 1, 5) = "PLOTS" OR MmS(O~r$, 1, 5) = "CONTS')@ @AND

operFlg

=

1

S¢1% = 5

OperFIg = 0 ' - - T h e n do the plotting (chosen on basis of OperFI8 status if with stats) '--Operation is still set to 2 so no new t'de read, do next operation ELSEIF (MID$(Oper$, 1, 4) -- "PLOT" OR MID$(Oper$, 1, 6) = O @'EIOHTP') AND OpcrFlg = 0 THEN S¢1% = 2 Operation% = 1 ELSEIF (MID$(Oper$, 1, 4) = " C O N T " OR M1D$(Oper$, 1, 6) = @ @ ' E I G H T C ' ) AND OperFIg = 0 THEN SeI% = 3 Operation% = 1 ' - - B a t c h stats operation variable prefixed with STATS ' - - ( e g STATSEIGEN,STATSFISHER,STATSPI) ELSEIF MID$(Oper$, 1, 5) = "STATS" OR MID$(Oper$, 1, 5) = @ @'FLINN" OR MID$(Opcr$, I, 5) = "TRIAN" THEN S¢1% = 5 Operation% = I ENDIF ' - - I f both contouring and plotting are needed four to a page IF MID$(Oper$, 1, 6) = "EIGHTB" THEN IF Flg8B% = 0 THEN Sel% = 2: FIg8B% = I ELSEIF FIg8B% = I T H E N Sel% = 3: FlggB% = 0: Operation% = I ENDIF EHDIF ENDIF EndBatchlnput: END SUB DEFINT L-N ~S ~ S O O s t l t

e ~ S l t S O ~ Q ~ O ~ S ~ S ~ S m S g S Q ~ O S ~ O O S I ~ S l S m S ~ Q O ~ S ~ S ~ O ~ e ~

' - - C r e a t e a batch f'de, Open a batch input file SUB BatchMode (FinishS) FinishS = "" CLS : IF NoG$ = " " THEN LINE (0, 0)-(D.MX, D.MY),, B BatQ$ = "P" WHILE INSTR('YN', BatQ$) ----0 LOCATE 2, 29: PRINT "QuickPlot BATCH PLOTTING" LOCATE 8, 20: PRINT "You have chosen batch plotting, Okay[Y]?" BatQ$ = UCASE$(INPUT$(I)) IF BatQ$ = CHR$(13) THEN BatQ$ = "Y" IF N o G $ = "Y" AND BatQ$ = "N" THEN CLS : END ENDIF WEND IF BatQ$ = "N" THEN LOCATE 9, 20: PRINT "Do you wish to use QuickPIot iateractivdy [N]?" Q25 = UCASE$(INPUT$(I)) IF Q25 = C H R $ ( 1 3 ) T H E N 0 2 5 = "N" IF Q25 -- " Y " T H E N Batch% = 0: CLS EHD1F IF Q25 = "N" THEN SCRP-FN 0: END ENDIF ELSEIF BatQ$ = "Y" THEN QI$ = "P" WHILE INSTR('YN', QI$) = 0 LOCATE 10, 20: PR/NT "Do you want help on bitch fde format [N]" Q I $ = UCASE$(INPUT$(1)) IF Q I $ = CHR$(13) THEN Q I $ = " N "

211

212

D . A . VAN EVERDINGEN, J. A. M. VA~ GOOL, and R. M. VISSERS

WEND IF QI$ = "Y" T ~ BatchI-lelp L O C A T E 2, 29: PRINT "QuickPlot B A T C H P L O T T I N G " IF N o G $ = " " T ~ LINE (0, 0)-(D.MX, D.MY),, B RNDIF ENDIF TryTwice: Q$ -- . p WHILE I N S T R ( ' Y Q ' , Q$) -- 0 LOCATE 12, 17 PRINT "Input file name containing batch commands (Q to quit)" LOCATE 13, 15 PRINT "(To create batch files use the QuickPIotUtil (QPID program)" LOCATE 14, 3: PRINT SPACES(75) LOCATE 14, 22: INPUT ; " > > ", Files IF UCASE$(File$) = "Q" THEN SCREEN 0: END ENDIF PRINT" Okay?[Y/Q]" Q$ = UCASE$(INPUT$(I)) IF Q$ = CHR$(13) THEN Q$ = "Y" IF Q$ = "N" THEN LOCATE 14, 24: PRINT SPACES(30) LOCATE 14, 24 ENDIF IF Q$ -- "Q" THEN SCREEN 0: END ENDIF WEND FilcExist FileS, E% ' - - F i l e Exists IFE% = ITHEN OPEN Files FOR INPUT AS//50 ' - - F i l e not found ELSEIF E% -- 0 THEN LOCATE 14, 20: PRINT "File not Found, Press any key to continue': DO: LOOP UNTIL INKEY$ < > "" GOTO TryTwic¢: ENDIF ' - - - w h e n Batch% =1 program runs in batch mode Batch% = 1 EndBatchMode: Finishs = "Y" END SUB ' ~ - C H E C K FOR A N D SET P R O G R A M D E F A U L T SETITNGS DEFINT L-N SUB DefaultFind ' ~ i n i ~ t e all kinds of flags sad other variables DIM InRegs AS RegType, OutRegs AS RegType D I M D/rotS(2), dta%(43) ' ~ D e t e r m i n e current director/ DEF SEG ' - - F i n d current drive letter InRegs.ax : & H I 9 0 0 CALL intermpt(&l-121, InRegs, OutRegs) Numb% : VAL(RIGHT$(STR$(OuIRegs.ax), 1)) IF Numb% : 0 THEN Drives ffi "A:~* IF Numb% ffi 1 THEN Drives ffi *B:~* IF Numb% ffi 2 THEN Dl~ve$ ffi *C:\* IF Numb% : 3 THEN Drives ffi "D:\*

' - - F i n d currmt mbditectmy S.bDir$ = ST~nqO$(M," ") InRegs.ax = &H4700 InRq~s.dx : &HO

Processing orientation data with QuickPlot lnRegs.fi : SADD(SubDir$) CALL interrupt(&H21, lnRcgs, OutRcgs) SubDir$ = RTRIMS(SubDirS) SubDir$ = MIDS(SubDir$, 1, LEN(SubDir$) - 1) + "\" IF LEN(SubDir$) = 1 THEN SubDir$ = "" 'Root directorV '----Combine the results HomeDir$ = DriveS + SubDir$ - - - F i n d out if QP.DEF exists FileS = HomeDir$ + "QP.DEF" FileExist FileS, E% ' - - - F i l e doesn't exist I F E % = 0 THEN AspectS = "SCREEN" YSRatio = D.ASP YRatio = YSRatio YPRatio = .6654088 DatalnputS = "DATAFILE" DataFormatS = "AD" MuitFlg$ = " " Diametrc = D.MD North% = 0 Tick% = 0 NMOdes = " DataDirln$ = HomeDir$ DataDirOuts = DataDirln$ '---f'de does exist ELSEIF E% = 1 THEN OPEN FileS FOR INPUT AS #1 INPUT #1, YSRatio, YPRatio YRatio = YSRatio ' - - - S e t the aspect for printer if in batch mode and you don't want PIC output IF Batch% = 1 AND PrintOutS < > "PIC" THEN YRatio = YPRatio INPUT #1, Datalnput$ INPUT #I, MuKFI8$ '----if MID$(MultFIg$,3,1)='M" then multiple .eta else : " " DataFormats -- LEFTS(MultFIg$, 2) INPUT #1, Diametre INPUT #1, North%, Tick%, Msg% IF Msg % = I T H E N NMOdes = " N " ELSE NModes = " " INPUT #1, DataDir$ IF RIGHT$(DataDir$, 1) < > "\" THEN DataDirln$ = DataDir$ + "\" INPUT #1, DataDir$ IF RIGHT$(DataDir$, 1) < > "\" THEN DataDirOuts = DataDir$ + "\" CLOSE #1 Direc$(1) = UCASE$(DataDirln$): Direc$(2) = UCASE$(DataDirOutS) IF Direc$(l) = Direc$(2) THEN Check% = 1 ELSE Check % = 2 ENDIF FOR JJ = 1 TO Check% IF LEFT$(Direc$(JJ), 2) = "A:" OR LEFT$(DirecS(JJ), 2) = "B:" THEN TryDrive: LOCATE 1, 1 PRINT "Checking whether drive "; LEFT$(Direes(JJ), 2); " is ready" M S = Direc$0J) + "z~z.@$#" ON ERROR OOTO Erro~rap: O P E N M $ FOR I N P U T A S # 6 0 IF Nerr~ : 71 THEN

LOCATE 1, 1 P R I N T "Drive "; LEFr$(DirecSOJ) , 2); " not ready (Put Diar in @ @Drive, Close door)" PRINT " Press any key to eonthate" DO: LOOP UNTIL ]NKEY$ < > "" WipeArea I: CLOSE #60: Nerr~ = 0 GOTO TryDrive: ENDIF CAGEO 18 2/3--H

213

214

D . A . VAN EVERDINGEN,J. A. M. VAN GOOL, and R. M. VISSERS

ENDIF MS = Direc$(JJ) + "*.*" + CHR$(0) InRegs.ax = &HIA00 InRegs.dx = VARPTR(dta%(I)) CALL interrupt(&H21, InRegs, OutRegs) InRegs.sx = & H 4 E 0 0 lnRcgs.CX = 22 InRegs.dx = SADD(M$) CALL interrupt(&H21, InRegs, OutRegs) IF OutRegs.ax < > 0 THEN IF JJ = 1 THEN DataDirIn$ = HomeDir$ IF JJ = 2 THEN DataDirOutS = HomeDir$ ENDIF NEXT JJ ENDIF R% = CINT(D.MX * Diametre / 50) CircleGausFlag % = 2 AutocontFlag~ = 1 Pattern% = 0 GridDonsity% = 0 END SUB DEFSNG I-N , * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

SUB DefaultSet ' - - - S e t the options/defaults DEFINT I-N ASS = AspectS: DIS = DatalnputS: DF$ = DataFormats: NT% = Tick% ND = Diametre: NN% = North%: DIS -- DataDirln$: DOS = DataDirOuts MS$ = MuitFIg$: NMS = NMod¢$ LastPm~ = 2 IF DataFormats = "DA" THEN AA$ = "Dip-Azimuth* ELSEIF DataFormats = "SD" THEN AA$ = "Strike-Dip" ELSE AA$ = "Azimuth-Dip" ENDIF IF MID$(MultFIg$, 3, 1) = "M" THEN A$ = "Multiple ~ " ELSE A$ = "Single set" ENDIF Choice~ = 0 WHILE C'noice% < 7 WipeArea 1 LOCATE 1, h PRINT "Defaults:" Meaus$(2) = "Screen" Menus$O) = "File" M e n u s $ ( 4 ) = "Dir" Menua$(5) ffi "Labela" Menus$(7) : "Quit" ExplainS2) ffi "Set aspect ratio (" + STR$(YRalio) + "), Circle @ O d ~ (- + S T R $ ~ ) + ")" Explain$O) = "Set data Wpe (" + AA$ + " ) , File format (" + @ @AS + "): from " + Datalnimts ExplainS(4) = "Set directmy path: Inputffi" + RIGHTS(LEFTS(@ @DataDirln$, LEN(DataDh-la$) - I), 20) + " Outputffi" + @ @ R I O H T $ ( L ~ a t a D i r O u t s , LEN(DataDirOut$) - 1), 20) IF Noflh~ ffi 0 THEN NMsg$ = " Display N symbol." ELSE NMsg$ @ O = " Don't display N." IF Tick~ ffi 0 THEN TMsg$ ffi " Don't display licks." ELSE TMsg$ @ @ = " Display 10 degree licit." IF MID$(NMode$, 6, 1) = " " THEN MMsg$ = " Display nature of @ ~ l a t t . " ELSE MMs8$ = " Don't display nature of data." Exph~n$(5) = N M ~ $ + TMsg$ + M M ~ $

Processing orientation data with QuickPlot ExplainS(6) = "Leave optiom menu 0ave, quit)" Menu Menus$(), ExplainS(), Choice%, LastPm% SELECT CASE Choice % ' - - Screen Parameters CASE 2 WipeArea 1 LOCATE 1, 1: PRINT "Screen:" ANSI % = 0 WHILE ANSI % < 4 Menus$(2) = "Aspect" Menus$(3) = "Diam." Menus$(4) = "Quit" IF AspectS = " S C R E E N " T H E N YRatio = YSRatio ELSEIF Aspects = "PRINTER" T H E N YRatio = YPRatlo ENDIF ExplainS(2) = "Aspect ratio of " + AspectS + " (" + STR$(YRatio) @ @ + ")" ExplainS(3) = "Diameter of plotted net: " + STR$(Diamctrc) ExplainS(4) -- "Go to Defaults menu" Menu Menus$(), ExplainS(), A N S I %, LastP% SELECT CASE ANSI % CASE 2, 3 'Aspect Ratio or screen IF NetOnScreenFlg% = 1 THEN LOCATE 1, 1: PRINT "Proceed:" Menus$(2) --- "Yes': ExplainS(2) = "The net on the screen @ @will be crascd. Procccd anyway?" Menus$(3) --- "No': ExplainS(3) = "Return to Defaults menu" Menu Menus$(), ExplainS(), Choice2%, 0 IF Choicc2% = 3 THEN ANSI% = 4 ENDIF IF ANSI% < 4 THEN WipcArca 4

NctO~Sc~'ag%

=

o

ENDIF InputAsp:

'--aspect ratio IF A N S I % = 2 T H E N Mcnus$(1) = "Screen" ExplainS(1) = "Set aspect ratio for screen" Menus$(2) = "Printer" ExplainS(2) = *Set aspect ratio for printer" Menus$(3) = "Own a~.ct" ExplainS(3) = "Set own aspect ratio for screen - not uved" Menu Menus$(), ExplainS(), Choice2 %, 0 SELECT CASE Choice2 % CASE 1 Aspects = "SCREEN" YRatio = YSRatio CASE 2 Aspects = "PRINTER" YRatio = YPRatio CASE 3

InputY: LOCATE 1, 1 INPUT "Enter your own screen aspect ratio: ", NumberS WipeArea 1 Query NumberS, NumFig % IF N t m d q g % = I T H E N LL)CATE I, I: PRINT SPACES(79) GOTO lnputY: ENDIF YRatin = VAL(NumberS) Aspects = "SCREEN" CASE ELSE END SELECT

215

D. A. VAN EVERDINGEN,J. A. M. VAN GOOL, and R. M. VISSERS

216

PktCircle X X % , Y'Y%, R % , YRatio, O, O, O, 0 LOCATE 1, 5: PRINT "Is this circle OK7 < Y > :" DO: A n ~ = INKEY$: LOOP WFIII.P. Ans$ = ""

WipcArca 1 IF UCASE$(Ans$) = "N" THEN WipcArea 4

NctOnScreenFlg% = 0 G O T O InputAsp: ENDIF IF Choice2% -- 3 T H E N WipeArea I L O C A T E I, I: PRINT "Is this Aspect for:" Menus$(4) = "Screen": Menus$(5) = "Printer" Menu Menus$(), ExplainS(), Choice2%, 0 IF C h o i c e 2 % = 5 THEN Aspects = "PRINTER" YPRatio = YRa6o ELSE Aspects = "SCREEN" YSRatio = YRatio ENDIF ENDIF WipeArca 4

NetOnScrceeFlg% = 0 AspectEnd: ELSEIF ANSI % = 3 THEN 'Net Diameter IaputDi:

L O C A T E I, I: INPUT "Input Not Diameter: ", NumberS Query NumberS, NumFlg WipeArea I IF NumFlg% = I T H E N G O T O InputDi: Diametre = VAL(Number$) PlotCircl¢ X X % , Y'Y%, CINT(Diametrc * D . M X / 50), YRatio, @ 0 o , o, o, o LOCATE 1, 5: PRINT "Is this circle OK'/ < Y > :" DO: Ans$ = INKEY$: LOOP WHILE Ans$ -- "" WipeArea 1: WipeArea 2: WipeArca 4

NctOnScrcenFlg% = 0 IF UCASE$(Ans$) = "N" THEN GOTO InputDi ENDIF CASE ELSE END SELECT WEND ' - - Data Format CASE 3 ANSI% ffi0 WHILE ANSI % < 4 Wipe,Area 1 LOCATE 1, I: PRINT "File:" Menus$(2) -- "Mode" Menus$(3) -- "Format"

Menus$(4) = "Quit" Exphin$(2) = "Dam input mode: " + Datalnput$ ExplainS(3) -- "Format of data: " + h A S + " (" + AS + ")" Bxplaia$(4) = "Go to Defaults menu" Mmu Menus$(), ExplainS(), ANSI %, 0 SELECT CASE ANSI % CASE 2 'Input mode of data IF Datalnput$ ffi "DATAFILE" THEN Datalnput$ = "KEYBOARD" ELSE Datalnput$ -- "DATAFILE" END1F CASE 3 'Format of data file ANS2% -- 0 WHILE ANS2% < 5 LOCATE 1, 1: PRINT "Format'" Menus$(2) --- *Type': ExplainS(2) -- "Set Data f'de fommt.@

Processing orientation data with QuickPlot

@Now=" +AA$ Menu.SO) = "# of Sets" IF MID$(Multlqg$, 3, I) = "M" THEN A$ = "Multiple sets" ELSE AS = "Single set" ENDIF ExplainS(3) = "Set Column format. Now -- " + AS Mmus$(5) -- "Quit": ExplainS(5) -- "Go to Defaults menu"

-

WipcArea I Menu Menus$(), ExplainS(), ANS2%, La~PP% IF ANS2 % = 2 THEN LOCATE 1, 1: PRINT "Type:" Menus$(2) -- "AD" ExplainS(2) = "Data file format: Azimuth Dip (2 columns)" Menus$(3) -- "DA" ExplainS(3) = "Data file fommt: Dip Azimuth (2 columns)" Menus$(4) = "SD" E.xplain$(4) = "Data file fommt: Strike Dip (2 columns)" WipcAre* I Menu Menus$(), ExplainS(), Choice2~, 0 SELECT CASE Choice2% CASE 2 DataFormat$ -- "AD': AA$ -- "Azimuth Dip* CASE 3 DataFormat$ = " D A ' : AA$ = "Dip Azimuth" CASE ELSE DataFormat$ = "SD': AA$ = *Strike Dip* END SELECT ELSEIF ANS2% = 3 THEN IF MIDS0dultFIg$, 3, 1) = "M" THEN MuRFI8$ = DataFommt$ + " " AS = "Single set" ELSE MultFI8$ -- DataFormat$ + "M" AS = "Multiple sets" ENDIF ENDIF WEND CASE ELSE END SELECT WEND Directory Path Setup CASE 4 ANSI% = 0 WHILE ANSi % < 6 WipeArea 1 LOCATE 1, 1: PRINT "Directory:" Mentm$O) = "In-Path" Mentm$(4) = "Out-Path" Memm$(6) = "Quit" Explaia$(3) -- "Input data path: " + MID$(DataDirIn$, 1, @ @LEN(DataDirIn$) - 1) ExplainS(4) = "Outlet data path: " + MIDS(DataDirOut$, I,@ @ LEN(DstaDirOut$) - 1) ExplainS(6) -- "Return to Optinm meau" Menu Memm$(), ExplainS(), ANSI ~ , 0 SELECT CASE ANSI CASE 3 StDriveDirec DataDirln$ CASE 4 StDriveDiree DataDirOut$ CASE ELSE END SELECT WEND

217

218 '--

D . A . VAN EVERDINGEN,J. A. M, VAN GOOL, and R. M. VISSERS North and tick symbol display CASE 5 ANSI % ---- 0 WHILE ANSI % < 5 WipeArea 1 LOCATE 1, 1: PRINT "Markers:" Menus$(2) = "North" Menus$O) = "Tick" Menus$(4) = "Message" Menus$(5) = "Quit" ExplainS(2) = N M s g $ Explaln$O) = T M s g $ ExplainS(4) = MMsg$ ExplainS(5) = "Go to Defaults menu" Menu Menus$(), ExplainS(), ANSI %, LP% SELECT CASE ANSI % CASE 2 IF North% = 0 THFAq North% = 1: N M s g $ = = Don't display N." ELSE North% = 0: NMsg$ = " Display N." ENDIF CASE 3 IF Tick % = 0 THEN Tick% = 1: TMsg$ = " Display 10 degree ticks." ELSE Tick% = 0: TMsg$ = " Don't display ticks. ~ ENDIF CASE 4 IF MID$(NMode$, 6, 1) = " " THEN NMod¢$ = " N ": M M s g $ = " Don't display nature of d a t a . " ELSE

NModc$ = " ": MMsg$ = " Display nature of data." ENDIF CASE ELSE END SELECT WEND ' - - - Exit Menu CASE 7 WipcArca 1 LOCATE 1, I: PRINT "Changes:" Menus$(2) = "Save" Menus$O) = "Quit" ExplainS(2) = "Save the new default settings to QP.DEF (Eat leaves @ @with no changes)" Explain$O) = "Quit - use changes for this session only (Esc leaves @ @with no changes) " Menu Menus$(), ExplainS(), Ch %, 0 SELECT CASE Ch% CASE 2

'wif

OPEN "QP.DEF" FOR OUTPWr AS #7 PRINT #7, YSRatio, YPRafio PRINT #7, Datalnput$ PRINT #7, DataFormat$ + MID$(MultFlg$, 3, I) PRINT #7, D i a m ¢ ~ N M o d e $ f ' N " (don't display) then s e t Msg% to 1 IF MID$0qMod¢$, 6, 1) = "N" THEN Msg% = 1 ELSE Mag% = 0 PRINT #7, North%; Tick%; Msg% PRINT #7, MID$(DataDitln$, 1, LEN(DalaDirIa$) - 1) PRINT #7, MlD$(DataDhOut$, 1, LEH(DataDirOut$) - 1) CLOSE #7 CASE -1 Aspects ffi ASS: Dattlnput$ = DIS: DataFormat$ -- DF$ Tick% ffi NT%: MID$(MuitFIg$, 3, 1) ffi MS$: Diametre = ND NN% ffi North%: DataDirln$ ffi DIS: DataDirOut$ = DOS Choiee% = 12: NMode$ = NM$

Processing orientation data with QuickPlot CASE ELSE END SELECT '~ F_..SCleave items unchanged CASE -1 Atq~ect$ = ASS: Datalnput$ = DIS: DataFomua$ = DF$: Tick% = T% MID$(MuliFi8$, 3, 1) = MS$: Diamctrc = ND: NN% = North% DataDirln$ = DIS: DataDirOut~ = DOS: Choice% = 12 NModc$ -- NM$ '----change items for current session only CASE ELSE END SELECT WEND IF Dlamctrc < > ND THEN CircleOuceFIg = 0 R% = CINT(D.MX * Diametrc / 50) ENDIF LastPm% = 0 END SUB ' - - - C O N T O U R T I I E DATA **********************************************************************

DEFINT I-L SUB ContGausRing (l, L, AZ, CbeckFiag%) '----subroutine for counting in one ring of the net tint in clockwise '----then in a cotmterelockwise direction '----CbeckFiag ~ = 0 no counts on ring '-1 at least one connt on ring '--2 last cotmt was zero (with previous non-zero counts) '~ 3 full ring has been counted '-----JCount is the number of cotmted points in the ring '----L is number of datapoint CbeekFlag~ -- 1 JCount = 0 ' dctcnnine thc right position on thc ring IF I = 0 T H E N 'centrcpoint o f thc ring '----CosTbeta = VectorDataO, L) 'PolcCntP arc 0,0 and 1 rcsp. IF VcctorDataO, L) > .8660254 THEN C1WI'(0, 0) = clwr(0, 0) + EXP(100 * (VectorDatsO, L) - 1)) ENDIF ChcekFlag% = 0 ELSE FullRing ~ = 6 * I J = n c r ( A z / (ei / 0 * ]))) J2 = (J + 1) MOD PullRing~ PP3 = VoctorDataO, L) * PolcCntPO, I, J) ' - - - f i r s t coont in anti clockwise direction DO CosTheta = ABS(VoctorData(l, L) * P o l ~ t P ( l , I, J) + VoctorData(2, L)@ @ * ~ ( 2 , I, J) + PP3) IF CoeTbeta > .8660254 THEN C'NT(I, J) = CqqT(I, J) + EXP(100 * (CmTheta - 1)) J = (J - 1 + FuilRing~) MOD FullRing96 JConnt = JCotmt + 1 ELSE CbeckFlagS; = 2 ENDIF IF JCotmt -- FuURing~ THEN GOTO endcotmt LOOP WHILE ChockFlag~ --- 1 ' - n o w in elockwi~ direction J =J2 c'heck]~ = t DO CmTbeta = ABS(VectorData(l, L) * PoleCntP(l, I, J) + VeetorData(2, L)@ @ * PaeCntP(2, ], J) + PP3)

:219

220

D . A . VAN EVERDINGEN,J. A. M. VAN GOOL, and R, M. V1SSERS

IF CmThett > .8660254 THEN C N T ( I , / ) = CNT(I, J) + EXP(IO0 * (CosTheta - l)) J -- (l + 1) MOD FullRing95 JCotmt = JCotmt + 1 ELSE CbeckFlag95 = 2 ENDIF IF JCotmt -- FullRing 95 THEN EMIT DO LOOP WHILE CheckFlag95 = 1 endcount: IF JCotmt = 0 THEN CheckFlag 95 --- 0 ENDIF END SUB

SUB Con*Intervals (AutoContFlag %, NCON%, CVAL()) '---subroutine calculates automatically the contour intervals ' - - ( A u t o C o n i F i ~ = 1) at regular interv~ln ~ at I time uniform ' distribution, or ff AutoConiFlag 95 = 2 the program asks the user for ' - - - t h e numbers, IF AutoConiFlag95 = 1 THEN ' - - calculate contour levels Maxcont95 -- I N T ( M A X P E R ~ CVAL(I) = 1 IF Maxcont95 < = 6 THEN FOR I = 2 TO Maxcont95 CVAL(I) -- I NEXT I NCON95 = Maxcont95 ELSEIF Maxcont95 < 12 THEN FOR I = 2 TO Maxccnt95 STEP 2 C V A L ( I / 2 + 1) = I NEXT I NCON95 = Maxcont95 ~ 2 + l ELSEIF Maxcont95 < 20 TI-IF~ STP95 = Maxcont% \ 4 FOR I = 2 TO 5 CVAL(I) = 0 - 1) * STP95 NEXTI NCON95 = 5 ELSEIF Maxcont95 < -~ 49 THEN FOR I = 1 TO Maxcont95 \ 5 C V A L ( I + 1) = 1 " 5 NEXTI NCON% = Maxcont95 \ 5 + 1 ELSE FOR I = 1 TO Maxcont95 \ 10 CVAL(I + 1) = I * 10 NEXTI NCON95 = Maxcont95 ~ 10 + 1 ENDIF '~ read i. self specified contour levels ELSEIF AutoCoaiFl~ 95 = 2 THEN LOCATE 1, 1: PRINT "Give ¢onWurlevels in 95. < C R > to end.Contour at > " FORI= ITO15 LOCATE 2, 1: PRINT "C¢~mur ieveiJ entered m far: "; CC~ LOCATE I, 52: PRINT " " InputC: LOCATE !, 52: INPUT " ' , NumberS 'read ¢ontourlevei Query NumberS, NumFI8 95 IF NumF1895 = I T H E N LOCATE 2, 52: PRINT SPACE*(78) GOTO InputC: ENDIF CVAL(I) = VAL(Numbers) CC$ = CC$ + " " + Numbers

Processing orientation data with QuickPlot

IF CVAL(I) = 0 T H E N EXIT FOR N C O N ~ -- I CC$ = "" ~.sort the array in case ~ m c o n e onsets value8 not in ascending order SortRcals C V A L ( ) , N C O N ~ N % = NeON % FOR I = 1 TO N IF CVAL(I) > M A X P E R ~ THEN NCON% = I - 1 EXIT FOR ELSEIF CVAL(1) = CVAL(I - 1) T H E N NCON~ = NCON~ - 1 FOR J = I TO N E O N % CVAL(J) = CVAL(J + 1) NEXTJ ENDIF NEXTI WipcArea 1 ENDIF

SUB DEFSNG LL

SUB C o n ~ ' ~ d ~ r o n ~ e for c ~ the c ~ net with R ~ s ~ n ~ b e r of ~ s ' - - i n a grid of 2000 by 2000 units (or~in m the c~t~), i n d ~ d e m ' - - - o f screen units WipcArea 1 LOCATE 1, 1: PRINT " C r e a t ~ counting grid... Please wait" CXPT(0, 0) = 0 CYPT(0, 0) = 0 '----this must be done for both Circle and Gauss contouring F O R I = I TO Rings% ' I is the number of the ring in the cotmting net J6=6"I-I PIOVERI3 = PI / 0 * I) 'is the angular distance between two counting RC = I * I000 / R ~ s ~ 'points in one ring FOR J = 0 TO J6 'for all points in the ring CAZ = J * PIOVERI3 C'XPTf L ~) = RC * S[N(CAL0 CYPT(L J) = RC * COS(CAZ) NEXTJ NEXT I ' ~ f o r Gauss counting method IF CircleGausFlag~ = 2 A N D OridDensity% < > Rings% T H E N GridDens~yg~ = R m g s ~ PoleCntP(l, O, O) = 0 PoleCntP(2, 0, 0) = 0 P o t e c n t P O , 0, 0) = 1 FOR I = 1 TO R i ~ s ~ ' I is the number of the ring in the counting net J6=6"I-1 SinTbet = I * SQR(2 * R i q s ~ * Rinss~; - I * I) / ( R i n g s ~ * R i n g s ~ ) Cc.Thet = I - I * I / (Rings~ * R i n g s ~ ) PIOVERD = PI / O * D 'is the angular distance between two counting 'point, in one ring FOR J -- 0 TO J6 'for all points in the ring CAZ = I * PIOVERI3 PoioCntP(l, I, J) ----SinThet * COS(CAZ) PoleCntP(2, I, J) = SinThet * SIN(CAZ) PoleCntPO, I, I) = CosThet NIDcr J

221

222

D . A . VAN EVERDINGEN,J. A. M. VAN GOOL, and R. M. VISSERS

NEXTI END]F END SUB DEFINT I-L , ********************************************************************

SUB ContourData '---subroutine for co,rating and contouring of planar or linear data '----counting circle is fLxed to 1 percent of the net ' - - - i f data are greatcircles we don't do contours, 8o return to main menu IF Mede% > 2 T H E N LOCATE 1 , 4 : PRINT "No contouring for great circle data.* PRINT "Type any key to return to main numu." DO: LOOP WHILE INKEY$ -- "" WlpeArca 1 GOTO EndContourData: ENDIF ' - - S o m c dcfinitlons PERC = 100 / Numb% 'factor for conversion from number of ¢otmte to 'percentage of total datapointe (=NUMB) DIM CVAL(16) 'array containing contour values '---Explanation of variables . . . . CXPT = X coordinate of counting point in counting net --CYPT = Y coordinate o f counting point in cotmting net - - - R I N G S % = Number o f i~n~s in the counting net. Controls directly the density --of counting points in the net. - - R C N T = size of counting circle in net mite set to 100 ~ M A X P E R C = maximum of percentages per counti~ arcs - - N E T F L A O = the counting net has to be created only once during the exccudou -of thc program, the flag is set to m e after the tint dmc. - - - - C N T ( ) -- counts in % o f total, -~AutoContFlag% = 1 Automatic calculation of contour levels --2 User specifies contour levels ....CircleGansFlag~ = I coutoudng using counting circle --2 contouring using gauss curve - - C o u n t F l g % = 0 current data~t has not been counted --= 1 current dataset has been counted with coeunting circle .... = 2 current dataPA has been counted with Gauss curve . . . . DataLoadFiag % > 0 if current dataset has been loaded in array for counting ' - - - initiate the routine IF M]D$(Oper$, 1, 5) = "EIGHT" ~ ChgCentLoc XXX%, YYY% WipeArca 1 IF NoG$ = "Y" THEN LOCATE 12, 45: COLOR 16, 15 PRINT "CONTOURING': COLOR 7, 0 IF NetOnScrcmFIg% = 1 THEN ErasePiot CircleFIg, PicFI8, Numb%, Pictures IF NoO$ -- "Y" THEN LOCATE 12, 45: COLOR 16, 15@ @PRINT "CONTOURING': COLOR 7, 0 ENDIF '.. Check if output will be needed for PORAPH file PicFileOpen PictureS, PicFlg, " C ' , F$ PlotCircle XX%, YY%, R%, YRATIO, PicFIg, CircleFIg, XXX%, YYY% Da~FI~% ffi Countl~% '--sets DataLmdFlag% to 0 '-if Countl~% = 0 '~ select contouring procedure IF Batch% = 0 T H E N ContourMenu A N S % , Dens% IF A N S % ffi-I T H E N G O T O EndCoutourData: ELSEIF Batch% ffi 1 AutoCoutFlag% = 1 ' - - pick automatic coutom'ing Circl¢OausFlag % : 2 ' - - ,, Gauss couating curve ENDIF ' - - sct up thc couating nct

Processing orientation da t a with QuickPlot

--re.~ density of cotmting net if necessary

IF ( N c O q ~ -- 0) O R (Rings~ < > Dense) O R (CirclcOausFlag% = 2 @ @ A N D (I)cns% 2 < > GridDcnsity%)) T H E N CotmtFlg % = 0 Pdngs~ : D~ls% IF Dens% < > GridDcnsity% AND CirclcGausFlag% = 2 THEN @ @REDIM PoicCntP(l TO 3, Rings%, Rings% * 6) REDIM CNT(Rings%, Rings% * 6) REDIM CXPT(Rings%, Rings% * 6)

R E D I M CYPT(Rings%, Rings% * 6) CoutNctSc~ NctFlag% = 1 ENDIF ----load data in array IF CountFlg % < > CircleGausFlag % THEN 'dataset has not been counted 'with the slccted mcthod before IF DataLoadFlag% = 0 THEN 'datasct has not been loaded yet WipcArea I LOCATE I, I: PRINT "Data point hr...." PRINT "Loading data in array... Please wait" ERASE XPT, YPT RED1M XPT(Numb %), YPT(Numb%) RSQ = 1000 * SQR(2) FOR I = 1 TO Numb% DD = RSQ * SIN(ThetR(1) / 2) XPT(I) = DD * SIN(AZR(I)) 'XPT and YPT are X-Y coordinates YPT(I) = DD , COS(AZR(I)) 'in cotmting net of radius 1000 LOCATE 1, 16: PRINT USING "###'; I; NEXT I ENDIF - - - s t a r t counting routine IF CircleGausFlag% = I THEN ' - - u s e counting circle CountCirclc IMax, JMax CountFlg% = I

ELSE CountCurve IMax, JMax '---use weighted counting with Gauss curve CountFig% = 2 END IF Maxcount$ = " " ENDIF - - - i n order to remember max oricmtation for lineations: IF LEFT$(Maxcotmt$, 3) = " " THEN IF IMax = 0 THEN MaxAz% = 0: . . . . for planes and lineations respectively IF Mode% = 2 THEN MaxDip% = 90 ELSE MaxDip% = 0 ELSE MaxAz~ = CINT(JMax / (3 * IMax) * 180) MaxDip% = 90 - CINT(2 * ATN(IMax / SQR(2 * Rings% * @ @Rings% - IMax * IMax)) * 180 / PI) IF M o d c % = I T H E N 'data are planes MaxAz% --- (MaxAz% + 180) MOD 360 MaxDip% = 90 - MaxDip% ENDIF V2qDIF Max¢otmt$ = STR$(MaxAz%) + "/" + LTRIM$(STR$(MaxDip%)) ENDIF WipcArea 1 LOCAT E 4 , 1: PRINT "Max. value emmted: ": PRINT " "; PRINT USING " ~ / . r ; MAXPERCENT; PRINT " times uniform ": PRINT " at: "; Maxcotmt$; " IF PicFIg = 1 AND MID$(Oper$, 1, 5) < > "EIGHT" THEN PMovc PictureS, 1 , 1764

Frext PictureS, 0, I, "Max. value counted:" Msg$ = MID$(STR$(MAXPERCEN~, I, 5") + " times uniform"

223

224

D . A . VAN EVERDINGEN, J. A. M. VAN GOOL, and R. M. VISSERS

PMove PictureS, 1, 1680 PText PictureS, 0, 1, Ma8$ PMove PictureS, 1, 1596 PText PictureS, O, 1, "at " + Maxcom~t$ EIgD IF IF AutoCoutFlag % ffi 2 THEN SOUND 850, .7 contour intervals CoutIntervals AutoCouiFlag%, NCON%, CVAL() '--finds contour intervals '-----drawing contour lines LOCATE I, 5: PRINT "Drawing contours, please wait." ContourDraw CVAL(), NCON%, XPT(), YPT( ) WipcArea 1 SOUND 850, .5 '--get

IF MID$(Oper$, 1, 6) = "EIGHTB" THEN PitNameFlg = 1 PrintToPIot P A ( ) , p(), "C" EadContourData: END SUB DEFINT M-N SUB ContourDraw (CVAL(), NCON%, XPT(), YPT()) '-----subroutine draws coutourlines in the net as well as patterns FOR KSECTOR = 1 T O 6 ' - KSECTOR indicates a pie point FOR I = 1 TO Rings% '-- I is a ring in the counting net J2 = I * KSECTOR- 1 Jl = J 2 - I + 1 FOR J = Jl TO J2 '-- J is the position in the ring IF I > 1 THEN MI = (J - KSECTOR + 1) MOD ((I- 1) * 6): M2 = (MI + 1) MOD @((I - 1) * 6)

ELSE MI = 0 : M 2 ENDIF N =(J

=0

+ 1) M O D ( I ' 6 )

IF CNT(I, J) + CNT(I, N) + CNT(I - 1, MI) + CNT(I - 1, M2) < @ ~g2VAL(I) THEN (30TO nextpoint: 'all counts are zero FOR K = 1 TO NCON% ' - K is one of the contour levels CONXI% = 0: CONYI% = 0: CONX2% = 0: CONY2% = 0 CONX3% = 0: CONY3% = 0: CON-X4% = 0: CONY4% = 0 SideOneFlag% = 0 SideTwoFlag% = 0 IF CNT(I, J) + CNT(I, N) + CNT(I - 1, MI) < CVAL(I) THEN GOTO @ @secondtriang: '----The program picks two triangles with point I,J in the apex and for '----each side of the triangle it checks whether the value of • contour ' - ~ l i e s in between the values of the endpoints. If so, the intersectiou point ' - - . - o f the two lines is determined in subroutine SetCoutour. Since one contour '-----can only intersect two of the sides, the program quits looking for an '---interaect/ou point after it found two (this is the point where you found '~an intersection point in the second side and CONX < > 0 and you proceed to ' - - L i n e 3700. ' ~ ~heck first side of fu,st triangle IF CNT(I, J) = CNT(I, N) THEN GOTO U~mglside2: SetMinMax ctcr(1, J), CNTq, N), CMin, Ct,b ~ IF CVAL(K) > CMax THEN GOTO trianglside2: IF CVAL(K) < C M m THEN GOTO trianglside2: SideOneFlagg; ffi 1 SetCoutour CVAL(K), CNT(I, J), CNT(I, N), CXPT(I, J), CXPT(I, N), @ @CYPT0, ~ , CYPT0, 1~, C O N X I ' t , CONY1 96

Processing orientation data with QuickPlot l.,danglsklc2:' ~ check second side of firsttriangle---SetMinM~ CNT(I, N), CNT(I - I, MI), CMin, C M a x IF CVAL(K) > C M a x ~ O O T O trils3: IF CVAL(K) < CMin T H E N O O T O trilt3: IF CNT(I, N) = CNT([ - I, MI) T H E N O O T O trils3: SideTwoFlag95 = I SctContour CVAL(K), CNT(I, IN), CNT(I - 1, MI), CXPT(I, N), @ @CXPT(I - 1, MI), CYPT(I, N), CYFTO - 1, MI), CONX395, CONY3 95 IF SideOncFlag 95 = 0 THEN CONXI 95 = CONX3%: CONYI 95 = CONY395: GOTO trils3: ELSE CONX2 % = CONX3 %: CONY2 % = CONY3 % GOTO 37OO END IF trils3: '-- check third side of firsttriangle ...... IF SidcOneFlag% = 0 A N D SideTwoFlag95 = 0 T H E N G O T O secondtriang: SctMinMax CN'I'(I,J), CNT(I - l, Ml), CMin, C M a x IF CVAL(K) > C M a x T H E N 3700 IF C V A L 0 0 < CMin T H E N 3700 IF CNT(I, J) = CHT(I - 1, M1) THEN 3700 SctContouf CVAL(K'), CNT(I, J), CNT(] - 1, MI), CXPT(I, J), @ @CXPT(I - 1, MI), CYFTO, I), C Y P T ( I . 1, MI), CONX2%, CONY2% 3700 ' - - Draw a contoudine in the first triangle IF (CONXI % < > CONX295)OR (CONYI95 < > CONY2%)THEN DrawLine CONXI %, CONYI %, CONX295, CONY2%, K ENDIF sccondtriang:

IF J = I * KSECTOR - 1 THEN 3954

' - - Check f'trstsklc of second triangle SctMinMax C N T 0 , N), C N T O - I, M2), CMin, C M a x IF CVAL(K) > C M a x T H E N G O T O tri2s2: IF CVAL(K) < C M m T H E N O O T O tri2s2: IF CNT(I, N) = CNT(I - I, M2) T H E N G O T O tri2s2: IF SidcTwoFlag ~ = 0 TI.W~ SctContour CVAL(K), CNT(], N), CNT(I - 1, M2), CXPT(I, N),@ @ CXPT(I - 1, M2), CYPT(I, N), CYPT(I - 1, M2), CONX395, CONY395 ELSE SctContour CVAL(K), CNT(], N), CNT(I - 1, M2), CXPT(I, N), @ @ C X F T O - I, M2), CYPT(I, N), CYPTCI - I, M2), CONX495, C O N Y 4 % GOTO 3850 ENDIF tti2s2: ' ~ Check second side of second triangle SctMinMax CNT(I - 1, MI), C N T ( ] - 1, M2), CMin, CMax IF CVAL(K') > CMax THEN 3850 IF CVAL(K) < CMin THEN 3850 IF CNT(I - 1, M i ) = CNT(I - 1, M2) THEN 3850 SctContaur CVAL(K), CNT(I - 1, MI), CNT(I - 1, M2), CXPT(I - 1, @ @MI), C'XPTO - l, M2), C Y P T 0 - l, MI), C Y P T 0 - 1, M2),@ @ C O N X 4 95, C O N Y 4 95

3850 '-- Draw contour line in second triangle IF (CONX3~ < > CONX4~) OR (CONY3% < > CONY4~) THEN DmwLine CONX3 95, CONY3 95, CONX495, CONY4~$, K ENDIF GOTO 3955 3954 IF K = NCON~ THEN 3957 ELSE 3955 3955 ~ K nextlminu NEXTJ 3957 IF K < ~ NCON95 THEN 3955 ELSE (30TO Label Label: NEXT I KSECTOR

225

D. A. VAN EVERDINGEN,J. A. M. VAN GOOL, and R. M. VISSERS

226

contours have been drawn, print legend Msgl$ = "Contours: " Msg2$ = "" Mgg3$ = "" FOR I = 1 TO NCON% Msg2$ -- Msg2$ + STR$(CVAL(I)) NIDCr I Msg2$ = LTRIM$(Msg2$) IF LEN(Msg2$) > 20 T H E N IF LEN(Msg2$) > 30 THEN I = 16 ELSE I -'- LEN(Msg2$) \ 2 DO WHILE MID$(Msg2$, I, 1) < > " " I=I-I LOOP Msg3$ = RIGHT$(Msg2$, LEN(Msg2$) - I) Msg2$ = LEFT$(Msg2$, I - 1) ENDIF IF Msg3$ = "" THEN YPOS% = D . M L - I ELSE YPOS% = D.ML - 2 ENDIF LOCATE YPOS%, 22: PRINT Msgl$; LOCATEYPOS% + 1, 22: PRINT Msg2$; IF Msg3$ < > "" THEN LOCATEYPOS% + 2, 22: PRINT Msg3$; ENDIF '----

COlIU3qlrs a l ~ l'e.Jldy

IF pattern ~ = 1 THEN ' - - draw patterns in the plot PlotPatteml CVAL(), NCON% ELSEIF pattern% = 2 AND HoGS = " " THEN PlotPattem2 C'VAL(), NCON% ENDIF ' - - T e x t for PIC file IF Batch% = 1 AND (MID$(Oper$, 1, 6) = "EIGHTC" OR MIDS(Oper$, @ @1, 6) = "EIGHTB') AND PicFlg = 1 THEN '---ContLevel$ is passed to PlotTitle for printing in the 8to a page plots it '----contains the contour lcvcls for the plot ContLevcl$ = "C:" FOR I = 1 TO NCON% Msg$ = LTRIM$(RTRIM$(STR$(CVAL(1)))) ContLevel$ = ContLevel$ + Msg$ + "," NEXT I ' - - R e m o v e the last comma from the ContLevel$ s~sing ContLevel$ -- MID$(CmtLeVel$, 1, LEN(ContLevel$)- 1) ELSEIF (Batch% = 1 AND MID$(Oper$, 1, 5) < > "EIGHT" AND PicFIg@ O = 1) OR Batch% = 0 THEN PMove PictureS, 1200, 300 PTcxt Pictare$, 0, 1, Msgl$ PMovc PictureS, 1200, 200 PTcxt PictureS, 0, I, LTRIM$(Msg2$) PMove PictureS, 1200, 100 PText PictureS, 0, 1, LTRIM$(Msg3$) ENDIF END SUB . ******************************************************************

DEFSNO I-N SUB ContourMcnu (ANS%, Dcm%) ' ~ m e n u for the contour routh~ to set the contour proccdurc ' - - s a v e old settings in case they get changed before escape is pressed dummy2% -- Au~oCcmtl~g dummy3% -- CircleGausFlag% dummy5% = pattern% LastPm% : I GDem% = OridDemity% IF GDens% < 10 THEN GDeas% = 10

Processing orientation data with QuickPlot

DO F O R I = 1 TO 11: Menus$(1) = " ' : ExplainS(l) = " ' : N E X T I ExplainS(l) = "Start contouring " IF AutoContPlag95 = 1 T H E N ExplainS(2) = "Automatically set contour levels." ExplainS(l) = ExplainS(I) + "[AUTO/" ELSE ExplainS('2) = "User defined contour levels." Exphin$(1) = Exphin$(l) + "[USER/" ENDIF 1F CircleGausFiag% = 1 THEN ExplainS(l) = ExplainS(l) + "CIRCLE/LOW DENS" ExplainS(3) = "Kalsbeek net with a one percent counting circle." ExplainS(4) = "Grid density fixed at LOW" ELSE ExplainS(3) = "Weighted counting with Gauss-like counting curve." ExplainS(i) = ExplainS(l) + "GAUSS/" SELECT CASE GDens% CASE 10 ExplainS(4) = "LOW" CASE 15 ExplainS(4) = "MEDIUM" CASE 20 ExplainS(4) = "I-UGH" END SELECT ExplainS(l) = ExplainS(l) + Explsin$(4) + " DENS" ExplainS(4) = "Counting grid density = " + Exphin$(4) ENDIF IF pattern 95 = 0 T H E N ExplainS(5) = "[NO PATTERN]" Explain$O) = Explain$O) + "]" ELSEIF pattern% = 1 T H E N Explsin$(5) = "[PATTERN 1]" ExplainS(l) = ExplainS(l) + "/PATTERN I]" ELSEIF pattern% = 2 T H E N ExplainS(5) = "[PATTERN 2]" ExplainS(l) = ExplainS(l) + "/PA'Vi'ERN 2]" ENDIF Explsin$(5) = "Fill contonrlines with paRcm: " + ExplainS(5) WipeArea 1 LOCATE 1, 1 : PRINT "Contour:" Menus$(l) -- "Go ~ Menus$(2) = "Auto" Menus$(3) = "Count': Menus$(4) = "Density" IF PicFIg = 0 T H E N Menus$(5) = "Pailem': Menu M m u s $ ( ) , ExplainS(), ANS%, LastPos95 F O R I = 1 TO 11: Menus$(I) = " ' : ExplainS(l) = " ' : N E X T I SELECT CASE ANS 95 CASE 2 ' - - s e l e c t i o n of contour levels, toggle IF AutoContFlsg95 = 1 T H E N AutoContFlag95 = 2 ELSE AutoContFlag%@ @=I CASE 3

'--

Select counting circle or Gauss curve, toggle

IF CirdeOausFlsg95 = 1 T H E N CircleGausFlag95 = 2 ELSE@ @ CircleOausFlag95 = 1

CASE 4 ' grid density IF CircleOausFlsg~ - 2 Menus$O) = " L o w ' : Menus$(4) = "Mcd.': Menus$(5) = "High" LOCATE I, I: PRINT "Density of cotmting grid" LOCATE 2, 4

PRINT "h~her grid densitygives smoother contoursbut is slower" GD~ : GDe~

\5 + I

227

228

D . A . VAN EVERDINGEN,J. A. M. VAN GOOL, and R. M. VISSERS Menu Menus$(), ExplainS(), GDens%, GDg; ODens~ = (GDemg; - 1) • 5 ENDIF CASE 5 '~ plot pattern in contoured net FOR I = 1 TO 11: Menus$(l) = "': ExplainS(l) = "': ~ I LOCATE 1, 1: PRINT "Fill contours with patterns:" Menus$(4) = " N o ' : ExplainS(4) = "Don't f'dl cootourlinc~" Menus$(5) = =1 Pat." ExplainS(5) = "Fill only maximum and less than minimum levels" Menus$(6) = "2 Pat.': ExplainS(6) = "Fill all contour levels" PatPos % = pattern % + 4 Menu Menus$(), ExplainS(), pattern%, PatPos% IF pattern% = -1 THEN pattern% = PatPos% - 4 ELSE pattern% = @ @ pattern % - 4

END SELECT LOOP UNTIL ANSgg < 2 IF ANS% = -1 THEN AutoCoutFlsg % = dummy2 % CircleGausFlag % = dummy3 % pattern% = dummy5% ELSE IF CircleGausFlag% = 1 THEN Dens% -- 10 ELSE Dens% = GDens% ENDIF END SUB DEFINT I-L , s*o•~os~*~**•*•*•~•e•~•*sI•*ses~s

J•o••o~o~o~eoolsssss~oooo••~oooos

SUB CountCircle (IMtx, JMax) ' - - s u b r o u t i n e for counting number of datapoints within a one percent area of ' - - - t h e net. The ¢otmts are returned to the main program in percentages of the '---total of data points in the array CNT(). ' - - T h e maximum count is remebered in MAXPERCENT, in percentages of total ' .....

pOillts,

PERC = 100 / Numb% RCNT% = 100 ' ~ counting circle in net units WipeArea 1 LOCATE 1, 1: PRINT "Countdown at ..." RCNTQUAD% = 10000 ' - - =RCNT%"2 '----fast method K=O FOR I = 0 TO Rings~ 'set counting matrix to zero J6K=6*I-K FORJ = 0 T O J 6 K crzr(l, J) = 0 NEXT J K=I NEXT I '----start counting, based on data points FOR I -- I TO N u m b ~ LOCATE 1, 17: PRINT USING " t / # r ; N u m b ~ - I + 1; II = INT(SQR(2) • SIN(ThetR(I) / 2) • Rings~) I2=II +1 IF II = 0 THEN 'only three cotmting points can be determined 112 = 0 ELSE IFII =IOTHENII =9:12=10 'if poiats lie cxaetly ou the edge J l l -- INT(AZR(1) / (Pl / 0 • 11))) J12 = ( I l l + 1) M O D (II • 6) dx = CXPT(II, J11) - XPT(1): DY -- CYPT(II, J l l ) - YPT(1) I F d x • d x + DY • D Y < 10080THEN CNT(II, l I D = c2¢rfIl, l I D + 1 ENDIF

Processing o r i e n t a t i o n d a t a with Q u i c k P l o t ENDIF

121 = INT(AZR(1) / (Pl / 0 * 12))) J22 -- 021 M O D (12 * 6)) + I dx = C X P T ( I I , J12) - XPT(1): DY = C Y P T ( I I , J12) - YPT(I) I F d x * dx + DY * D Y < 1 0 0 8 0 T H E N C N T ( l l , J12) -- C N T ( I I , J12) + 1 ENDIF dx = CXPT(12, J21) - XPT(I): DY = CYPT(I2, J21) - YPT(1) IF dx * dx + DY * DY < 10080 T H E N CNT(I2, J21) = CNTO2, J21) + 1 ENDIF dx = CXPT(12, J22) - XPT(I): DY = CYPT(I2, J22) - YPT(1) IF dx * dx + DY * DY < 10080 T H E N CNT(I2, J22) = CNT(12, J22) + 1 ENDIF NEXT I ' - - - - c h e c k on edge and print maximum count WipeArea 1 L O C A T E 1, 1: PRINT "Check on edge.." JEND = Rings% * 3 FORJ =0TOJEND-1 CNT(Rings%, J) = CNT(Rings%, J) + CN'I'(Rings%, J + JEND) CNT(Rings%, J + JEND) = CNT0tings%, J)

NEXT J '

, determine maximum MAXPERCENT = 0 K--0

F O R I = 0 T O Rings% J6K=6*I-K

FORJ = 0TOJ6K CNT(I, J) = CNT(I, J) * P E R C IF CNT(I, J) > M A X P E R C E N T T H E N M A X P E R C E N T = CNT(I, J) IMax = I" J M a x = J ENDIF NEXT J K=I NEXT I END SUB **********************************************************************

SUB CountCurve OMax, JMax) ' - - - s u b r o u t i n e for cotmfing with Gauss curve u descnl~..d by Robin '----and Jowelt with k = 100

PERC = 100 / Numb % WipeArea 1 L O C A T E 1, 1: PRINT "Countdown at ..." ' - - - - s e t coun6ng matrix to zero K=0 FOR I = 0 TO Rings% J6K -- 6 * I - K FORJ =0TOJ6K CNTfl, J) -- 0 ~ J

K=I NEXTI '---start counting, based oe

data points

F O R in ffiI T O N u m b % L O C A T E 1, 17: PRINT USING " # # r ; Numb% - in + 1; II ffi INT(SQR(2) * SIN(TheiR(in) / 2) * Rings%)

F O R I -- Il T O 0 STEP -l ' ~ go from s t a ~ ContGausRing I, in, AZR('m), CheckFlag % IF Check,Flag % -- 0 T H E N EXIT F O R NEXTI FOR I = II + I T O R i q s %

' - - from s t t a h ~ point outward

ContOtusRing I, in, AZR(in), ~

IF CheckF~% CAGEO 18 213~l

= 0 THEN

point inward

%

O O T O nextdmpoint:

229

D. A, VAN EVERDINGEN,J. A. M. VAN GOOL, a n d R. M, VISSERS

230

NEXTI I : Rings95 A Z I R = (AZR(in) + PI) M O D 2 * PI DO CoutGausP.h~ I, in, AZIR, CheckFlag95 I=I-I L O O P UWI'IL CheckFlag 95 = O nextdaUq,oint: N-EXT in ' - - - c h e c k on edge FORJ =0TORinss95*31 SetMinMax CNT(Rings95, J), cN'r(Rings95, J + Rings95 * 3), CMin, CMax CNT(Rings95, J) = C M a x CNT(Rings%, J + Rings95 * 3) = CMax NEXT J '-----determine maxhnum K=0 MAXPERCENT = 0 FOR I = 0 TO Rings95 I6K=6*I-K FORJ =OTOJ6K CNT(I, J) = CNT(I, J) * PERC IF CNT(I, J) > M A X P E R C E N T T H E N M A X P E R C E N T = CWI'(I, J-) IMax = I: J M a x = J ENDIF NEXT J K=I

NEXT I END SUB DEFSNG I-L ' - - - - - Subroutine for drawing a contuurline on the screen, after converting -grid coordinates to screen coordinates SUB DrawLine ( X I % , Y I % , X 2 ~ , Y2%, K ~ ) FCT = R% / 1000 PicFCT = PieR% / 1000 X S I % = CINT(XX95 + X l % * F C T ) Y S I % = C I N T ( Y Y % - Y 1 9 5 * FCT * YRATIO) XS2 95 = CIHT(XX 95 + X2 95 * FCT) YS295 = C1NT(VY95 - Y295 * FCT * YRATIO) IF HoGS = " " T H E N L I N E (XSI 95, Y S I 95)-(XS2 %, YS2 95) " - - - F o r PIC l-des convert to a 3200 by 2311 screen size from 720 by 348 '-----(PIC file origin = lower left comer, Hercules origin = upper left comer) IF PicFlg = 1 T H E N PXI95 = CINT((XXX95 + X195 * PicFCT) * 4.A.A,A.A.A.A.A.A.A.#) PX2% = CINT((XXX% + X295 * PicFCT) * 4AA.A.A,A.A,a.A.AJ/) PY195 = C I N T ( 2 1 0 0 - ((YY'Y95 - Y195 * PicFCT) * 4.A.A.A.A.A.A.A.A,#)) PY295 = C I N T ( 2 1 0 0 - ((Y'YY% - Y2% * PicFCT) * 4.A.AAA.A.A.A.A.#)) ' - - - T o avoid running out of memory dump the Pictures array periodically ' - - I f Pictures Iouser than IKB - dump to file IF LEN(picture$) > 1000 T H E N PDump PictureS, Numb 95, TypeS, F$, DumpFlg ENDIF PMove PictureS, PXI 95, PYI95 PDraw PictureS, PX2 95, PY2 95 ENDIF END SUB D E F I N T I-K *0.****.4.***.0***440**00$**44*0.**.0.*********e*****8.*444.******

SUB Pl~LPttt~'ul (CVAI.,(), N ~ N % ) ' Subroutine for plotting • paU~m in the area o f less then uniform ' distn'bution of data in the contoured stereonet and shade the maxhnum concmtrsticm area ' - - - - ~ sub is called from subromlne ContourDrsw

Processing orientation data with QuickPlot '-----check 'for every point ha the counting net if the count is lower than the ' - - l o w e s t or higher thegn the highest contour level. FAC = R% / 1000 'for conversion from net units to screen units K=0

FOR I = 0 TO Rings% - 1 J 6 K -- 6 * I - K FORJ =0TOJ6K IF ClqT(I, J) < CVAL(I) THEN ' - - - if count < lowest contour IF NoG$ = " " THEN PSET (XX% + CXPT(I, J) * FAC, YY% - CYPT(I, J) * PAC@2 @ * YRATIO) DRAW "RI" ' - - draw dot ENDIF IF PicFIg = 1 THEN PDrawSym PictureS, XXX% + CXPT(I, J) * PAC, YYY% -@ @ CYPT(L J) * FAC, l, ~ - n ~ ENDIF ELSEIF CNT(I, J) > CVAL(NCON%) THEN ' - - - fdl max concentration IF NoG$ = " " THEN PAINT (XX% + CXPT(I, J) * FAC, YY% -@ ¢I~-"YPT(I, J) * FAC * YRATIO) ENDIF NEXT J K=l NEXT l ' - - - f o r outer ring paint point has to be within peripheral circle, not on it I = Rings% FORJ = 0 T O 6 * R i n g s % - I IF CNT(I, J) > CVAL(NCON%)THEJq IF NoG$ = " " THEN PAINT (XX% + CXPT(I, J) * FAC * @ @.99, YY% - CYPT(I, J) * FAC * YRATIO * .99) ENDIF NEXT J END SUB

DEFINT L-N SUB PlotPattem2 (CVAL(), NCON%) ' - - s u b r o u t i n e for filling contours with plttems, which can be ' - - p r i n t e d ha a screen dump, but will not show up ha a picfile ' - - - F l a g FiratTime is 0 until the pattemstrmgs have been loaded, '----when it is set to 1 1F NCON% > 9 THEN WipeArea 1 LOCATE 1, 1 PRINT "No pattern service for plots with more than 9 contour levels." PRINT "Hit any key to continue." DO: LOOP WHILE INKEY$ = "" WipeArea 1 OOTO endpattem ENDIF m a x ----9

DIM patternS(max) patternS(l) = CHR$(&HI) + CHR$(&B0) + CHR$(&BI0) + CHR$(&H0) patternS(2) = CHR$(&HI1) + CHR$(&H0) + CHR$(&H44) + CHR$(&H0) patternS(3) = CHR$(&H55) + CHR$(&B0) + CHR$(&HAA) + CHR$(&H0) patternS(4) = CHR$(&HAA) + CHR$(&Hll) + CHR$(&HAA) + CHR$(&H44) patternS(5) = CHR$(&H55) + CHR$(&HAA) patternS(6) --- CHR$(&H55) + CHR$(&HEE) + CHR$(&H55) + CHR$(&I-IBB) patternS('/) = CHR$(&H55) + CHR$(&HFI~ + CHR$(&HAA) + CHR$(&HFF) patternS(8) = CHR$(&HEE) + CHR$(&HFF) + CHR$(&HBB) + CHR$(&HFF) patternS(9) = CHR$(AHF~ pattem$(NCON~) = patternS(9) ' - - f o r couversion from net units to screen units FAC = R ~ / 1000 K=0 FOR I = 0 TO Rings% - 1 J6K = 6 * I - K

231

232

D . A . VAN EVERDINGEN,J. A. M. VAN GOOL, and R. M. VISSERS FOR J = 0 T O J6K IF CNT(I, J) > CVAL(1) T H E N FOR M = N C O N ~ T O 1 STEP -1 IF CNT0, .I) > CVALtM) PAINT ( X X ~ + C'XPT(I, J) * FAC, Y Y % @* YRATIO), patternS(M) EXIT FOR ENDIF NEXTM ENDIF NEXTJ

- CYPT0, J) * F A C @

K=l

NEXT I IF NCON% > 1 THEN Space = .13 * (CVAL(NCON%)- CVAL(NCON%O @ - 1)) ELSE Space = .2 I = Rings~ F O R J = 0 T O 6 * Rings~ - l IF CNT(I, J) > CVAL(I) THEN IF CNT(I, J) > CVAL(NCON%) + Space THEN ' + .1 * spacing to ' avoid spills PAINT (XX% + CXPT(I, J) * FAC * .99, Y Y ~ - CYPT(I, J) " FAC@ @ * YRATIO * .99), patternS(M) ELSE FOR M = HCONg$ - 1 TO 1 STEP -1 IF (CNT(I, J) > CVAL(M) + Space) AND (CNT(I, J) < CVAI.O~ + O 1) - Space) THE]~ ' + .1 * Spacing to avoid spillim~ PAINT (XX% + C'XPT(I, J) * FAC * .99, Y Y ~ - CYPT(I, J) O @* FAC * YRATIO * .99), patternS(M) EXIT FOR ENDIF NEXT M ENDIF ENDIF NEXT J ERASE patterns endpattern: END SUB DEFSNG I-N SUB SetContonr (CVAL, CA, CB, XA, XB, YA, YB, C O N X ~ , CONY~) ---subroutine calculates the coordinates of the point where a contour - - l i n e cuts the connecting line between two cot.ring nodes CA and CB are the cotmts at the two pointa in percentage* - - - C V A L is the value of the contour line - - - X A , Y A , X B , Y X are the coordinates of the nodes in the counting net - - - C O N X and CONY are the final coordinates of the intersection point, - - - w h i c h are returned to the main program - - t h e routine is called from the sub ContonrData FACT = ( C V A L - CA) / (CB - CA) '--distance of contour away from point A CONX % = CINT(XA + FACT * (XB - XA)) '----in percenttge CONYS$ = CINT(YA + FACT * (YB - YA)) END SUB **********************************************************************

SUB Sc~fin]~bx (A, B, M ~ ,

• A > B'D[]3q nutx = A ELSE max = ]3

MD~=A SUB

max)

Processing orientation data with QuickPIot

DEFINT I-K ******************************************************************

SUB SortReals ( C V A L ( ) , N C O N ~ ) ' ~ s u b n m t i n c for s o ~ Ih¢ e o o t o u ~ t c r v a i s iatho array, in case ' ~ s o m c o n e types them in in the wrong o~ler (decending values) or not ' - - i n order at all FOR K = N C O N ~ - I TO I STEP -I J=K+I Save = CVAL(K) C V A L ( N C O N % + 1) = SJvc DO W H I L E Save > CVAL(Fy C V A L ( J - 1) = CVAL(J) J--J+l LOOP C V A L ( J - 1) = Save NEXT K C V A L ( N C O N % + 1) = 0 END SUB '---STATISTICAL TESTS: EIGEN ANALYSIS **********************************************************************

SUB Eigen (a, B, C, D1, E, F, E V i l ! ( ) , E V e c ( ) ) ' - - - - P r o g r a m to do an eigcn analysis on • random 3 X 3 matrix B2 = B * B: C'2 = C ' C : E2 = E * E A2 = - ( a + D I + F) A I = (a * ( D I + F) + D I * F ) - (B2 + C'2 + E2) A0=(a*E2 +F'B2 +DI *C2)-(2*B*C*E +a*DI*F) Q =AI /3!-A2*A2/91 R = (AI*A2-31*A0)/61-A2*A2*A2/271 IF ABS0t) > .0O0O01 T H E N T -- SQR(-(Q * Q * Q + R * R)) IF ABS(R) < = .000001 T H E N T -- .5 * Pl U = SQR(R* R + T'T) Theeta = ATN(T / R) IF Theeta < 0! T H E N The.eta = Theeta + Pl Thceta = Thccta / 3! U3 = 2! * (U ^ .33333333#) TI = U3 * COS(Theeta) I"2 = -U3 * SIN(Theeta) EVaI!(I) = T l - A2 / 31 CONI =-.5*TI-A2/3! CON2 = .5 * 1"2 * SQRO!) EVal!(2) = C O N I - CON2 EVaI!(3) = C O N I + CON2 FOR J = 1 TO 3 XI=I EVA = EVaI!(J) - a DEN = B * E - C * (DI - EVal!(J)) X2 = (EVA * E + B * C ) / D E N X3 = ( E V A - B * X 2 ) / C RS = I ! / S Q R ( X I * X I +X2*X2 +X3*X3) E V e c ( l , J) = X I * RS EVec(2, J) = X2 * RS EVcc(3, J) = X3 * RS NEXT J END SUB ********************************************************************

SUB EigenAnalysis ( I ' h e t a l ( ) , P h i l ( ) , F$) DIM •(6) L O C A T E l, 1: PRINT "Eigcn Analysis: Calculating..." RD = 1 8 0 ! / P I '-----~ data is multiple then do m a l y s i s o n • subset of data IF P o i n t a ~ < > 0 T H E N XNI = It / Points~ ELSE XN1 : 1! / Nuumb% EIqD IF FOR I : 1 TO 6: •(1) : 0~: N E X T I

233

234

D . A . VAN EVERDINGEN,J. A. M. VAN GOOL, and R. M. VISSERS

FOR I = 1 TO N u m b ~ FOR J = 1 T O 3 FOR K = J T O 3

L=(J-I)+K IFJ > ITHENL = L + 1 ' - - I f multiple data tlma mdy emmt data if chosen symbol matches IF MID$(MultFIg$, 3, 1) = "M" AND (VAL(WhatSymb$) = Symb~(1)@ O OR WhatSymb$ -- " A ' ) THEN a(L) = a(L) + VectorData(J, D * Vect~rData(K, I) ELSEIF MID$(MuRFlg$, 3, 1) < > "M= THEN a(L) = a(L) + VectorData(J, I) * VectorData(K, 1) ENDIF NEXT K NEXT J NEXT I ' ~ c a l c u l a t e eigenvectors (EVec) and eigenvalues (EVal) Eigen a(l), a(2), aO), a(4), a(5), 1(6), EVal!(), EVe¢( ) FOR I = 1 TO 3 ' ~ N o r m a l i z e the eigm values to the number of points in the data set EVal!(1) = EValIO) * XNI " - - n e g a t i v e dip angle IF EVec(3, I) < 0 THEN FORM% = 1 TO3 EVec(M~, D = -EVec0Vl%, D NEXT M% ENDIF ' ~ C a l c u l a t e Theta in the range (0 to PD so that COS(Theta)=X ' - - Q u i c k B A S I C has no arc-cosine function so use the are-tangent function Tbetalo) -- ATN(SQR(ll - EVecO, 1) * EVec(3, 1)) / (EVec(3, 1) + IE-30)) '----Now transform from direction cmines to polar coordinates IF ABS(EVee(I, I)) > = .000001 THEN Phil(I) = ATN(EVec(2, I) / EVec(l, 1)) IF EVec(l, 1) < 0! THEN Philo) = phil(I) + PI IF EVec(I, I) > = 0! AND EVec(2, I) < 0 ! THEN PhilO) = Phil(1) + @ @ 6.283185307// ELSE Philo) = 1.570796327// IF EVec(2, D < 0! THEN Philo) = 4.71238898// ENDIF Thetal(l) = 90! - Thetalo) * RD Philo) = PhilO) * RD THI = ThetalO) PHI = PhilO) NEXTI WipeArea 1 IF EigFishFlg = O THEN EigenPrint Thetal(), P h i l ( ) , "DISPLAY" EigenPrint Thetal(), P h i l ( ) , F$ ENDIF CLOSE//1 END SUB , O*~***O*Oe******************o**************Ooo0**0*~**

00.**0.0***.0*

SUB F_~mPrint (Tht~al(), P h i l ( ) , TypeS) IF Types = "DISPLAY" THEN LOCATE 8, 1 PRINT "Eigen Values:" FOR I = 1 T O 3 PRINT USING " ~ . 0 ~ f f ' ; EVal~(1); NEXTI PRINT : PRINT "Eigen Vectors:" PRINT" mpDir Dip" FOR I -- 1 TO 3 PRINT USING " ~ r T . r ; PhilO); Tbetal(1) NEXTI ELSE ' ~ i f in batch mode and want tO plot the data skip tO end of routine

*

Processing orientation data with QuickPlot IF Batch% -- I AND MID$(Oper$, I, 5) = "PLOTS" THEN GOTO EndEigenPrint: WqgAres 1 LOCATE I, I: PRINT "Save to file" IF Batch% ffi 0 THEN Menus$(2) = "Yes': Menm$O) = "No" ExplainS(2) = "Save dala to user spccifi~ fde" Explain$O) = "Do not save data to t'de" Menu Meuus$(), ExplainS(), A N S I %, 0 ELSEIF Batch% = I T H E N ANSI% = 2 ENDIF IF ANSI % = 2 THEN - - C h e c k first if there is enough room on the destination disk IF Bateh% = 0 THEN C'heckFree "STAT', TypeS, Numb% IF Batch% = I THEN IF MID$(Oper$, I, I0) = "STATSEIGEN" THEN F25 = MID$(F$, I, LEN(F$) - 3) + "EIG" ELSEIF MID$(OIgF$ , 1, 7) = "STATSPI" THEN F2$ = MID$(F$, I, LEN(F$) - 3) + "PI" Actlve$ = "PI" ENDIF ELSEIF Batch% = 0 T H E N E%=I WHILE NOT E% = 0 Wipe.A tea 1 LOCATE 1, I: I N P U T "Input f'de name: ", F25 FileExist F25, E% IFE% = ITHEN LOCATE 1, 18: PRINT "File Exists Overwrite [N]?" Q$ = UCASE$(INPUT$(I)) IF Q$ -- CHR$(13) THEN Q$ = "N" I F Q $ = "Y" THEN E% = 0 ENDIF WEND ENDIF F25 = DataDirOut$ + F25 OPEN F25 FOR OUTPUT AS #3 PRINT #3, "File Name: "; Types IF MID$(Oper$, 1, 7) = "STATSPI" OR Active$ = "PI" THEN PRINT #3, "Fold Axis:" PRINT #3, " Azimuth = ", : PRINT #3, USING "####.#'; PA(3) PRINT #3, " Dip = "; : PRINT #3, USING " # # # # . r ; P(3) ELSE Msg$ = "" IF Points % < > 0 THEN Number% = Points% Msg$ = "Multiple data set (subset" + WhatSymb$ + " only)" ELSE Number% = Numb% ENDIF PRINT #3, "Eigen Analysis:'; Number%; "pts." IF Points% < > 0 THEN PRINT 03, Msg$ PRINT #3, "Eigenvalues: " FOR I = 1 T O 3

PRINT #3, USING "##.####'; EVal[(1); NEXTI PRINT #3, " ' : PRINT #3, "Eigenvecton as Cosines:" PRINT #3, " L : ' ; : FOR I = 1 TO 3: PRINT #3, USING "###.####'; @ OEVec(l, D; : NEXT I: PRINT #3, PRINT #3, " M : ' ; : FOR I = 1 TO 3: PRINT #3, USING "#Jq/.g##r; @ OEVec(2,

D; : N E X T I: PRINT #3,

PRINT #3, " N : ' ; : FOR I = 1 TO 3: PRINT #3, USING " / / # g . # ~ ; @ @EVecO, D; : NHXT I: PRINT #3, PRINT #3, "and *- Coordinates of Eadpoints:" PRINT #3, " A z . : ' ; : FOR I = 1 TO 3: PRINT #3, USING "tM##.##'; @ @Phil(1); : NEXT I: PRINT #3,

235

236

D . A . VAN EVERDINGEN,J. A. M. VAN GOOL, and R. M. VISSERS

PRINT #3, "Dip:'; : FOR I = 1 TO 3: PRINT #3, USING "####,~1~; @ @Thettl(l); : NEXT I: PRINT #3, ENDIF ENDIF CLOSE ENDIF EedEigmPrint: END SUB ' - - S T A T I S T I C A L TESTS: FISltER ANALYSIS SUB FisherAnalysis (F$, T ( ) ) '---Dlaperaion on a Sphere By: D. van Evcrdingen 4/89 ' ~ R o u t i n e is based on Fisher's 1953 paper "Dispersion on a Sphere' ' ~ R o y a l Society of London, V217, p295-305. ' ~ 2 0 - l/P is the probability at the 5 ~ level (1 / 0.05) - used in A = .... ' ~ D e g = Radius of confidence at 5 % significJncc level. '----K=measure of the distribution (if large=pointa conf'med to small area). WipeArea 1 IF Numb % = 1 THEN PRINT "Data ~ t must contain more than 1 point to do the Fisher analysis" PRINT "Press any key to return to main menu" DO: LOOP UNTIL INKEY$ < > "" OOTO EndFisher: ENDIF LOCATE 1, 1: PRINT "Fisher Analysis: Calculating..." IF VFig% = 0 THEN FisherVector T(l), T(2), T(3) IF Points % < > 0 THEN Number% = P o i n t ~ EI~E Number% = Numb% ENDIF N = Number~ - Vector T(4) = T(l) / Vector T(5) = T(2) / Vector T(6) = T(3) / Vector a = 20 ^ (1 / (Numberg~ - 1)) C = l-(N)*(a-l)/Vector T(7) = ATN(SQR(I - C * C) / (C + IE-29)) / Grad T(8) = (Number% - 1) / (N) WipeArea 1 IF EigFishFig - 0 THEN FisherPrlnt T ( ) , "DISPLAY" FisherPrint T ( ) , F$ ENDIF EndFisher" END SUB *******************************************************************

SUB FisherPrint (T(), TypeS) IF Types = "DISPLAY" THEN LOCATE 15, 1 P R I N T "Rad. of Confidence" PRINT " at 5 % Signif." PRINT " is "; PRINT USING "####,##'; T(7), PRINT " deg." PRINT " K = "; PRINT USING "~..d~Lu.A~P; T(8) ELSE ' ~ i f in batch mode and want to plot the data skip to end of routine IF Batch% = 1 AND MID$(Oper$, 1, 5) -- "PLOTS" THEN GOTOO @EndFid~erPrint: Wipe.Area 1 LOCATE 1, 1: PRINT "Save to Pile" IF Rateh~; = O ' I ' H ~ Montm$(2) = "Yea': Meatm$O) = "No"

Processing orientation data with QuickPlot

ExplainS('2) = "Save data to user specified fde" Explainf~3) = "Do nat save data to fde" Menu Menus$(), ExplainS(), ANSI ~ , 0 ELSEIF Batch~ = I THEN ANSI ~ = 2 ENDIF IF ANSI ~ = 2 THEN IF Batch% = 0 THEN '-----Check first if there is enough room on the destination disk Checlr.Frec "STAT', TypeS, N o m b ~ E%=I WHILE NOT E% = 0 WipeArea 1 LOCATE 1, 1: INPUT "Input File Name: ", F25 FileExist F25, E% IFE% =ITHEN LOCATE 1, 18: PRINT "File Exists Overwrite [N]?" Q$ = UCASE$(INPUT$(I)) IF Q$ = CHR$(13) THEN Q$ = "N" IF Q$ = "Y" THEN E% = 0 ENDIF WEND ELSEIF Batch% -- 1 AND MID$(Oper$, 1, 11) = "STATSFISHER" THEN F'25 = MID$(F$, 1, LEN(F$) - 4) + ".FIS" ENDIF F25 = DataDirOut$ + F25 OPEN F25 FOR OUTPUT AS #3 Msg$ = "" IF Points % < > 0 THEN Number% = Points~ Msg$ -- "Multiple data set (subset " + WhatSymb$ + " only)" ELSE Number% = Nomb% ENDIF PRINT #3, "File Name: ", Types IF Points% < > 0 THEN PRINT #3, Msg$ PRINT #3, " Total: "; PRINT #3 USING "###.###r; T(1); T(2); TO) PRINT #3 "Res.Dir. Cos.:'; PRINT #3 USING "###.,%##~; T(4); T(5); T(6) PRINT #3 "Nembcr of points: "; Ntmlber~ PRINT #3 "Poss~k directions greaterthan "; PRINT//3 USING "###.#r; T(7); PRINT #3 " away from that" PRINT #3 "indicated are excluded at the 5% level of significance" PRINT #3 "Precision o f K = ( N - 1) / (N- R) = "; PRINT #3 USING "###~.#r; T(8) CLOSE #3 ENDIF ENDIF EndFishcrPrint: END SUB

SUB FisherVector (TI, T2, T3) ' ~ C a l c u l a t e the resultant vector TI = 0 : 1 " 2 = 0 : 1 " 3 = 0 FOR I -- 1 TO Nmnb% IF MID$(MultFIg$, 3, I) = "M" AND (VAL(WhatSymb$) = Symb%(1) OR Wl~tSymb$~

@ = "A') T H E N TI = TI + VectorData(3, 1): T2 = "1"2 + VectorData(l, 1): "1"3 -- T3 + @ @VectorData(2, I) ELSEIF MID$(MultFig$, 3, 1) < > "M" THEN TI -- TI + VectorData(3, I): T2 -- T2 + VectorData(l, D: T3 = T3 + @ OVectorData(2, I) ENDIF

237

238

D . A . VAN EVERDINGEN,J. A. M. VAN GOOL, and R. M. VISSERS

blEXT I Vector = SQR(TI * TI + 1"2 * I"2 + T3 * T3) V ~ = l END SUB ' - - S T A T I S T I C A L 1~.SI'S: MODIFIFJ) F I J N N & V O ~

DIAGRAMS

J*********************************************************************

SUB Flinn (EVal!(), ECmmt%) ' - - S u b r o u t i n e to contputc the shape and strength parameter of • slZ~da data ' - - s o t and pk~ them on • graph as per Woodcock mad Ntylor, 1983; Journal of ' Structural Geology v5 n5 p539-548 : Modified Flinn diagram ' - - I f PlotGr% = 1 then the graph already exists just plot the points to the ' - - P I C fdc. This subroutine not run if Ntunb% < 3 (see main program) ' - - - E l , E2, E3, LEI2, LE23, K, C are global arrays DIM J(5) II% = ECount% '----Plot the graph axes LINE (3 * D.MX / 10, 2 * D.MY / 8)-(3 * D.MX / 10, 7 * D.MY / 8) LINE (3 * D.MX / 10, 7 * D.MY / 81-(8 * D.MX / 10, 7 * D.MY / 8) '---change slope of line to plot shape parameter lines J(l) = 4: J(2) = 5.5: J(3) -- 8: J(4) = 4.5: J(5) = 6 FOR I = 1 TO 5 IFI < 4THEN LINE (3 * D.MX / 10, 7 * D.MY / 8)-(J(1) * D.MX / 10, 2 * D.MY / 8) ELSE LINE (3 * D.MX / 10, 7 * D.MY / 8/-(8 * D.MX / 10, J(1) * D.MY / 8) ENDIF NEXT I FOR I = 1 TO 9 IFI < 6THEN IF I = 2 O R I = 4 THEN LINE (3 * D.MX / I0, ( 7 - 1) * D . M Y / 8 ) - @ @(0 + 31 * D.MX / 10, 7 * D.MY / 8) LINE (3 * D . M X / 1 0 , (I + 1) * D.MY / 8)-(3 * D.MX / 1 0 - 5 , (I + 1) *@ @ D.MY / 8) LINE ((I + 3) * D.MX / 10, 7 * D.MY / 8)-((1 + 3) * D.MX / 10, 7 *@ @D.MY/8 +5) ELSEIF I = 6 OR I = 8 THEN XAx = I - 2 : Y A x = 12-I LINE (XAx * D.MX / 10, 2 * D.MY / 8)-(8 * D.MX / 10, YAx * D.MY/@ @ 8) ENDIF NEXT I ' - - l a b e l axes FOR I = 1 TO 5: LOCATE D.ML - 2, 23 + I * 8: PRINT I: NEXT I FOR I = 1 TO 5 : L O C A T E 4 + I * 3, 21: PRINT 6 - I: NEXT I LOCATE D . M L - 1, 50: PRINT "1n($2/$3)'; LOCATE 5, 40: PRINT "CLUSTERS" Texts = "GIRDLES" FOR I = I TO 7: LOCATE 25 - (16 - I), 71: PRINT MID$(Text$, I, 1): NEXT I SW "In(SI/S2)', 17 * D.CX + 7, 15 * D.C'Y, 1 LOCATE 6, 31: PRINT "K=5" LOCATE 6, 44: PRINT "K=2" LOCATE 6, 64: PRINT " K = I " LOCATE 14, 65: PRINT "K=0.5" LOCATE 19, 65: PRINT "K=0.2" LOCATE 11, 58: PRINT " C = 8 " LOCATE 14, 51: PRINT " C = 6 " LOCATE 17, 43: PRINT " C = 4 " LOCATE 5, 1: PRINT "Eigcn Values" LOCATE 6, 1: PRI~I" " SI $2 $3" LOCATE 7, 1: PRINT USING "Aq/.#k"; EI(II%); E2(II%1; E3(II%) LOCATE 8, 1: PRINT "Shape Parameter" LOCATE 9, 3: PRINT " K = ' ; USING "#N.#~'; KOI%) LOCATE 10, 1: PRINT " S l r e n ~ Par, re." LOCATE 11, 3: PRINT "(2--'; USING "Aq/.A~'; COI%) ' daa pkming FOR I ~ = 1 T O ECotmt~ X = 3 * D . M X / 10 + ( D . M X / 10 * L E 2 3 ( I ~ 1 ) : Y = 7 * D . M Y / 8 - ~ @(D.MY / 8 * LB12~%))

Processing orientation data with QuickPlot

IF NoG$ = " " THEN PSET (X + 2, Y - 2): DRAW "LAD4R4U4" NEXT I ~ ' ~Checkif output is needed of Flinn diagram but only if no plot is ' - - p r e s m t l y being made IF PicFlg = 0 T H E N PrintFlinn LE12(), LE23(), SetName$(), ECc~mt% ENDIF END SUB , * * * * * * * * * e * * * * * * * * * * * ~ . $ * * * * * * * * * * * * ~ * * * * * * * * e * * * * * * * s * * * ~ * * * * ~ * * * * * *

' - - R o u t i n e to do the Fiinn and Vollmer calculations SUB FlinnVolimer (Which$) WipeArea 2: WipeArea 4: NetOnScreenFlg = 1: PlotGr% = 1 FlinnFlg%

= 1

II% = BCotmt% + 1 IF ECount% > 0 AND BatchS$ = 0 THEN WipcA tea 1 LOCATE 1, 1: PRINT "Include previous data sets:" Menus$(4) = " Y e s ' : M e n u s $ ( 5 ) = " N o " Expiain$(4) = "New data point added to diagram (includes previous points)* ExplainS(5) = "Data point is only one on diagram" Menu Menus$(), ExplainS(), ANSI %, 0 IF ANSI% = 5 THENH% = 1 ENDIF EI(II%) = EVaI!(I): E2(II%) = EVaI!(2): E3(II%) = EVaI!(3) ' - - - F l i n n calcuhttlons LEI20I%) = LOG(EI01%) / E2OI%)): LE23(II%) = LOG(E2OI~) / E301%)) KOI%) = LEI20I%) / LE2301%): C(II%) = LOG(EI(II%) / E30I%)) ' - - V o l l m e r calculations ' - - - N o t e that non-normalized eigen value data are needed for this since ' - - - t h e normalization is done after the calculations L = EIOI%): M = E2(I]%): N = E301%) PVaIOI~) = (L - M) RValCtI%) = 3 * (N) GVaI([I~) = 2 * (M ' Check whether data was from keyboard or from f'de IF DataInput$ = "KEYBOARD" THEN SetName$(II%) = "Keyboard Data" ELSE SetName$0I%) = MID$(F$, 1, LEN(F$) - 4) ENDIF ECount% = H ~ ' - - - N o w go to the appropriate rvutine IF Which$ = "FLINN" THEN Flinn EVaI!(), ECotmt% ELSEIF Whieh$ = "TRIAN" THEN Vollmer EVaI!(), ECount% ENDIF END SUB , * * * * * * * * * * * * * * * O * * * * * * * * * * * * * * * * * * * * q l * * * * * * O * * * * * * * * * * * * * * * * * * ~ * * * * * *

SUB PrintFlinn (LEI2(), LE23(), SetNarne$(), EConnt%) ' ~ P r i n t the Flinn di~rmn to • PIC f'de DIM J(5) WipeArea 1 LOCATE 1, 1: PRINT "Output Flinn graph:" Menug$(4) = " N o ' : M e n u s $ ( 5 ) = " P I C ' : M e n u s $ ( 6 ) - "Screen-Dump" ExplainS(4) : "Do not save Flinn graph" ExplainS(5) = "Output to • PIC file" Expiain$(6) = "Output via screen dump to printer" IF l~tch% = 1 AND PrmtOm$ --- "PICHOW" THEN ANSI% = 5 EI~EIF Batch'$ = 1 AND PrintOutS = "~P.EENNOW" THEN ANSI¢$ = 6

239

240

D . A . VAN EVERDINGEN, J. A. M . VAN GOOL, a n d R. M . VISSERS

ELSKIF Batch ~ = 0 T H E N Menu Menu,S(), E x p l a i n S ( ) , A N S l %, 0 ENDIF IFANSI% = 5THEN WipeAre. 1 L O C A T E 1, 1: P R I N T * C r e a t h ~ P I C fd¢. Pleaze wait. ~ FlinnFlg% = 0 IF ECoLmt% > 10 T H E N NumPltg% = ECcamt% / 10 Remainder% = E C o u n t % M O D 10 IF Remaizater% > 0 T H E N NumPIta% ffi N u m P l t a % + 1 ELSE NumPRs% = 1 ENDIF F O R JJ ---- 1 T O NumPIts% PictureS = "" PHead Pictures ' - - - P l o t g r a p h axes P M o v ¢ PictureS, 6 * 63 * 4, 2 1 0 0 - 2 * 63 * 4 P D r a w PictureS, 6 * 63 * 4, 2 1 0 0 - 7 * 63 * 4 P D r a w PictureS, 11 * 63 * 4, 2 1 0 0 - 7 * 63 * 4 '-----Plot shape parameter curves J ( l ) = 7: J('2) = 8.5: J O ) = II: J(4) = 4.5: J(5) = 6 FOR I = 1 TO 5 1FI < 4THEN P M o v e PictureS, 6 * 63 * 4, 2 1 0 0 - 7 * 63 * 4 P D r a w PictureS, J(l) * 63 * 4, 2 1 0 0 - 2 * 63 * 4 ELSE P M o v e PictureS, 6 * 63 * 4, 2 1 0 0 - 7 * 63 * 4 P D r a w PictureS, 11 * 63 * 4, 2 1 0 0 - J(I) * 63 * 4 ENDIF NEXT I ' - - - - P l o t strength p a r a m e t e r curves P M o v e PictureS, 6 * 63 * 4, 2 1 0 0 - 5 * 63 " 4 P D r a w PictureS, 8 * 63 * 4, 2 1 0 0 - 7 * 63 * 4 P M o v ¢ PictureS, 6 * 63 * 4, 2 1 0 0 - 3 * 63 * 4 P D r a w PictureS, 10 * 63 * 4, 2 1 0 0 - 7 * 63 * 4 P M o v ¢ PictureS, 7 * 63 * 4, 2 1 0 0 - 2 * 63 * 4 P D r a w PictureS, 11 * 63 * 4, 2 1 0 0 - 6 * 63 * 4 P M o v ¢ PictureS, 9 * 63 * 4, 2 1 0 0 - 2 * 63 * 4 P D r a w PictureS, I I * 63 * 4, 2 1 0 0 - 4 * 63 * 4 ' - - - T i c k m a r k s ( b o ~ axes) and Label axes FOR I = I TO 5 II$ = S T R $ ( 6 - I) P M o v e Pi=ture$, 6 * 63 * 4, 2100 - (I + I) * 63 * 4 P D r a w PictureS, (6 * 63 ° 5) * 4, 2100 - (I + I) * 63 * 4 P M o v c PictureS, (6 * 63 - 40) * 4, 2100 - (I + I) * 63 * 4 PTcxt PictureS, 0, 1, H$ II$ = STR$(1) P M o v e PictureS, (I + 6) * 63 * 4, 2 1 0 0 - 7 * 63 * 4 P D r a w PictureS, (I + 6) * 63 * 4, 2 1 0 0 - (7 * 63 + 5) * 4 P M o v e PictureS, (I + 6) * 63 * 4 - 50, 2 1 0 0 - (7 * 63 + 20) * 4 PText PictureS, 0, 1, II$ P M o v e PictureS. 1330, 2 1 0 0 - 4 * 63 * 4 PText PictureS, 1, 1, " I n ( E l / E 2 ) " P M o v e PictureS, 2 1 0 0 , 160 PText PictureS, 0, 1, " I a ( E 2 / E 3 ) " P M o v e PictureS, 2 0 0 0 , 1750 PText PictureS, O, 1, " C L U S T E R S " P M o v e PictureS, 3 0 0 0 , 1500 PText PictureS, 3, 1, " G I R D L E S " P M o v e PictureS, 1650, 1640 PText PictureS, O, 1, "Kffi5" P M o v e PictureS, 2 0 5 0 , 1640 P T e x t PictureS, 0, 1, " K = 2 "

Processing orientation data with QuickPlot PMove PictureS, 2700, 1640 PText PictureS, 0, 1, " K - - I " PMove PictureS, 2800, 940 PText PictureS, 0, 1, "K--0.5" PMove Picture, S, 2800, 570 PText PictureS, 0, 1, "K--0.2" PMove PictureS, 2080, 820 PText PictureS, O, 1, "C--4" PMove PictureS, 2350, 1050 PText PictureS, 0, 1, " C = 6 " PMove PictureS, 2600, 1300 PText PictureS, O, I, " C = 8 " ~ D a t a plotting PMove PictureS, 10, 1800 Msg$ = "Symb. Set Name" PText PictureS, 0, 1, Msg$ IF ECount% > 10 THEN DD% = DD% + 10 C9; = D D g ; - 9 IF Remainderg; > 0 AND NumPltsg; = DDg; / 10 THEN DDg; = @ @ C9; + Remainderg; - 1 ELSE C9; = 1: DDg; = ECountg; ENDIF FOR I9; = C9; TO DDg; Xg; = (6 * 63 + (63 * LE23(19;))) * 4 / 4.A.A.AAA-A. Yg; = (7 * 63 - (63 * LEI2(Ig;))) * 4 / 4.A-A-A-A-A~I F I g ; > 10 T H E N N g ; = 19; MOD 10 ELSEN9; = I9; PFlinnSym Pictures, Xg;, Yg;, Ng;, ipeng; PFlinnSym PictureS, 10, 90 + Ng; * 22, Ng;, ipeng; PMove PictureS, 400, 2100 - (400 + (Ng; * 100)) PText PictureS, 0, 1, SetNames(Ig;) NEXT I9; ' - - - P u t title at top of page IF Batch9; = 0 THEN WipeAreat 1 LOCATE I, 1: INPUT "Eater title of plot (Printed at top of page): @ @ ' , Titles ELSE IF MID$(Oper$, 9, LEN(Opcr$)) < > "" THEN TitleS = MID$(Opcr$, @ @9, LEN(O~r$)) EHDIF PMove PictureS, 1590, 2000 PText PictureS, 0, 4, TitleS PMove PictureS, 1590, 1950 Msg$ = "(modified Flinn diagram)" PFSizc PictureS, 50, 50 Irrext PictureS, 0, 4, Msg$ IF NumPItg; > 1 THEN T$ = "F" + STR$(JJ) ELSE T$ = "F" ENDIF PicFileOpen PictureS, PicFIg, T$, F$ PC'lose Pictures NEXT JJ WipeArea 1 LOCATE 2, 1: PRINT "End" ELSEIF ANSI $ -- 6 THEN WipeArea 3

W~,Area 5 checkprimer3: LOCATE 1, 1: PRINT "Checking inmter" •----print space plm LPRINT" " + CHItS(g) WipeArea 1

241

D. A. VAN EVERDINGEN, J. A. M. VAN GOOL, and R. M. VISSERS

242

IFNerr~ <> 0THI~ BEEP Nerr~ = 0 LOCATE I, I: PRINT "Printer not ready. Check printer and press any key @ @to continue." PRINT "(press escape to return to main menu)" DO: aS = INKEYS: LOOP UNTIL aS < > "" WipeArea I IF aS = CHR$(27) THEN GOTO endprint3 ELSE GOTO checkprintcr3 ELSE ' - - A s k for title to plot ff needed WipcAreA 1 LOCATE I, 1: INPUT "Enter title of plot (Enter for none): ", Titles WipcArea 5 IF Titles < > "" THEN Msg$ = "(modified Flinn diagram)" L O C A T E 2 , 15: PRINT TitleS; " "; Msg$ ENDIF ' - - H e r c u l e s screen put 0 in keyboard buffer for mouoprt IF D.SCR = 3 THEN DEF SEO = &H40 POKE &HIA, &HIE POKE &HIC, &l-120 POKE &HIE, 4g ENDIF '---printscreen CALL interrupt(&H5, lnRcg, OutReg) LPRINT CHR$(12) ENDIF ENDIF ' - - - A s k if output of all data is required WipeArea 1 LOCATE 1, 1: PRINT "Save Flinn param, data:" Menu•S(4) = "Yes': Menus$(5) = "No" ExplainS(4) = "Save all eigen value and parameter data to • fde" ExplainS(5) = "Do not save data to a file" IF Batch% = 1 THEN S%=4

ELSE Menu Menu•S(), ExplainS(), S%, 0 ENDIF I F S % = 4 THEN IF Batch % = 0 THEN E%=I WHILE NOT E% = 0 '-----Check fu~t if there is enough room on the destination disk IF Batch% = 0 THEN CheckFree "STAT', " F ' , Numb% Wipe.Area 1 LOCATE I, 1: INPUT "Save file on disk - enter filename: ", FI$ FileS = D a t a D ~ + FI$ FileExist FileS, E% I F E % = 1 THFJq Wiwa~rea 1 LOCATE 1, 1: PRINT "Overwrite File" LOCATE 2, 1: PRINT FileS; " exists" Menu•S(2) = "Yea': Menu•SO) = "No': Menu•S(4) = "" Menu Menu,~S(), ExplainS(), 0, ANSI % IF ANSI% = 2 T H E N E% - - 0 ENDIF WEND ELSE Files = DataDirOut$ + MID$(F$, t, LEN(F$) - 3) + " F I N " ENDIF OPEN Files FOR OUTPUT AS 03 PRINT 03, "Data Eiten Value" PRINT 03, "Set 1 2 3 LEI2 LE23 K @ @

C"

Processing orientation data with QuickPlot

FOR I% = 1 TO ECotmt~ PRINT #3, USING "\ \ ' ; SetName$(l%); PRINT #3, USING " ~ . g t ~ ' ; E l 0 % ) ; E2(I~); E3(1%); LE12(I%); @ @LE23(I%); K(I%); C 0 % ) NEXT I% CLOSE #3 ENDIF cadprint3: END SUB *****.000..0.***.0****.0.*******.4.4.***0"****$'0"0"**0"*~

'--R~c

to plot triangular f ~ r ~ diagram

' - - B a s e d on Vollm©r, F.W.; 1990, An Application of Eigcnvalu¢ Mcthods ' - - t o Stn~tural Analysis; O.S.A.BuHetin v102, 786-791 '-----Program by D.A. van Everdingen Date: 8-8-90 SUB Vollmer (EVal!(), ECount%) I1% = ECount% IF Points % ( > 0 THEN Number% = Points% ELSE Number% = Numb% END IF '----PPX%, PPY% allow spatial translation of triangle PPX% = D.CX * 22 + 2: PPY% = D.CY * 4 + 9 ' - - - P X % , P Y % = top left corner of trhmgle ' - - - R X % , R Y % = bottom of triangle ' - - G X % = top right x coordinate (relative to PX%) PX% = 0 + PPX%: PY% = 0 + PPY% GX% = D.CX * 44 + 4: RX% = D.CX * 22 + 2 + PPX% RY% = (D.CY * 23 + 10) * YRatio + PPY% '----draw triangle LINE (PX%, PY%)-(PX% + GX%, PY%): LINE (PX% + GX%, PY%) -@

@ (RX%, RY%) LINE (RX%, RY%)-(PX%, PY%) ' - - - V tick symbol V$ = "GSE5fSH5" ' - - - D r a w top tick marks FOR I -- 1 TO 9 PSET (PX% + (GX% / 10) * I, PY%): DRAW V$ NEXT I ' - - - C a l c u l a t e left side hypotenuse length and ansl¢ Hyp = SQR((RX% - PX%) ^ 2 + OtY% - PY%) ^ 2) / 10 Th = ATN((RY% - PY%) / (RX% - PX%)) '----Draw left side tick marks FOR I = 1 TO 9 DX% = Hyp * I * C o s ( r h ) : DY% = Hyp * I * SING'h) PSET (PX% + DX%, PY% + DY%): DRAW "TAI20" + V$ NEXT I '----Calculate right side hypotenuse length and angle Hyp = SQR((RX% - (PX% + GX%)) ^ 2 + (RY% - PY%) ^ 2) / 10 Th = ATN((RY% - PY%) / (RX% - (PX% + GX%))) '----Draw right side tick marks FOR I = 1 TO 9 DX% = Hyp * ] * COS(Th): DY% = Hyp * I * SIN(Th) PSET (RX% + DX%, RY% + DY%): DRAW "TA240" + V$ NEXT I ' - - - L a b e l graph apices LOCATE 5, 17: PRINT "Point'; : LOCATE 5, 69: PRINT "Girdle'; LOCATE D.ML - I, 43: PRINT "Random'; '----Symbols for 0, Lambda, equah Zeros = " U 3 E I R 4 F I D 6 G I I A H I l D R I U 4 R 4 D g L 4 U 4 * L$ = " G 3 D 3 L I U I E I R I U 3 F 1 U 2 F 5 D 1 L I U 3 G I U 3 L 1 U 2 L I U 2 G I U 2 I A D I R I E 2 L I " EqualS = "BDIR6BD3L6* L O C A T E 17, 65: PRINT "TRIANGULAR'; ~ATE 19, 65: PRINT " FABRIC'; LOCATE 21, 65: PRINT " DIAGRAM';

243

244

D . A . VAN EVERDINGEN,J. A. M. VAN GOOL, and R. M. VISSERS

'--Lambda3 = 0 PSET (44 * D.CX + 4, 3 * D.CY + 8): DRAW "TA0" + L$ + @ @ "BF9BD3BR3" + NN$(3) + "BEI0" + Equals + "BRIOBUIBR2"@

@ + Zeros ' - - L a m b d a l = Lambda2 PSET (57 * D.CX + 7, 14 * D.CY + 4): DRAW "TA60" + L$ +@ @ "BF9BD3BR3" + NN$(1) + "BU10BR5" + Equals + "BRISBU4" @ @+ L$ + "BF9BD3BR3" + NN$('2)

'--Lambda2 = Lambda3 PSET (27 * D.CX + 7, 12 * D.CY + 2): DRAW "TA300" + L$ +@ @ "BF9BD3BR3" + NN$(2) + "BUIOBR5" + Equals + "BRIgBU4" @ @ + L$ + "BF9BD3BR3" + NN$(3) ' - - P l o t labels to side of page LOCATE 7, 1: PRINT "F..igen Values" PSET (2 * D.CX + 2, 7 * D.CY + 5): DRAW "TA0" + L$ + "BFTBRS" + @ @ NNS(1) PSET (8 * D.CX + 8, 7 * D.CY + 5): DRAW L$ + "BF7BR5" + NN$(2) PSET (15 * D.CX + 5, 7 * D.CT + 5): DRAW L$ + "BF7BR5" + NN$O) LOCATE 10, 1: PRINT "Point=( - )/N" PSET (7 * D.CX + 6, 9 * D.CY + 4): DRAW L$ + "BFgBD3BR3" + NN$(I) PSET (10 * D.CX + 7, 9 * D.CY + 4): DRAW L$ + "BFgBD3BR3" + NN$(2) LOCATE 12, 1: PRINT "Girdle=2( - )/N" PSET (9 * D.CX + 4, 11 * D.CY + 5): DRAW L$ + "BFgBD3BR3" + NN$(2) PSET (12 * D.CX + 7, 11 * D.CV + 5): DRAWLS + "BF9BD3BR3" + @ @ NN$(3) LOCATE 14, 1: PRINT "Rendum--3( )/N" PSET (9 * D.CX + 6, 13 * D.CY + 4): DRAW L$ + "BF9BD3BR3" + NN$(3) ' - - - P l o t data to side of page LOCATE 9, I: PRINT USING "#.### "; EI(II%), E2(I1%), E3(II%) LOCATE 11, 3: PRINT " P = ' , USING "#.##/if; PVaI(II%)

L O C A T E 13, 3: PRINT "G='; USING "#.###', GVaI(II%) LOCATE 15, 3: PRINT " R = ' ; USING "#.##/P'; RVaI(H%) ' - - - P l o t data points FOR I = 1 TO ECount% Y % = RVai(1) * O t Y % - P Y % )

'----The Y %/TAN(60) is < 0 ff X % > 50 else > 0 (basic geometry considerations) IF PVal(1) > 50 THEN YV% = -Y% ELSEYV% = Y% X% = (GX% * (1 - PVaI(1))) - YV% / SQR(3) / YRatio PSET (X% + PX%, Y% + PY%): DRAW "TAOLAU4R4D4" NEXT I ' - - - C h e c k if output is needed of Vollmer diagram but only if no plot is '----presently being made IF PicFIg = 0 THEN PrintVollmer PVaI(), RVaI(), GVai(), SetNamc$(), ECount% ENDIF END SUB

' - - - P I C output of Vollmer triangular fabric diagram SUB PrintVollmer (PVaI(), RVaI(), GVaI(), SetName$(), ECount%) WipeArea 1 LOCATE 1, 1: PRINT "Output Triangular diagram:" Menus$(4) = "No': Menuss(5) = "PIC': Menua$(6) = "Screen-Dump" Explains(4) = "Do not save diagram" Explains(5) = "Output to a PIC file" ExplainS(6) = "Output via screen dump to printer" IF Batch% = 1 AND PrintOutS = "PICNOW" THEN ANSI% = 5 ELSEIF Batch% = 1 AND PrintOutS = "SCREENNOW" THEN ANSI % = 6 ELSEIF Batch~ = 0 THEN Menu Menuss(), ExplainS(), ANSI 96, 0 ENDIF IF ANSI% = 5 T H E N W ~ , A tea 1

Processing orientation data with QuickPlot LOCATE I, 1: PRINT "Creating PIC ['de. pieue wait." ~,,~g~ = 0 IF ECotmt~ > 10 THEN NmnPlts~ = ECotmt~ / 10 Rmminder% = ECcqmt% MOD 10 IF Remainder% > 0 THEN NumPIts% = NumPlta~ + 1 ELSE NumPlts% = 1 ENDW FOR JJ -- 1 TO NumPIts% Pictures = "" PHcad pictures ' - - P l o t tvi~gle edges PMove pictureS, 889, 1811 PDraw pictureS, 2667, 1811 PDraw PictureS, 1778, 271 PDraw PictureS, 889, 1811 ' - - D r a w top tick marks FOR I = I TO 9

PMove PictureS, 889 + 178 * I, 1811 PDraw PictureS, 889 + 178 * I + 12, 1791 PMove PictureS, 889 + 178 * I, 1811 PDraw PictureS, 889 + 178 * I - 12, 1791 NF~T I ' ~ D r a w left side tick marks FOR I = 1 TO 9 DX% = 889 + 89.5 * I: DY% = 2100- 289- 155.0185 * I PMove PictureS, DX%, DY% PDraw PictureS, DX% + 23, DY% PMove PictureS, DX %, DY 9~ PDraw PictureS, DX% + 12, DY% + 20 NEXT I ' - - - D r a w right side tick marks FOR I = 1 TO 9 DX% = 2667 - 89.5 * I: DYg; -- 2100 - 289 - 155.0185 * I PMove PictureS, DX %, DY PDraw PictureS, DX% - 23, DY% PMove PictureS, DX%, DY% PDraw PictureS, DX% - 12, DY% + 20 NEXT I PMove PictureS, 840, 1820 PText PictureS, 0, 3, "Point" PMove PictureS, 2720, 1820 PText PictureS, 0, 1, "Girdle" PMove PictureS, 1800, 154 PText PictureS, 0, 4, "Random" ' w A d d lambda labels ' - - L 3 =0 PDrawSym PictureS, 380. 50, 27, ipen% PDrawSym PictureS, 394, 57, 22, ipen~ PDrawSym PictureS, 404, 50, 36, ipen~ PDrawSym PictureS, 418, 50, 37, ipcn~ 'wL2=L3 PDrawSym PictureS, 240, 190, 28, ipcn~ PDrawSym PictureS, 243, 202, 31, ipen96 PDrawSym PictureS, 250, 220, 34, i1~% PDrawSym PictureS, 265, 240, 28, ipeag; PDrawSym PictureS, 268, 252, 33, ipeng; ' ~ L I = L2 PDrawSym PictureS, 520, 250, 29, ipen~ PDrawSym PictureS, 527, 242, 30, ipett~ PDrawSym PictureS, 530, 230, 35, ipea~ PDrawSym PictureS, 540, 210, 29, il~a~ PDrawSym PictureS, 547, 202, 32, ~ '--Data PMove PictureS, 10, 1676 CAGEO 18 2/3--J

245

246

D . A . VAN EVERDINGEN, J. A. M. VAN GOOL, and R. M. VISSERS

Mag$ = "Symb. Set Name* PText PictureS, 0, 1, M q $ IF ECoent% > 1 0 T H E N DD% = D D % + 10 C% = DD% - 9 IF Remainder% > 0 AND NumPlts% -- DD% / 10 THEN DD% --- C % O @ + Remainder% - 1 EI~E C% = 1: DD% = ECotmt% ENDIF FOR I% = C % TO DD% ' - - C a l c u l a t e the x,y coordinates on the disgram - in screen coords since ' - - t h e routine pF1in~qym convem them to PIC cootah Y% = RVal(l%) * 346.5 ' - - T h e Y%/TAN(60) is < 0 f i X % > 5 0 else > 0 (basic geometry considerations) IF PVaI(I%) > 50 THEN YV% = -Y% ELSEYV% = Y% X% = (400 * (I - PValg%))) - YV% / SQR(3)

IF I% > I0 THEN N% = I% MOD I0 E L S E N % = I% PFlinnSym PictureS, X% + 200, Y% + 65, N%, ipon% PFlinnSym PictureS, 10, 118 + N% * 22, N%, ipon% PMove PictureS, 400, 2100 - (525 + (N% * 1{30)) PText PictureS, 0, 1, SetNames(l%) ~ T I% ' - - - P u t title at top of page IF Batch % = 0 THEN WipeA tea 1 LOCATE 1, 1: INPUT "Enter title of plot (Printed at top of page): ",@ @ TitleS ELSE IF MlD$(Oper$, 9, LEN(Oper$)) < > "" THEN TiOes = MIDS(Oper$,@ @ 9, LEN(Oper$)) ENDIF PMove Pictures, 1710, 2000 PText PictureS, 0, 4, TitleS PMove PictureS, 1710, 1950 Msg$ = "(Triangular Fabric Diagram)" PFSize PictureS, 50, 50 PText PictureS, 0, 4, Msg$ IF NumPlt% > I T H E N T$ = "T" + STR$(JJ) ELSE T$ = "T" ENDIF PicFileOpen PictureS, PicFlg, T$, F$ PClose Pictures N E X T JJ WipeArea 1 LOCATE 2 , 1: PRINT "End" ELSEIF ANSI % -- 6 THEN WipeArea 3 WipeArea 5 checkprinter33: LOCATE 1, 1: PRINT "Checking printer" ' - - p r i n t space plus backspace LPRINT " " + CHItS(g) WipeArea 1 IFNerr% < > 0 T H E N BEEP Nerr% = 0 LOCATE 1, 1 PRINT "Printernot ready. Check printer and press any key to continue." PRINT "(press escape to return to main menu)" DO: a$ = I N K E Y $ : LOOP UNTIL aS < > "" WipeArea 1 IF aS = CHR$(27) T H E N G O T O eudprint33 ELSE GOTO checkprinter33 EL.SE

Processing orientation data with QuickPlot

' ~ A s k for title to plot if needed Wipe.Area I LOCATE 1, 1: INPUT "Eater title of plot (Enter for none): ", TitleS

WipeArea 5 IF Titles < >

"'THEN

M~S -- -(Tampatt Fabric D ~ r m ) " LOCATE 2, 15: PRINT TitleS; " "; MsgS EIqD IF ' ~ H e r e u l ~ scrt~n put 0 hi keyboard buffer for monoprt IF D.SCR -- 3 THElq DEF SEG -- &H40 POKE &HIA, &HIE POKE &HIC, &H20 POKE &HIE, 48 ENDIF '~printacreen CALL interrupt(&H5, lnReg, OutReg) LPRINT CHR$(12) V_JqD IF ENDIF ' - - C h e c k first ff there is enough room on the disk IF Batch% = 0 THEN CheckFree "STAT', T$, Ntmab% '----Ask if output of all data is required

WipeArea 1 LOCATE I, I: PRINT "Save fabric data:" Menus$(4) = "Yes': Menus$(5) = "No"

ExplainS(4) = "Save all eigen value and parameter data to a file" ExplainS(5) = "Do not save data to a file" IF Batch% = 1 T ~ S% = 4 ELSE M e n u Menus$(), ExplainS(), S %, 0 ENDIF IFS% = 4 THEN IF Batch % = 0 T H E N E%=I

WHILE NOT E% -- 0 WipeArea 1 LOCATE 1, 1: INPUT "Save file on disk - enter filename: ", FI$ Files = DataDirOut$ + FI$ FileExist FileS, E% 1FE% = I T H E N WipeArea 1 LOCATE 1, 1: PRINT "Overwrite File" LOCATE 2, 1: PRINT FileS; " exists" MenusS(2) = "Yes': Menus$(3) = "No': Menus$(4) = "" M e n u Menus$(), ExplainS(), 0, A N S I % IF A N S I % = 2 T H E N E % = 0 ENDIF WEND ELSE

Files = DataDirOut$ + MID$(F$, 1, LEN(F$) - 3) + " F I N " ENDIF OPEN Files FOR OUTPUT AS//3 PRINT #3, "Data Eigen Values (Normalized to N = ' ; Numb%; ")" PRINT #3, "Set 1 2 3 Point Random @

@Girdle

-

F O R I% = I T O E C o n n t %

PRINT #3, USING "\ \ ' ; SetName$(l%); PRINT #3, USING "#~##.###N'; El(I%); E2(1%); E3(I%); PVaI(I%); @

@RVaI(I%); GVai(I%) ~ 1 % CLOSE #3 ENDIF

eedlniaO3: END SUB '-----STATISTICAL TESTS: D R I V E R R O U T I N E

247

248

D . A . VAN EVERDINGEN,J. A. M. VAN GOOL, and R. M. V]SSERS

**********************************************************************

SUB SmtaD~ta ' ~ R o n t m c to ~ the ~ 1 1 ~ of statistics routines W~Ar~ 1 LOCATE I, I: PRINT "Stats:" ' C h e c k for multiple data set check which symbol or if all are '--to be plotted IF Batch~ = 0 AND MID$(MuRI~$, 3, I) = "M" THEN OWSymb$ : WhatSymb$ ' - - - S a v e old symbol II = I: FOR I = I TO 13: Se~(1) = 0: NEXT I FOR I = 1 TO Nmmh% Okay% = 0 FORJ = 1TOII IF Sets(/) = Symb%(1) THEN Okay% = 1: EXIT FOR NEXTJ IF OkayeS = 0 THEN Sets(ll) -- Symb%(1)" II = II + 1 NEXTI Sets(13) = I I - 1 PickSymboD: WipeArea I L O C A T E 2, I: P R I N T "(Set numbers present in data: "; F O R I = I T O Sets(13): P R I N T SeAs(T); " "; : N E X T I: P R I N T ")" L O C A T E I, I PRINT "These data have "; Seta(13); " sets, enter set number to plot @ @(A for all): "; INPUT ; " ", WhatSymb$ What~ymb$ = UCASE$(WhatSymb$) IF WhatSymb$ = CHR$(13) THEN GOTO PickSymboD: Query WhatSymb$, NumFlgeS IF NumFlgeS -- I A N D WhatSymb$ < > "A" T H E N O O T O PickSymboD: ' - - M a k e sure the entered number is one of the possible choices Okay % = O FOR I -- 1 TO Sets(13) IF VAL(WhatSymb$) = Sets(l) THEN Okay eS = 1 NEXT I IF WhatSymb$ < > "A" AND Okay% = 0 THEN GOTO PickSymbol3: Points% = 0 FOR I = 1 TO Numb % IF VAL(WhatSymb$) = Symbes(l) THEN Pointses = Pointa~$ + 1 NEXTI IF OWSymb$ < > "" AND OWSymb$ < > WhatSymb$ THEN EigenFIg = 0: FishcrFlg = 0: PiFlg -- 0: VFlg % = 0 ENDIF END IF IF Numb% < 3 THEN LOCATE 1, 1 PRINT "Data set contains less than three points. It is not worth it to" PRINT " perform statistics on this data set. Press any key to continue" DO: LOOP UNTIL INKEY$ < > "" OOTO End.Stats: ENDIF DO WipeArea I LOCATE I, l: PRINT "Stats:" Menus$(l) = "Eigen': ExplainS(l) = "Calculate Eigenvectorl and Eigenvalues" Menus$(2) = "Fisher': ExplainS(2) = "Fisher 95% confidence circle diametre" Mmus$O) = "Girdle" ' - - I f lincations then is just girdle dist. otherwise (ModeeS < > 2 ) is PI gird. Explain$O) : "Compute girdle through or mean of orientations" Menus$(4) = "Uniform': ExplainS(4) = "Perform oniformity test on the data" Ment~$(5) = "Tri/Fl." ExplainS(5) = "Plot modif'~d Flinn or triangular fabric diagram" Menus$(6) = "Quit': ExplainS(6) = "Return to main menu" IF Batches = 0 T H E N Menu Menus$(), ExplainS(), SeS, 0 ELSEIF BatcheS = 1 THEN IV MID$(Oper$, 6, 5) = "EIOEN" THEN SeS = I

Processing orientation data with QuickPlot

IF MID$(Oper$, 6, O3 = "FISHER" T H E N S% = 2 IF Mm$(OperS, 6, 2) = "PI" THEN SSS = 3

IF M~DS(OperS, I, 5) = "FLn'~N" O R 1~ODS(Oper$, I, 5) = "TmAN" THINS% F~'D IF

-- 5

SELECT CASE S% CASE 1 ' Eigen Analysis EigcnAnalysis P ( ) , PA(), F$ F_~geul~ = t CASE 2, 3, 4, 5 IF EigenFIg = 0 T H EigFishFIg = 1 'Suppr~s output of eig~value data EigenAnalysis P ( ) , P A ( ) , F$ EigFishFIg -- 0 'Reset flag Eigenr~g = 1 ENDIF IF S% = 2 THEN 'Fisher analysis PlotOnlyl~8 = l FisherAnalysis F $ , T ( ) FisherFlg = 1 ELSEIF S% = 3 THEN 'Give pole to Pi circle PlotOnlyFIg = 1 PiFIg = 1 WipeArea 1 LOCATE 1, 1: PRINT "Girdle:" Menus$(l) = "Program':Menus$(2) = "Choose" ExplainS(l) = "Program decides if data are clustered or girdled" ExplainS(2) = "You decide if data are clustered or girdled" IF Batch % = 0 THEN Menu Menus$(), ExplainS(), ANSI %, 0 ELSEIF Batch% = 1 THEN ANSI % = 1 ENDIF IF ANSI % = 1 THEN ' ~ D o Uniformity test to see if data are clustered or s girdle Disp$ = "NONE" Unlfonn T ( ) , Disp$ K = VAL(Disp$) I F K > 11 THEN CPiFig% = 1 E I ~ E C P i F I g % = 2 ELSEIF ANSI % = 2 THEN WipeArea 1 LOCATE 1, 1: PRINT "Choose: " Menus$(l) = "Cluster': Menus$(2) = "Girdle" ExplainS(l) = "To you the data represent • cluster" ExplainS(2) = "To you the data represent • girdle" Menu Menus$(), ExplainS(), CPiFlg%, 0 ENDIF IF Mode % = I AND CPiFIg % = I THEN Msg$ = "Mean:" Msg2$ = " Dip = " AP = (PA(1) + 180) MOD 360: DP = 90 - P(1) ELSEIF Mode% = 1 AND CPiFig% = 2 T H E N Msg$ = "Fold Axis:" Msg2$ = " Ping = " AP = PA(3): DP = P(3) ELSEW Mode% = 2 AND CPiFlg% = 1 THEN Msg$ = "Axis:" Msg2$ = " Ping = " AP = PA(1): DP -- P(I) ELSEIF Mode% = 2 AND CPiFIg% = 2 THEN Mmg$ = "Best Fit Girdle:" Msg2$ = " Dip = " AP = (PA(3) + 180) MOD 360: DP = 90 - P(3) ENDIF LOCATE 19, 1: PRINT SPACES(17) LOCATE 20, 1: PRINT SPACES(14)

249

250

D . A . VAN EVERDINGEN, J. A. M. VAr~GOOL, and R. M. VISSESS

LOCATE 21, 1: PRINT SPACES(14) LOCATE 19, 1: PRINT M ~ $ PRINT " Azim = "; : PRINT USING " J ~ # . r ; AP PRINT Msg2$; : PRINT USING "##Jq/.#'; DP IF Batch% = 1 THEN OPEN MID$(F$, 1, LEN(F$) - 3) + "GIR" FOR OUTPUT AS//3 PRINT #3, Msg$ PRINT//3, " Azim = "; : PRINT//3, USING .####.je,; AP PRINT//3, Msg2$; : PRINT #3, USING -##jq/.je,; DP CLOSE #3 ENDIF ELSEIF S% = 4 THEN 'Uniformity test Uniform T ( ) , "ALL" ELSEIF S % = 5 THEN WipcArca 1 LOCATE 1, 1: PRINT "Which:" Menus$(l) = "MOd.FI.': ExplainS(I) = "Modified Fliun diagram" Memm$(2) = "Tri.Fab.': ExplainS(2) = "Triangular fabric diagram" IF Batch % = 0 THEN Menu Menus$(), ExplainS(), ANS1%, 0 IF ANSI % = 1 THEN Which$ = "FLINN" ELSEIF ANSI % = 2 THEN Whlch$ = "TRIAN" ENDW ELSE IF MID$(Oper$, 1, 5) = "FLINN" THEN Which$ = "FLINN" ELSEIF MID$(Oper$, 1, 5) = "TRIAN" THEN Which$ = "TRIAN" ENDIF ENDIF FlinnVollmer Which$ ENDIF CASE ELSE END SELECT IF Batch% = 1 THEN EXIT DO L O O P W H I L E S% < > 6 A N D S % < > -1 EndStats: IF MID$(Oper$, 1, 5) = "PLOTS" AND Batch% = 1 THEN Operstion% = 2 ENDIF END SUB ' - - S T A T I S T I C A L TESTS: U N I F O R M I T Y TEST SUB Uniform (T(), Disp$) ' - - R V 9 5 contains critical values for the Rayleigh test of uniformity at the '----0.05 level. Values range from N = 5 to 100+ and model a Chi squared '----distribution 0 degres of freedom) at N > 100. Based on Table Appendix 3.5 ' - - M a r d i a , 1972 - in Griffis et al.; 1985; Computers and C,-eoseienees v4 n4 '----p369-408. Disp$ tells whether to display output to screen DIM RV95 ('28) RESTORE: FOR I --- 1 TO 28: READ RV95(I): NEXT I IF VFIg% = 0 THEN FisherVector T(I), T(2), T(3) IF Points % < > 0 THEN Number % = Points % ELSE Number % = Numb % ENDIF RB = Vector / Number% IF Number% < 5 THEN IV -- 0 IF Number% > -- 5 AND Number% < -= 25 T H E N IV -- Number% - 4 IF Number% > 25 AND Number% < = 50 THEN IV = (Number% - 25) / 5 + 21 IF Number% > 50 AND Number% < = 100 THEN IV = 27 IF Number% > I O O T H E N IV = 28 ISIG -- 2

Processing orientation data with QuickPlot

IFIV <> 0THEN ISIG = 0 IF RB > RV95(IV) THEN ISIO = 1 ENDIF Wipe.Ares 1 LOCATE 1, 1 IF IV = 0 T H E N PRINT "There are too few data points to test significance" GOTO EndUnifonn: I~ID IF IF Disp$ = "ALL" THEN IF ISIO -- 0 THEN PRINT "The data do not differ significantly from ~miform @ @at the .95 level" IF ISIG : 1 THEN PRINT "The data differ significantly from uniform at the @ O.95 level" PRINT " Press any key to continue": DO: LOOP UNTIL INKEY$ < > "" ENDIF K = LOG(EVaI!(I) / EVaI!(2)) / LOG(EVaI!(2) / EVJd!0)) IF Disp$ -- "ALL" THEN Wipe.Area 1 LOCATE 1, 1 I F K > 1.1 THEN PRINT "Expected dis~l~tion type: Cluster" BLSEIF K > .9 AND K < 1.1 THEN PRINT "Expected distn'bution type: Girdle or Cluster" ELSEIF K < = .9 THF_,N PRINT "Expected distribution type: Girdle" ENDIF P R I N T " P r e s s any key to continue": DO: LOOP UNTIL INKEY$ < > "" C = LOGCEVaI!(1) / EVaI!(3)) WipeArea 1 LOCATE 1, 1 I F C >= 6THEN PRINT "Data have strong preferential orientation" ELSEIF C < 6 AND C > = 4 THEN PRINT "Data have moderate preferential orientation" ELSEIF C < 4 A N D C > - - 2 T H E N PRINT "Data have weak preferential orientation" ELSE PRINT "Data are not preferentially oriented" ENDIF EndUniform: P R I N T " Press any key to continue": DO: L O O P U N T I L I N K E ¥ $ < > "" WipeAres 1 LOCATE 1, 1 ENDIF ' ~ I f Uniform was called from the Pr/ntToPIot routine (to determine the ' ~ t y p e of great circle to draw (Ouster or Gridle)) then put the shape ' - - p a r a m e t e r into Disp$ for transfer to the PrintToPlot routine IF Disp$ < > "ALL" THEN Disp$ = STR$(K) END SUB ' ~ U T I L I T Y ROUTINES *************************************************************************

SUB Parse (Ent~$, N1, N2, N3, Fig%) ' ~ R o u t i n e to parse a data input line into numbers and check for errors DIM N(4) '~-Initializ¢ some variables FOR I = 1 TO 4: NO) = 0: NEXT I I = I: FIg~ = 0: FirstS = "" L e i t h = LRN{Ent~y$) ' ~ I g n o r e comment lines with ';' in column I IF MID$(Entry$, I, I) = ";" THEN GOTO EndParse: W H I L E I < = L e n g t h + 1 AND Fig% < 5 '.~ Check for non-numbers V.$ = MID$(EnUy$, I, ])

251

D. A. VAN EVERDINGEN, J. A. M. VAN GOOL, and R. M. VISSERS

252

IF E$ < c'tm$(48) OR ~ > crm$(57) AND E$ < > crm$(46) AND I < @ @ t ~ O h THEN IF PintS < > "'THEN N(FIg ~$) -- VAL('Fir~t$) Firsts = "" ENDIF '----Compile a number into Firsts ELSF_JF ~ > c m t $ ( 4 7 ) AND ~$ < C I ~ $ ( 5 8 ) OR E$ = CHR$(46) AND I@ @ < Longth T H ~ Firsts = Firsts + E$ ENDIF I=l+l WEND EndPar~: IF Fig % = 2 THEN N1 = N(I): N2 -- N(2) ELSEIF FIg ~ = 3 THEN

NI = N(1): ENDIF E N D SUB

N'2 = N(2): N 3

=

NO)

DEFSNG IoN SUB CheckFwe (SourceS, TypeS, Numb%) DIM InRegs AS RegType, OutRegs AS RegTypc ' - - - R o u t i n e to check how much space is f ~ e on a disk DEF SEG StartCheckFrec: ' - - D e t e r m i n e the current drive number ( M a x = ' H ' ) Dri$ = MID$(DataDirOut$, 1, 1) IF Dri$ = "A" THEN InRegs.dx -- & H I ELSEIF Dri$ = "B" THEN lnRegs.dx = &H2 ELSEIF Dri$ = "C" THEN InRegs.dx = &H3 ELSEIF Dri$ = "D" THEN InRegs.dx = &H4 ELSEIF Dri$ = "E" THEN InRegs.dx = &l-IS ELSEIF Dri$ = "F" THEN InRegs.dx = &H6 ELSEIF Dri$ = "G" THEN InRegs.dx -- &H7 ELSEIF Dri$ = "H" THEN InRegs.dx = &H8 ENDIF ' - - - D e t e r m i n e free di,k space left InRegs.ax -- &H3600 CALL intenupt(&H21, InRegs, OutRegs) Sec --- OutRegs.ax Clu -- OutRcgs.bx Byt --- OutRcgs.CX A U = OutRegs.dx Left = Byt * Sec * C l u ' - - - - D i s p l a y i f this is thought to be not enough Wipe.Area 1 IF Sources = "PIC" THEN IF Types = "C" THEN Sp = 1 2 0 0 0 : Room -- Left - Sp E I ~ E I F Types = "P" OR Types = "R" THEN Sp -- 1 0 0 0 + N u m b % * 100: R o o m = L e f t - Sip ELSEIF Types = "F" OR Types = "T" THEN Sp = 2 0 0 0 : Room = Left - Sp ENDIF OD$ = "Plot"

Processing o r i e n t a t i o n d a t a with Q u i c k P l o t ELSEIF SourceS = "STAT" T H E N Sp = 1000: Room = Lelt - Sp: OD$ = "Data fde" ELSEIF Sources = " D A T A " T H E N Sp = Numb% * 10: Roem = L e f t - Sp: OD$ = "Data fde" EblD IF IF Ronm < 0 T H E N L O C A T E 1, 1: PRINT OD$; " will require roughly "; Sp; "Bytes free apace." L O C A T E 2, 1: PRINT "Drive "; Dri$; " has "; Left; " bytes free space. O ~ P r e s s any key to continue" DO: L O O P U N T I L INKEY$ < > "" WipeArea I L O C A T E I, I: PRINT "Change:" Menus$(2) = "Drive" Menus$O) = "Floppy" Menus$(4) = "Chance" ExplainS(2) = "Change to m o t h e r drive and directory" ExplainS(3) = "Put another disk in drive" ExplainS(4) = "Take a chance and hope the f'de will fit (no guarantees!)" Menu M e n u s $ ( ) , ExplainS(), A H S 1 % , 0 SELECT CASE ANSI % CASE 2 StDriveDire¢ DataDirOut$ GOTO StartCheckFree: CASE 3 WipeArea 1 L O C A T E 1, 1: PRINT "Take disk out of "; Dri$; ": and put in another." L O C A T E 2, 1: PRINT "Close door and press any key when ready." DO: L O O P U N T I L INKEY$ < > "" GOTO S ~ e c k F r e e : CASE ELSE END S E L E C T ENDIF END SUB DEFINT 1-K SUB C h g C e n t I ~ ( X X X ~ , Y Y Y ~ ) ' ~ T h i s routine changes the centre location to produce multiple nets ' - - - o n one plot. Order of page filling for plots or contours only IF MID$(Oper$, 1, 6) -- "EIGHTC" OR MID$(Oper$, 1, 6) = "EIGHTP" T H E N IF X X X % = 462 A N D YY'Y'% = 172 T H E H XXX% = 101: Y Y Y % = 65: Fig8% = 1 E L S E I F X X X ~ = 101 A N D Y Y Y ~ = 65 T H E N X X X ~ = 270: Y'Y'Y~ = 65: Flgg*~ = 2 ELSEIF X X X % = 270 A N D Y Y Y % = 65 T H E N X X X % = 439: Y Y Y % = 65: F I g g ~ = 3 ELSEIF X X X ~ = 439 A N D Y Y Y % = 65 THEN XXX% -- 607: Y'YY% = 65: FIg8% = 4 ELSEIF X X X % = 607 A N D Y'YY ~ = 65 T H E N X X X % = 101: Y Y ' Y ~ = 270: Flg8% = 5 ELSEIF X X X ~ = 101 A N D Y Y Y ~ = 270 T H E N X X X % = 270: Y Y Y ~ = 270: Fig8% = 6 ELSEIF XXX % = 270 A N D YY'Y % -- 270 T H E N X X X % = 439: YY'Y% = 270: FI88% = 7 ELSEIF XXX ~ = 439 A N D Y Y Y % = 270 THEN X X X ~ = 607: Y Y Y ~ = 270: FIg8% = g ELSEIF XXX*~ = 607 A N D Y Y Y % = 270 T H E N X X X ~ = 101: Y Y Y % -- 65: Fig8% = 1 ENDIF ' - - O r d e r of page tiffing for plots or contours together ELSEIF MID$(Oper$, 1, 6) = "EIGHTB" T ~ I F X X X % = 462 A N D Y Y Y % = 172 THF~I X X X % = 101: Y Y Y % = 65" FIg8% = 1 ELSEIF X X X % = 101 A N D Y Y Y % = 65 T H E N X X X % = 101: Y Y Y % = 270: Fig8% = 2 E L S E I F X X X % = 101 A N D Y Y Y % = 2 7 0 T ~ X X X ~ = 270: Y Y Y g ; -- 65: F l g g ~ = 3

253

254

D . A . VAN EVERDINGEN, J. A. M. VAN GOOL, a n d R. M. VISSERS

ELSEIF X X X % ffi270 A N D Y Y ' Y % = 65 T H E N X X X % = 27~. Y Y Y % ffi270:. FIg8% = 4 EI~EIFXXX% ffi2 7 0 A N D Y Y Y % = 270THEN X X X % = 439: Y Y Y % = 65: Fig8% ffi 5 E L S E I F X X X % = 439 A N D Y Y Y % ffi 65 T H E N X X X % = 439: Y Y Y % = 270: Fig8% = 6 EI.~EIF X X X % = 439 A N D Y Y Y % ffi2 7 0 T ~ XXX% = 607: Y Y ' Y % = 65: F188% = 7 EI~EIF X X X % = 607 A N D Y Y Y % - 65 T H E N XXX% = 607: Y Y Y % = 270: F188% = 8 ELSEIF X X X % = 607 A N D Y Y Y % = 270 T H I ~ I X X X % = I01: Y Y Y % = 65: Flg8% = 1 ENDIF ENDIF END SUB DEFSNO L-N ,**m**m*********o*s*m*m******************@***************************

SUB GreatCircle (Azimuth, DipAngle) ' Compute and plot great circles DIM GreatC(20, 2) Str~¢ = (Azimuth + 90) M O D 360 FOR J = 1 T O 10 'make up array of 20 great circle points GrcatC(J, 2) = (90 - (J - 1) * 10) * Grad GreatC(J, 1) = S t r ~ e * Grad NEXT J FORJ = 11TO20 GreatC(J, 2) = ((J - 11) * 10) * Grad GreatC(J, 1) = ((Strike + 180) MOD 360) * Grad NEXTJ ' - - p o i n t s 20 and 1 must be interchanged to plot lines properly D3 = GreatC(20, 1): D2 = GreatC(20, 2) Gre~tC(20, 1) = G r e s t C ( l , 1): GreatC(20, 2) = GrestC(l, 2) GreatC(l, 1) = D3: GreatC(l, 2) = D2

OC~Ftg = 1 IF DipAngl¢ = 90 T H E N

DipAngl¢ = 89.9 GROtAng = 9 0 - DipAngle ' Now g o to the rotation part of the program and rotate the points RotateMath Strike, 0, GROtAng, D I , A, H, N A ( ) , biB( ) FORJ = ITO20 L = SIN(GreatC(J, 2)) * COS(GreatC(J, 1)) M = SIN(GreatC(J, 2)) * SIN(GreatC(J, 1))

N = c o s ( G r e s t c ( J , 2)) FOR J J = I T O 3 LL(JJ) = N A ( i , JJ) * L + NA(2, JJ) * M + NA(3, JJ) * N N E X T JJ GreatC(J, 1) = ATN(LL(2) / LL(1)) IF L L ( I ) < 0 T H E N GreatC(J. 1) = GrcatC(J, 1) + PI GrestC(J, 2) = ATN(((I / L L O ) ) " 2 - 1) " .5) ' - - t h e following statement is • H u g e to make the circles come out okay IF J : 1 A N D LL(3) > 0 T H E N LL(3) = LL(3) * (-1) IF L L O ) < 0 T H E N GrestC(J, I) = GrestC(J, 1) + PI NEXTJ F O R J = 1 TO 20 RSQ - R 95 * SQR(2) DD = RSQ * SIN(GreatC(J, 2) / 2): DDN = DD * YRatio X P T % = CINT(DD * SlN(GreatC(J, 1))) Y P T % = D D N * COS(GreatC(J, 1)) IF NoG$ = " " T H E N IF J > I T H E N LINE (OX0%, O Y 0 % ) - ( X X % + X P T % , Y Y % - Y P T % ) ENDIF ' ~ t h © following few lines put the points into a .PIC style format so '--that the data can be printed using Lotus (It) P G R A P H IF PicFIg = I T H E N DD = PieR% * S Q R ( 2 ) * SIN(GreatC(J, 2) / 2) PXPT% ffi DD * SIN(GreatC(J, 1))

Processing orientation data with QuickPlot XX! 95 == ( X X X % + PXPT%) * 4.A.A-~.A.A3.A-~ PYPT% = D D " COS(GreatC(J, 1)) Y Y I % "= 2100- ( Y Y Y % - 1 ~ 1 ~ % ) * 4.A.~.A.A.A.A.~.#

I F J > 1 THEN PMove Pktm~$, O X l % , OYI% PDraw PictureS,X X I % , Y Y I % ENDIF ' T o draw connected lines the lastpointmust be rmnembered O X l % = ( X X X % + P X P T % ) * 4.A.A.~A.J.A.~.~ TiC X O Y I % = 2100 - ( Y Y Y % - P Y P T % ) * 4.AA.A.~.A.A.X.#'PicY ENDIF • T o draw connected ~ the lastpointmust be remembered OX0% = XX% + XPT%: OY0% = YY% - YFF% 'Screea X,Y NEXTJ END SUB DEFINT N . ooeootleeeeoeosooooe~o~eooseee~oos~eoeoeeseosee$~eeoeoo~eeeeoee**eeeee

SUB Me~ (1"%) ' - - r o u t m ~ to plot the help screens, help f'fle contains help Wpc mtmbcr ' - - f o l l o w c d direct/y by nnmbcr of lincs of hcip (no spacc). '~I =main, 2=plot/rotate, 3=contour, 4=stats, 5=dcfaulls, 6=shell, 7=quit '--Help

file must contain no commas

' - - I f mode is Hercule~ IF D.SCR = 3 THEN SCREEN 3, , 1, 1 ELSE Wipe.Area 1 LOCATE 2, 1 PRINT "Requesting Help in this screen mode will erase the screen, Okay? [Y]" Q1$ = " ^ " WHILE INSTR('YN', QI$) = 0

QI$ = UCASE$(INPUT$(I)) IF QI$ = CHR$(13) T H E N Q I $ = "Y" IF QI$ < > "Y" T H E N G O T O EndHclp: ENDIF CLS E%=0 WHILE E% = 0 FileExist "QP.HLP', E % I F E % = 0 THEJq LINE (0, 0)-(D.MX, D.MY),, B L O C A T E I0, 25: PRINT "Help fileQP.HLP N O T found" LOCATE 12, 6 PRINT "To access Help, QP.HLP MUST be in uune directory as QP.EXE" LOCATE 18, 27: PRINT "Press any key ~ continue" DO: LOOP UNTIL INKEY$ < > " ' : E% = 2 ELSEIF E% = 1 T H I ~ OPEN "QP.HLP" FOR INPUT AS #I0 DO INPUT #!0, DIS LOOP UNTIL VAL(MID$(DI$, 1, 1)) = T% OR EOF(10) N% = VAL(MID$(DI$, 2, 2)) FORI = ITON% INPUT #10, DIS LOCATE I + 1, 2 PRINT MID$(DI$, 2, LEN(D1$)) NEXTI CLOSE #I0 LINE (0, 0)-(D.MX, D . M Y ) , , B LOCATE D . M L - I, 30: PRINT "Press any key to continue"; DO: LOOP UNTIL INKEY$ < > "" ENDIF WEND CLS

255

256

D . A . VAN EVERDINGEN,J. A. M. VAN GOOL, and R. M. VISSERS

' - - R ~ u m to screen page 1 if in Here. mode IF D.SCR -~ 3 THEN SCREEN 3, , 0, 0 EndHelp: END SUB $DYNAMIC ,******************************************************

'----Subroutine to put up QuickPIot logo SUB Logo LOCATE 2, 20: PRINT "Plotting Program For Orientation Data" LINE (D.CX * 33 - 2, D.CY * 6 - 2)-(D.CX * 42 + 2, D.CY * 7 ) , , B LOCATE 7, 34: PRINT "QuickPiot" LOCATE I0, 23: PRINT "D. van Everdingen/J. van Gool" LOCATE 12, 24: PRINT "Department of Earth Sciences" LOCATE 13, 21: PRINT "Memorial University of Newfotmdland" LOCATE 18, 34: PRINT "(C) 1990" LOCATE 20, 15: PRINT "MSHERC.COM is licensed by MicroSoft Corporation'; LOCATE 22, 26: PRINT " - - - - ' ; LOCATE 22, 70: PRINT "F1 -- Help'; LOCATE 24, 9 PRINT "This program may be distributed freely. It may NOT be sold'; END SUB REM $STATIC DEFSNG N ********************************************************************

S U B PlotCircle( X X % , Y Y % , R % , YRatio, PicFlg, CircleFlg,X X X % , '---Draw a circle

YYY%)

IF NoG$ = " " AND N~OnScreenFlg % = 0 THEN CIRCLE (XX%, YY%), R% . . . . YRatio L I N E ( X X % , Y Y % + YRatin * R % + 3)-(XX%, VY'% + YRatio * R % ) L I N E ( X X % , Y Y % - YRatio * R % - 4)-(XX%, Y Y % - YRatio * R % - I) '----N symbol IF North% = 0 THEN" P S E T ( X X % - 4, Y Y % - YRatio * R % - 6):@

@DRAW "U8FSUS" L I N E ( X X % - R % - 6, Y Y % ) - ( X X % - R % , Y Y % ) LINE CXX% + R % , Y Y % ) - ( X X % + R % + 6, Y Y % ) '----draw cross in centre

PSET (XX%, YY%): DRAW "BU3D6BU3BR4LS" '----Draw 10 degree interval tick marks around circumference IF Tick % = 1 THEN FOR I = 0 TO 35 Th = I * 1 0 * G r a d XB = XX % + R % * COS(Th) YB = Y Y % + R % * SIN(Th) * YRatio XE = XX% + (R% - R% / 20) * COS(Th) YE = YY% + (R% - R% / 20) * SIN(Th) * YRatio LINE (XB, YB)-(XE, YE) NEXT I ENDIF NctOnScreenFlg% = 1 ENDIF IF PicFig = 1 AND CircleFIg -- 0 THEN IF MID$(Oper$, 1, 5) < > "EIGHT" THEN CircleFIg = l XXX = XXX%: YYY = YYY% ' - - - p l o t circle to .PIC array PCircle PictureS, XXX, YYY, PicR %, Ticks ENDIF END SUB , ***************************************************************

SUB PlotTitle (N'umb%, Mode%, PicFIg, PIotOnlyFIg, Menus$()) '---Routine to plot a title and other information on the screen ' - - a n d in the PIC file ' - - N o ~ tl~t Points % is the number of data points plotted as a

Processing o r i e n t a t i o n d a t a with Q u i c k P l o t

.subset from the total data sea L O C A T E D . M L - 2, 73: PRINT "N = ": L O C A T E D . M L - 2, 77 IF Points % = 0 T H E N PRINT USING "#~P'; Numb% ELSE PRINT USING " # # r ; Points% ENDIF -Print data mode if N-ModeS is blank L O C A T E D . M L , 65: PRINT SPACES(15); IF MID$(NModes, 6, 1) = " " T H E N IF Mode % = I T H E N TitleMsg$ = "Poles to Planes" L O C A T E D . M L , 65: PRINT TitleMsg$; ELSEIF Mode% = 2 T H E N TitleMsg$ = "Lincations" L O C A T E D.ML, 70: PRINT TitleMsg$; ENDIF IF PicFlg = I T H E N PFSize PictureS, 75, 75 PMove PictureS, 3180, 320 PText PictureS, 0, 3, TitleMsg$ PFSIze PictureS, 100, 100 END IF ENDIF WipeArea 1 L O C A T E 1, 1: PRINT "Title:" Menus$(l) = " N o n e ' : ExplainS(l) = "Do not plot title on screen" Menus$(2) = "File": ExplainS(2) = "Plot file name on screen" IF F$ = "" T H E N Menus$(2) = "": ExplainS(2) = "" Mcnus$(3) = " O w n ' : ExplainS(3) = "Plot your own title on screen" IF Batch% = 0 T H E N Menu M c n u s $ ( ) , ExplainS(), r r l T L E % , 0 ELSEIF Batch% = 1 T H E N ITITLE% = 2 ENDIF IF ITITLE% > 1 T H E N IF I T I T L E % = 2 T H E N Titles = UCASE$(F$) ELSEIF I T r r L E % = 3 T H E N WipeA rear 1 L O C A T E 1, 1: PRINT "Give title (Max. 15 char.): [ ]" L O C A T E 1, 30: INPUT " ' , TitleS IF LEN(TIlles) > 15 T H E N TitleS = MID$G'itles, 1, 15) WipeArea 1 ENDIF L O C A T E 4, 62: PRINT S P A C E $ ( I 8 ) L O C A T E 4, 78 - LEN(Titles): PRINT TitleS IF NoG$ = " " T H E N L I N E (D.MX - 2 * D.CX, 4 * D . C Y + I)-(D.MX - D.CX * (4 + @ @LEN(Title$)), 3 * D . C Y - 2 ) , , B ENDIF IF PicFIg = 1 T H E N --Title on left side IF p l o t O n l y F ~ = 1 T H E N Ptx% = 1: Pry% = 2260 L% = 4.A-A-A-A.A-A-A-A-f* (9 * LEN(Titles)) + 100 PMove PictureS, Put % + 19, Pry % - 60 PTcxt PictureS, O, 1, Titles --Reset flag ploto~plg = 0 --Title on right side E I ~ E I F plotOnlyplg = 0 T H E N --Plot title and number o f points under the plot (used for cutout p l o t s --are pasted un maps). The label is eenlered under the plot ('4' in Irrext) IF Batch% = 1 A N D MID$(Oper$, I, 5) = "EIGHT" T H E N R a d l % = P i c R ~ * 4.~.A.~.A-A.~-A-A.A.~

257

258

D . A . VAN EVERDINGEN, J. A. M. VAN GOOL, and R. M. VISSERS

Ptxi % = XXX% * 4.A.A.A.A.A-~-~-S-A..q Pry1% = (2100 - (YYY% * 4.A.".~.~.~.~::.#)) ' ~ F o r $to • page put the N = p t s off to the side of the net IF Points % = 0 THEN Labels -- " N = " + LTRIM$(STR$(Numb%)) ELSE Labels = "N--" + LTRIM$(STR$(Points%)) F_2qD IF PFSize PictureS, 50, 50 PMove PictureS, Ptxl % - Radl % - 25, Ptyl % - Radl % PText PictureS, O, 1, LabelS '---Include f'dename u label for net & remove fde extension Labels = MID$(Title$, 1, LEN(Title$) - 4 ) ' ~ I f label contains underscore assume it's not wanted & replace with blank FOR 11 = I TO LEN(LabeI$) IF MIDS(Label$, [I, I) = " " T H E N @ @MTDS(Labcl$, H, I) .= "" N E X T II P M o v e PictureS, Ptxl %, Ptyl % - Radl % - 124 PFSize pictureS, I00, I00 PText PictureS, 0, 4, LabelS IF MlD$(Oper$, 1, 6) -- "EIGHTC" THEN '-----ContLevel$ is passed from the contour routine as • global variable PMove pictureS, Ptxl %, Ptyl% - Radl% - 180 PFSize PictureS, 50, 50 PText PictureS, O, 4, ContLevel$ PFSize PictureS, 100, 100 ContLevel$ = "" ENDIF '----Label printed upper right comer ELSE Ptx% = 3180: Pry% = 2260 L % = 4.S.S.S.A.A.A.S.A.#* (694 - 9 * LEN(TiUe$)) PMove PictureS, Ptx% - 20, Pty% - 60 PText PictureS, 0, 3, Titles ENDIF ENDIF ' - - P r i n t box around the title IF NOT (MID$(Oper$, 1, 5) = "EIGHT') THEN PMove PictureS, Ptx%, Pry% PDraw pictureS, Ptx%, Pty% - 120 PDraw PictureS, L%, Pry% - 120: PDraw PictureS, L%, Pry% PDraw PictureS, Ptx%, Pry% ENDIF ENDIF END IF END SUB **************************************************************

SUB CalcSaveAzHel (AzR(), ThetR(), A Z ( ) , HEL()) ' - - S u b r o u t i n e converts daUt from radians to degrees and saves them to a file ' - - - b y calling subroutine SaveFile. ' The routine is called from sub RotateD•t•. '~Pianes IF Mode% = 1 THEN F O R i = 1 TO N u m b % AZ(~ = (((AzR(~ * 180 / I'D + 180) MOD 360) HEL(0 = ThetR(0 * 180 / PI NEXT i '---Lineatiom ELSEIF Mode% -- 2 THEN FOR i -- 1 TO Numb% AZ(~ = AzR(0 * 180 / PI HEL(~ -- 90 - ThetR(0 * 180 1 Pl HEXTi

Processing orientation data with QuickPlot

ENDIF IF MID$(DataFomutt$, 1, 1) = "A" THEN SaveFile F$, A Z ( ) , HEL(), Symb%(), Nmnb% ELSEIF MlD$(DataFormat$, 1, 1) = "D" THEN SaveFile F$, HEL(), A Z ( ) , Symb%(), Ntmab% ELSEIP MID$(DataPormat$, 1, 1) = "S" THF_J~ IF M O d e % = I T H E N FOR i = I TO Numb%

AZ(0 = (AZ(~ + 270) MOD 360 NEXTi ENDIF SaveFile F$, A Z ( ) , HEL(), Symb%(), Numb% ENDIF END SUB

SUB DrawCursor (NewX%, OIdX%, Menus$()) ' ~ M o v e cursor to new position and cheek if it is non-blank IF NoG$ = " " THEN XStart% = D.CX * (9 * (OldX% - 1) + 8) - 2 XEnd% = XStat~% + LENfMenus$(OIdX%)) * D.CX + 5 ' - - - E r a s e old box LINE (XStart%, 0)-(XEnd%, D.CY - 1), 0, B '-----for if tops of characters are ehooped of LOCATE 1, OIdX% * 9: PRINT Menus$(OidX%) XStart% = D.CX * (9 * (NewX% - 1) + 8) - 2 XEnd% = XStart% + LEN(Menus$(NewX%)) * D.CX + 5 '-----Draw new Box LINE (XStart%, 0)-(XEnd%, D.CY - 1),, B ENDIF END SUB * 0****

Jt * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * e * * * * * * * * * * * * * * * * *

SUB ErasePIot (CireleFIg, PieFIg, Numb%, PictureS) '-----Erase Current Plot WipeArea 1 LOCATE 1, 1: PRINT "Erase current plot" IF Batch % = 0 THEN Menus$O) = " Y e s ' : M e n u s $ ( 4 ) = "No" ExplainS(3) = "Clear plotting area for next plot" ExplainS(4) = "Leave current plot on screen and write next set of O @data to it" Menu Menus$(), ExplainS(), ANSI %, O ELSEIF Batch% = 1 THEN ANSI % = 3 ENDIF IF ANSI % = 3 THEN '----for plotting multiple pie plots(batch mode) IF Fig8% = I TFIFaN CircleFIg = 0 PicFlg = 0 '-----Reset Pictures for new graphie output Pictures = "" ENDIF WipeArea 4 NetOnScreenFlg % -- 0 ENDIF END SUB

SUB FileExist (FileS, E%) '----this is • kludgey routine to check for file existence u s i ~ the fde '----ittn~ute check (modifmd from the QuickBASIC HIDE.BAS) ' - - - E % = 1 for exists, 0 for not fotmd DIM InReg AS RegTypc, OutReg AS RegTypc

259

260

D . A . VAN EVERDINGEN,J. A. M. VAN GOOL, and R. M. V[SSERS

' - - - - C ~ the file name and what to do. FileNames = FileS + CHR$(0) '----Get the current f'de attribute. '-----Current attribute comes back in OutRegs.AX and and errors InReg.ax = &H4300 lnReg.dx = SADD(FIleNames) ON ERROR GOTO Generr: caUagain: CALL interrupt(&H21, InReg, OutReg) IF Nerr% = 71 THEN BEEP WipeArea 1 LOCATE 1, 1: PRINT "Insert disk in drive "; LEFTS(FileS, 2); " and close @ ~door" PRINT "Hit any key to proceed" Nerr~ = 0 GOTO callagain: ENDIF '---check if error flag is IF (&HI AND OutReg.flags) < > 0 THEN '-----Get the error number oct of AX. SELECT CASE OutReg.ax AND &I-IF CASE 2 'File not found. E% = 0 CASE 3 'Path not found. E~=3 CASE 5 'Access denied. E'~ = 5 CASE ELSE 'Unrecognized error. E% = 6 END SELECT ELSE E% = 1 'File Exists. END1F END SUB , * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

SUB FileMenu (FileSpec$, FiNm$, ChoiceS) '----Subroutine reads the filemunes from the current directory, prints them '----in a 4 x 10 menu block and enables the user to pick one. By hitting '-----return the user will pick a file name which is returned to the main '---prognnn. ' - - - - E S C - returns to the main module without reading a file name. '----The string variable Cho/ees returns a value of "made" or "not made" to '----indicate whether the user has chosen a file name or not. '$DYNAMIC '- .... set the image size for saving screen dependent on screen mode IF D.SCR = 12 THEN Size% = 16000 ELSEIF D.SCR = 9 THEN Size% = 8000 ELSE Size~$ = 4000 ENDIF DIM FileN-meSO00), Imqe(Size~) DIM d ~ ( 4 3 ) , InRegs AS RegTyp¢, OutRegs AS RegType ChoiceS = ,not made" LOCATE 1, 17: PRINT "Reading file names, please wait" ' - - - G e t fdes in directory put in array FileNameS( ) '----FileSpec$ current path name and file. m$ path and '----f'de type (e.g. BA*.DAT) '----FileNmnes( ) - array to contsin the file names (should be huge) '----a% - # of files, probes - tnle (-1) if error occurs in trying to '----read file names prob~ = 0

Processing orientation data with QuickPlot

A%=0 DEF SEG MS = rileSpec$ + CHR$(0) ' - - - set dta InRegs.ax = &H!A00 InRegs.dx -- VARPTR(dta%(1)) ' - - get f'trst file name C A L L interrupt(&H21, lnRegs, OutRegs) InRegs.ax = &H4E00 lnRegs.CX = 22 InRegs.dx = SADD(M$) CALL interrupt(&H21, InRegs, OutRegs) IF OutRegs.ax < > 0 THEN prob% = - 1 ELSE StoreName dta%(), A%, FileName$( ) ENDIF ' - - - no f'des with this extension in the directory IF prob% THEN EXIT SUB ' - - - now get rma of the file names DO lnRegs.ax = &H4F00 InRegs.CX = 22 lnRegs.dx = SADD(M$) C A L L interrupt(&H21, lnRegs, OutRegs) IF OutRegs.ax = 0 THEN StoreName dta%(), A%, PileName$( ) ENDIF LOOP WHILE OutRegs.ax = 0 prob% = 0 IFA% =0THF~ LOCATE 1, 16: PRINT SPACE,S(63) LOCATE 1, 17: PRINT "Piles not found. Press any key." DO: LOOP UNTIL INKEY$ < > "" GOTO EndFileMenu: ENDIF '-----save part of the sereon and draw box for printing of the f'des ' - - - ( N o t e 'V is an integer division) ' - - - l e f t upper corner of f'de list in Here screen eoords HorHome% = D.CX * 12 + 2 VerHome% = D.CY * 2 GET (l-lorHome% - 4, VerHome% - 5)-(HorHome% + D.CX * 56, VerHome%@ @ + D.CY * 15 + 5), Image VIEW (HorHome% - 4, VerHome% - 5)-(HorHome% + D.CX * 56, @ @VerHome% + D.CY * 15 + 2): CLS : VIEW LINE (HorHome~ - 2, VerHome% - 3)-(HorHome% + D.CX * 55 + 6,@ @VerHome% + D.CY * 10 + 3), , B LINE (HorHome% - 4, VerHome% - 5)-(HorHome96 + D.CX * 55 + 8,@ @VerHomeg~ + D.CY * 15 + 4), , B LINE 0torHome% - 2, VerHome~ + D.CY * 12 + D.CY \ 2)-(HorHome% + @ @D.CX * 55 + 6, VerHome% + D.CY * 15 + 2), , B LINE (HorHome% - 2, VerHome% + D.CY * 10 + 3)-(HorHome~ + D.CX@ @* 3 + 3, VerHome% + D.CY * 12 + D.CY \ 2), , BF LINE (HorHome% + D.CX * 52 + 3, VerHome% + D.CY * 10 + @ @3)-(HorHome% + D.CX * 55 + 6, VerHom¢~ + D.CY * 12 + @ @D.CrY \ 2 ) , , BF PAINT (HorHome% + D.CX * 5 + 5, VerHome% + D.CY * 10 + 5),@ @CHR$(&H88) + crm$(&HO) + CHR$(&H22) + CHR$(&H0) - - - - start reading file names J=0 FOR i = 1 TO 2 IF MID$(Filelqame$(O, 1, 1) = "." THEN

J=J+l ENDIF NEXT i

C AGEO 18 2 / 3 ~ K

261

262

D . A . VAN EVERDINGEN, J. A. M. VAN GOOL, a n d R. M. VISSERS

IFJ <> 0THEN FORi =JTOA% FileNJune$(i - J) = FileNmne$(~ NEXT i ENDIF FOR i = A% TO A % - J + ! STEP - | : Fi|eN~-'ne$(0 = "": N E X T i FileCount% = A % - J Sor~s FilcName$(), FileCount~ FiNm$ = FileName$(l) print message at bottom of box L O C A T E 1, I: PRINT SPACES(79): L O C A T E 1, 1: PRINT "Give file name: " L O C A T E 14, 35: P R I N T FileCoum~; " Files" L O C A T E 16, 18: PRINT "Use Cursor Keys + Home and End to move around" L O C A T E 17, 20: PRINT "Hit < E n t e r > to select, < E s c a p e > to q u i t . " '-preset original position at left upper c o m e r ' - - H o r P o s and V e r P m are cohunn and row in 4 by 10 window ' - - C o l u m n is absolute col. in menu matrix - start = 0 '---max. # of cols = # of cols minus one HorPos% = 0 VerPos% = 0 Column% = 0 MaxColuran% = (FileCount% - 1) \ 10 PrintBlock F i l e N a m e $ ( ) , 0, HorHome%, VerHome%, M a x C o l u m n ~ PRESET CrlorHomeg~, V e r H o m e ~ - 1) ' - - - - d r a w indicator box at fu~t item and print first file name LINE STEP(0, 0)-STEP(D.CX * 13 + 3, D . C ' Y ) , , B L O C A T E 1, 17: PRINT FiNm$ DO DO MV$ = INKEY$ LOOP U N T I L MV$ < > "" PRESET (HorPos% * D . C X * 14 + HorHome%, V e r P o s ~ * D.CY + VerHome% - I) ' - - - - e r a s e present indicator box and prsent file name L I N E STEP(0, 0)-STEP(D.CX * 13 + 3, D.CY), 0, B L O C A T E 1, 17: PRINT SPACES(14) SELECT CASE MV$ C A S E CHR$(0) + CHR$(77) 'right HorPos~ = HorPm% + 1 Colunm% = Colunm% + 1 C A S E CHR$(0) + CHR$(75) 'left H o r P m % = HorPos ~ - 1 Colunm % = Column % - 1 C A S E CHR$(0) + CHR$(80) 'down VerPos% = (VerPos% + 1) MOD 10 C A S E CHR$(0) + CHR$(72) 'up VerPos% = (VerPos% + 9) MOD 10 C A S E CHRS(0) + CHR$(71) 'home IF Colunmg$ - HorPos% > 0 T H E N 'go to first trdename] '-----move to very first block of t'des PrintBiock F i l e N a m e $ ( ) , 0, HorHome%, VerHome%, MaxColunm% ENDIF HorPos% = 0 VerPos% = 0 Column% = 0 C A S E CHR$(0) + CHR$(79) 'End IF Colunm% - HorPos% + 3 < MaxColunm% T H E N PrintBlock F i l e N a m e $ ( ) , MaxColumn% - 3, HorHome%, VerHome%,@ @MaxColumn % ENDIF Column % = MaxColunm % IF M a x C o h m m % > 3 T H E N HorPos% = 3 ELSE HorPos % = MaxColumn % ENDIF VerPos% = FileCount% - ColumnS$ * 10 - 1

Processing o r i e n t a t i o n d a t a with Q u i c k P l o t

C A S E CHR$(13) 'Enter Choices = "made" EXIT DO C A S E CHR$(27) 'ESC Choices = "not made" EXIT DO END S E L E C T IF HorPos% > 3 OR Colunm% > MaxColumn% T H E N 'try to move to right H o f P m % -- HorPos% - 1 ' of block IF Colunm% > M a x C o h m m % T H E N 'no more f'de8 to right SOUND 500, 2 Column% = Column % I ELSE 'move one block to right, print next set of f'des PrintBlock F i l e N a m e $ ( ) , (Coluran% - 3), HorHome%, V e r H o m e % , @ @MaxColumn % PJqD IF ELSEIF H o r P m % < 0 T H E N 'try to move to left of block HorPm% = 0 IF Column% < 0 T H E N 'there are no more files to the left SOUND 500, 2 Column% = 0 ELSE 'move one block to ielL print new block PrintBiock F i l e N a m e $ ( ) , Column%, HorHome%, V e r H o m e % , @ @MaxColumn % ENDIF ENDIF ' - - t r y to move beyond last f'd¢ IF Colunm% * I 0 + V e r P m % + I > FilcConnt% T H E N Colunm% = MaxColunm% 'move to last fde IF MaxCohann % > 3 T H E N HorPos% = 3 ELSE HorPos % = MaxColumn % F2qD IF VerPos% = FileCount% - Column% * 10 - 1 ENDIF PRESET (HorPos% * D.CX * 14 + HorHome%, VerPos% * D . C Y + @ @VerHome% - 1) L I N E STEP(0, 0)-STEP(D.CX * 13 + 3, D.C'Y), , B FiNm$ = FileName$(Column% * 10 + VerPos% + 1) L O C A T E 1, 17: PRINT FiNm$ LOOP ' - - restore original screen VIEW (HorHome% - 4, VerHome% - 5)-(HorHome% + D.CX * 56,@ VerHome% + D . C Y * 15 + 5): CLS : V I E W PUT (HorHome% - 4, VerHome% - 5), Image EndFileMenu: END SUB -

R E M $STATIC SUB GeiFileName (FileName$, PieFile$) '----Routine to get the letters before the period in a filename Flagg% = 0 i=l FileName$ = FileName$ + "." DO Fchar$ = MID$(FileName$, i, 1) IF Fchar$ < > "." A N D Fchar$ < > " " T H E N PicFile$ = PicFile$ + Fchar$ ELSE Flagg% = 1 ENDIF

i=i+l LOOP U N T I L Flagg % = 1 END SUB

263

264

D . A . VAN EVERDINGEN, J. A. M. VAN GOOL, and R. M. V1SSERS

S U B Menu (Menus$(), ExplainS(), Chos©~. LastP'h) '----Lo[us stylemenus - Output from the routineis the Choice of menu item '-----inChose%, Input required is the Menu array and the Last positionof the '----cursorin the lastcall to this routine.The rootmc callsa box drawing ' . . . . rontinc: DrawCursor Cbo~e% = 0 '-----Find First non-blank menu item First% = 0 FOR*-- 1TOll IF Menus$(~ < > "* THEN First% -- i: EXIT FOR ENDIF NEXT* ' - - F i n d last non-blank menu item Lutg~ = 0 FOR i --- 11 TO 1 S T E P - I IF Menus$(~ < > "" THEN L ~ t ~ = i: EXIT FOR ENDIF NEXT* ' ~ P r i n t all non-blank menu items FOR J = First% TO Last% LOCATE 1, J * 9: PRINT Menus$(J) NEXTJ IF L ~tPg ; > 0 T H E N N e w X ~ ffi Lal~P~: OIdX~ ffi LastP~ ELSE NewXg~ = First%: O l d X ~ = First% ENDIF ' - - - - S ~ menu item box indicator coordinates XStart~ ffi D.CX * (9 * (NewX~ - 1) + 8) - 2 X E a d ~ = XStart~ + LEN(Menus$(NewX%)) * D.CX + 5 YSta.q~ = 0: YEad% = D . C Y - 1 ' - - - D r a w box IF NoG$ = " " THEN LINE (XStagg~, YStart~)-(XEnd~, Y E n d ~ ) , , B ' - - P r i n t explanation corressponding to last menu item used previously IF Explain$(NewX%) < > "" THEN LOCATE 2, 7: PRINT SPACES(M): LOCATE 2, 7: PRINT Explain$(NcwX~) ENDIF ' ~ F i n d which key was pressed DO Checks = "" DO CheckS = I N K E Y $

' ~ - M ~ ¢ sure that the functionkeys F3 to FI0 haven'[ been pres,~d FORJ =61TO68 IF Checks = CHR$(0) + C H R $ 0 ) T H E N Chocks = "": EXIT F O R ENDIF NEXTJ LOOP WHILE CheckS = "" ' - - - O n key press decide what is to be done O I d X e ~ = NewX% SELECT CASE Checks CASE CHR$(27) 'ESC EXIT DO CASE CHR$(l 3) 'Enter Chme~ = NewX~ EXIT DO CASE CHR$(0) + CHItS(T]) 'Right IF NewX% ffi Last96 THEN NewX% ffi Fir st~ DntwCurmr NewX%, OldX~, Menus*( ) IF Explain$(NcwX~) < > "" THEN LOCATE 2, 7: PRINT SPACE*(74) LOCATE 2, 7: PRINT Exphin$(NcwX%)

Processing orientation data with QuickPlot

ENDIF El.SEW NcwX95 < Last95 THEN NewX 95 = NewX 95 + 1 WHILE Menus$(N©wX95) ffi "": N e w X 9 5 = N e w X 9 5 + 1: WEND DrawCursor NewX95, OIdX95, Menus$( ) IF Explain$(NewX95) < > "" THEN LOCATE 2, 7: PRINT SPACES(74) LOCATE 2, 7: PRINT Explain$(NewX95) ENDIF ENDIF CASE CHRS(0) + CHR$(75) 'leO. IF NewX95 = First95 THEN NewX95 = Last95 DrawCursor NewX 95, OIdX95, Menus$( ) IF Expttin$(NewX95) < > "" THEN LOCATE 2, 7: PRINT SPACES(74) LOCATE 2, 7: PRINT Explain$(NewX95) ENDIF ELSEIF NewX95 > First95 THEN NewX 95 = NewX 95 - 1 WHILE Menus$(NewX95) = " ' : NewX95 = NewX95 - 1: WEND DrawCursor NewX 95, OIdX95, Menus$( ) IF Explain$(NewX95) < > "" THEN LOCATE 2, 7: PRINT SPACES(74) LOCATE 2, 7: PRINT Explain$(NewX95) ENDIF END IF CASE CHR$(O) + CHR$(79) 'Fad NewX95 = Last95 DrawCursor NewX 95, OIdX 95, Menus$( ) IF Explain$(NewX95) < > "= THEN LOCATE 2, 7: PRINT SPACES('/4): LOCATE 2, 7 PRINT Explain$(N'ewX 95) ENDIF CASE CHR$(O) + CHR$(71) 'Home NewX% = First95 DrawCursor NewX95, OIdX95, Menus$( ) IF Explain$(NewX95) < > "" THEN LOCATE 2, 7: PRINT SPACES('/4): LOCATE 2, 7 PRINT Explain$(NewX %) ENDIF CASE CHR$(0) + CHR$(59) 'Press FI (Help) - for main menu only IF Menus$(1) = "Input" THF2q IF Menus$(NewX95) = "Input" THEN Help 1 ELSEIF Menus$(NewX%) = "Plot" OR Menus$(NewX95) = *Rottte'@ @ THEN Help 2 ELSEIF Menus$(NewX95) = "Contour" THEN Help 3 ELSEIF Menus$(NewX 95) = "Stats" THEN Help 4 ELSEIF Menus$(NewX%) = "Options" THEN Help 5 ELSEIF Menus$(N'ewX95) = "DOS" THEN Help 6 ELSEIF Menus$(NewX95) = "Exit" THEN Help 7 ENDIF ENDIF IF NoG$ = " " THEN LINE (0, 2 * D.CY + 2)-(D.MX, 2 * D.CY + 2) FOR J = Firat95 T O Last95 LOCATE I, J * 9: PRINT Menus$(F) NEXT J DrawCursor N e w X %, OIdX 95, Menus$( )

265

266

D . A . VAN EVERDINGEN, J. A. M. VAN GOOL, and R. M. VISSERS

CASE ELSE 'Character typed PH =0 Chose% = 0 DO PH = PH + I IF UCASE$(Check$) = UCASE$(MID$(Menus$(P%), I, I)) T H E N C h o s e H = PH: N e w X H = P H DrawCursor NewX %, OldX H, M e n u s $ ( ) IF Explain$(NewX%) < > "" THEN L O C A T E 2, 7: PRINT SPACES(74) L O C A T E 2, 7: PRINT Explain$(NewXH) ENDIF EXIT DO ENDIF L O O P U N T I L P% = 11 IF C h o ~ % < > 0 T H E N E x r r DO IF C h o ~ % = 0 T H E N SOUND 500, 1 ENDIF END S E L E C T L O O P U N T I L C h e c k s = CHR$(27) IF Checks = CHR$(27) T H E N C h i n c h = -1 L u t P ~ = Chmegg: IF C'hmeH = -1 T H E N LastP% = 1 ' - - C l e a r menus for next time FOR i = 1 TO 1 1 : M e n u s $ ( 0 = "": ExplainS(0 = "": NF2~T i WipeArea 1 END SUB

SUB PrintBIock (FileName$(), S t a a C o l u n m ~ , H o r r i d , V e r i l Y , MaxColumnH) '~broutine for printing a block of 4 x 10 file names on the screen LeflArrow$ = "COL20U3G5F5U3R20U3" RightArrow$ = "R20U3F5GSU3L20U3" ' - - - fall arrows if they exist PAINT (HorHH + D.CX * 2 + 6, VerH% + D.CY * 11 + 4) PAINT (HorH% + D.CX * 52 + 7, V e r H H + D . C Y * 11 + 4) '- .... print the files V l E W (HorH%, VerH%)-(HOrHH + D.CX * 55 + 5, VerH% + D.CY * 9 + D.CY \ 2 + 3) CLS : V I E W KH = StartColutrm% * 10 FORJH = 0TO3 FORi% --0TO9 KH = KH + 1 L O C A T E i% + 3, J H * 14 + 14: PRINT FileNtme$(K%) N E X T iH N E X T J% ' - - - draw an arrow on the side of the block where more files can be found IF StartColunm % > 0 T H E N PRESET (HorH% + D.CX * 3 + 1, V e r H H + D.CY * I1 + 2) D R A W LeftArrow$ PAINT (l-lorH~ + D.CX * 2 + 6, V e r H H + D.CY * 11 + 4), 0 ENDIF IF StartColunmH + 3 < M a x C o h m m H T H E N PRESET (HorH% + D.CX * 52 + 5, VerH% + D.CY * 11 + 2) D R A W RightArrow$ PAINT (I-lorHH + D . C X * 52 + 7, VerH% + D.CY * 11 + 4), 0 ENDIF END SUB , * * * * * * * e * * * * * * * * * * * * * * * * * * * * * e . e * e * * e * o o * * o o e s * * * * s * * * * * * s o * * * e * * * * * *

'----(~tput results of" statistics to plot and/or PIC file S U B PrintToPle¢ (PA(), P(), T$) DIM lnReg AS RegType, OutReg AS RegType ' - - - - Plot titles into PIC array PlotTitle N u m b % , Mode%, PicFlg, PlotOnlyFIg, Menus$( )

P r o c e s s i n g o r i e n t a t i o n d a t a with Q u i c k P l o t

IF F.igenFig --- I T H E N WipeArea I L O C A T E I, I: P R I N T "Plot Eigen Vec.:" IF Batch% = 0 T H E N Menus$(2) = "None": ExplainS(2) = "Do not plot eigen vectors on net" Menus$O) = " F i r s t ' : ExplainS(3) = "Plot first eigen vector on net" Menus$(4) = " A l l ' : ExplainS(4) = "Plot all three eigen vectors on net" Menu M c n u s $ ( ) , ExplainS(), A N S I %, 0 ELSEW Batch% = I A N D MID$(Oper$, I, I I ) = " P L O T S E I G E N I " THEN ANSI% = 3 ELSEIF Batch% = 1 A N D MID$(Oper$. 1, l l ) = "PLOTSEIGEN3" THEN ANSI% = 4 P_A.,SPAP Batch% = 1 T H E ~ ANSI% = 2 ENDIF IFANSI% > 2 T ~ IF A N S I % = 3 T H E N A N S I % = 1 E L S E A N S I % = 3 FOR i = I T O A N S I % EPA = PA(i) * Grad: EP -- (90 - P(i)) * Grad

RSQ

=

R% *

SQR(2)

DD --- RSQ * SIN(EP / 2): DDN = DD * YRatio XPT% -- CINT(DD * SIN(EPA)): Y P T % = CINT(DDN * COS(EPA)) IF A N S I % = 1 T H E N IF NoG$ = " " T H E N PSET (XX% + X P T % , Y Y % - YPT%): @ @ D R A W PT$(15) IF PieFlg = I T H E N PDD = PicR% * SQR('2) * SIN(EP / 2) X X I % = X X X % + CINT(PDD * SIN(EPA)) Y Y I % = Y Y Y % - CINT(PDD * COS(EPA)) PDrawSym Picture.S, X X I %, Y Y I %, 26, ipen% ENDIF ELSE IF NoG$ = " " T H F ~ PSET (XX% + X P T % , Y Y % - YPT%): @ @DRAW NN$(~ IF PicFlg = I T H E N PDD = PieR% * SQR(2) * SIN(EP / 2) X X I % = X X X % + CINT(PDD * SIN(EPA)) Y Y I % = Y Y Y % - CINT(PDD * COS(EPA)) PDrawSym PictureS, X X l %, Y Y I %, (19 + i), ipen% ENDIF ENDIF NEXT i ENDIF IF PicFIg = 1 T H E N PMove PictureS, 1, 1428 PText PictureS, 0, 1, "Eigen values:" PMove PictureS, 1, 1344 ' ~ I f there is an exponent in the EVai(3) get rid of it B$ = LTRIM$(STR$(EVaI[0))) IF MIDS(B$, LEN(B$) - 3, I) = "E" T H E N ~xpon = VAL(RIGHT$(B$, I)) c$ = "0." FOR i = 1 TO Export - 1: c$ = c$ + "0": N E X T i B$ = c$ + MID$(B$, 1, 1) + MID$(B$, 3, I) + MID$(B$, 4, 1) ENDIF IF LEN(B$) > 5 T H E N B$ = MID$(B$, 1, 5) Msg$ -- MID$(STR$(EVaI!(1)), 1, 5) + " " + MID$(STR$(EVaI!(2)), @ @ 1 , 5 ) + " " + B$ PText PictureS, O, 1, Msg$ PMove PictureS, !, 1260 PTcxt PictureS, O, 1, " E i s e n vectors:" PMovc PictureS, 1, 1176 P'l'cxt PictureS, 0, 1, " D i w D i r Dip" FOR i = 1 T O 3 PMove PictureS, 1, 1176 - (i * 100) Msg$ -- MID$(STR$(PA0)), 1, 6) + " " + MID$(STR$(P(O), 1, 6) PText PictureS, 0, 1, Msg$

267

268

D . A . VAN EVERDINGEN,J. A. M. VAN GOOL, and R. M. VISSERS

NEXT i ENDIF ENDIF ' - - - P l o t 5 % confidence circle around the First Eigen vector IF FisherFIg -- I AND EigenFIg = I THEN WipeArea 1 LOCATE 1, 1: PRINT "Plot 95% circle:" IF Batch% = 0 THEN Menus$(2) = "Yes": M e n u s $ O ) = " N o " ExplainS(2) -- "Plot 95 9~ confidence circle" ExplainS(3) = "Do not plot 95% confidence circle" Menu Menus$(), ExplainS(), ANSI %, 0 ELSEIF Batch% = 1 AND MID$(Oper$, 1, 11) = "PLOTSFISHER" THEN ANSI% = 2 ELSEIF Batch % = 1 THEN ANSI% = 3 ENDIF ' ~ G i v e n the radius compute 36 points at the center of the net and rotate ' ~ t o the eigen vector poeition. T(7) = radius, PA(I) & P(I) are the plunge ' ~ a T i m u t h and plunge of the maximum eigen vector IF ANSI% = 2 T H E N FOR 1 I = 1 TO 36 FishCir(II, 1) = II * 10 * Grad FishCir(II, 2) = T(7) * Grad NEXT II FisCircFIg = 1 ' - - R o t a t i o n axis orientation is F A ( I ) + 9 0 mod 360, 0 inclination. The amount ' - - - - o f rotation is (for lower hemisphere projections) ffi 90-P(l) FisROtAz = (PA(I) + 90) MOD 360 FisRotDip = 0 FisRotAng = 90 - P(1) ' - - N o w go W the rotation part of the program and route the points RotateMath FisRotAz, FisRotDip, FisRotAng, DI, A, H, NA(), NB( ) FOR i = 1 TO 36 L = SIN(FishCir(i, 2)) * COS(FishCir(i, 1)) M = S1N(FishCir(i, 2)) * S1N(FishCir(i, 1)) N --- COS(FishCir(i, 2)) FORJ = 1 TO3 LL(J) = NA(I, J) * L + NA(2, J) * M + NA(3, J) * N NEXT J FishCir(i, 1) = ATN(LL(2) / LL(I)) IF LL(I) < 0 THEN FishCir(i, I) = FishCir(i, 1) + PI FishCir(i, 2) -- ATN(((I / LL(3)) A 2 - 1) ^ .5) IF LL(3) < 0 THEN FishCir(i, 1) = FishCir(i, 1) + PI NEXTi FORi= ITO36 RSQ -- R% * SQR(2) DD = RSQ * SIN(FishCir(i, 2) / 2): DDN = DD * YRatio XPT% = CINT(DD * SIN(FishCir(i, 1))) YPT% = CINT(DDN * COS(FishCir(i, 1))) IF NoG$ = " " THEN PSET (XX~ + X P T ~ , YY% - YPT%): @ @DRAW FT$(1) '---The following few lines put the points into a .PIC style format so that '---the data can be printed using Lotus (R) P O R A P H IF picFlg = l T H E N P D D = PicR% * SQR(2) * SIN(FishCir(i, 2) / 2) XXI % = XXX% + C I N T ( P D D * SIN(FishCir(i, I))) Y Y I % = Y Y Y ~ $ - C I N T ( P D D * COS(FishCir(i, l))) '----draw to .PIC file PDrawSym PictureS, X X I ~ , Y Y I ~ , 1, ipen% ENDIF NEXTi '--Plot Fisher results to PIC array IF picFIg = I THEN PMove PictureS, 1,760 PText PictureS, 0, 1, "Confidence Radius"

Processing orientation data with QuickPlot

PMove PictureS, I, 616 Msg$ = "": Msg$ = " 95~ Signif.: " + MID$(STR$(T(7)), I, 5) + @

@- deg." PText PictureS, 0, I, Msg$ PMove PictureS, 1,592 Msg$ = "": M s g $ = " K --- " + M I D $ ( S T R $ ( T ( 8 ) ) , 1, 5) PText PictureS, 0, 1, Msg$ ENDIF ENDIF ENDIF IF PiFIg = I THEN Wi~Area 1 ' - - - - I f iineations then is just girdlc dist. othet~it~ (Mode% < >2) is PI girdle '-----dist. Also if distm~ution is clustered is axis else is fold axis ' - ~ S O t Disp$ to NONE so that the Uniformity test results are not displayed. ' ~ t h e value of the distribution test is returned in the Disp$ string and '-----~en is converted back to a number Disp$ = "NONE" Uniform T ( ) , Disp$ K = VAL(Disp$) LOCATE 1, 1: PRINT "Girdle:" IF Batch % = 0 THEN Menus$(2) ffi "No': Menus$(3) = "Girdle" Menus$(4) -- "Axis": Menus$(5) = "Both" ExplainS(2) = "Do not plot" ExplainS(3) = "Plot girdle" ExplainS(4) = "Plot axis location" ExplainS(5) -- "Plot girdle and axis location" Menu Menus$(), ExplainS(), ANSI %, 0 ELSEIF Batch% -- 1 AND MID$(Oper$, 1, 7) = "PLOTSPI" THEN ANSI% = 5 ELSEIF Batch% = I THEN ANSI% = 2 ENDIF IF ANSI% = 3 OR ANSI% = 5 THEN IF CPiFIg % = 1 THEN ' - - - F o r cluster distribution of points use 1st eigen vector Azimuth = (PA(I) + 180) MOD 360- DipAngle = 90 - P ( I ) ELSEIF CPiFIg % = 2 THEN ' - - - F o r a great circle distribution of points use 3rd eigen vector Azimuth = (PA(3) + 180) MOD 360: DipAngle -- 90 - P(3) END IF GrcatCircic Azimuth, DipAngle ENDIF IF ANS1% = 4 OR ANSI % --- 5 THF3q IF CPiFIg % = 1 THEN ' - - - F o r cluster distribution of points use I st eigen vector EPA ffi PA(1) * Grad: EP -- (90 - P(l)) * Grad ELSEIF CPiFIg% = 2 THEN ' - - - F o r a girdle distribution of points use 3rd eigen vector EPA = PA(3) * Grad: EP ffi (90 - P(3)) * Grad ENDIF RSQ = R% * SQR(2) DD = RSQ * SIN(EP / 2): DDN = DD * YRatio XPT% = CINT(DD * SIN(EPA)): YPT% = CINT(DDN * COS(EPA)) IF NoG$ = " " THEN PSET (XX% + XFF%, YY% - YPT%): @ @DRAW PT$(15) IF PicFlg = 1 THEN PDD = P i e R % * SQR(2) * SIN(EP / 2) XXI% = XXX% + CINT(PDD * SIN(EPA)) YYI % = YYY% - CINT(PDD * COS(EPA)) PDrawSym PictureS, XX1%, YY1%, 26, ipen% ENDIF ENDIF IF ANSI % > 2 AND PicFIg ffi 1 THEN PMove PictureS, 1,504

269

270

D . A . VAN EVERDINGEN,J. A. M. VAN GOOL, and R. M. VISSERS

' - - - - I f planar data then the axis is the 3rd cigen vector '----else for lineations it is the Ist eigen vector IF ModeSt = 1 A N D CPiFI8% = 1 T H E N AP = ( P A ( I ) + 180) MOD 360: DP = 90 - P(I) M s g $ = "Mean:" Msg2$ = " A z l m = " + M I D $ ( S T R $ ( A P ) , I, 5) M~35 = " Dip = " + MID$(STR$(DP), 1, 5) ELSEIF Mode% = 1 AND CPiFIgS$ = 2 T H E N AP = PAO): DP -- PO) Msg$ = "Fold Axis:" Msg2$ = " Azim = " + MID$(STR$(AP), I, 5) Msg3$ = " Ping = " + MID$(STR$(DP), 1, 5) ELSEIF Mod¢~ = 2 A N D CPiFIg~ = 1 THEN AP = PA(I): DP = P(I) M q $ = "Axis:" Msg2$ = " Azim = " + MID$(STR$(AP), 1, 5) M ~ 3 5 = " Ping = " + MID$(STR$(DP), 1, 5) ELSEIF Modee~ = 2 A N D CPiFIg~$ = 2 THEN AP = (PA(I) + 180) M O D 360: DP ffi 90 - P(I) Msg$ = "Best Fit Girdle:" M~g2$ = " Azim = " + MID$(STR$(AP), 1, 5) Msg3$ = " Dip = " + MID$(STR$(DP), I, 5) ENDIF PText PictureS, O, I, Msg$ PMovc PictureS, 1 , 4 2 0 PT©xt Picture.S, 0, 1, Msg2$ PMov¢ PictureS, 1,336 PT©xt PictureS, 0, 1, Msg3$ ENDIF ENDIF ' - - PIC or Screen output Wipe.Area 1 LOCATE 1, 1: PRINT "Make a printout:" IF Batch% = 0 T H E N Mmus$(2) = "Yes': Menus$O) = "No" IF PicFlg = 1 THEN S$ = "Lotus (R) compatible PlC file." ELSE S$ = "print of screen." ENDIF ExplainS(2) = "Make " + S$ Explain$O) = "Do not make printout" IF PicFIg = 1 T H E N Explain$O) -- Explain$O) + " (yet)" Menu Menus$(), ExplainS(), ANSi %, 0 ELSEIF Batch% = 1 T H E N ANSI% = 2 ENDIF ' - - - T $ = 1 char to put at end of f'de name (P=plot, C=coutour) IF ANSI ~ = 2 A N D PicFig = 1 T H E N IF (MID$(Oper$, 1, 5) = "EIGHT" A N D FI88~ < 8) T H E N PDump PictureS, Numb%, T$, F$, DumpFlg ELSEIF (MIDS(Opcr$, 1, 5) -- "EIGHT" AND FlgS~ = 8) OR MID$(Opcr$@

@, 1, 7) = "CONTOUR" OR MID$(Oper$, 1, 5) = "PLOT" THEN PDump PictureS, Numb~$, T$, F$, 1 ELSE PCIosc Pictures E.ND IF FX.SEIF A N S I % ffi 2 A N D PicFIg = 0 THF.N WipcAre4 3 WipeArea 5 chcckprint~rl: LOCATE I, I: PRINT "Checking printer" ' - - - p r i n t space and backspace to check printer L P R I N T " " + CHR$(8) WipeAren 1 IF Neff% < > 0 T H E N

Processing orientation data with QuickPlot BEEP Nerrg; = 0 LOCATE 1, 1 PRINT "Printer not ready. Check printer and press any kcy to continue'." PRINT "(press escape to return to main menu)" DO AS = INKEY$ LOOP UNTIL AS < > "" WipeArca 1 IF AS = CHR$(27) THEN GOTO endprintl ELSE GOTO checkprinterl ELSE '----Hercules screen put 0 in keyboard buffer for monoprt IF D.SCR = 3 THEN DEF SEG -- &H40 POKE &HIA, &HIE POKE &HIC, &H20 POKE &HIE, 48 ENDIF '--print~reon CALL intermpt(&HS, InReg, OutReg) LPRINT CHR$(12) ENDIF ENDIF ' MoreDataFIg 9; is used in PClme, PDmnp to see if more than one data set ' - - i s loaded (but not with t h e / A setting in ReadData) * this allows one to ' - - - p l o t multiple data sets with different symbols directly IF ANSIg; = 2 THEN MoreDataFI89; = 0: NumbPtsg; = 0 endprintl: END SUB *****************************************************************

'----Subrmnhte to see if numbers have been input at a prompt ' - - N u m l ~ 9; = 1 means values is not a number SUB Query (NumberS, NumFlgg;) N~d~9;

= 0

FOR i ffi I TO LEN(Number$) IF MIDS(NumberS, i, 1) > CHR$(57) OR MIDS(NumberS, i, I)@ @ < CHR$(43)THEN NumFlgg; - ] IF MID$(Number$, i, l) : CHR$(47) THEN NumFigg; = 1 'case / IF MID$(Number$, i, 1) : CHR$(44) THEN NumFlg% -- I 'case, IF NumFIgg; = I THEN EXIT FOR NEXT i END SUB *********************************************************************

SUB SaveFile (F$, A Z ( ) , HEL(), Symbg;(), Kg;) '--wCheck first if there is enough space on the disk IF Batchg; = 0 THEN CheckFree "DATA', TypeS, Numbg; '----Save file on disk Eg;ffil WHILE NOT Eg; = 0 WipeArea I LOCATE 1, i: INPUT "Save file on disk - enter filename: ", F$ LOCATE 2, 1: PRINT "This will save only the most recently entered data." Files = DataDitOut$ + F$ FileExist FileS, Eg; I F E g ; : 1 THEN WipeA rea 1 LOCATE 1, 1: PRINT "Overwrite File" LOCATE 2, 1: PRINT FileS; " exists" Menus$(2) = "No': Menus$(3) : "Yes" Explsin$(2) : "Do not overwrite file and pick a new file name" Explsin$(3) : "Write over file contents with this data" Menu Menus$(), ExplainS(), 0, ANSI 9; IF ANSIg; : 3 THEN Eg; - - 0 ENDIF WEND

271

272

D . A . VAN EVERDINGEN, J. A. M. VAN GOOL, and R. M. VISSERS

OPEN Files FOR OUTPUT AS #1 FOR J = 1 TO Kg; PRINT #1, USING "### "; AZ(J); HEL(J); '-----Case for multiple data IF Symb 9; (J) < > 0 THEN PRINT #1, USING " # r ; Symbg;(J) ELSE PRINT #1, "" END IF NEXT

J

CLOSE #1 WipeArea 1 LOCATE 1, 1: PRINT "Data stored on disk file: "; UCASE$(F$) END SUB , ********************************************************************

SUB SortStrings (FileNames(), FaeCountg;) ' ~ s u b r o u t i n e for sorting file names alphabetically by insertaort FOR K -- FileCountg; - I TO I STEP-1 J=K+I SaveS = FileName$(K) FileNameS(FileCotmtg; + 1) = SaveS DO WHILE Saves > FileNames(J) FileName$(J - 1) = FileNames(J) J=J+l LOOP FileNames(J - 1) = SaveS NEXTK FileNameS(FileCotmtg; + 1) -- "" END SUB DEFINT A-Z • ********************************************************************

SUB StDriveDirec (DataDir$) '----Subroutine to change the drive and or directory for input or output files • When the drive is changed the directory is automatically set to the '-----root directory of that drive. DoorFIg % = 0: EacFlg = 0 Dr$ = UCASE$(MID$(DataDir$, 1, 2)) Q$_-.WHILE INSTR('Y', Q$) = 0 TryAgain3: WipeArea 1 LOCATE 1, 1: PRINT SPACES(60) IF DoorFlg % = 0 THEN LOCATE 1, 1: INPUT "Enter new driveddir (e.g. C:\DATA): ", NewDirec$ NewDire2$ = UCASE$(NewDire¢$) ENDIF LOCATE 2, 10: PRINT SPACES(10) LOCATE 2, 10: PRINT "Okay [Y]?" IF Batch = 0 THEN Q$ = UCASE$(INPUT$(I)) ELSEIF Batch = 1 THEN Q$ = . y . ENDIF DoorFIgg; --- 0 IF Q$ = "N" THEN LOCATE 2, i: PRINT SPACES(60) IF Q$ = CHR$(13) THEN Q$ = "Y" IF Q$ = CHR$(27) THEN F~Flg = 1 GOTO EndDirec: ENDIF IF Q$ = "Y" THEN ' - - - I f neceuary add "\" and/or ":" to the Directory name IF MID$(NewDirec$, 1, 1) -- "\" THEN NewDire¢$ = Dr$ + NewDirec$ IF MID$(NewDirec$, 2, 1) < > ":" THEN NewDiree$ -- MID$(NewDirec$, 1, 1) + ":" + MID$(NewDirec$, 2, @ @LEN(NewDirec$))

Processing orientation data with QuickPlot ENDIF IF MID$(NewDirec$, LEN(NewDirec$), 1) = ":" THEN NewDirec$ = @ @NewDirec$ + "\" IF MID$(NewDirec$, 3, 1) < > "\" THEN NewDirec$ ffi @ @ MID$(NewDirec$, 1, 2) + "\" + MID$(NcwDirec$, 3,@ @ LEN(NewDirec$)) ' - - - F i r s t check if error is generated by opening a nonexistent file on '----that drive IF MID$(NewDircc$, 1, 1) < > MID$(Directory$, 1, 1) THEN IF MID$(NewDirec$, LEN(NewDirec$), 1) < > "\" THEN NewDirec$ = @ @ NewDirec$ + "\" TryAgain4: PhoneyNamc$ = NewDircc$ + "zzzz.zzz" CLOSE #16 ON ERROR (30TO C,enerr: OPEN PhoneyName$ FOR INPUT AS #16 ' - - O k a y if file not found - means that directory chosen exists IF Nerr% = 53 THEN 'File not fmmd CLOSE #16 Nerr~ = 0 ELSEIF Nerr~ = 76 THEN 'Path not found LOCATE 2, 1: PRINT SPACES(60) LOCATE 2, 4: PRINT "Specified Drive or Path Invalid" Nerr% = 0 QS=.OOTO TryAgain3: ELSEIF Nerr~ = 71 THEN 'door is not closed Nerrg~ = 0

DoorFlg~ = 1 LOCATE2, I: PRINT SPACES(60) LOCATE 2, 4: PRINT "Clme Drive Door and [R]etry or [Q]uit" Q15 = " " WHILE INSTR("RQ', QI$) -- 0 QI$ = UCASE$(INPUT$(1)) WEND IF QI$ = "R" THEN GOTO TryAgain4: ENDIF ENDIF ENDIF WEND CLOSE #16 EndDircc: IF EscFlg = 0 AND QI$ < > "Q" THEN DataDir$ = NewDirec$ ENDIF END SUB DEFSNG A-Z , osoe~e*~o~g~ei~.eosoeo~leleosooo~ooei~**~o~eo~ss~o~oo~s.~o~se~,

SUB StorcName (dta%(), A%, FilcNam¢$()) ' - - P u t found names into array

B$_--. NN% = VARPTR(dta%(1)) + 29 ' - - s k i p subdirectories - bit 21 of dla is 16 for subdir IF PEEK(VARPTR(dta%(I)) + 21) < > 16 THEN DO IF PEEK(NN~) < > 0 OR PEEK(NN~) < > 46 THEN B$ = B$ + CHR$(PEEK(NN~)) ENDIP NN~ = NN~ + 1 LOOP UNTIL PEEK(NN%) -- 0 B$ = RIGHT$(B$, LEN(B$) - 1) dummy$ -- UCASE$(RIOHT$(B$, 4)) IF dummy$ < > ".EXE" AND dummy$ < > ".COM" AND dummy$~ 0<> ".BAT" THEN A ~ = A ~ + 1 FileName$(A%) = B$

273

274

D . A . VAN EVERDINGEN, J. A. M. VAN GOOL, a n d R. M. VISSERS

END 1F ENDIF END SUB

S U B WhatGraphics

'----Routine to determine what graphics card is present (possible choices ' - - - a r e : Hercules, C G A , E G A , VGA ON ERROR GOTO Generr: S C R E E N 12 ' V G A IF Neff% = 5 T H E N Neff% = 0: S C R E E N 0 ELSEIF Neff% = 0 T H E N D.MX = 639: D . M Y = 479: D.CX = 8: D.CY = 16: D . M L = 30 SCR = 12: NoG$ = " ": D . M D = 12: D.ASP = 1!: D.SCR = 12 GOTO EndDiaplay: ENDIF SCRI~.I~N 9 ' E G A IF Nerr% = 5 T H E N N e r r ~ = 0: S C R E E N 0 ELSEIF Nerr~ = 0 THEN D . M X = 639: D . M Y = 349: D . C X = 8: D . C Y -- 14: D . M L = 25 S C R -- 9: N o G $ = " ": D . M D = 12: D . A S P = .729: D . S C R -- 9 O O T O EndDisplay: ENDIF

SCREEN 2

'CGA

IF N e n g ~ = 5 T H E N

Nerrgg = 0: S C R E E N 0 ELSEIF Nerr% = 0 THEN D . M X = 639: D . M Y = 199: D . C X = 8: D . C Y -- 8: D . M L = 25 SCR = 2: N e G $ = " ": D . M D = 10: D.ASP = .42: D.SCR = 2 GOTO EndDiaplay: ENDIF S C R E E N 3 'Hercules graphics card IF N e r r % = 5 T H E N S C R E E N 0: CLS L O C A T E 10, 5 PRINT "To run this program (QP) you must first load M S H E R C . C O M " L O C A T E 11, 5 PRINT "This program supports Hercules graphics only if M S H E R C . C O M " L O C A T E 12, 5: PRINT "has been run." L O C A T E 14, 5 PRINT "If you choose to a m this program without the presence of a" L O C A T E 15, 5 PRINT "Hercules graphics card, it can only be run in B A T C H mode;" L O C A T E 16, 5 PRINT "the screen display will be incomplete, however, the PIC" L O C A T E 17, 5 PRINT "graphics files o f the stereo plots will be produced normally." ELSEIF Neff% = 0 T H E N D . M X = 719: D . M Y = 347: D.CX = 9: D . C Y = 14: D . M L = 25 SCR = 3: NoG$ = " ": D . M D = 13: D.ASP = .7291667: D.SCR = 3 GOTO EndDisplay: ENDIF S C R E E N 0: D.SCR = 99 CLS : Nerr% -- 5 L O C A T E 10, 5 PRINT "This program supports Hercules, CGA, EGA, VGA graphics modes." L O C A T E 11, 7: PRINT "Your computer does not have a compatible graphics" L O C A T E 12, 7: PRINT "card. This program can be run without a graphics" L O C A T E 13, 7: PRINT "card - but only in batch mode. To do this type:" L O C A T E 14, 7 PRINT "QP B A T C H < E N T E R > or answer yes to the following" EndDisplay: NoG$ = " "

Processing orientation data with QuickPlot

IF Ncrr% = 5 THEN Neff% = 0 LOCATE 19, 5: PRINT "Do you wish to nan this program in batch mode? IN]" NoG$ = UCASE$(INPUT$(1)) IF NoG$ = CHR$(13) THEN NoG$ = "N" IF NoG$ < > "Y" THEN PRINT : PRINT " Press any key to r c t u m to DOS" DO: LOOP UNTIL INKEY$ < > " ' : CLS ENDIF END IF END SUB

SUB WipeArea (Location%) '----Subroutine for screen clearing and messages '~L~ation~: 1 =top two lines of screen; 2 = s i d e bar; 3=fdename & num.pts. ,~ area 4 =plotting area, 5 --top two lines of menu + ho6z. line IF NoG$ = " " THEN IF Location% = 1 THEN VIEW (0, 0)-(D.MX, 2 * D.CW): CLS : VIEW E L S E I F Location % = 2 THEN VIEW (0, 2 * D.CY + 4)-(20 * D.CX, D.MY): CLS : VIEW ELSEIF Locs6on% = 3 THEN VIEW (0, (D.ML - 1) * D.CY)-(14 * D.CX, (D.ML - 3) * D.CY - 3) C I ~ : VIEW ELSEIF Location% = 4 THEN VIEW (20 * D.CX, 2 * D.CY + 4 ) - ( D . M X , D.MY): ~ : VIEW Pictures = "" ELSEIF Location 9g = 5 THEN VIEW (0, 0)-(D.MX, 2 * D.CY + 3): CLS : VIEW ENDIF ENDIF END SUB

SUB SW (Msg$, PosX, PraY, Opt) ' - - - p r i n t s text sideways on screen as title of y-axis in Flinn-Diagram FOR Length = 1 TO LEN(Msg$) LOCATE 1, 1 PRINT M [ D S ~ s g $ , L e n g t h , 1) FOR X = 0 T O 8 FORY =0TO13 IF POINT(X, Y) THEN IF Opt = 1 T H E N PSET (Y + PosX, 9 - X + Po6Y - (9 * Length))', Colour ELSE PSET (9 - Y + PosX, Posy + (9 * Length) + X)', Colonr ENDIF ENDIF NEXTY NEXTX NEXT Length LOCATE !, 1: PRINT " " END SUB '--PIC

FILE }q~OTI~G R O ~

SUB PCirclc (PictureS, X, Y, PieR%, TickS) ' - - - D r a w • circle of radius Rad%, and center X 2 ~ , Y 2 % , '~a

cross at thccentse

'--X,Y = Hercules circic centre coords '-----X29;,Y29; = PIC circle centre coords ' ~ X 3 9 g , Y 3 ~ = PIC circle and symbol coords

with •

275

276

D . A . VAN EVERDINGEN, J. A. M. VAN GOOL, and R. M. V~SSERS

X2% = CINT(X * 4.A.A,A.a.A.A.A.a-A..f) Y2% = CINT(2100 - (Y * 4.A-A-A-A-A-A-A-A.A.#)) Rad% = PicR% * 4.A.X.A.A-A-A-A-A-A-// '----move to circle centre PMove PictureS, X2 %, Y2 % '----draw cross at circle centre PDrawSym PictureS, CINT(X'), CINT(Y), 19, 1 ' - - - - I f Circle has been drawn once this session do not do it '-----again copy it from CircleS IF CircleOnceFIg = 1 THEN Pictures = Pictures + Circles ELSEIF CircleOnceFIg = 0 THEN WipeArea 1 LOCATE I, I: PRINT "Creating circle for Lotus (R) Picfile* PRINT "Please wait..." X3% = X2% + Rad% Y3% = Y2% '----move to circle edge (90 deg.) PMove CircleS, X3 %, Y3 % PMove PictureS, X3%, Y3% ' draw circle over 2 degree increments FORI = ITO180 THETA = 2 * I * Grad X3% -- X2% + Rad% * COS(THETA) Y3% = Y2% + Rad% * SIN(THETA) ' - - save circle once to string ff not plotting eight to a page in batch IF MID$(Oper$, 1, 5) < > "EIGHT" THEN PDraw CircleS, X3%, Y3% PDraw PictureS, X3 %, Y3 % NEXTI CircleOnceFIg = 1 ENDIF IF MID$(Oper$, I, 5) -- "EIGHT" THEN CircleOnceFIg ffi 0 ' - - - T i c k mark (90 deg.) X3% = X2% + Rad%: Y3% = Y2% PDraw PictureS, X3 % + 25, Y3 % ' - - - T i c k mark (270 deg.) X3% = X2% - Rad% PMove PictureS, X3%, Y2% PDraw PictureS, X3% - 25, Y3% '----Tick mark (0 deg.) Y3% = Y2% + Rad% PMove PictureS, X2 %, Y3 % PDraw PictureS, X2%, Y3% + 25 '-----Draw N symbol - suppress 'N' if need be with NModes IF North% = 0 T H E N PMove PictureS, X 2 % - 20, Y 3 % + 45 PDraw PictureS, X 2 % - 20, Y 3 % + 95 PDraw PictureS, X2 % + 20, Y3 % + 45 PDraw PictureS, X 2 % + 20, Y3 % + 95 ENDIF '----Draw 10 degree interval tick marks around circumference IF Tick% = I T H E N FORI = 0TO35 Th = I * 1 0 * G r a d X B % = X 2 % + R a d % * COS(Th) Y B % = Y 2 % + R a d % * SIN(Th) XE% = X2% + (Rad% - Rad% / 20) * COS(Th) YE% = Y2% + (Rid% - Rad% / 20) * SIN(Th) PMove PictureS, XB%, YB% PDraw PictureS, XE%, YE% NEXT I ENDIF '----Tick mark (180 deg.) Y3% = Y2% - Rsd% PMove PictureS, X2 %, Y3 % PDraw PictureS, X2 %, Y3 % - 25

Processing orientation data with QuickPlot

WipeArea 1 END SUB REM $STATIC S U B PClosc (PictureS) '-----Putnumbcr of points on PIC-plot IF MoreDataFIg % = 1 THEN NumbPts % = NumbPts % + Numb % ELSE NumbPts % = N u m b % END IF IF Points% < > 0 THEN NumbPts% -- Points% Msg$ = "N = " + STR$(NumbPts%) PFSize PictureS, 75, 75 PMove PictureS, 3180, 400 IF MID$(Oper$, 1, 5) = "EIGHT" OR MID$(Oper$, 1, 5) = "FLINN" @ @ OR MID$(Oper$, 1, 5) -- "TRIAN" THEN Mql$ = "" PText PictureS, O, 3, Msg$ ' ~ P u t fdc end marker in Pictures and dump to file, then close it traps = CHR$(&H60) Pictures = Pictures + tmp$ PUT #2, , Pictures CLOSE//2 Pictures = "" END SUB REM $DYNAMIC , * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

SUB PColor (PictureS, pc%) ' - ~ s u b to ~ a d color change to PIC fde maps = -&H" + HRX$(RHB) + HEXS(pc~) tmp$ = CHR$(VAL(tmp$)) Pictures = Pictures + maps EXIT SUB END SUB , * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

SUB PDraw (PictureS, X%, Y%) '----sub that outpuB draw command to P I e file maps = CHR$(162) Pictures = Pictures + t m p $ GetHcx X%, hiS, 1o$ maps = CHR$(VAL0ai$)) + CHR$(VAL0o$)) Pictures = Pictures + t m p $ GctHex Y%, hiS, 1o$ maps = CHR$(VAL0ti$)) + CHR$(VAL(lo$)) Pictures = Pictures + maps EXIT SUB END SUB REM $STATIC , * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

SUB PDrawSym (PictureS, X%, Y%, isym%, ipen%) DIM xvert%(10), yvert%(10) '----sub to draw symbol in PIC f'fie '----X % , Y % = Hercules coords '----X3%, Y3% = PIC coords White% = 7 X3% = CINT(X% * 4.:A.A.A.A.A.A.A.A.~ Y3% = CINT(2100 - (Y% • 4.A.A.A.A.A.A.A.~dA.#)) IF isym % = 0 THEN EXIT SUB IF ipen% < > White% THEN PCoior PictureS, iima% SELECT CASE isym % CASE 1 '. PMove PictureS, X3%, Y3% PDraw PictureS, X3 %, Y3 % C AGE O 18.2/3--L

277

278

D . A . VAN EVERDINGEN, J. A. M . VAN GOOL, a n d R. M . VISSERS

C A S E 2 'Small square P M o v c PictureS, X 3 9 ; , Y 3 9 ; P D r a w PictureS, X 3 9 ; , Y 3 9 ; + 2 P D r a w PictureS, X 3 9 ; - 2, Y 3 9 ; + 2 P D r a w PictureS, X 3 9 ; - 2, Y 3 9 ; P D r a w PictureS, X 3 9 ; , Y 3 9 ; C A S E 3 " triangle P M o v c PictureS, X 3 9 ; - 10, Y 3 9 ; - 10 P D r a w PictureS, X 3 9 ; , Y 3 9 ; + 10 P D r a w PictureS, X 3 9 ; + 10, Y 3 9 ; - 10 P D r a w PictureS, X 3 % - 10, Y 3 9 ; - 10 C A S E 4 'large cross P M o v e PictureS, X 3 9 ; - 10, Y 3 9 ; P D r a w PictureS, X 3 9 ; + 10, Y 3 9 ; P M o v e PictureS, X 3 9 ; , Y 3 9 ; + 10 P D r a w PictureS, X 3 9 ; , Y 3 9 ; - 10 C A S E 5 'circle open P M o v e PictureS, X 3 9 ; - 7, Y 3 9 ; + 2 P D r a w PictureS, X 3 9 ; - 3, Y 3 9 ; + 7 P D r a w PictureS, X 3 9 ; + 3, Y 3 9 ; + 7 P D r a w PictureS, X 3 9 ; + 7, Y 3 9 ; + 2 P D r a w PictureS, X 3 9 ; + 7, Y 3 9 ; - 2 P D r a w PictureS, X 3 9 ; + 3, Y 3 9 ; - 7 P D r a w PictureS, X 3 9 ; - 3, Y 3 9 ; - 7 P D r a w PictureS, X 3 9 ; - 7, Y 3 9 ; - 2 P D r a w PictureS, X 3 9 ; - 7, Y 3 9 ; + 2 C A S E 6 'circle f'dled x v e r t g ; ( l ) = X 3 9 ; - 7: y v c r t g ; ( l ) = Y 3 9 ; + 2 xvertg;(2) = X 3 % - 3: y v e r t g ; ( 2 ) = Y 3 9 ; + 7 xvertg;(3) = X 3 9 ; + 3: yvertg;(3) = Y 3 9 ; + 7 xvertg;(4) = X 3 9 ; + 7: y v e t t g ; ( 4 ) -- Y 3 9 ; + 2 xvertg;(5) = X 3 9 ; + 7: yvertg;(5) = Y 3 9 ; - 2 x-vertg;(6) = X 3 9 ; + 3: yvertg;(6) = Y 3 9 ; - 7 xvertg;(7) = X 3 9 ; - 3 : y v e r t g ; ( 7 ) = Y 3 9 ; - 7 xvertg;(8) = X 3 9 ; - 7: y v e a g ; ( 8 ) = Y 3 9 ; - 2 IVdlo PictureS, 8, x v e r t g ; ( ) , y v e s 9 ; ( ) C A S E 7 ' triangle open dn P M o v ¢ PictureS, X 3 9 ; - 10, Y 3 9 ; + 10 P D r a w PictureS, X 3 9 ; , Y 3 9 ; - 10 P D r a w PictureS, X 3 9 ; + 10, Y 3 9 ; + 10 P D r a w PictureS, X 3 9 ; - 10, Y 3 9 ; + 10 C A S E 8 'triangle filled d o w n x v e r t g ; ( l ) = X 3 9 ; : y v e r t g ; ( l ) = Y 3 9 ; - 10 xvertg;(2) = X 3 9 ; - 10: yvertg;(2) = Y 3 9 ; + 10 xvertg;(3) = X 3 9 ; + 10: y v e a g ; ( 3 ) = Y 3 9 ; + 10 Pfdlo PictureS, 3, x v e r t g ; ( ) , y v e r t g ; ( ) C A S E 9 'box open P M o v e PictureS, X 3 9 ; - 10, Y 3 9 ; - 10 P D r a w PictureS, X 3 9 ; + 10, Y 3 9 ; - 10 P D r a w PictureS, X 3 % + 10, Y 3 9 ; + 10 P D r a w PictureS, X 3 9 ; - 10, Y 3 9 ; + 10 P D r a w PictureS, X 3 9 ; * 10, Y 3 9 ; - 10 C A S E 10 ' b o x filled x v e r t g ; ( l ) = X 3 9 ; - 10: y v e r t g ; ( l ) = Y 3 % - 10 xvertg;(2) = X 3 9 ; + 10: yvertg;(2) : Y 3 % - 10 xvertg;(3) = X 3 9 ; + 10: y v c r t g ; ( 3 ) : Y 3 % + 10 xvertg;(4) = X 3 % - 10: yvertg;(4) = Y 3 9 ; + 10 Pfillo PictureS, 4, x v e r t g ; ( ) , y v e r t g ; ( ) C A S E 11 ' d i a m o n d open P M o v e PictureS, X 3 % - 10, Y 3 9 ; P D r a w PictureS, X 3 9 ; , Y 3 9 ; + 10 P D r a w PictureS, X 3 9 ; + 10, Y 3 9 ; P D r a w PictureS, X 3 9 ; , Y 3 9 ; - 10 P D r a w PictureS, X 3 9 ; - 10, Y 3 9 ; C A S E 12 ' d i a m o n d filled x v e t t g ; ( l ) = X 3 9 ; - 10: y v e r t % ( I ) = Y 3 9 ;

Processing orientation data with QuickPlot xvert%(2) = X 3 % : yvert%(2) = Y3% + 10 x v e r t % 0 ) : X3% + 10: yvert%(3) = Y3% xvert%(4) : X 3 % : yvert%(4) : Y3% - l 0 Pf'dlo PictureS, 4, x v e r t % ( ) , yvert%( ) C A S E 13 'Filled triangle up xvert%(I) = X3%- y v e r t % ( I ) = Y3% + 7 xvert%(2) = X3% + 7: yvert%(2) = Y3% - 7 xvert%(3) = X3% - 7: yvert%(3) = Y3% - 7 Pfdlo PictureS, 3, x v e ~ % ( ) , y v e n % ( ) C A S E 14 'triangle open down (slightly larger: was 7 now 10&13 PMove PictureS, X 3 % , Y3% - 10 PDraw PictureS, X3% - 13, Y3% + 13 PDraw PictureS, X3% + 13, Y3% + 13 PDraw PictureS, X3 %, V3 % - 10 C A S E 15 'triangle filled down x v e r t % ( l ) = X3%: y v e a % ( l ) = Y3% - 7 xve~%(2) = X3% - 7: yvert%(2) = Y3% + 7 xvert%(3) = X3% + 7: yvert%(3) = Y3% + 7 Pf'dlo PictureS, 3, x v e r t % ( ) , yvert%( ) C A S E 16 'vertical bar PMove PictureS, X 3 % , Y3% + 10 PDraw PictureS, X3 %, Y3 % - 20 C A S E 17 'Horizontal bar PMove PictureS, X3% - 10, Y3% PDraw PictureS, X3 % + 20, Y3 % C A S E 18 'Cross with circle PMove PictureS, X3 % - 45, Y3 % PDraw PictureS, X3 % + 45, Y3 % PMove PictureS, X3 %, Y3 % + 45 PDraw PictureS, X3 %, Y3 % - 45 PMove PictureS, X3 % - 36, Y3 % PDraw PictureS, X3% - 30, Y3% + 15 PDraw PictureS, X3% - 15, Y3% + 30 PDraw PictureS, X3 %, Y3 % + 36 PDraw PictureS, X3% + 15, Y3% + 30 PDraw PictureS, X3% + 30, Y3% + 15 PDraw PictureS, X3% + 36, Y3% PDraw PictureS, X3% + 30, Y3% - 15 PDraw PictureS, X3% + 15, Y3% - 30 PDraw PictureS, X 3 % , Y3% - 36 PDraw PictureS, X3% - 15, Y3% 30 PDraw PictureS, X3% - 30, Y3% - 15 PDraw PictureS, X3 % - 36, Y3 % C A S E 19 'Cross for stereonet centre PMove PictureS, X3 % - 20, Y3 % PDraw PictureS, X3 % + 20, Y3 % PMove PictureS, X3 %, Y3 % + 20 PDraw PictureS, X 3 % , Y3% - 20 C A S E 20 '1' PMove Plcmre$, X 3 % - 6 , Y3% + 6 PDraw PictureS, X3%, Y3% + 15 PDraw PictureS, X3%, Y3% - 15 PMove PictureS, X3% - 6, Y 3 % - 15 PDraw PictureS, X3% + 6, Y3% - 15 -

C A S E 21 '2' PMove PictureS, PDraw pictureS, PDraw PictureS, PDraw pictureS. PDraw pictureS, PDraw PictureS, C A S E 22 '3' PMove pictureS. PDraw PictureS, PDraw PictureS, PDraw PictureS, PDraw PictureS,

X3% X3% X3% X3% X3% X3%

- 15, Y3% + 6 - 6, Y3% + 15 + 4, Y3% + 15 + 15, Y3% + 6 - 15, Y3% - 15 + 15, Y3% - 15

X3% - 15, Y3% + 15 X3% + 15, Y3% + 15 X 3 % , Y3% X3 % + 6, Y3 % X3% + 12, Y3% - 3

279

280

D . A . VAN EVERDINGEN, J. A. M. vA~ GOOL, a n d R. M. VISSERS PDraw PictureS, X 3 ~ + 15, Y3% - 4 PDraw PictureS, X3% + 15, Y3% - 7 PDraw PictureS, X3% + 10, Y3% - 10 PDraw PictureS, X3% + 6, Y3% - 15 PDraw PictureS, X3% - 6, Y3% - 15 PDraw PictureS, X3% - 15, Y3% - 10 C A S E 23 '4' PMove PictureS, X3% - 9, Y3% + 15 PDraw PictureS, X3% - 9, Y3% PDraw PictureS, X3 % + 9, Y3 % PMove PictureS, X3% + 9, Y3% - 15 PDraw PictureS, X3 % + 9, Y3 % + 15 C A S E 24 '5' PMove PictureS, X3% + 15, Y3% + 15 PDraw PictureS, X3% - 15, Y3% + 15 PDraw PictureS, X3% - 15, Y3% PDraw PictureS, X3 % + 6, Y3 PDraw PictureS, X3% + 12, Y39~ - 3 PDraw PictureS, X3% + 15, Y3% - 4 PDraw PictureS, X 3 ~ + 15, Y 3 ~ - 7 PDraw PictureS, X39; + 10, Y 3 ~ - 10 PDraw PictureS, X3% + 6, Y39g - 15 PDraw PictureS, X 3 ~ - 6, Y 3 ~ - 15 PDraw PictureS, X396 - 15, Y3% - 10 C A S E 25 '6' PMove PictureS, X3% - 15, Y396 PDraw PictureS, X39~ + 6, Y3 PDraw PictureS, X 3 ~ + 12, Y39; - 3 PDraw PictureS, X3~g + 15, Y39; - 4 P D m w PictureS, X 3 ~ + 15, Y3% - 7 PDraw PictureS, X 3 ~ + 10, Y 3 ~ - 10 PDraw PictureS, X 3 ~ + 6, Y39; - 15 PDraw PictureS, X396 - 6, Y39g - 15 PDraw PictureS, X39~ - 15, Y3% - 10 PDraw PictureS, X3% - 15, Y3% + 6 PDraw PictureS, X396 - 10, Y 3 ~ + 10 PDraw PictureS, X 3 ~ - 3, Y3% + 15 PDraw PictureS, X39g + 4, Y3% + 15 PDraw PictureS, X3% + 10, Y3% + 10 C A S E 26 'six sided star PMove PictureS, X3 %, Y3 % + 40 PDraw PictureS, X3% - 12, Y 3 ~ + 20 PDraw PictureS, X3 % - 34, Y3 % + 20 PDraw PictureS, X3 ~ - 22, Y3 PDraw PictureS, X 3 ~ - 34, Y3% - 20 PDraw PictureS, X3% - 12, Y 3 ~ 20 PDraw PictureS, X3 %, Y3 ~ * 4 0 PDraw PictureS, X3% + 12, Y3% - 20 PDraw PictureS, X39~ + 34, Y3% - 20 PDraw PictureS, X3 % + 22, Y3 PDraw PictureS, X3 ~ + 34, Y3 ~ + 20 PDraw PictureS, X 3 ~ + 12, Y3% + 20 PDraw PictureS, X3 ~ , Y3 ~ + 40 C A S E 27 'lambda PMovc PictureS, X3 ~ + 30, Y3 % - 30 PDraw PictureS, X3 % - 30, Y3 ~ + 30 PMove PictureS, X3 %, Y3 % PDraw PictureS, X3 ~ - 30, Y3 ~ - 30 C A S E 28 'lambda rotated 60 deg clkwse PMove PictureS, X 3 ~ - 10, Y 3 ~ - 40 PDraw PictureS, X 3 ~ + 10, Y3% + 40 PMove PictureS, X 3 % , Y3% PDraw PictureS, X39; - 40, Y 3 ~ + 10 C A S E 29 'iambda rotated 300 deg clkwse PMove PictureS, X 3 ~ + 40, Y39; + 10 PDraw PictureS, X 3 ~ - 40, Y 3 ~ * 10 -

Processing orientation data with QuickPlot

PMove PictureS, X 3 9 ; , Y39; PDraw PictureS, X3% + 10, Y39; - 4 0 C A S E 30 '1 rotated 300 deg clkwse PMove PictureS, X39; - 12, Y39; + 8 PDraw PictureS, X39; - 10, Y39; PMove PictureS, X39; - 12, Y39; + g PDraw PictureS, X39; + 12, Y39; - 8 PMove Pictures X39; + 15, Y 3 % - 2 PDraw Pictures X39; + 10, Y39; - 12 C A S E 31 '2 rotated 60 deg clkwse PMove Pictures X39; + 15, Y39; PDraw Pictures X39; - 15, Y39; PDraw Pictures X39; - 5, Y39; - 15 PMove Pictures X39; + 15, Y39; P D r l w Pictures X3% + 18, Y39; + 5 PDraw Pictures X39; + 13, Y39; + 12 PDraw Pictures X39; + 5, Y39; + 12 C A S E 32 '2 rotated 300 deg clkwse PMove PictureS, X39; + 15, Y39; + 5 PDraw PictureS, X39; + 5, Y39; - 15 PDraw PictureS, X39; - 5, Y39; + 15 P D r t w PictureS, X39; - 10, Y39; + 12 PDraw PictureS, X39; - 18, Y39; + 5 PDraw PictureS, X39; - 15, Y39; - 5 C A S E 33 '3 rotated 60 deg elkwse PMove PictureS, X39; + 8, Y39; + 20 P D r t w pictureS, X39; + 20, Y39; - 5 PDraw PictureS, X 3 9 ; , Y39; PDraw PictureS, X39; + 3, Y39; - 8 PDraw PictureS, X 3 9 ; , Y39; - 15 PDraw PictureS, X39; - 10, Y39; - 12 PDraw PictureS, X39; - 18, Y39; PDraw PictureS, X39; - 15, Y39; + 5 C A S E 34 ' = rotated 60 deg clkwae PMove PictureS, X39; - 20, Y39; + 10 PDraw PictureS, X39;, Y39; - 20 PMove pictureS, X 3 9 ; , Y39; + 20 PDraw pictureS, X39; + 20, Y39; - 10 C A S E 35 ' -- rotated 300 deg clkwse PMove PictureS, X39; - 2 0 , Y39; - 10 PDraw PictureS, X 3 9 ; , Y39; + 20 PMove pictureS, X39;, Y39; - 20 PDraw PictureS, X39; + 20, Y39; + 10 C A S E 36 'equal PMove pictureS, X39; - 20, Y39; + 10 PDraw PictureS, X39; + 20, Y39; + 10 PMove PictureS, X39; - 20, Y39; - 10 PDraw PictureS, X39; + 20, Y39; - 10 C A S E 37 '0 PMove PictureS, X39; - 16, Y39; PDraw PictureS, X39; - 16, Y39; + 24 PDraw PictureS, X39; - I0, Y39; + 30 PDraw PictureS, X39; + 10, Y39; + 30 P D r l w PictureS, X39; + 16, Y39; + 24 PDraw PictureS, X39; + 16, Y39; - 24 PDraw PictureS, X39; + 10, Y39; - 30 PDraw PictureS, X39; - 10, Y39; - 30 PDraw PictureS, X39; - 16, Y39; - 24 PDraw PictureS, X39; - 16, Y39; CASE ELSE END SELEL-'F IF ipeeg; < ) Whiteg; THEN PColor PictureS, Whiteg; EXIT SUB END SUB D E F I N T I-K

281

282

D . A . VAN EVERDINGEN, J. A. M. VAN GOOL, and R. M. VISSERS

*******************************************************************

SUB PDump (pictureS, Numb%, T$, F$, DumpFlg) ' - - - T h i s routine is set up to periodically dmnp the contents of Pictures to '----the output file if the program is run in batch mode to avoid running out ' - - - o f string space '-----Dump Pictures and Clear string space IF DumpFIg = 0 THEN PUT #2, , PictureS PictureS = "" '-----Dump Pictures and close f'de ELSEIF DumpFIg = 1 THEN DumpFIg = 0 '-----Addlower title IF MID$(Oper$, !, 5) -- "EIGHT" THF2q IF MID$(Oper$, 1, 6) = "EIGHTC" OR MlD$(Oper$, 1, 6) = @ @ "EIGHTB" THEN Msg$ = "(C: =contour levels in multiples of a uniform distribution)" PFSize PictureS, 50, 50 PMove PictureS, 1590, 360 Irl'ext PictureS, 0, 4, Msg$ PFSize PictureS, 100, 100 F2qDIF ' - - P l o t title bottom of page IF MID$(Oper$, 9, LEN(Oper$)) < > "" THEN Msg$ = MID$(Oper$, 9, LEN(Oper$)) PMove PictureS, 1590, 200 PFSize PictureS, 100, 100 FText PictureS, 0, 4 , Msg$ ENDIF EI~E IF MoreDataFIg % = 1 THEN Numbpls% -- Numbpls% + Numb% EI~E NumbPts% = Numb% ENDIF Msg$ = "N = " + STR$(Numbpla%) PFSize PictureS, 75, 75 PMove PictureS, 3180, 400 IF MID$(Oper$, 1, 5) = "EIGHT" THEN Msg$ = "" PText PictureS, 0, 3, Msg$ ENDIF '----Put f'de end marker in Pictures and dump to file

maps = CHR$(&H60) Pictures = Pictures + maps P U T #2,, PictureS CLOSE #2 PicFig = O: PictureS = "" F2qD IF END SUB DEFSNO I-K ,

**********************************************************

SUB Pl'dl (PictureS, nvert%, rvert%(), yvert%()) '-----sub to send f'flled poly to PIC file

Imps = CHR$(48)

+ CHR$(nvert%

- I)

Pictures = Pictures + Imps FOR I% = 1 TO nvert% GetHex xvert%(l%), hiS, los

t m p $ = CHR$(VAL(hi$)) + CHR$(VAL(Io$)) Pictures = Pictures + Imps GetHex yvert%(l%), hiS, loS Imps = CHR$(VAL(hi$)) + CHR$(VAL(Io$)) Pictures = PictureS + Imps NEXT 1% EXIT SUB END SUB

Processing orientation data with QuickPlot

, *$ ****$4***$*$***111.4*O*$*0*tm*$*$$

$*$*$**$********$$*$4*$**

SUB Pf'dlo (PictureS, nven%, xvert%(), yvert%()) ' - - - s u b to send outlined idled poly to P1C file t m p $ = CHR$('208) + CHR$(nvert% - 1) Pictures = Pictures + trapS FOR 1% = 1 TO nvert% GetHex xvert%(l%), hiS, Io$ trap* = CHR$(VAL(hi$)) + CHR$(VAL0o$)) PictureS = Pictures + traps Getl-lex yvert%0%), hiS, 1o$ t m p $ = CHR$(VAL(hi$)) + CHR$(VAL(Io$)) PictureS = PictureS + unp$ NEXT I% EXIT SUB END SUB REM $DYNAMIC t.@es~,so,oese~mssee*e*e**oe@*oo*osQ@**e*s***e*o*esse,*so**e*~**@

SUB PFlinnSym (PictureS, X%, Y%, isym%, ipcn%) '----routine for modified Flinn diagram - symbols twice as large as PDrawSym DIM xvert%(10), yvert%(10) ' ~ s u b to draw symbol in P i e f'de ' - - - X % , Y% = Hercules coords '----X3%, Y3% = P i e coords White% = 7 X 3 ~ = CINT(X~ * 4.A.A.A.A.A.A.4.AA~ Y3% = CINT(2100- (Y% * 4.A.SA.A.A.A.A.A.~A.tt)) IF isym% = 0 THEN E x r r s t m IF ipea% < > White% THEN PColor Picture*, ipen% SELECT CASE isym% CASE 1 'box fdled xvert%(l) = X3% - 14: yvett%(l) = Y3% - 14 xvert%(2) = X3% + 14: yvcrt%(2) = Y3% - 14 xvert%(3) = X3% + 14: yvert%(3) = Y3% + 14 xvert%(4) = X3% - 14: yvert%(4) = Y3% + 14 Pfillo PictureS, 4, xvert~(), y v e r t ~ ( ) CASE 2 ' + PMove PictureS, X3 % - 14, Y3 PDraw PictureS, X3% + 14, Y3% PMove PictureS, X3%, Y3% + 14 PDmw PictureS, X 3 ~ , Y3% - 14 CASE 3 'triangle open up PMove PictureS, X3%, Y3% + 14 PDraw PictureS, X3% + 14, Y3% - 14 PDraw PictureS, X3% - 14, Y3% - 14 PDraw PictureS, X3%, Y3% + 14 CASE 4 '* PMove PictureS, X3% - 14, Y3% + 14 PDraw PictureS, X3 % + 14, Y3 % - 14 PMove PictureS, X3% - 14, Y3% - 14 PDraw PictureS, X3% + 14, Y3% + 14 PMove PictureS, X3% - 14, Y3% PDraw PictureS, X3% + 14, Y3% PMove PictureS, X3%, Y3% + 14 PDraw PictureS, X3%, Y3% - 14 CASE 5 'diamond idled xvert%(l) = X3% - 14: yvett%(1) = Y3% xvert%(2) ffi X3%: yvet~%(2) = Y3% + 14 xvett%(3) = X3% + 14: yvett%O) = Y 3 ~ xvett~(4) = X3%: yvert%(4) = Y3% - 14 Pf'dlo PictureS, 4, x v e r t % ( ) , y v e r t % ( ) C A S E 6 'circle filled x v e r t % ( l ) -- X 3 % - 14: y v e r t % ( l ) = Y 3 % + 4 xvert%(2) ffi X 3 % - 6: yvert%('2) = Y 3 % + 14 xvert%(3) = X 3 % + 6: y v e r t % ( 3 ) = Y 3 % + 14 xvcrt%(4) = X 3 % + 14: y v e r t % ( 4 ) = Y 3 % + 4

283

284

D . A . VAN EVERDINGEN, J. A. M. VAN GOOL, and R. M. VISSERS

xvert%(5) = X3% + 14: yvea%(5) = Y 3 ~ - 4 xvert%(6) = X3% + 6: yvert%(6) = Y3% - 14 xvert%(7) = X3% - 6: yvert%(7) = Y3% - 14 xvert%(8) = X 3 ~ - 14: yvet~%(8) = Y3% - 4 Wdlo PictureS, 8, xvelt%(), yvert%( ) CASE 7 'box open PMove PictureS, X3% - 14, Y3% - 14 PDraw PictureS, X3% + 14, Y3% - 14 PDraw PictureS, X3% + 14, Y3% + 14 PDraw PictureS, X3% - 14, Y3% + 14 PDraw PictureS, X3% - 14, Y3% - 14 CASE 8 ' X PMove PictureS, X3% - 14, Y3% + 14 PDraw PictureS, X3% + 14, Y3% - 14 PMove PictureS, X3% - 14, Y3% - 14 PDraw PictureS, X3% + 14, Y3% + 14 CASE 9 'circle open PMove PictureS, X3% - 14, Y3% + 4 PDraw PictureS, X3% - 6, Y3% + 14 PDraw PictureS, X 3 ~ + 6, Y3% + 14 PDraw PictureS, X3% + 14, Y3% + 4 PDraw PictureS, X3% + 14, Y 3 ~ - 4 PDraw PictureS, X3% + 6, Y3% - 14 PDraw PictureS, X 3 ~ - 6, Y3% - 14 PDraw PictureS, X3% - 14, Y 3 ~ - 4 PDraw PictureS, X 3 ~ - 14, Y3% + 4 CASE 10 'diamond open PMove PictureS, X3% - 14, Y3% PDraw PictureS, X3%, Y3% + 14 PDraw Pictme$, X 3 ~ + 14, Y 3 ~ PDraw PictureS, X 3 ~ , Y3% - 14 PDraw PictureS, X 3 ~ - 14, Y3% CASE ELSE END SELECT IF ipen% < > Wh ite~ THEN PColor PictureS, White%

EXIT SUB END SUB ***********************************************************

SUB PFSiz~ (PictureS, X%, Y%) ' ~ s u b to output font size command to PIC file traps = Ctnt$(]72) Pictures = Pictures + unp$ GctHex X ~ , hiS, Io$ tmp$ = CHR$(VAL(hi$)) + CHR$(VAL0o$)) PictureS = PictureS + t m p $ GetHex Y %, hiS, 1o$ Imps = CHRS(VAL0d$)) + CHR$(VAL(Io$)) Pictures = PictureS + tmp$ EXIT SUB END SUB ***********************************************************

SUB PHead (PictureS) ' - - - s u b that ~ n d s header to PIC file traps = C I ~ $ ( I ) + CHR$(0) + CHR$(0) + CHR$(0) + CHR$(I) + CHR$(0) Imps -- t m p $ + CHR$(8) + CHR$(0) + CHR$(&H44) + CHR$(0) + CHitS(0) traps = Unp$ + CHR$(0) + CHR$(0) + CHR$(~HC) + Ctnt$(&HTF) + Ctnt$(9) + CI-m$(6) Pictures = Pictures + traps PFSizc PictureS, 100, 100 EXIT SUB END SUB REM $STATIC DEFINT I-K , ****.****mmm*e*o*e**msm**esoem*m*e**ose***s***o**@m**********

Processing orientation data with QuickPlot

S U B PicPileOpen (PictureS, PicFig, TypeS, F$) '---routine to initializePictures array so data can laterbe saved to a .PIC '---f'de for plotting with Lotus P G R A P H (R) ' - - - D o not do the first pa~ if • Flinn or triangular plot is to be made MoreDataFIg 95 = 0 IF MID$(Type$, 1, 1) < > "F" A N D MID$(Type$, 1, 1) < > "T" THEN IF Batch 95 = 0 T H E N WipeArea 1 LOCATE 1, 1: PRINT "PIC Output:" IF PicF1 8 -- 0 THEN Menus$(2) = " N o ' : Menus$(3) = "Yes" ExplainS(2) = "Data plotted to screen only" ExplainS(3) = "Data plotted to screen and to PIC file" Menu Menus$(), ExplainS(), ANSI 95, 0 IF ANSI 95 = 3 T H E N CircleFig = 0 Pictures = "" PicFig = 1 PHead Pictures 'put Header into Pictures string CLOSE #2 ENDIF ELSEIF PicFig = 1 THEN Menus$(2) = "Add': Menus$(3) = " N e w ' : Menus$(4) = "Screen" ExplainS(2) = "Add this plot to the previous plot already in PIC fde" ExplainS(3) = " E r a ~ PIC fde and ~ u ~ new one with this plot" ExplainS(4) -- "Do not make PIC fde, only make screen output" Menu Menus$(), ExplainS(), ANSI 95, 0 IFANSI95 = 30RANSI95 = 4 THEN PictureS = "" CirclcFtg = 0 ' - - - D e l e t e previously output data CLOSE #2 O N E R R O R G O T O Generr: FF$ = DataDirOut$ + PicFile$: KILL FP$ IF Neff95 < > 0 T H E N Ncrr% = 0 PicFlg = 0 ' - - - I f more data is to be added then remember to total number of points - @

@ ~ nag ELSEIF ANSI 95 = 2 T H E N MorcDstaFig95 = 1 ENDIF IF ANSI 95 = 3 T H E N PicFlg = 1 WipcArea 4 NetOnScreenFlg95 = 0 PHead PictureS 'put Header into PictureS 'string ENDIF ENDIF ELSEIF Batch 95 = 1 A N D PicFIg = 0 THEN IF PrintOutS = "PIC" T H E N PicFig = 1 ' - - - - I f O P e r $ = E I G H T then chose PIC f'de mode IF MID$(Oper$, 1, 5) = "EIGHT" THEN PicFIg = 1 IF PicFlg = I T H E N Pictures = " ' : PHead Pictures ENDIF ENDIF ENDIF ' - - - I f • picfile is needed in either interactive or batch mode then open fde IF ((ANS195 = 3 OR Batch95 = 1) AND PicFig = 1) OR (MID$(Type$, 1, 1)@ @ = "F" OR MID$Crype$, 1, 1) = " T ' ) THEN ' - - I f we are in nbatch mode and plotting Eight per page don't open • new ' - - f d c unless we are at the first plot IF MID$(Oper$, 1, 5) = "EIGHT* A N D FIg895 > 1 T H E N GOTO SkipToEnd: ' - - C h e c k if there is enough free space on the disk (not if in batch mode) IF Batch95 = 0 T H E N CheckFree "PIC", TypeS, Numb% PieFile$ = " "

285

286

D . A . VAN EVERDINGEN, J. A . M . VAN GOOL, and R . M . VISSERS

FilcName$ = F $ + " " I=l GetFilcNam¢ FileNames, PicFiles IF LEN(PicFiles) + LEN(Types) < = 8 THEN PicFiles = UCASE$(PicFiles + Types + =.PIC') ELSEIF LEN(PicFIle$) + L E N ~ ) > 8 THEN PicFiles = UCASE$(MID$(PicFiles, 1, LEN(PicFiles) - LEN(Types)) + @ @Types + ".PIC') END IF IF Batch~ = 0 THEN WipeArea I LOCATE 1, 2: PRINT "Output will be to: "; PicFiles; " Okay [Y]7" Q$ ----UCASE$(INPUT$(I)) IF Q$ = "N" THEN WipeArea 1 LOCATE 1, 1 INPUT "Enter new PIC file Name (No extension): ", PicFiles J=O '----Check first ff the fool entered an extension anyway FOR H = 1 TO LEN(PicFile$) IF MID$(PicFile$, H, 1) = "." THEN J = II NEXT II IF J < > 0 THEN PicFiles = MID$(PicFiles, 1, J - 1) PicFiles -- PicFiles + ".PIC" ENDIF ENDIF f'deS = DataDirOut$ + PicFileS ' - - I n Batch mode existing files are overwritten IF Batch~ --- 0 T H E N E9$=1

WHILE NOT E ~ = 0 FUcExist fileS, E ~ IF E ~ = 1 THEN 'File exista WipeArea 1 LOCATE I, 1: PRINT "Overwrite File" LOCATE 2, 1: PRINT fdeS; " exias" Menua$(2) ffi " N o ' : M e n u s $ O ) = =Yet" Menu Menus$(), ExplainS(), ANSI $$, 0 IF A N S I ~ = 2 THEN WipeArca 1 LOCATE 1, 1 INPUT "Enter new name (Omit extension): ", FileNames PicFiles : "" GetFileName FileNames, PicFileS PicFiles = PicFileS + ".PlC" files = DataDirOut$ + PicFileS ELSEIF ANSI % = 3 THEN E~ =0 ENDIF ENDIF WEND ENDIF WipvA rear 1 LOCATE 1, 1: PRINT "Plot will be saved To: "; UCASE$(PicFileS); " @ 2(in "; MID$(DataDirOut$, 1, LEN(DataDirOul$) - 1); ")" OPEN fdc$ FOR BINARY AS #2 IF Batch % = 0 THEN LOCATE 2, 1: PRINT "Press any key to continue" DO: LOOP UNTIL INKEY$ < > "" ENDIF ENDIF SkipToEad: END SUB REM $DYNAMIC DEFSNG I-K

Processing orientation data with QuickPlot

SUB PMove (PictureS,X % , Y % ) '-~sub that output move command to PIC file maps = CHR$(160) Pictures : Pictures + traps GetHex X%, hiS, io$ t m p $ = CHR$(VAL(hi$)) + CHR$(VAL(io$)) PictureS = Pictures + traps GetHex Y %, hiS, Io5 Unp$ -- CHR$(VAL(hi$)) + CHR$(VAL(Io$)) Pictures = Pictures + unp$ END SUB SUB PText (PictureS, DI %, P%, Msg$) '-----sub to send text to PIC file ' - - - d % is orientatitm : 0 - hor I to r : 0 '- .... 1 - vet b t o t " 90 '- .... 2-horrtol: 180 '- .... 3 - ver t to b : 270 '----p% is position : see lotus file guide tmp$ = CHR$(168)'&HA8 Pictures = PictureS + traps tmp$ = "&H" + HEX$(DI%) + HEX$(P%) traps = CHR$(VAL(tmp$)) Pictures = Pictures + t m p $ t m p $ = Mq~$ + CHR$(O) PictureS = PictureS + trapS

E N D SUB $DYIqAMIC ,***oeeetmo*~essIQe*sste*es*****o***mse***ss**************o~,

SUB O~J-lex ( i v . l ~ , hiS, 1o$) "-----convert numbers to hexadecimal format hi byte first t m p $ = HEX$(iva~) SELECT CASE LEN(Unp$) CASE 0 his = "AH00" Io$ = "&H00" CASE 1 his = "&H00" !o$ = "&H0" + traps CASE 2 his = "&H00" i o $ = "&H" + t m p $ CASE 3 hiS = "&H0" + LEFT$0mp$, 1) los = "&H" + RIOHT$(eaW$, 2) CASE 4 his = "&H" + LEFTS(trapS, 2) io$ = "&H" + RIGHTS(trapS, 2) CASE ELSE END SELECT END SUB

287