AlllQb 037D71

NBSIR 85-3235

A Device Independent Graphics

Kernel

NBS

^PUBLICATIONS

Walter W. Jones and

Alicia B. Fadell*

ri Reference

U.S. DEPARTMENT OF COMMERCE

National Bureau of Standards

National Engineering Laboratory

Center for Fire Research

Gaithersburg, MD 20899

*Current Address - Department of Mathematics

University of Maryland

College Park, Maryland

May 1985

Issued October 1 985

DEPARTMENT OF COMMERCE

100

.056

85-3235

1985

INAL BUREAU OF STANDARDS
/
NBSIR 85-3235

9 t

f A DEVICE INDEPENDENT GRAPHICS

KERNEL

NATIONfli ETTR-rnri OF STANDARDS

ilBRARY

0^

0

Walter W. Jones and

Alicia B. Fadell*

U.S. DEPARTMENT OF COMMERCE

National Bureau of Standards

National Engineering Laboratory

Center for Fire Research

Gaithersburg, MD 20899

*Current Address - Department of Mathematics

University of Maryland

College Park, Maryland

May 1985

Issued October 1 985

U.S. DEPARTMENT OF COMMERCE, Malcolm Baldrige, Secretary

NATIONAL BUREAU OF STANDARDS, Ernest Ambler. Director

TABLE OF CONTENTS

Page

List of Figures iv

List of Tables v

1. Introduction 1

2. Overview 1

3. Schematic of the transform from the application window to a device dependent world space 7

4. Structure of the Data Files 9

5. Input/Output Devices 11

6. Implementation 12

6.1 BUILD 12

6.2 TITLE 17

6.3 ADDMAP 19

Appendix

A. Description of Routines and Their Arguments 22

B. Control Sequences for WDDRAW 60

C. Character Sets (1-24) 61

D. Description of BUILD commands 86

E. Description of TITLES commands 100

F. Examples of Usage of Routines 105

G. Listing of Device 139

iii
List of Figures

Page

1. Interface between application program and devices or processors 2

2. Schematic of the transform from the application window to a device dependent world space 6

3. Schematic of the transform from the application window to a viewpoint on the viewing surface 7

4. Filling pattern for "FILTYP" 36

5. Default color lookup table for Lexidata 8100 52

6. Plot geometry used in "SURFAC"; this shows the naming convention used

for the skirts and surfaces 33

7. Overlapping spheriods with hidden lines removed 58

-iv-
List of Tables

Page

1. Sample of a hardware interface protocol 2

2. General format and grouping of graphics routines 4

3. Device coordinates 8

4. Listing from BUILD - corresponding to data file shown in

Table 3 10

5. Coordinate limits of the hardware 10

-V-

A DEVICE INDEPENDENT GRAPHICS KERNEL

Walter W. Jones

Alicia B. Fadell

Abstract

This paper describes an interface for programs which allows one to write

graphics primitives to several devices without regard for the type of

device. The most salient features are that it has low overhead, is

transportable and can be expanded as the nature of the Input/output devices

changes. A conscious effort has been made to include all normal graphics

primitives together with the most useful high level routines without

compromising the use of special features of custom display units.

Ke3u^7ords: device Independence, display devices, graphics

1 . INTRODUCTION

This paper describes a graphics package which is intended to ease the use

of input/output devices in acquiring and displaying information graphically.

The intent is to reduce the problem to its simplest level by allowing one to

describe graphs in much the same way one thinks of them. A further intent is

to make the user language truly device independent and allow a programmer or other user to switch devices interactively simply by identifying the desired

input and output devices. As much as possible, the similarity in instructions

to different devices is maintained. There are some limitations of course. Pen plotters do not normally come with erasers and most storage scopes (e.g.

,

Tektronics) are not erasable on the individual pixel level. Beyond this no function which is available for a particular device, but not supported because

there is no commonality amongst the devices, is rendered unavailable. Thus, even for specialized usage, this package will take care of normal

Initialization and setup.

The devices which are currently supported are Plot-10 emulators, CALCOMP

pen plotters, a line printer and the Lexidata 3400/8100 series^. These

devices encompass most protocols and slots have been left in the package for

future expansion. We currently support these devices since those are the ones which are available. Any suggestions for expansion or additional functions

are welcome.

2. OVERVIEW

Graphics application programs may be required to send output to or accept

input from several devices. Since each output device is supported by different sets of graphics routines, writing application programs is normally

Certain commerlcal equipment is identified in this paper in order to

illustrate adequately certain device specific characteristics. Such

idenlf ication does not imply recommendation or indorsement by the National

Bureau of Standards, nor does it imply that the equipment is necessarily the

best availale for the purpose.

- 1 -
burdensome since applications may reguire several device-dependent versions of

each program. Alternatively, each application could include all the devicedependent routines in one version of each program, and call only the routines

required for a specific device, e.g., by means of GO TO statements. In either

case, when a new device is added to the work environment, application programmers must learn another set of graphics routines and write new codes for each

application. This reprogramming can be time-consuming and costly.

A graphics system which supports several input and output devices, while

hiding the device-dependent routines from the user, is desirable. DEVICE is a package of FORTRAN subroutines for producing graphics output on several

devices. The package consists of one standard routine for each output primitive (line, polygon, character, etc.). Once a device has been identified, a primitive is displayed through a call to the appropriate routine. This

routine is also used to generate the same output on other devices. Hence

DEVICE is an interface between the application program and the input/output

devices since each standard routine is device-independent, as shown in

Figure 1.

Every hardware interface routine is divided into sections. Each of these

sections is devoted to a device. Once a primitive is called by a program,

command goes to the section designed for the accessed device, as shown in

table 1.

application program

console

interface

FIGURE 1

-2 -
Table 1 A Sample of the Hardware Interface Protocol

SUBROUTINE SAMPLE

COMMON/DEV /IDEV

GO TO (1 ,2, . . .n) IDEV

C CALCOMP SECTION

r graphics subroutines

RETURN

C PRINTER SECTION

^

• graphics subroutines

RETURN

END

The coordinates used in labeling a viewing area differ for each device.

Therefore, the user's data points must be converted into device coordinates

(see section 5). This conversion is done by DEVICE before device-dependent

routines are called. The format of a typical graphics subroutine is

SUBROUTINE SAMPLE

COMMON /DEV /IDEV

GO TO (1,2,. ..n) IDEV

C CALCOMP SECTION

1 convert to CALCOMP coordinates

call CALCOMP graphics routines

RETURN

C PRINTER SECTION

2 convert to PRINTER coordinates

call PRINTER graphics routines

RETURN

C CONSOLE SECTION

n convert to CONSOLE coordinates

call CONSOLE graphics routines

RETURN

END

- 3 -
2.1 Structure of the Package

These routines can be grouped into 6 categories summarized below and

defined in table 2. More detail is given in the apprendixes.

1 . Device Control - utility routines which include

initialization and termination procedures

for the device

2. Viewing - specify the part of the user’s coordinate system to

display and where to place the display on the viewing surface

3. Output Primitives - define objects and display them on the

viewing surface

4. Attributes - define the appearance of the output primitives

5. Auxiliary - miscellaneous routines

6. Input - acquire data.

-4 -
Table 2. Graphics Subroutines - General Format

1 . Device Control

DEVICE (n)

NEWFRM

HDCOPY

FRAME

ERASE

ENDFRM

2 . Viewing

SCALNG (XI, Yl, X2, Y2,

XIH, YIH, X2H,

Y2H, XIS, YIS,

X2S, Y2S)

DEFINE (XI, Yl, X2, Y2)

3 . Output Primitives

LINE (XI , Yl , X2, Y2)

LINES (XI, Yl, X2, Y2, N)

LNPLOT (X, Y, II, 12, 13)

PLYGON (X, Y, N)

BOXPLT (XI, Yl, X2, Y2)

CIRCLE (X, Y, R)

SURFAC (Z, NX, NY, MODE)

CONTUR (F, TEST, NX, NY, FL)

VOLUME (MODE, F, NX, NY, NZ

,

CLEVEL, NCL, T, NT)

SYMBOL (X, Y, CHAR)

CHPLOT (X, Y, CHAR, II, 12, 13

HHDRAW (X, Y, SX, SXY, ICHAR,

NSET, NSET, lERR)

WDDRAW (X, Y, DX, DY, SX, SXY

SY, CHARS)

Function

initialize a graphics device

clear the screen and initialize a new frame

generate a hard copy

write out the buffer

clear the screen (also done in

"NEWFRM"

)

close the graphics device

Function

define the window and viewport

define the window (viewport defaults

to entire viewing surface)

Function

draw a line between 2 points

draw a line between points in an array of length n draw lines between selected points

of an array

draw a closed polygon

draw a rectangle

draw a circle

performs surface plotting

performs contour plotting

performs volume plotting

(3 dimensional contouring)

draws a specified hardware character

at a given point

draws a specified hardware character

at selected points in an array

draws a particular character of

the specified character set

draws a character string

- 5 -
LABEL (CHARS, XI, Y1 , X2 , Y2,

ANGLE)

ALABEL (CHARS, XI, X2 , Yl, Y2

,

ANGLE)

FNUMBR (X, Y, DX, DY, SX, SXY,

SY, XNUMBR, WIDTH, DIGITS)

ENUMBR (XNUMBR, XI, Yl, X2 , Y2)

GRAFIT (NPLT, XI, X2 , XIR, X2R,

XXI, XX2, Yl, Y2, YIR,

Y2R, YYl, YY2, XTIT, NDVX,

YTIT, NDVY)

PLYPLT (F, IS)

MAPIN (FW, V, NV, E, ES,

NE, P, PS, NP)

MAPOUT (W, V, NV, E, ES, NE,

P, PS, NP)

VIEWTR (X, W, V, NV, E, ES,

NE, P, PS, NP)

4. Attributes

COLOR (N)

LINWID (N)

FILTYP (N)

CHRSIZ (CHFRZ, GCHFRZ)

CHRSET (N)

5 . Auxiliary

lOWAIT (N)

SETDEV (Nl, N2)

DELAY (N)

SETLUT

6. Input

DEVINP (I, status, X,Y,Z)

draws a character string

draws a character string with

aspect ratio 4/3

draws a real number in FORTRAN

F-type format

draws a real number in exponential

(E) format (E - type)

sets up a graph (x and y axis)

for plotting data

read in a "BUILD" formatted

structure file, F and display

according to IS

read a "BUILD" file and return

the vertices, edges and polygons.

Files are appended after the initial

call.

display the specified edges as given

display the specified edges and

polygons using the transform matrix

X.

Function

defines the color for drawing

defines the line width

defines the appearance of the

interior of polygons and circles

sets the size of the hardware

characters

changes the default character set

Function

puts a pause in the program

changes logical units

delays for hard copy units

sets up the color look-up table

read input coordinates triplet from

a device

-6-
3. COORDINATE SYSTEMS

The application must define the environment in which it will operate.

For instance, temperature may be calculated in degrees Celsius for one study,

while length is measured in feet for another project. Data can be sent to the

DEVICE routines directly from the application; no conversion to a standard

unit is required of the user. Within the graphics package, however, the data

coordinates must be converted to device-dependent coordinates for the

individual hardware.

The user space is a 3-dimensional left-handed coordinate system (positive

x-axis to the right, positive y-axis up, and positive z-axis into the viewing

surface). Data points are added to the space in "application-dependent"

coordinates. Before these points can be displayed, a window and a viewport

must be specified.

The window, a rectangle in the x-y plane of the user space, encloses the

points to be displayed. This window is mapped into the device's world space.

The world space is labeled differently for each device. The world space is

determined by the device's fixed points (XIS, YIS) and (X2S, Y2S). The window

is defined by the user who specifies the diagonal endpoints (XI, Yl) and (X2,

Y2). The window is mapped to the world space by the scale factors:

XYCOORD(l) = (X2S - X1S)/(X2 -XI)

XYC00RD(2) = XIS - XI * XYCOORD(l)

XYC00RD(3) = (Y2S - Y1S)/(Y2 - Yl)

XYC00RD(4) = YIS - Yl * XYC00RD(3)

A point (X,Y) in the user space is converted to the world coordinate

(XS,YS) by the transformation:

XS = X * XYGOORD(l) + XYC00RD(2)

YS = Y * XYC00RD(3) + XYC00RD(4)

Any point within the user's window will be converted into valid world

coordinates (i.e., XIS ^ XS ^ X2S and YIS ^ YS _< Y25) and can be plotted.

Other points will be mapped out of the device's range and should not

displayed on the viewing surface.

(X2S,Y2S)

- 7 -
The part of the viewing surface which will contain the display is called

the viewport. The viewport defaults to the entire viewing surface. In order

to place the display on a smaller portion of the viewing surface, the desired

rectangular area must be specified. The device coordinates (XIH, YIH) and

(X2H, Y2H) are used to define this viewport. The world space is then mapped

onto the viewport. Hence, all data points in the user space are converted to

device coordinates through 2 transformations. Only points in the user's

window will be transformed into valid device coordinates (i.e., coordinates

within the device's viewport).

FIGURE 3

Usual usage is to transform the viewport to the entire viewable space

(view surface). In this case a call to DEFINE is sufficient. The default

values for the device world coordinate space are used, and the defined window

is mapped to the maximum normalized device coordinates. Special applications

might require other tranf ormations . Such a facility is provided by SCALNG.

This routine specifies the transform from user space to world coordinate

space, from world coordinate space to normalized device coordinates and

finally to the device (or hardware) address units. Table 3 shows the default

values for the current list of output device.

-8 -
TABLE 3

DEVICE COORDINATES

OUTPUT WORLD NORMALIZED PHYSICAL

X Y X Y X Y

Lexidata 128000 102300 32700 26160 1279 1023

Tek 40XX 1280 1024 1029 1029 1023 768

CALCOMP - - 1029 1023 10.75 8.75

Printer 1279 1023 1279 1023 128 50

The physical (device) coordinates map windows to the full viewing

space. Some applications require use of only a portion of this space. An

example is the reduction of about 15% of the linear dimensions in order to fit

into a 512 line raster scan television frame.

4. STRUCTURE DATA FILES

Several programs create and modify structure files for graphical

display. The elements used to compose these structures are vertices, edges,

and polygons. The elements are stored in user coordinates in the data file.

Attributes for these elements along with the specifications of the user space,

are also stored in this file.

Listed at the beginning of the data file are the dimensions of the user space and the window space. The boundaries of the window are put into the

WINDOW array: WINDOW (1 -> 4) {(left - bottom), and (right - top),

respectively}, while the boundaries of the user space are sent to the WORLD

array: WORLD (1 ->• 6) (left, bottom, front, and right, top, back),

respectively. This latter three dimensional space specification is not

currently used.

The following two images in the data files specify the number of

vertices, elements (defined as polygons + edges) and the number of edges, and

a description of the elements by groups. This latter is currently implemented

only in ADDMAP, described in Section 6.3.

The data for the elements and attributes comprise the remaining part of

the file. The vertex coordinates (x,y,z) are stored next, followed by element

pointers. The input routines read the data for the vertices into the array

VERTEX (i,j). Here, the row index, i, (possible values = 1,2,3) refers to the

i^ coordinate (x, y, or z, respectively) and the column vector j refers to

the vertex number. For instance VERTEX (2,5) stores the value of the y

coordinate of the 5*" vertex. In the file, each coordinate triplet is

preceded by zero (0) or one (1). A zero indicates that the vertex was deleted

from the user space (i.e., the vertex is not used for displaying or for

constructing edges and polygons) but was not deleted from the data file. A one (1) specifies that the vertex exists in the user space. An example would

be deleting a polygon without removing the corresponding vertices.

-9 -
The vertices are grouped together to form edges and polygons. Following

the list of vertex coordinates is the list of elements. Each element, either

an edge or a polygon, is identified by its endpoints which are in

EDGE (i,j) or POLY(i,j),

where i specifies which of the two endpoints and j Indicates the element

number. For example, if the fourth edge is composed of vertices 6 and 10, we

have

EDGE (1,4) = 6 and EDGE (2,4) = 10

Polygons are stored in a similar manner. P0LY(i,j) contains the vertex number

of the i^ vertex of the polygon. Polygons have no more than NPVERT

(currently 8) vertices.

Data for each edge or polygon fills one row of the data file. The

element’s vertices are listed first and are followed by the element's attributes. The attributes are read into the arrays ESPEC (i,j) or PSPEC (i,j) for

edges and polygons, respectively. Here the 1 specifies the attribute and j

indicates the element number. ^ ESPEC (i,j)

1 line width

2 color

3 line attribute

4 <unused>

PSPEC (i,j)

1 line width

2 color

3 fill type

4 polygon (^0) or polyline (<0)

A sample data file is shown in Table 3. In this file there are 9 valid

vertices, 1 "deleted" vertex, 1 edge, and 3 polygons. (Note that the last

polygon is actually a polyline. T The same data as listed by the BUILD program

is shown in Table 4.

Table 3

BUILD O.OOOOOE+00 O.OOOOOE+00 1.28000E+03 1.02400E+03

-1.00000E+09-1.00000E+09-1.00000E+09 l.OOOOOE+09 l.OOOOOE+09 l.OOOOOE+09

10 4

4

1.55608E+02

4.03576E+02

5.00956E+02

2.60015E+02

4.36470E+02

9.64768E+02

5.30060E+02

5.30070E+02

8.03136E+02

8.03136E+02

4 6 0 0

12 3 0

6 7 8 9

14 7 0

7.37531E+02 O.OOOOOE+00

9.39818E+02 O.OOOOOE+00

7.45070E+02 O.OOOOOE+00

6.44554E+02 O.OOOOOE+00

3.88245E+02 O.OOOOOE+00

6.44554E+02 O.OOOOOE+00

3.68136E+02 O.OOOOOE+00

5.88014E+02 O.OOOOOE+00

5.88014E+02 O.OOOOOE+00

4.63627E+02 O.OOOOOE+00 000002100 000002100 000002810 000002 10 -1

-10-
The edge, polygon and polyline entries in Table 3 are integer format. In this case there are 13 entries for each element. For polygons and polylines,

NPVERT entries, a zero for compatibility with"MOVIE, BYU" and the 4 NSPEC

entries. For edges, here are two entries, seven zeros and the 4 ESPEC

entries

.

Table 4

WORLD

LEFT, BOTTOM, FRONT: -l.OE+09

RIGHT, TOP, BACK: l.OE+09

WINDOW

-l.OE+09 -l.OE+09 LEFT BOTTOM: 0.0 0.00

l.OE+09 l.OE+09 RIGHT, TOP: 1.3E+03 l.OE+03

VERTEX(X,Y,Z)

1) 155.61 737.53 0.00000

2) 403.58 939.82 0.00000

3) 500.96 745.07 0.00000

4) 260.02 644.55 0.00000

6) 964.77 644.55 0.00000

7) 530.07 368.14 0.00000

8) 530.07 588.01 0.00000

9) 803.14 588.01 0.00000

10) 803.14 463.63 0.00000

EDGES SPECS

1) 4 6 2 1 0 0

POLYGONS SPECS

1) 1 2 3 0 0 0 0 0 2 1 0 0

2) 6 7 8 9 0 0 0 0 2 8 1 0

3) 1 4 7 0 0 0 0 0 2 1 0 -1

5. INPUT/OUTPUT DEVICES

Currently four separate input and output devices are supported. These

encompass all the common standard Interfaces and the flexibility exists to

include any future Input/output device for which a transformation between the

hardware and mathematical space can be given. The devices for output are a CALCOMP pen plotter (1012), Tektronix 40XX or emulator, Lexidata Displays

(8100 and 3700) and a line printer. Devices for input are a digitizing

tablet, a joystick, segments in the Lexidata picture descriptor lists which

can be "picked" and ASCII input from a keyboard or file.

The software maintains three dimensional picture descriptors. Although

only the Lexidata 3700 can utilize this capability directly, perspective and

visual cuing can be shown on the other devices. The coordinate limits of the

hardware are shown in Table 5

.

- 11 -
TABLE 5

DEVICE Xmin/Xmax Ymin/Ymax Zmin/Zmax

Tektronix 40XX 0/768 0/1023 — Printer 1/128 format limited - Joystick 0/32767 0/26160 - Lexidata 8100 0/1279 0/1023 - Lexidata 3700 0/1279 0/1023 0/4095

Tablet 0/12190 0/9142 - Segments 0/~ 10^ 0/~ 10

Calcomp plotter 0/11.5 0/8.5

These are the local address modes for pixels and not the normalized

device coordinates (see section 3). This group of devices includes almost all

standard protocols for graphics interfaces. These are the CORE standard,

escape sequences, direct (DMA) input/output of pixels, line oriented

input/output (ASCII) and the very early protocols formulated by Tektronix and

CALCOMP. Slots have been left in the software to accomodate new devices. At

the time of this writing, the GKS standard has not been formalized. However,

if it is similar to the proposed standard then inclusion of devices which

follow this protocol is straightforward.

6. IMPLEMENTATION

6.1 BUILD

The BUILD program is used to create, modify, or display files consisting

of vertices, edges, and polygons. These files also contain the elements'

characteristics: line width, color, and polygon fill type. The first step in

creating a file is to specify the user space and the window. The user space

defaults to a cube centered at the origin and having sides of length

6 X 10^. Prompts are used by the programs when needed. There are no default

values for the window space. The x and y coordinates of the window must be

specified with a call to

WINDOW

At this point, data for the various structures may be entered and

subsequently modified or displayed. The work file, however, need not be a new

file. It is possible to alter or display data of an existing file. The

command to access an old file is

GET [filename]

where the file defaults to INFILE, the last file accessed. Similarly, a work

file may be saved by

-12-
SAVE [filename]

In this case, the default file is OUTFILE which is the last file that was saved. A check of the filenames stored in INFILE and OUTFILE is possible by

calling

STATUS

This command also Indicates the number of vertices, edges, and polygons in the

work file along with the maximum number of each element allowed.

The work file is modified in several ways.

file with

( VERTEX

ADD

{ EDGE

( POLYGON

Elements are added to the

(default = VERTEX)

Vertices are input by specifying three (x,y,z) coordinates. Edges are specified by pointing to two vertices and polygons are defined by indicating a minimum of 3 vertices to a maximum of NPVERT vertices.

Elements can be added from any of the input devices. The command

[joystick]

SET (TABLET

[ (default = KEYBOARD)

{ KEYBOARD

)

sets the default input device. At the start of program execution, the

keyboard is the data input device. To add data from a different device, SET

^ must be used before ADD.

If the attributes of new edges or polygons are to be different than the

default characteristics, the command

SELECT

must be used before the ADD command. SELECT allows the specification of the

line width, color, polygon fill type and a user specification parameter, the

fourth element in ESPEC and NSPEC. These new values then become the default

attributes

.

Elements are deleted from the file with the command

(

VERTEX

) EDGE

[ (default = VERTEX)

polygon)

When a vertex is deleted, any edge or polygon containing that vertex is also

deleted. It should be noted that the vertex is not deleted from the permanent

data file; instead, this point is marked with a flag to indicate deletion from

the user space. In order to remove vertices from the data file, the

- 13 -
SQUEEZE

command is used. All "flagged" vertices, along with any vertices in the user

space which are not used by an edge or a polygon, are deleted from the data

file by SQUEEZE. When the DELETE command is used for polygons and edges,

however, these elements are removed from the user space and the data file.

Once added to the user space, the elements can be modified. Elements are moved to new locations through the command

(VERTEX

j MOVE {edge

j (default = VERTEX)

( POLYGON )

A vertex can be moved by specifying its new (x,y,z) coordinates. Alternatively, a single vertex or* a group of vertices can be moved a distance given by an (x,y,z) displacement vector. MOVE EDGE allows a single edge or a group of

edges to change location by a specified (x,y,z) distance. Polygons are moved

in the same manner as edges. "MOVE" makes new verticies when moving edges or polygons. In addition, duplicates of elements can be created with

f EDGE ) DUPLICATE polygon (default = VERTEX)

The new elements are positioned at the designated displacement from the

original position.

In addition to modifying portions of the model, the entire structure can

be transformed. The model is moved to another part of the user space with the

command

TRANSLATE

accompanied by an (x,y,z) displacement vector. A rotation of the model about

a specified point (default is the body center of gravity for the model) is

possible with

ROTATE

The rotations occur about axes parallel to the x-, y-, or z-axes of

coordinate system. The axis and angle of rotation are specified. The

structure is scaled about its center point by

SCALE

which requires the input of a positive scale factor. If the scale factor is

greater than one, the model will be magnified. If the factor is between zero

and one, the structure will be reduced. Each scaling, rotation, and

translation, along with the order of application, is recorded in a matrix

called the transformation matrix. This matrix contains the information needed

to directly convert the structure from the original configuration to the final

position determined by the series of transformations.

-14 -
A listing of the elements in the work file or of the transformation

matrix can be obtained at the terminal with

LIST

VERTEX

EDGE

POLYGON

MATRIX

(default = VERTEX)

Heading the vertex list are the world and window coordinates of the work

file. The (x,y,z) coordinates of a designated group of vertices follow.

These vertices are listed by numbers; missing numbers correspond to vertices

which were removed from the user space with DELETE. The LIST EDGE command

also requires the specification of a group of edges. Each edge’s number and

endpoint vertices are listed on a row. Similarly, the polygon numbers and

component vertices are listed for a group of polygons by the LIST POLYGON

command. Finally the transformation matrix is displayed with LIST MATRIX.

The lists can be sent to the printer instead of the terminal with the

command

PRINT

VERTEX

EDGE

' POLYGON

ALL

( MATRIX

(default = ALL)

The PRINT commands produce lists in the same format as the corresponding LIST

commands. However, groups of elements are not specified by the user. The

PRINT element command lists the first through the last "element" stored in the

work file. The additional command, PRINT ALL, lists the world and window

coordinates; all of the vertices, edges, and polygons; and the transformation

matrix.

The contents of the work file can be displayed graphically. At the start

of program execution, the output device for the display defaults to the

Lexidata. A different device is selected with

f

CALCOMP

PRINTER

LEXIDATA

CONSOLE

(default = LEXIDATA)

The specified device becomes the new default for graphical display.

If the output device has associated hard copies, these copies can be

generated with

COPY ON

j OFF)

(default = OFF)

After COPY ON has been entered, a specified number of hard copies of each

subsequent graphics diplay will be produced. To discontinue this automatic

duplication, COPY OFF must be entered. Note that the copy switch is in the

OFF position at the start of program execution.

- 15-
The model is displayed with

DISPLAY

(

VERTEX

EDGE

POLYGON

ALL

(default = ALL)

If the ouptut device is a screen, the screen is cleared before the display is

generated. Only the elements within the window are displayed. DISPLAY VERTEX

plots the model's vertices and labels each vertex with its number. DISPLAY

EDGE or DISPLAY POLYGON draws the models' edges or polygons, respectively

without numbering them. All edges and polygons are shown with DISPLAY ALL. A

screen can be cleared with

ERASE

Otherwise, the image will remain on the screen until DISPLAY is used again or until termination of the program.

The field of view for a display is altered with

FIELD

The point of observation can be moved relative to the x-y plane of the user's

system. A distance of zero places the observer at the origin of the

coordinate system. A positive distance, d, positions the observer d units on the negative z-axis. The perspective of the display changes as the viewer's

distance is altered. In addition, the angle of view can be changed. This

angle, originating at the observer and bisected by the z-axis, determines the

scope of vision. For instance, as the angle is decreased, the scope of vision

becomes narrower. At the start of program execution, the observer is

positioned 10,000 units from the origin and the angle of view is 90°.

At times it is useful to modify a structure throughout a sequence of frames.

The number of frames and the changes desired are specified with

ANIMATE

The structure can be translated, scaled about its center, or rotated about a particular point. Edges and polygons may be moved. The observer can be moved

along the z-axis. Any combination of these modifications is possible. Note

that ANIMATE only receives the parameters for each change. The sequence of

frames is viewed with DISPLAY.

Some transformations may cause the model to be moved outside the

window. If the location of the structure becomes unknown, there may be

difficulties in retrieving the model. The model is found with

AUTO

The window and the observer are automatically moved so that the entire model

can be seen. As a result of AUTO, the scale of the model may not be optimum

for viewing. This situation is easily modified with SCALE and FIELD.

-16-
The commands and the user's reponses to the subsequent prompts do not

have to be entered at the console. The input device is changed to a specified

file with

INPUT

All input is read from this file until another input file is specified. The

EXIT

command changes the input device to the console.

Finally, the program is terminated with

END

While the program is running, the

HELP

command is used to list all the commands together with a brief description of

them.

6.2 TITLES

The TITLES program is used to create and modify a series of colored

pictures consisting of character strings, lines, and circles. The strings are positioned on the screen by means of a joystick. Characters from any

combination of the 24 character sets (see Appendix C) are used to form a string. Lines, circles, and bullets also may be added to the picture.

Elements are added in various colors and sizes. Once the pictures (usually

called slides ) have been created, hard copies may be generated. TITLES is

commonly used to produce slide presentations.

At the start of program execution, there is the option of accessing an existing data file or composing a new file. The desired option is specified

by entering the filename, or, to indicate the creation of a new file, by

hitting the <RETURN> key.

Once an existing file has been read, the user is asked for a command with

the prompt FUNCTION=. Prompts are given when needed. If the file is new, the

command defaults to

NEW,

a new slide is created and added to the work file. The default color and

character set for the text on this slide is specified. Lines of text are entered and then positioned with the cursor. Colors and character sets may be

changed within a character string by means of control sequences. Control

sequences are also used to add subscripts and superscripts and to change the

justification of the text (see Appendix B). These attributes, however, are returned to the default values for the next Line of text.

- 17 -
Once a character string is placed on the screen, modifications may be

made. The string may be deleted, moved, centered on the line, and scaled.

Note that the character size resulting from a scaling becomes the default size

for all characters subsequently entered. This process of adding and modifying

text is continued until the <RETURN> key is entered instead of text

characters. At this point, the user is informed of the number of slides in

the work file.

Slides are modified in several ways. Lines of text can be corrected one line at a time with the command

COEIRECT

A character string can be deleted, moved, centered on the line and scaled.

When all corrections have been made to one line of text, the process is

repeated for the remaining character strings on the slide.

Various elements may be added to a slide. Text is added with the command

ADD

The default color and character set are selected. Lines of text are entered

and modified as with the NEW command. Other types of elements are drawn in

specified colors and at given locations. Bullets (filled circles) are added

with the command

BULLET

A straight line is drawn between two specified points with

LINE

Finally, with a center point and a radial distance designated, a circle is

added to the slide with

CIRCLE

Once drawn, each element may be corrected in the usual manner. It may be

deleted, moved, centered, or scaled.

Specified slides in the work file may be displayed on the Lexidata with

the command

VIEW

Hard copies are generated with the command

PROCESS

Slides are specified along with the desired number of copies of each slide.

The delay time for the hard copy device is changed with

-18-
DELAY

and the work file may be written and saved as a data file with the command

SAVE

If the work file is new, a filename is specified by the user. Otherwise, the

slides are automatically written to the file last accessed. In order to access another data file, the

REREAD

command is used.

The various character sets and colors may be referenced. The command

SET

displays a specified character set. Each set has been arranged to correspond

to the 96 displayable ASCII characters. When adding text to a slide, a desired character is placed in the character string by entering the

corresponding ASCII character. The command

COLORS (default = 1)

displays all the available colors in rows. The colors are numbered to

correspond with the rows. The color in the top row is color number one, the

next row is color number two, and so on.

The two remaining commands are HELP and END. The commands are listed

(but not described) with

HELP

Finally, the program is terminated with

END

6.3 ADDMAP

This is a structure manipulation program to add pieces of structure file

together. The commands are similar to those found in BUILD and TITLE. There

are some additional commands to manipulate the individual pieces. The

commands are

SET, NEW, GET, WINDOW, ADD, SAVE, DISPLAY, SPECS, DRAG, GROUP, TRANSLATE,

ROTATE, SCALE, FIELD, DEVICE, HELP and END.

The only commands described here are those which differ from the explanation

in sections 6.1 and 6.2. The implementation of several commands, such as SET

and GET, differs in BUILD and TITLES, but accomplishes the same task.

The special commands to deal with adding structures involve those which

force actions on only a portion of the total file. These are NEW, DRAG and

- 19-
GROUP.

In general, all manipulation commands are applied to all extant

vertices. However, as pieces are added with repeated GET requests, a table is

maintained which points to each of these GROUPS of vertices, polygons, edges

and polylines. In order to apply an operation to a single group, the command,

GROUP

is used. The response will be an integer from zero to a number no larger than

the number of GETs which have been applied. If 0 is entered, then all groups

are affected. If a non-zero number is used, then only that group is

affected. An error is returned and the request repeated if a negative integer

or a number which exceeds the maximum number of groups is entered.

DRAG

is similar to translate, but is done by a pointing device. When this command

is invoked, a point to drag is specified. This is the initial point. Then a final or destination position is requested. The action is to move the

appropriate vertices by this change. Essentially, it allows the user to

specify a translation without knowing the actual coordinates of a map position

on the screen. This program maintains the group designations internally

whereas BUILD does not. The grouping is given on the third line (image) of

the structures file.

The command

NEW

resets pointers and counters and is equivalent to restarting the program.

-20-
ACKNOWLEDGMENTS

As with any good software product, many people have contributed to the

development of improvement of the package over several years. Special thanks

to Jay Boris and Richard Peacock who wrote routines which appear here, and to

the many users who have suffered through initial releases of the software,

making sometimes pointed but useful comments on improvements which were

needed, and usually made. Also to the numerous readers who caught poor

explanations and unjustified assumptions.

- 21 -
APPENDIX A

The following is a description of each routine, together with its

arguments. All routines are listed, although emphasis is on the higher level

routines. For the "hackers", low level routines are included since special

effects are sometimes desirable. The usual FORTRAN convention for integer and

real (floating) numbers is maintained. Type is given only for arrays and

character variables.

-22-
ALABEL

Purpose: to draw a character string with an aspect ratio of 4/3 given the

width and an angle of rotation.

Usage; Call ALABEL (CHARS, XI, Yl, X2, Y2, ANGLE)

Description of Parameters:

CHARS - CHARACTER * 1 ARRAY - character string to be drawn

XI, Yl - lower left starting point of the string

X2 - X coordinate of the right ending point of

the string

Y2 - not used

ANGLE - angle (radians) by which to rotate the

string. - [A positive (negative) angle causes a counter-clockwise (clockwise) rotation about

the lower left starting point.

Control Sequences; See Appendix B

Method: This routine calls the subroutine WDCOUNT to determine if the string

contains characters. If characters exist, LABEL calculates the space

size of the characters in order to create a 4/3 aspect ratio.

Finally, the subroutine WDDRAW is called to plot the text.

-23 -
BOXPLT

Purpose: to draw a rectangle given the endpoints of one of the diagonals.

Usage: Call BOXPLT (XI, Yl, X2, Y2)

Description of Parameters:

XI, Yl - coordinates of lower left corner of the box

X2, Y2 - coordinates of the upper right corner of the box

Method: The routine determines the endpoints of each side of the rectangle.

These endpoints are placed in an array and sent to the subroutine

LINES which plots the four sides.

- 24 -
CHPLOT

Purpose: to draw a specified hardware character centered at selected points

in an array.

Usage: Call CHPLOT (X, Y, CHAR, 11, 12, 13)

Description of Parameters:

X, Y - ARRAY - points at which to plot the character

CHAR - CHARACTER * 1 - character to be plotted

11 - index of first point to plot

12 - Increment at which points are to be selected to

plot

13 - index of last point to plot

Method: The routine selects the points at which to plot the character. The

subroutine SYMBOL is called to draw the character at each of these

chosen points.

- 25 -
CHRSET

Purpose: to change the default character set

Usage: Call CHRSET (N)

Description of Parameters:

N - number (1-24) corresponding to a character set

- 26 -
CHRSIZ

Purpose: to set the size of the hardware character

Usage: Call CHRSIZ (CHFRZ, GCHFRZ)

Description of Parameters:

CHFRZ - a fraction specifying the size of the characters relative to

the screen (default = .03)

GCHFRZ - a fraction specifying the size of the characters relative to

the variables YIR and Y2R in subroutine GRAFIT

(default = .04)

- 27 -
CIRCLE

Purpose

:

to draw a circle of a given radius about a specified center point.

Usage: Call CIRCLE (X,Y,R)

Description of Parameters:

X,Y - center of the circle

R - radius of the circle

Method: The routine generates commands to transform the points from the user space to the raster space. It then generates commands to plot a circle centered at the point (X,Y) with a radius of R.

«

-28 -
COLOR

Purpose: to define the color for drawing

Usage: Call COLOR(N)

Description of Parameters:

N - the number corresponding to a desired color

Method: This command is Ignored for the printer and Tektronix. For the other

devices, an integer is normalized between 1 and NUMCOLOR, where

NUMCOLOR is the number of colors the device can display. The Calcomp

and Lexldata possess 4 and 16 colors, respectively. The numbers are normalized by modular arithmetic and numbers less than 1 are set

equal to 1

COLOR = M0D(N-1, NUMCOLOR) + 1 COLOR = MAX0(COLOR, 1)

- 29 -
CONTUR

Purpose: to perform surface plotting

Usage: Call CONTUR (F, TEST, NX, NY, FL)

Description of Parameters:

F - ARRAY (NX, NY) - real values of the function to be contoured

TEST - ARRAY (NX, NY) - user supplied scratch array having the same dimension as F

NX - range and dimension of i in F(i,j)

NY - range and dimension of j in F(i,j)

FL - value of F(i,j) for contouring

Method: Contours are plotted by looking at a projection of the function

F(I,J) and determining if the function crosses the contouring

interval within their box. Six interpolations are done. First I to

I+l, then J to J+1 parallel crossings are considered. Finally, the

four cases of diagonal crossings are considered by triangular interpolation of each tesselation of the box by the corner points with the

center. The corner points are considered in pairs moving counterclockwise around the projected box.

- 30 -
DEFINE

Purpose: to define the correspondence between the user's window and the

device's world space

Usage: Call DEFINE (XI, Yl, X2, Y2)

Description of Parameters:

XI, Yl - coordinates of the window's lower left vertex

X2, Y2 - coordinates of the window's upper right vertex

Method: The differences X2-X1 and Y2-Y1 are checked. If either of the

differences is equal to zero, the difference is set equal to one. The

routine then calculates the transformation which maps objects from

the user's window to the device's world space. The viewport defaults

to the entire viewing surface.

- 31 -
DELAY

Purpose: to delay for hard copy units

Usage

:

Call DELAY(N)

Description of Parameters:

N

- the number of seconds to delay

Method: This routine calls the system routing WAIT for the Tektronix and. the

Matrix camera.

-32
DEVICE

Purpose; to initialize a device

Usage: Call DEVICE(N)

Description of Parameters

:

N - defines a device

= 1 - Calcomp

= 2 - Printer

= 3 - Lexldata

= 4 - Textronix Console

= 5 - Empty Slot

Method: If a device is already open, execution of the program is terminated.

Otherwise, the desired (device) file is connected to a unit. The

device defaults to the printer if the specified number "n" does not

correspond to an existing device.

33 -
DEVINP

Purpose

:

to get a coordinate triplet from an input device.

Usage

:

CALL DEVINP (INPUT, MASK, STATUS, X, Y, Z)

Description of Parameters:

INPUT - input device: 1 = joystick; 2 = tabet; 3 = keyboard.

MASK - button select - by power of 2.

1 = button 1

2 = button 2

4 = button 3

8 = button 4

STATUS - returns a value corresponding to MASK for the button pushed.

X,Y,Z - cordlnate values returned. For two-dimensional

devices, Z is always 0.

- 34 -
ENDFRM

Purpose: to close the graphics device

Usage: Call ENDFRM

Method: Closes logical units associate with DEVICE, Normally these are units

7, 8, and 9. This routine does not empty the I/O buffer but does

send disconnect sequences and, for screen devices, erases the screen.
ENUMBR

Purpose

:

to draw a real decimal number expressed with powers of 10 such that

the mantissa is between 1 and 10, i.e. , y^lO*^ where 1 < |y| < 10

Usage: Call ENUMBR (XNUMBR, XI, Yl, X2, Y2)

Description of Parameters:

XNUMBR - number to be plotted in exponential format

XI, Y1 - starting point (lower left corner) of the first character drawn

X2, Y2 - terminating point (upper right corner) of the last character

Method:

drawn

A real number, not equal to zero, is normalized between 0 and 10.

Then ENUMBR plots this portion as scaled by the starting and terminating points (XI, Yl) and (X2, Y2). The characters "10*" are then

plotted, followed by a superscript containing the normalizing power

of 10.

- 36 -
ERASE

Purpose: to erase the screen

Usage: Call ERASE

Method: This command is ignored for the Calcomp. For display devices a simple erase sequence is sent.

-37 -
FILTYP

Purpose: to define the appearance of the interior of polygons and circles

Usage: Call FILTYP(N)

Description of Parameters:

N - the number corresponding to a desired fill type

Method: There are 9 fill types (0-8) for devices supporting filling patterns.

The current devices, except for the Calcomp, support these patterns.

Figure (4) shows the fill pattern numbered from 0 on the lower left

to 8 at the upper right of the figure.

figure 4

~38 -
FNUMBR

Purpose: to draw a real number in FORTRAN F format

Usage: Gall FNUMBR (X, Y, DX, DY, SX, SXY, SY, XNUMBR, IWIDTH, NDIGIT)

Description of Parameters:

X, Y - starting point (lower left corner) of the first character to be

drawn

DX - increment added to the X-coordinate for each character drawn

DY - increment added to the Y-coordinate for each character drawn

SX - X space size for the characters

SXY - slant modifier for characters

SY - Y space size for the characters

XNUMBR - number to be plotted in F format

IWIDTH - total width of field including decimal point

NDIGIT - number of places to the right of the decimal point to be drawn

Method: The input "XNUMBR" is scaled to include the specified number of

places to the right of the decimal point. Each digit in the number

is converted to a literal character. Leading zeros are converted to

blanks and the decimal point is inserted if NDIGIT is greater than

zero. The subroutine WDDRAW is called to plot the literal data

string. The parameters X, Y, DX, DY, SX, SXY, and SY have the same

meaning as in WDDRAW.

- 39 -
FRAME

Purpose: to force out the contents of the buffer

Usage: Call FRAME

Method: This call should be used to terminate each series of graphics

sequences. It is used to insure that the I/O buffers are empty and

to synchronize the timing of the I/O channel.

40
GRAFIT

Purpose: to set up a graph (X and Y axis) for plotting data

Usage: Call GRAFIT (NPLT, XI, X2, XIR, X2R, XXI, XX2 , Yl, Y2, YIR, Y2R, YYl,

YY2, XTIT, NDVX, YTIT, NDVY)

Description of Parameters:

NPLT

XI, X2

X1R,X2R

- number of the plot referenced (up to four graphs may

be placed on one graph)

- labels of X-axis minimum and maximum, respectively.

(The literal string 'NONE' produces no label.)

- user space value of X-axis minimum and maximum,

respectively

XXI, XX2 - minimum and maximum values, respectively, of X in

data to be plotted

Yl, Y2 - labels of Y-axis minimum and maximum, respectively.

(The literal string 'NONE' produces no label.)

Y1R,Y2R - user space value of y-axis minimum and

maximum, respectively

YY1,YY2 - minimum and maximum values, respectively, of Y in data

to be plotted.

XTIT - char - title for X-axis (less than 30 characters and terminated

by 'I.')

NDVX - number of Intervals to be drawn on X-Axis

YTIT - char - title for Y-axis (less than 30

characters and terminated by *

j •

'

)

NDVY - number of intervals to be drawn on Y-axis

There are three additional entry points: PLOTCH, PLOTLN and GRISET.

PLOTCH (NPLT, X, Y, NP CHAR) - where NPLT is the corresponding

plot number

PLOTLN (NPLT, X, Y, NP) - (See above), X and Y are coordinate

arrays, NP is the number of points to

plot (or connect) and CHAR is a character in CHARACTER *1 format

GRISET (XL, YL, XR, YT) - see DEFINE

-41 -
HDCOPY

Purpose: to generate a hard copy

Usage: Call HDCOPY

Device Associated Hard Copy

Calcomp - Printer - Lexidata Camera

Tektronix Activates screen copy unit

Method: This command is ignored for the Calcomp and the printer.

-42 •
HHDRAW

Purpose: to draw a particular character of a specified character set

Usage: Call HHDRAW (X, Y, SX, SXY, SY, ICHAR, NSET, lERR)

Description of Parameters:

X, Y - starting point (lower left) of the character to be plotted

SX - X space size for character (user coordinate system)

SXY - slant modifier for character

SY - Y space size for character (user coordinate system)

ICHAR - index to specify characters within the chosen set

NSET - number specifying a particular character set

lERR - error flag

= 0 - no errors

= 1 - error in accessing set or character

Method: If the desired character is from the hardware set, then the

subroutine SYMBOL is called to plot the character. For characters

from other sets, HSETS is called to place the character's coordinates

and pen values in arrays and then LINES is called to plot the

character as a set of connected strokes.

-43 -
lOWAIT

Purpose: to put a pause in the program

Usage: Call lOWAIT (N)

Description of Parameters:

N - number of milliseconds to pause

Method: This routine calls the system routine WAIT.

_ 44_
LABEL

Purpose: to draw a character string of a specified width and height (i.e., a rectangular area) at a specified location

Usage: Call LABEL (CHARS, XI, Yl, X2, Y2, ANGLE)

Description of Parameters:

CHARS - CHARACTER * 1 ARRAY - character string to be drawn

XI, Yl

X2, Y2

ANGLE

- lower left starting point of string

- upper right ending point of string

- angle (radians) by which to rotate the

string. [A positive (negative) angle causes

a counter-clockwise (clockwise) rotation

about the point (XI, Yl)].

Control Sequences: See Appendix B

Method: This routine calls the subroutine WDCOUNT to determine if the string

contains characters. If characters exist, LABEL calculates the space

size of the characters and calls the subroutine WDDRAW to plot the

text.

- 45 -
LINE

Purpose: to draw a line between two given points

Usage: Call LINE (XI, Yl, X2, Y2)

Description of Parameters:

XI, Yl - coordinates of first point

X2, Y2 - coordinates of second point

Method: The routine transforms the points from the user space to the raster

space. Subroutine PUTLNV is then called to generate a line segment

to connect the points.

-46 -
LINES

Purpose; to draw lines between points in an array

Usage; Call LINES (XI, Yl, X2, Y2,N)

Description of Parameters;

XI, Yl-array - starting coordinates of the lines

CM X! Y2-array - ending coordinates of the lines

N - number of line pairs; [Xl(i), Yl(i)] [X2(i), Y2(i)]

Method; The routine transforms the points from the user space to the raster

space. Subroutine PUTLNV is then called to generate line segments to

connect corresponding points.

- 47 -
LINWID

Purpose: to define the line width for plotting

Usage: Call LINWID(N)

Description of Parameters:

N - the number of strokes when drawing a line - not Implemented

for CALCOMP

Method: This routine sets the number of strokes for each line. (The

strokes are drawn one pixel apart.

)

- 48 -
LNPLOT

Purpose: to draw lines between selected points of an array

Usage: Call LNPLOT (X, Y, 11, 12, 13)

Description of Parameters:

X - array - X coordinates of data

Y - array - Y coordinates of data

11 - index of first point to be connected

12 - increment at which points are to be selected to plot

13 - index of the last point in the data array

Method: The selected points are stored in new arrays and the subroutine LINES

is called to generate each of the lines.

- 49 -
NEWFRM

Purpose: to erase the screen and initialize a new frame

Usage: Call NEWFRM

Method: Device dependent but in general clears buffers and initializes

pointers.

- 50-
PLYGON

Purpose; to draw a closed polygon

Usage: Call PLYGON (X,Y,N)

Description of Parameters:

X - Y

- N

array - X coordinates of the data

array - Y coordinates of the data

- number of vertices in the polygon

Method: The routine generates commands to transform coordinates from the user

space to the raster space. It then generates commands to plot the

polygon starting and ending at vertex (X(l), Y(l)).

- 51 -
SCALNG

Purpose: to define the window and the viewport

Usage: Call SCALNG (XI, Yl, X2, Y2, XIH, YIH, X2H, Y2H, XIS, YIS, X2S, Y2S)

Description of Parameters:

XI, Yl - lower left corner of the window (user coordinates)

X2, Y2 - upper right corner of the window (user coordinates)

XIH, YIH - lower left corner of viewport (device coordinates)

X2H, Y2H - upper right corner of viewport (device coordinates)

XIS, YIS - lower left corner of world (world coordinates)

X2S, Y2S - upper right corner of world (world coordinates)

Method: Calculates the transformations to map objects from the user's window

into the device's world and then into the viewport.

- 52 -
SETDEV

Purpose: to change logical units

Usage: Call SETDEV (Nl, N2)

Description of Parameters

:

Nl - logical unit for graphics output (0- ; default = 7)

N2 - logical unit for diagnostic output (1- ; default = 0)

Default Device Assignments

:

LU Result

Diagnostics 0 no output

Graphics 7 normal - assigned

Camera* 8 assigned with Lexidata

Character set 0 unit zero-assigned

Cal comp L7: RS232 line

Printer PR: whatever

Lexidata LEX: DMA (L34DVR in system)

Matrix camera L14: RS232

Tektronix C: console

Open slot NULL: bit bucket

Console input 5

Character set 9 (closed then opened)

Tablet input* 8 (closed then opened)

*Note: Camera and tablet cannot be active simultaneously

' 53 *-

SETLUT

Purpose: to set color look-up table

Usage: Call SETLUT

Method: The default color look-up table is shown in Fig. (5) for the Lexidata

8100 . SETLUT is not currently used. It exists for users who must

define look-up tables on other systems.

FIGURE 5

-54 -

SURFAC

Purpose: construct and plot data surface

Usage: Call SURFAC (Z, NX, NY, MODE)

Description of Parameters:

Z - ARRAY (NX, NY) - data to be plotted as a surface

NX - dimension and range of i in Z(i,j)

NY - dimension and range of j in Z(i,j)

MODE - specifies the surface to plot

MODE = 1: upper surface

MODE = -1: lower surface

This subroutine and its entries construct and display plots of a surface

function (two dimensional) with the hidden lines removed. The appearance of

the plot is quite flexible and can Include skirts around unobservable portions. It is possible to show just the upper or just the lower surface, or both together. The surface must be approximately horizontal.

SFRAME (MODE) - shows rectangular parallelpiped plotting

region.

SSKIRT ( Z, NX, NY, MODE) - draw skirts around the plotting region

(See figure 6) - uses hidden surface

algorithm, so should be called last

SRFSET (X,Y, Z MIN, Z MAX, NX, NY) - initiates the plotting region

THE GEOMETRY FOR "SURFAC" PLOTS

- 55 -
SYMBOL

Purpose: to draw a specified hardware character centred at a given point

Usage: Call SYMBOL (X, Y, CHAR)

Description of Parameters:

X, Y - location at which to plot the character

CHAR - CHARACTER*! - character to be plotted

Method: The routine transforms the center point from the user space to the

raster space. Subroutine PUTCH is then called to generate the

commands to plot the character.

- 56 -
VOLUME

Purpose: To draw a two -dimens ion projection of a 3-dimensional array;

simulates effect of "3D"

Usage: Call VOLUME (MODE, F, NX, NY, NZ, CLEVE, NCL, T, NT)

Description of Parameters:

F - ARRAY (NX, NY, NZ)

NX

NY

NZ

T - ARRAY (NT, NT)

NT

CLEVE

MODE

ABS(MODE) = 1:

ABS(MODE) =-2:

MODE < 0:

MODE > 0:

NCL

three-dimensional figure to be plotted

range and dimension of i in F(i,j,k)

range and dimension of j in F(i,j,k)

range and dimension of k in F(i,j,k)

plotting array (boolean) to eliminate hidden

lines

dimension of the array T: T(NT,NT)

contour surface level for plotting

specifies the surface to be plotted

plot contour level "CLEVE" in each plane;

fix hidden line matrix, T

find hidden line matrix, T, without plotting

"outside" is less than "CLEVE"

used when the value of the function on the

"outside" is greater than "CLEVE"

number of pairs of (MODE, CLEVE) to be plotted

Method: Contours a Function F(See above) in three dimensions and projects the

resultant plots onto a two dimensional plotting surface. Auxiliary

entries are

VOLSET (X,Y,T,NT) - initialize the plot

VOLFRM (MODE) - MODE = 0 = corner vertices

- Mode = 1 = surrounding box

- 57 -

A three dimensional interpolation by triangular tesselation is used to

find the contour crossing points. The technqiue is similar to that used in

CONTUR. Once again, the hidden pixel (frame buffer) is filled as the figure

is scanned back to front. A sample showing two overlapping spheroids and a cylinder is shown in Fig. 7. The functions plotted are

Cylinders: F = (X-10.5)2 + (Y-3. 5)^

Sphere : p, _ 10

(X-8)2 + (Y-10.5)2 + (Z-10.5)^

V 20

If 2~

(X-13)2 + (Y-10.5)2 + (Z-10.5)2

FIGURE 7
*.' « httMk

Hi t .R... o;»

' '-'ll.' Vfi 1 IMI I.-*!.

w- ' '"".V''" M 49«I-5^S¥I>:

,J, _. Sf’-.s':^ *^,«s^a.s

hiVl^Hk
WDDRAW

Purpose; to draw a character string

Usage; Call WDDRAW (X, Y, DX, DY, SX, SXY, SY, CHARS)

Description of Parameters;

X, Y - starting point of the character string (the

string is plotted to the right of (X,Y) unless

otherwise indicated by a control character)

DX - increment to be added to the X-coordinate

for each character drawn

DY - increment to be added to the Y-coordinate

for each character drawn

SX - X space size for characters (user coordinate

system)

SXY - slant modifier for characters

SY - Y space size for characters (user coordinate

system)

CHARS - CHARACTER * 1 ARRAY - character string to be drawn

Control Sequences - See Appendix B

Method; This routine scans the string for control characters and text

characters. When a text character is found, the corresponding

character number is obtained by the function IDCHAR. The set number

assumes the default value unless the number was changed by a control

character within the string. The routine also executes scaling,

shifting, and rotating transformations in order to determine the

starting positions of the characters. Finally, the subroutine HHDRAW

is called to plot the text characters.

- 59 -
APPENDIX B

Control Sequences for WDDRAW, LABEL, and ALABEL

The control sequence is "| " followed by an editing character which is one of

the following;

L - justify the text to the left

M - center the text

R - justify the text to the right (default)

Hnn - change from default character set to set nn

U - draw the following characters in superscript

D - draw the following characters in subscript

0 - reset character size and placement from superscript or subscript to

original size

B - backspace over last character drawn (works only for one character,

multiple backspaces will produce unpredictable results.

)

Cnn - change from the default color to color nn

. - end of character string

-60
123

4

5

6

78

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

APPENDIX C

Alphabet Style Size

Roman (Hardware characters)

Roman Cartographic

Greek Cartographic

Roman Simplex Print

Greek Simplex Print

Script Simplex Print

Roman Complex Index

Greek Complex Index

Italic Complex Index

Roman Complex Print

Greek Complex Print

Italic Complex Print

Script Complex Print

Roman Duplex Print

Roman Triplex Print

Italic Triplex Print

German Gothic Print

English Gothic Print

Italian Gothic Print

Cyrillic Complex Print

Miscellaneous

Miscellaneous

Miscellaneous

Miscellaneous

- 61-
Set

Number

CT> c X o

00 CD O £ • \ A

01 - — > It « V

CD o O (0 - o ift II m

Ll. Q_ M - - & + —

LU O — (0 1 ^ 1

ro Q X - c c- w .

CM O z; O) cf

. i»»

1 — CD -- > - Q. N i_J

o 3 <p O •tf

62 -
Set

Number

~J h +

CN

(D - V) (3 1

^ I a

10 o a

m ii. 0. N

liJ o >

n Q z X “ ^

(N u 2 ^ • \

t- m j > » * t

0<XDV>1|:

63 -
Set

Number

® h

- W

I Ol

L.

C N

y o

<J Z X

III 2 C

m < €•

< X ^

-64-
Set

Number

(D-^h-X) C X

0O-(/) 0^5 -\A

>=#=* V

CD O O 0 ^ 34^ 11

:

If) L_ CL N — @ H

^LlIO) I'—'I

nOZXil c

(MO CnCT -1—1

^CQ_I>'^- ClU

O < Y D 0) 0 X --z-N-

-65-
Set

Number

O I- O X

-N'»^:l3 -\A

Z Z Q3-K S~=fl= * V

L

II

:

CN<?i b@+—

Ld O b I I dZX

I'I2G X

QQ d 0" ^

“—I^

d Z ^ W O • • /~s*

-66-
Set

Number

^

^ -\A

i=ft=*V

II

=

t*a

^ @ H

eoe)>-^ ^ I -- I

Qj ^ ^ d«> — I—

I

- 67 -
Set

Number

0) h -d a X 'w'

CO 1—

1

CO 0

g

« \ A

M V

<0 0 O' 11 -

10 N @ + —

0 fX •rt CO

1 1

CO Q jz; c- C

C\2 0 S

. 4fe»«

1

H m 1-1 > <M A N « K

o <! M Q 0 • «

68-
Set

Number

® H <0 X

W i 3

ffi Pk

^ X 3*

U ^ ^ ?

C N ^ b

w 0 b

< Z X ^ ^

W S G ^

ffl <! •6* t

<J M ^

to 0

- 69 -
Set

Niiiube

h »

s 0 $

« \ A

g; x> ? =11: a V

0^ 8 3 11 -

ft, N •c^ M § + —

o l^ •e W 1 q

0 0l -* -

q •<i s A ^i « -

li Q> 0 >

« «

c

K

-70-
Set

Number

10

Oi E-i Ti fl X

•X.A

OOO* (0^ ^34^ 11

:

iD N •'^+J @ H

1--1

%

COQIZIX^

C\JUl^^ tlOD" -r-1

^

ffl i-J ^> *H fl^ N • -I 1//

^ 0

- 71 -
Set

Number

11

© E-i K) X

i-t W 'V ^ 3 A

1UPlhQ2.X ^=}fc* V

II

:

b@+—

W O b 0^ I ^

<ZX PQ.^0-—

c

PQ <] t0< V • -I—I

/

•<1

^

Co 0

- 72 -
Set

Number

12

sCo o

^ ^ -\A

!l:|Q:;-o'^ V

CiO> '^m- II

:

Ct, c^'w (§) -(

O ^ ^ ^ ^ 1

o ^

0) —(—I

pqk:];^SP,n - -I—/

1^ b <i) O ^

••/^-

- 73 -
SeL

Numb

0 I § .\a

N ^ ^ ^

i =ffc* V

esi 54^ II

;

lO t?) tJ^ •^i^'si @ -|

^ ^

Q) ^ 4 I /-^

I

C\JS3^^ *--r—

I

^ ^ -'—

/

O ^ ^ ^ 6 ^••'^'

- 74 -
Set

Number

i^t

0) “) h- "D C X

co-(n 0 E ^ -XA

N I Qi XI

“ >^4 V

(DOO 0 34©= ii :

If) Ll Ql N —H- @ + —

rOQZXi: c

D)CT -I—

I

^

DQ —1 > Q. N • *1—I/

0<YD © 0 >s--/-N-

- 75 -
Set

Number

lb

05 *-5 h Tl ^

CO CO 0 ^ ^ ‘\A

K K i£ V

coOcy 0m II

tfD fe Oh N •in4^ @ -|

Wo^ I-—>(

COQ^X^

mu*

^

PO hO ^ ^

0^ N • •'\—iy/

o<i3;a^

I

d qj 0

- 76-
Set

Number

16

Oi S h ^

QQ N Co O

^ ^ "\A

NJCjO^iO'^ V

^=§1= II

'

^0 fe, @ "i

>C;^O^i-c^ co<^ I--J

•^•1—

I

>* U 'S Ji, N • -I—1/

O b W 0 ^

- 77 -
i

f

aociuiitN

IDS

tot*?® « g S -\A

•fi-^'S- V

iQ® «** 3:^ |(

*(§) ~l

n Q S; W ^

fUts)^^ ac *-1—!'«

S ^ *^ '^ *^ * *“‘—

*

/

Q ^

J3

^ Q O' <*-^*

- 78-
Set

Number

18

^ S 5 *"\

A

J3-» s=fe* V

tlj^§'t3 jtf S4& II

:

If) ^ @ -)

^

lit © SR*** w ^I I n ^ ^ X -E^ ^

c

W9^i cper

fl.N -i—1 /

Q S * Q jj)«</^*

- 79-
Nuinlier

J9

tj) ^ ^ ^ C X

^

g 3 ‘\A

N)Q(2!i^— V

(G >3 >1^ II

in 01 Q( SO-—^ @ +

rf^on- I — I n 0 Q M ^ ^ 0*'-^ f

a. f^ * *1 I^

Q ttOsS D ** ® sn

-80-
Set

Number

20

)S >»(0 n 0 3

SEhhJQ ^

nu2 C ^

t[0 g

wcB’t. w 5-

t[o 9 ffl

K X K

wt::><jK)S >v(5

<^^ 9, s H

-81 -
St*.L

Number

2L

n =

111 ) t ^-i- ( 3 - u ' w 8 • 2 U

II ' C '©5 X ^

t

^

< n s H- All •

- " • i 3 > -H VII -

* * x8u^-|-/\”

•

• H- /Ml - <0

i V *

* \| -H VII ' -» =

III ) U

0 —)

+ A « i —'ll, / C

- = I V -

II

' n

-82 -
Set

Number

22

ff c c, > ^ 0

lb te> <D 0 W f*

0 G'-^ iy n W Co

» * '—'9- & i

0 w I—1(1) 10 t wx* >K

m m 1—j(D «» 8

^8

44 ^

K (S Vw^O g ^^0 (^

«« r WS« iO>CH- # ^

-83 -
Set

Number

23

%/ z

i +

*-

cl

* ^ / / n ^

-K

t — • o A 0

) \

(

^ <

4 ) 1 «-( vD^/ il 0 4 4

c8>c12!/))o [)«iCO

<> < 8—^ |l‘* O

O«oo \ j I [

-84-
Set

Number

24

• JT (*\0l 1 itni: OL

-85-
APPENDIX D

The following is a description of each BUILD command. The prompts

associated with each command and the format of the user's response are indicated.

Note: When specifying a command, at least two letters of each word must be

entered (e.g. AD PO means ADD POLYGON).

-86-
1. ADD

Elements are added to the arrays.

1.1 ADD VERTEX

ENTER (X,Y,Z) COORDINATES AND SELECT BUTTON

BUTTON 1 (KEYBOARD = '1') — ENTER VERTEX

BUTTON 2 (KEYBOARD = ’2')— QUIT

If the input device is the joystick or the tablet, the vertex is selected with

the picking implement and then button 1 is pressed. If the keyboard is used,

the prompt

X,Y,Z,IDV=>

appears. Three real numbers, followed by the number 1, are entered. These

numbers are separated by commas or spaces.

In both cases, the X,Y,Z coordinates of the vertex are stored in the VERTEX

array. Vertices are added until the VERTEX array is filled or the user wants

to quit. In order to quit, button 2 is pressed. At the keyboard, any three

numbers, followed by the number 2, will terminate the process.

(Alternatively, three commas followed by the number 2 can be entered: ,,,2)

1.2 ADD EDGE

BY VERTEX NO. (1) OR COORDINATES (2)?

An integer is entered. The number 1 is entered if the edges are to be

composed of vertices in the VERTEX array. The number 2 is entered if the

edges will be created from new vertices.

If the first method is chosen, there will be the prompt

ENTER ENDPOINTS — 2 VERTEX NUMBERS

TO QUIT HIT <RETURN> OR ENTER ’QUIT'

VETEX NUMBERS:

Two integers, separated by a comma or space, ar entered. These numbers,

indicating the vertices which define the edge, are stored in the EDGE array.

The user is prompted for another edge by

VERTEX NUMBERS:

The process continues until the EDGE array is filled or the user has finished

adding edges.

If the second method is selected (i.e. new vertices will be chosen), tlie user is prompted

ENTER 2 ENDPOINT COORDINATES:

BUTTON 1 (KEYBOARD = '!') — ENTER VERTEX FOR EDGE

BUTTON 2 (KEYBOARD = '2') — LAST VERTEX FOR EDGE

BUTTON 3 (KEYBOARD = '4') -- QUIT

- 87 -
The vertices are specified as in ADD VERTEX. The first vertex of an edge is

followed by button 1 ('1* on the keyboard) and the second vertex is followed

by button 2 ('2* on the keyboard). The new vertices are added to the VERTEX

array and the new edge is added to the EDGE array. Additional edges can be

created until the VERTEX or EDGE array is filled or the user wants to quit.

Button 3 ('4' on the keyboard) is used to terminate the process.

Note: In both cases, if a newly formed edge exists in the EDGE array, this

element will not be stored again. A message will appear to inform the user of

the condition.

1. 3 ADD POLYGON

Polygons are added in the same manner as edges except that at least three

vertices are needed to define a polygon. Also, there is a limit of NPVERT

vertices for a polygon. Polygons can be created from existing vertices or from new vertices. When entering new vertices, button 1 ('1* on the keyboard)

is pressed after each vertex except the last one in a polygon. This last

vertex is followed by button 2 (’2' on the keyboard). Finally, button 3 ('4' on the keyboard) terminates the process.

New polygons are added to the POLY array provided that they don't already

exist in the array. (Messages will appear to indicate existing polygons. ) Any new vertices will be added to the VERTEX array.

2. ANIMATE

A sequence of frames is specified. This sequence is viewed with DISPLAY.

NUMBER OF FRAMES

An integer is entered to indicate the number of frames.

TOTAL TRANSLATION CHANGE (DX,DY,DZ)

Three real numbers separated by commas, are entered. These numbers indicate

the total displacement of the model in the X,Y,Z directions.

TOTAL ROTATION CHANGE (DX,DY,DZ)

Three real numbers, separated by commas, are specified. The model can be

rotated about a point (specified in the next step) with respect to X',Y’,Z'

axes. These axes pass through the specified point and are parallel to the

X,Y,Z axes of the coordinate system. The three numbers entered indicate the

angles (in degress) of rotation about the X',Y',Z* axes. Note that the rotations will be made in he X',Y*,Z* order.

RELATIVE ORIGIN

The point about which rotations occur is specified. The center for the model

is chosen by hitting the <RETURN> key. A different point is chosen by

entering the appropriate X,Y,Z coordinates. The coordinates are entered as three real numbers separated by commas.

-88 -
DISTANCE TO ORIGIN (DELTA)

A real number indicating the total change in the observer's position, is

entered. A positive number moves the observer along the Z-axis in the

negative direction (i.e. away from the viewing surface). A negative number

causes the observer to move in the positive direction along the Z-axis.

SCALE FACTOR

A positive real number is entered. If the number is greater than one, the

model is magnified. The model is reduced if the number is less than one.

MOVE EDGE(S)

There are several acceptable formats for the response:

nn-m

nn BY X,Y,Z n-m BY X,Y,Z n- BY X,Y,Z

One edge (n) or a group of edges (n-m) may be moved. Note n- represents all

the edges from n through the last element in the EDGE array. n and m are entered as positive integers. The relative displacement vector is specified

by the real numbers X,Y,Z. If this displacement vector is not specified, the

user is prompted for it.

MOVE POLYGON(S)

One polygon (n) or a group of polygons (n-m) may be moved by a distance X,Y,Z.

The specifications are entered in the same format as for MOVE EDGE(S).

Note: Any of these transformations are omitted from the animated sequence by

hitting <RETURN> after a particular prompt.

3. AUTO

The window and observer are moved so that the entire model appears in the

field of view. This command is particularly useful if the location of the

model outside the window becomes unknown to the user. New parameters are calculated by AUTO. A display does not automatically follow. The DISPLAY

command must be used to view the model.

Note: The scaling of the model may be altered as a result of using AUTO. It

may be necessary to compensate for this change by using the SCALE command.

4. COPY

The switch for hard copy of the graphics display is set.

-89 -
4.1

COPY ON

NO. OF COPIES

An integer is entered to indicate the number of hard copies of each display to

produce. This number defaults to one (1) if the <RETURN> key is pressed.

Following each graphics display on the output device, hard copies, associated

with this device, are generated.

4.2

COPY OFF

The automatic generation of hard copies after each graphics display is

discontinued.

Note: At the start of program execution, the copy switch is set off.

5. DELETE

Elements are deleted from the arrays.

5.1 DELETE VERTEX

Vertices are not actually deleted from the VERTEX array. Instead, these

"deleted" vertices are made unavailable for displaying and for constructing

edges or polygons. Vertices are deleted from the array with the SQUEEZE

command.

ENTER VERTEX LINE NUMBERS

HIT <RETURN> OR ENTER 'QUIT' WHEN DONE

VERTEX n=

There are three formats for entering vertices:

nn-m

n- where n and m are positive integers. One vertex (n) or a group of vertices

(n-m) may be deleted. n- repesents all the vertices from n through the last

element in the VERTEX array. Once these vertices are deleted, the user is

prompted for other vertices to delete with

VERTEX n=

This process is repeated until all vertices are deleted or until the user

has finished.

5.2

DELETE EDGE

ENTER LINE NUMBERS.

HIT <RETURN> OR ENTER QUIT' WHEN DONE

LINE NUMBER(S):

One edge (n) or a group of edges (n-m) may be deleted. These specifications

are entered in the same format as the DELETE VERTEX, The user is prompted for

LINE NUMBER(S): until the EDGE array is empty or the user is done.

-90-
5.3

DELETE POLYGON

ENTER LINE NUMBERS.

HIT <RETURN> OR ENTER ’QUIT’ WHEN DONE

LINE NUMBER(S):

One polygon (n) or a group of polygons (n-m) may be deleted. These

specifications are entered in the same format as the DELETE VERTEX. The user

is prompted for LINE NUMBERS: until the POLY array is empty or the user is

finished.

6.

DEVICE

At the begining of program execution, the output device for graphics display

defaults to the Lexidata. DEVICE is used to select a new default device. The

possible selections are

I

CALCOMP

PRINTER

I (default = LEXIDATA)

LEXIDATA

j CONSOLE 1

7.

DISPLAY

Array elements are displayed in graphics mode.

7.1 DISPLAY VERTEX

Each vertex in the model is displayed and labelled with its vertex number.

7.2 DISPLAY EDGE

The model’s edges are displayed.

7.3

DISPLAY POLYGON

The model’s polygons are displayed.

7.4

DISPLAY [ALL]

All the edges and polygons in the model are displayed.

8.

DUPLICATE

Elements are duplicated at other locations. The new elements are added to the

array.

-9L-
8.1 DUPLICATE EDGE

WHICH EDGE(S)?

The specifications for duplicating edges are entered in one of several ways:

nn-m

nn BY X,Y,Z n-m BY X,Y,Z n- BY X,Y,Z

where n and m are positive integers and X,Y,Z are real numbers. One edge (n) or a group of edges (n-m) may be duplicated. n- represents all the edges from

n through the last element in the EDGE array. The displacement vector is

specified by X,Y,Z. If this vector is not specified, the user is prompted for

it. Edges can be duplicated until <RETURN> is pressed or QUIT is entered.

8.2 DUPLICATE POLYGON

WHICH POLYGON(S)?

One polygon (n) or a group of polygons (n-m) may be duplicated. The

specifications are entered in the same format as for DUPLICATE EDGE. The

process of duplicating polygons can be terminated by hitting <RETURN> or entering QUIT.

Note: In DUPLICATE, the displacment vector can be entered using a type of

shorthand. A zero may be represented by a blank or by no character at all.

e.g. long form

10 , 8,0

0,7,0

0 , 0,6

1,0,3

short form

10,8

,7

, ,6

1,,3

9. END

The graphics display screen is erased. Execution of BUILD is terminated.

10. ERASE

The graphics display screen is

CALCOMP.

erased.

11 .

Note:

EXIT

this command is ignored for the

The command source is changed to the console.

- 92-
12 FIELD

The field of view is altered by moving the observer and changing the angle of

view.

CURRENT DISTANCE TO ORGIN: x. xx

NEW DISTANCE TO ORIGIN?

A positive real number, X, is entered. The observer is positioned at the

point (0,-X); i.e. X units in front of the viewing surface.

CURRENT ANGLE OF VIEW; x. xx

NEW ANGLE OF VIEW?

The angle is measured in degrees. A positive real number in entered.

13.

GET

A structure file is opened. Elements are read into variables and arrays.

This file becomes the new INFILE.

GET FILENAME

The specified file is opened and read.

GET

The INFILE is opened and read. If there is no INFILE, the user is prompted

for a filename.

14. HELP

The BUILD commands and their functions are listed at the console. Only a portion of the list appears followed by

CONTINUE? Y/N

Either the letter Y (for yes) or the letter N (for no) is entered. The

remaining commands are listed if Y is entered. Nothing else is listed if N i entered.

15. INPUT

The command source is changed to a specified file. Possible formats are

INPUT filename

or INPUT

The user is prompted for a filename in the latter case.

16. LIST

The array elements and/or the transformation matrix are Listed at tlie console

- 93 -
16.1

LIST VERTEX

The world and window coordinates are listed. The user is prompted for the

vertices to list:

WHICH VERTICES?

There are three formats for entering vertices:

nn-m

nwhere n and m are positive integers. One vertex (n) or a group of vertices

(n-m) may be listed. n- represents all the vertices from n through the last

element in the VERTEX array. The user is prompted for more vertices with

WHICH VERTICES?

This process is repeated until the user hits <RETURN> or types QUIT.

16.2

LIST EDGE

Only the model's edges are listed.

WHICH ELEMENTS?

One edge (n) or a group of edges (n-m) may be listed. These specifications

are entered in the same format as in LIST VERTEX. The user is prompted for

edges until <RETURN> is pressed or QUIT is entered.

16.3 LIST POLYGON

The model's polygons are listed.

WHICH ELEMENTS?

One polygon (n) or a group of polygons (n-m) may be listed. These

specifications are entered in the same format as in LIST VERTEX. The user is

prompted for polygons until <RETURN> is pressed or QUIT is entered.

16.4 LIST MATRIX

The transformation matrix is listed.

17. MOVE

Elements are moved to new locations.

-94-
17.1

MOVE VERTEX

VERTEX n =

There are several possible formats for response:

nn-m

nn TO X,Y,Z

n BY X,Y,Z n- BY X,Y,Z

One vertex (n) or a group of vertices (n-m) may be moved. Note: n- represents all the vertices from n through the last element in the VERTEX

array. n and m are entered as positive integers. Vertices may be moved by a distance relative to the origin; the displacement vector is given by (X,Y,Z).

In addition, a single vertex can be moved to a specific point (X,Y,Z). In

both cases, X,Y,Z are entered as real numbers. If the input consists of only

the vertex number(s), the user will be prompted for a relative displacement

vector. This process of moving vertices will continue until <RETURN> is

pressed or QUIT is entered.

17.2

MOVE EDGE

MOVE EDGE(S)

The specifications for moving the edges are entered in one of several ways:

nn-m

nn BY X,Y,Z n-m BY X,Y,Z n- BY X,Y,Z

where n and m are positive integers and X,Y,Z are real numbers. One edge (n) or a group of edges (n-m) may be moved. n- represents all the edges from n through the last element in the EDGE array. The displacement vector is specified by X,Y,Z. If this vector is not specified, the user is prompted for

it. Edges can be moved until <RETURN> is pressed or QUIT is entered.

17.3

MOVE POLYGON

MOVE POLYGON(S)

One polygon (n) or a group of polygons (n-ra) may be moved. The specifications

are entered in the same format as for MOVE EDGE. The process of moving polygons can be terminated by hitting <RETURN> or entering QUIT.

Note: In MOVE, the displacement vector can be entered using a type of shorthand. A zero may be represented by a blank character or by no character at

all.

- 95-
e. g. long form

10 , 8,0

0,7,0

0 , 0,6

1,0,3

The array elements and/or

short form

10,8

,7

, ,6

1,,3

18. PRINT

the transformation matrix

18.1

PRINT VERTEX

are listed at the printer.

The world and window coordinates are printed. Then all the vertices are

listed.

18. 2 PRINT EDGE

All of the model's edges are listed.

18. 3 PRINT POLYGON

All of the polygons are printed.

18.4 PRINT MATRIX

The transformation matrix is printed.

18.5 PRINT ALL

The world and window coordinates are printed. All of the vertices, edges, and

polygons are listed. The transformation matrix is printed.

19. ROTATE

The model is rotated about a specified point. Rotations take place about

X',Y',Z' axes. These axes passing through the given point, are parallel to

the X,Y,Z axes, respectively, of the coordinate system.

ANGLES? (X,Y,Z)

Three real numbers, separated by commas, are entered. These numbers specify

the angles (in degrees) of rotation about the X', Y', Z’ axes, respectively.

Note that the rotations will be made in the X', Y', Z' order.

RELATIVE ORIGIN? (X,Y,Z)

The point about which rotations occur is specified. The center of the model

is chosen by hitting the <RETURN> key. A different point is chosen by entering the appropriate X,Y,Z coordinates. These coordinates are entered as three

real numbers separated by commas.

After both prompts, the response can be entered using a type of shortA zero may be represented by a blank character or by no character at

Note:

hand.

all.

- 96-
e.g long form short form

10 , 8,0

0,7,0

0 , 0,6

1,0,3

10,8

20.

SAVE

Variables and array elements are written to a file. This structure file is

closed and becomes the new OUTFILE.

SAVE filename

The current work file is saved in the specified file.

The work file is saved in the OUTFILE. If there is no OUTFILE, the user is

prompted for a filename.

21.

SCALE

All the vertices are scaled about the center point of the structure.

SCALE FACTOR?

A positive real number is entered. If the number is greater than one, the

model is magnified. The model is reduced if the number is less than one.

The defaults for line width, color, and polygon filling are chosen.

LINE WIDTH (0-15)

An integer is entered. As the numbers increase, the lines become wider. At

the start of program execution, the default value is 2.

COLOR (1-15)

An integer, corresponding to the desired color, is entered. Initially, the

default value is 1.

FILL TYPE (0-4)

An integer, indicating a particular polygon filling, is entered. At the

start, the default value is 0. (See FILTYP in Appendix A).

SAVE

22.

SELECT

Note: If the default value for an attribute is not to be changed, the

<RETURN> key is pressed after the prompt.
23.

SET

At the beginning of program execution, the input device for data (vertices,

edges, and polygons) defaults to the keyboard. SET is used to select a new default input device. The possible selections are

( KEYBOARD \

SET (JOYSTICK) (default = KEYBOARD)

( TABLET j

24. SQUEEZE

Vertices which were deleted with the DELETE command and vertices which are not

used in any polygon or edge are removed from the VERTEX array. The remaining

vertices are shifted up in the array in order to fill empty slots. The EDGE

and POLY arrays are adjusted to account for the new vertex numbers.

25. STATUS

Some general information concerning the work file appears at the console. The

filenames of the INFILE and OUTFILE are listed. The number of elements in the

VERTEX, EDGE, and POLY arrays are indicated along with the size of each array.

26.

TRANSLATE

The vertices of the model are translated.

TRANSLATE VERTICES BY (DX,DY,DZ)

Three real numbers, separated by commas, are entered. These numbers indicate

the total displacement of the model in the X,Y,Z directions. The numbers can

be entered using a type of shorthand. A zero may be represented by a blank

character or by no character at all.

e.g. long form short form

10,8,0 10,8

0,7,0 ,7

0 , 0,6 ,,6

1,0,3 1,,3

27.

WINDOW

The boundaries of the window are specified.

ENTER THE LOWER LEFT VERTEX;

If the input device is the joystick or the tablet, the picking implement is

used to point to the lower left corner of the window and then button 1 is

pressed. If the keyboard is the input device, then the user in prompted

X,Y,Z,IDV=

- 98 -
Three real numbers, followed by the number 1, are entered. These numbers are separated by commas or spaces. The real numbers specify the X,Y,Z, coordinates, respectively, of the lower left corner of the window. Note: The Zcoordinate is assigned the value zero, regardless of the value entered by the user.

ENTER THE UPPER RIGHT VERTEX:

This vertex is entered in the same manner as the lower left vertex.

28. WORLD

The boundaries of the world space are specified.

ENTER THE LOWER LEFT FRONT VERTEX:

If the input device is the joystick or the tablet, the picking implement is

used to point to the lower left front corner of the box which will be the

world space. Button 1 is then pressed. If the keyboard is the input device,

then the user is prompted

X,Y,Z,IDV=

Three real numbers, followed by the number 1, are entered. These numbers are separated by commas or spaces. The real numbers specify the X,Y,Z coordinates, respectively, of the lower left front corner of the box.

ENTER THE UPPER RIGHT BACK VERTEX:

This vertex is entered in the same manner as the lower left front vertex.

- 99-
APPENDIX E

The following is a description of each TITLES command. The prompts

corresponding to each command, together with the formats of the user's

responses, are indicated.

1. ADD

Character strings are added to a specified slide.

FRAME=

An integer is entered to specify a slide

COLOR=

An integer (1-15) is entered to specify a default color for the new character

strings.

SET=

An integer (1-24) is entered to specify a default character set for the new

text.

INPUT THE STRING

The character string is entered. The character sets and colors used within

the string are modified with control sequences. In addition, control

sequences are used to place subscripts and superscripts in the string and to

change the justification of the text. See Appendix B for a list of these

sequences.

TOGGLE BUTTON FOR LOWER LEFT

The cursor is moved to select the location of the lower left corner of the

string. Once the cursor is set in place, the text is displayed.

DEL(l), M0V(2), CENTER(3), SCALE(4)=

An integer (1-4) is entered:

1 - The string is deleted.

2 - The text will be moved. TOGGLE BUTTON TO MOVE LL CORNER. The cursor

is positioned at the desired location of the lower left corner of the

text. Once the cursor is set in place, the text is moved.

3 - The string is centered on the line.

4 - The text is scaled by a SCALE FACTOR which is specified as a positive

real number.

<RETURN> - The string is not modified.

-100-
Only one correction can be made at a time. The prompt for corrections will

reappear until the string is deleted or the <RETURN> key is entered.

INPUT THE STRING

Another string may be added to the slide. When no other strings are to be

added, the <RETURN> key is entered.

2.

BULLET

A bullet is drawn on a specified slide.

FRAME=

An integer is entered to specify the slide on which the bullet will be drawn.

COLOR=

An integer (1-15) is entered to select the color of the bullet.

TOGGLE FOR CENTER

The cursor is positioned at the desired location of the bullet. Once the cursor is set, the bullet is displayed.

3.

CIRCLE

A circle is drawn on a specified slide.

FRAME=

An integer is entered to specify the slide on which the circle will be drawn.

COLOR=

An integer (1-15) is entered to select the color of the bullet.

TOGGLE FOR CENTER

The cursor is positioned at the location of the circle's center.

TOGGLE FOR RADIUS

The cursor is positioned at the location of any point on the circle. Once the cursor is set, the circle is drawn.

4.

COLORS

All of the available colors are displayed.
5.

CORRECT

The Cext on a slide is corrected one string at a time.

FRAME=

An integer is entered to specifiy the slide which will be corrected. A line

of text is printed at the console, followed by

DEL(l), M0V(2), CENTERO), SCALE(4) =

An integer (1-4) is entered:

1 - The string is deleted.

2 - The text will be moved. TOGGLE BUTTON TO MOVE LL CORNER. The cursor

is positioned at the desired location of the lower left corner of the

text. Once the cursor is set in place, the text is moved.

3 - The string is centered on the line.

4 - The text is scaled by a SCALE FACTOR which is specified as a positive

real number.

<RETURN> - The string is not modified

Only one correction can be made at a time. This prompt for corrections will

reappear until the string is deleted or the <RETURN> key is entered.

The next line of text, along with the prompt for corrections, is displayed on

the console. This process is repeated for each line of the text on the slide.

6.

DELAY

The delay time for the hard copy device is specified. An integer is entered

for this delay time.

7.

END

The program is terminated.

8.

HELP

The TITLES commands are listed.

9.

NEW

A new slide is created. The frame number is incremented. New character

strings are added to this slide as with the ADD command.

10.

LINE

A line is drawn on a specified slide.

FRAME=

An integer is entered to specify the slide on which the line will be drawn.

-102-
COLOR=

An integer (1-15) is entered to select the color of the line.

TOGGLE FOR START OF LINE

The cursor is positioned at the location of one of the line's endpoints.

TOGGLE FOR END OF LINE

The cursor is positioned at the location of the other endpoint of the line.

Once the cursor is set, the line is drawn.

11.

PROCESS

Hard copies of specified slides are generated.

INPUT SLIDE // (0 TO PROCESS. ) AND FRAME COUNT =

Two integers are entered to indicate the slide number and the number of hard

copies, respectively.

INPUT SLIDE# (0 TO PROCESS,) AND FRAME C0UNT=

Another slide may be specified for copying. When all the desired slides have

been specified, a zero is entered. The hard copies are then processed and the

program is terminated.

12.

REREAD

A file is opened and data is read into variables.

RESTART FILE

The name of a data file is entered. A new file may be started by just hitting

<RETURN>.

n SLIDES

FUNCTI0N=

The user is informed of the number of slides in the the data file. A corairuand

is then specified by the user.

13.

SAVE

The slides in the work file are written to a data file. If a data file has

been opened, the slides are written to this file. Otherwise, tlie user Is

prompted for

- 103 -
FILE NAME

The name of the new data file is entered.

14. SET

A character set is displayed.

SET N0.=

A integer (1-24) is entered to select a character set.

15. VIEW

A slide is displayed.

NUMBER=

An integer is entered. This number indicates the slide to be displayed. Once

the image has been generated, the process is repeated with the NUMBER= prompt.

When no other slides are to be displayed, a zero or the <RETURN> key is

entered.

-104 -
Appendix F

PROGRAM G2TEST page 1

SUBROUTINE ANGTST page 2

SUBROUTINE CIRC page 4

SUBROUTINE CUBE page 5

SUBROUTINE MM page 7

SUBROUTINE MM3 page 8

SUBROUTINE SETMAT page 9

SUBROUTINE TRANS page 10

MAIN PROGRAM page 1

1

SUBROUTINE GRAFITl page 12

SUBROUTINE GRAFIT2 page 13

SUBROUTINE RDCNL page 15

SUBROUTINE GRAFIT3 page 16

SUBROUTINE (31AFIT4 page 13

SUBROUT LNE PUT page 19

SUBROUTINE PHASE page 20

SUBROUTINE RUMTST page 21

SUBROUTINE VENTV page 22

SUBROUTINE LAYER page 23

SUBROUTINE FIRE page 24

SUBROUTINE PLUME page 25

SUBROUTINE ROOM page 2b

SUBROUTINE SADDLE page 27

SUBROUTINE SETCOL page 29

SUBROUTINE SYMTST page 30

SUBROUTINE VOLTST page 3 ^ SUBROUTINE FILNGT page 33

- 105 -
I2

34

56

78

9

iO

1

1

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

40

41

42

43

44

45

46

47

48

49

50

PROGRAM G2TEST page I

PROGRAM G2TEST

INTEGER PB(6)

C

C TEST EACH FUNCTION OF THE DEVICE INDEPENDENT PCKAGE

C

C

c

c

c

WRITE(5,1)

WRITE(5, 1)

WRITE(5, 1)

WRITE(5, 1)

WRITE(5, 1)

WRITE(5,1)

WRITE(5,1)

WRITE(5, 1)

WRITE(5, 1)

WRITE(5, 1)

WRITE(5, 1)

WRITE(5, 1)

WRITE(5, 1)

WRITE(5, 1)

I I 'ANGLE r

'CIRCLE 2' 'FLYING CUBE 3' 'GRAFIT(i) 4'

'GRAFIT(2) 5' 'GRAFIT(3) 6'

'GRAFIT(4) 7' 'PHASE SPACE PLOT (CONTOUR AND SURFACE PLOT)

'SINGLE ROOM FIRE 9'

'SADDLE SURFACE iO'

'HARDWARE/ HERS HEY SYMBOLS II' '3D CONTOURING 12'

'POLYGON FILLING 13'

CALL SYSIO(PB,41,5, ' TEST =',7,0)

READ(5,3,END=4,ERR=4) I

GET THE DEVICE

CALL SYSIO(PB,33,5, 'DEVICE=' ,7,0)

READ(5,2) ID

2 FORMAT(I)

CALL DEVICE(ID)

GO TO (201,202,203,204,205,206,207,208,209,210,211,212,

213),

I

STOP 'NO SELECTION'

201 CALL ANGTST

202 CALL CIRC(ID)

203 CALL CUBE

204 CALL GRAFITl(ID)

205 CALL GRAFIT2(ID)

206 CALL GRAFIT3(ID)

207 CALL GRAFIT4(ID)

208 CALL PHASE

209 CALL RUMTST

210 CALL SADDLE(ID)

211 CALL SYMTST

212 CALL VOLTST(ID)

213 CALL FILNGT(ID)

1 FORMAT ( IX, A50)

3 FORMAT(I)

4 STOP

END

C

8

’

- 106-
SUBROUTINE ANGTST page 2

51

52 C

53 C

54 C

55

56

57

58 C

59 C

60 C

61

62

63

64

65

66

67

68

69

70

71

72

73

74 C

75 C

76 C

77

78

79

80

81

82

83

84

85 C

86 C

87 G

88

89

90

91

92

93

94

95 C

96 C

97 C

98

99

100

101

102

103

104

105

SUBROUTINE ANGTST

A SLMPLE TEST OF THE CHARACTER STUFF

CHARACTER*! TITLE(80)

INTEGER PB(6)

CHARACTER*80 STRING

FIRST A SIMPLE DEMONSTRATION

CALL GRISET (0. ,0. , 100. , 100.

)

CALL NEWFRM

CALL WDDRAW (50. ,90. ,6. ,0. ,8. ,0. ,8. ,

' 1LL1C02EFT1 . ’ ) CALL WDDRAW (50. ,75. ,6. ,0. ,8. ,0. ,8. ,

’ 1M1C01C1C02ENTERED1 .

’ ) CALL WDDRAW ( 50. , 60. , 6. , 0. , 8. , 0. , 8. ,

' 1R1C0 1R1C02IGHT1 .

’

)

STRING=’1M1C0111C0221C0331C0441C0551C0661C0771C0881C1391G1401.

f • CALL WDDRAW (50. ,45. ,6. ,0. ,8. ,0. ,8. , STRING)

STRING=’1M1C01ALS01U1C05SUP£RSCRIPTS10 ICO 1AND1C051DSUBSCRIPTS

• 1. ' CALL WDDRAW (50. ,30. ,6. ,0. ,4. ,0. ,5. .STRING)

STRING = '1MABC1U1. 2341. ' CALL LABEL( STRING, 60. ,10. ,90. ,20. , . 50)

STRING='1M1C011H04AND 1C03YOU 1C071H18CAN 1H04CHANGE CHARACTER

. 1C031H18SETS1.

CALL WDDRAW (50. ,20. ,6. ,0. ,4. ,0. ,5. .STRING)

STRING = '1C021H04S1US1USVUS1. ' CALL WDDRAW ( 10. , 10. ,6. ,0. ,4. ,0. , 5. , STRING)

STRING = '1C0310D1DD1DD1DD1.

CALL WDDRAW (20. , 10., 6., 0., 4., 0., 5., STRING)

STRING = '1G08NOW TRY ONE YOURSELF !1.'

CALL WDDRAW( 10. ,1. ,6. ,0. ,4. ,0. ,5. .STRING)

CALL FRAME

PAUSE

THE RESTART POSITION - SCART WITH THE ANGLE OF THE TEXT

4 CALL SYSIO(PB, 33,5, 'ANGLE=' ,6,0)

R£AD(5,1) ANGLE

1 FORMAT(2F)

IF(ANGLE.LT.O.O) GO TO 5 THETA = ANGLE/ 5 7. 295

DO 7 I = 1, 80

7 TITLE(I) = ' '

ERASE THE SCREEN AND PREPARE TO DRAW

CALL NEWFRM

CALL SYSIO(PB,33,5, ’TEXT=',5,0)

READ(5,3) TITLE

3 FORMAT (80A1)

DO 11 I = 1, 80

II = 81 - I IF(TITLE( II).NE. ’ ') GO TO 12

11 CONTINUE

- 107 -
SUBROUTINE /^GTST page 3

L06 GO TO 4

107 12 TITLE(II+1) = 'V

108 TLTLE(II+2) = ' 109 C CALL SYSIO(PB,33,5, ' LINWID= ' , 7 , 0)

1 10 C READ(5,2) LW

1 11 CALL DEFINE (0. , 0. , 13. , 13.

)

1 12 CALL COLOR(4)

113 c CALL LINWID(LW)

1 14 CALL BOXPLT (0.5, 0.5, 12.5, 12.5)

1 15 CALL COLOR(5)

1 16 CALL WDCOUNT(TITLE,NT)

117 IF(NT.EQ.O) GO TO 4

1 18 c

1 19 c DRAW THE LABEL

120 c 121 YB = 5.0

122 XPOS = 5.0

123 XRIGHT = XPOS + MIN(FLOAT(NT) , 11.

)

124 YTOP = YB +1.

125 CALL LABEL(TITLE, XPOS, YB , XRIGHT,

126 CALL FRAME

127 GO TO 4

128 c 129 c CLOSE THE PLOTTING DEVICE AND ERASE NON130 c

131 5 CALL ENDFRM

132 STOP

133 END

- 108 -
134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

SUBROUTINE CIRC page 4

SUBROUTINE CIRC(ID)

CALL NEWFRM

IF(ID,NE. 1) THEN

CALL DEFINE (0. ,0. , 10. , 10. ) ELSE

CALL SCALNG (0. ,0. , 10. , 10. ,0. ,0. , 7 . 9 , 7 . 9 , 0. ,0. ,0. , 0.

)

ENDIF

CALL COLOR(2)

CALL LINWID(4)

CALL FILTYP(l)

CALL CIRCLE(5. ,5. ,4.

)

CALL FRAME

PAUSE

CALL ERASE

CALL ENDFRM

STOP

END

- 109 -
SUBROUTINE 00*3

151 SUBROUTINE CUBE

152 COMMON QN0RM(3,6),VERT(3,8),IEDGV1(12),IEDGV2(12),

153 . ISURF(6) ,IPEDG(24) ,NVERT,NEDGS,NSURf,F,SCAL£(4)

15A INTEGER IV(2)/2,0/

155 C

156 DLMENSION T( 4 , 4) , QM( 4 , 4) , QMT(4 , 4)

1 57 DX = 4. 158 DY = 4.

1 59 XL = -1. 5 - 0. 1*4.

1 60 XR = +3. + . 15*4.

161 XB = -1. 5 - 0. 1*4.

162 XT = +3. + 0. 15*4.

163 CALL DEFINE (XL, XB , XR, XT)

164 CALL DELAY(26)

165 CALL NEWFRM

1 66 CALL C0L0R(5)

167 CALL LINWID(3)

168 NVERT = 8

169 NEDGS = 12

170 NSURF = 6

171 F = 3. 172 XINCR = .5 / 95.

173 DO 100 I = 1, 4 174 DO 100 J = 1, 4

175 T(I,J) = 0.0

176 IF(I.EQ.J) T(I,I) = 1.0

177 100 CONTINUE

178 XC = 0.5

179 YC = 0.

5

180 ZC = 0.5

181 CALL SETMAT (QM , 1, 1 . 0 , 0 , 0 , 0)

132 DO 1000 I = 1, 95

183 CALL TRANS (T)

184 XCl = XC - XINCR

185 YCl = YC - XINCR

186 ZCl = ZC - XINCR

187 Q4(l,4) = -(QM(1,1)*XC + QM(1,2)*YC) + XCl

188 QM(2,4) = -(QM(2,1)*XC + QM(2,2)*YC) + YCl

189 QM(3,4) = -ZC + ZCl

190 XC = XCl

191 YC = YCl

192 ZC = ZCl

193 CALL MM (T,QM,T)

194 1000 CONTINUE

195 CALL TRANS (T)

196 CALL SETMAT(QM,2, 1.0,0,0,0)

197 DO 2000 1=1, 192

198 F = F + . 15

199 2000 CALL TRANS (T)

200 CALL SETMAT(QM,3, 1.0,0,0,0)

201 DO 3000 1=1, 192

202 F = F - .15

203 CALL MM(T,QM,T)

204 3000 CALL TRANS (T)

205 CALL SETMAT(QM, 1, 1.0, 0,0,0)

- 110-
206

207

208

209

210

2ii

212

213

214

215

2ib

217

218

219

220

221

222

223

2 24

225

226

227

228

2 29

2 30

SUBROUTINE CUBE page 6

CALL SETMAT(QMT,2, 1.0,0,0,0)

CALL MM(QM,QMT,QM)

DO 4000 1=1, 96

CALL MM(T,QM,T)

CALL TRANS(T)

CALL SETMAT(QMT,3, 1.0,0,0,0)

CALL MM (QM,QMT,QM)

THETA = 3. 14159265/180.

ANGLE8 = 3.141592 + THETA

DO 5000 1=1, 360

XCl = SIN(ANGLE8)

ZCl = C0S(ANGLE8)+ 1.0

YCl = FL0AT(I)/360.

QM(1,4) = -(QM(1,1)*XC + QM(1,2)*YC + QM(1,3)^ZC) + XCl

QM(2,4) = -(QM(2,1)*XC + QM(2,2)*YC + QM(2,3)*ZC) + YCi

QM(3,4) = -(QM(3,1)*XC + QM(3,2)*YC + QM(3,3)*ZC) + ZCl

XC = XCl

YC = YCl

ZC = ZCl

ANGLE8 = ANGLE8 + THETA

CALL MM (T,QM,T)

CALL TRANS (T)

CALL ENDFRM

STOP

END

- 111 -
231

232

233

234

235

236

237

238

239

240

241

242

243

244

SUBROUTINE MM page 7

SUBROUTINE MM(A,B,C)

DIMENSION A(4,4) ,B(4,4) ,C(4,4) ,D(4,4)

DO 10 1=1,4

DO 9 J = I, 4

D(I,J) = 0.0

DO 8 K. = 1, 4

D(I,J) = D(I,J) + B(I,K) * C(K,J)

CONTINUE

CONTINUE

DO 20 I = 1, 4 DO 20 J = 1, 4

A(I,J) = D(I,J)

RETURN

END

- 112 -
245

246

247

248

249

250

251

252

253

254

255

256

SUBROUTINE MM3 page 8

SUBROUTINE MM3(A,B,C,K)

DIMENSION B(4,4),A(3),C(3) ,D(3)

DO 10 I = 1, 3

IF(K.EQ. 1) D(I) = B(I,4)

IF(R.NE.l) D(I) = 0.0

DO 9 J = 1, 3

D(I) = D(I) + B(I,J)*C(J)

CONTINUE

DO 20 I = 1, 3 A(I) = D(I)

RETURN

END

- 113 -
10

100

200

300

400

SQB ROUTINE SETMAT page 9

SUBROUTINE SETMAT(A, ITYPE , THETA, XT , YT , ZT)

DIMENSION A(4,4)

RAD = 3. 141592 / 180.

DO 10 I = 1, 4

DO 10 J = 1, 4

A(I,J) = 0.0

A(4,4) = 1.0

ANGLE = THETA * RAD

CT = COS (ANGLE)

ST = SIN (ANGLE)

GO TO (100, 200, 300, 400), ITYPE

A(i, 1) = CT

A(2,l) = -ST

A(l,2) = ST

A(2,2) = CT

A(3,3) = 1.0

RETURN

A(l,l) = 1.0

A(2,2) = CT

A(3,2) = ST

A(2,3) = - ST

A(3,3) = CT

RETURN

A(l, 1) = CT

A(3,l) = -ST

A(l,3) = ST

A(3,3) = CT

A(2,2) = 1.0

RETURN

A(l,l) = 1.0

A(2,2) = 1.0

A(3,3) = 1.0

A(l,4) = XT

A(2,4) = YT

A(3,4) = ZT

RETURN

END

- 114 -
s UBROUTINE TRANS page 10

294 SUBROUTINE TRANS(R)

295 COMMON QNORM(3,6),VERT(3,8) ,IEDGV1(12),IEDGV2(12),

296 • ISURf(6) ,IPEDG(24) ,NVERT,NEDGS,NSURf ,F,SCAL£(4)

297 DIMENSION R(4,4),RVERT(3,8) ,QN(4)

298 DLMENSION IEDG( 1 2) , XP( 1 2) , YP( 1 2)

299 DO 10 I = 1, NEDGS

300 10 lEDG(I) = 0

301 DO 20 I = 1, NVERT

302 CALL MM3 ( RVERT ( 1

, I )

, R , VERT ( 1, I )

, 1

)

303 20 CONTINUE

304 IPTS = 1 305 DO 100 I = 1, NSURF

306 K = ISURF(I)

307 IPTF = IPTS + R - 1 308 CALL MM3(QN,R,QNORM( 1,I),0)

309 K1 = IPEDG(IPTS)

310 K2 = lEDGVl(Kl)

311 XN2 = -RVERT(1,K2)

312 YN2 = -RVERT(2,K2)

313 ZN2 = -RVERT(3,K2) - F 314 DOT = QN(1) * XN2 + QN(2) * YN2 -i- QN(3) * ZN2

315 IF(DOT.LE.O.O) GO TO 100

316 DO 30 J = IPTS, IPTF

317 JJ = IPEDG(J)

318 30 lEDG(JJ) = lEDG(JJ) + 1 319 100 IPTS = IPTF + 1 320 DO 200 I = 1, NVERT

321 ZPF = RVERT(3,I) + F 322 XP(I) = F * RVERT(1,I) / ZPF

323 YP(I) = F * RVERT(2,I) / ZPF

324 200 CONTINUE

325 CALL ERASE

326 DO 300 I = 1, NEDGS

327 IF(IEDG(I).EQ.O) GO TO 300

328 11 = lEDGVl(I)

329 12 = IEDGV2(I)

330 CALL LINE (XP(Il), YP(Il), XP(I2), YP(I2))

331 300 CONTINUE

332 CALL FRAME

333 C CALL UDCOPY

334 RETURN

335 END

-1 15-
336

337

338

339

340

34i

342

343

344

345

346

MAIN PROGiUM page 11

BLOCKDATA BLK

COMMON QNORM(3,6) ,VERT(3,8),IEDGVl(i2),lEDGV2(l2),

ISURF( 6 )

, IPEDG( 24 )

, NVERT , NEDGS , NSURE , F , SCALE ( 4

)

DATA QNORM/0,0,-1. , -1 ., 4*0 ., 2*1 . ,3*0. ,-l. ,0,0, 1. ,0/

DATA VERT/ 4*0, 1 .

, 0 , 2* 1 .

, 0 , 1 .

, 4*0 , 1 .

, 0. , 6* 1 .

, 0 , 1 .

/

DATA lEDGV 1/1, 2, 3, 4, 5, 6, 7, 8, 1,2, 3,4/

DATA IEDGV2/2, 3,4, 1,6,7,8, 5, 5,6,7,8/

DATA ISURF/6*4/

DATA IPEDG/1,2,3,4, 1,9,5,10,8,7,6,5,3,11,7,12,4,12,8,9,

2, 10,6,11/

END

-116-
347

348

349

350

351

352

353

354

355

356

357

358

359

360

361

362

363

364

365

366

367

368

369

370

371

3 72

373

374

375

376

377

378

379

SUBROUTINE GRAFITl page 12

SUBROUTINE GRAFITl(ID)

DIMENSION X(IOO), Y(IOO)

CHARACTER*31 YAXIS/ ' IGNITION TIME (MINUTES ) 1

.

CALL NEWFRM

CALL SETDEV(0,5)

CALL C0L0R(2)

CALL GRISET (0., -50., 1023., 1023.)

PIP = 3. 1415

PIM = - PIP

CALL C0L0R(3)

CALL GRIlj^B(l,PIM,-2. ,PIP,+2. ) CALL GRAFIT (1,PIM, PIP, 200., 900., PIM, PIP, -2.0, +2.0,

100., 800., -2.0, +2.0, 'XAXIS1.', 3, YAXIS, 5)

CALL COLOrU)

CALL GRIlAB(2,PIM,-2. ,PIP,+2.

)

CALL GRAFIT (2, PIM, PIP, 450., 650., PIM, PIP, -2.0, +2.0,

200., 500., -2.0, +2.0, 'XAXISl.’, 3, 'YAXIS1.', 5)

XOFF = (PIP - PIM) / 100.

DO 2 I = 1, 100

XI = PIM + FLOAT(I-l) * XOFF

YI = COS(XI)

X(I) = XI

Y(I) = YI

CALL COLOR(l)

CALL PLOTLN (1, X, Y, 100)

CALL PLOTLN (2, X, Y, 100)

CALL FRAME

IFdD.EQ. 3) PAUSE

CALL ENDFRM

STOP

END

- 117 -
SUBROUTINE GRAflTZ page 13

380

381

382 C

383 C

384 C

385

386

387

388

389

390

391

392 . 393

394

395

396

397

398

399

400

401

402

403

404 C

405 C

406 C

407

408

409

410

411

412

413

414

415

416

417

418

419

420

421 G

422 C

423 C

424

425

426

427

428

429

430

431

432

433

434

SUBROUTINE GRAFIT2(ID)

DIMENSION X(100),Y(100)

READ IN SOME DATA (X VS Y)

LIN = 3

0PEN(UNIT=1,FIL£=’G1TEST2.DAT'

)

CALL RDCNL(Y,I1, IY,I2)

CALL RDCNL(X,Ii,IX,I2)

IZ = MIN0(IX, lY)

13 = IZ/3

3 IREV = 0

DO 4 I = 1, IZ-1

II = I + 1 IF(X(I).LE,X(II)) GO TO 4

IREV = IREV -t- 1 XP = X(I)

YP = Y(I)

X(I) = X(II)

Y(I) = Y(II)

X(II) = XP

Y(II) = YP

4 CONTINUE

IF (IREV.GT.O) GO TO 3

SCALE - WE NOW KNOW HOW BIG TO MAKE THE AXES

XMAX = 0.0

XMIN = 1. E+10

YMAX = 0.0

YMIN = l.E+10

DO 1 I = 1, IZ

XMAX = AMAX1(XMAX,X(I))

XMIN = AMIN1(XMIN,X(I))

YMAX = AMAX1(YMAX,Y(I))

1 YMIN = AMIN1(YMIN,Y(I))

YMINC = l.E+10

YMAXC =0.0

DO 5 I = 1, 13

YMINC = AMIN1(YMINC,Y(I3-1+D)

5 YMAXC = AMAXl ( YMAXC, Y(I3-1+D)

NOW ROUND OFF THE AXES TO APPROPRIATE WHOLE VALUES

YMIN = 0.0

DELTAX = (XMAX-XMIN)/9.

DELTAY = (YMAX-YMIN)/9.

XMAXA = XMAX - DELTAX * 0.8

XMINA = XMIN + DELTAX * 1.5

YMINA = YMIN + DELTAY •k 1.5

YMAXA = YMAX - DELTAY k .8

XMINB = XMINA + DELTAX

XMAXB = XMAXA - 2.0*DELTAX

YMINB = YMINA + DELTAY * .76

YMAXB = YMAXA - 2. 7*DELTAY

- 118 -
435

436

437

438

439

440

441

442

443

444

445

446

447

448

449

4 50

451

452

453

4 54

455

456

457

458

459

460

461

SUBROUTINE GRAF IT

2

page 14

XMAX = IFIX(XMAX+DELTAX/2.

)

YMAX = IFIX((YMAX+DELTAY)/100. )*100.

CALL NEWFRM

CALL LINWID(LIN)

CALL COLOR(l)

CALL GRISET (XMIN, YMIN, XMAX, YMAX)

CALL GR I LAB( 1 , XMIN, YMIN, XMAX, YMAX)

CALL GRAFIT( 1 , XMIN , XMAX, XMINA , XMAXA , XMIN , XMAX , YMIN, YMAIX,

. YMINA,Y’MAXA,YMIN, YMAII, ' T LM£(MINUTES ) 1 .

’

, 14

,

. 'TEMPERATUR£(K)1. ' , 12)

CALL GRILAB(2,X(I3) , YMINC , X( 2*13) ,YMAXC)

CALL GRAFIT(2,X(I3) ,X(2*I3),XMINB,XMAXB,X(I3) ,X(2*I3),

. YMINC, YMAXC,YMINB,YMAXB, YMINC, YMAXC,

. 'TLME(MINUTES)1. ’ , 5, 'FLUE TEMPERATURE(K) 1 , 5)

CALL COLOR(2)

CALL LINWID(4)

CALL PLOTLN(l,X,Y,I3)

CALL COLOR(3)

CALL PLOTLN(l ,X( 13-1) ,Y( 13-1) ,13)

CALL PLOTLN(2,X(I3) ,Y(I3),I3)

CALL COLOR(2)

CALL PL0TLN(1,X(2*(I3-1)),Y(2*(I3-1)),IZ-2*(I3-D)

CALL FRAME

IF(ID. EQ.3) PAUSE

CALL ENDFRM

STOP

END

- 119 -
SUBROUTINE RDCNL page 15

462 SUBROUTINE RDCNL (REED, ICNL.MAXR , lEOF)

463 C

464 C

465 C

466 C

467 C

468 C

469 C

470 C

47L C

472

473

474

475

476

477

478

479

480

481 C

482 C

483 10

484 20

485 C

486

RRRRRRR

RRRRRRRR

RR RR

RR RR

RRRRRRR

PR. RR

RR RR

END

RRRRRRR

RRRRRRRR

RR RR

RR RR

RR RR

RRRRRRRR

RRRRRRR

RRRRRR

RRRRRRRR

RR RR

RR

RR RR

RRRRRRRR

RRRRRR

RR RR

RRR RR

RRRR RR

RR RR RR

RR RRRR

RR RRR

RR RR

RR

RR

RR

RR

RR

RRRRRRRR

RRRRRRRR

DIMENSION REED(IOO)

READ (1,10) MAXR,IGNL,IEND

IF (lEND. EQ. 999) THEN

IEOF=l

ELSE

IEOF=0

READ (1,20) (REED(IR) ,IR=1,MAXR)

END IF

RETURN

FORMAT (2I6,T78,I3)

FORMAT (7E11.5)

- 120-
487

488

489

490

491

492

493

4 94

495

496

497

498

499

500

501

502

503

504

50 5 506

507

508

509

510

511

512

513

514

515

516

517

518

519

520

521

522

523

524

525

526

527

528

529

5 30

531

532

533

534

535

536

537

538

539

540

541

SUBROUTINE GRAF IT

3

page 16

SUBROUTINE GRAFIT3(ID)

DIMENSION X(IOO), Y(IOO)

CHARACTER*31 YAXIS/ 'TIME SINCE IGNIT ION1 . MINUTES) 1 .'

/

CHARACTER IC/'Z’/

CALL SETDEV(0,5)

XMIN = 0.

XMAX = 1000.

YMIN = 0.

YMAX = 1000.

XMAXG = 0.0

YMAXG = 0.0

DO 3 J = 1, 5 CALL NEWFRM

XMAXG = XMAXG + XMAX

YMAXG = YMAXG + YMAX

CALL GRISET(XMIN, YMIN, XMAXG, YMAXG)

PIP = 3. 1415

PIM = - PIP

CALL C0L0R(3)

DX = XMAX - XMIN

DY = YMAX - YMIN

X200 = XMIN + .2 * DX

X900 = XMAX - . 1 * DX

YlOO = YMIN + .2 * DY

Y800 = YMAX - . 1 * DY

CALL GRILAB(l,PIM,-2. ,PIP,+2.

)

CALL (^AFIT (1,PIM, PIP, X200, X900, PIM, PIP, -2.0, +2.0,

YlOO, Y800, -2.0, +2.0, 'X AXIS1.', 3, YAXIS, 5)

CALL C0L0R(4)

X450 = XMIN + .45 * DX

X650 = XMAX - .35 * DX

Y200 = YMIN + .30 * DY

Y500 = YMAX - .40 * DY

CALL GRILAB(2,PIM,-2. ,PIP,+2.

)

CALL GRAFIT (2, PIM, PIP, X450, X650, PIM, PIP, -2.0, +2.0,

Y200, Y500, -2.0, +2.0, 'XAXISl.', 3, ’YAXISV’, 5)

XOFF = (PIP - PIM) / 10.

DO 2 I = 1, 10

XI = PIM + FLOAT(I-l) * XOFF

YI = COS(XI)

X(I) = XI

Y(I) = YI

CALL COLOR(l)

CALL PLOTLN (1, X, Y, 10)

CALL CHRSIZ(0. , .05)

CALL PLOTCH ( 1

, X, Y , 10, ' *A '

)

CALL PLOTLN (2, X, Y, 10)

CALL PLOTCH (2 , X, Y, 10, LC)

CALL FRAME

LF(LD.EQ. 3) PAUSE

CONTINUE

CALL ENDFRM

STOP

- 121 -

543

544

545

546

547

548

549

550

551

552

553

554

555

5 56

557

558

559

560

561

5o2

563

564

565

5 66

567

568

569

570

571

572

573

574

575

576

577

578

579

580

581

SUBROUTINE GRAF IT

4

page 18

SUBROUTINE GRAFIT4(ID)

DIMENSION Q(550) ,VS(550) ,X(500) ,Y(500) ,TM(500) ,SQT(500)

CHARACTER* 16 FILE

CHARACTER*40 TITLE/ 'GRAFIT(4) '/

FILE = 'G1TEST4.DAT'

TSTAR = 10.

B = .321

OPEN (UNIT=8,FILE=FIL£)

NP=0

Nl = l 6 READ(8,3,END=5) N

3 FORMAT(I2)

READ(8,4) (VS(J),Q(J) ,TM( J) , J=1 , N)

DO 10 1=1,

N

FT=B*SQRT(TM(I))

IF(TM(I).GT.TSTAR) FM=1.

10 SQT(I)=Q(I)*FT

4 F0RMAT(50X,3F10. 2)

N2=NP+(N-2)

J=1

DO 8, I=N1,N2

Y(I)=VS(J)

X(I)=SQT(J)

8 J=J+1

NP=N2

N1=NP+1

GO TO 6

5 CONTINUE

TYPE *, TITLE

NP=N2

CALL PLT(NP,X,Y)

IF(II>. EQ. 1) GO TO 50

PAUSE

50 CONTINUE

CALL ENDFRM

STOP

END

- 123 -
582

583

584

585

58b

587

588

589

5 90

591

592

593

594

595

596

597

598

599

bOO

60L

602

603

604

605

SUBROUTINE PUT page 19

SUBROUTINE PLT(N,X,Y)

DLMENSION X( 5 50 ) , Y( 550)

CHARACTER*40 TITL

CHARACTER*25 YLABL

CHARACTER*25 XLABL

TITL = ' Rigid Foaml. ' XLABL='q . F(c) (W/cm1U2lO) 1.

YLA3L=’i/ V (s/oim)1.' . ymax = 2.0

lYTIC = 10

CALL NEWFRM

CALL COLOR(l)

CALL GRISET(0. ,0. , 1100. , 1100.

)

CALL COLOR(8)

CALL GRAFIT(1,0. ,6. ,200. ,900. ,0. ,6. ,0. , YMAX, 200. ,900. ,0. ,YMAX,

&XLABL,6,YLABL, lYTIC)

CALL COLOR(l)

CALL R.0TCH(1,X,Y,N, 'o'

)

CALL COLOR(5)

CALL LABEL(TITL, 2 50. ,950. ,850. , 1000. ,0.0)

CALL FRAME

RETURN

END

- 124 -
SUBROUTINE PHASE page 20

606 SUBROUTINE PHASE

607 DLMENSION Z(30,30), X(8),Y(8), FL(8), TEST(30,30)

608 EATA A/1./, B/-4./, C/5./, NINT/8/

609 DATA X/100., 800., 250., 950., 100., 800., 250. , 950

610 DATA Y/lOO, , 100., 300., 300., 800., 800., 950., 950

611 C

612 DO 1 I = 1,30

613 DO 1 J = i, 30

614 1 Z(I,J) = A*C0S(-.4+FL0AT(I)/5. )*

615 . (l.+B*EXP(-C*(FLOAT(J-10)/7. )**2))+5

616 ZMAX = -l.E+9

617 ZMIN = +1.E+9

618 DO 4 I = 1, 30

619 DO 4 J = 1, 30

620 ZMAX = MAX(ZMAX, Z(I,J))

621 4 ZMIN = MIN(ZMIN, Z(I,J))

622 CALL LINWID(l)

623 CALL NEWFRM

624 CALL DEFINE(0. ,-100, , 1000. , 1000.

)

625 CALL SRFSET(X,Y,0. , 10. ,30,30)

626 CALL C0L0R(2)

627 CALL SURFAC(Z,30,30, 1)

628 CALL C0L0R(3)

629 CALL SURFAC(Z, 30, 30,-1)

630 C

631 C SET UP A REASONABLE CONTOURING INTERVAL

632 c 633 CALL CNTSET(X(1),Y(1),X(2),Y(2),X(4) , Y(4 )

, X( 3 ), Y( 3 )

)

634 DELTAZ = (ZMAX - ZMIN) * 0.9 / FLOAT (NINT)

635 FL(1) = ZMIN + 0. 5 * DELTAZ

636 DO 2 I = 2, 8

637 2 FL(I) = FL(I-l) + DELTAZ

638 DO 3 I = 1, 8

639 CALL COLOR(I)

640 3 CALL CONTUR (Z, TEST, 30, 30, FL(I))

641 CALL FRAME

642 PAUSE

643 CALL ENDFRM

644 STOP

645 END

-L25-
646

647

648

649

650

651

652

653

654

655

656

657

658

659

660

661

662

663

664

665

666

667

668

6d9

670

671

672

673

674

675

6 76

677

678

679

680

SUBROUTINE RUMTST page 21

SUBROUTINE RUMTST

COMMON/ ROOMSZ/RML,RMR,RMB,RxMT,SCAL£( 4) .WALLSZ ,CEILSZ

REAL*4 LSIZE, DELTA

CALL NEWFRM

CALL FILTYP(2)

CALL ROOM (0.0, 5.0, 0.0, 2.5, .05, 1.0, 0.7)

CALL VENTV (0.1, 0.5, 0.0, -1.)

A = -1.5 / 20.

B = 2. 2 - A

I = 1 FSIZE = FLOAT(I)*A + B

LSIZE = FSIZE + 0.2

PSIZE = FSIZE

CALL FIRE (4.0, 0.5, 0.2, FSIZE)

CALL PLUME (4.0, 0.5, 0.5, PSIZE, 0.2)

CALL LAYER (0.05, 2.45, 4.95, 2.48)

CALL FRAME

CALL lOWAIT(lOOO)

DELTA = -A

DO 101 I = 1, 21

CALL FIRE (4.0, 0.5, 0.2, FSIZE)

CALL PLUME (4.0, 0.5, 0.5, PSIZE, 0.2)

FSIZE = FLOAT(I)*A + B

LSIZE = FSIZE + 0.2

PSIZE = FSIZE

CALL FIRE (4.0, 0.5, 0.2, FSIZE-2*DELTA)

CALL PLUME (4.0, 0.5, 0.5, PSIZE-DELTA, 0.2)

CALL LAYER(0.05, LSIZE-DELTA, 4.95, 2.48)

CALL FRAME

CALL lOWAIT(lOOO)

CONT INUE

PAUSE

CALL ENDFRM

STOP

END

- 126-
681

682

683

684

685

686

687

688

689

690

691

692

693

694

695

696

697

6 98

6 99

700

SUBROUTINE VENTV page 22

SUBROUTINE VENTV (BOTH, TOP, SIDE, THICK)

COMMON/ ROOMSZ / RML , RMR , RMB , RMT , SCALE ( 4 )

, WALLS Z , C E I LS Z REAL BOTM, TOP, SIDE

DRAW VERTICAL LINES IN BLACK AND HORIZONTAL LINES IN WHITS

Y1 = BOTM

Y2 = TOP

DO 2 I = 1 , 2 XI = SIDE + (I-i) * WALLSZ * THICK

X2 = XI

CALL LINE (XI, Yl, X2, Y2)

XI = SIDE

X2 = WALLSZ * THICK

DO 1 I = 1 , 2 Y1 = BOTM + (I-l) * (TOP-BOTM)

Y2 = Y1

CALL LINE (XI, Yl, X2, Y2)

RETURN

END

- 127 -
SUBROUTINE LAYER page 23

701 SUBROUTINE LAYER (LEFT, BOTTOM, RIGHT, TOP)

702 C

703 C DRAW SQUIGGLE FROM LEFT TO RIGHT TO REPRESENT

704 C THE LAYER (HOT) ABOVE THE PLUME

705 C

70b INTEGER DIVCNT

707 REAL LEFT, RIGHT, BOTTOM, TOP, X(4), Y(4)

708 C

7j9 C now draw THE SQUIGGLE

710 C

711 CALL C0L0R(2)

712 X(l) = LEFT

713 Y(l) = BOTTOM

714 X(2) = LEFT

715 Y(2) = TOP

716 X(3) = RIGHT

717 Y(3) = TOP

713 X(4) = RIGHT

719 Y(4) = BOTTOM

720 CALL PLYGON(X, Y, 4)

721 RETURN

722 END

- 128 -
723

724

725

726

727

728

729

730

73i

732

733

734

735

736

737

7 38

739

740

741

742

743

744

745

746

747

748

SUBROUTINE FIRE page 24

SUBROUTINE FIRE (CENTER, WIDTH, HEIGHT, FSIZE)

COMMON/ ROOMSZ/ RML , RMR , RMB , RMT , SCALE ( 4 )

, WALLS Z , CEILSZ

C

C PLOT THE FIRE SOURCE

C

CALL COLOR(3)

CALL VBXPLT (CENTER-. 5*WIDTH, 0.0,

CENTER+. 5*WIDTH, HEIGHT)

C

C START AT HEIGHT [HP=( 1 +EPS ) *H£IGHT ] AND TRACE THE PARABOLA

C

CALL COLOR(8)

HP = 1.2 * HEIGHT

W5 = WIDTH * .

5

SLOPS = FSIZE / W5**2

W20 = WIDTH / 20.

YB = HP

XB = CENTER - W5

DO 1 I = 1, 21

XA = XB

YA = YB

XB = CENTER - W5 + W20* FLOAT(I-l)

YB = -(XB-CENTER)**2*SLOPE + HP + FSIZE

1 CALL LINE (XA, YA, XB , YB)

RETURN

END

- 129 -
SUBROUTINE PLUME page 25

749

7 30 C

751 C

752 C

7 53 C

754 C

755 C

7 5b C

757

758

759 C

7b0 C

761 C

762

763

764 C

765

766 C

767 C

768 C

769 C

770 C

771

772

773

774

775

776

111

778

779

7 80

SUBROUTINE PLUME (CENTER, WIDTH, PBOTM, PTOP, FSOURC)

TO PUT THE PLUME III , NORMALLY ABOVE THE FIRE

THIS ROUTINE ASSUMES A POINT SOURCE PLUME AT A

VIRTUAL DISTANCE BELOW THE FIRE SUCH THAT THE

PLUME SUBTENDS AN ANGLE OF li DEGREES AT THE FIRE

SOURCE.

REAL CENTER, WIDTH, PBOTM, PTOP, FSOURC

COMMON/ ROOMSZ/ RML , RMR , RMB , RMT , SCALE ( 4 )

, WALLSZ , CE ILS Z

PLOT THE PLUME

RADIUS = 0. 5 * WIDTH

THETA = 11. / 57.

1

VIRTUAL = RADIUS / ATAN(THETA)

RTAN = ATAN (THETA)

DRAW TWO LINES FROM THE VIRTUAL POINT WITH AN ANGLE

OF THETA AND VISIBLE SEGMENTS

FROM PBOTM TO PTOP

CALL COLOR(7)

Y1 = PBOTM

Y2 = PTOP

DO 1 I = 1, 2 PM = (-1.0)**!

XI = CENTER + PM*(RADIUS+(PBOTM-FSOURC)*RTAN)

X2 = CENTER + PM*(RADIUS+(PTOP -FSOURC )*RTAN)

1 CALL LINE (XI, Yl, X2, Y2)

RETURN

END

- 130-
781

782

7 83

784

785

786

787

788

789

7 90

791

792

7 93

7 94

795

796

797

798

7 99

800

801

802

803

80h

805

806

807

808

809

810

811

812

813

814

SUBROUTINE ROOM page 26

SUBROUTINE ROOM (L, R, B, T, DW , FW , FH)

REAL L, R, T, B, F, SCAL£(4)

COMMON/ ROOMSZ / RML , RMR , RMB , RMT , SCALE , WALLS Z , C E I LS

Z

C

C - L = LEFT SIDE OF ROOM

C - R = RIGHT SIDE OF ROOM

C - T = TOP OF THE ROOM

C - B = BOTTOM OF THE ROOM

C - DW = WIDTH OF WALL

C - F IS THE FRACTION OF THE SCREEN TO BE USED

C

1

XFW = AMINl (1. , FW)

XFH = AMINl (1. , FH)

DWMIN = AMINl (R-L, T-B)

WALLS Z = DWMIN * DW

CEILSZ = 0.5 * XFW/XFH * WALLSZ

DY = T - B

DX = R - L XL = L - DX/3.5

XR = R + DX/3.5

XB = B - DY/3.5

XT = T + DY/3.5

CALL DEFINE (XL, XB , XR, XT)

CALL COLOR(l)

DO 1 IW = 1, 2 WALL = WALLSZ * (IW-1)

CEIL = CEILSZ * (IW-1)

XL = L - WALL

XR = R + WALL

XB = B

XT = T + CEIL

CALL BOXPLT (XL, XB , XR , XT)

RETURN

END

- 131 -
SUBROUTINE SADDLE page 27

815 SUBROUTINE SADDLE(ID)

8 i D C

817

C PROGRAM TO TEST THE SURFACE PLOTTING AND CONTOUR ROUTINES.

818 C

819 PARAMETER (NX=25, NY=1 3, NP=4)

820 REAL Z(NX,NY), XP(8 , 9) , YP(8 , 9) , FL(16), TEST(NX,NY)

821 INTEGER INDX(NP)

822 DATA ZMIN, ZMAX

823 DATA INDX/1,3,7,

824 DATA XP/

825 1 100. , 800. , 826 2 100. , 900. , 827 3 200. , 900. , 828 4 100. , 800. , 829 5 100. , 900. , 830 6 200. , 900. , 831 7 100. , 800. , 832 8 100. , 900. , 833 9 200. , 900. , 334 DATA YP/

835 1 100. , co 836 2 100. , 100. , 837 3 100. , 100. , 838 4 100. , 100. , 839 5 100. , oo • 840 6 100. , 100. , 841 7 200. , 200. , 842 8 200. , 200. , 843

844 C

9 200. . 200. ,

/-0.75, 200./, MX, MY /I, 1/

9/

250. , 900. , 100. , 800. , 250. , 900. , 200. , 800. , 100. , 900. , 200. , 800. , 100. , 750. , 200. , 900. , 100. , 750. , 250. , 900. , 100. , 800. , 250. , 900. , 200. , 800. , 100. , 900. , 200. , 800. , 100. , 750. , 200. , 900. , 100. , 750.

,

250. , 900. , 100. , 800. , 250. , 900. , 200. , 800. , 100. , 900. , 200. , 800. , 100. , 750. , 200. , 900. , 100. , 750./

250.

,

250. , 800. , 800. , 900. , 900. , 250. , 250. , 800. , 800. , 900.

,

900. , 250. , 250. , 800. , 800. , 900. , 900. , 200. , 200. , 900. , 900. , 800. , 800. , 200. , 200. , 900. , 900. , 800. , 800. , 200. , 200. , 900. , 900. , 800. , 800. , 100. , 100. , 900. , 900. , 750. , 750. , 100. , 100. , 900. , 900. , 750. , 750. , 100. , 100. , 900. , 900. , 750. , 750./

845 C

846 C

84 7 848

849

850

INITIALIZE THE DATA

DO 20 J = 1, NY

DO 20 I = 1, NX

Z(I,J) = ABS(FLOAT(J)-7. )**2 + ( 144. -ABS(FLOAT(I)-13. )**2)

20 CONTINUE

851 DO 2 I = 1, 8

852 FL(I) = -1.0 + FLOAT(I)*10.

853 2 FL(I+8) = 0. 2 + FLOAT(I)*10.

8 54 C

855 C INITIALIZE THE GRAPHICS PACKAGE

856 C

857 CALL DEFINE (0., 0., 1023., 1023.)

858 CALL NEWFRM

859 C

860 C LOOP OVER THE VARIOUS PERSPECTIVE PLOTS.

861 C

862 IPP = 3

863 DO 100 IPP = 1, NP

864 IP = INDX(IPP)

865 C

866 C PLOT THE UPPER PART OF THE SURFACE WITH FRONT SKIRT.

867 C

868 CALL SRFSET (XP(1,IP), YP(1,IP), ZMIN, ZMAX, NX, NY)

869 CALL ERASE

- 132 -
870

871

872

873

874

875

876

877

878

879

880

881

882

883

884

885

886

887

888

889

890

891

892

893

894

895

896

897

898

899

900

901

902

903

904

905

906

907

908

SUBROUTINE SADDLE page 28

CALL SETLUT

CALL COLOR(5)

CALL SURFAC (Z, NX, NY, +1)

CALL COLOR(4)

CALL SFRAME (2)

CALL FRAME

CALL IOWAIT(2000)

C

C PLOT THE LOWER PART OF THE SURFACE.

C

CALL SRFSET (XP(1,IP), YP(1,IP), ZMIN, ZMAX, NX, NY)

CALL ERASE

CALL C0L0R(7)

CALL SURFAC (Z, NX, NY, -1)

CALL COLOR(4)

CALL SFRAME (2)

CALL FRAME

CALL IOWAIT(2000)

C

C PLOT BOTH PARTS OF THE SURFACE WITH SIDE SKIRTS.

C

CALL SRFSET (XP(1,IP), YP(1,IP), ZMIN, ZMAX, NX, NY)

CALL ERASE

CALL COLOR(5)

CALL SURFAC (Z, NX, NY, +1)

CALL COLOR(7)

CALL SURFAC (Z, NX, NY, -1)

CALL SFRAME (2)

CALL FRAME

IF(ID.EQ. 3) THEN

PAUSE

ELSE

CALL IOWAIT(2000)

ENDIF

100 CONTINUE

CALL ENDFRM

C

STOP

END

- 133 -
909

910

911

912

913

914

913

9lo

917

913

919

920

921

922

923

SUBROUTINE SETCOL page 29

SUBROUTINE SETCOL(IC)

DIMENSION LUT(16,3)

DO 1 I = 1, 3 DO 1 J = 1, 16

LUT(J,I) = 0

DO 2 I = 1, 8

LUT( 1+1,2) =1*2-1

LUT(I+1,3) = 1*2 - r

DO 3 I = 1, 7 LUT(I+9, 1) = 1*2 + 1 LUT(I+9,2) =1*2+1

CALL DSLWT (16, 48, LUT)

RETURN

END

-134 -
924

925

926

927

928

929

930

931

932

933

934

935

936

937

938

939

940

941

942

943

944

945

946

947

948

949

950

951

952

953

954

955

956

957

SUBROUTINE SYMTST page 30

SUBROUTINE SYMTST

C

C A SIMPLE TEST OF THE CHARACTER STUFF

C

CHARACTER*28 TITLE 1/ 'A SET OF HARDWARE CHARACTERS'/

CHARACTER*19 TITLE2/’U SET FROM SET 11.'/

CHARACTER*32 TITLE3/'1:A SET ([§/*t]) FROM SET #101.'/

ISC=0

3 XSZ = 11. * 2.**ISC - 11.

CALL NEWFRM

CALL DEFINE(-XSZ, -XSZ, ll.+XSZ, ll.+XSZ)

CALL C0L0R(4)

CALL BOXPLT (0.5, 0.5, 8.5, 4.5)

CALL BOXPLT (0.5, 5.5, 8.5, 9.5)

CALL BOXPLT (9.0, 0.5, 10.7, 9.5)

DX = 5. / 28.

XL = 4.5 - 14.*DX

CALL COLOR(l)

CALL CHRSIZ ( DX/ ( 1 1 . +2 . *XSZ) , 0. ) DO 1 I = 1, 28

1 CALL SYMBOL (XL+DX*FLOAT(I) , 7.5, TITLE1(I:I))

CALL COLOR(3)

CALL LABEL(TITLE2, 2.0, 2.0, 8.0, 2.5, 0.0)

CALL COLOR(2)

CALL LABEL(TITLE3, 10.3, 1., 17.3, 2., 3.14/2.)

CALL FRAME

CALL IOWAIT(2000)

ISC = ISC + 1 IF(ID.NE.3) GO TO 4

IF(ISC.GT.7) GO TO 4

GO TO 3

4 CALL ENDFRM

STOP

END

- 135 -
SUBROUTINE VOLTST page 31

9 58 SUBROUTINE VOLTST(ID)

959 C

9b0 C VOLU'ME TEST PROGRAM WITH REDUCED RESOLUTION HIDDEN LINES.

961 C

962 C

963 C

964 C

965 C

966 C

967 C

968 C

969 C

970

971

972

973

9 74

THIS PROGRAM DEMONSTRATES THE USE OF THE "VOLUME" PLOTTER.

IT USES A SIMPLE SOLID ( TWO OVERLAPPING SPHERES)

WITH A SOLID PILLAR PLACED IN FRONT TO OBSCURE PART OF THE

SPHERES AND DEMOSTRATE THE HIDDEN LINE FEATURE. THIS IS DONE

TOGETHER WITH THE NECESSARY INTERACTION WITH THE GRAPHICS

PACKAGE. THIS SHOULD BE USED AS A MODEL FOR DESIGNING PROGRAMS UN

THE USER IS FAMILIAR WITH VOLUME.

PARAMETER (NT=100, NT2=NT*NT)

REAL T(NT2), CLEVE(2)

REAL XP(8,3), YP(8,3)

REAL F(20, 20, 20)

INTEGER M0DE(2)

975 DATA NX,NY,NZ /20, 20, 20/

976 DATA MODE /-i, 2/ , CLEVE /I .5, -1 .0/

977 DATA NP, ITAPE /3 , 105/

978 DATA XP/

979 1 100. , 800. 250. , 900. , 100. , 800. , 250. , 900. , 980 2 100. , 900. > 200. , 800. , 100. , 900., 200. , 800. , 981 3 200. , 900. 9 100. , 750. , 200. , 900. , 100. , 750./

982 DATA YP/

983 1 100. oo • > 250. , 250. , 800. , 800. , 900. , 900. , 984 2 100. , 100. > 250. , 250. , 800. , 800.

,

900. , 900. , 985 3 100. , 100. y 250. , 250. , 800. , 800.

,

900. , 900./

986

987

988

989

990

991

992

C

C

C

C

C

C

INITIALIZE THE PACKAGE

CALL DEFINE(0., 0., 1024., 1024.)

LOOP OVER FOUR SIZES OF THE SPHERES

993

994

995

996

997 C

998 C

999 C

1000 C

1001 C

1002 C

1003

1004

1005

1006

1007

1008

1009

1010 C

1011 C

1012 C

DO 100 IPIC = 1,901,300

NP = NP

IP = 1 FAC = 1.0 + 0.01*FLOAT(IPIC)

SET UP THE VALUE OF THE FUNCTION.

IT IS AN NRL PEANUT ( 2 OVERLAPPING SPHERES)

(X-13)**2 + (Y-10.5)**2 + (Z-10.5)**2

(X-8)**2 + (Y-10.5)**2 + (Z-10.5)**2

DO 1 I = 1, NX

DO 1 J = 1, NY

DO 1 K = 1, NZ

RISQ = (I-8.0)**2 + (J-10.5)**2 + (K-10.5)**2

R2SQ = (1-13. )**2 + (J-10.5)**2 + (K-10.5)**2

F(I,J,K) = FAC/RISQ + 2.0*FAC/R2SQ

CONTINUE

CONSTRUCT THE PILLAR

- 136 -
1013

1014

1015

1016

1017

1018

1019

1020

1021

1022

1023

1024

1025

1026

1027

1028

1029

1030

1031

1032

1033

1034

1035

1036

1037

1038

1039

1040

1041

1042

1043

1044

1045

1046

1047

1048

1049

1050

1051

1052

1053

1054

1055

1056

1057

1058

1059

SUBROUTINE VO LIST page 32

DO 2 I = 1, NX

DO 2 J = 1, 5

DO 2 K. = 1, NZ

RSQ = (I-10.5)**2 + (J-3.5)**2

F(I,J,K) = -4.0/RSQ

2 CONTINUE

C

C INITIALIZE THE PLOTTING PACKAGE

C

C IN THIS CASE, "VOLSET" IS CALLED FOR EACH CYCLE SO THAT THE

C VARIOUS CONTOUR LEVELS WILL BE PLOTTED. THE PILLAR IS PLOTTED

C ONLY ONCE(THIRD CALL) BUT STUFF BEHIND IT IS ALWAYS HIDDEN

C (NCL=2, MODE=2, CLEVE=-1.).

C

C

C

C

C

C

C

C

C

C

C

CALL NEWFRM

DRAW THE FIGURE

CALL COLOR(l)

CLEVE(l) =1.5

CALL VOLSET (XP(1,IP), YP(1,IP), T, NT)

CALL VOLUME(MODE, F, NX,NY,NZ, CLEVE, 2, T, NT)

CALL COLOR(2)

CLEVE(l) =0.5

CALL VOLSET (XP(1,IP), YP(1,IP), T, NT)

CALL VOL'UME(MODE , F, NX,NY,NZ, CLEVE, 2, T, NT)

CALL COLOR(3)

CALL VOLSET (XP(1,IP), YP(1,IP), T, NT)

CALL VOLUME (+1, F, NX,NY,NZ, -1.0, 1, T, NT)

CALL COLOR(4)

CALL VOLUME (-2, F, NX,NY,NZ, 0.5, 1, T, NT)

CALL VOLFRM (2)

CALL FRAME

CALL I0WAIT(2000)

100 CONTINUE

CLOSE-OUT GRAF IT.

C

IF(ID. EQ.3) PAUSE

CALL ENDFRM

C

STOP

END

- 137 -
1060

1061

1062

1063

1064

1065

1 066

106 7 1068

1069

1070

1071

1072

1073

1074

SUBROUTINE FILNGT page 33

SUBROUTINE FILNGT

CALL NEWFRM

CALL DEFINE(-11. ,-11. ,11. ,11,)

DO 2 I = 1, 9

CALL FILTYP(I-l)

X = -11. FLOAT(I)*2. 1 Y = -11. + FLOAT(I)*2,

1

CALL CIRCLE(X, Y, 2.0)

CONTINUE

CALL FRAME

PAUSE

CALL ENDFRM

STOP

END

- 138 -
Appendix G

SUBROCrriNE ALABEL page 1

FUNCTION AND page 2

SUBROUTINE BOXPLT page 3

ENTRY VBXPLT page 3

SUBROUTINE CHPLOT page 4

SUBROUTINE CIRCLE page 5

SUBROUTINE CONTUR page 6

SUBROUTINE DEVICE page 10

ENTRY SETDEV page 12

ENTRY NEWFRM page 12

ENTRY FRAME page 12

ENTRY ERASE page 12

ENTRY HDCOPY page 12

ENTRY COLOR page 12

ENTRY FILTYP page 12

ENTRY GHRSIZ page 13

ENTRY LINWID page 13

ENTRY SCALNG page 13

ENTRY DEFINE page 13

ENTRY ENDFRM page 14

ENTRY DELAY page 20

ENTRY lOWAIT page 20

ENTRY LEXDID page 20

ENTRY TABLET page 20

SUBROUTINE DEVINP page 22

SUBROUTINE ENUMBR page 24

SUBROUTINE FNUMBR page 25

SUBROUTINE GRAF IT page 28

ENTRY PLOTCE page 31

ENTRY PLOTLN page 31

ENTRY PLOTBAR page 32

ENTRY GRISET page 32

ENTRY GRILAB page 32

SUBROUTINE REDRAW page 34

SUBROUTINE ESETS page 36

INTEGER FUNCTION IDCEAR page 38

ENTRY IREVCE page 38

SUBROUTINE LABEL page 39

- 139 -
SUBROUTINE LINE page 40

SUBROUTINE LINES page 41

SUBROUTINE LNPLOT page 42

INTEGER FUNCTION LS HF page 43

SUBROUTINE MAPIN . page 44

SUBROUTINE MAPOUT page 45

SUBROUTINE PLYGON page 46

SUBROUT LNE PLYPLl page 47

SUBROUTINE PLYPL2 page 49

SUBROUTINE PLYPL3 page 50

SUBROUTINE PLYPL4 page 5 2

SUBROUTINE PLYPL5 page 54

SUBROUTINE PLYPLT page 56

ENTRY PLYGNS page 59

SUBROUTINE PROPOL page 61

ENTRY CNTSET page 63

ENTRY CNTFRM page 63

SUBROUTINE PUTCH page 64

SUBROUTINE PUTLNV page 66

SUBROUTINE SETLUT page 68

SUBROUTINE SRFSET page 69

ENTRY SFRAME page 71

ENTRY SSKIRT page 71

ENTRY SURFAC page 73

SUBROUTINE SURF4 page 7 7

ENTRY SURF5 page 7 7

SUBROUTINE SYMBOL page 78

SUBROUTINE VIEWTR page 79

SUBROUTINE VOLFRM page 83

- 140-
SUBROUTINE VOLUMO page 84

SUBROUTINE

SUBROUTINE

SUBROUTINE

SUB ROUT LNE

SUBROUTINE

ENTRY VOLUM6

VOLUM7

VOLUM8

VOLUME

ENTRY VOLSET

WDCOUNT . . . .

WDDRAW

ENTRY CHRSET

page 84

page 85

page 87

page 89

page 92

page 94

page 96

page 99

-L4L-
I2

34

56

78

9

10

1 1 12

1 3 14

1 5

1 o

SUBROUTINE MABEL page 1

SUBROUTINE MABEL (CHARS, XL, XR, ANGLE)

COMMON /DEVTYP/ IDEVIC , LSW , LTSW , XYCOOD(4 )

, LUOUT, LPAGE

COMMON/GRFTYP/ XNGLE , IRVRSE , CHS IZ E ( 9 )

, ITKWIT , LUDIAG , LUHSET

CHARACTER*! CHARS(*)

CALL WDC0UNT( CHARS, NC)

IF(NC.LE.O) THEN

IF( LUDIAG. GT.O) WRITE (LUDIAG, 3) (CHARS( I ), 1=1 , 132

)

3 FORMAT (

' NO ESCAPE SEQUENCE IN ALABEL -’,^1X, 132A1)

RETURN

ENDIF

DX = (XR - XL) / MAX( 1. , FLOAT (NC))

DY = 4./3. * DX * XYCOOD(1)/XYCOOD(3)

XNGLE = ANGLE

GALL WDDRAW (XL, YB , DX, 0.0, DX, 0.0, DY, CHARS)

RETURN

END

- 142 -
23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

40

41

42

43

44

45

46

47

48

49

50

SUBROUTINE BOXPLT page 2

SUBROUTINE BOXPLT (XI, Yl, X2, Y2)

C

(]*********************************************************************•*

C BOXPLT

(^* ***************** *x ********************* *** ***************************

C

REAL XA(4) ,XB(4) ,YA(4) ,YB(4)

C

ENTRY VBXPLT (XI, Yl, X2, Y2)

XA( 1)=X1

YA(1)=Y1

XB( 1)=X2

YB( 1)=Y1

XA(2)=X2

YA(2)=Y1

XB(2)=X2

YB(2)=Y2

XA(3)=X2

YA(3)=Y2

XB(3)=X1

YB(3)=Y2

XA(4)=X1

YA(4)=Y2

XB(4)=X1

YB(4)=Y1

CALL LINES(XA,YA,XB,YB,4)

RETURN

END

- 143 -
51

52

53

54

55

56

57

58

59

60

61

62

63

64

6 5 66

67

68

69

70

71

7 2 73

74

75

76

77

78

SUBROUTINE CHPLOT page 4

SUBROUTINE CHPLOT

C

C XARRAY REAL

C

C YARRAY REAL

C

C CHARAC LITERAL - C II INTEGER -

C 12 INTEGER -

C

C 13 INTEGER -

(XARRAY, YARRAY, CHARAC , li, 12, 13)

AN ARRAY, DIMENSIONED N, OF X COORDINATES OF

THE DATA (MATH SPACE)

AN ARRAY, DIMENSIONED N, OF Y COORDINATES OF

THE DATA (MATH SPACE)

CHARACTER TO BE PLOTTED

INDEX OF FIRST POINT TO BE PLOTTED

INCREMENT AT WHICH POINTS ARE TO BE SELECTED

TO PLOT

INDEX OF LAST POINT IN DATA ARRAYS

C CHPLOT

COMMON /DEVTYP/ IDEVIC , LSW , LTSW , XYCOOD(4 )

, LUOUT , LPAGE

COMMON/GRFTYP/ ANGLE, IRVRSE, CHS IZ£(9) ,ITKWIT,LUDIAG,LUHSET

INTEGER II, 12, 13, CHCODE

REAL XARRAY(4), YARRAY(4)

CHARACTER*! CHARAC

INTEGER IX, lY

NOPTS = (I3-I1+I2) / 12

IlM = II - 12

DO 1 1=1, NOPTS

II=IIM+I2*I

I CALL SYMBOL (XARRAY( II) YARRAY(II), CHARAC)

RETURN

END

- 144 -
79

80

81

82

83

84

85

86

87

88

89

90

91

92

93

94

95

96

97

98

99

100

101

102

103

104

105

106

107

108

SUBROUTINE CIRCLE page 5

SUBROUTINE CIRCLE(X, Y, R)

C

C DRAW A CIRLE OF WIDTH LINWDM AND FILL WITH LFLMAT.

C

COMMON/DEVTYP/ IDEVIC , LSW , LTSW , XYCOOD( 4 )

, LUOUT , LPAGE

COMMO N/ GRFMO D/ LF LMAT ( 5 )

, L INW DM ( 5 ), LC LMAT ( 5

)

REAL XO, YO, XN, YN, DX, DY, THETA, ARC

C

IF( IDEVIC. EQ.O) RETURN

GO TO (1,1, 2, 1,1), IDEVIC

1 ARC = 3. 1415/50.

THETA =0.0

XO = X + R

YO = Y

DO 10 I = 1, 101

THETA = THETA + ARC

XN = R * COS(THETA) + X

YN = R * SIN(THETA) + Y

CALL LINE(XO, YO, XN, YN)

XO = XN

YO = YN

10 CONTINUE

RETURN

2 XL = MAX(X * XYCOOD(l) + XYCOOD( 2 )

, 0.

)

YL = MAX(Y * XYCOOD(3) + XYCOOD( 4 ) , 0.

)

RL = R * MIN(XYCOOD( 1) , XYCOOD(3))

CALL GMOVA(XL, YL)

CALL GCIRA(RL)

RETURN

END

- 145 -
109

I 10

1 1 i 112

113

1 14

1 15

1 16

1 17

1 16

1 19

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

1 46

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

SUBROUTINE CONTUR page 6

SUBROUTINE CONTUR (F, TEST, NX, NY, FL)

PARAMETER (NPT=101)

REAL F(NX,NY), TEST(NX,NY)

REAL XTl(NPT), XT2(NPT), XT3(NPT), YTl(NPT), YT2(NPT),

1 YT3(NPT), FTi(NPT), FT2(NPT), FT3(NPT)

REAL TOO(NPT), TIO(NPT), TOl(NPT), Til(NPT)

C

C SUB ARRAYS OUT OF THE DATA CANNOT BE CONTOURED. THE

C ENTIRE F(I,J) ARRAY IS CONTOURED SO A COPY OVER INTO SCRATCH SPACE

C IS REQUIRED IF ONLY A PORTION OF F IS TO BE PLOTTED.

Cc

c

c

F REAL ARRAY (NX, NY) THE REAL VALUES OF THE FUNCTION TO

CONTOURED. A TOPOLOGICALLY SQUARE

GRID CELL IS ASSUMED AND DX = DY = 1 c

c TEST REAL ARRAY (NX, NY) A USER SUPPLIED SCRATCH ARRAY OF

THE SAME DIMENSIONALITY AS F. c NX INTEGER RANGE AND DIMENSION OF I IN F(I,J).

c NY INTEGER RANGE AND DIMENSION OF J IN F(I,J).

c FL REAL THE VALUE OF F(I,J) FOR CONTOURING.

C

C CALCULATE THE AVERAGE VALUE OF F AT THE CENTERS OF THE CELLS.

C

NTMAX = NPT - 2 NTRIA = 0

NXM = NX - 1 NYM = NY - 1 DO 200 J = 1, NYM

DO 200 I = 1, NXM

TEST(I,J) = F(I,J). + F(I+1,J)

TEST(I,J) = TEST(I,J) + F(I,J+i)

TEST(I,J) = TEST(I,J) + F(I+1,J+1)

200 TEST(I,J) = 0. 25*TEST(I, J)

C

C NOW CALCULATE THE CROSSINGS WHICH PARELLEL THE "I” AXIS.

C

DO 310 J = 1, NY

DO 300 I = 1, NXM

300 TOO(I) = (F(I+i,J) - FL)*(FL - F(I,J))

C

C A CROSS OCCURS IF THE CONTOUR PASSES THRU F(I,J) IN THE BOX I->I+1

C

DO 309 I = i, NXM

IF (TOO(I) .LT. 0.0) GO TO 309

C

C THE LINE SEGMENT IS A HIT. TREAT IN A SCALAR WAY FIRST THE UPPER

C AND THEN THE LOWER TRIANGLE.

C

IF (J.EQ.NY) GO TO 305

IF (NTRIA .GE. NTMAX) CALL PROPOL (NTRIA, XT1,YTI,FT1,

1 XT2,YT2,FT2, XT3,YT3,FT3, FL, NX, NY)

NTRIA = NTRIA + 1 XTl(NTRIA) = FLOAT(I)

YTl(NTRIA) = FLOAT(J)

FTl(NTRIA) = F(I,J)

XT2( NTRIA) = FLOATd + 1)

- 146 -
164

165

1 66

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

SUBROUTINE CONTUR page 7

305

YT2(NTRIA) ^ FT2(NTRIA) ^ XT3(NTRIA) ^ YT3(NTRIA) ^ FT3(NTRIA) ^ IF (J,EQ. 1)

= FLOAT(J)

= F(I+1,J)

= FLOAT(I) +

= FLOAT(J) +

= TEST(I.J)

GO TO 309

0.5

0.5

If (NTRIA .GE. NTMAX) CALL PRO POL (NTRIA, XT1,YT1,FT1

XT2,YT2,FT2, XT3,YT3,FT3, FL, NX, NY)

NTRIA = NTRIA + 1

1 )

309

310

XT 1( NTRIA)

YT1( NTRIA)

FTl(NTRIA)

XT2( NTRIA)

YT 2 (NTRIA)

FT2(NTRIA)

XT3(NTRIA)

YT3(NTRIA)

FT 3 (NTRIA)

CONTINUE

CONTINUE

FL0AT(I + FLOAT(J)

F(I+1,J)

FLOAT(I)

FLOAT(J)

F(I, J)

FLOAT(I)

FLOAT(J)

+ 0.5

- 0.5

= TEST(I,J-1)

NEXT CALCULATE THE CROSSINGS ALONG THE "J" AXIS.

Cc

c

c

DO 360 J = 1, NYM

DO 350 I = 1, NX

350 Tll(I) = (F(I,J+1) - FL)*(FL - F(I,J))

CORSS OCCURS IF THE CONTOUR VALUE PASSES THRU THE BOX IN F(I,J)

IN THE RANGE J->J+1

DO 359 I = 1, NX

IF (Tll(I) .LT. 0.0) GO TO 359

THE LINE SEGMENT IS A HIT. TREAT IN A SCALAR WAY FIRST THE RIGHT

AND THEN THE LEFT TRIANGLE.

IF (I.EQ.NX) GO TO 355

IF (NTRIA .GE. NTMAX) GALL PROPOL (NTRIA, XT1,YT1,FT1,

1 XT2,YT2,FT2, XT3,YT3,FT3, FL, NX, NY)

NTRIA = NTRIA + 1 XT 1 (NTRIA) = FLOAT(I)

YTl(NTRIA) = FLOAT(J + 1)

FTl(NTRIA) = F(I,J+1)

XT2( NTRIA) = FLOAT(I)

YT2(NTRIA) = FLOAT(J)

FT2(NTRIA) = F(I,J)

XT3(NTRIA) = FLOAT(I) +0.5

YT3(NTRIA) = FLOAT(J) +0.5

FT3(NTRIA) = TEST(I,J)

355 IF (I.EQ. 1) GO TO 359

IF (NTRIA .GE. NTMAX) CALL PROPOL (NTRIA, XT1,YT1,FT1,

1 XT2,YT2,FT2, XT3,YT3,FT3, FL, NX, NY)

NTRIA = NTRIA + 1 XTl(NTRIA) = FLOAT(I)

YTl (NTRIA) = FLOAT(J)

- 147 -
219

2 20

22L

222

223

224

225

226

227

223

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

2 50

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

271

272

273

SUBROUTINE CONTUR

359

360

FTl(NTRIA)

XT2(NTRIA)

YT2(NTRIA)

FT2(NTRIA)

XT3(NTRIA)

YT3(NTRIA)

FT3(NTRIA)

CONTINUE

CONTINUE

•F(I,J)

FLOAT(I)

FLOAT(J + 1)

F(I,J+1)

FLOAT(I) - 0.5

FLOAT(J) +0.5

TEST(I-1, J)

420

NOW SEEK ALL TRIANGLES WITH TWO DIAGONAL CROSSINGS,

DO 490 J = 1, NYM

DO 420 I = 1, NXM

TOO(I) = (TEST(I,J) - FL)*(FL - F(I,J))

TIO(I) = (FL - TEST(I,J))*(F(I+1,J) - FL)

TOl(I) = (FL - TEST(I,J))*(F(I, J+1) - FL)

Tll(I) = (TEST(I,J) - FL)*(FL - F(I+l,J+i))

CONSIDER THE LOWER TRIANGLE IN THE SQUARE.

DO 430 I = 1, NXM

IF (AMINKTOO(I) , TIO(D) .LT. 0.0) GO TO

IF (NTRIA .GE. NTMAX) GALL PROPOL (NTRIA,

XT2,YT2,FT2, XT3,YT3,FT3, FL, NX, NY)

NTRIA = NTRIA + 1

430

XTl

,

YTl.FTl

430

XTl (NTRIA)

YTl (NTRIA)

FT 1 (NTRIA)

XT2(NTRIA)

YT2( NTRIA)

FT2( NTRIA)

XT3( NTRIA)

YT3( NTRIA)

FT3( NTRIA)

CONTINUE

FLOAT(I) + FLOAT(J) + TEST(I, J)

FLOAT(I)

FLOAT(J)

F(I,J)

FLOAT(I + FLOAT(J)

F(I+i,J)

0.5

0.5

i)

CONSIDER THE RIGHT TRIANGLE IN THE SQUARE.

DO 440 1=1, NXM

IF (AMIN1(T10(I) , Tll(I)) ,LT. 0.0) GO TO

IF (NTRIA .GE, NTMAX) CALL PROPOL (NTRIA,

XT2,YT2,FT2, XT3,YT3,FT3, FL, NX, NY)

NTRIA = NTRIA + 1

440

XTl

.

YTl.FTl

440

XTl(NTRIA)

YTl (NTRIA)

FTl(NTRIA)

XT2(NTRIA)

YT2(NTRIA)

FT2(NTRIA)

XT3(NTRIA)

YT3(NTRIA)

FT3(NTRIA)

CONTINUE

FLOAT(I) +0.5

FLOAT(J) +0.5

TEST(I, J)

FLOATd + 1)

FLOAT(J)

F(I+1,J)

FLOAT(I + 1)

FLOAT(J + 1)

F(I+1, J+1)

page 8

-148 -
274

275

276

277

278

279

280

281

282

283

284

285

286

287

288

289

290

291

292

293

294

295

296

297

298

299

300

301

302

303

304

305

306

307

308

309

310

311

312

313

314

315

316

317

SUBROUTINE CONTUR

CONSIDER THE UPPER TRIANGLE IN THE SQUARE.

DO 450 I = 1, NXM

IF (AMINKTl 1(1) , TOl(D) .LT. 0.0) GO TO

IF (NTRIA .GE. NTMAX) CALL PRO POL (NTRIA,

XT2,YT2,FT2, XT3,YT3,FT3, FL, NX, NY)

NTRIA = NTRIA + 1

450

XTl YTl.FTl

450

XTl (NTRIA)

YT1( NTRIA)

FTl(NTRIA)

XT 2 (NTRIA)

YT 2 (NTRIA)

FT2(NTRIA)

XT3(NTRIA)

YT3( NTRIA)

FT3(NTRIA)

CONTINUE

FLOAT(I) +0.5

FLOAT(J) +0.5

TEST(I, J)

FL0AT(I + 1)

FLOAT(J + 1)

F(I+1, J+1)

FLOAT(I)

FLOAT(J + 1)

F(I,J+1)

CONSIDER THE LEFT TRIANGLE IN THE SQUARE.

DO 460 I = 1, NXM

IF (AMINl(TOUI) , TOO(I)) .LT. 0.0) GO TO 460

IF (NTRIA .GE. NTMAX) CALL PROPOL (NTRIA, XT1,YT1,FT1,

XT2,YT2,FT2, XT3,YT3,FT3, FL, NX, NY)

NTRIA = NTRIA + 1 0.5

0.5

460

490

XTl (NTRIA)

YTl (NTRIA)

FTl(NTRIA)

XT2(NTRIA)

YT2( NTRIA)

FT2(NTRIA)

XT3(NTRIA)

YT3(NTRIA)

FT3(NTRIA)

CONTINUE

CONTINUE

= FLOAT(I) +

= FLOAT(J) +

= TEST(I,J)

= FLOAT(I)

= FLOAT (J +

= F(I,J+1)

= FLOAT(I)

= FLOAT(J)

= F(I,J)

1 )

IF THE BUFFER IS ONLY PARTIALLY FULL, FLUSH AT THE END.

IF (NTRIA .GT. 0) CALL PROPOL (NTRIA, XT1,YT1,FT1,

XT2,YT2,FT2, XT3,YT3,FT3, FL, NX, NY)

RETURN

END

page 9

- 149 -
318

319 C

320 C

321 C

322 C

323 C

324 C

325 C

326 C

327 C

328 C

329 C

330 C

33 L C

332 C

333 C

334 C

335 C

33b C

337 C

338 C

339 C

340 C

341 C

342 C

343 C

344 C

345 C

346 C

347 C

348 C

349 C

350 C

351 C

352 C

353 C

354 C

355 C

356 C

357 C

358 C

359 C

360

361

362

363

364

365

366

367

368

369

370

371

372

SUBROUTINE DEVICE page 10

SUBROUTINE DEVICE (N)

DEVICE 1 CALCOKP PLOTTER

2 PRINTER PLOT

3 LEXIDATA DISPLAY UNIT WITH MATRIX CAMERA

4 ADM WITH RETROGRAPHICS OR TEX 40XX SERIES

5 EMPTY SLOT

COMMAN DS DEVICE - SELECT DEVICE (1-5)

SETDEV - SET THE LOGICAL UNITS FRO OUTPUT

LINWID - NUMBER OF STROKES IN A LINE

FILTYP - TYPE OF FILLING FOR POLYGONS AND CIRCL

CHRSIZ - HEIGHT OF CHARACTERS (IN RASTER UNITS)

1 NEWFRM - SET UP DEVICE FOR A NEW PLOT

2 FRAME - FORCE A FLUSH OF ALL BUFFERS

3 ERASE - ERASE THE SCREEEN

4 HDCOPY - HARD COPY COMMAND - SHUTTER ON MATRIX

5 COLOR - SELECT THE COLOR TO DRAW

6 SCALE - SCALE FOR PHYSICAL DEVICE

7 ENDFRM - TERMINATE THE DEVICE AND ADVANCE

DEFAULT DEVICE ASSIGNMENTS

TYPE

DIAGNOSTICS

GRAPHICS

CAMERA

CHARACTER SET

CALCOMP

PRINTER

LEXIDATA

MATRIX CAMERA

TEKTRONIX

OPEN SLOT

CONSOLE INPUT

CHARACTER SET

TABLET INPUT

LU RESULT

0 NO OUTPUT

7 NORMAL - ASSIGNED

8 ASSIGNED WITH LEXIDATA

0 UNIT 0 - ASSIGNED

L7: RS232 LINE

PR: WHATEVER

LEX: DMA (L34DVR IN SYSTEM)

LE: RS232

C: CONSOLE

NULL: BIT BUCKET

5

9 (CLOSED THEN OPENED)

8 (CLOSED THEN OPENED - CAMERA AND TABLET CAN

NOT BE ACTIVE SIMULTANEOUSLY)

INTEGER LB, COUNT(5), NFRAME(5), PEN, COMMND, DEVID, PBLK(6)

CHARACTER*8 IDFLTO(5), MATFIL, TABFIL

INTEGER ICODET(2), ICTRLX(2), ICHANX(2,2), SCRATCH(60)

INTEGER HBLANK, HMINUS , HAPOSA, HAPOSB , HASTRA, HASTRB , NHOLD

INTEGER VSNUM(2), TEKRAS(4), LEXRAS(4), HWSIZE(20), CALRAS(4)

INTEGER LPAGE(30,65) , START, LINE, SLASH, ENDIT

INTEGER MATUNT, TABUNT, USPAT(12,4)

LOGICAL LSW, LTSW, OPEN, OPENANY, OPNCAL, OPNLEX, IRVRSE

LOGICAL OPNMAT, OPNTAB, OPENTB

COMMON/ DE VT YP/ I DE V IC , LSW , LTSW , XYCOOD( 4 )

, LUOUT , LPAGE

COMMON/GRFTYP/ ANGLE , IRVRSE , CHS IZE(9 )

, ITKWIT , LUDIAG, LUHSET

C0MM0N/DEVP0S/X1R(5) ,Y1R(5) , X2R( 5) , Y2R( 5

)

COMMON/GRFMOD/LFLMAT(5) , LINWDM( 5) , LCLMAT( 5

)

- 150-
SUBROUTINE DEVICE page 11

373

374

375

376

377

378

379

380

381

382

383

384

385

386

387

388

389

390

391

392

393

394

395

396

397 C

398 C

399 C

400 C

401 C

402 C

403

404

405

406

407

408

409

410

411

412

413

414 C

415 C

416 C

417

418

419 C

420 C

421 C

422 C

423

424

425 C

4 26 C

427 C

EQUIVALENCE ( HWS IZE( 1 )

, CALRAS ) , (HWSIZE( 9 ) , LEXRAS

)

EQUIVALENCE (HWSIZE( 13) , TERRAS)

DATA START, LINE, SLASH, ENDIT/4B( , 4H108H, 4H / , 4H ) /

DATA HBLANR, HMINUS , HAPOSA, HAPOSB, HASTRA, HASTRB

1 /4H , 4H , 4H1 , 4H 1 , 4H*--- , 4H * / DATA OPENANY/.FALSE./ , OPNLEX/ . TRUE,

/

DATA ITIMET/20/, IDLETM/50/, LUDlAG/0/

DATA COUNT/ 5*0/, NFRAME/5*0/, ANGLE/0.0/

DATA TERRAS/ 0,0, 1022 , 768/ , LEXRAS/ 50 , 50 , 32700 , 26 1 60/

DATA CALRAS/0, 0, 10750, 7900/

DATA IDFLI0/'L7: ','PR; LEX: C NULL: '

/

DATA XlR/0, ,0. ,l.E+7,0. ,0./, X2R/2*1279. , 11279000. ,2*1279./

DATA YlR/0. ,0. ,l.E+7,0. ,0./ , Y2R/2*1023. , 1 1023000. ,2*1023./

DATA LUSET/7/, ICODET/ 2 7 , 23/ , ICTRLX/ 3 1

, 24/

DATA ICHANX/27,97, 27, 127/ , OPNCAL/ .TRUE./

DATA NFRAME/5*0/ ,COUNT/5*0/ ,LUHSET/9/ , OPNMAT/ . TRUE .

/

DATA LFUMAT/0,0, 1,0,0/ , LINWDM/ 1,1,2, 1,1/, LCLMAT/5*!/

DATA MATUNT/8/, MATFIL/ ' L14: '/ , TABFIL/ ’ L 1 9

:

' / , TABUNT/8/

DATA XYCOOD/1. ,0. ,1. ,0./, OPNTAB/ . TRUE .

/

DATA CHSIZE/31. ,31. ,0.3,0. 5,0.04,0.58,0. ,0. ,.03/

DATA USPAT/ 3*3640, 3*455, 3*3 640, 3*455, 0,0, 7 78,

992,504,240,240,504,992,778,0,0,2*0,Z20,Z70,ZF8,

Z1FC,Z3FE,Z7FF,4*0,

0,96,240,504,1020,2046,4095,3999,3855,3591,3075,2049/

*** START OF THE SECTION WHICH HANDELS FUNCTIONS

DEVICE

IF(OPENANY) GO TO 1100

IDEVIC = N LUOUT = LUSET

ITRWIT = 40

IF (IDEVIC.lt. 1. OR. IDEVIC. GT. 5) IDEVIC = 4

CLOSE(LUOUT)

OPEN(UNIT=LUOUT, IOSTAT=IOS , ERR=90 1

, FILE=IDFLTO( IDEVIC )

,

1 TYPE='DEVICE' ,SHARE='ERW' , RREY=0 , WREY=0

)

OPENANY = .TRUE.

IF (LUDIAG.NE.O) WRITE ( LUDIAG, 1003 ) IDEVIC

RETURN

ERROR ON CALL TO DEVICE

901 CLOSE(LUOUT)

IF (LUDIAG.NE.O) WRITE ( LUDIAG, 10 14) IDEVIC, lOS

SET A VALUE OF ZERO IN THE DEVICE TYPE TO INDICATE THAT

A DEVICE CAN NOT BE ACCESSED. ADDED 1/24/85

IDEVIC = 0

RETURN

SETDEV - CHANGE THE LOGICAL UNIT

- 151 -
SUBROUTINE DEVICE page 12

428

429

4 30

431

432

433 C

434 C

4 35 C

436

^37

438

4 39

440

441

442

443

444 C

445 C

446 C

44 7 448

449

450

451

452

453 C

454 C

455 C

456

457

4 58

459

460

461 C

462 C

4o3 C

464

465

466

467

468

469 C

470 C

471 C

472

473

474

475

476

477

478 C

479 C

480 C

481

482

ENTRY SETDEV (Nl, N2)

IF (Ni.GT.O) LUSET = Nl

IF (N2.GE.0) LUDIAG = N2

IF (LUDIAG. NE.O) WRITE (LUDIAG, 1005) LUOUT, LUSET

RETURN

NEWFRM

ENTRY NEWFRM

MODE? = i IF ( .NOT.OPENANY) GO TO 1000

COUNT(IDEVIC) = COUNT(IDEVIC) + 1 NFRAME(IDEVIC) = 1 IRVRSE = .FALSE.

IF (LUDIAG. NE.O) WRITE (LUDIAG, 1101) COUNT( IDEVIC)

GO TO (1,2, 3, 4, 5), IDEVIC

FRAME - FORCE A WRITE OF THE BUFFER

ENTRY FRAME

MODE? = 2 IF (.NOT.OPENANY) GO TO 1000

NFRAM£( IDEVIC) = NFRAME( IDEVIC ) + 1 IF (LUDIAG. NE.O) WRITE (LUDIAG, 1001) NFRAME( IDEVIC) , IDEVIC

GO TO (1,2, 3, 4, 5), IDEVIC

ERASE

ENTRY ERASE

MODEP = 3 IF (.NOT.OPENANY) GO TO 1000

IF (LUDIAG. NE.O) WRITE ( LUDIAG, 1 50 1 ) NFRAME( IDEVIC)

GO TO (1,2, 3, 4, 5), IDEVIC

HARD COPY

ENTRY HDCOPY

MODEP = 4

IF (.NOT.OPENANY) GO TO 1000

IF (LUDIAG. NE.O) WRITE (LUDIAG, 1502) NFRAME( IDEVIC)

GO TO (1,2, 3, 4, 5), IDEVIC

COLOR

ENTRY COLOR (N)

MODEP = 5 IF (.NOT.OPENANY) GO TO 1000

ICO LOR = N

IF (LUDIAG. NE.O) WRITE (LUDIAG, 1214) ICOLOR

GO TO (1,2, 3, 4, 5), IDEVIC

SET THE TYPE FOR POLYGON AND CIRCLE FILLING 0, 1, 2, OR 3

ENTRY FILTYP(IFIL)

IF( .NOT.OPENANY) GO TO 1000

- 152 -
SUBROUTINE DEVICE page 13

483

484

485

486

487 C

488 C

489 C

490

491

492

493

494

495

496

497

498

499 C

500 C

501 C

502

503

504

505

506

507

508 C

509 C

510 C

511

512

513

514

515

516

517

518

519

520

521

522

523

524

525

526

527

528

529

530

531

532

533

534

535

536

537

LFLMAT(IDEVIC) = IFIL

IF(LUDIAG.GT.O) WRITE(LUDIAG, 1503) LFLMAT

MODE? = 5 GO TO (1,2, 3, 4, 5), IDEVIC

SET THE SIZE OF THE HARDWARE CHARACTERS

ENTRY CHRSIZ (CHFRZ, GCHFRZ)

IF( .NOT.OPENAxNY) GO TO 1000

IF( CHFRZ. GT.O) CHSIZE(9) = CHFRZ

CHSIZE(l) = CHSIZE(9) * (Y2R( IDEVIC)-Y 1R( IDEVIC)

)

CHSIZE(2) = CHSIZE(l)

IF (GCHFRZ. GT.O) CHSIZE(5) = GCHFRZ

IF(LUDIAG.GT.O) WRITE(LUDIAG, 1505) CHFRZ, GCHFRZ

MODE? = 5 RETURN

SET THE LINE WIDTH

ENTRY LINWID(LINWD)

IF( .NOT.OPENANY) GO TO 1000

LINWDM( IDEVIC) = MAXO(LINWD , 1

)

IF(LUDIAG.GT.O) WRITE(LUDIAG, 1 504) LINWDM

MODEP = 5 GO TO (1,2, 3, 4, 5), IDEVIC

SCALE

ENTRY SCALNG(X1,Y1,X2,Y2,X1H,Y1H,X2H,Y2H,X1S,Y1S,X2S ,Y2S)

IF( .NOT.OPENANY) GO TO 1000

IND = (IDEVIC-1)*4

IF(IDEVIC.EQ. 1) THEN

SCLRAS = 1000.

ELSE

SCLRAS = 1. ENDIF

IF (XlH.GE.0.0) HWSIZE(IND+1) = XIH * SCLRAS

IF (YlH.GT.0.0) HWSIZE(IND+2) = YIH * SCLRAS

IF (X2H.GE.0.0) HWSIZE(IND+3) = X2H * SCLRAS

IF (Y2H.GT.0.0) HWSIZE(IND-l-4) = Y2H * SCLRAS

IF (XlS.NE.0.0) XIR(IDEVIC) = XIS

IF (X2S.NE.0.0) X2R(IDEVIC) = X2S

IF (YlS.NE.0.0) YIR(IDEVIC) = YIS

IF (Y2S.NE.0.0) Y2R(IDEVIC) = Y2S

GO TO 11

ENTRY DEFINE (XI, Yl, X2, Y2)

11 MODEP = 6

IF( .NOT.OPENANY) GO TO 1000

DX = X2 - XI

IF (DX.EQ.0.0) DX = 1.0

XYCOOD(l) = (X2R(IDEVIG) - X1R( IDEVIC) )/DX

XYCOOD(2) = XIR(IDEVIC) - XYCOOD(l)*Xl

DY = Y2 - Yl

IF (DY.EQ.0.0) DY = 1.0

XYCOOD(3) = (Y2R(IDEVIC) - Y 1R( I DEV IC ) ) / DY

-15J-
538

539

540

54 1 542

543

544

545

546

547

543

5-49

550

551

552

553

5 54

555

5 56

557

558

559

560

561

5 62

563

564

565

566

567

568

569

570

571

572

573

574

575

576

577

578

579

580

581

582

583

584

585

586

587

588

589

590

591

592

SUBROUTINE DEVICE page 14

XYC00D(4) = YIR(IDEVIC) - XYCOOD(3)*Yl

IF (LUDIAG.NE.O) WRITE (LUDIAG, 1400) XYCOOD

CHSIZE(l) = CHSIZE(9) * (Y2R(IDEVIC)-Y1R(IDEVIC)

)

CHSIZE(2) = CHSIZE(l)

GO TO (1,2, 3, 4, 5), IDE VIC

C

C ENDFRM - TO CLOSE THE LOGICAL UNIT

C

ENTRY ENDFRM

IF( .NOT.OPENANY) GO TO 1000

MODE? = 7 IF (LUDIAG.NE.O) WRITE (LUDIAG, 1201 ) COUNT( IDEVIC)

,

NFRAME(IDEVIC)

NFRAME( IDEVIC) = 0

GO TO (1,2, 3, 4, 5), IDEVIC

10 CLOSE(7)

OPENANY = .FALSE.

IDEVIC = 0

RETURN

C

C *** START OF THE SECTION WHICH HANDELS THE HARDWARE ***

C

C

C CALCOMP SECTION

C

1 GO TO (101,102,103,103,105,106,107), MODEP

C

C CALCOMP LNITIALIZATION

C

101 CALL CALBUF ( LUOUT , 0 , 1

, IDXX)

IF(OPNCAL) CALL CALPLT (0.0, +1.0, 1007)

OPNCAL = .FALSE.

CALL CALPLT ( FLOAT(CALRAS( 3 ) ) / ( (X2R( 1 )-XlR( 1 ) )*i000. )

,

FLOAT(CALRAS(4))/((Y2R(1)-Y1R(1))*1000. ) , 1001)

CALL CALPEN (1)

LSW = .TRUE.

RETURN

C

C CALCOMP FRAME (FLUSH BUFFER AND RESET, IGNORE HARDCOPY)

C

102 RETURN

C

C ERASE THE SCREEN AND PRINT HARDCOPY ARE IGNORED FOR THE CALCOMP

C

103 RETURN

C

C COLOR SELECTION PRINTOUT.

C

105 PEN = MOD(ICOLOR-l,4) + 1 PEN = MIN0(MAX0(PEN, 1) ,4)

LCLMAT( IDEVIC) = PEN

CALL CALPEN(PEN)

RETURN

C

C CALCOMP AXIS SET.

- 154 -
SUBROUTINE DEVICE page 15

593

594

595

596

597

5 98

599

600

601

602

603

604

C

c

c

c

c

106 CONTINUE

CALL CALPLT ( FLOAT( CALRAS( 3 ) ) / ( (X2R( 1

) -X1R( 1 )

) *1 000. )

FL0AT(CALRAS(4))/((Y2R(1)-Y1R(1))*1000.), 1001)

RETURN

ENDFRM FOR CALCOMP

107 CONTINUE

CALL CALPLT(0. , 0. , 999)

GO TO 10

605

606

607

608

609

610

611

612

613

614

615

616

617

618

C

C

C

C

C

C

C

201

203

211

PAPER PLOT SECTION

GO TO (201,202,203,204,205,206,207), MODEP

PAPER PLOT INITIALIZATION.

THE PAGE PLOT IS OUTPUT AS ONE LARGE VARIABLE FORMAT,

SET UP THE FORMAT STATEMENT IN LPAGE.

CONT INUE

DO 211 J=l,65

LPAGE(2, J)=LINE

LPAGE(30, J)=SLASH

LPAGE(1, 1)=START

LPAGE(30,65)=ENDIT

619 C

620 C SET UP THE PAGE AND CLEAN

621 C

622 DO 221 J = 1, 65

623 DO 221 I = 4, 29

624 221 LPAGE(I,J) = HBLANK

625 DO 222 I = 5, 28

626 LPAGE(I, 1) = HMINUS

627 222 LPAGE(I,63) = HMINUS

628 DO 223 J = 2, 62

629 LPAGE ( 4, J) = HAPOSA

630 223 LPAGE(29,J) = HAPOSB

631 LPAGE (29,1) = HASTRB

632 LPAGE(29,63) = HASTRB

633 LPAGE (4, 63) = HASTRA

634 LPAGE(4, 1) = HASTRA

635 RETURN

636 C

637 C PAPER PLOT- WRITE OUT THE

638 C

639 202 WRITE(LUOUT, LPAGE)

640 RETURN

641 C

642 C HARDCOPY COMMAND

643 C

644 204 RETURN

645 C

646 C COLOR SELECTION PRINTOUT.

647 C

- 155 -
648

649

650

651

652

653

654

655

656

6 57

6 58

659

660

661

662

663

664

665

666

667

668

669

670

671

672

673

674

675

676

677

678

679

680

681

682

683

684

685

686

687

688

689

690

691

692

693

694

695

696

697

698

699

700

701

702

SUBROUTINE DEVICE page 16

205 RETURN

C

C SET SCALING FOR PAGE PLOT

C

206 RETURN

C

C ENDFRM FOR THE PAPER PLOTTER

C

207 WRITE (LUOUT,1212)

GO TO 10 . C

C LE XI DATA/ MATRIX SECTION

C

3 GO TO (301,302,303,304,305,306,307), MODEP . C

C INITIALIZE THE LE XI DATA/ MATRIX - OPEN AND SET THE LUT ONLY

C IF THE DEVICE IS/WAS CLOSED

C

301 IF(OPNLEX) THEN

CALL GSOPN(LUOUT, 1, LIERR)

IF(LIERR.NE.O) GO TO 1002

C

C CURSOR OFFSET - THIS IS INSTALLATION SPECIFIC

C

C

C

C

3001

CALL DSCSLdO, 153, 75)

CALL DSCER

CALL SETLUT ; SET THE DEFAULT LOOK UP TABLE

CALL GSTYPE(3)

SET VIEW CORRESPONDENCE

CALL GDEFVS (1, 15, 0, 1, 4, 0)

CALL GINTVS (1)

CALL GACTVS (1)

CALL GDFWIN (1, XIR(IDEVIC), YIR(IDEVIC), X2R(IDEVIC),

Y2R(IDEVIC)

)

CALL GDFVP (1, LEXRAS(l), LEXRAS(2), LEXRAS(3), LEXRAS(4))

VSNUM(l) = 2 VSNUM(2) = 0

CALL GDFVU (1, 1, 1, VSNUM)

CALL GACTVU(l)

CALL GDASEG

CALL GCRSEG(IOO)

DO 3001 I = 1, 4

CALL GDPAT(100+I, USPAT(1,I))

CALL GCLSEG

CALL GSVUAS(100, VSNUM)

CALL GDLSEG(IOO)

CALL GSIVIS(l)

CALL GSVUAS (0, VSNUM)

C

C DEFINE LOCATOR PORT EXTENTS AND SET TRACKING TYPE

C

CALL GDVINI(DEVID, 2, 1)

CALL GDFLPT(DEVID, LEXRAS( 1 )

, LEXRAS( 2 ), LEXRAS ( 3 ) , LEXRAS (4 )

)

- 156 -
SUBROUTINE DEVICE page L7

703 CALL GSTTRK(DEVID, 2, 1)

704 C

705 C SET ECHO TYPE

7 06 C

707 CALL GSTDVE(DEVID, 1, 1)

708 CALL GDVENB(DEVID)

709 CALL GRSLG (DEVID, 255)

710 OPNLEX = .FALSE.

711 ENDIF

712 C

713 c SET THE PARAMETERS FOR THE LEXIDATA DISPLAY,

714 c 715 CALL GCLSEG

716 CALL DSCLR(-l)

717 CALL GCTSEG

718 CALL GSFTYP(LFLMAT(IDEVIC))

719 CALL GSLWID(LINWDM(IDEVIC))

7 20 CALL GSCHSZ(CHSIZE(2))

721 CALL GSCNDX (1)

722 RETURN

723 c 724 c FRAME - FORCE OUT THE CONTENTS OF THE BUFFER

725 c 726 302 CALL GCLSEG

727 CALL GMPCUR

728 CALL GCTSEG

729 RETURN

7 30 c

731 c ERASE THE SCREEN AND THE CURSOR

732 c 733 303 CALL DSCLR(-l)

7 34 CALL DSCSL (10, 153, 75)

735 RETURN

7 36 c 737 c HARD COPY - CAMERA

7 38 c 739 304 IF(OPNMAT) THEN

740 CLOSE (MATUNT)

741 OPNTAB = .TRUE.

742 OPEN(UNIT=MATUNT , IOSTAT=IOS , ERR=3 14 , FILE=I

743 • TYPE='DEVICE' ,SHARE='ERW , RKEY=0 , WK£Y=0

)

744 OPNMAT = .FALSE.

745 ENDIF

746 IF(LUDIAG.NE.O) WRITE(LUDIAG, 1003) MATUNT

747 CALL SYSIO(PBLK, 41, MATUNT, ' .CE. ' ,4,0)

748 CALL WAIT(ITIMET,2,IOS)

749 RETURN

7 50 c 751 c ERROR ON CALL TO DEVICE

752 c 753 314 CLOSE (MATUNT)

7 54 IF (LUDLAG.NE.O) WRITE (LUDIAG, 1014) MATUNT

755 STOP 'camera can not be accessed'

756 c 757 c SET COLOR - THIS APPLIES TO WHAT IS IN THE LUT

- 157 -
758

759

7bO

761

762

763

764

765

7 66

767

768

769

770

771

772

773

774

775

7 76

777

778

779

780

781

7 82

783

7 84

785

7 86

787

7 88

789

7 90

791

7 92

793

7 94

795

796

7 97

798

7 99

800

801

802

803

804

805

806

807

808

809

810

81

1

812

SUBROUTINE DEVICE page 18

C

305 LEXCOL = MOD( ICOLOR-1 , 1 5) + 1 LEXCOL = MAX0( LEXCOL, 1)

LCLMAT(IDEVIC) = LEXCOL

CALL GSCNDX(LCLMAT(IDEVIC))

CALL GSLWID(LINWDM(IDEVIC))

LFLLEX = LFLHAT(IDEVIC)

IF(LFLLEX.LE.4) THEN

CALL GSFTYP(LFLLEX)

ELSE

CALL GSFTYP(96+LFLLEX)

ENDIF

RETURN

C

C SET THE WINDOW AND AREA OF NORMALIZED DEVICE COORDINATES

C

306 IF(OPNLEX) GO TO 301

CALL GCLSEG

CALL GDAVU(l)

CALL GDFWIN (1, XIR(IDEVIC), YIR(IDEVIC), X2R(IDEVIC),

Y2R(IDEVIC))

CALL GDFVP (1, LEXRAS(l), LEXRAS(2), LEXRAS(3), LEXRAS(4))

CALL GDFVU (1, 1, 1, VSNUM)

CALL GACTVU O)

C

C OPEN A NEW SEGMENT

C

CALL GCTSEG

RETURN

C

C

307 OPNLEX = .TRUE.

IF ( .NOT.OPNMAT) THEN

CLOSE (MATUNT)

OPNMAT = .TRUE.

ENDIF

CALL GCLSEG

CALL GDASEG

CALL GFRAME

CALL DSCLR(-l)

CALL GRSLG(DEVID,255)

CALL GDVDSB(DEVID)

GO TO 10

C

C TEKTRONIX SECTION

C

4 GO TO (401,402,403,404,405,406,407), MODEP

'

C

C TEKTRONIX INITIALIZATION

C

401 CALL TEKINT (120)

CALL SWINDO (TEKRAS ( 1 )

, TEKRAS( 3) ,TEKRAS ( 2 ) ,TEKRAS( 4 )

)

CALL VWINDO (X1R( IDEVIC) , X2R(IDEVIC)-X1R(IDEVIC)

,

YIR(IDEVIC), Y2R(IDEVIC)-Y1R(IDEVIC))

LTSW = .TRUE.

- 158 -
813

814

815

816

817

818

819

820

821

822

823

824

825

826

827

828

829

830

831

832

833

834

835

836

837

838

839

840

841

842

843

844

845

846

847

848

849

850

851

852

853

854

855

856

857

858

859

860

861

862

863

864

865

866

867

SUBROUTINE DEVICE page 19

CALL TEKHOM

CALL TTKSND

CALL WAIT (IDLETM, 1, IS)

RETURN

C

C FRAME (NO MODE SWITCHING)

C

402 CONTINUE

CALL TTKSND

CALL WAIT (IDLETM, 1, IS)

RETURN

C

C ERASE THE SCREEN

C

403 CONTINUE

CALL TEKHOM

CALL TEKERA

CALL TOUTST (2, ICTRLX)

CALL TTKSND

CALL WAIT (IDLETM, 1, IS)

RETURN

C

C ISSUE HARD COPY COMMAND

C

404 CONTINUE

CALL TOUTST (2, ICODET)

CALL TEKHOM

CALL TTKSND

CALL WAIT (ITIMET, 2, IS)

RETURN

C

C COLOR - DOES NOT APPLY TO ADM OR TEKTRONIX 4054

C

405 CONTINUE

RETURN

C

C SET SCREEN CORRESPONDENCE

C

406 CONTINUE

CALL SWINDO(TEKRAS(l) ,TEKRAS(3) ,TEKRAS(2) ,TEKRAS(4))

CALL VWINDO (X1R( IDEVIC) , X2R( I DEVIC )-XlR( I DE VIC )

,

YIR(IDEVIC), Y2R(IDEVIC)-Y1R(IDEVIC)

)

RETURN

C

C END THE FRAME ON THE ADM OR TEK 4054

C

407 CALL TEKHOM

CALL TOUTST (2, ICTRLX)

CALL TTKSND

CALL WAIT (IDLETM, 1, IS)

CALL SVSTAT (SCRATCH)

GO TO 10

C

C SLOT FOR AN EXTRA DEVICE

C

- 159 -
868

869

870

871

872

873

874

875

876

:S77 878

8 79

880

881

882

883

884

885

886

887

888

889

890

891

892

893

894

895

896

897

898

899

900

901

902

903

904

905

906

907

908

909

910

91

1

912

913

914

915

916

917

918

919

920

921

922

SUBROUTINE DEVICE page 20

5 STOP 74

C

C DELAY IN SECONDS FOR HARD COPY UNITS

C

ENTRY DELAY(ITIME)

ITIMET = ITLME

RETURN

C

C IOWA IT

C

ENTRY lOWAIT(IT)

CALL WAIT (IT, 1, IS)

RETURN

C

C GET THE DEVICE ID FOR THE LEXIDATA TRACKING TYPE

C

ENTRY LEXDID(IDVL)

IDVL = DEVID

RETURN

C

C OPEN ACCESS TO THE TABLET - IF POSSIBLE

C

ENTRY TABLET (OPENTB)

OPENTB = .FALSE.

IF(OPNTAB) THEN

IF(.NOT.OPNMAT) CLOS E(MATUNT)

OPEN(UNIT=TABUNT , IOSTAT=IOS , ERR=1 304 , FILE=TABFIL,

TYPE= 'DEVICE ' ,SHARE='ERW' ,RKEY=0,

WKEY=0)

OPNTAB = .FALSE.

OPENTB = .TRUE.

OPNMAT = .TRUE.

ELSE

IF(LUDIAG.GT.O) WRITE( LUDIAG, 1302)

OPENTB = .TRUE.

END IF

RETURN

C

C THE TABLET HAS GENERATED AN ERROR

C

1304 CLOSE(TABUNT)

IF ( LUDIAG. GT.O) WRITE(LUDIAG, 1303) TABUNT,IOS

STOP 'can not access tablet'

C

C PUNISH IF NOT INITIALIZED.

G

1000 IF (LUDIAG. NE.O) WRITE (LUDIAG, 1004) MODEP, IDEVIC

IDEVIC = 0

RETURN

1002 IF (LUDIAG. NE.O) WRITE(LUDIAG, 1013)LIERR

STOP 'Lexidata can not be accessed'

1100 IF (LUDIAG. NE.O) WRITE( LUDIAG, 1006) IDEVIC

RETURN

C

C FORMATS

- 160-
SUBROUTINE DEVICE page 21

923 C

924 1001 FORMAT (

' FRAMES PLOTTED = ',15,' ON DEVICE ',13

925 1003 FORMAT (

' DEVICE = ',12,' INITIALIZED')

926 1004 FORMAT (' DEVICE NOT INITIALIZED. 215)

927 1005 FORMAT (

' LUOUT = ',13,' AND WILL BE SET TO ',13,

928 •

' AT TEE NEXT CALL TO "DEVICE"')

929 1006 FORMAT (

' DEVICE ',13,' IS ALREADY OPEN')

930 1013 FORMAT (

' CAN NOT OPEN LEXIDATA, ERROR =',I3)

931 1014 FORMAT (

' DEVICE ',13,' CAN NOT BE ACESSED, ERROR

932 1101 FORMAT (

FRAME NUMBER ',15,' INITIALIZED')

933 1201 FORMAT (

’ PLOTTER CLOSED WITH' ,215,

FRAMES')

934 1212 FORMAT (

' 1')

935 1214 FORMAT (

COLOR SELECT = ',13)

936 1302 FORMAT (

' CAMERA IS ALREADY AVAILABLE')

937 1303 FORMAT (CAMERA ',13,' CAN NOT BE ACESSED, ERROR

938 1400 FORMAT (

' FACTOR ',4F8.2)

939 1501 FORMAT (ERASE COMMAND ISSUED AT FRAME ',15)

940 1502 FORMAT (

' HARDCOPY COMMAND ISSUED AT FRAME ',15)

941 1503 FORMAT (SET THE FILL TYPE FOR SURFACES ',513)

942 1504 FORMAT (

' SET THE LINE WIDTH ',513)

943 1505 FORMAT ( ' :SET THE CHARACTER SIZE (%) ',2F6.3)

944 END

M3)

,13)

- 16 L-
SUBROUTINE DEVINP page 22

945

946

947

948

949

9 50

951

952

953

954 C

955 C

95b C

957

958

959

960

961

962

963

964

965

966

967 C

968 C

969 C

970

971

972

973

9 74

975

976 C

977 C

978 C

979

980 C

981 C

982 C

983

984

985

986

987

988

989

990

991

992

993 C

994 C

995 C

996

997

9 98

999

SUBROUTINE DEVINP( INPUT , BTMASK, IDV, X,Y, Z)

LOGICAJ. JFIRST/.TRUE./ , TFIRST/ . TRUE. / , KFIRST/ . TRUE . /

INTEGER BTMASK,DEVID,PBLK(6) ,TLOOK(4)/l,2,4,8/

CHARACTER*! INST( 2 ) /Z IB ,

' A

7

CHARACTER*20 DATAIN

COMMON/ DEVT YP/ IDEVIC , LSW , LTSW , XYCOOD( 4 )

, LUOUT , LPAGE

COMMON/ TXXDAT/ TAB IN , TABWIN , TAB XYC

REAL TABIN(2) ,TABWIN(4) ,TABXYC(4)

C0MM0N/DEVP0S/X1R(5) ,Y1R(5) ,X2R(5) , Y2R(5)

SELECT THE INPUT FROM THE DEVICE CODE

X = 0. Y = 0. Z = 0.

IDV = 0

IF( INPUT.lt. 1.0R.INPUT.GT.3) RETURN

IF(INPUT.NE. l.AND. (.NOT.JFIRST)) THEN

CALL DSCSL (10, 153, 75)

JFIRST = .TRUE.

ENDIF

GO TO (10, 20, 30), INPUT

GET THE DEVICE ID FOR THE JOYSTICK

10 IF(JFIRST) THEN

CALL LEXDID(DEVID)

CALL GDFBGF(DEVID, 15, 0, IDUM)

CALL DSCSL (8, 153, 75)

JFIRST = .FALSE.

ENDIF

SET APPROPRIATE LIGHTS

CALL GSLTG(DEVID, BTMASK)

READ THE LOCATOR

XWC = 0,0

YWC = 0.0

3 CALL GRBTG(DEVID, IDV)

IDV = IAND(IAND( IDV, BTMASK), 15)

IF(IDV.EQ. 0) GO TO 3 ; NO SWITCH HAS BEEN TOGGLED

CALL GSLC(DEVID, IDVV, LCX, LCY, XWC, YWC)

IF(LCX.LT.O) GO TO 3

CALL GRSLG (DEVID, 255)

2 CALL GRBTG (DEVID, IDVV)

IF(IDVV.NE.O) GO TO 2

NORMALIZE TO <RE>WINDOWED COORDINATES

X = (XWC-XYCOOD(2)) / XYCOOD( 1

)

Y = (YWC-XYCOOD(4)) / XYGOOD(3)

Z = 0.0

RETURN

- 162 -
LOGO

iOOl

1002

1003

1004

1005

1006

1007

1008

1009

1010

1011

1012

1013

1014

1015

1016

1017

1018

1019

1020

1021

1022

1023

1024

1025

1026

1027

1028

1029

1030

1031

1032

1033

1034

1035

1036

1037

1038

1039

1040

1041

1042

1043

1044

1045

1046

1047

SUBROUTINE DEVINP

page 23

C

C THE TABLET HAS BEEN SELECTED

C

20 IF(TFIRST) THEN

TFIRST = .FALSE.

CALL TABLET(OPENTB)

IF(IDEVIC.EQ.O) THEN

DX = 1280.

DY = 1024.

ELSE

DX = (X2R(IDEVIG)-X1R(IDEVIC)) / XYCOOD(l)

DY = (Y2R(IDEVIC)-Y1R(IDEVIC)) / XYCOOD(3)

ENDIF

TABXYC(l) = 8.2034E-5 * DX

TABXYC(2) =0.0

TABXYC(3) = 1.0938E-4 * DY

TABXYC(4) =0.0

ENDIF

21 CALL SYSIO(PBLK,72,8,DATAIN,20,0)

READ(DATAIN, 22,ERR=21) IX,IY,IBT

22 F0RMAT(1X,I5,2X,I5, 1X,I2)

IF(IBT.EQ.O) GO TO 21

C

C CONVERT THE CURSOR BUTTON TO A STANDARD FORMAT

C

IDV = TLOOK(IBT)

IDV = IAND(BTMASK, IDV)

IF(IDV.EQ.O) GO TO 21

TABIN(l) = IX

TABIN(2) = lY

X = FLOAT(IX)*TABXYC( 1) + TABXYC(2)

Y = FLOAT(IY)*TABXYC(3) + TABXYC(4)

Z = 0.0

RETURN

C

G INPUT FROM THE KEYBOARD

C

30 CALL SYSIO ( PBLK, 4 1 , 5

,

' X, Y , Z , IDV = ',12,0)

READ(5,32,END=33,ERR=30) XCOR,YCOR,ZCOR, IDV

32 FORMAT(3F,I)

X = XCOR

Y = YCOR

Z = ZCOR

IDV = IAND(BTMASK, IDV)

RETURN

33 IDV = BTMASK

RETURN

END

- 163 -
1048

1049

1050

1051

1052

1053

1054

1055

105b

1057

1058

1059

1060

1061

1062

1063

1064

1065

1066

1067

1068

1069

1070

1071

1072

1073

1074

SUBROUTINE ENUMBR page 2k

SUBROUTINE ENUMBR (REALNO, XRl, YRl, XR2 , YR2)

C

Q************A**********************************************************

C ENUMBR

(^***********************************************************************

C

DX = (XR2 - XR1)/10.0

THE NO = REALNO

EXPON = 0.001

IF (REALNO .EQ. 0.0) GO TO 10

12 IF (ABS(THENO) .LT. 10.0) GO TO 11

EXPON = EXPON + 1.0

THENO = THENO*0. 1000001

GO TO 12

11 IF (ABS(THENO) .GE. 1.0) GO TO 10

EXPON = EXPON - 1.0

THENO = THENO*9. 99999

GO TO 11

10 CALL FNUMBR (XRl, YRl, DX, 0.0, 0. 7*DX, 0.0, YR2-YR1,

1 THENO, 5, 2)

CALL WDDRAW (XR1+5.0*DX, YRl, DX, 0.0, 0.7*DX, 0.0,

1 YR2-YR1, '*101.')

CALL FNUMBR (XR1+8.0*DX, ( YR1+YR2) /2. 0 , 0.66*DX, 0.0,

1 0.75*DX, 0.0, 0.64*(YR2-YR1) , EXPON, 3, 0)

C 1 0.50*DX, 0.0, 0.6*(YR2-YR1) , EXPON, 3, 0)

RETURN

END

- 164 -
1075

1076

1077

1078

1079

1080

1081

1082

1083

1084

1085

1086

1087

1088

1089

1090

1091

1092

1093

1094

1095

1096

1097

1098

1099

1100

1101

1102

1 103

1104

1105

1106

1 107

1 108

1 109

1110

nil

1 112

1113

1114

1115

1116

1117

1118

1 1 19

1120

1 121

1122

1123

1124

1 125

1 126

1127

1 128

1 129

SUBROUTINE FNUMBR page 23

SUBROUTINE FNUMBR (XSTART, YSTART, DX, DY, SX, SXY, SY,

1 NUMBR, WIDTH,

C

c X REAL

c

c Y REAL

c

c DX REAL

c

c DY REAL

cc SX REAL

c SXY REAL

c SY REAL

c RNUMB REAL

c WIDTH INTEGER

c DIGITS INTEGER

C

DIGITS)

X COORDINATE (MATHEMATICAL SPACE) OF THE FIRST

CHARACTER TO BE DRAWN

Y COORDINATE (MATHEMATICAL SPACE) OF THE FIRST

CHARACTER TO BE DRAWN

INCREMENT TO BE ADDED TO THE X COORDINATE FOR

EACH CHARACTER DRAWN

INCREMENT TO BE ADDED TO THE Y COORDINATE FOR

EACH CHARACTER DRAWN

X MATH SPACE SIZE FOR CHARACTERS

SIANT MODIFIER FOR CHARACTERS

Y MATH SPACE SIZE FOR CHARACTERS

NUMBER TO BE PLOTTED IN F FORMAT

TOTAL WIDTH OF FIELD INCLUDING DECLMAL POINT

NUMBER TO FRACTIONAL PLACES TO BE DRAWN

REAL NUMBER, NUMBR, TEST(6)

INTEGER WIDTH, DIGITS, NL’M, NN(22)

LOGICAL SPACE

INTEGER WORD(7), HASTR, HTEMP, SFIL(3)

INTEGER TEXT(13)

CHARACTER*! WWORD(28), BLANK, HMINUS

DATA TEXT /Z00000030, Z00000031, Z00000032, Z00000033,

1 Z00000034, Z00000035, Z00000036, Z00000037,

2 Z00000038, Z00000039, Z00000020, Z0000002E,

3 Z0000007C /

DATA SFIL / '*1..', ’**1.’, '***V /

DATA HMINUS, HASTR / ’- ', '****’ /, BLANK/' '/

EQUIVALENCE (WORD( 1 ) ,TEST( 1 ) ,WWORD( 1 ) )

11 = 1 12 = 1 NUMBER = ABS(NUMBR)

IF (DIGITS. EQ.O) NUM = NUMBER +0.5

IF (DIGITS. EQ.O) GO TO 5 C

WIDTH = WIDTH - 1 NUM = NUMBER*10**DIGITS +0.5

5 DO 10 I = 1, WIDTH

J = WIDTH - I + 1 NN(J) = NUM - 10*(NUM/10)

C

C BREAK OUT THE DIGITS.

C

NUM = NUM/10

10 CONTINUE

J = WIDTH - DIGITS

IF(J .NE. 0) GO TO 18

WORD(l) = TEXT(ll)

II = II + 1 GO TO 25

18 SPACE = .TRUE.

DO 20 K = 1,J

- 165 -
1130

I 131

1 132

1133

1134

1135

1136

1137

1 138

1 139

1 140

1 141

1 142

i 143

1 144

1 145

1 146

1 147

1 148

1 149

1 150

1 151

1 152

1 153

1 154

1155

1 156

1157

1 158

1 159

1 160

1 161

1 162

1163

1164

1 165

1 166

1167

1168

1 169

1 170

1 171

1172

1 173

1174

1175

1176

1177

1178

1179

1 180

1181

1182

1 183

1184

SUBROUTINE FNUMBR page 26

I = NN(K)

C

C LEADING ZERO = SPACE

C

IF (I.NE.O) SPACE = .FALSE.

IF(K .EQ. J .AND. SPACE) SPACE = .FALSE.

IF (I.EQ.O. AND. SPACE) I = 10

II = II + 1 HTEMP = ISliFT(W0RD(I2) , 8)

W0RD(I2) = IOR(HTEMP, TEXT (1+1))

IF(I1 .LT. 5) GO TO 20

12 = 12 + 1 11 = 1 20 CONTINUE

IF (DIGITS. EQ.O) GO TO 40

C

C PUT IN DECIMAL POINT

C

25 II = II + 1 HTEMP = ISHFT(W0RD(I2) , 8)

W0RD(I2) = lOR ( HTEMP, TEXT( 12))

IF(I1 .LT. 5) GO TO 26

12 = 12 + 1 II = 1 26 DO 30 K = 1, DIGITS

I = NN(J+K)

II = II + 1 HTEMP = ISHFT(W0RD(I2), 8)

W0RD(I2) = I0R(HTEMP,TEXT(I+1)

)

IF(I1 .LT. 5) GO TO 30

12 = 12 + 1 11 = 1 30 CONTINUE

WIDTH = WIDTH + 1 C

C PUT IN (END OF TEXT)

C

40 II = II + 1 HTEMP = ISHFT(WORD(I2) , 8)

WORD(I2) = IOR(HTEMP,TEXT(13))

IF(I1 .LT. 5) GO TO 42

12 = 12 + 1 II = 1 42 HTEMP = ISHFT(WORD(I2) , 8)

WORD(I2) = IOR(HTEMP,TEXT(12))

C

C LEFT JUSTIFY LAST WORD.

C

44 II = II + 1 IF(I1 .GE. 5) GO TO 46

WORD(I2) = ISHFT(WORD(I2) , 8)

GO TO 44

C

C PUT IN THE MINUS SIGN

C

- 166 -
SUBROUTINE FNUMBR page 27

1 185 46 IF (NUMBR .GE, 0.0) GO TO 50

1186 IF (WWORD(l).NE. BLANK) GO TO 60

1187 NUMMX = 4 * 12

1 188 DO 47 I = 2, NUKMX

1 189 IP = I

1 190 IF(WWORJ)(I).NE. BLANK) GO TO 48

1 191 47 CONTINUE

1192 48 WWORD(IP-l) = HMINUS

1 193 GO TO 50

1 194 60 12 = WIDTH/4

1 195 IF(I2 .EQ. 0)GO TO 64

1 196 DO 62 K = 1, 12

1 197 62 WORD(K) = HASTR

1 198 64 11 = WIDTH - 4*12

1 199 IF(I1 .GT. 0) WORD(I2+l) = SFIL(Il)

1200 C

1201 50 CALL WDDRAW(XSTART,YSTART,DX,DY,SK,SXY, SY,WORD)

1202 RETURN

1203 END

-L67-
SUBROUTINE GRAEIT page 28

1204 SUBROUTINE OIAflT (NPL,Xl,X2,XlR,X2R.IXl,IX2,Yi,Y2,YlR,Y2R,IYl,

L205 IY2, XTIT.NDVX , YTIT, NDVY)

1206 C

1207 C NPL INTEGER - THE NUMBER OF THE PLOT REFERENCED. UP TO FOUR

1208 C PLOTS MAY BE PLACED ON ONE OlAPH

1209 C XI REAL - A FLOATING POINT NUMBER, THE lABEL OF THE X

1210 C AXIS MINIMUM. THE LITERAL STRING ''NONE'

1211 C PRODUCES NO LABEL

1212 C X2 REAL - A FLOATING POINT NUMBER, THE LABEL OF THE X AXIS

1213 C MAXIMUM. THE LITERAL STRING 'NONE'' PRO1214 C DUCES NO LABEL

1215 C XIR REAL - THE USER SPACE VALUE OF THE X AXIS MINIMUM

1216 C X2R REAL - THE USER SPACE VALUE OF THE X AXIS MAXIMUM

1217 C IX

1

REAL - THE MINIMUM VALUE OF X IN THE DATA TO BE PLOTTED

1218 C 1X2 REAL - THE MAXIMUM VALUE OF X IN THE DATA TO BE PLOTTED

1219 C Y1 REAL - A FLOATING POINT NUMBER, THE LABEL OF THE Y

1220 C AXIS MINIMUM. THE LITERAL STRING ''NONE'

1221 C PRODUCES NO LABEL.

1222 C Y2 REAL - A FLOATING POINT NUMBER, THE LABEL OF THE Y 1223 C AXIS MAXIMUM. THE LITERAL STRING ' NONE'

1224 C PRODUCES NO LABEL

1225 c YIR REAL - THE USER SPACE VALUE OF THE Y AXIS MINIMUM

1226 c Y2R REAL - THE USER SPACE VALUE OF THE Y AXIS MAXIMUM

1227 c lYl REAL - THE MINIMUM VALUE OF Y IN THE DATA TO BE PLOTTED

1228 c IY2 REAL - THE MAXIMUM VALUE OF Y IN THE DATA TO BE PLOTTED

1229 c XT IT CHAR - A STRING OF LITERAL CHARACTERS TERMINATED BY

1230 c A 1. THIS IS THE TITLE FOR THE X AXIS AND

1231 c SHOULD BE LESS THAN 30 CHARACTERS

1232 c NDVX INTEGER - THE NUMBER OF INTERVALS TO BE DRAWNI ON THE

1233 c X AXIS

1234 c YTIT CHAR - A STRING OF LITERAL CHARACTERS TERMINATED BY

1235 c A 1. THIS IS THE TITLE FOR THE Y AXIS AND

1236 c SHOULD BE LESS THAN 30 CHARACTERS

1237 c NDVY INTEGER - THE NUMBER OF INTERVALS TO BE DRAWN: ON THE

1238 c Y AXIS

1239 c 1240 c ENTRY POINTS (WITH ARGUMENTS):

1241 c 1242 c PLOTCH (NPL,X,Y ,N,CHARAC) - PLOTS ALPHANUMERIC CHARACTERS AT THE

1243 c COORDINATES PROVIDED

1244 c X REAL - A ONE DIMENSIONAL ARRAY CONTAINING THE

1245 c COORDINATES FOR X

1246 c Y REAL - A ONE DIMENSIONAL ARRAY CONTAINING THE

1247 c COORDINATES FOR Y

1248 c N INTEGER - THE NUMBER OF ENTRIES IN 'X' AND 'Y '. IF 'N' = 1249 c NO COORDINATES ARE PLOTTED.

1250 c PC HR CHAR*! A SINGLE CHARACTER TO BE USED FOR PLOTTING

1251 c 1252 c PLOTLN (NPL,X,Y ,N) - PLOTS STRAIGHT LINES THROUGH THE COORDINATES

1253 c PROVIDED. ARGUMENTS ARE THE SAME AS FOR

1254 c PLOTCH.

1255 c 1256 PARAMETER (NLINES=200,NPLTMX=4)

1257 REAL IXl, 1X2, lYl , IY2, NONE, HOLD(12,NPLTMX), WX(NLINES)

1258 REAL CC(16), C(I6) , WY(NLINES)

- 168 -
SUBROUTINE GRAF IT page 29

1259

1260

1261

1262

1263

1264

1265

' 1266

1267

1268

. 1269

1270

1271

1272

1273 C

1274 C

1275 C

1276 C

1277 C

1278 C

1279 C

1280

1281

1282

1283

1284

1285

1286

1287

1288

1289

1290

1291

1292

1293

1294

1295

1296

1297

1298

1299

1300

1301

1302

1303

- 1304

1305

1306

.1307

1308 C

1309 C

1310 C

1311

1312

1313

CHARACTER*! XTIT(NDVX), YTIT(NDVY) , PCHR, TITL£(132)

INTEGER IX, lY, IT, NTX, NTY, INDX(16)

DIMENSION X(l), Y(l) , XL(1), YB(1), XR(1), YT(1)

LOGICAL PLOTON(NPLTMX)/NPLTMX*. FALSE./

LOGICAL LLABPL(NPLTMX) /NPLTMX*. FALSE.

/

DIMENSION NTICX(NPLTMX) ,NTICY(NPLTMX) ,XMINO(NPLTMX) ,XMAX0 (NPLTMX)

DIMENSION YMINO(NPLTMX) , YMAXO( NPLTMX)

COMMON /DEVTYP/ IDEVIC , LSW , LTSW ,XYCOOD( 4 )

, LUOUT , LPAGE

COMMON/ GRFTYP/ ANGLE , IRVRSE , CHS IZ E ( 9 )

, ITKWIT , LUD LAG

DATA NONE/ 'NONE'/

DATA CC/.0500, .0600, .0310, .0600, . 11, . 15,

.0800, .0781, .1780, .2500, .0300, .0315, .0600, .040,

.020,. 025/

DATA LNDX/ 3, 3, 3, 9, 9, 9, 3, 3, 3, 3, 9, 9, 9, 3, 3, 9/

THIS ROUTINE LNITIALIZES A GRAPHICS GRID OR CONTOUR DIAGRAM

WITH A FULL SET OF LABELS AND SWITCHES THE REST OF THE CONTOUR

GRAPHICS MATERIAL TO THE GRAPHICS MODE.

DEFINE THE PLOTTING REGIONS.

CHSIZE(4) = .44

IF(NPL.GT.NPLTMX.OR.NPL.LT. 1) STOP 72

PLOTON(NPL) = .TRUE.

HOLD(l,NPL) = XI

HOLD(2,NPL) = X2

HOLD(3,NPL) = XIR

HOLD(4,NPL) = X2R

HOLD(5,NPL) = IXl

HOLD(6,NPL) = 1X2

HOLD(7,NPL) = Y1

HOLD(8,NPL) = Y2

HOLD(9,NPL) = YIR

HOLD(iO,NPL) = Y2R

HOLD(ll,NPL) = lYi

HOLD(12,NPL) = IY2

IF(LLABPL(NPL)) THEN

HOLD(l,NPL) = XMINO(NPL)

HOLD(2,NPL) = XMAXO(NPL)

HOLD(5,NPL) = XMINO(NPL)

HOLD(6,NPL) = XMAXO(NPL)

HOLD(7,NPL) = YMINO(NPL)

HOLD(8,NPL) = YMAXO(NPL)

HOLD(ll,NPL) = YMINO(NPL)

HOLD(12,NPL) = YMAXO(NPL)

ENDIF

CALL BOXPLT (XIR, YIR, X2R, Y2R)

DO 11 I = 1, 16

11 C(I) = CC(I) * (HOLD(INDX(I)+l,NPL)-HOLD(INDX(I),NPL))

DETERMINE NUMBER OF CHARACTERS IN AXIS TITLES.

TITLE(l) =« 't' TITLE(2) =• 'M' MAXT - 130

- 169 -
SUBROUTINE GRAF IT page 30

13U

1 315

1 316

1317

1318

1 319

1 320

1 321

1 322

1 323

1 324

1 325

1326

1327

1328

1329

1330

1331

1332

1333

1334

1 335 C

1336 C

1 337 C

1338

1339

1340

1341

1342

1343

1344

1345

1346

1347

1348

1349

1350

1351

1352

1353

1354

1355

1356

1357

1358

1359

1360

1361 C

1362 C

1363 C

1364

1365

1 366

1367

1368

CALL WDCOUNT(XTIT, NTX)

IF (NTX.LT.l) THEN

IF (LUDIAG.GT.O) WRITE (LUDIAG, 12)

ELSE

DO 15 I = 1, MAXT

15 TITL£(I+2) = XTIT(I)

C(8) = (X2R+XlR)/2.

XRR = C(8) + NTX*C(1)

CALL L^BEL(TITLE, C(8), Y1R-C(6), XRR, Y1R-C(6 )+C( 1 3) , 0.0)

END IF

12 FORMATC NO ESCAPE SEQUENCE IN TITLE - GRAFIT')

CALL WDCOUNT(YTIT, NTY)

IF(NTY.LT.l) THEN

IF (LUDIAG.GT.O) WRITE (LUDIAG, 12)

ELSE

C(ll) = (Y1R+Y2R) / 2.

DO 16 I = 1, MAXT

16 TITL£(I+2) = YTIT(I)

CALL LABEL(TITLE, X1R-C(7), C( 1 1 ) , X1R-C( 7 )+NTY*C( 1 )

,

. C(11)-K:( 13), 1.5707)

ENDIF

DECIDE WHICH LABELS TO USE

IF(L1ABPL(NPL)) THEN

CALL FNUMBR (XIR-C(IO), Y1R-C(16), C(3), 0.0,

C(2),0.0,C(4) , YMINO(NPL), 6, 1)

CALL FNUMBR (XIR-C(IO), Y2R-C(16), C(3), 0.0,

. C(2) ,0.0,C(4) , YMAXO(NPL), 6, 1)

CALL FNUMBR (X1R-C(9), Y1R-C(5), C(3), 0.0,

C(2) ,0.0,C(4) , XMINO(NPL), 6, 1)

CALL FNUMBR (X2R-C(9), Y1R-C(5), C(3), 0.0,

C(2),0.0,C(4) , XMAXO(NPL), 6, 1)

ELSE

IF(Yl.NE.NONE)

CALL FNUMBR (XIR-C(IO), Y1R-C(16), C(3), 0.0,

C(2),0.0,C(4), Yl, 6, 1)

IF(Y2.NE.N0NE)

CALL FNUMBR (XIR-C(IO), Y2R-C(16), C(3), 0.0,

C(2),0.0,C(4), Y2, 6, 1)

IF(Xl.NE.NONE)

CALL FNUMBR (X1R-C(9), Y1R-C(5), C(3), 0.0,

C(2),0.0,C(4), XI, 6, 1)

IF(X2.NE.N0NE)

CALL FNUMBR (X2R-C(9), Y1R-C(5), C(3), 0.0,

C(2),0.0,C(4), X2, 6, 1)

ENDIF

PUT TIKS ON THE GRAPH IF THE NUMBER IS GREATER THAN ZERO.

IF(LLABPL(NPL) ) THEN

NDVXLL = NTICX(NPL)

NDVYLL = NTICY(NPL)

ELSE

NDVXLL = NDVX

- 170-
1369

1370

1371

1372

1373

1374

1375

1376

1377

1378

1379

1380

1381

1382

1383

1384

1385

1386

1387

1388

1389

1390

1391

1392

1393

1394

1395

1396

1397

1398

1399

1400

1401

1402

1403

1404

1405

1406

1407

1408

1409

1410

1411

1412

1413

1414

1415

1416

1417

1418

1419

1420

1421

1422

1423

SUBROUTINE GRAPH page 31

NDVYLL = NDVY

ENDIP

IP (NDVXLL.GT. 1) THEN

DELX = (X2R - X1R)/PL0AT(NDVXLL)

DO 3 I = 1, NDVXLL-1

XX = XIR + PLOAT(I)*DELX

3 CALL LINE (XX, YIR, XX, Y1R+C(16))

DO 7 I = 1, NDVXLL-1

XX = XIR + PLOAT(I)*DELX

7 CALL LINE(XX, Y2R, XX, Y2R-C(16))

END IP IP ( NDVYLL. GT. 1) THEN

DELY = (Y2R - Y1R)/PL0AT( NDVYLL)

DO 4 I = 1, NDVYLL-i

YY = YIR + FLOAT(I)*DELY

4 CALL LINE (XIR, YY, X1R+C(15), YY)

DO 8 I = 1, NDVYLL-1

YY = YIR + FLOAT(I)*DELY

8 CALL LINE(X2R, YY, X2R-C(15), YY)

END IP

RETURN

C

ENTRY PLOTCH (NPL, X, Y, N, PCHR)

C

IF (N.LE.O) RETURN

IF(NPL.GT.NPLTMX.OR.NPL.LT. 1) STOP 72

IF( .NOT.PLOTON(NPL) ) RETURN

DX = (HOLD(4,NPL)-HOLD(3,NPL)) / (HOLD( 6 , NPL)-HOLD( 5 , NPL) ) DY=(HOLD(10,NPL)-HOLD(9,NPL))/(HOLD(12,NPL)-HOLD(i 1,NPL) ) CHSIZE(2) = (HOLD(iO,NPL)-HOLD(9,NPL) ) * XYCOOD(3) * CHSIZE(5)

NLM = 1 13 1ST = NLM

NLM = MIN(NLM-1+NLINES, N)

DO 5 I = 1ST, NLM

WX(I-IST+1) = HOLD(3,NPL) + DX * (X( I )-HOLD( 5 , NPL)

)

5 WY(I-IST+1) = HOLD(9,NPL) -(- DY * (Y( I )-HOLD( 1 1 , NPL) ) CALL CHPLOT (WX, WY, PCHR, 1, 1, NLM-IST+i)

IF(NLM.LT.N) GO TO 13

CHSIZE(2) = CHSIZE(l)

RETURN

C

ENTRY PLOTLN (NPL, X, Y, N)

C

IF (N.LE.O) RETURN

IF(NPL.GT.NPLTMX.OR.NPL.LT. 1) STOP 72

IF( .NOT.PLOTON(NPL)) RETURN

DX = (HOLD(4,NPL)-HOLD(3,NPL)) / (HOLD(6 , NPL) -HOLD( 5 , NPL)

)

DY=(HOLD(10,NPL)-HOLD(9,NPL))/(HOLD(12,NPL)-HOLD( 1 1,NPL)

)

NLM = 1 14 1ST = NLM

NLM = MIN(NLM-1+NLINES,N)

DO 6 I = 1ST, NLM

WX(I-IST+1) = HOLD(3,NPL) + DX * (X( I )-HOLD( 5 , NPL)

)

6 WY(I-IST+1) =• HOLD(9,NPL) + DY * (Y( I )-HOLD( 1 1 , NPL) ) CALL LNPLOT (WX, WY, 1, 1, NLM-IST+1)

- 171 -
SUBROUTINE GRAF IT page 32

1424

1425

142b C

1427

1428 C

1429

1430

1431

1432

1433

1434

1435

1436

1437

1438

1439

1440

1441

1442

1443

1444

1445

1 446

144 7 1448

1449

1450

1451

1452

1453

1454

1455

1456

1457

1458

1459

1460

1461

1462

1463

1464

1465

1466

1467

1468 C

1469

1470 C

1471

1472

1473 C

1474

1475

1476

1477

1478

IF(NLM.GE.N) RETURN

GO TO 14

ENTRY PLOTBAR (NPL, XL, YB , XR, YT , N, VALUE)

IF (N.LE.O) RETURN

IF(NPL.GT.NPLTMX.OR.NPL.LT. 1) STOP 72

IF(.NOT.PLOTON(NPL)) RETURN

DX = (HOLD(4,NPL)-HOLD(3,NPL)) / (HOLD(6 , NPL)-H0LD( 5 , NPL)

)

DY = (tiOLD(10,NPL)-HOLD(9,NPL)) / (HOLD( 1 2, NPL)-HOLD( 1 1 , NPL) ) NLM = 1 20 1ST = NLM

XI = XO =

Y1 = YO = WX(i)

WX(2)

WX(3)

WX(4)

WY(1)

WY(2)

WY(3)

WY(4)

DX

DX

DY

DY

(XR(I)-HOLD(5,NPL))

(XL(I)-tiOLD(5,NPL))

(YT(I)-HOLD(li,NPL))

(YB(I)-HOLD(ll,NPL))

NLM = MIN (NLM-l+N LINES, N)

CALL LIN’WID(l)

DO 21 I = 1ST, NLM

HOLD(3,NPL)

HOLD(3,NPL)

HOLD(9,NPL)

HOLD(9,NPL)

XO

XO

XI

XI

YO

Y1

Y1

YO

CALL PLYGON(WX, WY, 4)

TX = XI - XO

TY = H0LD(10,NPL) - H0LD(9,NPL)

IDIGIT = 0

IF (ABS( VALUE). LT. 10. ) IDIGIT = 1 NDIG = 3

IF( ABS( VALUE). GE. 1000. ) NDIG = 4

YOFF = Y1 - .02 * TY

IF (VALUE.lt. 0.0) YOFF = YO - 0. 15 * TY

FAC = 1. / FLOAT(NDIG)

XST = FAC * .95

IF(VALUE.NE.O.O) CALL FNUMBR(X0+0. 01*TX, YOFF, ; -.025->+.01

. FAC*TX,0.0,XST*TX, 0.0,0. 12*TY,ABS( VALUE) , NDIG, IDIGIT)

21 CONTINUE

CALL LINWID(3)

IF(NLM.GE.N) RETURN

GO TO 20

ENTRY GRISET (XL, YB , XR, YT)

CALL DEFINE (XL, YB, XR, YT)

RETURN

ENTRY GRILAB (NPL, XLL, YBT, XRT, YTT)

DX = (XRT-XLL) / 3.

DY = (YTT-YBT) / 3.

XINTl = 10.**(INT(ALOG10(DX)))

YINTl = 10.**(INT(ALOG10(DY)))

- 172 -
1479

1480

1481

1482

1483

1484

1485

1486

1487

1488

1489

1490

1491

1492

1493

1494

1495

1496

1497

1498

1499

1500

1501

1502

1503

1504

1505

1506

1507

1508

1509

1510

1511

1512

1513

1514

1515

SUBROUTINE GRAF IT page 33

XINT2 = DX / XINTl

YINT2 = DY / YINTl

IF(XINT2. LT. 2.0) THEN

DX = XINTl

ELSE IF (XINT2.lt. 5.0) THEN

DX = 2.*XINT1

ELSE IF (XINT2.LT. 10. ) THEN

DX = 5.*XINT1

ELSE

DX = 10.*XINT1

ENDIF

IF(YINT2.LT.2.0) THEN

DY = YINTl

ELSE IF (YINT2.lt. 5.0) THEN

DY = 2.*YINT1

ELSE IF (YINT2.lt. 10. ) THEN

DY = 5.*YINT1

ELSE

DY = 10.*YINT1

ENDIF

XINT2 = XLL / DX

YINT2 = YBT / DY

IF(XINT2.LT.0.0) XINT2 = XINT2 - 0.99999

IF(YINT2.LT.0.0) YINT2 = YINT2 - 0.99999

XMINO(NPL) = DX * (INT(ABS(XINT2))*SIGN(1. ,XINT2))

YMINO(NPL) = DY * (INT ( ABS( YINT2 ) )*S IGN ( 1 . , YINT2 ) ) XINT2 = XRT / DX

YINT2 = YTT / DY

IF(XINT2.GT.0.0) XINT2 = XINT2 + 0.99999

IF(YINT2.GT.0.0) YINT2 = YINT2 + 0.99999

XMAXO(NPL) = DX * ( INT( ABS( XINT2 ) )*S IGN( 1 ., XINT2 )

)

YMAXO(NPL) = DY * (INT( ABS( YINT2) )*S IGN( 1 ., YINT2)

)

NTICX(NPL) = (XMAXO(NPL)-XMINO(NPL)+0. 5) / DX

NTICY(NPL) = (YMAX0(NPL)-YMIN0(NPL)+0. 5) / DY

LLABPL(NPL) = .TRUE.

RETURN

END

- 173 -
SUBROUTINE HHDRAW page 34

1516 SUBROUTINE HHDRAW (XCHAR, YCHAR, SX,SXY,SY, CHNUMB, SET, lERR)

1517 C

1518 C XCHAR REAL - X STARTING COORDINATE OF THE CHARACTER TO BE

1519 C DRAWN

1520 c YCHAR REAL - Y STARTING COORDINATE OF THE CHARACTER TO BE

1521 c DRAWN

1522 c SX REAL - X MATH SPACE SIZE FOR CHARACTERS

1523 c SXY REAL - SLANT MODIFIER FOR CHARACTERS

1524 c SY REAL - Y MATH SPACE SIZE FOR CHARACTERS

1525 c CHNUMB INTEGER - INDEXX TO IDENTIFY CHARACTERS WITHIN THE SPECI1 526 c FIED SET

1527 c SET INTEGER - NUMBER SPECIFYING A PARTICULAR CHARACTER SET

1528 c 1529 c 1530 REAL XCHAR, YCHAR, SX, SXY, SY,X(1 28) ,Y( 128)

1531 INTEGER M, CHNUMB, SET , PEN( 1 28) , ERROR, lERR

1532 CHARACTER*! CHRIRV

1533 COMMON /DEVTYP/ IDEVIC , LSW , LTSW , XYCOOD(4 )

, LUOUT , LPAGE

1534 COMMON/GRFTYP/ ANGLE , IRVRSE , CHS IZE( 9 )

, ITKWIT , LUDIAG , LUHSET

1535 c 1536 c 1537 lERR = 1 1538 IF (SET.GT.l) GO TO 3 1539 IF (SET.LT.l) RETURN

1540 c 1541 IRV = IREVCH( CHNUMB, CHRIRV)

1 542 CALL SYMBOL(XCHAR+CHSIZE(7) ,YCHAR+CHSIZE(8) , CHRIRV)

1543 RETURN

1544 c 1545 3 CALL HSETS (CHNUMB , X, Y , PEN, N , SET-1 , ERROR)

1546 IF(ERROR.NE.O) RETURN

1547 lERR = 0

1548 c 1549 M = N

1550 IF (M.EQ.O) RETURN

1551 c 1552 c ROTATE COORDINATES IF ANGLE>0.0

1553 c 1554 SXP = ABS(XYCOOD(l))

1555 SYP = ABS(XYCOOD(3)

)

1556 OSXP =1. /SXP

1557 OSYP =1. /SYP

1558 SXP = SXP * SX

1559 SYP = SYP * SY

1560 DO 9 I = 1, M

1561 X(I) = X(I) * 0.216 * SXP

1562 9 Y(I) = Y(I) * 0.0800 * SYP + X(I) * SXY

1563 IF (ANGLE. EQ. 0.0) GO TO 4

1564 SINX = SIN(ANGLE)

1565 COSX = COS (ANGLE)

1566 DO 6 I = 1, M

1567 XP = X(I)*COSX - Y(I)*SINX

1568 YP = X(I)*SINX + Y(I)*COSX

1569 X(I) = XP

1570 6 Y(I) = YP

- 174 -
SUBROUTINE HHDRAW page 35

1571

1572

1573

1574

1575

1576

1577

1578

1579

1580

1581

1582

1583

1584

1585

1586

1587

1 588

1589

1590

1591

1592

1593

1594

4 DO 1 I = 1, M

X(I) = X(I) * OSXP

1 Y(I) = Y(I) * OSYP

ADD THE ABSOLUTE POSITION

DO 7 I = 1, M

X(I) = X(I) + XCHAR

7 Y(I) = Y(I) + YCHAR

WRITE THE CHARACTER AS A SET OF CONNECTED STROKES

IS = 1 IL = IS

10 IF(PEN(IL+1).EQ.O.OR. IL.GE.M) GO TO 2

IL = IL + 1 GO TO 10

2 IF(IL.GT.IS) CALL LINES(X(IS) , Y( IS) ,X(IS+1) , Y( IS+1 )

, IL-IS)

LF(IL.GE.M) RETURN

IL = IL + 1 IS = IL

GO TO 10

RETURN

END

- 175 -
SL^ ROUTINE HSETS page 36

1595 SUBROUTINE HSETS (CHNU’MB.XX.YY, PEN, N, SET, ERROR)

1596

1597

1598

1599

1600

1601

1602

1603

1 604

1605

1606

1607

1608

1609

IblO

loll

1612

1613

1614

1615

1616

1617

1618

1619

1620

1621

1622

1623

1624

1625

1626

1627

1628

1629

1630

1631

1632

1633

1634

1635

1636

1637

1638

1639

1640

1641

1642

1643

1644

1645

1646

1647

1 648

1649

C

C***** **************************************************** **************

C HSETS

C* ************************************************************* *********

cC THIS SUBROUTINE RECEIVES A SET NL'MBER AND A CHARACTER NUMBER

C AND SEARCHES THROUGH 'HSETS.DAT' (FILE CONTAINING THE PACKED

C HERSHEY CHARACTER SUBSETS) TO FIND THE CHARACTER'S COORDINATES

C AND CORRESPONDING 'PEN' VALUES.

C

PARAMETER(MAXSET=23,MAX1=24)

LOGICAL FOPEN/. FALSE./

INTEGER IN(125, 96) ,IOS, CHAR, SET, COORD, ERROR

INTEGER CHNUMB,PEN( 125) ,MASK1 , MASK2 , TABLE(MAX1

)

INTEGER FIRST, LAST, NCHAR(MAXSET) ,TT(64) , IOB(64) , lOBC

EQUIVALENCE (TT( 1 ) ,TABLE( 1 ) ) , (TT( 33) , NCHAR( 1 )

)

DATA MASK2/ZFFFF/ ,MASK1/Z7FFFFFFF/ ,NSET/-1/

REAL XX(125) ,YY( 125)

COMMON/GRFTYP/ ANGLE , IRVRSE, CHS IZE( 9 )

, ITKWIT , LUDIAG , LUHSET

C

C OPEN FILE CONTAINING PACKED HERSHEY CHARACTER SETS IF NOT

C PREVIOUSLY OPENED

C

IF(SET.EQ.NSET. AND. FOPEN) GO TO 41

CLOSE(LUHSET)

C

C OPEN A NEW FILE FOR THE PACKED HERSHEY CHARACTER SUBSETS

C

OPEN(UNIT=LUHSET , IOSTAT=IOS , ERR=50 , FILE= ' S YS : HI . CAT/ S

'

,

* ACCESS= 'DIRECT' , FORM= 'BINARY ' , RECL=256 , S IZE=7 30

,

* BLOCKS IZ E=2 56 , TYPE= ' CONT IG '

)

REWIND LUHSET

FOPEN=.TRUE.

IF( LUDIAG. NE.O) WRITE(LUDIAG, 20) LUHSET

20 FORMAT (' HSET CHARACTER FILE OPENED TO UNIT =',I3)

C

C READ STARTING RECORD POSITIONS OF THE SETS INTO 'TABLE'

C READ THE NUMBER OF CHARACTERS' IN EACH SET INTO 'NCHAR'

C

READ( LUHSET) TT

C

C CHECK THAT THE SET AND CHARACTER NUMBERS ARE VALID

C

ERROR=0

IF(SET.GT.MAXSET) THEN ;SET NOT IN FILE

ERROR=l

GO TO 52

ENDIF

IF(CHNUMB.GT.NCHAR(SET)) THEN .CHARACTER NOT IN SET

ERROR=2

GO TO 52

ENDIF

C

C READ THE CHARACTERS' COORDINATES INTO THE 'IN' ARRAY

- 176 -
1650

1651

1652

1653

1654

1655

1656

1657

1658

1659

1 660

1661

1662

1663

1 664

1665

1666

1667

1668

1669

1670

1671

1672

1673

1674

1675

1676

1677

1678

1679

1680

1681

1682

1683

1684

1685

1686

1687

1688

1689

1690

1691

1692

1693

1694

1695

1696

1697

1698

1699

1700

1701

1702

1703

1704

SUBROUTINE HSETS page 37

C

NSET = SET

FIRST=TABLE(SET) ;FIRST RECORD OF SET

LAST=TABLE(SET+i) - 1 ,LAST RECORD OF SET

CHAR=1

C00RD=0

DO 30 I=FIRST,LAST

READ(LUHSET,REC=I) lOB

C

C STORE DATA IN ARRAY ELEMENTS FOR 1 CHARACTER AT A TIME

C

J=0

32 J=J+i

COORD=COORD+l

IN(COORD,CHAR)=IOB( J)

IF((IOB(J).NE.MASKi).AND.(J.LT.64)) GO TO 32

C

C END OF CHARACTER FOUND; READ COORDINATES FOR NEXT CHARACTER

C

IF(I0B(J).EQ.MASK1) THEN

CHAR=CHAR+1

C00RD=0

IF(CHAR.GT.NCHAR(SET)) GO TO 31

ENDIF

IR(J.LT.64) GO TO 32

30 CONTINUE ;READ NEXT RECORD

31 CLOSE (LUHSET)

C

C UNPACK THE DATA FOR THE SPECIFIED CHARACTER & DETERMINE THE REAL

C VALUES OF THE COORDINATES AND THE INTEGER VALUE OF THE PEN.

C

41 N=0

40 IF(IN(N+i,CHNUMB).EQ.MASKl) RETURN ;END OF CHARACTER

N=N+1

C

C FIND THE ’PEN’ VALUE & ELIMINATE 'PEN' BIT FROM PACKED WORD

C

PEN(N)=ISHFT(IN(N,CHNUMB) ,-31)

IOBC=IAND(IN(N,CHNUMB) ,MASK1)

C

C FIND THE X & Y COORDINATES

C

XX(N)=(ISHFT(IOBC,-16))/100.00

YY(N)=(IAND(IN(N,CHNUMB) ,MASK2) )/ 1 00.

0

GO TO 40 ;UNPACK NEXT COORDINATE AND PEN VALUE

C

C ERROR

C

50 ERROR = lOS

IF(LUDIAG.NE.O) WRITE( LUDIAG, 5 1 ) lOS

51 FORMATC ERROR IN HSET - UNABLE TO OPEN CHARACTER FILE, ERROR =',

. 14)

52 CLOSE(LUHSET)

RETURN

END

- 177 -
INTEGER FUNCTION IDCHAR page 38

1705

1706

1707

1708

1709

1710

1711

1 712

1713

1714

1715

1716

1717

1718

1719

1720

1721

1722

1723

1724

1725

1726

1727

1728

1729

1730

1731

1732

1733

17 34

1735 C

1736 C

1737 C

1738 C

17 39 C

1740

1741

1742

1743

1744 C

1745 C

1746 C

1747 C

1748

1749

17 50

1751

1752

INTEGER FUNCTION IDCHAR (CHARX)

C

(^***********************************************************************

C IDHCAR

Q********* ************* **********x*** ************************** * ********

C

LOGICAL ZERO?/. TRUE./

INTEGER IDN(128), CHAR, KA, MASK/127/

CHARACTER*! CHARX, CHARXX(4) , JA(4), CHRIRV

CHARACTER*8 ASCII(16)

CHARACTER*! ASCIII(128)

EQUIVALENCE ( CHAR, CHARXX)

EQUIVALENCE (JA,KA), (ASCII ,ASCIII)

DATA ASCII/ '01234567' , '89ABCDEF' , 'GHIJKLMN' , 'OPQRSTUV ,

. 'WXYZabcd' , 'efghijkl '

, 'mnopqrst ', 'uvwxyz %',

')[]§rr<','>“"

4*' '/

C

C THIS ROUTINE INITIALIZES TH£ IDENTITY ARRAY ID TO THE IDENTITY

C NUMBER OF THE ACCEPTED ASCII TERMINAL CHARACTERS.

C

IF(ZEROP) THEN

DO 2 I = 1, 128

2 IDN(I) = 127

DO 1 I = 1, 128

JA(4) = ASCIII(I)

KA = IAND(KA, MASK)

1 IF(IDN(KA+1).EQ. 127) IDN(KA+1) = I ZEROP = .FALSE.

ENDIF

THIS INTEGER FUNCTION RETURNS THE IDENTITY NUMBER OF THE ONE

BYTE CHARACTER ENTERED THROUGH THE ARGUMENT LIST AS A CHARACTER*!

VARIABLE.

CHARXX(4) = CHARX

CHAR = IAND(CHAR, MASK)

IDCHAR = IDN(CHAR+1)

RETURN

THIS ENTRY REVERSES THE CHARACTER PROCESS - USED BY HHDRAW WHEN

CALLING SYMBOL. CHANGES THE NUMBER BACK INTO A CHARACTER

ENTRY IREVCH (ICHR, CHRIRV)

IREVCH = 0

IF( ICHR. GE. 1. AND. ICHR. LE. 128) CHRIRV = ASCIII(ICHR)

RETURN

END

- 178 -
SUBROUTINE LABEL page 39

17 53

1754

1755

1756

1757

1758

. 1759

1760

1761

1762

°1763

1764

1765

1766

1767

1768

SUBROUTINE LABEL (CHARS, XL, YB , XR, YT , ANGLE)

COMMON /DEVTYP/ IDEVIC , LSW, LTSW , XYCOOD( 4 )

, LUOUT , LPAGE

COMMON/GRFTYP/ XNGLE , IRVRSE , CHS IZE( 9 )

, ITKWIT , LUDIAG , LUHS ET

CHARACTER*! CHARS(*)

CALL WDCOUNT( CHARS, NC)

IF(NC,LE.O) THEN

IF(LUDIAG.GT.O) WRITE(LUDIAG, 3) (CHARS( I) , 1=1 , 132)

3 FORMATC NO ESCAPE SEQUENCE IN LABEL , IX, 1 32A1

)

RETURN

ENDIF

DX = (XR - XL) / MAX(1. , FLOAT (NO)

DY = (YT - YB)

XNGLE = ANGLE

CALL WDDRAW (XL, YB , DX, 0.0, DX, 0.0, DY, CHARS)

RETURN

END

- 179 -
I 769

1770

1771

1 772

1773

1 774

1775

1776

1777

1778

1779

1780

1781

1782

1783

17 84

1785

17 86

1787

1788

1789

1790

1791

1792

SUBROUTINE LINE page 40

SUBROUTINE LINE (XI, Yl, X2, Y2)

C

C LINE

Q***********************************************************************

C

COMMON /DEVTYP/ IDEVIC , LSW , LTSW , XYCOOD( 4 )

, LUOUT , LPAGE

C

C THIS ROUTINE PLOTS A LINE FROM (XI, Yl) TO (X2,Y2).

C THE PRESENT ALGORITHM ALWAYS PLOTS FROM THE CURRENT LOCATION TO

C THE TARGET POINT THUS INSURING PERFECT LINE CONTINUITY.

C

C

REAL IX 1, 1X2, lYl, IY2, IDX, IDY

C

IXl = XYCOOD(l)*Xl + XYCOOD(2)

1X2 = XYCOOD(i)*X2 + XYCOOD(2)

lYl = XYCOOD(3)*Yl + XYC00D(4)

IY2 = XYCOOD(3)*Y2 + XYCOOD(4)

IDX =1X2 - 1X1

IDY = IY2 - lYl

CALL PUTLNV ( 1X1 , lYl , IDX, IDY, 1

)

RETURN

END

- 180-
1793

1794

1795

1796

1797

1798

1799

1800

1801

1802

1303

1804

1805

IS 06

1807

1808

1809

1810

181 1 1312

1313

1814

1315

1816

1317

1318

1319

1820

1321

1822

1823

1824

o

SUBROUTINE LINES page 41

SUB ROUT INE LINES ( XI , Y 1 , X2 , Y2 , NL)

C

C THIS SUBROUTINE PLOTS LINES FROM (X1(J),Y1(J)) TO (X2( J )

, Y2( J) ) C ;^HILE CONVERTING TO RASTER NUMBERS THROUGH SCALE.

C

(^ **************** ****************************** A ************ **Ax**x* * * G LINES

Q*** ** * **************************************** *************************

G

PARAMETER (NLINES=200)

GOMMON /BE^/TYP/ IDEVIC , LSW , LTSW ,XYCOOD( 4 ) ,LUOUT,L?AGE

GOMMON/ GRFTYP/ANGLS , IRvUSS , CHS IZ £( 9 )

, ITKWIT , LUDIAG , LUHSET

REAL Xl(NL) ,X2(NL) ,Yi(NL) ,Y2(NL)

REAL IXi(NLINES), lYl(NLINES), IDX(NLINES), IDY(NLINES)

NLM = NL

12 = 1 5 li = 12

12 = MIN0(I2-1+NLINES,NL)

NLMIN =12-11+1

DO 10 I = II, 12

IXl ( I-I 1+1 ) =XYGOOD( 1

) *X1 ( I )+XYGOOD( 2

)

IDX(I-Il+l)=XYGOOD( i)*X2(I)+XYGQOD(2)-IXl(I-Il+l)

IYi( I-I 1+1 ) =XYGOOD( 3

) *Y 1 ( I )^XYGOOD( 4

)

iO IDY(I-I1+1)=XYGOOD(3)*Y2(I)+XYGOOD(4)-IY1(I-I1+I)

G

GALL PUTLNV(IX1,IY1, IDX,IDY, NLMIN)

IF (I2.GE.NL) RETURN

GO TO 5 RETURN

END

1 O }
SUBROUTINE LNPLOT page 42

1325

132b C

1327

1328

1329

1330

1331 C

1332

1333

133*4

.b35

133 b M37

.333

1339

1340

1341

1342

13^3

1844

13^5

134b

1347

SUBROUTINE LNPLOT (XARRAY, YARRAY, II, 12, 13)

PARAMETER (NLINES=200)

REAL XARRAY(l), YARRAY(i)

REAL XA(NLINES) ,YA(NLINES) ,XB(NLINES) ,YB(NLINES)

INTEGER II, 12, 13, 1ST, I, NOPTS , NOPT

N0PTS=(I3-I1+I2)/I2-1

IST=Ii

2 NOPT=NOPTS

NOPT = MINO (NLINES ,NOPT)

DO 1 1=1, NOPT

:U ( I ) =X.4RRAY (I3T+I2*I-I2)

YA ( I ) = YAR.RAY(I3T+I2*I-I2)

:Q( I ) =XARRAY ( IST+I2*! ) YB( I ) =Y-\RRAY( IST+I2*! )

1 CONTINUE

CALL LINES (XA,YA,XB,YB, NOPT)

NOPTS=NOPTS-NOPT

IST=IST+I2*N0PT

IF( NOPTS. GT.O) GO TO 2 RETITIN

END
1852

1853

1854

1855

1856

1857

r358

1359

1860

1861

1362

1863

1364

1365

1866

1867

1368

i869

1870

1871

1872

1873

1874

1875

1376

1377

1878

1879

1880

1831

1882

1883

1884

1335

1836

1337

1838

1889

1890

1891

1892

1893

SUBROUTINE MAP IN page 44

SUBROUTINE MAP IN (MAPFIL,

. WIN, XYZ, NV, NE, NES , NEX, NP, NPS , NPX)

C

PARAMETER (NVM=4000 , NEM=400 , NPM=400)

CHARACTER* 16 MAPFIL

REAL XYZ(3,NV), WIN(4)

INTEGER NP(8,NPM), NPS(4,NPM), NE(2,NEM), NES(4,NEM)

LOGICAL FIRSTC/.TRUE./

C

C INITL4LIZE THE COUNTERS THE FIRST TIME THRU THIS ROUTINE

C

IF(FIRSTC) THEN

NV = 0

NEX = 0

NPX = 0

FIRSTC = .FALSE.

ENDIF

C

C OPEN AND INPUT A STRUCTURES FILE

C

NVl = N'TM NEl = NEM

NPl = NPM

CALL PLYPLT (MAPFIL, 0)

GALL PLYGNS(WIN, XYZ(1,NV+1), NVl, N£(1,NEX+1), NES ( 1

, NEX+1 )

,

. NEl, NP(1,NPX+1), NPS(1,NPX+1) , NPl)

IF(NVl.LE.O) RETURN

C

C UPDATE THE EDGE AND POLYGON POINTERS

Vj DO 132 I = NEX+1, NEX+l+NEl

DO 132 J = 1, 2 132 NE(J,I) = NE(J,I) + NV

DO 133 I = NPX+1, NPX+l+NPl

DO 133 J = 1, 8

IF(NP(J,I).GT.O) NP(J,I) = NP(J,I) + NV

133 GONTLNUE

NV = NV + NVl

NEX = NEX + NEl

NPX = NPX + NPl

RETURN

END

_ I u »
1^94

1595

1896

1897

1898

18 99

1900

1901

1902

1903

1 90^ :905

SUBROUTINE MAPOUT page 45

SUBROUTINE MAPOUT(WIN, XYZ , NV, NE , NES , NEX, NP, NPS , NPX)

C

SINCLUDE BUILD.COM (NLIST)

REAL XYZ(3,NV), WIN(4)

INTEGER NP(NPVERT.NPX) , NPS (NSPEC , NPX) , NE(2,NEX), NES (NSPEC , NEX)

C

CALL DEFINE(WINd) ,WIN(2) ,WIN(3) ,WIN(4))

CALL PLYPL4(NE,NEX,XYZ ,WIN,NES)

CALL PLYPL5(NP,NPX,XYZ ,WIN,NPS ,NPVERT)

CALL FRAME

RETURN

END
SUBROUTINE PLYGON page 46

1906

1907

1908

1909

1910

1911

f912

1913

1914

1915

1916

1917

1913

1919

1920

1921

1922

1923

1924

1925

1926

1927

1923

SUBROUTINE PLYGON(X, Y, N)

C

C DRAW A COMPLETE POLYGON AND FILL IT WITH 'LFLMAT'

C

PARAMETER (NPMAX=32)

GOMMON/DEVTYP/ IDEVIC , LSW , LTSW , XYCOOD( 4 )

, LUOUT , LPAGE

COMMON/GRFMOD/LFLMAT(5) ,LINWDM(5) ,LCLMAT(5)

DIMENSION X(N), Y(N) , XL(2*NPMAX)

r* IFdDEVIG.EQ. 0) RETURN

NL = MINOCNPMAX, N)

•30 TO (1, 1,3, 1, 1) , IDEVIC

1 DO 11 I = i, N-i

11 CALL LINE(X(I), Y(I), X(I+1), Y(I+1))

CALL LINE(X(N), Y(N), X( 1 ) , Y( 1 )

)

?^TURN

3 DO 31 I = 1, NL

XL(2*I-1) = MAX(X(I) * XYCOOD(l) + XYC00D(2), 0.0)

31 XL(2*I) = MAX(Y(I) * XYGvDOD(3) + XYC00D(4) , 0.0)

GALL a30VA(XL(l), XL(2))

CALL GPOLA (XL(3), NL-1)

RETURN

END
L':)29 1930

1931

1932

933

193-4

1935

1936

i937

.938

1939

-940

194 1 .94 2 194 3

: 9^ -4 1945

1946

194 7 194 3

-949

1950

1951

l952

1953

1954

1955

1956

1957

1953

l959

i960

1961

1962

1963

1

9

64

1965

1966

1967

1968

1969

1970

1971

1972

1973

1974

1975

1976

1977

1978

1979

1980

1981

1982

1983

o

o

n

r:

o

oo

SUBROUTINE PLYPLl page 47

C

C

C

C

C

rC

G

C

C

cc

G

G

G

r

cG

G

G

G

G

10

C

G

G

G

G

G

C

SUBROUTINE PLYPLl (GBOOSE , ENDSTR, SSTART , SFIRST, SLAST, SVALID,

II BLANK)

THIS ROUTINE FINDS POSITIONS OF SUBSTRINGS WITHIN A GHARACTER

STRING. GOMMAS -4ND SPAGES ARE SUBSTRING DELIMITERS. WHEN

A VALID SUBSTRING IS FOUND, ITS FIRST AND LAST CHARAGTER

POSITIONS ARE RETURNED TO THE GALLING ROUTINE.

THIS ROUTINE ALSO INGLUDES THE OPTION OF GONSIDERING A GROUP

OF BLANKS SET OF BY GOMMAS TO BE A VALID SUBSTRING. IF SUGH

A SUBSTRING IS FOUND, THE POSITIONS OF THE FIRST -AND LAST

3LANKS ARE .NOT RETURNED, BUT RATHER IHE POSITIONS OF THE

DELLM ITERS (GOMMAS).

7A-RLA3LES USED:

GFIND = POSITION OF 1ST COMMA FOUND (IF ’BLANK’ OPTION SET)

CHOOSE = I.NTEGER GO-NTAINING GHARACTER STRING

ENDSTR = NUMBER OF C-4ARACTERS IN THE ENTIRE STRING

IB LANK = 'BLANK' FLAG

(inpuc) = 0 - BLANKS NOT VALID SUBSTRING

(input) = 1 - BLANKS FOLLOWED BY i COMMA - VALID SUBSTRING

(input) = 2 - BLANKS FOLLOWED BY 2 COMMAS - VALID SUBSTRING

(output )= -1,-2 - SPECIFIED BLANKS (1 OR 2) FOUND

SFIRST = POSITION OF FIRST CHARACTER OF SUBSTRING

3LAST = POSITION OF LAST CHJ^RACTSR OF SUBSTRING

SSTART = STARTING POSITION FOR SUBSTRING SEARCH

STRING = CHARACTER ARRAY CONTAINING THE CHARACTER STRING

SVALID = 'V-ALID SUBSTRING' FLAG

= TRUE - VALID SUBSTRING FOUND

= FALSE - NO VALID SUBSTRING FOUND

LOGICAL SVALID

I-NTEGER SF IRST , SLAST , SSTART , ENDSTR

INTEGER I3LANK, GFIND, CHOOSE(20) ,STR(20)

CHARACTER*! STRING( 30 ), SPACE/ '

' / , CR/ ZD/ , COMMA/ Z2C/

EQUIVALENCE ( STR , 3TRI.NG)

-ASSUME V-\LID SUBSTRI-NG

SVALID=.TRUE.

FORM AN EQUIVALENT CHARACTER STRING

DO 10 1=1,20

STR(I)=CHOOSE(I)

INVALID STARTING POSITION - PAST END OF STRING

IF(ENDSTR.LT. SSTART) GO TO 40

FIND POSITION OF FIRST ELEMENT OF SUBSTRING

CFIND-0

DO 20 I=S START, ENDSTR

SF IRST-I

-I
L984

1985

1986

1987

1988

1989

1990

1991

1992

1993

1994

1995

1996

1997

1998

1999

2000

2001

2002

2003

2004

2005

2006

2007

2008

2009

2010

2011

2012

2013

2014

2015

2016

2017

2018

2019

2020

2021

2022

2023

2024

2025

2026

2027

2028

2029

2030

2031

2032

2033

2034

2035

2036

SUBROUTINE PLYPLl page 48

C A COMMA FOUND

C

IF (IBLANK.NE.O.AND.STRING(I).EQ.COMMA) THEN

C

G FOUND FIRST COMMA

C

IF (CFIND. EQ.O) THEN

CFIND=I

IF (IBLANK. EQ. 2) GO TO 20

END IF

C

G FOUND BLANK SUBSTRING; NOTE POSITIONS OF DELIMITERS (COMMAS)

C

SLAST=SFIRST

SFIRST=CFIND

IB LANK=-I BLANK

GO TO 100

END IF

C

C FOUND FIRST CHARACTER OF SUBSTRING - NOW FIND LAST

G

IF((3TRING(I).NE. SPACE). AND. ( STRING( I ) , NE. CR) . AND.

1 (STRING(I).NE.COMMA)) GO TO 60

20 CONTINUE

C

C NO SUBSTRING FOUND - ONLY DELIMITER

C

WRITE(6,998)

998 FORMAT (

’ REACHED THE END WITHOUT FINDING A NON-BLANK CHARACTER')

GO TO 40 , G

C FIND POSITION OF LAST CHARACTER OF SUBSTRING

G

60 IF (SFIRST.EQ. ENDSTR) GO TO 45

DO 50 J=SFIRST+1 , ENDSTR

3LAST=J-1

G

C FOUND SUBSTRING DELLMITER - CAN RETURN NOW

G

IF((STRING(J).EQ. SPACE). OR. (STRING(J).EQ. COMMA)) GO TO 100

50 CONTINUE

C

G NO SUBSTRING DELIMITER =«> LAST CHARACTER OF SUBSTRING IS THE

C LAST CHARACTER OF THE STRING

C

45 SLAST=«ENDSTR

GO TO 100

C

G NO SUBSTRING FOUND

C

40 SVALID-. FALSE.

100 RETURN

END
2037

2038

2039

2040

204 1 2042

2'J43

2044

204 5 2046

2047

20^8

2049

2050

2051

2052

2053

2054

2055

2056

2057

2053

2059

2060

2061

2062

2063

2064

2065

2066

2 Ob 7

o

n

c")

SUBROUTINE PLYPL2 page 49

C

C

c

cc

c

c

c

c

c

cc

c

c

c

SUBROUTINE PLYPL2 (WINDOW , OPENN .WORLD)

READ WINDOW COORDINATES AND STORE THEM IN 'WINDOW' ARRAY. ALSO

CHECK VALIDITY OF COORDINATES. IF VALID, 'OPENN' IS TRUE;

OTHERWISE, 'OPENN' IS FALSE. WINDOW COORDINATES WILL BE STORED

AS FOLLOWS:

INDEX / WINDOW( INDEX)

1 left

2 bottom

3 right

4 top

LOGICAL OPENN

REAL WINDOW(4) ,WCRLD(6)

INITIALIZE

OPENN=. FALSE. ;ASSUME LNVALID COORDINATES

CHECK VALIDITY OF WINDOW COORDINATES

DO 30 1=1,2

IF ( WINDOW ( I ).GE. WINDOW (1+2)) RETURN ;INVALID COORDINATES

30 CONTINUE

C

C WINDOW COORDINATES VALID

C

OPENN=.TRUE.

RETURN • END

_ 1 « Q
2068

2069

2070

2071

2072

2073

2074

2075

2076

2-077

2078

2079

2080

2081

2082

2083

2084

2085

2086

2087

2088

2089

2090

2091

2092

2093

2094

2095

2096

2097

2098

2099

2100

2101

2102

2L03

2104

2105

2106

2107

2108

2109

2110

2111

2112

2113

2114

ni5

2116

2117

2118

2119

2120

2121

2122

SUBROUTINE PLYPL3 page 50

SUB ROUT IN E PLYPL3 ( ARRAY , NARRAY , SP , N PNT , N VE RT

)

G

C THIS SUBROUTINE PLOTS VERTICES FOUND WITHIN THE WINDOW AND THEIR

C CORRESPONDING LINE NUMBERS.

C

INTEGER CHARAC/’. '/, NARRAY , CHR , NPNT(NVERT) , DIGITS

REAL ARRAY(3, NARRAY) ,SP(4) ,NUM,NL'MBR,SSP(4)

REAL NX,NY,XINC,XSTART

COMMON/ PLS CMR/ DOZ , WCX , WGY , FANGLE , TANAL

COMMON/DEVTYP/IDEVIC , LSW , LTSW , XYGOOD(4 )

, LUOUT , LPAGE

G

C DEFINE THE WINDOW SPACE

C

DO 1 I = 1, 4

1 SSP(I) = XYCOOD(I)

CALL DEFINE(3P(1) ,S?(2) ,SP(3) ,SP(4)

)

C

C PLOT 1 '7ERTEX AND NUMBER AT A TIME

G

DO 20 1=1, NARRAY

G

G DO NOT PLOT A 'DELETED' VERTEX

G

IF(NPNTd).EQ.O) GO TO 20

C

C ADD PERSPECTIVE

G

D = DOZ/((DOZ-l-ARRAY(3,I))*TANAL)

XX = ( ARRAY (1,1) -WCX) *D + WCX

YY = (ARRAY(2, I)-WCY)*D -t- WCY

C

C DO NOT PLOT A VERTEX WHICH IS OUTSIDE OF WINDOW

C

IF((XX,LT.SP(1) ).OR. (XX.GT.SP(3))) GO TO 20

IF((YY.LT.SP(2) ).OR. (YY.GT.3P(4))) GO TO 20

G

C PLOT THE VERTEX USING THE CHARACTER MODE OF THE HARDWARE

C

CALL SYMBOL(XX,YY, CHARAC)

C

C SCALE MULTIPLIERS FOR NUMBERS

C

XINC=0.025*(SP(3)-SP(D)

NX=0.035*(SP(3)-SP( D)

NY=0.035*(SP(4)-SP(2))

NUMBR=I

G

C DETERMINE NUMBER OF DIGITS 'NUM' (THE VERTEX LINE NUMBER)

G

NUM=I

DIGITS-0

10 NUM-NUM/10.0

DIGLTS-DIGITS+1

IF (NUM.GE. 1) GO TO 10

C
2123

2124

2125

2126

2127

2128

2129

2130

2131

2132

2133

2134

2135

2136

2137

2138

2139

2 140

2141

2142

2143

2:44

2145

2146

SUBROUTINE PLYPL3

C CALCULATE X COORDINATE OF FIRST DIGIT OF THE NUMBER

C

IF (DIGITS. EQ. 1) THEN

XSTART=XX

ELSE

IF ( MOD( DIGITS, 2 ).EQ,0) THEN

XSTART=XX-(DIGITS*XINC)/4

ELSE

XSTART=XX-(DIGITS*XINC)/2

ENDIF

ENDIF

C

C PLOT THE NL’MBER

C

CALL ?N'JM3R(XSTART , YY-NY , XINC , 0. 0 , NX, 0. 0,

* NY,NI:MBR,DIGITS,0) , print vertex NLT«13ER

20 CONTINUE

C

C RESTORE THE COORDINATE SYSTEM

C

DO 2 I = 1, 4

2 XYCOOD(I) = SSP(I)

RETURN

END

page 51

-IQO-
2147

2148

2149

2150

2151

2152

2*153

2154

2155

2-156

2157

2153

2159

2160

2 161

2162

2163

2164

2165

2166

2167

2168

2169

2170

2171

2172

2173

2174

2175

2176

2177

2178

2179

2180

2131

2132

2133

2184

2185

2186

2187

2183

2139

2190

2191

2192

2193

2194

2195

2196

2197

2198

2199

2 200

2201

SUBROUTINE PLYPL4 page 52

SUBROUTINE PL YPL4( ARRAY , NARRAY , VERTX, SP , SPEC

)

C

C THIS SUBROUTINE PLOTS EDGES WHICH ARE WITHIN THE WINDOW OR

C EDGE SEGMENTS WHICH CROSS A PORTION OF THE WINDOW.

C

LOGICAL VALID

INTEGER ARRAY (2, NARRAY ) , SPEC( 4 , NARRAY)

REAL VERTX( 3, NARRAY) , SP( 4 )

, SSP(4 ) ,U 1

, V 1

, U2 , V2

COMMON/ PLSCMR/ DOZ , WCX , WCY , F ANGLE , TANAL

COMMON/ DEVTYP/ I DEVIC , LSW , LTSW , XYC(X)D( 4 ) , LUOUT , LPAGE

G

G DEFINE THE WINDOW SPACE

r DO 1 I = 1, 4

I SSP(I) = XYCOOD(I)

CALL DEFINE(SP(1),S?(2),SP(3) ,SP(4))

C

G PLOT ONE EDGE AT A TIME

G

LWD = -1

LCL = -1

DO 150 J=l, NARRAY

C

C ADD PERSPECTIVE

C

D = DOZ/((DOZ+VERTX(3,ARBAY(l,J)))*TANAL)

U1=(VERTX(1,ARRAY(1,J))-WCX)*D + WCX

V1=(VERTX(2,ARRAY(1, J))-WCY)*D + WCY

D = DOZ/((DOZ+VERTX(3,ARRAY(2,J)))*TANAL)

U2=(VERTX(1,ARRAY(2,J))-WCX)*D + WCX

V2=(VERTX(2,ARRAY(2,J))-WCY)*D + WCY

G

C CLIP LEFT EDGE

G

IF (U1.GE,SP(1).AND.U2.GE.S?(1)) GO TO 50

IF (Ul. LT.SP(1).AND.U2.LT.SP(D) GO TO 150

IF (Ul.GT.SP(D) GO TO 40

VI = (V1-V2)*U1/(U2-U1)+V1

Ul = SP(1)

GO TO 50

40 V2 = (V2-V1)*U2/(U1-U2)+V2

U2 = SP(1)

C

C CLIP RIGHT EDGE

G

50 IF (U1.LE.SP(3).AND.U2.LE.SP(3)) GO TO 70

IF (U1.GT.SP(3).AND.U2.GT.SP(3)) GO TO 150

IF (U1.GT.SP(3)) GO TO 60

V2 - (V2-V1)*(SP(3)-U1)/(U2-U1)+V1

U2 - SP(3)

GO TO 70

60 VI - (Vl-V2)*(SP(3)-U2)/(Ul-U2)-*-V2

Ul - 3P(3)

C

C CLIP BOTTOM EDGE

- 1 9 1 -
2 202

2203

2 204

2 205

2206

2207

2208

2 209

2210

2211

2212

2213

2214

2215

2216

2217

2218

2219

2 220

2221

2222

2223

2224

2225

2226

2227

2228

2229

2230

2231

2232

2233

2234

2235

2236

2237

2238

2239

2240

2241

SUBROUTINE PLYPL4 page 53

C

IF (V1.GE.SP(2). AND,, V2, GE.SP(2)) GO TO 90

IF (V1.LT.SP(2), AND,, V2. LT.SP(2)) GO TO 150

IF (V1.GT.SP(2)) GO TO 80

Ul = (U1-U2)*V1/(V2--V1)-HU1

VI = 3P(2)

GO TO 90

U2 = (U2-U1)*V2/ (VI--V2)-i-U2

V2 = SP(2)

CLIP rOP EDGE

90 IF (V1.LE.SP(4).AND.V2.LE.SP(4)) GO TO liO

I? (Vi.GT.SP(4).AND.V2.GT.SP(4)) GO TO 150

IF (V1.GT.3P(4)) GO TO 100

U2 = (U2-UI)*(SP(4)-V1)/(V2-V1)+U1

V2 = SP(4)

GO TO no

100 Ui = (U1-U2)*(SP(4)-V2)/(V1-V2)-KJ2

Vi = 3P(4)

C

C PLOT THE EDGE

C

no IF(LWD.NE.SPEC( 1, J)) THEN

LWD = 3PEC(i,J)

CALL LIiNWID(LWD)

ENDIF

IF(LCL.NE.SPEC(2, J)) THEN

LCL = SPEC(2,J)

CALL COLOR (LCL)

ENDIF

CALL LINE(U1, VI, U2, V2)

150 CONTINUE

C

C RESTORE THE ORIGINAL COORDINATE SYSTEM

C

DO 2 I = 1, 4

2 XYCOOD(I) = SSP(I)

RETURN

END

- 1 Q ~
2242

2243

2244

2245

2246

2247

2*248

2249

2250

2=251

2252

2253

2254

2255

2256

2257

2258

2259

2 260

2261

2262

2263

2264

2265

2266

2267

2268

2 269

2270

2271

2272

2273

2274

2275

2276

2277

2278

2279

2280

2281

2282

2283

2284

2285

2286

2287

2288

2289

2290

2 291

2292

2293

2 294

2295

2296

SUBROUTINE FuYPL5 page 54

SUBROUTINE PL YPL5 (ARRAY , NARRAY , VERTX, SP, SPEC , NP'/ERT)

C

C THIS SUBROUTINE GRAPHS POLYGONS WHICH ARE WITHIN THE WINDOW OR

C PARTS OF POLYGONS WHICH CROSS A PORTION OF THE WINDOW

C

PARAMETER ( MAXLN= 1 0

)

LOGICAL PASSl

INTEGER ARRAY ( NPVERT , NARRAY ), NARRAY , FIRST , S ECOND , NUM , S

1

INTEGER INVALD, VINDX, ENDPT , SPEC(4 , NARRAY)

REAL VERTX(3,NARRAY) ,SP(4) ,D,SSP(4)

REAL Xi,X2,Yl, Y2,X(MAXLN) ,Y(MAXLN)

COMMON/ PLSCMR/DOZ ,WCX,WCY, FANGLE , TANAL

COMMON/ DEVT YP/ IDEVIC , LSW , LTSW , XYCOOD( 4 ) , LUOUT , LPAGE

C

C DEFINE WINDOW SPACE

C

DO 1 I = 1, 4

1 SSP(I) = XYCOOD(I)

CALL DEFINE(SP( 1),SP(2) ,SP(3) ,S?(4)

)

C

C PLOT POLYGONS ONE AT A TLME

C

LWD = -1

NDX = -1

LFL = -1

DO 10 I = 1, NARRAY

NUM=0

C

G DETERMINE THE NUMBER OF VERTICES (NON-ZERO ENTRIES) IN THE

C POLYGON

C

DO 15 J=l, NPVERT

IF(ARRAY(J,I).NE.O) NUM=NUM+1 , NUMBER OF VERTICES IN POLYGON

15 CONTINUE

C

G FIND THE PERSPECTIVE

C

DO 60 IV=1,NUM

D = DOZ/((DOZ+VERTX(3,ARRAY(IV,I)))*TANAL)

X(IV) = (VERTX(1,ARRAY(IV,D) - WCX)*D -r WCX

Y(IV) = (VERTX(2,ARRAY(IV, I)) - WCY)*D -I- WCY

60 CONTINUE

C

G PLOT THE POLYGON

C

IF(SPEG(1,I).NE.LWD) THEN

LWD - SPEC(l.I)

CALL LINWID(LWD)

ENDIF

IF(SPEC(2, I).NE.NDX) THEN

NDX - SPEC(2,I)

GALL COLOR(NDX)

ENDIF

IF(SPEC(3, L).NE. LFL) THEN

LFL - SPEC(3,I)

- 1 0 1 -
2302

2303

2 304

2305

2306

2307

2308

2 309

2310

2311

CALL LINES(Xd), Y( L ) , X(2), Y(2), NUM-1)

ENDIF

10 CONTINUE ;GET NEXT POLYGON

C

C RESTORE THE COORDINATE SYSTEM

C

DO 2 I = L, 4

2 XYCOOD(I) = SSP(I)

RETURN

END

- 194 -
2312

2313

2314

2315

2316

2317

2318

2319

2320

2321

2322

2323

2324

2325

2325

2327

2328

2329

2330

2331

2332

2333

2334

2335

2336

2337

2338

2339

2340

2 341

2342

2343

2344

2 345

2346

2347

2348

2349

2350

2351

2352

2353

2354

2355

2356

2357

2358

2359

2 360

2361

2362

2 363

2364

2365

2 366

U

CJ)

SUBROUTINE PLYPLT page 56

SUBROUTINE PLYPLT (FILE .OPTION)

$INCLUDE BUILD.COM

(NPART=20)

EXIST, VALID

NVERTO, NELMTO, NEDGEO, NPOLYO, FIRST, LAST, lOS

EDGS(NSPEC,NEDGE) , POLS (NSPEC , NPOLY) , SELECT

FNM(5), OPTION, EDG( 2

, NEDGE ) , POL(NPVERT , NPOLY)

NPL(2,NPART) , ISPEC(NSPEC) , JP(NPVERT)

WIN(4), VER0,NVERT), SPACE(4)

SOURCE

FNAME, FILENM, OLDFIL, FILS

NOREC, BLANK

VALID/. FALS E. / , BLANK/' '/, LUNIT/9/, OLDFIL/' '/

IUNIT/5/, ZERO/0/

(FILENM.FNM)

COMMON/ PLSCMR/ DOZ , WCX, WCY , FANGLE , TANAL

COMMON/GRFTYP/ ANGLE, IRVRSE, CHS IZE(9) , ITKWIT , LUDIAG , LUHSET

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

PARAMETER

LOGICAL

INTEGER

INTEGER

INTEGER

INTEGER

REAL

CHARACTER*5

CHARACTER* 1

7

CHARACTER* 20

DATA

DATA

EQUIVALENCE

DATA FILE

c

C CREATE EQUIVALENT CHARACTER STRING OF FILENAME

G

FILENM = FILE

IF(FIL£NM.EQ, OLDFIL) GO TO 1100

G

C READ FILENAME

C

CLOSE (LUNIT)

CALL PLYPLUFNM, 17, 1 , FIRST , LAST , EXIST , 0)

IF ( .NOT. EXIST) GO TO 90

FNAME = BLANK

DO 10 I = FIRST, LAST

J = I - FIRST + 1 10 FNAME(J:J) = FIL£NM(I:I)

C

G FILE EXIST?

G

INQUIRE( FIL£=FNAME , IOSTAT=IOS , ERR=9 1

, EXIST=EXIST)

IF(. NOT. EXIST) GO TO 93

G

G OPEN FILE

G

OPEN(UNIT-LUN IT , lOSTAT-IOS , ERR=94 , FILE-FNAME , STATUS^ 'OLD '

)

REWIND LUNIT

G

C GET(l) READ DATA INTO VARIABLES AND ARRAYS

C

READ(LUNIT,FMT=«1500,ERR=98) SOURCE , (WINDOW( I ) ,1 = 1,4)

IF(SOURCE.NE. 'BUILD' . AND. SOURCE. NE . 'MOVIE' . AND. SOURCE. NE. 'FILNG' )

. GO TO 98

READ(LUNIT,FMT-1510,ERR-98) (WORLD( L )

, I- 1

, 6

)

R£AD(LUNIT,FMT-l 520,ERR-98) NPARTO , NVERTO , NELMTO , NEDGEO

IF (NPARTO. LT.O) GO TO 98

NPOLYO-NELMTO -NEDGEO

- 195 -
2367

2368

2 369

2370

2 371

2 372

2 373

237A

2375

2 376

2 377

2 378

2379

2 380

2381

2 382

2383

2 334

2385

2386

2387

2388

2 389

2390

2391

2392

2393

2 394

2395

2396

2397

2398

2 399

2 400

2401

2 402

2403

2404

2405

2406

2407

2408

2409

2410

2411

2412

2413

2414

2415

2416

2417

2418

2419

2420

2421

SUBROUTINE PLYPLT page 57

READ(LUNIT,FMT=1520,ERR=98) ((NPL( I , J) , 1=1 , 2) ,J=1 .NPARTO)

IF(NVERT0. LE.O) GO TO 1090

DO 1020 J=1,NVERT0

1020 READ(LUNIT,FMT=1530,ERR=98) NPOINT( J ) , ( VERTEX( I , J) , 1=1 , 3)

IF (NELMTO. LE.O) GO TO 1090

C

C LNITIALIZE EDGE AND POLYGON COUNTERS

C

NE=0

NP=0

DO 1080 J=l, NELMTO

RF2\D(LUNIT,FMT=1525,ERR=98) ( JP( I ) , 1 = 1 , NP'/ERT) , ( ISPEC( I ) , 1=1

,

1 NS PEC)

C

C COUNT NUMBER OF VERTICES IN ELEMENT

C

NC0N=0

DO 1030 I = 1,NP'7ERT

L? (JP(I).EQ.O) GO TO 1035

1030 NC0N=NC0N+1

C

C ELEMENT IS EDGE

C

1035 IF (NCON.EQ, 2) TEEN

NE=NE+1

DO 1040 1=1,2

1040 EDGE(I,NE)=JP(I)

DO 1050 I=1,NSPEC

1050 ESPEC(I,NE)=ISPEC(I)

C ELEMENT IS POLYGON

C

ELSE

NP=NP+1

DO 1060 I=1,NC0N

1060 ?OLY(I,NP)=JP(I)

IF (NCON. LT.NPVERT) TEEN

DO 1065 I=NC0N+1,NPVERT

1065 POLY(I,NP)=0

ENDIF

DO 1070 I=1,NSPEC

1070 PSPEC(I,NP)=ISPEC(I)

ENDIF

1080 CONTINUE

1090 CLOSE(LUT^IT) ********* ***Jlt* *********************************** **************:k*^

C DISPLAY

Q* ******************************* ********************^  ** **********

c

C **SPECIFY WINDOW**

C

1100 IF (NVERTO.NE.O) TEEN

CALL PLYPL2(WINDOW, VALID, WORLD)

ELSE

NOREC - 'NO RECORDS'

1 O;
SUBROUTINE PLYPLT page 58

2422 IF(LUDIAG.GT.O) WRITS (LUDIAG, 108) NOREG

2423 RETURN

2424 ENDI?

2425 C

2426 C IE VALID WINDOW , SET 'SPAGE' GOORDINATES TO 'WINDOW' ,OTHERWISE

2427 C SET THE 'SPAGE' GOORDINATES TO 'WORLD'

2428 c *2429 lE(VALID) THEN ;VALID WINDOW

2430 DO 40 1=1,4

2431 40 SPAGE(I)=WINDOW(I)

'2432 ELSE

2433 IF(LUDIAG.GT.O) WRITE (LUDIAG, 107)

2434 00 41 1=1,2

2435 41 SPAGE(I)=WORLD(I)

2436 DO 42 1=3,4

2437 42 SPAG£(I)=W0RLD(I+1)

2438 ENDIF

2439 G

2440 G **FIND GENTSR OF WINDOW**

2441 G

2442 WGX=(SPAGE(3)+SPAC£(l))/2

2443 WCY=(SPAGE(4)+SPAGS(2))/2

2444 G

2445 G **INITIALIZE FIELD OF VIEW**

2446 G

2447 DOZ=10000.

2448 FANGLE=90.

2449 TANAL=1.0

2450 G

2451 G INITIALIZE AND SET UP FOR A SINGLE GRAPH - 'NOREG', IF SET, 'WILL 2452 G INDIGATE THAT THERE ARE NO R^GORDS TO BE DISPLAYED

2453 G

2454 NOREG=BLANK

2455 G

2456 IF (OPTION. EQ.O) THEN ;N0 PLOTS - READ IN DATA FILE ONLY

2457 RETURN

2458 ELSE IF (OPTION. EQ. 1) THEN

2459 IF (NEDGEO. EQ.O) NOREG=’NO EDGES’

2460 ELSE IF(OPTION.EQ. 2) THEN

2461 IF (NVERTO. EQ.O) NOREG='NO VERTIGES'

2462 ELSE IF (OPTION. EQ, 3) THEN

2463 IF (NPOLYO.EQ.O) NOREG='NO POLYGONS'

2464 ELSE IF (OPTION. EQ. 4) THEN

2465 IF (NEDGEO. EQ.O.AND. NPOLYO.EQ.O) NOREG='NO EDGES OR POLYGONS'

2466 ELSE

2467 NOREG- 'INVALID OPTION'

2468 IF(LUDIAG.GT.O) WRITE( LUDIAG, 108 ) NOREG

.2469 RETURN

2470 ENDIF

2471 G

2472 G **PLOT**

2473 G

2474 IF (NOREG. EQ. BLANK) THEN

2475 IF (OPTION. EQ. 1) THEN

2476 GALL PLYPL4 ( EDGE , NEDGEO , VERTEX , S PAGE , ES PEG

)

- 10 ?.
2477

2478

2479

2480

2481

2 482

2483

2484

2485

2486

US7

2488

2489

2490

2491

2492

2493

2494

2495

2 496

2497

2498

2499

2 500

2501

2 502

2503

2504

2505

2506

2507

2508

2509

2510

251

1

2512

2513

2514

2515

2516

2517

2518

2519

2520

2521

2522

2523

2524

2525

2526

2527

2528

2529

2530

2531

SUBROUTINE PLYPLT page 59

ELSE IF (OPTION. EQ. 2) THEN

CALL PLYPL3(VERTEX,NVERT0, S PACE, NPOINT.NVERT)

ELSE IF (OPTION. EQ. 3) THEN

CAL L PLYPL5 (POLY, N POLYO , VERTEX , S PACE , PS PEC , NP VERT

)

ELSE IF (OPTION. EQ. 4) THEN

IF(NEDGEO.GT.O) CALL PLYPL4(EDGE ,NEDGEO , VERTEX, SPACE , ESPEC)

IF(NPOLYO.GT.O) CALL PLYPL5(P0LY, NPOLYO , VERTEX, SPACE , PS PEC,

NPVERT)

ENDIF

ELSE

IF(LUDIAG.GT.O) WRITE (LUDL4G, 108) NOREC

ENDIF

RETURN

(^*:^****4t*:w*:‘:*-****:^r*4:*********4r  ** A*:!c*4r*'** **************** ***4r*** * 0 “NTRY PLYGNS

Q* X*****************************************************************

C

C A ROUTINE TO RETURN THE COORDINATE ARRAY VALUES FROM A DATA FILE

C

ENTRY PL YGNS ( WIN , VER , N VM , E DG , EDGS , NEM , POL , POLS , N EM

)

NVM = MIN(NVERT,NVM,NVERTO)

DO 80 I = I, 4

30 WIN(I) = WINDOW(I)

DO 81 I = i , NVM

DO 82 J = i, 3

82 '/ER(J,I) = VERTEX(J,I)

31 CONTINUE

NEM = MIN(NEDGE,NEM,NE)

DO 88 I = 1, NEM

DO 83 J = 1, 2 83 EDG(J,I) = EDGE(J,I)

DO 84 J = 1, NSPEC

34 SDGS(J,I) = ESPSC(J,I)

88 CONTINUE

NPM = MIN(NPOLY,NPM,NP)

DO 85 I = 1, NPM

DO 86 J = 1, NPVERT

86 POL(J,I) = POLY(J,I)

DO 87 J = 1, NSPEC

87 POLS(J,I) = PSPEC(J,I)

85 CONTINUE

RETURN

C

C ERRORS

C

90 IF(LUDIAG.GT.O) WRITE(LUDIAG, 100) FILE

RETURN

91 CLOSE(LUNIT)

IF (IOS.EQ. 349) THEN

IF(LUDIAG.GT.O) WRITE(LUDIAG, 100) FNAME

ELSE IF (lOS.EQ. 324) THEN

IF(LUDIAG.GT.O) WRITE(LUDIAG, 101

)

ELSE

IF(LUDUG.GT.O) WRITE(LUDIAG, 102) lOS

ENDIF

- 198 -
2532

2533

2534

2535

2536

2537

2538

2539

2 540

2541

2542

2543

2544

2545

2546

2547

2 548

2549

2550

2551

2552

2553

2554

2555

2556

SUBROUTINE PLYPLT page 60

RETURN

93 IF(LUDIAG.GT.O) WRITE(LUD1AG, 103)

RETURN

94 CLOSE (UNIT=LUNIT , IOSTAT=IOS , ERR=95

)

95 IF (LUDIAG.GT.O) WRITE (LUDAIG, 104) lOS

RETURN

98 IF(LUDIAG.GT.O) WRITE(LUDIAG, 1 10)

RETURN

C

C

C

100

101

102

103

104

107

108

110

1500

1510

1520

1525

1530

FORMATS

FORMAT (

'

FORMAT (

FORMJ^T( ’ FORMAT (

•

FORMAT (

'

FORMAT (

INVALID FILE DESCRIPTOR’ , 2X, Ai 7

)

NO RECORDS IN FILE')

INQUIRE ERROR = ’,14)

FILE DOES NOT EXIST')

FILE ERROR', 14)

WINDOW DEFAULTS TO '’WORLD" ' ) F0RMAT(1X,A20,/,/)

FORMATC ERROR - DATA

FORMAT(A5,4E12. 5)

FORMAT(6E12.5)

FORMATC 1615)

FORMAT(8I5,5X,8I5)

FORMAT(I5,3E12.5)

END

FORMAT PROBLEMS — ENTER NEW

- 199-
SUBROUTINE PROPOL page 61

2 557

2558

2559 C

2 5bO

2561

25b2

2 563

2 5bA

2565

2 5ob

2 567

2568

25b9

2 570

2571

2 572

2 573

2574 C

2575 C

2576 C

2577 C

2578 C

2579 C

2 580 C

2581 C

2 582 C

2583 C

2 584 C

2585 C

2586 C

2587 C

2588 C

2589 C

2590 C

2591 G

2 592 C

2593 C

2594 C

2595 C

2596 C

2597 C

2598 C

2599 C

2600 C

2601 C

2602 C

2603 C

2604 C

2605

2606

2607

2608

2609

2610

2611

SUBROUTINE PROPOL (NTRIA, XT 1 , YT 1 , FT 1 , XT2 , YT2 , FT2 , XT3 , YT3 , FT3

,

1 FL, NX, NY)

PARAMETER

REAL

REAL

REAL

INTEGER

REAL

REAL

REAL

REAL

REAL

REAL

(NPT=101)

XTl(NTRIA) , YTl(NTRIA) , FT 1 (NTRIA),

MASK(NPT)

DIFFl(NPT) , SGNl(NPT)

,

DFLl(NPT) , ALFl(NPT)

,

XT2(NTRIA)

YT 2 (NTRIA)

FT2(NTRIA)

DIFF2(NPT)

SGN2(NPT)

,

DFL2(NPT)

ALF2(NPT)

XT3(NTRIA)

YT3(NTRIA)

FT3(NTRIA)

, DIFF3(NPT)

SGN3(NPT)

DFL3(NPT)

ALF3(NPT), Xl(NPT) X2(NPT)

X3(NPT), Yl(NPT), Y2(NPT), Y3(NPT) , TEST(NPT)

DELTA, MASXl, MASKS, RMASK(NPT)

EQUIVALENCE (MASK(l), RMASK(l))

DATA MASKl, DELTA, MASKS / 1.0, l.OE-20, Z80000000/

DATA XMN1,YMN1,XMN2,YMN2,XMX1,YMX1 ,XMX2,YMX2/4*0. ,4*100./

Mkit^c^cMk^cic•kkkkkitkkkickit^k^kkie•kkkki^kk:k

PROPOL (NTRIA, XTl, YTl,

FL, NX, NY)

NTRIA LNTEGER

XTl REAL ARRAY (NTRIA)

YTl REAL ARRAY (NTRIA)

FTl REAL ARRAY(NTRIA)

XT 2 REAL ARRAY (NTRIA)

YT2 REAL ARRAY( NTRIA)

FT2 REAL ARRAY (NTRIA)

XT3 REAL ARRAY( NTRIA)

YT3 REAL ARRAY (NTRIA)

FT3 REAL ARRAY (NTRIA)

FL REAL

NX INTEGER

NY INTEGER

FTl, XT2, YT2, FT2, XT3, YT3, FT3,

NUMBER OF TRIANGLES IM LIST I X POSITIONS OF FIRST VERTICES I Y POSITIONS OF FIRST VERTICES I FUNCTION VALUES AT FIRST VERTICES I X POSITIONS OF SECOND VERTICES I Y POSITIONS OF SECOND VERTICES I FUNCTION VALUES AT SECOND VERTICES I X POSITIONS OF THIRD VERTICES I Y POSITIONS OF THIRD VERTICES I FUNCTION VALUES AT THIRD VERTICES I VALUE OF F AT WHICH CONTOUR IS DRAWN I MAXIMUM VALUE OF X POSITIONS I MAXIMUM VALUE OF Y POSITIONS I

PROPOL ASSUMES A CONTOUR CROSSING LIES

BETWEEN (XT1,YT1) AND (XT2,YT2). THE VERTICES MUST BE NUMBERED

COUNTER-CLOCKWISE AROUND THE TRIANGLE. THE CODE IN PROPOL IS SPECIALIZED TO THE RECTANGULAR X-Y CASE BY THE TRANSFORMATION OF DO

LOOP 145. PLOAR PLOTS CAN BE FORMED BY CHANGING THIS TRANSFORMATION.

ENTRY POINTS: CNTSET, CNTFRM (SEE DOCUMENTATION OR LISTING BELOW)

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

IF (NTRIA .GT. NPT) NTRIA = NPT

XD - (XMN2-XMN1) / FLOAT(NX-l)

XB - ((XMN2-XMN1)-(XMN3-XMN4)) / FLOAT( (NY-l)^(NX-l )

)

XC » (XMN4 - XMNl) / FLOAT(NY-l)

YD - (YMN4 - YMNl ) / FLOAT(NX-l)

YB » ((YMN4-YMN1)-(YMN3-YMN2)) / PLOAT((NY-l)*(NX-l))

YC - (YMN2 - YMNl) / FLOAT(NX-i)

- 200-
2612

2613

2614

2615

2616

'2617

2618

2619

2620

2621

2622

2623

2624

2525

2626

2627

2628

2629

2630

2631

2632

2633

2634

2635

2636

2637

2638

2639

2640

2641

2642

2643

2644

2645

2646

2647

2648

2649

2 650

2651

2652

2653

2654

2655

2656

2657

2658

2659

2660

2661

2 662

2 663

2664

2665

2666

SUBROUTINE PRO POL page 62

C

C

C

C

C

C

C

100

110

120

DO 100 I = 1, NTRIA

DIFF3(I) = FT2(I) - FTl(I)

DIFFl(I) = FT3(I) - FTl(I)

DIFF2(I) = FT3(I) - FT2(I)

SGN3(I) = SIGN (1.0, DIFF3(D)

SGNl(I) = SIGN (1.0, DIFFl(I))

SGN2(I) = SIGN (1.0, DIFF2(I))

DO no I = 1, NTRIA

DIFF3(I) = A3S(DIFF3(D) + DELTA

DIFFl(I) = A3S(DIFF1(D) + DELTA

DIFF2(I) = A3S(DIFF2(D) + DELTA

DFL3(I) = SGN3(I)*(FL - ?T1(I))

DFLl(I) = SGN1(I)*(FL - FTl(I))

DFL2(I) = SGN2(I)*(FL - FT2(I))

DO 120 I = 1, NTRIA

ALF3(I)

ALFl(I)

ALF2(I)

X3(I) = Y3(I) = X1(I) = Y1(I) = X2(I) = Y2(I) = TEST(I)

= DFL3(I)/DIFF3(I)

= DFL1(I)/DIFF1(I)

= DFL2(I)/DIFF2(I)

XTl(I) + ALF3(I)*(XT2(I) - Xn(I))

YTl(I) + ALF3(I)*(YT2(I) - YTl(I))

XTl(I) + ALFi(I)*(XT3(I) - XTl(I))

YTl(I) + ALF1(I)*(YT3(I) - YTl(I))

XT2(I) + ALF2(I)*(XT3(I) - XT2(I))

YT2(I) + ALF2(I)*(YT3(I) - YT2(I))

= (1.0 - ALF2(I))*ALF2(I)

IF TEST IS LESS THAN ZERO, THEN HISS, OTHERWISE HIT.

130

140

DO 130 I = 1, NTRIA

MASK(I) = LSHF (TEST(I), -31)

MASX(I) = HASK(I) - 1 X2(I) = AND (RMASX(I), X2(I))

Y2(I) = AND (RMASK(I), Y2(I))

DO 140 I = 1, NTRIA

MASX(I) = -1 - MASK(I)

X1(I) = AND (RMASK(I), X1(I))

Y1(I) =» AND (RMASK(I), Y1(I))

X1(I) = X1(I) + X2(I)

Y1(I) = Y1(I) + Y2(I)

NOW PLOT THE LINE SEGMENTS.

145

150

DO 145 I =• 1 X1(I) » (Xl(

X3(I) - (X3(

Y1(I) - (Yl(

Y3(t) - (Y3(

DO 150 I = 1 X3(I) - AMIN

X1(L) - AMIN

X3(l) - AMIN

Yl(l) - AMIN

CALL LINES ( NTRIA - 0

, NTRIA

I)-l. )*(XD-XB*(Y1(I)-1.

I)-l. )*(XD-XB*(Y3(I)-l.

I)-l. )*(YD-YB*(Xl(I)-l.

I)-l. )*(YD-YB*(X3( L)-l.

, NTRIA

KXMAX, AMAXUXMIN, X3(

l(XHAX, AMAXUXMIN, Xl(

UYMAX, AMAXKYMIN, Y3(

l(YMAX, AMAXUYMIN, Yl(

X3, Y3, XI, Yl. NTRIA)

) )+XC*(Yl(I)-l

))+XC*(Y3(L)-l

) )-*-YC*(Xl(I)-l

))+YC*(X3(l)-l

I)))

1 )))

I)))

1 )))

. )+XMNl

. )+XMNl

. ) +YMN 1

. ) +YMN

1
SUBROUTINE PROPOL page 63

2667

2 668

26o9

2670

2671

2672

2673

2674

2675

2676

2677

2678

2679

2o8o

2681

2682

RETURN

2698

2699

2700

2701

2702

C

C

C

C

C

C

C

cc

c

cc

cc

ENTRY CNTSET (XMl, YMl, XM2, YM2 , XM3, YM3, XM4 , YM4)

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

DESCRIPTION: CNTSET MAY BE CALLED BY THE USER TO MOVE THE CONTOUR

PLOT GENERATED AROUND ON THE PLOTTING REGION OR TO STRETCH OR

COMPRESS THE PLOT. THE DATA STATEMENT GIVES THE DEFAULT FOR A

L4RGE SQUARE PLOT. THE PLOT WILL EXTEND FROM XXMIN TO XXMAX IN THE

HORIZONTAL AND FROM Y'lMIN TO YTMAX IN THE VERTICAL. ALL FOUR OF

THESE VALUES SHOULD BE IN THE RANGE I TO 1023.

2683 C * * * * * **************

2 684

2685

C

:^i _ XMl

2 686 'fMNl = YMl

2687 XMN2 - XM2

2688 YMN2 - YM2

2689 :<MN3 = XM3

2690 YMN3 = YM3

2691 XMN4 = XM4

2692 YMN4 = YM4

2693 XMAX = MAX(XMN1, XMN2, XMN3, XMN4)

2694 XMIN = MIN(XMN1, XMN2, XMN3, XMN4)

2595 YMAX = MAX(YMN1, YMN2, YMN3 , YMN4)

2696 YMIN = MIN(YMNi, YMN2, YMN3, YMN4)

2697 RETURN

ENTRY CNTFRM

2703 C

2704 C

2705 C

2706 C

2707 C

2708 C

2709 C

2711 C

2712 C

2713 C

2714

2715

2716

2717

2718

2719

************************ik********

DESCRIPTION: CNTFRM IS A USER-CALLED ROUTINE TO PLOT THE RECTANGULAR BOUNDARY OF THE CONTOURED REGION. CNTFRM HAS NO ARGU’MENTS

SINCE THE REGION IS SPECIFIED BY DEFAULT OR VIA A PREVIOUS CALL TO

CNTSET.

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

CALL LINE(XMN1,YMN1,XMN2,YMN2)

GALL LINE(XMN2,YMN2,XMN3,YMN3)

CALL LINE(XMN3, YMN3,XMN4,YMN4)

CALL LINE(XMN4,YMN4,XMNl,YMNi)

RETURN

END
SUBROUTINE PUTCH page 64

2720

2721 C

1111

2723

2724

2725

’2726

2727

2728

-2729

2730

2731

2732 C

2733

2734

lll'b

2736

2737 C

2738 C

2739 C

2740

2741

2742

2743 C

2744 C

2745 C

2746

2747

2748

2749

2750

2751

2752

2753

2754

2755

2756

2757

2758

2759

2760

2761 C

2762 C

2.763 C

2764

2765

2766

2767

2768

2769

2770 C

2771 C

2772 C

2773

2774

SUBROUTINE PUTCH (X, Y, CHARAC)

INTEGER LPAGE(30, 65)

COMMON/ DEVTYP/ I DEVIC , LSW , LTSW ,XYCOOD( 4 )

, LUOUT , LPAGS

COMMON/ GRFTY P/ANGLE, IRVRSE, CHS IZE(9) , ITKW IT, LUDIAG, L msET

CHARACTER*! CHARAC, CH(4)

EQUIVALENCE (CH,ICH)

INTEGER K, K1 , M, IK, IM, MASK(5)

INTEGER ISHFT, AND, OR

LOGICAL LSW, LTSW

DATA MASK /ZFFFFOOFF, ZFFOOFFFF, ZOOFFFFFF, ZFFFFFFOO,

ZFFOOOOOO/, CHSZ/0.0/

ICH = 0

CH(1) = CHARAC

CHS = CHSIZE(2)

GO TO (1,2, 3, 5), IDEVIG

GALCOMP SECTION.

1 CALL CALSYM (X, Y, CHS, CH, 0, 0.0, 1)

LSW = .TRUE.

RETURN

PAGE PLOT SECTION.

2 JXl = MAX(0, MIN(IFIX(X) , 1023))

JYl = MAX(0, MIN(IFIX(Y) ,1023))

I = (JXl + 5)/10 + 1 J = 65 - (JYl+8)/16

K = 1/4

M = I - 4*K

K1 = 4 - M

IF(M .EQ. 0) K = K - 1 IM = IAND(LPAGE(K+4, J) , MASK(Kl))

IK = lANDdCH, MASK(5))

IF(M .EQ. 0) IK = ISHFTdK, -24)

IF(M .EQ. 3) IK = ISHFTdK, -16)

IF(M .EQ. 2) IK = ISHFTdK, -8)

LPAGE(K+4, J) = IOR(IK, IM)

RETURN

LEXIDATA/MATRIX SECTION

3 GALL GSCHSZ (CHS)

XL - MAX(X,0.)

YL - MAX(Y,0.)

CALL GMOVA (XL, YL)

GALL GTXTWC (CH, 1)

RETURN

TEKTRONIX SECTION

5 CONTINUE

CALL MOVEA(X.Y)
SUBROUTINE PUTCH page 65

2775

2776

2777

2778

CALL A10UT(1,ICH)

LTSW = .TRUE.

RETURN

END

- 204 -
SUBROUTINE PUTLNV page 66

2779 SUBROUTINE PUTLNV (XI, Yl, DX, DY, NL)

2780 C

2781 PARAMETER (N LINES =2 00)

2782 INTEGER LENGTH, COUNT

2783 REAL Xi(NL), Yl(NL), DX(NL) , DY(NL)

2784 INTEGER MASK1/15/,0P11/12/ ,IVERT/i023/

2785 INTEGER LPAGE(30,65) , HSYMBL, HDOT, HAPOS , HMINUS

2786 REAL JXl(NLINES) ,JY1(NLINES), JX2CNLINES) ,JY2(NLINES)

2787 REAL XY(2,NLINES) , JXS , JYS , IDDX, IDDY

2788 common/ DEVTYP/ I DEVIG , LSW , LTSW , XYCOOD( 4 ), LUOUT , LPAGE

2789 COMMON/GRFTYP/ ANGLE , IR'/RSE , CHSIZE( 9 ) , ITKWIT , LUDIAG , LUHSET

2790 COMMON/GREMOD/LFLMAT(5) ,LINWDM(5) ,LCLMAT(5)

2791 INTEGER X, Kl, M, Ml, IK, LM , MASK(4)

2792 LOGICAL LSW, LTSW, IR'/RSE, LEXL3W

2793 DATA HDOT, HAPOS, HMINUS /Z0000002E, Z00000027, Z0C00002D

2 794 DATA MASK /ZFFFFOOFF,. ZFFOOFFFF, ZOOFFFFFF, ZFFFFFFOO / 2795 DATA JXS, JYS / 2*0.0 / 2796 c 2797 IF(IDEyiC.EQ.O) RETURN

2798 IF ( NL. GT . NLINES . AND. LUDIAG. GT . 0 ) WRITE ( LUDIAG ,1002)

2799 1 002 FORMAT (

' *** BUFFER SPACE EXCEEDED IN PUTLNV *** ’ ) 2800 NLP = MINO(NLINES,NL)

2801 c 2802 c MASK THE LINE SEC23ENT FOR CALCOMP AND PAPER, AND TEKTRONIX.

2803 c 2304 DO 10 1=1, NLP

2805 JXl(I) = X1(I)

2306 JYl(I) = Y1(I)

2307 JX2(I) = JXl(I) + DX(I)

2308 10 JY2(I) = JYl(I) + DY(I)

2809 DO 11 I = 1, NLP

2810 JXl(I) = MAX(JXKI) ,0. ) 231

1

JYl(I) = MAX(JYKI) ,0. ) 2312 JX2(I) = MAX(JX2(I) ,0.

)

2313 11 JY2(I) = MAX(JY2(I) ,0.

)

2314 GO TO (1,2, 3, 5), IDE VIC

2815 G

2316 C CALCOMP SECTION.

2817 C

2318 1 DO 16 I = 1, NLP

2819 IF(LSW) GO TO 12

2820 IF(JXS.EQ. JXl(I) .AND. JYS . EQ, JY 1 ( I ) )GO TO 15

2821 12 CALL CALPLT(JXKI), JYl(I), 3)

2322 LSW =. FALSE.

282 3 15 CALL CALPLT(JX2(I), JY2(I), 2)

2324 JXS-JX2(I)

2325 JYS=JY2(I)

2326 16 CONTINUE

2827 RETURN

2828 G

2829 G PAGE PLOT SECTION.

2830 C

2831 2 DO 22 I-l,NLP

2832 HSYMBL - HDOT

2833 IF(DX(l).GT.2*DY(l))HSYMBL-HMlNUS
283

283(

283;

283 ^ 2839

284C

2841

2842

2843

2844

234 5 2846

234 7 2843

2349

2350

2351

2852

2853

2854

2355

2856

2357

2858

2859

2860

2861

2862

2363

2864

2865

2866

2867

2868

2369

28 70

2871

2872

2873

2874

2875

2876

2877

2878

2879

2880

2881

2882

2883

2884

2885

2886

SUBROUTINE PUTLNV page 67

IF( D Y( I )

. GT. 2*DX( I ) )HSYMBL=HAPOS

IDDX=JX2(I)-JXi(I)

IDDY=JY2(I)-JY1(I)

DO 20 L = 1, 9

JX=JXl(I)+((L-l)*IDDX)/8

JY=JYl(I)+((L-l)*IDDY)/8

IX= (JX+5)/10 + 1 IY= 65 - (JY+8)/16

K.=IX/4

M = IX- 4*K

IK = HSYMBL

K1 = 4 - M

Ml = 8*K1

I?(M .£Q. 0) K = :< - i LM = IAND(LPAGE(K+4,IY) , MASK(Kl))

IF( M .NE. 0) IK = I3HFT(HSYMBL, Ml)

20 LPAGE(K+4,IY) = I0R(LM, IK)

22 CONTINUE

RETURN

LEXIDATA/ MATRIX SECTION

3 IL = 1 32 IS = 1 CALL GMOVA(JXi(IL) , JYl(IL))

XY(1,IS) = JX2(IL)

XY(2,IS) = JY2(IL)

31 IL = IL + 1 IF(JXi(IL).NE.XY( 1 ,IS).0R. JY1(IL).NE.XY(2,IS),0R. IL.GT.NLP)

GO TO 30

IS = IS + 1 XY(1,IS) = JX2(IL)

:CY(2,IS) = JY2(IL)

GO TO 31

30 CALL GPLNA(XY,I3)

IF( IL.GT.NLP) RETURN

GO TO 32

RETURN

TEKTRONIX SECTION

5 CONTINUE

DO 40 I=>1,NLP

IF(LTSW) GO TO 42

IF(JXS. EQ. JXKD.AND, JYS.EQ, JYi(D) GO TO 45

42 CALL MOVEA(JXid) ,JYi(I))

LTSW = . FALSE.

45 CALL DRAWA(JX2(I) ,JY2(I))

JXS=JX2(I)

JYS-JY2(I)

40 CONTINUE

RETURN

END

A

"
2887

2888

2889

2890

2891

2892

2893

2394

2895

2896

SUBROUTINE SETLUT page 58

SUBROUTINE SETLUT

DIMENSION LUT(48)

DATA LUT/0, 15, 15,0,0, 15,15,0,15,1,3,5,7,9,11,13,

. 0, 15,0, 15,0, 15,0, 15,8,1,3,5,7,9, 11, 13,

. 0,15, 0,0, 15, 0,15, 15, 0,1, 3, 5, 7, 9, 11, 13/

CALL DSLWT (16, 48, LUT)

RETURN

END

- 207 -
SUBROUTINE SRfSET page 69

2897

2898 C

2899 C

2900 C

2901 C

2902 C

2903 C

2904 C

2905 C

290b C

2907 C

2908 C

2909 C

2910 C

2911 C

2912 C

2913 C

2914 C

2915 C

2916 C

2917 C

2918 C

2919 G

2920 C

292 1 C

292 2 C

2923 C

2924 C

292 5 C

2926 C

2927 C

2928 C

2929 C

2930 C

293 1 C

2932 C

2933 C

2934 C

2935 C

2936 C

2937 C

2938 C

2939 C

2940 C

2941 C

2942 C

2943 C

2944 C

2945 C

2946 C

2947 C

2948 C

2949 C

2950 C

2951 C

SUBROUTINE SRFSET(XX, YY , ZZMIN, ZZMAX, NX, NY)

THIS SUBROUTINE AND ITS ASSOCIATED ENTRIES CONSTRUCT AND

DELIVER PLOTS OF A SURFACE Z(I,J) WITH HIDDEN LINES REMOVED

FOR I = 1, NX AND J = 1, NY. THE TYPE, ORIENTATION,

\ND DETAILS OF THE PLOTS ARE QUITE FLEXIBLE AS SEEN BY CAREFUL

STUDY OF THE TEST EROGRAM AND THE RESULTING OUTPUT

THE PARTICULAR 'VERSION IS AN INTERFACE TO THE GENERAL PURPOSE

PLOTTLNG PACKAGE WHICH CAN DRAW COLOR PLOTS ON THE CALCOMP,

LEXIDATA, PRINTER OR TSKTRONICS (4000'S SERIES),

SURFACE INITIALIZES THE SURFACE PLOTTING PACKAGE AND MUST

BE CALLED EACH TIME A NEW PLOT IS DESIRED TO RESET THE

HIDDEN LINE ARRAYS.

NOTE THAT MAX(NX,NY) MUST BE LESS THAN NPT

THE LOGICAL PLOTTING REGION IS A 3D RECTANGULAR PARALLELEPIPED WITH 8 CORNER VERTICES.

XX REAL - ARRAY DIMENSIONED 8 CONTAINING THE 8 CORNER

VERTEX X LOCATIONS. THE VERTICES ARE NLTHBERED

AS SHOWN ON THE SURFACE GEOMETRY SHEET (AVAILABL

FROM THE SPL LIBRARIAN OR THE AUTHOR).

YY REAL - ARRAY DIMENSIONED 8 CONTAINING THE 8 CORNER

VERTEX Y LOCATIONS. THE VERTICES ARE NUMBERED

AS SHOWN ON THE SURFACE (SOMETRY SHEET WHICH IS AVAILABLE FROM THE SPL LIBRARIAN OR THE AUTHOR.

- THE VALUE OF Z(I,J) TO BE PLOTTED AT THE

BOTTOM SURFACE OF THE PARALLELEPIPED.

SMALLER Z(I,J) ARE SET (I.E. LIMITED) TO

ZZMIN,

- THE VALUE OF Z(I,J) TO BE PLOTTED AT THE

UPPER SURFACE OF THE PARALLELEPIPED,

lARGER Z(I,J) ARE SET (I.E, LIMITED) TO

ZZMAX.

NX INTEGER - DLMENSION AND RANGE OF I LN Z(I,J)

NY INTEGER - DLMENSION AND RANGE OF J IN Z(I,J)

ZZMIN REAL

ZZMAX REAL

SFRAME (MODEl) - PLOTS THE FRAME OF THE RECTANGULAR PARALLELEPIPED PLOTTING REGION.

MODEl INTEGER - MODEl = 1 PLOTS + AT THE VERTICES

= 2 ALSO PLOTS LINE SEGMENTS

CONNECTING THE VERTICES.

SSKIRT (ZZ, NX, NY, MODE2) - PLOTS ANY OF THE SKIRTS WHICH MAY

BE DESIRED. ONLY ONE SKIRT IS PLOTTED PER CALL AND THE

HIDDEN LINE ALGORITHM IS INVOKED. THEREFORE, THE SIDE

SKIRTS (+2, -2, +4, -4) AND THE DATA SURFACE BACK SKIRTS

(+3, -3) SHOULD ONLY BE PLOTTED AFTER THE DATA SURFACE

’has BEEN CONSTRUCTED USING SURFACE. THIS ENTRY DOES NOT

PLOT THE Z SURFACE (HERE THE DATA ARE CALLED ZZ TO AVOID

DECLARATION CONFLICTS). HOWEVER Z(I,J) ARE NEEDED TO

DEFINE THE SKIRT POSITIONS.

ZZ REAL - ARRAY CONTAINING THE DATA TO BE PLOTTED AS A

SURFACE

NX INTEGER - DIMENSION AND RANGE OF I IN Z(I,J)
SUBROUTINE SRFSET page 70

2952 C NY INTEGER - DLMENSION AND RANGE OF J IN Z(I,J)

2953 G M0DE2 INTEGER - M0DE2 = i(-l) LOWER (UPPER) FRONT SRIRT

2954 C = 2(-2) LOWER (UPPER) RIGHT SXIRT

2955 G = 3(-3) LOWER (UPPER) BACK SKIRT

2956 G = 4(-4) LOWER (UPPER) LEFT SKIRT

2957 G SURFAG (Z, NX, NY, M0DE3) - GONSTRUGTS AND PLOTS THE DATA SUR2958 G FACE AND SETS THE HIDDEN LINE ARRAYS WHICH ARE USED IN 2959 G SURFS K. 2960 G Z REAL - ARRAY DIMENSIONED (NX, NY) CONTAINING THE DATA

296 L G TO BE PLOTTED AS A SURFACE

2962 G NX INTEGER - DLMENSION AND RANGE OF I IN Z(I,J)

2963 G NY INTEGER - DIMENSION AND RANGE OF J IN Z(I,J)

2964 G M0DE3 INTEGER - M0DE3 = 1 PLOTS THE UPPER SURFAGE

29o5 c =-I PLOTS THE LOWER SURFACE

2966 G

2967 PARAMETER (NPT=101)

2968 LOGICAL SW(1024)

2969 REAL XX(8), YY(8)

2970 REAL X(8), Y(8), H(1280), G(1280)

2971 G REAL AJl(NPT), AJN(NPT), AIl(NPT), AIN(NPT) , ZVAL(NPT)

2972 G REAL RDZVB(NPT), RDZTV(NPT)

2973 LOGICAL SWITCH

2974 REAL Z(NX,NY), Xl(NPT) , X2(NPT) , Yl(NPT) , Y2(NPT)

2975 REAL ZZ(NX, NY)

2976 COMMON /SURCMN/ X, Y, ZMIN, aLAX, RDZ , RNXMl, RNYMl, NNX,

2977 G

2978 G INITIALIZE HIDDEN LINE ARRAYS.

2979 G

2980 NNX = NX

2981 NNY = NY

2982 IF(MAXO(NX,NY).GT.NPT) STOP 76

‘ 2983 YMIN = l.E+25

2984 YMAX = -l.E+25

2985 DO 3 I = 1, 8

2936 ’£MIN = AMINlCfMIN, YY(I))

2937 3 '£MAX = AMAX1(YMAX, YY(I))

2988 DO 1 1=1, 1280

2989 G(I) = YMAX

2990 1 H(I) = YMIN

2991 G

2992 G FOR SPECIAL EFFECTS ZBOT AND ZTOP MAY DIFFER FROM ZMIN AND ZMAX

2993 G

2994 ZBOT = ZZMIN

2995 ZTOP = ZZMAX

2996 ZMIN = ZZMIN

2997 ZMAX - ZZMAX

2998 RDZ = 1.0/(ZTOP - ZBOT)

2999 DO 2 I = 1, 8

3000 X(I) - XX(I)

3001 2 Y(I) - YY(I)

3002 RNXMl - L.O/FLOAT(NX - 1)

3003 RNYMl - 1.0/FL0AT(NY - 1)

3004 RETURN

3005 G

3006 C
SUBROUTINE SRfSET page 71

3007 C

3008 C

31309

3010 C

3011 C

3012 C

3013 C

3014 C

3015 C

30 1 0 C

3017 G

3013 C

3019 C

3 .:o C

3021 C

3022 C

3023

3024 0

3025 C

3026 C

3027

3028

3029

3 030

3031

3032

3033

3034

3035

3036

3037

3038

3039

3040

3041

30^2

3043

3044

30a5

3046

3047

3048

3049

3050 C

3051 C

3052 C

3053 C

3054

3055 C

3056 C

3057 C

3058 C

3059 C

3060 C

3061 C

ENTRY SFRAME (MODEl)

*-kitkitit-k-k-kititMit-kieicie-kie-k-kit-k:kie:kic*-kit-k:k-k

DESCRIPTION: SURFRM PLOTS TEE FRAME OF THE RECTANGULAR PARALLELOPIPED PLOTTING REGION.

ARGUMENTS

:

MO DEI INTEGER MO DEI = 1 PLOTS + AT THE VERTICES.

MODEl = 2 ALSO PLOTS LINE SEGMENTS

CONNECTING THE VERTICES.

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

CALL CHPLOT (X, Y, 1, 1, 8)

NOW CHECK THE VARIOUS LINES.

IF (MODEl .LE. 1) GO TO 12

CALL SURF5 (X(l), Y( 1 ) , X(2), Y(2))

CALL SURF5 (X(6), Y(6), X(2), Y(2))

CALL SURF5 (X(6), Y(6), X(5), Y(5))

CALL SURF5 (X(l), Y(l), X(5), Y(5))

IF (Y(7).GT.Y(5) .OR. X( 7 ) . LT. X( 5 )

)

1 CALL SURF5 (X(5), Y(5), X(7), Y(7))

IF (Y(8).GT.Y(6) .OR. X(8) .GT.X(6)

)

1 CALL SURF5 (X(8), Y(8), X(6), Y(6))

IF (Y(3).LT.Y(1) .OR. X(3 ) . LT. X( 1 )

)

1 CALL SURF5 (X(l), Y(I), X(3), Y(3))

IF (Y(4) .LT.Y(2) .OR. X(4).GT.X(2)

)

1 GALL SURF5 (X(2), Y(2), X(4), Y(4))

IF (Y(7).GE.Y(5) .AND. Y(8) .GE. Y(6)

)

1 CALL SURF5 (X(8), Y(8), X(7), Y(7))

IF (X(3).GE.X(6) .AND. X( 4 ) . GE . X( 2 )

)

1 GALL SURF5 (X(8), Y(8), X(4), Y(4))

IF (Y(4).LE.Y(2) .AND. Y(3) . LE. Y( 1 )

)

1 CALL SURF5 (X(4), Y(4), X(3), Y(3))

IF (X(3).LE.X(1) .AND. X(7) .LE.X(5)

)

1 CALL SURF5 (X(7), Y(7), X(3), Y(3))

12 CONTINUE

RETURN

ENTRY SSKIRT (ZZ, NX, NY, MODE2)

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

DESCRIPTION: SURFSR PLOTS ANY OF THE SKIRTS WHICH MAY BE DESIRED,

ONLY ONE SKIRT IS PLOTTED PER CALL AND THE HIDDEN LINE ALGORITHM

IS INVOKED. THEREFORE, THE SIDE SKIRTS (+2, -2, M, -4) AND THE
3062

3063

3064

3065

3066

3067

3068

3069

3070

3071

3072

3073

3074

3075

3076

3077

3078

3079

3080

3081

3082

3083

3084

3085

3086

3087

3088

3089

3090

3091

3092

3093

3094

3095

3096

3097

3098

3099

3100

3101

3102

3103

3104

3105

3106

3107

3108

3109

3110

3111

3112

3113

3114

3115

3116

SUBROUTINE SRFSET page 72

C

Cc

c

c

c

c

c

c

c

c

c

cc

c

c

Gc

c

211

212

G

G

G

22

221

BAGK SKIRTS (+3, -3) SHOULD ONLY BE PLOTTED AFTER THE DATA SURF AGE

HAS BEEN GONSTRUGTED USING SURFAGE. THIS ENTRY DOES NOT PLOT THE Z SURFAGE (HERE THE DATA ARE GALLED ZZ TO AVOID DEGLARATION GONFLIGTS). HOWEVER Z(I,J) ARE NEEDED TO DEFINE THE SKIRT POSITIONS.

ARGUMENTS

:

ZZ REAL ARRAY (NX, NY) THE DATA TO BE PLOTTED AS A SURF AGE. I NX INTEGER DIMENSION AND RANGE OF I IN Z(I,J). I NY INTEGER DLMENSION AND RANGE OF J IN Z(I,J). I MODE2 INTEGER MODE2 = 1(-1) LOWER (UPPER) FRONT SKIRT

MODE2 = 2(-2) LOWER (UPPER) RIGHT SKIRT

MODE2 = 3(-3) LOWER (UPPER) BAGK SKIRT

MODE2 = 4(-4) LOWER (UPPER) LEFT SKIRT

NSKIRT = IABS(MODE2)

GO TO (21, 22, 23, 22), NSKIRT

THE FRONT SKIRT IS ADDED.

GONTINUE

XL = X(l)

XR = X(2)

YL = Y(l)

YR = Y(2)

IF (MODE2 .GT. 0) GO TO 211

XL = X(5)

XR = X(6)

YL = Y(5)

YR = Y(6)

DO 212 I = 1, NX

FIl = FLOAT(I-l)/FLOAT(NX-l)

FIN = FL0AT(NX-I)/FL0AT(NX-1)

XA = XR*FI1 -t- XL*FIN

YA = YR*FI1 + YL*FIN

GALL SURF4 (XB,YB, 1,1, ZZ(I,1))

GALL SURF5 (XA, YA, XB , YB)

RETURN

THE RIGHT OR LEFT SIDE SKIRT IS ADDED. IF IT IS OBSGURED THE

HIDDEN LINE ALGORITHMS ARE USED SO GALL ONLY AFTER SURFAGE IS USED

NSK =- (4 - NSKIRT)/2

I - 1 + (NX-1)*NSK

XST - X(NSK+1)

YST - Y(NSK+1)

XND - X(NSK+3)

YND =- Y(NSK+3)

IF (MODE2 .GT. 0) GO TO 221

XST - X(NSK+5)

YST - Y(NSK+5)

XND - X(NSK+7)

YND - Y(NSK-»-7)

DO 222 J - 1, NY

PJl - FLOAT(J-l)/FLOAT(NY-l)
SUBROUTINE SRFSET page 73

3117

3118

3119

3120

3121

3122

3123

3124

3125

312b

3127

3128

3129

3130

3131

3132

3133

3134

3135

3136

3137

3138

3139

3140

3141

3142

3143

3144

3145

3146

3147

3148

3149

3150

3151

3152

3153

3154

3155

3156

3157

3158

3159

3160

3161

3162

3163

3164

3165

3166

3167

3168

3169

3170

3171

FJN = FLOAT(NY-J)/FLOAT(NY-l)

XA = XND*FJ1 + XST*FJN

YA = YND*FJ1 + YST*FJN

CALL SURF4 (XB.YB, I,J, ZZ(I,J))

C

C THE SKIRT MAY BE OBSCURED. CHECK ON TOP OR BOTTOM.

C

K = XB -t- 0. 5 IF (MODE2 .GT. 0) YB = AMIN1(YB, G(K))

IF (MODE2 .LT. 0) YB = AMAX1(YB, H(K))

IF (MODE2.GT.O .AND. YA.LT.G(K)) CALL SURF5 (XA, YA , XB , YB)

IF (MODE2.LT.O .AND. YA.GT.H(K)) CALL SURF5 (XA, YA , XB , ’IB)

222 CONTINUE

RETURN

C THE BACK SKIRT IS ADDED (ASSUMED CALLED AFTER SURFACE).

C

23 CONTINUE

XL = X(3)

YL = Y(3)

XR = X(4)

YR = Y(4)

IF (MODE2.GT.O) GO TO 231

XL = X(7)

YL = Y(7)

XR = X(8)

YR = Y(8)

231 DO 232 I = 1, NX

FIl = FLOAT(I-l)/FLOAT(NX-l)

FIN = FLOAT(NX-I)/FLOAT(NX-l)

XA = XR*FI1 -t- XL*FIN

YA = YR*FI1 + YL*FIN

CALL SURF4 (XB,YB, I, NY, ZZ(I,NY))

K = XB + 0. 5 IF (MODE2 .GT. 0) YB = AMINl (YB , G(K))

IF (MODE2 .LT. 0) YB = AMAXl (YB, H(K))

IF (FLOAT(MODE2)*(YB-YA) .GT. 0.0) GALL SURF5(XA, YA, XB , YB)

232 CONTINUE

RETURN

C

G

C

C

ENTRY SURFAC (Z, NX, NY, MODE3)

C

C A********************************

C

C DESCRIPTION: SURFACE CONSTRUCTS AND PLOTS THE DATA SURFACE AND SET

C THE HIDDEN LINE ARRAYS WHICH ARE USED IN SURFSK.

C

C ARGUMENTS

:

c z REAL ARRAY (NX, NY) THE DATA TO BE PLOTTED AS A SURFACE. I c NX INTEGER DIMENSION AND RANGE OF I IN Z(I,J). I c NY INTEGER DIMENSION AND RANGE OF J IN I c MODE3 INTEGER MODE3 - 1 PLOTS THE UPPER SURFACE I

n T
SUBROUTINE SRFSET page 75

3227

3228

3229

3230

3231

3232

3 233

3234

3235 C

3236 G

3237 C

3238

3239

3240

3241

3242

3243

3244

3245

3246

3247

3248

3249

3250

3251

3252

3253 C

3254 C

3255 C

3256

3257

3258

3259

3260

3261

3262

3263

3264

3265

3266

3267

3268

3269

3270

3271

3272

3273

3274

3275 C

3276 G

3277 G

3278

3279

3280

3281

YA = AMAXl(YKI), H(IXH))

YB = AMAX1(Y2(I), H(IXH))

IF (YB.GT.YA) GALL SURF5 (X1(I),YA, X2(I),YB)

GO TO 35

39 YA = AMINl(YKI), G(IXH))

YB = AMIN1(Y2(I), G(IXH))

IF (YB.LT.YA) GALL SURF5 (X1(I),YA, X2(I),YB)

GO TO 35

THIS IS A SLANTED LINE SEGMENT.

38 DIX = 1.0/FLOAT(IXB - IXA)

SWITGH = .TRUE.

NSWT = IXB - IXA + 1 DO 36 K = IXA, IXB

3W(X) = .TRUE.

IF (X2(I),GT.X1(I)) YK = Y1(I)*(IXB-X)*DIX + Y2( I

) *(K-IXA) *DIX

IF (X2(I).LT.X1(I)) YK = Y2( I

) *( IXB-K) *DIX + Yl( I )*(X-IXA)*DIX

IF ( (MODE3 .lt. 0 .AND. G(K) .GE. YK-0. 5)

1 .OR. (MODE3.GT.O .AND. H(K) . LE. YK+0. 5) ) GO TO 36

SWITGH = .FALSE.

SW(X) = .FALSE.

NSWT = NSWT - 1 36 GONTINUE

IF (SWITGH) GALL SURF5 (X1(I), Y1(I), X2(I), Y2(I))

IF (SWITGH .OR. NSWT.EQ.O) GO TO 35

PART OF THE LINE IS OBSCURED SO WE NEED TO PLOT SEGMENTS,

SW(IXA-l) = .FALSE.

SW(IXB+1) = .FALSE.

DO 41 K = IXA, IXB

IF (X2(I).GT.X1(D) YK = Y1(I)*(IXB-K)*DIX + Y2( I ) *(K-IXA) *DIX

IF (X2(I).LT.X1(I)) YK = Y2( I)*(IXB-K)*DIX + Y 1

( I

) *( K-IXA ) *DIX

IF (.NOT.SW(K) .OR. SW(K-l)) GO TO 51

XA = K

YA = YK

IF (K. EQ.IXA) GO TO 51

IF (MODE3.GT.O) YA =» AMINl (H(K), YK)

IF (MODE3.lt. 0) YA = AMAXl (G(K), YK)

51 IF (.NOT.SW(K) .OR. SW(K+1)) GO TO 41

IF (K.EQ. IXB) GO TO 52

IF (MODE3.GT.O) YK - AMINl (H(K), YK)

IF (MODE3.LT.O) YK = AMAXl (G(K), YK)

52 CALL SURF5 (XA, YA,FLOAT(K) ,YK)

41 CONTINUE

35 CONTINUE

37 CONTINUE

PLOT THE I TO I-t-1 LINE SEGMENTS IF NOT HIDDEN.

DO 33 I - 2, NX

IXB - X2(I) + 0.5

IXA - X2(l-1)

DIX • l.O/FLOAT(lXB - IXA)
3282

3283

3284

3285

3286

3287

3288

3289

3290

3291

3292

3293

3294

329 5 3296

3297

3298

3299

3300

3301

3302

3303

3304

3305

3306

3 307

3308

3 309

3310

3311

3312

SUBROUTINE SRESET page 76

SWITC8 = .TRUE.

NSWT = IXB - IXA + 1 DO 34 K. = IXA, IXB

SW(K.) = .TRUE.

YK = Y2(I-1)*(IXB-K:)*DIX + Y2(I)*(K-IXA)*DIX

IF (MODE3.GT.O) H(X) = AMAX1(H(K), YK)

IF (M0DE3.lt. 0) G(K) =AMIN1(G(K), YK)

IF ((M0DE3.LT.0 .AND. G(K) .GE. YK-0. 5)

1 .OR. (MODE3.GT.O .AND. H(K) . LE . YK+0. 5) ) GO TO 34

SWITCH = .FALSE.

SW(K) = .FALSE.

NSWT = NSWT - 1 34 CONTINUE

IF (SWITCH) CALL SURF5 (X2(I-1), Y2(I-1), X2(I), Y2(I))

IF (SWITCH .OR. NSWT.EQ.O) GO TO 33

C

C PART OF THE LINE IS OBSCURED SO WE NEED TO PLOT SEGMENTS.

C

SW(IXA-l) = .FALSE.

SW(IXB+i) = .FALSE.

DO 44 K = IXA, IXB

YK = Y2(I-i)*(IXB-K)*DIX + Y2( I

) *(K-IXA) *D IX

IF (SW(K) .AND. .NOT.SW(K-D) XA = K

IF (SW(K) .AND. .NOT.SW(K-i)) YA = YK

IF (SW(K) .AND. .NOT.SW(K+i)) CALL SURF5 (XA , YA , FLOAT(K) , YK)

44 CONTINUE

33 CONTINUE

C

31 CONTINUE

RETURN

END

- 214 -
SUBROUTINE SURE4 page 77

3313

3314 C

3315 G

3316 C

3317 C

3318 C

3319 G

3320 G

3321 G

3322 G

3323 G

3324

3325

3326 G

3327

3 328

3329

3330

3331

3332

3333

3334

3335

3336

3337

3338

3339

3340

3341

3342 G

3343 G

3344 G

3345 G

3346 G

3347 G

3348 C

3349 G

3350 G

3351

3352 G

3353

3354

3355

3356

SUBROUTINE SURF4 (XVAL, YVAL, I, J, ZIN)

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

THIS IS AN AUXILIARY ROUTINE TO SURFAGE. IT PERFORMS A TRILINEAR I TERPOIATION IN THE 3D REGTANGLE OUTLINED BT (X(I), Y(I)) ON THE

PLOTTING SURFACE FOR I = 1, 8. THE TEXT WILL BE SUBSTITUTED

IN LINE WHEN THE ASC COMPILER BUG HAS BEEN FIXED.

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

REAL X(8), Y(8)

COMMON /SURCMN/ X, Y, ZMIN, ZMAX, RDZ , RNXMi, RNYMl, NNX, NNY

12

3

12

3

FIl = FL0AT(I-1)*RNXM1

FJl = FL0AT(J-1)*RNYM1

FIN = FL0AT(NNX-I)*RNXM1

FJN = FL0AT(NNY-J)*RNYM1

ZVAL = AMAXl (ZIN, ZMIN)

ZVAL = AMINl (ZVAL, ZMAX)

XVAL = RDZ*(ZVAL-ZMIN)*(FJN*(FI1*X(6)

+ FJl*(FIi*X(8) + FIN*X(7)))

+ RDZ*(ZMAX-ZVAL)*(FJN*(FI1*X(2)

+ FJ1*(FI1*X(4) + FIN*X(3)))

YVAL = RDZ*(ZVAL-ZMIN)*(FJN*(FI1*Y(6)

+ FJ1*(FI1*Y(8) + FIN*Y(7)))

+ RDZ*(ZMAX-ZVAL)*(FJN*(FI1*Y(2)

+ FJ1*(FI1*Y(4) + FIN*Y(3)))

RETURN

+ FIN*X(5))

+ FIN*X(D)

+ FIN*Y(5))

+ FIN*Y(1)

)

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

THIS SUBROUTINE IS A GENERAL-PURPOSE GRAPHICS INTERFACE FOR USE

WITH THE SURFACE SUBROUTINE FOR 3D SURFACE PLOTS WITH HIDDEN LINES

REMOVED.

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

ENTRY SURF5 (XI, Yl, X2, Y2)

IF ( ((Xl-X2)**2 + (Yl-Y2)**2) .GT. 2.25)

1 CALL LINE (XI, Yl, X2, Y2)

RETURN

END
SUBROUTINE SYMBOL page 78

3357

3358 C

3359

3360

3361

3 362 C

3363 C

3 364 C

3365 C

3366 C

3367

3368

3369

3370

337 1 3372

SUBROUTINE SYMBOL (XCHAR, YCHAR, CHARAC)

COMMON /DEVTYP/ IDEVIC , LSW , LTSW , XYCOOD(4 )

, LUOUT , LPAGE

COMMO N/ GRFT Y P/ ANGLE , IRVRSE , CHS IZ E ( 9 )

, ITKW IT , LUD lAG , LUES ET

CHARACTER*! CHARAC

THIS SUBROUTINE USES THE HARWARE CHARACTERS TO PLOT DATA

POINTS AT THE LOCATION SPECIFIED BY (XCHAR, YCHAR) IN THE PLOTTING

REGION DETERMINED BY XYCOOD.

IF (IDEVIC, EQ. 4) CALL IOWAIT(8)

X = XYCOOD(i)*XCHAR + :CYCOOD(2) - CHSIZE(2) *CHSIZE( 3

)

Y = XYCOOD(3)*YCHAR + XYCOOD(4) - CHSIZ£(2)*CHSIZE(4)

CALL PUTCH (X, Y, CHARAC)

RETURN

END

- 216-
SUBROUTINE VIEWTR page 79

3373

3374

3375

3376

3377

3378

3379

‘3380

3381

3382

*3383

3384

3385

3386

3387

3 388

3389

3390

3391

3392

3393

3394

3395

3396

3397

3398

3399

3400

3401

3402

3403

3404

3405

3406

3407

3408

3409

3410

3411

3412

3413

3414

3415

3416

-3417

3418

3419

3420

3421

3422

3423

3424

3425

3426

3427

SUBROUTINE VIEWTR(XDC , WINDOW , VERTEX, NV , EDGE , ESPEC , NE

,

. POLY,PSPEC,NP)

C

C THIS SUBROUTINE PLOTS EDGES AND POLYGONS WHICH ARE WITHIN THE WINDOW

C EDGE SEGMENTS WHICH CROSS A PORTION OF THE WINDOW.

C

REAL VERTEX(3,NV) , WINDOW(4), XYZ(3,8)

INTEGER EDGE (2, NE) , ESPEC(4,NE), POLY(8,NP), PSPEC(4,NP)

REAL U1,V1,U2,V2,X(8),Y(8),XDC(4,4)

C

C DEFINE THE WINDOW SPACE

C

CALL DEFINE ( WINDOW (1 ), WIN DOW ( 2 )

, WINDOW ( 3 ), WIN DOW ( 4 )

)

C

DOZ = iOOOO.

FANGL£=90.

TANAL =1.0

WCX = 0. 5 * (WINDOWC l)+WINDOW(3)

)

WCY = 0,5 * (WINDOWC 2)+WINDOW(4)

)

C

C PLOT ONE EDGE AT A TIME

C

LWD = -1

LCL = -1

LFL = -1

DO 150 J=1,NE

C

C MOVE VERTICES INTO A LOCAL WORK ARRAY

C

DO 151 I = 1, 2 DO 151 K = 1, 3

151 XYZ(K,I) = VERTEX(K,EDGE(I, J))

C

C .4PPLY THE TRANSFORM

C

DO 152 I = 1, 2 U1 = XYZ(1,I)

U2 = XYZ(2,I)

U3 = XYZ(3,I)

XYZ(1,I) = XDC(1,1)*U1 + XDC(1,2)*U2 + XDC(1,3)*U3 + XDC(1,4)

XYZ(2,I) = XDC(2,1)*U1 + XDC(2,2)*U2 + XDC(2,3)*U3 + XDC(2,4)

152 XYZ(3,I) = XDC(3,1)*U1 + XDC(3,2)*U2 + XDC(3,3)*U3 + XDC(3,4)

C

C ADD PERSPECTIVE

C

D - DOZ/((DOZ+XYZ(3, 1))*TANAL)

U1=(XYZ(1, 1)-WCX)*D + WCX

V1-(XYZ(2, 1)-WCY)*D + WCY

D - DOZ/((DOZ+XYZ(3,2))*TANAL)

U2-(XYZ( 1 ,2)-WCX)*D + WCX

V2=(XYZ(2, 2)-WCY)*D + WCY

C

C CLIP LEFT EDGE

C

IF (Ui.GE.WINDOW(i).AND.U2.GE.WINDOW(l)) GO TO 50

T 1

-•
3428

3429

3430

343 1 3432

3433

3^34

3435

3436

3^37

3438

3439

5-*40

3 -‘*+

1

34-»2

3443

3 -*44 3-445

3-446

3-447

3 448

3449

3450

3451

3452

3453

3454

3455

3456

3457

3458

3459

3460

3461

3462

34o3

3 4 64

3465

3466

3467

3468

3469

3470

3471

3472

3473

3474

3475

3476

3477

3478

3479

3480

3481

3482

SUBROUTINE VLEWTR page 80

IF (Ul.LT.WINDOW(l).AND.U2.LT.WINDOW( D) GO TO 150

IF (Ul.GT.WINDOW(l)) GO TO 40

VI = (V1-V2)*U1/(U2-U1)+V1

U1 = WINDOW(l)

GO TO 50

40 V2 - (V2-V1)*U2/(U1-U2)+V2

U2 = WINDOWS)

C

C CLIP RIGHT EDGE

C

50 IF (Ul.LE.WINDOW(3).AND.U2.LE.WINDOW(3)) GO TO 70

IF (Ul.GT.WINDOW(3).AND.U2,GT.WINDOW(3)) GO TO 150

IF (Ul.GT.WINDOW(3) ) GO TO 51

V2 = (V2-V1)*(WIND0W(3)-U1)/(U2-U1)+V1

U2 = WINDOW(3)

GO TO 70

51 VI = (V1-V2)*(WIND0W(3)-U2)/(U1-U2)+V2

U1 = WINDOW(3)

C

C CLIP BOTTOM EDGE

C

70 IF (Vl.GE.WINDOW(2).AND. V2.GE.WINDOW(2)) GO TO 90

IF (Vl.LT.WINDOW(2).AND.V2.LT.WINDOW(2)) GO TO 150

IF (Vl.GT.WINDOW(2)) GO TO 80

U1 = (U1-U2)*V1/(V2-V1)+U1

VI = WINDOW(2)

GO TO 90

80 U2 = (U2-U1)*V2/(V1-V2)+U2

V2 = WINDOW(2)

C

C CLIP TOP EDGE

C

90 IF (Vl.LE.WINDOW(4).AND.V2.LE.WINDOW(4)) GO TO 110

IF (Vl.GT.WINDOW(4).AND.V2.GT.WINDOW(4) ) GO TO 150

IF (Vl.GT.WINDOW(4) ) GO TO 100

U2 = (U2-U1)*(WIND0W(4)-V1)/(V2-V1)+U1

V2 = WINDOW(4)

GO TO 110

100 U1 = (U1-U2)*(WIND0W(4)-V2)/(V1-V2)+U2

VI = WINDOW(4)

C

C PLOT THE EDGE

C

110 LF(LWD.NE,ESPEC(1, J)) THEN

LWD » ESPEC(1,J)

GALL LINWID(LWD)

END IF

IF(LCL.NE.ESPEC(2,J)) THEN

LCL » ESPEC(2,J)

CALL COLOR(LCL) ' ENDIF

CALL LINE(U1, VI, U2, V2)

150 CONTINUE

C

C PLOT POLYGONS ON TOP OF EDGES
3483

3484

3485

3486

3487

3488

3489

* 3490

3491

3492

*3493

3494

3495

3496

3497

3498

3499

3500

3501

3502

3503

3504

3 505

3 506

3507

3508

3 509

3510

3511

3512

3513

3514

3515

3516

3517

3518

3519

3520

3521

3 522

3523

3524

3525

3526

3527

3528

3529

3530

3531

3532

3 533

3 534

3535

3536

3537

SUBROUTINE VIEWTR page 81

C

DO 10 J = 1, NP

NUM=0

C

C DETERMINE THE NUMBER OF VERTICES (NON-ZERO ENTRIES) IN THE

C POLYGON

C

DO 15 1=1,8

IF(P0LY(I, J).NE.0) NUM=NUM+1 ;NUMBER OF VERTICES IN POLYGON

15 CONTINUE

C

C MOVE THE VERTICES INTO A LOCAL WORK ARRAY

C

DO 61 I = 1, NUM

DO 61 K = 1, 3 61 XYZ(K,I) = VERT£X(K,POLY(I, J))

C

C APPLY THE TRANSFORM

C

DO 62 I = 1, NUM

U1 = XYZ(1,I)

U2 = XYZ(2,I)

U3 = XYZ(3,I)

XYZ(1,I) = XDC(1,1)*U1 + XDC(1,2)*U2 + XDC(1,3)*U3 + XDC(1,4)

XYZ(2,I) = XDC(2,1)*U1 + XDC(2,2)*U2 + XDC(2,3)*U3 + XDC(2,4)

62 XYZ(3,I) = XDC(3,1)*U1 + XDC(3,2)*U2 + XDC(3,3)*U3 + XDC(3,4)

C

C ADD PERSPECTIVE

C

DO 60 IV=1,NUM

D = DOZ/((DOZ+XYZ(3,IV))*TANAL)

X(IV) = (XYZ(1-, IV) - WCX)*D + WCX

60 Y(IV) = (XYZ(2,IV) - WCY)*D + WCY

C

C PLOT THE POLYGON

C

IF(PSPEG( 1

, J) .NE. LWD) THEN

LWD = PSPEC(1,J)

GALL LINWID(LWD)

ENDIF

IF(PSPEC(2,J).NE.LCL) THEN

LCL = PSPEC(2,J)

GALL COLOR(LCL)

ENDIF

IF(PSPEC(3,J).NE.LFL) THEN

LFL - PSPEC(3,J)

GALL FILTYP(LFL)

ENDIF

IF(PSPEC(4,J).GE.O) THEN

CALL PLYGON(X, Y, NUM)

ELSE

GALL LINES(X(1), Y( 1 ) , X( 2 ) , Y(2), NUM-l)

ENDIF

10 CONTINUE ;GET NEXT POLYGON

RETURN
i •»

3538

3539 C

5

144-.

3*4 »

* w

ISUBROUTINE VIEWTR

END i'

»

* i f ' *

- la as3jtH:iv w

hr,'.- ^ - r'lw /, ^ *»4. fllHiS'4 L^-

*'!T’ «*'"*

,*'''«tt!a„®>i

1r4

' '*53^

_. 7:^'- a £ ’3fe

.•1 >M ^«-t: ®;<<-tfj:;is4*«:’j9)5|mv >#a.isj'jnpt ,*j,.

^#is«iyufT-^iti? yj’iiA

.-.-V,' i?rl

n . ~n-\^ , fk 'J 'ifJ® '..‘' >>/.' «».«««» .. -t NyWW * ^t>W*» » to ''

<*OA v;jit % ,7r -

-^-' m

p myif

r* f ^

m^- m-

* ,. » If'

' '^‘ ' '^'

iv rm

'

jiho - "''**-

- ^ " ' - ‘- Si;39««Sl - 4ai

^ 2'f ^i- T

iom *"^K...( i

j-

. .T • ^' W . ^ ^ . ,«• • — »?i*^ «£

-* 4ai

'' '"^ 'iriaHa'

» J1U

jiui.0

news

\HS8T (9 4^,. \ , #:>3(jrt.8'r >n

'KU,R %y ,sf^HO©yj9

' -itjs

^ -

^KWlUTtS

-*-&a
3540

3541

3542

3543

3544

3545

3546

3547

3548

3 549

3550

3551

3552

3553

3554

3555

3556

3557

3558

3559

3 560

3561

3562

3563

3564

3565

3566

3567

3 568

3 569

3570

SUBROUTINE VOLFRM page 83

SUBROUTINE VOLFRM (MODEl)

C

C THIS ENTRY PUTS A FRAME AROUND THE REGION IF DESIRED.

C FIRST PLOT + AT ALL OF THE VERTICES.

C

COMMON/VOLCOM/XR,YR,A,TP,AP,DK,DY,DZ ,X, Y , Z , SC 1 , FSEG , NTT

LOGICAL A(l)

INTEGER TP,AP

DIMENSION XR(8) ,YR(8) ,DX(4) ,DY(4) ,DZ(4) ,X(4) , Y(4) ,Z(4) ,SC1(4)

DO 101 I = 1, 8

101 CALL CHPLOT (SCI, XR(I), YR(I), ' + V',

C

C NOW CHECK THE VARIOUS LINES.

C

IF (MODEl .LE. 1) GO TO 102

CALL LINE (XR(1) ,YR(1) , XR(2) ,'fR(2) ) CALL LINE (XR(6) ,YR(6) , XR(2),YR(2))

CALL LINE (XR(6) ,YR(6) , XR(5),YR(5))

CALL LINE (XR(1),YR(1), XR(5),YR(5))

CALL VOLUM8 (XR(4) , YR(4) , XR(3),YR(3), T, NT)

CALL VOLUM8 (XR(4) , YR(4) , XR(8),YR(3), T, NT)

CALL VOLUM8 (XR(7 ), YR(7 ) , XR(8),YR(8), T, NT)

CALL VOLUM8 (XR( 7 ), YR( 7 ) , XR(3),YR(3), T, NT)

CALL VOLUM8 (XR(4) , YR(4) , XR(2),YR(2), T, NT)

CALL VOLUM8 (XR( 1 )

, YR( 1 ) , XR(3),YR(3), T, NT)

CALL VOLUM8 (XR(6 )

, YR( 6 ) , XR(8),YR(8), T, NT)

CALL VOLUM8 (XR(7) ,YR(7 ) , XR(5),YR(5), T, NT)

102 CONTINUE

RETURN

END

C

- I -
SUBROUTINE VOLUMO page 84

3 57 1 SUBROUTINE VOLUMO (Q, R, NX, NY, NZ

3572 C

3 573 REAL X(8), Y(8), Q(8), R(8)

3 574 RNX = 1.0/FLOAT(NX-1)

3 575 RNY = 1. 0/FLOAT(NY-1)

3 576 RNZ = 1.0/FLOAT(NZ-I)

3 577 FNX = NX

3578 FNY = NY

3 579 FNZ = NZ

3 530 DO 1 I = 1, 8

3531 K(I) = Q(I)

3 532 1 Y(I) = R(I)

3 533 RETURN

3 584 C

3 535 c

3 536 ENTRY V0LUM6 (:<A,YA, XG,YG,ZG)

3537 c

3 538 Dll = (FNX - XG)*RNX

3539 DJI = (FNY - YG)*RNY

3590 DKi = (FNZ - ZG)*RNZ

3591 DIN = 1.0 - Dll

3592 DJN = 1.0 - DJI

3 593 DKN = 1.0 - DKI

3594 :<A = ((X(l)*DIi+K(2)*DIN)*DJl + (X(3)*DI1+X(4)*DIN)*DJN)*DK1

3595 1 + ((X(5)*DI1+X(6)*DIN)*DJ1 + (X(7 ) *DI1+X(8 ) *DIN)*D JN) *DKN

3596 YA = ((Y( l)*DIi+Y(2)*DIN)*DJl + (Y(3)*DIi+Y(4)*DIN)*DJN)*DXl

3597 1 + ( (Y(5)*DIi+Y(6)*DIN)*DJl + (Y(7 )*DI1+Y(8)*DIN) *DJN)*DKN

3598 RETURN

3 599 END

3600 C

_')T T-
SUBROUTINE VOLUM7 page 85

3601 SUBROUTINE VOLUM7 (GLEVEL, F00,F10,F1 1 ,F01

3602 C

3603 REAL X(4), Y(4)

3604 C

3605 c AT LEAST ONE GROSSING WILL BE FOUND. TEST

3606 c 3607 ISEG = 0

3 608 IF (FOO.NE.FIO) DX = (GLEVEL-F00)/(F10

3609 IF (FOO.EQ.FIO) DX = 0.0

3610 IF (DX.GE.1.0 .OR. DX.LE.0.0) GO TO 2

3'611 c 3612 c REGORD THE LOWER GROSSING.

3613 c 3614 ISEG = ISEG + 1 3615 X(ISEG) = DX

3616 Y(ISEG) = 0.0

3617 G

3618 C TEST THE RIGHT SEGMENT.

3619 G

3620 2 IF (FlO.NE.Fll) DY = (GLEVEL-F 10) / (F 1

1- 362 1 IF (FlO.EQ.Fll) DY = 0.0

3622 IF (DY.GE.1.0 .OR. DY.LE.0.0) GO TO 3

3623 G

3624 G REGORD THE RIGHT SIDE GROSSING.

3625 G

3626 ISEG = ISEG + 1 3627 X(ISEG) = 1.0

3628 Y(ISEG) = DY

3629 G

3630 G TEST THE TOP SEGMENT.

3631 G

3632 3 IF (Fll.NE.FOl) DX = (GLEVEL-FOl ) / (F 1 1- 3633 IF (Fll.EQ.FOl) DX = 1.0

3634 IF (DX.GE.1.0 .OR. DX.LE.0.0) GO TO 4

3635 G

3636 G REGORD THE TOP GROSSING.

3637 G

3638 ISEG = ISEG + 1 3639 X(ISEG) = DX

3640 Y(ISEG) = 1.0

3641 G

3642 G TEST THE LEFT SIDE SEGMENT.

3643 G

3644 4 IF (FOl.NE.FOO) DY =• (GLEVEL-FOO) /(FOl

3645 IF (FOl.EQ.FOO) DY = 1.0

3646 IF (DY.GE.1.0 .OR. DY.LE.0.0) GO TO 5 3647 G

3648 G REGORD THE LEFT SIDE GROSSING.

3^9 G

3650 ISEG - ISEG -t- 1 3651 X(ISEG) =0.0

3652 Y(LSEG) - DY

3653 G

3654 G SAVE ANY LINE SEGMENTS FOUND

3655 G
SUBROUTINE VOLUM7 page 86

3656 5 NSEG = ISEG

3637 RETURN

3658 END

- 224 -
SUBROUTINE VOLUM8 page 87

3659

3660 C

3661

3662

3663

3664

3665

3666 C

3667

3668 G

3669 C

3670 C

3671

3672

3673

3674

3675

3676

3677

3678

3679

3680

3681

3682 C

3683 C

3684 C

3685

3686

3687 C

3688 C

3689 G

3690

3691

3692

3693

3694

3695

3696

3697

3698 G

3699 G

3700 C

3701

3702

3 703

3704

3705 C

3706 G

3707 G

3708

3709

3710

371

1

3712

3713

SUBROUTINE VOLUM8 (XA, YA, XB , YB , T, NT)

GOMMON/ VOLCOM/XR , YR , A , TP, AP , DX , DY , DZ , P , Q , R , SG 1

, FSEG , NTT

DIMENSION XR(8) ,YR(8) ,DX(4) ,DY(4) ,DZ(4) ,P(4) ,Q(4) ,R(4) ,SG1(4)

LOGIGAL T(NT, NT)

DATA KING / 1 /

LOGIGAL SWl

IF (SQRT((XB-XA)**2 + (YB-YA)**2) .LT. 1.9) RETURN

GHEGK FOR HIDDEN PORTIONS OF THE LINE.

RSEG=FLOAT(NTT) / 1 024.

lAT = RSEG*XA

IBT = RSEG*XB

JAT = RSEG*YA

JBT = RSEG*YB

KI = ABS(XB-XA)

KJ = ABS(YB-YA)

IF (KI.GT.120 .OR. KJ.GT.120) GO TO 1 IF ( .NOT.T(IAT, JAT) .OR. . NOT . T( IBT , JBT) ) GO TO 1 GALL LINE (XA,YA, XB,YB)

RETURN

AT LEAST PART OF THE LINE IS HIDDEN. FIND REASONABLE LIMITS.

1 KMAX = (MAXO(XI,KJ)/XINC)*KING + i IF (KMAX .LT. 2) RETURN

NOW GHEGK EAGH SEGMENT ALONG THE LINE.

SWi = .FALSE.

DO 2 K = 1, KMAX, KING

FA = FLOAT(K-l) /FLOAT (KMAX- 1)

X = XA + FA*(XB - XA)

Y = YA + FA*(YB - YA)

IX = RSEG*X

lY = RSEG*Y

IF (SWi) GO TO 3

UPDATE THE FIRST POINT IF SWI IS .FALSE.

IF (.NOT.T(IX, lY)) GO TO 3

XST « X

YST - Y

SWI = .TRUE.

SET THE END POINT.

3 IF (T(IX,IY) .AND. K.NE.KMAX) GO TO 2 IF ( .NOT. SWI) GO TO 2 FB - FLOAT(K-l -KING )/FLOAT( KMAX- 1)

XND - XA + FB*(XB - XA)

YND - YA + FB*(YB - YA)

CALL LINE (XST.YST, XND, YND)

> ’S-
SUBROUTINE VOLUM8 page 88

3714 SWl = .FALSE.

3 71 5 2 CONTINUE3716 RETURN

3717 END

3718 C
SUBROUTINE VOLUME page 89

C

C

C

C

c

c

G

C

c

cc

G

G

G

G

G

G

G

G

G

G

G

G

G

G

G

G

G

G

G

G

G

G

G

G

G

G

G

G

G

G

G

G

G

G

G

G

G

G

G

G

C

G

SUBROUTLNE VOLUME (MODE, F, NX,NY,NZ, GLEVE , NCL, T, NT)

THIS SET OF ROUTINES IS DESIGNED TO DRAW ON A DEVIGE, SUGH AS

A PRINTER, A PLOTTER, THE SC4020 OR THE TEK.TRONIGS GRAPHIGS

TERMINAL, A TWO-DIMENSION PROJEGTION OF A THREE DIMENSIONAL

ARRAY (FIGURE). THE HIDDEN LINES ARE ELIMINATED TO SIMULATE

THE EFFEGT OF ”3D".

THE GO LOR OF THE FIGURES (FOR THE SG4020 ONLY) MUST BE SET

BY THE USER IN THE GALLING PROGRAM USING THE APPROPRIATE GALLS

TO THE GRAPHIGS PAGKAGE.

THE AXIS ARE LABELED AS FOLLOWS: X IS LEFT TO RIGHT

Y IS INTO THE PAGE

Z IS BOTTOM TO TOP

TO INITIALIZE THE PLOTTING PAGKAGE, "VOLSET" MUST BE GALLED.

IF A FRAME SURROUNDING THE DRAWING IS WANTED, GALL "VOLERM’’.

THE ROUTINE LOOPS OVER THE Y AXIS FROM FRONT TO BAGK, PLOTTING

EAGH SUGGESSIVE (X,Z) PLANE. AT THE END OF THE (X,Z) GYGLE,

THE ARRAY ”T" IS SET TO INDIGATE WHAT WILL BE HIDDEN BY THE

GURRENT PLANE.

GALLING SEQUENGE OR OPERATIONAL PROCEDURE:

CALL VOLSET(XP, YP, T, NT)

CALL VOLUME (MODE, F, NX, NY, NZ , GLEVE, NCL)

GALL VOLFRM(MODEl)

ARGUMENTS (TYPE AND SIGNIFICANCE) AND/OR INITIAL CONDITIONS;

XP CONTAINS THE LOCATIONS OF THE X POSITION OF THE VERTICES (8)

YP CONTAINS THE CORRESPONDING Y VALUES (8)

T IS THE PLOTTING ARRAY (BOOLEAN) TO ELLMINATE THE HIDDEN LINES

WHICH IS NT X NT IN SIZE (THIS ARRAY TOGETHER WITH

NX,NY,NZ DETERMINE THE FINESSE OF THE PLOT).

MODE DETERMINES WHICH SURFACE IS PLOTTED (USED WITH GLEVE)

ABS(MODE)=l WILL PLOT THE CONTOUR LEVEL "CLEVE" IN EACH PLANE

AND THEN FIXES THE HIDDEN LINE MATRIX "T".

ABS(MODE)-2 SLMPLY FIXES THE HIDDEN LINE MATRIX ”T" WITHOUT

PLOTTING. THIS IS USEFUL IN AVOIDING MULTIPLE

PLOTS OF THE SAME FIXED FIGURE.

M0DE<0 IS USED WHEN THE VALUE OF THE FUNCTION ON THE

"OUTSIDE" IS LESS THAN "GLEVE".

MODE>0 IS USED WHEN THE VALUE OF THE FUNCTION ON THE

"OUTSIDE" IS GREATER THAN "GLEVE".

F IS THE THREE-DIMENSIONAL FIGURE TO BE PLOTTED.

NX,NY,NZ ARE THE DIMENSIONS OF THIS .ARRAY <F(NX, NY, NZ)>

GLEVE IS THE CONTOUR SURFACE LEVEL FOR PLOTTING.

NCL IS THE NUMBER OF PAIRS OF (MODE, GLEVE) TO BE PLOTTED.

MODE I IS THE MODE OF FRAMING 0-> AT THE EIGHT VERTICES;

l-> A BOX FORMED BY LINES.
SUBROUTINE VOLUME page 90

377^ C

3 775

3 776

3 77 7 3778

3 779

3780

3781 C

3 782

3733 C

3784 C

3785 C

3 736

3 737

3738 C

3789 C

3790 C

3791

3792

3793

3 794

3795 C

3 796 C

3797 C

3798

3799

3800

3801

3302

3803

3804

3805

380o

3 SO 7 3308

3809

3810

381

1

3812

3813

3814

3815

3816

3817

3818

3819

3820

3821

3822

3823

3824

3825

3826

3827

3828

COMMON/VOLCOM/XR,YR,A,TP,AP,DX,DY,DZ ,X, Y,Z ,SCi , FSEG,NTT

LOGICAL T(NT,NT)

DIMENSION XR(8) , YR(8 )

, DX(4 ), DY(4) ,DZ(4) ,X(4) , Y(4) ,Z(4) ,SCi(4)

INTEGER MODE(NCL)

REAL F(NX,NY,NZ), CLEVE(NCL)

REAL XP(8), YP(8)

CALL VOLUTiO (XR,YR, NX,NY,NZ)

THE OUTER LOOP IS OVER THE I,K SURFACES MOVING BACK.

DO 1 J = 1, NY

IF (J.EQ. 1) GO TO 2

THEN LOOP OVER THE VARIOUS CONTOUR LEVELS.

DO 20 LL = 1, NCL

CLEVEL = CLEVE(LL)

MODEL = MODE(LL)

IF (lABS (MODEL) .EQ. 2) GO TO 20

FIRST COMPUTE THE FRONT -TO-BACK LINE SEGMENTS.

DO 3 I = 1, NX

DO 4 K = 2, NZ

FMAX = AMAXl ( F( I , J-1 , K-1 ) , F(I,J,K-1), F(I,J,K), F(I,J-1,K))

FMIN = AMINl (F(I, J-1 ,K-1) , F(I,J,K-1), F(I,J,K), F(I,J-1,K))

IF ( FMAX. LT. CLEVEL .OR. FMIN. GT . CLEVEL) GO TO 4

GALL VOLUM7 (CLEVEL, F( I , J-1 , K-i ) , F(I,J,K-1),

1 F(I,J,K), F(I,J-1,K), NSEG, DY, DZ)

IF (NSEG .LE. 1) GO TO 4

DO 5 L = 1, NSEG

X(L) = FLOAT(I)

Y(L) = FLOAT(J-l) + DY(L)

5 Z(L) = FLOAT(K-l) + DZ(L)

CALL VOLUM6 (XA.YA, X( 1 ) , Y( 1 ) ,Z( 1 )

)

CALL VOLUM6 (XB,YB, X( 2 ) , Y( 2 ) , Z( 2 ) ) GALL VOLUM8 (XA,YA, XB,YB, T, NT)

IF (NSEG.NE.4) GO TO 4

CALL VOLUM6 (XA,YA, X(3) , Y(3) ,Z(3)

)

CALL VOLUM6 (XB,YB, X(4) ,Y(4) ,Z(4)

)

CALL VOLUM8 (XA,YA, XB,YB, T, NT)

4 CONTINUE

3 CONTINUE

DO 6 K - 1, NZ

DO 7 I - 2, NX

FMAX = AMAXl ( F( I-l , J-1 , K) , F(I,J-1,K), F(I,J,K), F(I-l,J,K))

FMIN =. AMINl (F(I-1,J-1,K), F(I,J-1,K), F(I,J,K), F(I-1,J,K))

IF ( FMAX. LT. CLEVEL .OR. FMIN. GT . CLEVEL) GO TO 7 CALL VOLUM7 (CLEVEL, F( I-l , J-1 , K) , F(I,J-1,K),

1 F(I,J,K), F(I-1,J,K), NSEG, DX, DY)

IF (NSEG .LE. 1) GO TO 7 DO 8 L - 1, NSEG

X(L) - FLOAT(I-l) + DX(L)
SUBROUTINE VOLUME page 91

3829

3830

3831

3832

3-333

3834

3835

3836

3837

3838

3839

3840

3841 C

3842 G

3843 C

3844 G

3845

3846

3847

3848

3849

3850

3851

3852

3853

3854

3855

3856

3857

3858

3859

3860

3861

3862

3863

3864

3865

3866

3867

3868

3869

3870

3871 G

3872 G

3873 G

3874

3875

3876

3877

3878

3879

3880

3881

3882

3883 C

Y(L) = FLOAT(J-l) + DY(L)

8 Z(L) = FLOAT(K)

GALL VOLUM6 (XA,YA, X( 1 )

, Y( 1 ) ,Z( 1 ) ) GALL VOLUM6 (XB,YB, X(2) , Y(2) ,Z(2)

)

GALL VOLUM8 (XA,YA, XB,YB, T, NT)

IF (NSEG, NE.4) GO TO 7 GALL VOLUM6 (XA,YA, X( 3 )

, Y( 3 )

, Z( 3 )

)

GALL VOLUM6 (X3,Y3, X( 4 ) , Y( 4 ) , Z( 4 ) ) GALL VOLUM8 (:CA,YA, X3,Y3, T, NT)

7 GO NT IN UE

6 GONTINUE

20 GONTINUE

NOW PLOT THE X-Z SURFAGE GONTOURS BEFORE GORREGTING THE HIDDEN

LINE ARRAY.

2 DO 21 LL = 1, NGL

GLEVEL = GLEVE(LL)

MODEL = MODE(LL)

IF (LABS (MODEL) . EQ. 2) GO TO 21

DO 9 K. = 2, NZ

DO 10 I = 2, NX

FMAX = AMAXl (F( I-l , J , K-1 ) , F(I,J,K-1), F(I,J,K), F(I-1,J,K:))

FMIN = AMINl (F(I-1, J,K-1) , F(I,J,R-1), F(I,J,K.), F(I-l,J,iC))

IF (FMAX. LT. GLEVEL .OR. FMIN. GT . GLEVEL) GO TO 10

GALL VOLUM7 (GLEVEL, F(I-1 , J,K-1 ) , F(I,J,K.-1),

1 F(I,J,X), F(I-1,J,K), NSEG, DX, DZ)

IF (NSEG .LE. 1) GO TO 10

DO 11 L = 1, NSEG

X(L) = FLOAT(I-l) + DX(L)

Y(L) = FLOAT(J)

11 Z(L) = FLOAT(K-l) -i- DZ(L)

GALL VOLUM6 (XA,YA, X( 1 ) ,Y( 1 ) ,Z( 1 )

)

GALL VOLUM6 (XB,YB, X( 2 ) , Y( 2 ) , Z( 2 ) ) GALL VOLUM8 (XA,YA, XB,YB, T, NT)

IF (NSEG, NE.4) GO TO 10

GALL VOLUM6 (XA.YA, X(3 )

, Y( 3 )

, Z( 3 )

)

GALL VOLUM6 (XB,YB, X( 4 ) , Y(4 ) , Z( 4 ) ) GALL VOLUM8 (XA,YA, XB,YB, T, NT)

10 GONTINUE

9 GONTINUE

21 GONTINUE

FILL THE HIDDEN LINE ARRAY AFTER PLOTTING IN THE NEW PLANE.

DO 22 LL - 1, NGL

GLEVEL =- CLEVE(LL)

MODEL - MODE(LL)

DO 12 K - 2, NZ

DO 13 I - 2, NX

IF (MODEL. GT.O .AND. AMIN 1 ( F( I-l , J , K- I ) , F(l,J,K-l),

I F(I-l,J,X), F(l,J,X)).GT. GLEVEL) GO TO 13

IF (MODEL. LT.O .AND. AMAX I ( F( I- 1 , J , X- 1 ) , F(I,J,K-l),

I F(1-1,J,X), F(l,J,K)).LT. GLEVEL) GO TO 1

3

1 -•) 0
SUBROUTINE VOLUME page 92

THERE IS HIDDEN STUFF SOMEWHERE IN THE CELL, FIRST FIND THE LIMITS

OF THE CELL.

CALL VOLUM6 (XOO,YOO, FLOAT(I-l), FLOAT(J), FLOAT(K-l))

CALL VOLUM6 (X10,Y10, FLOAT(I ), FLOAT(J), FLOAT(K-l))

CALL VOLUM6 (XLl.Yll, FLOAT(I ), FLOAT(J), FLOAT(K ))

CALL VOLUM6 (XOl.YOl, FLOAT(I-l), FLOAT(J), FLOAT(K ))

DXMAX = AMAXl ( ABS( XIO-XOO) , ABS(X 1 1-XO L )

)

DYMAX = .\MAXI ( A3S ( YO 1 -YOO ) , ABS ( Y 1 L-Y iO) ) NSEGX = (DXMA:^ + FSEG)/FSEG

NSEGZ = (DYMAX + FSEG)/FSEG

DII = i.O/NSEGX

DRX = i.O/NSEGZ

DO 14 II = i, NSEGX

XGRID = (FLOAT(II) - 0.5)*DII

DO 15 KX = 1, NSEGZ

ZGRID = (FLOAT(KK) - 0.5)*DKK

CALL VOLUM6 (XA , YA , XGRID+FLOAT( I-l )

, FLOAT( J )

, ZGRID+FLOAT( X-1 )

)

IXA = XA/FSEG

UA = YA/FSEG

IF (.NOT.T(IXA,IYA)) GO TO 15

FIND THE VALUE OF F AT THE POINT UNDER SCRUTINY.

FVAL = (F(I-l,J,K-i)*(i.O-XGRID)+F(I, J,X-l)*XGRID)*(i.O-ZGRID)

1 + (F(I-l,J,K)*(i.O-XGRID) +F(I,J,K)*XGRID)*ZGRID

IF (MODEL.GT.O, AND. FVAL. LT.CLEVEL) T(IXA,IYA) = .FALSE.

IF (MODEL. LT.O. AND. FVAL. GT.CLEVEL) T(IXA.IYA) = .FALSE.

15 CONTINUE

14 CONTINUE

13 CONTINUE

12 CONTINUE

22 CONTINUE

I CONTINUE

RETURN

ENTRY VOLSET (XP, YP, T, NT)

THIS FIRST ENTRY INITIALIZES THE PLOT GEOMETRY AND FILLS THE

HIDDEN LINE ARRAY T WITH THE INITIAL .TRUE. FOR TRANSPARENT. THE

ARRAY T IS NT X NT (OR 16K. WORDS MAX) AND IS PASSED IN FROM THE

OUTSIDE. THIS CORRESPONDS TO 1024/NT RASTER UNITS ON THE SC4020.

SCl(l) » 1.0

SC1(2) - 0.0

SC1(3) =• i.O

SCi(4) - 0.0

DO 100 I =- 1, NT

DO 100 J - 1, NT

100 T(I,J) » .TRUE.

FSEG - 1024.0/FLOAT(NT)

DO 103 I - 1, 8

XR(I) - XP(I)
SUBROUTINE VOLUME page 93

3939

3940

3941

3942

103 YR(I) = YP(I)

NTT = NT

RETURN

END j < .

.

‘ (

•i i ;
3943

3944

3945

3946

3947

3948

3949

3950

3951

3952

3953

3954

3955

3956

3957

3958

39 59

3960

3961

3962

3963

3964

3965

3966

3967

3968

3969

3970

3971

3972

3973

3974

3975

3976

3977

3978

3979

3980

3981

3982

3983

3984

3985

3986

3987

3988

3989

3990

3991

3992

3993

3994

3995

3996

3997

SUBROUTINE WDCOUNT page 94

SUBROUTINE WDCOUNT(W,NC)

C

C COUNT THE NUMBER OF CHARACTERS (LEGITIMATE) IN A STRING

C

CHARACTER*! W(*), E, P, B, H, U, D, L, C, R, 0, M

DATA E/ ' V / ,P/ ’ . 7 ,B/ 'B7 ,H/'H7 ,U/ 'U 7 ,D/ ’D7 ,L/'L7

DATA C/'C7,R/’R7,0/’07,M/'M7

C

IP = 0 ; NO CHARACTERS

I = 1 100 IF(W(I).EQ.E) THEN

IF(W(I+1).EQ.H) THEN

1 = 1+2

ELSE

IF(W(I+1),EQ.U) THEN

ELSE

IF(W(I+1).EQ.D) THEN

ELSE

IF(W(I+1).EQ,L.0R.W(I+1).EQ.R.0R.W(I+1).EQ.M) THEN

ELSE

IF(W(I+1).EQ, B) THEN

ELSE

IF(W(I+l).EQ.O) THEN

ELSE

IF(W(I+1).EQ.C) THEN

1 = 1 + 2 ELSE

IF(W(I+1).EQ.E) THEN

GO TO 200

ELSE

IF(W(I+1).EQ.P) THEN

GO TO 300

ELSE

GO TO 101

ENDIF

ENDIF

ENDIF

ENDIF

ENDIF

ENDIF

ENDIF

ENDIF

ENDIF

ELSE

GO TO 200

ENDIF

C

101 1 = 1+2

IF(I.GT.132) GO TO 400 ; QUIT ANYHOW

GO TO 100

C

C COUNT A CHARACTER

C

200 I - I + 1 IP - IP + 1
SUBROUTINE WDCOUNT page 95

3998 s HO

3999 C

4000 c TERMINATE

4001 c 4002 300 NC = IP

4003 RETURN

4004 c 4005 c TERMINATE

4006 c 4007 400 NC = 0

4008 RETURN

4009 END

_ > 1 »
•4010

•401

L

4012

4013

4014

4015

4016

4017

-•j L'i 4019

4020

4021

4022

4023

4024

4.J2 5 4026

4027

4028

4029

4030

4031

4032

4033

4034

4035

4036

4037

4038

4039

4040

4041

4042

4043

4044

4045

4046

4047

4048

4049

4050

4051

4052

4053

4054

4055

4056

4057

4058

4059

4060

4 061

4062

4063

4064

o

o

SUBROUTINE WDDRAW page 96

SUBROUTINE WD DRAW (XS TART, YSTART, DX, DY, SX, SXY, SY, W)

C

c

c

c

cc

c

c

cc

G

C

cc

c

XSTART REAL

YSTART REAL

DX REAL

DY REAL

SX REAL

SXY REAL

SY REAL

w

- X COORDINATE (MATHEMATICAL SPACE) OF THE FIRST

CHARACTER TO BE DRAWN

- Y COORDINATE (MATHEMATICAL SPACE) OF THE FIRST

CHARACTER TO BE DRAWN

- INCREMENT TO BE ADDED TO THE X COORDINATE FOR

EACH CHARACTER DRAWN

- LNCREl-lENT TO BE ADDED TO THE Y COORDINATE FOR

EACH CHARACTER DRAWN

- X MATH SPACE SIZE FOR CHARACTERS

- SLANT MODIFIER FOR CHARACTERS

- Y MATH SPACE SIZE FOR CHARACERS

- CHARACTER STRING TO BE DRAWN.

CONTROL CHARACTERStL - TEXT IS DRAWN TO THE LEFT OF XS TART , YSTART

1M - TEXT IS CENTERED AT XS TART , YSTART

1R - TEXT IS DRAWN TO THE RIOIT OF XS TART , YSTART

C

C

C

C

C

C

Cc

c

c

c

c

G

1U

ID

10

IB

C

cG

C

Cc

c

c

1C

1 .

CHANGE CHARACTER SETS ... IHOi, 1H02,

... 1H20, 1H21 FOR CHARACTER SETS

1, 2, ... 20, AND 21.

DRAW THE FOLLOWING CHARACTERS LN

SUPERSCRIPT.

DRAW THE FOLLOWING CHARACTERS IN SUBSCRIPT.

RESET CHARACTER SIZE AND PLACEMENT FROM

SUPERSCRIPT OR SUBSCRIPT TO ORIGINAL

SIZE.

BACKSPACE OVER LAST CHARACTER DRAWN.

WORKS ONLY FOR ONE CHARACTER. MULTIPLE

BACKSPACES WILL PRODUCE UNPREDICTABLE

RESULTS.

CHANGE COLOR, 1C00, 1C01, ... TO CHANGE

TO COLOR 0, 1, ...

END OF CHARACTER STRING.

C* ****************************** A* ************************* *************

C WDDRAW

C* *************************************************************** *******

C

INTEGER CHNUMB, SDFLT

CHARACTER*! W( I ) , E, P, B, CC(4), H, U, D, L, C

CHARACTER*! CENTER, R, 0, M

DATA E/ ‘1 V,P/’. V,B/’B'/,H/'H'/,U/'U'/,D/’DV,L/'L'/

DATA C/'G'/,R/’R'/,0/'OV,M/'M’/, SDFLT/4/, SE/4/

REAL X(132),Y(132),SCL(132),XLL(125),YLL(125),PEN( 125)

COMMON /DEVTYP/ IDEVIC , LSW ,LTSW ,XYCOOD(4) , LUOUT , LPAGE

COMMON/GRFTYP/ ANGLE, IRVRSE, CHSIZE(9) ,ITKWIT,LUDIAG,LUHSET

EQUIVALENCE (CC, CHNUMB)

INTEGER SETL(132), SE, CH(132), ICL(132)

C

C
4065

4066

4067

4068

4069

4070

4071

4072

4073

4074

4075

4076

4077

4078

4079

4 080

4081

4082

4083

4084

4085

4086

4087

4088

4089

4090

4091

4092

4093

4094

4095

4096

4097

4098

4099

4100

4101

4102

4103

4104

4105

4106

4107

4108

4109

4110

4111

4112

4113

4114

4115

4116

4117

4118

4119

SUBROUTINE WDDRAW page 97

C SET THE PLOTTING SPACE PARAMETERS

C

CHSIZE(2) = SY * XYCOOD(3) * CHSIZE(6)

CHSIZE(7) = CHSIZE(2)*(CHSIZE(3)+.5*(1.8-CHSIZE(6)))/XYCOOD(l)

CHSIZE(8) = CHSIZE(2)*(CHSIZE(4)+. 5*(1.8-CHSIZE(6) ))/XYCOOD(3)

C

XL = 0.0

YL = 0,0

IP = 0

ICOL = 0

XLAST = XL

WIDTH =0.0

SC = 1.0

IC = 1 1=1

CENTER = 'R' C

C SCAN THE LNPUT STRING FOR JUSTIFICATION AND END OF TEXT

C

100 IF(W(I).EQ.£) THEN

IF(W(I+1).EQ.H) THEN

SE = CTOI(W(I+2) ,IC)*10 + CTOI(W(I+3) ,IC)

IF (SE.LT. 1.0R.SE.GT.24) SE = SDFLT

1 = 1 + 2

ELSE

IF(W(I+1).EQ.U) THEN

XL = XL + SX * 0.20 * SC

YL = YL + SY * 0.8 * SC

SC = SC * 0.6

ELSE

IF(W(I + 1).EQ.D) THEN

XL = XL + SX * 0,06 * SC

YL = YL - SY * 0.20 * SC

SC = SC * 0.6

ELSE

IF(W(I+l).EQ.L.OR.W(I+l).EQ.R.OR.W(I+l).EQ.M) THEN

CENTER = W(I+1)

ELSE

IF(W(I+1).EQ. B) THEN

XL = XL - WLAST

ELSE

IF(W(I+l).EQ.O) THEN

YL - 0.0

SC = 1.0

ELSE

IF(W(I+1).EQ.C) THEN

ICOL = CTOI(W(I+2), IC)*10 + CTOI(W( 1+3) , IC)

1 = 1 + 2

ELSE

IF(W(I+1).EQ.E) THEN

GO TO 200

ELSE

IF(W(I+1). EQ. P) THEN

GO TO 300

ELSE
4 120

4121

4122

4123

4124

4125

4126

4127

4128

4129

4130

4131

4132

4133

4134

4135

4136

4137

4138

4139

4140

4141

4142

4143

4144

4145

4146

4147

4148

4149

4150

4151

4152

4153

4 154

4155

4156

4157

4158

4159

4160

4161

4162

4163

4164

4165

4166

4167

4168

4169

4170

4171

4172

4173

4174

SUBROUTINE WDDRAW page 98

1 = 1-1

GO TO 101

ENDIF

END IF

ENDIF

ENDIF

ENDIF

ENDIF

ENDIF

ENDIF

ENDIF

ELSE

GO TO 200

ENDIF

C

101 1 = 1+2

IF(I.GT.132) GO TO 300 , QUIT ANYHOW

GO TO 100

C

C WE HAVE A CHARACTER

C

200 IF(SE.EQ, 1) THEN

CC(1) = W(I)

CWMIN = 0. CWMAX = SX

ELSE

CHNUMB = IDCHAR(W(I))

CALL HSETS (CHNUMB , XLL , YLL , PEN , NR, SE-1 , lER)

IF(IER.NE.O) THEN

IF(LUDLAG.GT.O) WRITE ( LUDLAG , 20 1 ) CHNUMB , SE ,W( I

)

201 FORMATC CHARACTER ',Z10,' NOT FOUND IN SET ',I4,Z5)

GO TO 203

ENDIF

IF(NR.EQ. 0) THEN

CWMIN =0.0

CWMAX = SX * 0.6

ELSE

CWMIN = l.OE+10

CWMAX = 0.

DO 202 J = 1, NR

XLL(J) = XLL(J) * 0.216 * SX

CWMIN = MIN (CWMIN, XLL(J))

202 CWMAX = MAX (CWMAX, XLL(J))

ENDIF

ENDIF

C

C STORE ITS PARAMETERS IN LOCAL SPACE

C

XLAST = XL

IP - IP + 1 X(IP) = XL - CWMIN

Y(IP) - YL

ICL(IP) - ICOL

SCL(IP) - SC

CH(IP) - CHNUMB
4175

4176

4177

4178

.4179

4180

4181

,4182

.4183

4184

4135

4186

4187

4188

4189

4190

4191

4192

4193

4194

4195

4196

4197

4198

4199

4200

4201

4202

4203

4204

4205

4206

4207

4 208

4209

4210

4211

4212

4213

4214

4215

4216

4217

4218

4219

^220

4221

4222

4223

4224

4225

4226

4227

4228

4229

SUBROUTINE WDDRAW page 99

SETL(IP) = SE

WLAST = (0.500*SC+0.5)*(CWMAX-CWMIN) + 0. 20*SC*DX

XL = XL + WLAST

YL = YL + DY

203 1 = 1 + 1 GO TO 100

C

C DRAW IT - FIRST SET THE CORRECT CENTERING

C

300 XOFF = X(l)

WIDTH = XL - XOFF

IF (CENTER. EQ,R) THEN

DXX = 0.0

ELSE IF (CENTER. SQ.M) THEN

DXX = WIDTH / 2.

ELSE IF (CENTER. EQ.L) THEN

DXX = WIDTH

END IF

DO 301 I = 1, IP

301 X(I) = X(I) - XOFF - DXX

C

C DO ANY SHIFTING AND NECESSARY ROTATIONS

C

COSX = COS (ANGLE)

SINX = SIN (ANGLE)

SXX = ABS(XYCOOD(l))

SYY = ABS(XYCOOD(3))

OSX = 1. / SXX

OSY = 1. / SYY

DO 304 I = 1, IP

XI = X(I) * COSX * SXX - Y(I) * SINX * SYY

YI = X(I) * SINX * SXX + Y(I) * COSX * SYY

X(I) = XI * OSX + XSTART

304 Y(I) = YI * OSY + YSTART

C

C NOW DO THE DRAW

C

IF(IP.LE.O) GO TO 303 , NOTHING TO DO

ICOL = 0

DO 305 J = 1, IP

IF(ICL(J).NE.O.AND. ICL(J).NE. ICOL) THEN

CALL COLOR(ICL(J)

)

ICOL = ICL(J)

ENDIF

305 CALL HHDRAW (X(J), Y(J), SX*SCL(J), SXY, SY*SCL(J),

CH(J), SETL(J), lER)

303 CHStZE(2) - CHSIZE(l)

ANGLE = 0.0

RETURN

C

C CHANGE THE DEFAULT CHARACTER SET - BYPASS THE ESCAPE SEQUENCE

C

ENTRY CHRSET (ISET)

IF( ISET.GT.O) SE - ISET

LF(LUDIAG.GT.O) WRITE(LUDIAG, 302 ) ISET

'> l 7
SUBROUTINE WDDRAW page 100

4230

4231

4232

4233

RETURN

302 FORMAT (' CHANGE THE DEFAULT CHARACTER SET TO #',I3)

RETURN

END

_ O Q
NBS-H4A iREv. 2-80

U.S. DEPT. OF COMM.

BIBLIOGRAPHIC DATA

SHEET (See instructions)

4. TITLE AND SUBTITLE

PUBLICATION OR

REPORT NO.

2. Performing Organ. Report No. 3. NBSIR 85-3235

PubI i cation D ate October 1985

A Device Independent Graphics Kernel

5. AUTHOR(S)

Walter W. Jones and Alicia B. Fadell

6 . PERFORMING ORGANIZATION (If joint or other than NBS, see in struction sj 7 . ContracL''Grant No. NATIONAL BUREAU OF STANDARDS

DEPARTMENT OF COMMERCE 8. Type of Report & Period Covered

Gaithersburg, Maryland 20899

9.

SPONSORING ORGANIZATION NAME AND COMPLETE ADDRESS (Street. City, State. ZIP)

10.

SUPPLEMENTARY NOTES

I ! Document describes a computer program; SF-185, FlPS Software Summary, is attached.

11.

ABSTRACT (A 200-word or less factual summary of most significant information. I f document includes a significant

bi bliography or literature survey, mention it here) This paper describes an interface for programs which allows one to write graphics

primitives to several devices without regard for the type of device. The most

salient features are that it has low overhead, is transportable and can be expanded

as the nature of the input/output devices changes. A conscious effort has been

made to include all normal graphics primitives together with the most useful high

level routines without compromising the use of special features of custom display

units.

12. KEY WORDS (S/x to twelve entries; alphabetical order; capitalize only proper names; and separate key words by semicolon s) device independence; display devices; graphics

13. AVAILABILITY

[_j^ Unlimited For Official Distribution. Do Not Release to NTIS

1 1 Order From Superintendent of Documents, U.S. Government Printing Office, Washington, O.C

20402.

fXl Order From National Technical Information Service (NTIS). Springfield, VA. 22161

14. NO. OF

PRINTED PAGES

241

15. Price

USCOmm-OC «04,i.p«0
i'ii7T!rnjr V-’ Ttn •ST, flO' wd^Aj'j Vp^4-'i'W.U'

if!§|

rsiTis

f t .,_ ml# -

0p*«'»*7 ’"^ I* • '•^^ 'b ai*j>'T ai fS:'

•vttL .Jir;7

aWi

.%V lOI

A—fi--

4 £ e,T^4r’ri'T ,,©

} — ' Jfc ;.1..Lj /a. 1,-r.' j; '.•* ‘^\-li,'.v.'.i’ ^'fci • l_'Cl.-..^^tC.

U ‘^itm

,B$lrtv

. J '.Is I

'M

' -4 ic

il.'

' ye >^*k0

.\t*

" '“" '"*“

''W''ij'iiAj.<'' *A iH[’

0

" '
^Tr>^ O 'ih •?